## 145 Puzzle

### April 20, 2010

Consider this math puzzle:

Form all the arithmetic expressions that consist of the digits one through nine, in order, with a plus-sign, a times-sign, or a null character interpolated between each pair of digits; for instance, 12+34*56+7*89 is a valid expression that evaluates to 2539. What number is the most frequent result of evaluating all possible arithmetic expressions formed as described above? How many times does it occur? What are the expressions that evaluate to that result?

Your task is to answer the three questions. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.

[…] Praxis – 145 Puzzle By Remco Niemeijer In today’s Programming Praxis exercise we have to solve a math puzzle. The provided solution is 15 lines, not […]

My Haskell solution (see http://bonsaicode.wordpress.com/2010/04/20/programming-praxis-145-puzzle/ for a version with comments):

From the name of the post, I expected this was the shortest solution.

But here’s a real solution using Python’s eval.

You may be interested in the related “24 puzzle”, as seen on Wikipedia (http://en.wikipedia.org/wiki/24_Game) and as exhaustively enumerated (yes I am not kidding) http://home.manhattan.edu/~peter.boothe/24solutions/

My python version:

“product” returns all the cartesian products of its arguments,

or if the “repeat” keyword is used, the cartesian product of

the first argument repeated that many times.

#!/usr/bin/perl

# Answer: 0 occurs 167 times: 1*2*3*4-5*6+7+8-9 …

use strict;

use warnings;

my %count;

my @symbol = (qw(+ – * /), ”);

foreach my $a (@symbol) {

foreach my $b (@symbol) {

foreach my $c (@symbol) {

foreach my $d (@symbol) {

foreach my $e (@symbol) {

foreach my $f (@symbol) {

foreach my $g (@symbol) {

foreach my $h (@symbol) {

my $expr = join(“”, 1, $a, 2, $b, 3, $c, 4, $d, 5, $e, 6, $f, 7, $g, 8, $h, 9);

my $val = eval $expr;

$count{$val}{$expr} = 1;

}

}}}}}}}

my ($maxval, $maxcount, @maxexprs);

while(my($val, $exprs) = each %count) {

if (keys(%$exprs) > $maxcount) {

$maxval = $val;

$maxcount = keys %$exprs;

@maxexprs = sort keys %$exprs;

}

}

print “$maxval occurs $maxcount times: @maxexprs\n”;

Oops, I didn’t realize subtraction and division weren’t allowed. Just change the line to:

my @symbol = (‘+’, ‘*’, ”);

“Hand made” solution in Haskell, for the sake of the fun of it (I wanted to write the parser *huhu*)

import List

import Control.Monad.State

import Data.Map

data Exp = Num Int | Plus Exp Exp | Mult Exp Exp deriving Show

{-Generate all the expressions-}

gen [] = []

gen [x] = [[x]]

gen (x:xs) = let rest = gen xs in

(List.map (\y -> x:’+’:y) rest)

++

(List.map (\y -> x:’*’:y) rest)

++

(List.map (\y -> x:y) rest)

{-Useful tool-}

conv :: String -> Maybe Exp

conv [] = Nothing

conv xs = (Just . Num . read . reverse) xs

{-Now, the parser for our grammar!-}

— F ::= 0 | 1 | …

f seen = do

l return $ conv seen

(x:xs)->

if (elem x “123456789”)

then

do

put xs

f (x:seen)

else

return $ conv seen

— T ::= F T’

t seen = do

(Just exp) <- f []

r return (Just exp)

(Just exp’) -> return (Just (Mult exp exp’))

— T’ ::= * T | ε

t’ seen = do

l return $ conv seen

(‘*’:xs)-> do

put xs

t seen

otherwise -> return $ conv seen

— E ::= T E’

e seen = do

(Just exp) <- t []

r return (Just exp)

(Just exp’) -> return (Just (Plus exp exp’))

— E’ ::= + E | ε

e’ seen = do

l return $ conv seen

(‘+’:xs)-> do

put xs

e seen

otherwise -> return $ conv seen

— How to eval an Exp

eval’ (Num n) = n

eval’ (Plus e1 e2) = (eval’ e1) + (eval’ e2)

eval’ (Mult e1 e2) = (eval’ e1) * (eval’ e2)

eval x = case x of

(Just exp) -> eval’ exp

Nothing -> -1

{-Well, there must be a cleaner way to do this…-}

old tr k w =

case Data.Map.lookup k tr of

Just (n,v) -> (n+1,w:v)

Nothing -> (1,[w])

main = do

{-All the sentences-}

let parses = gen “123456789”

{-Eval, build a map to store everything-}

let list = toList $ foldl (\tr (ex,str) -> let r = eval ex in Data.Map.insert r (old tr r str) tr) empty $ List.map (\xp ->((evalState (e []) xp),xp)) parses

{-Turn into a list to sort by number of occurences-}

let all = (sortBy (\(_,(a,_)) (_,(b,_)) -> compare a b) list)

{-Print everything if you want to-}

— mapM_ print all

{-The result-}

let (n,(m,l)) = last all

print $ “Number ” ++ (show n) ++ ” appears ” ++ (show m) ++ ” times, and is generated by formulas: ” ++ (show l)

Another solution that does *not* “eval” or do any string-parsing. There must be a more efficient way to implement “foldls” — basically it just enumerates the depth-1 trees that have a given list of leaves — but I’m blanking on it. Any haskellers or schemers to the rescue? :)

You can see it commented at http://steamcode.blogspot.com/2010/05/145-puzzle.html (no highlighting though :( )

My take in ten-odd lines of Ruby: http://gist.github.com/422922