Send More Money
Today my attention was partially drawn to an article by Mark Dominus, the author of Higher-Order Perl. He pondered on how to write program to solve:
cryptarithms: | S E N D | +) M O R E | ------------- | M O N E Y
The problem is not really hard. However, Mark is impressed by the solution in Haskell:
#---- send_more_money.hs: ---- 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 solutions = do s <- remove  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) main = do print solutions
I am not familiar with Haskell, so I admit I was initially impressed. It took me a while to understand what is going on -- like magic.
do tries each letter over a list of digits;
remove refines the list of choices by removing digits that is already selected, achieving a permutation; and
guard checks the condition when solution is found. A few months ago I wrote an article on Vocabulary Based Programming arguing a new style of programming by leading with vocabularies. In particular, I used the example of
fold in Haskell as an example of what a vocabulary is. But in this example, the vocabulary --
guard -- are hardly good examples. How do they lead to the real code logic of "try each letter" over "list of available digits" until find solution when "condition was met"? In vocabulary based programming, I would write something like:
$tryeach s in digits $tryeach e in remaining_digits ... $tryeach y in remaining_digits $if send+more == money return solution
It will be the exact same code logic as the Haskell example, but would be (much) more intuitive to read and understand, at least for me. So while Mark was inspired by Haskell and tried to create the same machinery (profound and misleading) in Python and Perl, I went ahead tries to write some direct code in Perl, with the help of MyDef:
#---- v1.def: ---- page: v1 module: perl my @digits $(set:prev=digits) &call tryeach, s &call tryeach, e &call tryeach, n &call tryeach, d &call tryeach, m &call tryeach, o &call tryeach, r &call tryeach, y my $send = to_number($s, $e, $n, $d) my $more = to_number($m, $o, $r, $e) my $money = to_number($m, $o, $n, $e, $y) $if $send+$more==$money $print $send + $more = $money exit subcode: tryeach(s) $(set:range=0..9) $(if:s in s,m) $(set:range=1..9) $for $$(s) in $(range) $if !$$(prev)[$$(s)] my @l_$(s) = @$(prev) $l_$(s)[$$(s)] = 1 $(set:prev=l_$(s)) BLOCK fncode: to_number my $t=0 $foreach $a in @_ $t=$t*10+$a return $t
In this version, even as you do not know what MyDef is, since the code was lead by vocabulary "tryeach" as well as the choice of variable names, you could understand the code logic of the main code. The actual implementation of
tryeach subcode is not difficult to read either; all you need to understand is that
$(...) are MyDef macros (functionally the same as C macros) and the code -- with macro substitution -- is simply straight Perl code. In each
tryeach, we inherit a new list of available digits and check off the current selection.
The Haskell version is still shorter or more succinct, but there is code behind the
import. The Perl version contains no hidden magic.
We repeated the
tryeach call eight times and nested them to highlight the actual code logic. In MyDef, there is always someway of DRY (Don't Repeat Yourself):
#---- v2.def: ---- page: v2 module: perl my @digits $(set:prev=digits) $nest tryeach, s, e, n, d, m, o, r, y $if $send+$more==$money $print $send + $more = $money exit subcode: tryeach(s) $(set:range=0..9) $(if:s in s,m) $(set:range=1..9) $foreach $$(s) in $(range) $if !$$(prev)[$$(s)] my @l_$(s) = @$(prev) $l_$(s)[$$(s)] = 1 $(set:prev=l_$(s)) $(if:s=d) my $send = to_number($s, $e, $n, $d) $(elif:s=r) my $more = to_number($m, $o, $r, $e) $(elif:s=y) my $money = to_number($m, $o, $n, $e, $y) BLOCK fncode: to_number my $t=0 $foreach $a in @_ $t=$t*10+$a return $t
You may view the equivalent Perl code in github repository.
It is obvious what
$nest does compared to the previous version. We also moved the
to_number calls from inner loop to outer loop, now it exactly duplicates the code logic in Haskell. Same code logic, but no lambda function, no list monad, no mysterious vocabulary of
guard, no recursive function calls. Topologically, recursive function calls are equivallent to loops, and higher order functions are equivallent to macros. In my view, the latter is often easier to comprehend. The Haskell version is like an intricate machine producing dazzling results until you realize all it does is simply imperative loops, functionally a plain old permutation search.
In Mark Dominus's article, he included code in Python and Perl that implemented the same machinery as Haskell. He also noted down some of his timing information. My working machine is not particularly fast, so I copied his code and timed it on my machine to provide rough comparisons. His functional python code runs for around 5s. That is impressive given that Python was not originally aimed at functional programming. His Perl code runs for around 15.5s. Alas, Perl remains a core imperative language and the gimmicks does not fly well on Perl. I also timed the original Haskell code and it runs for about 1.7s. Haskell compiles to binary, so it won't be a fair comparison. But regardless, the significant speed performance is a reason for Haskell, isn't it?
Before I time my versions of code listed above, I would like to also present a even more intuitive version in Perl: simply try all permutations of digits:
#---- v0.def: ---- include: perl/permutation.def page: v0 module: perl &call permute, 10, 8 my ($s, $e, $n, $d, $m, $o, $r, $y) = @perm $if $s!=0 and $m!=0 my $send = to_number($s,$e,$n,$d) my $more = to_number($m, $o, $r, $e) my $money= to_number($m, $o, $n, $e, $y) $if $send+$more==$money $print $send + $more = $money exit fncode: to_number my $t=0 $foreach $a in @_ $t=$t*10+$a return $t
The compiled equivalent perl code is not so easy to read, but if you prefer, it is here.
Well, the implementation of
permute is not exactly trivial; but let's assume you have such library or implementation (MyDef does), then this will be the most intuitive code logic. Intuitive, but not particularly fast. It runs for around 15s. In addition to the fact that it evaluates the three
to_number calls in the very inner loop, there is also expense in the implementation of permute, which necessarily needs tracking states. It is intuitive, and it is more generic -- you can easily expand the permutation to any amount by simply changing the parameters -- so it is forgivable to be slow.
tryeach version avoids all the extra state tracking by explicitly setting the states in variables, 8 sets of them. It runs for around 5.7s. This is close to the performance of Python (maybe that is the best scripting language can do?).
Finally, I would like to put Haskell's performance in perspective. I implemented a C version:
#---- c0.def: ---- page: c0, basic_frame module: c $nest tryeach, s, e, n, d, m, o, r, y $if send+more==money $print $send + $more = $money return 0 subcode: tryeach(s) $local int $(s), int l_$(s) $for $(s)=0:10 $(if:s in s,m) $if $(s)==0 continue $(if:prev) $if $(prev)[$(s)] continue $for i_$(s)=0:10 $(if:prev) l_$(s)[i_$(s)] = $(prev)[i_$(s)] $(else) l_$(s)[i_$(s)] = 0 l_$(s)[$(s)] = 1 $(set:prev=l_$(s)) $(if:s=d) $call to_number, send, s, e, n, d $(elif:s=r) $call to_number, more, m, o, r, e $(elif:s=y) $call to_number, money, m, o, n, e, y BLOCK subcode: to_number(dest, @plist) $local int $(dest) $(for:p in $(plist)) $(if:_i=0) $(dest)=$(p) $(else) $(dest)=$(dest)*10+$(p)
It is almost the exact transcription from the Perl version, except the
to_number function is implemented using MyDef macro because of C's lacking of arbitrary parameters support. This C code, after compiled, runs on my machine for around 0.2s -- that's right.
Do you see how that with Perl's prototyping, C's performance, and MyDef's refactoring power, I had little incentive to adopt Haskell?
It is a neat puzzle, so let us keep playing around a little longer. I have listed two versions of Perl code above and I should mention that the code
v1 runs for around 9.5s while the code
v2 runs for around 5.5s. The difference is in
v2 we moved some of the
to_number evaluation from the very inner loop to outer loop, as the code logic in the original Haskell version. That is not the best we can do. By sacrificing readability a little, we can do better. For example, let's notice that we can evaluate
mone much earlier than
#---- v3.def: to_number ---- $(if:letter=d) my $send = to_number($s, $e, $n, $d) $(elif:letter=o) my $mone = to_number($m, $o, $n, $e) $(elif:letter=r) my $more = to_number($m, $o, $r, $e) $(elif:letter=y) my $money = $mone*10+$y
This version improves the speed from 5.5s to 3.8s.
m are used more than other letter. Let's move them to the outer loop by rearrange the order of
#---- v4.def: iterate ---- $nest tryeach, m, o, r, e, n, s, d, y $if $send+$more==$money $print $send + $more = $money exit
to_number evaluation need be updated accordingly:
#---- v4.def: to_number ---- $(if:letter=e) my $more = to_number($m, $o, $r, $e) $(elif:letter=n) my $mone = to_number($m, $o, $n, $e) $(elif:letter=d) my $send = to_number($s, $e, $n, $d) $(elif:letter=y) my $money = $mone*10+$y
This is significant as the timing of this version improves to 0.076s. That is 50x times faster. Well, this is more accidental than planned. We moved letter
m to the outer most loop, and it happens to find the answer at "1". We are decrypting numbers so luck does have a lot to do with it. It is still fairly readable thanks to the powerful MyDef's refactoring using
$nest and macro
tryeach. We can do the same thing to the Haskell version, but we need change more as which letters to remove need also be updated along with every change of letter orders.
If you ever tried to solve the puzzle by hand, I bet you first deduced that
m=1. For smart readers out there, I bet they cannot help not to notice that
m=1 at the very beginning. Let's use that knowledge:
#---- v4.def: narrow range ---- $(set:range=0..9) $(if:letter=m) $(set:range=1) $(elif:letter=s) $(set:range=1..9)
Feeling clever, let's check the timing. It runs this time for, ... 0.076s, no change. Of course, we immediately realize that 1 is the first in the range that
m is iterated with in our previous version. Being the right answer skips over all other choices anyway. Unless we guess a number to be 8 or 9, we won't see significant improvement. And luck has it, that the next clue we have is 'S' + 'M' = 'O' plus carry over.
s has to be either '8' or '9'. Let's incorporate that knowledge:
#---- v5.def: narrow range ---- $(set:range=0..9) $(if:letter=m) $(set:range=1) $(elif:letter=s) $(set:range=8..9)
And we better move the better knowledge of 's' to the outer loop as well:
#---- v5.def: iterate ---- $nest tryeach, m, s, o, r, e, n, d, y $if $send+$more==$money $print $send + $more = $money exit
This version runs for, ... 0.1s!
We can keep going, but before long, you will have solved the puzzle entirely by hand! Also squeezing in the 0.1s range is not really as much fun as we had earlier.
Of course the tricks are problem specific. Only the version
v0, the permutation approach, are general. However, all problem we will solve in real life will be specific in some aspect. What's wrong with applying some short cuts here and there? For the least, we had fun, aren't we?