Easy exhaustive search with the list monad
(Haskell people may want to skip this article about Haskell, because
the technique is wellknown in the Haskell community.)
Suppose you would like to perform an exhaustive search. Let's say for
concreteness that we would like to solve this cryptarithm puzzle:
S E N D
+ M O R E

M O N E Y
This means that we want to map the letters S , E , N , D , M ,
O , R , Y to distinct digits 0 through 9 to produce a fivedigit
and two fourdigit numerals which, when added in the indicated way,
produce the indicated sum.
(This is not an especially difficult example; my 10yearold daughter
Katara was able to solve it, with some assistance, in about 30
minutes.)
If I were doing this in Perl, I would write up either a recursive
descent search or a solution based on a stack or queue of partial
solutions which the program would progressively try to expand to a
full solution, as per the techniques of chapter 5 of HigherOrder
Perl. In Haskell, we can use the list monad to hide all the
searching machinery under the surface. First a few utility functions:
import Control.Monad (guard)
digits = [0..9]
to_number = foldl (\a > \b > a*10 + b) 0
remove rs ls = foldl remove' ls rs
where remove' ls x = filter (/= x) ls
to_number takes a list of digits like [1,4,3] and produces the
number they represent, 143. remove takes two lists and returns all
the things in the second list that are not in the first list. There
is probably a standard library function for this but I don't remember
what it is. This version is !!O(n^2)!!, but who cares.
Now the solution to the problem is:
 S E N D
 + M O R E
 
 M O N E Y
solutions = do
s < remove [0] digits
e < remove [s] digits
n < remove [s,e] digits
d < remove [s,e,n] digits
let send = to_number [s,e,n,d]
m < remove [0,s,e,n,d] digits
o < remove [s,e,n,d,m] digits
r < remove [s,e,n,d,m,o] digits
let more = to_number [m,o,r,e]
y < remove [s,e,n,d,m,o,r] digits
let money = to_number [m,o,n,e,y]
guard $ send + more == money
return (send, more, money)
Let's look at just the first line of this:
solutions = do
s < remove [0] digits
…
The do notation is syntactic sugar for
(remove [0] digits) >>= \s > …
where “…” is the rest of the block. To expand this further, we need
to look at the overloading for >>= which is implemented differently
for every type. The mote on the left of >>= is a list value, and
the definition of >>= for lists is:
concat $ map (\s > …) (remove [0] digits)
where “…” is the rest of the block.
So the variable s is bound to each of 1,2,3,4,5,6,7,8,9 in turn, the
rest of the block is evaluated for each of these nine possible
bindings of s , and the nine returned lists of solutions are combined
(by concat ) into a single list.
The next line is the same:
e < remove [s] digits
for each of the nine possible values for s , we loop over nine value
for e (this time including 0 but not including whatever we chose for
s ) and evaluate the rest of the block. The nine resulting lists of
solutions are concatenated into a single list and returned to the
previous map call.
n < remove [s,e] digits
d < remove [s,e,n] digits
This is two more nested loops.
let send = to_number [s,e,n,d]
At this point the value of send is determined, so we compute and
save it so that we don't have to repeatedly compute it each time
through the following 300 loop executions.
m < remove [0,s,e,n,d] digits
o < remove [s,e,n,d,m] digits
r < remove [s,e,n,d,m,o] digits
let more = to_number [m,o,r,e]
Three more nested loops and another computation.
y < remove [s,e,n,d,m,o,r] digits
let money = to_number [m,o,n,e,y]
Yet another nested loop and a final computation.
guard $ send + more == money
return (send, more, money)
This is the business end. I find guard a little tricky so let's
look at it slowly. There is no binding (< ) in the first line, so
these two lines are composed with >> instead of >>= :
(guard $ send + more == money) >> (return (send, more, money))
which is equivalent to:
(guard $ send + more == money) >>= (\_ > return (send, more, money))
which means that the values in the list returned by guard will be
discarded before the return is evaluated.
If send + more == money is true, the guard expression yields
[()] , a list of one useless item, and then the following >>= loops
over this one useless item, discards it, and returns yields a list
containing the tuple (send, more, money) instead.
But if send + more == money is false, the guard expression yields
[] , a list of zero useless items, and then the following >>= loops
over these zero useless items, never runs return at all, and yields
an empty list.
The result is that if we have found a solution at this point, a list
containing it is returned, to be concatenated into the list of all
solutions that is being constructed by the nested concat s. But if
the sum adds up wrong, an empty list is returned and concat ed
instead.
After a few seconds, Haskell generates and tests 1.36 million choices
for the eight bindings, and produces the unique solution:
[(9567,1085,10652)]
That is:
S E N D 9 5 6 7
+ M O R E + 1 0 8 5
 
M O N E Y 1 0 6 5 2
It would be an interesting and pleasant exercise to try to implement
the same underlying machinery in another language. I tried this in
Perl once, and I found that although it worked perfectly well, between
the lack of the do notation's syntactic sugar and Perl's clumsy
notation for lambda functions (sub { my ($s) = @_; … } instead of
\s > … ) the result was completely unreadable and therefore
unusable. However, I suspect it would be even worse in Python
because of semantic limitations of that language. I would be
interested to hear about this if anyone tries it.
[ Addendum: Thanks to Tony Finch for pointing out the ηreduction I missed while writing this at 3 AM. ]
[ Addendum: Several people so far have misunderstood the question
about Python in the last paragraph. The question was not to implement
an exhaustive search in Python; I had no doubt that it could be done
in a simple and clean way, as it can in Perl. The question was to
implement the same underlying machinery, including the list monad
and its bind operator, and to find the solution using the list
monad.
[ Peter De Wachter has written in with a Python solution that clearly
demonstrates that the problems I was worried about will not arise, at
least for this task. I hope to post his solution in the next few
days. ]
[ Addendum 20150803: De Wachter's solution and one in
Perl ]
[Other articles in category /prog/haskell]
permanent link
