Showing posts with label nondeterminism. Show all posts
Showing posts with label nondeterminism. Show all posts

Thursday, April 14, 2011

Attributed Variables: their uses and one implementation

Here's a problem that comes up enough, computationally: find a value within some range. You don't know what the value is at the moment, but you will know it, eventually, as the range becomes further restricted by refinements of the constraints or data.

Now, in general, this is an easy problem for Haskell to solve, and Haskell provides more than one way to approach the solution. For example, if we have some x in some domain D, one way to look at an arbitrary x until we find the one, true x we are looking for is the following code snippet:

> [ x | x <- D, ... further constraints ]

More variables? Interrelated ones? No problem:

> [ (x, y, z) | x <- D, y <- D, z <- D, x < y, ... further constraints ]

Okay, let’s take it to the next level. What if the interrelation is such that one variable consumes from the domain, so that value is now unavailable to other variables. Pithily: the variables’ values are mutually exclusive.

Well, one way to go about that is to embed a guard for each variable into the list compression:

> [ (x, y, z) | x <- D, y <- D, y /= x, z <- D, z `notElem` [x,y], ...

The drawback here is that this kind of guarded coding becomes tedious and prone to errors. On top of that we see that the guard follows the select, causing unnecessary backtracking through the search space,[1] especially given that we know the guarded values a priori.

Well, then, we can automate guarded selection with a state (transformer) monad:[2]

> ...
> f = do x <- choose
> y <- choose
> z <- choose
> ...
> runStateT f [0..9]


Okay, excellent! All of this works and works well … for a fixed and predetermined variable set.

The Problem



Things start to get tricky for me, programmatically, however, when one set of constrained values spill over onto another set of constrained values, such as the results of one generation in a cellular automata set or genetic (algorithm) pool affect the next set:

> evalStateT (gen row1guards) domain >>= \ans1 ->
> evalStateT (gen (row2guards ans1)) domain >>= \ans2 ->
> evalStateT (gen (row3guards ans1 ans2)) domain >>= \ans3 ->
> ... etc


The state transformer isn’t enough, so it needs to be some RWS monad, perhaps pushing the interim results into the Reader monad and the accumulated ones into Writer while the State monad handles the flow of the computation?

It seems to me that the work becomes more about monad management and less about the computation itself.[3]

Then there’s the even more general computation. What if we do not know, a priori, how many values we are generating in our problem solving? The problem space I’m looking at is something like:
For a variable number of variables, map selection and guards for each variable.

How do I write that as a list compression expression, or as a monadic one? The problem with Haskell variables is that they aren't (variables), and so something so easily accomplished in a Prolog program:

kakuro([], Vars, Functor) :-
Fn =.. [Functor, Vars],
call(Fn).
kakuro([H|T], Acc, Functor) :-
assign(H),
kakuro(T, [H|Acc], Functor).


called with:

?- kakuro([A, B, C, D], [], sum_equals_10).

or:

?- kakuro([X, Y, Z], [], sum_equals_10).

... or with a list of any other length isn't so easily written out in Haskell when I go to attack the problem. After all, what is the type of a list of unbound variables? Haskell doesn't (so easily) allow this, and I was stuck: I didn't know how to proceed using monadic programming or list compression.

A solution



Fortunately for me, I've been studying constraint-based programming, and that research has let me to some papers on attributed variables[4] which faciliate that programming style.

Attributed variables are variables ranging over a domain that can have attributes attached to them that restrict (or constrict) the range of values. It's a very simple step to go from a set of unbound attributed variables to a (simple or façile) constraint solver by adding (constraining) attributes to the variables.

More formally, I declare (denotationally) an attributed variable as:

> data Attribute a = Attribute [Constraint a] (Domain a)

where Constraint and Domain are declared as:

> newtype Constraint a = Constraint { resolve :: a -> Bool }

> type Domain a = [a]


Or, to put words to it, an Attributed Variable is an object that has a set of (constraining) functions over an assigned domain.[5]

The above denotational declaration of attributed variables works, but I find, operationally, grounding an attributed variable once it's reduced to a single value to be useful:

> data Attribute a = Attribute [Constraint a] (Domain a)
> | Ground a


So, that's my declaration.[8] How is this implemented in practice?

Implementation



The approach I take is that an attributed variable is created in a free state over its domain:

> makeAttrib :: Domain a -> Attribute a
> makeAttrib list = Attribute [] list


And then, as constraints are added to the attributed variable, the system 'tries to solve' the attributed variable over the set of the constraints:

> constrain (Attribute constraints dataset) constraint
> = solve (Attribute (Constraint constraint:constraints) dataset)
> constrain (Ground x) _ = Ground x


And if the solution results in a singleton list, then the attributed variable becomes Ground:

> solve attr@(Attribute _ []) = attr
> solve attr@(Attribute constraints list@(h:t))
> = let result = solve' constraints list
> in if length result == 1
> then Ground (head result)
> else Attribute constraints result


Of course, the 'solution' to a Ground attributed variable is itself:

> solve (Ground x) = Ground x

The above code is simply a dispatch along the binary type. The worker-bee, solve' is simply (again) an implementation of the dual of filter:

> solve' :: [Constraint a] -> [a] -> [a]
> solve' _ [] = []
> solve' constraints (h:t) =
> if (solveConstraints constraints h)
> then (h:solve' constraints t)
> else solve' constraints t

> solveConstraints :: [Constraint a] -> a -> Bool
> solveConstraints [] _ = True
> solveConstraints (f:rest) x = resolve f x && solveConstraints rest x


So something from Control.Applicative to reduce that to a one-liner? I leave that as an exercise to the reader.

And there you have it, that is a working implementation of attributed variables. I have test functions for groundedness, solvability and the current state of the domain of an active attributed variable, but those are simple helper functions, easily implemented, and provided in the attached source code.

Uses



So, now, what do we have?

Now we have variables over which we may specify a domain ('loosely' typing a variable) and then constrain. How can we use such a system?

One way is that we can write constraint logic programs in Haskell. The illustration from Prolog (above) has a nearly direct transliteration into Haskell (with the additional benefit of strong typing):

> kakuro :: [Int] -> Int -> [[Int]]
> kakuro list total = nub $ summer (sort $ map trib list) [] total

> trib :: Int -> Attribute Int
> trib x | x == 0 = makeAttrib [1..9]
> | otherwise = Ground x

> summer :: [Attribute Int] -> [Int] -> Int -> [[Int]]
> summer [] list total = do
> guard $ sum list == total
> return $ sort list
> summer (h:t) list total = do
> a <- domain $ constrain h (flip notElem list)
> summer t (a:list) total


And with the above code, we can now do the following:

*Kakuro> kakuro [0,0,0] 10
[[1,2,7],[1,3,6],[1,4,5],[2,3,5]]
*Kakuro> kakuro [0,0,0,0] 10
[[1,2,3,4]]


Note that I use sort above, but attributed variables are not (denotationally) ordered types. Operationally, that is: in logical programming, it makes sense to eliminate early, so if we have Ground values, we wish to consume those first. So, to that end, I declare the following instances:

> instance (Eq a) => Eq (Attribute a) where
> Ground x == Ground y = x == y
> _ == _ = False

> instance (Ord a) => Ord (Attribute a) where
> Ground x <= Ground y = x <= y
> Ground _ <= _ = True
> _ <= _ = False


And with those instance declarations, sort automagically works. Neat!

Interlude: Haskell is "Neat"



I don't know about you, but I'm guessing that many of you are taking the gift that Haskell is for granted. Or I suppose I should say 'the way of thinking that using Haskell provides.' Over and over again in industry (yes: stone knives and bearskins) I hear 'that can't be done.' And I find myself puzzled. What's the showstopper here?

For example, this past week at work, we needed to convert a data mapping document in Excel (stop snickering, please) into an equivalently flat XML schema representation with a accompanying XML sample file. So fields of the form:

/Field/Name="BusinessAddress"
/Field/Value="plaintext"

/Field/Name="BusinessAddress"
/Field/Value="encrypted"


And there were enumerated values as well:

/Field/Name="PropertyOccupancyTypeOwnerOccupied"
/Field/Value="plaintext"

/Field/Name="PropertyOccupancyTypeRentedToTenant"
/Field/Value="plaintext"

/Field/Name="PropertyOccupancyTypeVacant"
/Field/Value="plaintext"


There were over 1,000 of these element names. I mentioned I would write a parser to generate the XSD and XML and was told by the development team point-blank that that was impossible and the only way to go about this transcription was manually, line-by-line, by hand.

So I wrote the script. I suppose I could have used Perl, but as I'm on a Windows box, the shell isn't very inviting for Perl-like piping, so I used Haskell, stripping the metainformation and pushing the parsed names into a map (or, to be precise, a Data.Map) where enumerated (mutally exclusive instance) types went into a list named by their type name and other values were singletons. Then for the XSD I simply iterated over the elements of the map (recursively), and for the sample XML file, I just chose an element (in this case, the first element) of each type.

The net result was that all the elements analysis team compiled into an Excel spreadsheet by hand over a six week period I was able to deliver in two days as a full XSD schema and a comprehensive XML sample file.

Two members from the development team assisted me on this task, one of them was the lead developer. He was intrigued and asked me: "What does this script do?" after being impressed that he could generate a schema definition file and a sample file in seconds. So I explained Haskell as a 'data-flow' language and I traced the flow of the input file through the monad and function composition showing the translation of the internal representation into XSD and then, in a different context, into XML. I'm not sure he got my explanation, but he did walk away impressed with what Haskell can do.

Yes, these are simple things: parsing, mapping, iterating. But for most of the software engineering community in industry, it is easier and faster to go through, line-by-line, by hand, than to write a piece of code to automate that process ("Can that even be done?" "No, it's impossible, just do it manually").

I have encountered this over and over again in industry. Teams are willing to expend more than two hundred person hours to a reoccuring task and are willing to accept the associated fatigue errors to schedule systems by hand. Then they are shocked that I build a functional or logic-based system that autogenerates a pristine result in sub-second time.

Where does this leave us?

What I see as status quo is that industry is resigned to slog through repetitive tasks manually, because it's too hard in Language X to consider tackling the problem: more time would be spent writing, compiling and fixing a program to do the task than to do the task by hand.

On the academic side, I see researchers isolated from industry, feeling their advances have no practical use as there appears to be no interest from industry. I attended a talk on dependent types where the thesis was that this typing makes coding more declarative, more powerful and less error prone. I approached the lecturer and asked how I could implement such a system and was asked what application dependent types had for industry.

Hm. Let me think on that for a while.

Why would industry be interested in coding more declaratively, more powerfully, and with less errors? I was flabbergasted that the researcher saw no benefit for industry in his presentation.

We have a powerful tool in Haskell. We can do more, cleaner, safer, and do it faster than the mainstream alternatives industry picks over and over again by default.

I've found, however, that talking about typing, or monads, or pure functional programming only causes the eyes to glaze.

What lights a fire in management's eyes? When you rescue an overdue project, delivering before the deadline, and you educate other workers to be as productive ... perhaps not writing Haskell themselves (I've been asked: "Is it like Pascal?" ... and that's after a code walkthrough), but using the tools you've used to deliver these 'tremendous' results, and earning their trust that when you say, 'just let me write a Haskell script to do that: I'll take a day to write it, and we'll start getting results right away,' that that is actually what happens. I've found that 'we should use Haskell because of [all the wonderful arguments put forward]' does not convince anybody. Delivering 'incredible' and 'impossible' results, significantly faster than anticipated (two days instead of two months for the XML project)? That moves mountains.

Where I work, Haskell is installed on two lead developer's systems other than my own, and I'm given permission to code in Haskell, on a 'we only allow Language X' project.

Other Uses



So attributed variables can be used to help one solve kakuro puzzles, or to write a sudoku solver. Fine.

And I've been inching my way toward attributed variables, so it can be applied to symbolic logic puzzles as well, replacing my Whatever type with attributed variables over the enumerated domain.

So the domain is not restricted to Number, but these are not very interesting or pragmatic examples in and of themselves. Not very gripping.

So how about this example?

*Stocks> makeAttribute [Buy, Sell, Hold]

with Constraints being input feeds filtered through weighted moving averages and other indicators. Now this is a system of keen interest for me and 'currently under active and intense research.'

Will such a system work or not work? I'm not at liberty to say,[9] but here is an area that appears to fit well in the language space of constraint programming.

As problem spaces attacked by software projects — workflow analysis, data mining, planning and scheduling, budgeting, forecasting, (war)gaming, modelling and simulation — many seem good candidates to use constraint-based reasoning. Attributed variables give Haskell programmers another way to express these problem domains.



Endnotes:



[1] Y’all don’t mind if I speak logically, and in the logic-programming paradigm, do you?

[2] See my article in The Monad.Reader, issue 11, “MonadPlus: What a Super Monad!” for an implementation of choose, et al.

[3] No, I’m not speaking disparagingly of the monadic programming style. I rather like that style, and use it in my domain language of predicate logic that I layer on top of ‘regular’ Haskell programming. The beauty of monads, for me, is that they are invisible (in coding them) and powerful (in their effect). When the code becomes more about monads and less of what they are there to do is when I see this as an opportunity to examine things in a different light.

[4] http://www.swi-prolog.org/pldoc/doc_for?object=section(2,'6.1',swi('/doc/Manual/attvar.html'))

[5] My representation of Domain is straightforward and workable for most cases, but it hides more than a few compromises (or 'sell-outs') beneath the surface. For example, it makes the (gross) assumption that the range of the domain is enumerable. If Domain is in ℜ that no longer holds (at all), so then Domain shouldn't have a list representation but a pair (or bookending) bounds. But then what if Domain extends beyond ℜ and goes into the surreal numbers?[6] Then we have infintesimals such as '*' (pron: 'star') where:

* > 0, * < 0, * + * = 0

and:

* || 0 (that is: 'star' is incomparable to 0)

So how does one bounds-check on incomparables?

But these concerns are, in the main, not ones to lose one's head over. For the most part, simple linear programming solves a vast majority of the World's problems,[7] and those interesting cases are exactly that: interesting cases.

[6] http://en.wikipedia.org/wiki/Surreal_number

[7] The preface of How to Solve It: Modern Heuristics by Zbigniew Michalewicz and David B. Fogel makes this assertion, from hard-won experience in the field. Seconded.

[8] This is one approach to attributed variables, that is: constraints or attributes are applied to the variable over the domain until it is reduced to a single value, at which point the constraints and even the domain become superfluous and simply go away. An advantage to this approach is that a test for groundedness becomes trivial. A disadvantage is that once grounded one loses the path or information that got one there except through the data flow through the algorithm (the stack trace, as it were). Another disadvantage is that an attributed variable, once grounded, automatically rejects constraints. This may lead to unexpected program behavior, because AV grounded to 5 with a new constraint of x > 23 should fail, but my implementation forwards the 5 value in a success state.

[9] An audit trail of at least a year of data is necessary before any claims can be made.

Wednesday, August 27, 2008

Ten = 1+2+3+4

Daniel Lyons on his blog, showed us how to how to arith our way to 10 in Prolog using the operations of addition, subtraction, multiplication, and division and the numbers 1, 2, 3, and 4. A straightforward logic program, which I was hoping to duplicate the feel of in Haskell. Here's my go at it.
> module Ten where

> import Control.Monad
> import Data.List
> import Smullyan


I suppose the standard way people going about enumerating the arithmetic operations is to encode it in the following way ...
> {-
> data BinaryOp = Plus | Minus | Div | Times deriving Eq

> op :: BinaryOp → Int → Int → Maybe Int
> op Plus b a = Just $ a + b
> op Minus b a = Just $ a - b
> op Times b a = Just $ a * b
> op Div b a = if b ≡ 0 ∨ a `rem` b ≠ 0
> then Nothing
> else Just (a `div` b)

> instance Show BinaryOp where
> show Plus = "+"
> show Minus = "-"
> show Div = "/"
> show Times = "x"
> -}


... but I shied away from that approach for two reasons: first and foremost, we have a disjoint type with enumerated values, but later we are going to choose from those enumerated values from a list of all those values. It seems to me to be wastefully redundant to enumerate the values of the type in its declaration, and then be required to enumerate those values again in their use. Wastefully redundant and dangerous — the type guarantees that I will not use values outside the type, but how can I guarantee that I've used all the values of the type in the program? I'm mean, of course, besides full coverage using a dependently typed system, that is.

So instead of the above commented out code, I chose the following type definition:
> data BinaryOp = Op (Int → Int → Int) String


This type has the advantage that the arithmetic operation is embedded in the type itself, as well as showing and equality:
> instance Eq BinaryOp where
> (Op _ a) ≡ (Op _ b) = a ≡ b

> instance Show BinaryOp where
> show (Op _ s) = s

> op :: BinaryOp → Int → Int → Maybe Int
> op (Op f s) b a | s ≡ "/" = if b ≡ 0 ∨ a `rem` b ≠ 0
> then Nothing
> else Just (a `div` b)
> | otherwise = Just $ f a b


I know that some of you are going to be raising your eyebrows in disbelief: I've forsaken a pure and dependable, or compile-time, way to distinguish operations with a very weak string, or runtime, representation. The former is "just the way it makes sense" for most; the latter, my "sensible" compromise, sacrificing type safety for a more declarative representation. Again, if we had dependent types, I think there would be a type-safe way to represent arithmetic operators as comparable (distinct) and showable types ... dependent types for Haskell', anyone?

Okay, now we need to write permute, because this isn't C++ or Java. *sigh* That's correct, you heard it here first: Java and C++ are way better programming languages because they have permute in their standard libraries, and Haskell does not.
> permute :: Eq a ⇒ [a] → [[a]]
> permute list@(h:t) = [x:rest | x ∈ list,
> rest ∈ permute (list \\ [x])]
> permute [] = [[]]


And from that the solver simply follows: it's the permutation of the row of numbers matched with any arbitrary (ambiguous) arithmetic operation. This has the flavor of the days when I was writing code in MMSForth, push the numbers on the stack and then call the operators. Oh, JOY! (I'll stop now.)
> solver = [twiner perms [op1, op2, op3] |
> perms@[a,b,c,d] ∈ permute [1..4],
> op1 ∈ amb, op2 ∈ amb, op3 ∈ amb,
> ((op op1 b a >>= op op2 c >>= op op3 d)
> ≡ Just 10)]

> amb = [Op (+) "+", Op (*) "x", Op div "/", Op (-) "-"]


So, all we need is the display mechanic (twiner) to intersperse the arithmetic operators between the provided numbers. I had started down this path ...
> stringIt :: BinaryOp → Int → String → String
> stringIt op num acc = "(" ++ acc ++ show op ++ show num ++ ")"

> twiner :: [Int] → [BinaryOp] → String
> {-
> twiner args ops = doTwine args ops True ""
> where doTwine args ops binary acc | binary =
> let (arg1, rest) = (head args, tail args)
> (arg2, done) = (head rest, tail rest)
> in doTwine done (tail ops) False
> (stringIt (head ops) arg2 (show arg1))
> | ops == [] = acc
> | otherwise =
> doTwine (tail args) (tail ops) False
> (stringIt (head ops) (head args) acc)
> -}


... looking longingly at intersperse in the Data.List module (why, oh, why! can't they have intersperse take a state-function argument? Oh, because I would be the only person using it?), but, I figured, as I have already reinvented takeWhile, I had better not reinvent zipWith here:
> twiner (h:r) ops = foldl t (show h) (doTwine r)
> where doTwine args = zipWith (c stringIt) args ops


... *ahem* dependent types would guarantee that twiner is never called with an empty list of arguments.

I'd say my Haskell version follows in the spirit of the Prolog version in that it uses nondeterminism (of the Maybe and list MonadPlus types) to select the true equations. Weighing in at 18 lines of type declarations and code (with 4 additional lines for the module declaration and the imports), it is also about the same size as the Prolog version as well.

Goodness! Typeful logic programming in Haskell, with all the functional frosting on the cake applied for free, costs no more than developing a Prolog program, and along with the type-safety, it also carries with it the flavor and the feel of logic programming in Prolog as well.

Wednesday, May 28, 2008

Composing functions with Arrows

The Arrow class in Haskell is a generalization of the Monad class. Whereas a Monad type contains a value, and therefore is often used to represent state (in that the value captures the output of a function), an Arrow type represents the entire function, capturing both its inputs and outputs.

This is very Prolog-y. In Prolog, there are no functions, per se: the procedure's parameters (both input and output, if the procedure has any) are explicit in the declaration.1 It's this total control of the procedure's environment that makes writing, e.g., aspects for Prolog a trivial exercise.

With Arrows, Haskell, which has always been friendly to function composition, receives another way of controlling data flow and composing functions. This topic is broad, diverse and general, and I am just starting down the path of exploring the Arrow class, so this entry will concentrate on only one aspect of the Arrow class, that is data flow through a composed arrow.

The problem comes up often enough: one wishes to dispatch some input through different functions and then marry the results for disposition by another function (if this sounds like neural nets or circuits, that's because those systems do just that). The usual way of going about this work is for the programmer to shepherd the data as it flows from function to function. However, the Arrow protocol provides tools to automate this shepherding. To provide a specific example of the above described problem, we will use problem 54 from Project Euler to illustrate: which hand of poker wins (with the problem statement listing the rules of what makes a hand of poker and the ranking of hands)?

To see which hand wins, first the hands must be classified to their type: high card, pair, two pairs, three of a kind, straight, flush, full house, four of a kind, straight flush and royal flush. We will concentrate on hands that are straights, flushes, straight flushes and royal flushes.2

Given a hand is a list of cards of the following type ...

data Face =  Jack | Queen | King | Ace deriving (Eq, Ord, Enum)
data N = Two | Three | Four | Five | Six | Seven | Eight
| Nine | Ten deriving (Eq, Ord, Enum)
data Rank = N N | Face Face deriving (Eq, Ord)

data Suit = Diamonds | Clubs | Spades | Hearts deriving Eq

data Card = Card Rank Suit deriving Eq3


... and cards are typed as follows ...

data HighCard = High Rank deriving (Eq, Ord)

data Type = [...]
| Straight HighCard
| Flush HighCard Rank Rank Rank Rank
[...]
| StraightFlush HighCard
| RoyalFlush deriving (Eq, Ord)


... and the cards are ranked in descending order, seeing if a hand is a straight is simply a check to see if all cards are a run:

run :: MonadPlus m ⇒ [Card] → m HighCard
run (Card rank _:cards)
= High rank |- descending (value rank)
(map value cards)
where descending _ [] = True
descending x (card:t) = x - 1 ≡ card
∧ descending card t


... where the value returns the value (of the rank) of the card (Two ≡ 2, Three ≡ 3, ..., King ≡ 12, Ace ≡ 13), and the |- function [pron: "implied by"] converts a value to its MonadPlus equivalent based on the result of a predicate:

(|-) :: MonadPlus m ⇒ a → Bool → m a
x |- p | p = return x
| otherwise = mzero


A flush is a hand that has all cards of the same suit ...

sameSuit :: MonadPlus m ⇒ [Card] → m Suit
sameSuit (Card _ suit:cards) = suit |- all inSuit cards
where inSuit (Card _ s) = s ≡ suit


... or in the mode of sameSuit a flush is a hand where every other card has the same suit as the first card.

So now we have functions that determine if a hand is a flush or if its a straight. Now, during the discussion, you may have been wondering at the return type of these functions. Why not simply return a truth value, as these are predicates on straights and flushes? If these functions simply tested only for straights and flushes (mutually-) exclusively, the return type of Bool is most appropriate, but we intent to use these tests for more than just that: we will be using these simple functions to build our tests for straight flushes and royal flushes, and their return types help in that eventuality.

The strength of the Arrow class comes into its own in the following development, as well.

First off, what are straight flushes and royal flushes, conceptually? A straight flush is a straight in the same suit with a discriminating high card (for, after all, 109876 beats 76543). A royal flush is a straight flush with an ace as the high card. Now it is clear that the return type of the test functions above need more information than what Bool conveys.

So, we need to process the hand through both run and sameSuit, obtaining positive results from both functions, and we need to retrieve the result from run either to ensure the hand is a royal flush (because the high card must be an ace) or to fix the value of the straight flush. The Arrow protocol has function, &&& [pron. "fan-out"] that splits an input and sends it off to two Arrow types for separate processing, so to determine a straight flush we start the test with ...

run &&& straight


... which gives the following results (with the Maybe type selected to represent the particular MonadPlus):


















AKQJ10 (Just (Face Ace), Just (Suit Spades))
AKQJ10 (Just (Face Ace), Nothing)
AK762 (Nothing, Just (Suit Spades))
QQQ44 (Nothing, Nothing)



Now that we have those results (in the form of a tuple pair), we need simply to perform a logical-and over the different values to obtain a conjoined truth result and to retrieve the high card's value to determine the "blue-blooded"ness of the straight flush.

That solution gives us two problems to deal with:


  1. I'm not aware of a logical-and operation for the MonadPlus types; but that doesn't matter because:

  2. We're working with two different types of MonadPlus type values anyway.



So, I rolled my own conjunctive function, favoring the result of the run, given both tests resolve positively:

mand :: Monad m ⇒ m a → m b → m a
x `mand` y = y >> x >>= return


Given the above definition of mand and introducing the composition function of the Arrow protocol, >>>, we can now write the computation that determines a straight flush and returns its high card:

run &&& sameSuit >>> uncurry mand


In fact, this pattern: f &&& g >>> uncurry mand4 neatly captures the logic programming paradigm of goal-seeking via conjunction, so it deserves it's own apt abstraction:

conjoin :: Monad m ⇒ (a → m b) → (a → m c) → a → m b
conjoin f g = f &&& g >>> uncurry mand


So, now we have the tools available to discriminate a hand's type along the straight or royal flush -- the straight flush simply returns the type with the high card value ...

straightFlush :: [Card] → Maybe Type
straightFlush hand = (run `conjoin` sameSuit) hand >>=
return . StraightFlush


... and a royal flush is a straight flush with a guaranteed high ace:

royalFlush :: [Card] → Maybe Type
royalFlush hand = straightFlush hand >>= highAce
where highAce kind
= RoyalFlush |- kind ≡ StraightFlush (High (Face Ace))


Note the complementary rôles of conjoin and >>= [pron. bind]: conjoin marries two truth values (emphasizing the first), and >>= forwards a truth value for disposition. Due to the monadic nature of these functions, a false result (or failure) at any point in the computation aborts it, so these nondeterministic functions are very well-behaved: what is returned is either Just a straight flush or a royal flush if and only if every test is true along the way, or Nothing if even a single test fails.

In summary, this particular aspect of the Arrow protocol that captures the totality of functions and simplifies the control of data flow gives a particularly powerful and flexible set of tools to the user, combining this flexibility with (Arrow) composition and the existing Monad and MonadPlus facilities allows a programming style as simple, declarative and powerful as the logic-programming paradigm.






















1 Further distancing Prolog procedures from Haskell functions, the outcome of a procedure is not an "output" but its validity, or truth value -- how very un-Haskell-y!
2 But seriously! A royal flush? How many of you have every drawn that hand? There should be some special rule for drawing a royal flush, like: you get a life-time supply of marzipan loaded into the trunk of your brand new Bentley parked at your vacation home in St. Croix.
3 Note that in poker there is no precedence of suits (unlike in other card games, like Contract Bridge), so Suit is not an Ord type. This means, that since the Card type contains a Suit value, it, too, is not ordered ... if it were, then the situation would arise where a high card hand of 109... would lose to a high card hand of 106... which is patently not within the rules of poker.
4 In fact, the pattern foo &&& bar >>> uncurry quux deserves and has its own article which very prettily describes and illustrates graphically what this pattern does.

Friday, May 16, 2008

Guarded Choice with MonadPlus

In the previous article, I introduced the MonadPlus class and three examples of monads that allow for non-determinism in programming (Maybe and the list data type, both of which are MonadPlus types and Either, which can be coerced into a MonadPlus type). These types were introduced, but besides showing (unexplained) examples and minimal explanation of the Maybe lookup example, there is not much there to show how to program in a declarative nondeterministic manner. Let's rectify that. First, we'll show how to program nondeterministically and narrow the options down with guard. We will be using the standard nondeterministic "Hello, world!" problem, that is: solving the cryptarithmetic problem ...
SEND + MORE = MONEY

... by iteratively improving the efficiency of the solution.

First up, list compression is a powerfully expressive programming technique that so naturally embodies the nondeterministic programming style that users often don't know they are programming nondeterministically. List compression is of the form:

[ x | qualifiers on x]
where x represent each element of the generated list, and the qualifiers either generate or constraint values for x


Given the above definition of list compression, writing the solution for our cryptarithmetic problem becomes almost as simple as writing the problem itself:

[(s,e,n,d,m,o,r,e,m,o,n,e,y) | s ← digit, e ← digit, n ← digit,
d ← digit, m ← digit, o ← digit,
r ← digit, y ← digit,
s * 1000 + e * 100 + n * 10 + d
+ m * 1000 + o * 100 + r * 10 + e
≡ m * 10000 + o * 1000 + n * 100
+ e * 10 + y]
where digit = [0..9]


Easy, but when run, we see that it's not really what we needed for the answer is ...

[(0,0,0,0,0,0,0,0,0,0,0,0,0),(0,0,0,1,0,0,0,0,0,0,0,0,1),...]


... and 1153 others. No, we wish to have SEND + MORE = MONEY such that S and M aren't zero and that all the letters represented different digits, not, as was in the case of the first solution, all the same digit (0). Well, whereas we humans can take some obvious constraints by implication, software must be explicit, so we need to code that S and M are strictly positive (meaning, "greater than zero") and that all the letters are different from each other. Doing that, we arrive at the more complicated, but correct, following solution ...

[(s,e,n,d,m,o,r,e,m,o,n,e,y) | s ← digit, s > 0,
e ← digit, n ← digit, d ← digit,
m ← digit, m > 0,
o ← digit, r ← digit, y ← digit,
different [s,e,n,d,m,o,r,y],
num [s,e,n,d] + num [m,o,r,e]
≡ num [m,o,n,e,y]]
where digit = [0..9]
num = foldl ((+).(*10)) 0
different (h:t) = diff' h t
diff' x [] = True
diff' x lst@(h:t) = all (/= x) lst && diff' h t


A bit of explanation -- the function num folds the list of digits into a number. Put another way ...

num [s,e,n,d] ≡ ((s * 10 + e) * 10 + n) * 10 + d


... and the function different, via the helper function diff', ensures that every element of the argument list are (not surprisingly) different -- a translation of diff' is ...

diff' x [] = True "A list is 'different' if there is only one number"
diff' x lst@(h:t) = all (≠ x) lst && diff' h t "A list is 'different' if one of the numbers is different than every other number in the list and if this is true for all the numbers in the list"


... and after a prolonged period [434 seconds], it delivers the answer:

[(9,5,6,7,1,0,8,5,1,0,6,5,2)]


Okay! We now have the solution, so we're done, right? Well, yes, if one has all that time to wait for a solution and is willing to do tha waiting. However, I'm of a more impatient nature: the program can be faster; the program must be faster. There are few ways to go about doing this, and they involve providing hints (sometimes answers) to help the program make better choices. We've already done a bit of this with the constraints for both S and M to be positive and adding the requirement that all the letters be different digits. So, presumably, the more hints the computer has, the better and faster it will be in solving this problem.

Knowing the problem better often helps in arriving at a better solution, so let's study the problem again:

 SEND
+MORE
MONEY


The first (highlighted) thing that strikes me is that in MONEY, the M is free-standing -- its value is the carry from the addition of the S from SEND and the M from MORE. Well, what is the greatest value for the carry? If we maximize everything, then the values assigned are 8 and 9, then we find the carry can at most be 1, even if there's carry over (again, of at most 1) from adding the other digits. That means M, since it is not 0, must be 1.

What about for S, can we narrow its value? Yes, of course. Since M is fixed to 1, S must be of a value that carries 1 over to M. That means it is either 9 if there's no carry from addition of the other digits or 8 if there is. Why? Simple: O cannot be 1 (as M has taken that value for itself), so it turns out that there's only one value for O to be: 0! We've fixed two values and limited one letter to one of two values, 8 or 9. Let's provide those constraints ("hints") to the system.

But before we do that, our list compression is growing larger with these additional constraints, so let's unwind into an alternate representation that allows us to view the smaller pieces individually instead of having to swallow the whole pie of the problem in one bite. This alternative representation uses the do-notation, with constraints defined by guards.

A guard is of the following form:

guard :: MonadPlus m ⇒ Bool → m ()



What does that do for us? Recall that MonadPlus kinds have a base value (mzero) representing failure and other values, so guard translates the input Boolean constraint into either mzero (failure) or into a success value. Since the entire monadic computation is chained by mplus, a failure of one test voids that entire branch (because the failure propagates through the entire branch of computation).

So, now we are armed with guard, we rewrite the solution with added constraints in the new do-notation.

do let m = 1
o = 0
s ← digit
guard $ s > 7
e ← digit
n ← digit
d ← digit
r ← digit
y ← digit
guard $ different [s,e,n,d,m,o,r,y]
guard $ num [s,e,n,d] + num [m,o,r,e] ≡ num [m,o,n,e,y]
return (s,e,n,d,m,o,r,e,m,o,n,e,y)
where digit = [2..9]


Besides the obvious structural difference from the initial simple solution, we've introduced some other new things --

  • When fixing a value, we use the let-construct.

  • As we've grounded M and O to 1 and 0 respectively, we've eliminated those options from the digit list.

  • Since the do-notation works with monads in general (it's not restricted to lists only), we need to make explicit our result. We do that with the return function at the end of the block.



What do these changes buy us?

[(9,5,6,7,1,0,8,5,1,0,6,5,2)] returned in 0.4 seconds


One thing one learns quickly when doing logic, nondeterministic, programming is that the sooner a choice is settled correctly, the better. By fixing the values of M and O we entirely eliminate two lines of inquiry but also eliminate two options from all the other following choices, and by refining the guard for S we eliminate all but two options when generating its value.

In nondeterministic programming, elimination is good!


So, we're done, right? Yes, for enhancing performance, once we're in the sub-second territory, it becomes unnecessary for further optimizations. So, in that regard, we are done. But there is some unnecessary redundancy in the above code from a logical perspective -- once we generate a value, we know that we are not going to be generating it again. We know this, but digit, being the amb operator doesn't, regenerating that value, then correcting that discrepancy only later in the computation when it encounters the different guard.

We need the computation to work a bit more like we do, it needs to remember what it already chose and not choose that value again. We've already use memoization when we implemented the Fibonacci sequence and the Ackermann function with the State monad; so let's incorporate that into our generator here.

What we need is for our amb operator to select from the pool of digits, but when it does so, it removes that selected value from the pool. In a logic programming language, such as Prolog, this is accomplished easily enough as nondeterminism and memoization (via difference lists) are part of the language semantics. A clear way of dissecting this particular problem was presented to me by Dirk Thierbach in a forum post on comp.lang.haskell, so I present his approach in full:

  • I need both state and nondeterminism, so I have to combine the state monad and the list monad. This means I need a monad transformer and a monad (you need to have seen this before, but if you have once, it's easy to remember).

  • The state itself also has to be a list (of candidates).

  • So the final monad has type StateT [a] [] b.

  • I need some function to nondeterministically pick a candidate. This function should also update the state.

  • Played around a short time with available functions, didn't get anywhere.

  • Decided I need to go to the "bare metal".

  • Expanded StateT [a] [] a into [a] → [(a,[a])], then it was obvious what choose should do.

  • Decided the required functionality "split a list into one element and rest, in all possible ways" was general enough to deserve its own function.

  • Wrote it down, in the first attempt without accumulator.

  • Wrote it down again, this time using an accumulator.



With this approach presented, writing the implementation simply follows the type declaration:

splits :: Eq a ⇒ [a] → [(a, [a])]
splits list = list >>= λx . return (x, delete x list)


Although, please do note, this implementation differs significantly from Dirk's, they both accomplish the same result. Now we lift this computation into the State monad transformer (transformers are a topic covered much better elsewhere) ...

choose :: StateT [a] [] a
choose = StateT $ λs . splits s


... and then replace the (forgetful) digit generator with the (memoizing) choose (which then eliminates the need for the different guard) to obtain the same result with a slight savings of time [the result returned in 0.04 seconds]. By adding these two new functions and lifting the nondeterminism into the StateT we not only saved an imperceptibly few sub-seconds (my view is optimizing performance on sub-second computations is silly), but, importantly, we eliminated more unnecessary branches at the nondeterministic choice-points.

In summary, this entry has demonstrated how to program with choice using the MonadPlus class. We started with a simple example that demonstrated (naïve) nondeterminism, then improved on that example by pruning branches and options with the guard helper function. Finally, we incorporated the technique of memoization here that we exploited to good effect in other computational efforts to prune away redundant selections. The end result was a program that demonstrated declarative nondeterministic programming not only fits in the (monadic) idiom of functional program but also provides solutions efficiently and within acceptable performance measures.