145 Puzzle
April 20, 2010
Our strategy will be to generate the 38 = 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.
Programming Praxis 
[…] 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):
import Control.Applicative import qualified Data.List.Key as K import Text.Parsec exprs :: String -> [String] exprs (x:y:ys) = [x:o++z | o <- ["","+","*"], z <- exprs $ y:ys] exprs xs = [xs] eval :: String -> Int eval = either (const 0) id . parse expr "" where expr = chainl1 term ((+) <$ char '+') term = chainl1 (read <$> many1 digit) ((*) <$ char '*') main :: IO () main = do let mf = K.maximum length . K.group snd . K.sort snd . liftA2 zip id (map eval) $ exprs ['1'..'9'] print (snd $ head mf, length mf) mapM_ putStrLn $ map fst mfFrom the name of the post, I expected this was the shortest solution.
But here’s a real solution using Python’s eval.
from collections import defaultdict def z(s): if len(s) < 2: yield s else: for t in z(s[1:]): for i in ('+', '*', ''): yield s[0] + i + t h = defaultdict(int) for x in z('123456789'): h[eval(x)] += 1 print max(h, key=lambda n: h[n])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.
from collections import defaultdict from itertools import product expr_fmt = "1{0}2{1}3{2}4{3}5{4}6{5}7{6}8{7}9" output_fmt = """\ There are {how_many} expressions that evaluate to {most_freq}. They are: {expression_list} """ value = defaultdict(list) for ops in product( ('','+','*'), repeat=8 ): expression = expr_fmt.format( *ops ) value[ eval( expression ) ].append( expression ) else: most_freq = max( value, key=lambda k: len( value[k] ) ) how_many = len( value[ most_freq ] ) expression_list = '\n\t'.join( value[ most_freq ] ) print output_fmt.format( **locals() )#!/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? :)
from collections import defaultdict from operator import mul def base10(x,y): return 10*x + y def foldls(xs, oper, init): if len(xs) == 0: yield [] else: x = init for k in range(len(xs)): x = oper(x, xs[k]) for tail in foldls(xs[k+1:], oper, init): yield [x] + tail count = defaultdict(int) for numbers in foldls(range(1,9+1), base10, 0): for products in foldls(numbers, mul, 1): count[ sum(products) ] += 1 print "the most common result is", max(count, key=count.get)You can see it commented at http://steamcode.blogspot.com/2010/05/145-puzzle.html (no highlighting though :( )
def mc(elements, level, current=[], &block) elements.each do | e | if level == 1 then yield current << e else mc(elements, level-1, current << e, &block) end current.pop end end digits = ['1', '2', '3', '4', '5', '6', '7', '8', '9'] results = Hash.new() mc(['*', '+', ''], 8) do | operators | # Initialize the string to evaluate. eval_string = '' # Add the digits and operators to the eval_string. 0.upto(digits.length-2) { |i| eval_string << digits[i] << operators[i] } # Add teh final digit. eval_string << digits.last # Evaluate the string and save the result in the hash. Create a new array # if one doesn't exist at this position. (results[eval(eval_string)] ||= []) << eval_string end m = results.max { |a, b| a[1].length <=> b[1].length } puts "Most evaluated number = #{m[0]} Number of times evaluated = #{m[1].length} values = #{m[1]}"My take in ten-odd lines of Ruby: http://gist.github.com/422922