## 145 Puzzle

### April 20, 2010

Our strategy will be to generate the 3^{8} = 6561 possible expressions, evaluate each using the expression evaluator from the previous exercise, and then calculate the requested statistics. Here’s the code to generate the expressions, due to Jos Koot:

`(define (f digits)`

(let loop ((n (string-length digits)) (digits digits))

(if (= n 1) (list digits)

(let

((first-digit (substring digits 0 1))

(other-digits (substring digits 1 n)))

(let ((r (loop (- n 1) other-digits)))

(append

(map (lambda (r) (string-append first-digit r)) r)

(map (lambda (r) (string-append first-digit "+" r)) r)

(map (lambda (r) (string-append first-digit "*" r)) r)))))))

We can find the most common value and the number of its occurrences with a pipeline of functions:

`> (car (sort (lambda (a b) (< (cdr b) (cdr a)))`

(uniq-c = (sort < (map evaluate (f "123456789"))))))

(145 . 12)

The most common value is 145, which appears 12 times. Here is the list:

`> (map car (filter (lambda (x) (= (cdr x) 145))`

(map (lambda (str) (cons str (evaluate str))) (f "123456789"))))

("12+3+45+6+7+8*9" "12+3+4+5*6+7+89" "12+3*4+56+7*8+9"

"1+23+4+5*6+78+9" "1+2+3+4+56+7+8*9" "1+2*34+5+6+7*8+9"

"1+2*3+45+6+78+9" "1*23+4*5+6+7+89" "1*2+34+5*6+7+8*9"

"1*2+3+4+5+6*7+89" "1*2*3+4+56+7+8*9" "1*2*3*4+56+7*8+9")

We used `filter`

and `uniq-c`

from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/SzbrJbjx.

Pages: 1 2

[…] 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