The Universe of Discourse

Easy exhaustive search with the list monad

(Haskell people may want to skip this article about Haskell, because the technique is well-known 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 five-digit and two four-digit numerals which, when added in the indicated way, produce the indicated sum.

(This is not an especially difficult example; my 10-year-old 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 Higher-Order 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 concats. But if the sum adds up wrong, an empty list is returned and concated 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