24 game/Solve
From Rosetta Code
< 24 game
You are encouraged to solve this task according to the task description, using any language you may know.
Write a function that given four digits subject to the rules of the 24 game, computes an expression to solve the game if possible.
Show examples of solutions generated by the function
C.F: Arithmetic Evaluator
Contents |
[edit] Argile
Works with: Argile version 1.0.0
die "Please give 4 digits as argument 1\n" if argc < 2
print a function that given four digits argv[1] subject to the rules of \
the _24_ game, computes an expression to solve the game if possible.
use std, array
let digits be an array of 4 byte
let operators be an array of 4 byte
(: reordered arrays :)
let (type of digits) rdigits
let (type of operators) roperators
.: a function that given four digits <text digits> subject to
the rules of the _24_ game, computes an expression to solve
the game if possible. :. -> text
if #digits != 4 {return "[error: need exactly 4 digits]"}
operators[0] = '+' ; operators[1] = '-'
operators[2] = '*' ; operators[3] = '/'
for each (val int d) from 0 to 3
if (digits[d] < '1') || (digits[d] > '9')
return "[error: non-digit character given]"
(super digits)[d] = digits[d]
let expr = for each operand order stuff
return "" if expr is nil
expr
.:for each operand order stuff:. -> text
for each (val int a) from 0 to 3
for each (val int b) from 0 to 3
next if (b == a)
for each (val int c) from 0 to 3
next if (c == b) or (c == a)
for each (val int d) from 0 to 3
next if (d == c) or (d == b) or (d == a)
rdigits[0] = digits[a] ; rdigits[1] = digits[b]
rdigits[2] = digits[c] ; rdigits[3] = digits[d]
let found = for each operator order stuff
return found unless found is nil
nil
.:for each operator order stuff:. -> text
for each (val int i) from 0 to 3
for each (val int j) from 0 to 3
for each (val int k) from 0 to 3
roperators[0] = operators[i]
roperators[1] = operators[j]
roperators[2] = operators[k]
let found = for each RPN pattern stuff
return found if found isn't nil
nil
our (raw array of text) RPN_patterns = Cdata
"xx.x.x."
"xx.xx.."
"xxx..x."
"xxx.x.."
"xxxx..."
our (raw array of text) formats = Cdata
"((%c%c%c)%c%c)%c%c"
"(%c%c%c)%c(%c%c%c)"
"(%c%c(%c%c%c))%c%c"
"%c%c((%c%c%c)%c%c)"
"%c%c(%c%c(%c%c%c))"
our (raw array of array of 3 int) rrop = Cdata
{0;1;2}; {0;2;1}; {1;0;2}; {2;0;1}; {2;1;0}
.:for each RPN pattern stuff:. -> text
let RPN_stack be an array of 4 real
for each (val int rpn) from 0 to 4
let (nat) sp=0, op=0, dg=0.
let text p
for (p = RPN_patterns[rpn]) (*p != 0) (p++)
if *p == 'x'
if sp >= 4 {die "RPN stack overflow\n"}
if dg > 3 {die "RPN digits overflow\n"}
RPN_stack[sp++] = (rdigits[dg++] - '0') as real
if *p == '.'
if sp < 2 {die "RPN stack underflow\n"}
if op > 2 {die "RPN operators overflow\n"}
sp -= 2
let x = RPN_stack[sp]
let y = RPN_stack[sp + 1]
switch roperators[op++]
case '+' {x += y}
case '-' {x -= y}
case '*' {x *= y}
case '/' {x /= y}
default {die "RPN operator unknown\n"}
RPN_stack[sp++] = x
if RPN_stack[0] == 24.0
our array of 12 byte buffer (: 4 paren + 3 ops + 4 digits + null :)
snprintf (buffer as text) (size of buffer) (formats[rpn]) \
(rdigits[0]) (roperators[(rrop[rpn][0])]) (rdigits[1]) \
(roperators[(rrop[rpn][1])]) (rdigits[2]) \
(roperators[(rrop[rpn][2])]) (rdigits[3]);
return buffer as text
nil
Examples:
$ arc 24_game_solve.arg -o 24_game_solve.c $ gcc -Wall 24_game_solve.c -o 24_game_solve $ ./24_game_solve 1234 ((1+2)+3)*4 $ ./24_game_solve 9999 $ ./24_game_solve 5678 ((5+7)-8)*6 $ ./24_game_solve 1127 (1+2)*(1+7)
[edit] Clojure
The code:
(use 'clojure.contrib.combinatorics)
(defn nested-replace [l m]
(cond
(= l '()) '()
(m (first l)) (concat (list (m (first l))) (nested-replace (rest l) m))
(seq? (first l)) (concat (list (nested-replace (first l) m)) (nested-replace (rest l) m))
true (concat (list (first l)) (nested-replace (rest l) m))))
(defn format-solution [sol]
(cond
(number? sol) sol
(seq? sol)
(list (format-solution (second sol)) (first sol) (format-solution (nth sol 2)))))
(defn play24 [& digits] (count (map #(-> % format-solution println)
(let [operator-map-list (map (fn [a] {:op1 (nth a 0) :op2 (nth a 1) :op3 (nth a 2)})
(selections '(* + - /) 3))
digits-map-list
(map (fn [a] {:num1 (nth a 0) :num2 (nth a 1) :num3 (nth a 2) :num4 (nth a 3)})
(permutations digits))
patterns-list (list
'(:op1 (:op2 :num1 :num2) (:op3 :num3 :num4))
'(:op1 :num1 (:op2 :num2 (:op3 :num3 :num4))))
;other patterns can be added here, e.g. '(:op1 (:op2 (:op3 :num1 :num2) :num3) :num4)
op-subbed (reduce concat '()
(map (fn [a] (map #(nested-replace a % ) operator-map-list)) patterns-list))
full-subbed (reduce concat '()
(map (fn [a] (map #(nested-replace % a) op-subbed)) digits-map-list))]
(filter #(= (try (eval %) (catch Exception e nil)) 24) full-subbed)))))
The function play24 works by substituting the given digits and the four operations into the two binary tree patterns (o (o n n) (o n n)) and (o n (o n (o n n))). The substitution is the complex part of the program: two pairs of nested maps (the function) are used to sub in first the operations and then the digits, which are matched into the tree patterns using maps (the datatype.)
Example use:
user=> (play24 5 6 7 8) ((5 + 7) * (8 - 6)) (6 * (5 + (7 - 8))) (6 * (5 - (8 - 7))) (6 * (7 + (5 - 8))) (6 * (7 - (8 - 5))) ((6 * 8) / (7 - 5)) (6 * (8 / (7 - 5))) ((7 + 5) * (8 - 6)) ((8 - 6) * (5 + 7)) ((8 - 6) * (7 + 5)) ((8 * 6) / (7 - 5)) (8 * (6 / (7 - 5))) 12
[edit] Common Lisp
(defconstant +ops+ '(* / + -))
(defun digits ()
(sort (loop repeat 4 collect (1+ (random 9))) #'<))
(defun expr-value (expr)
(eval expr))
(defun divides-by-zero-p (expr)
(when (consp expr)
(destructuring-bind (op &rest args) expr
(or (divides-by-zero-p (car args))
(and (eq op '/)
(or (and (= 1 (length args))
(zerop (expr-value (car args))))
(some (lambda (arg)
(or (divides-by-zero-p arg)
(zerop (expr-value arg))))
(cdr args))))))))
(defun solvable-p (digits &optional expr)
(unless (divides-by-zero-p expr)
(if digits
(destructuring-bind (next &rest rest) digits
(if expr
(some (lambda (op)
(solvable-p rest (cons op (list next expr))))
+ops+)
(solvable-p rest (list (car +ops+) next))))
(when (and expr
(eql 24 (expr-value expr)))
(merge-exprs expr)))))
(defun merge-exprs (expr)
(if (atom expr)
expr
(destructuring-bind (op &rest args) expr
(if (and (member op '(* +))
(= 1 (length args)))
(car args)
(cons op
(case op
((* +)
(loop for arg in args
for merged = (merge-exprs arg)
when (and (consp merged)
(eq op (car merged)))
append (cdr merged)
else collect merged))
(t (mapcar #'merge-exprs args))))))))
(defun solve-24-game (digits)
"Generate a lisp form using the operators in +ops+ and the given
digits which evaluates to 24. The first form found is returned, or
NIL if there is no solution."
(solvable-p digits))
Example Output:
CL-USER 138 > (loop repeat 24 for soln = (solve-24-game (digits)) when soln do (pprint soln)) (+ 7 5 (* 4 3)) (* 6 4 (- 3 2)) (+ 9 8 4 3) (* 8 (- 6 (* 3 1))) (* 6 4 (/ 2 2)) (* 9 (/ 8 (- 8 5))) NIL
[edit] Haskell
import Data.List
import Data.Ratio
import Control.Monad
import System.Environment (getArgs)
data Expr = Constant Rational |
Expr :+ Expr | Expr :- Expr |
Expr :* Expr | Expr :/ Expr
deriving (Eq)
ops = [(:+), (:-), (:*), (:/)]
instance Show Expr where
show (Constant x) = show $ numerator x
-- In this program, we need only print integers.
show (a :+ b) = strexp "+" a b
show (a :- b) = strexp "-" a b
show (a :* b) = strexp "*" a b
show (a :/ b) = strexp "/" a b
strexp :: String -> Expr -> Expr -> String
strexp op a b = "(" ++ show a ++ " " ++ op ++ " " ++ show b ++ ")"
templates :: [[Expr] -> Expr]
templates = do
op1 <- ops
op2 <- ops
op3 <- ops
[\[a, b, c, d] -> op1 a $ op2 b $ op3 c d,
\[a, b, c, d] -> op1 (op2 a b) $ op3 c d,
\[a, b, c, d] -> op1 a $ op2 (op3 b c) d,
\[a, b, c, d] -> op1 (op2 a $ op3 b c) d,
\[a, b, c, d] -> op1 (op2 (op3 a b) c) d]
eval :: Expr -> Maybe Rational
eval (Constant c) = Just c
eval (a :+ b) = liftM2 (+) (eval a) (eval b)
eval (a :- b) = liftM2 (-) (eval a) (eval b)
eval (a :* b) = liftM2 (*) (eval a) (eval b)
eval (a :/ b) = do
denom <- eval b
guard $ denom /= 0
liftM (/ denom) $ eval a
solve :: Rational -> [Rational] -> [Expr]
solve target r4 = filter (maybe False (== target) . eval) $
liftM2 ($) templates $
nub $ permutations $ map Constant r4
main = getArgs >>= mapM_ print . solve 24 . map (toEnum . read)
Example use:
$ runghc 24Player.hs 2 3 8 9 (8 * (9 - (3 * 2))) (8 * (9 - (2 * 3))) ((9 - (2 * 3)) * 8) ((9 - (3 * 2)) * 8) ((9 - 3) * (8 / 2)) ((8 / 2) * (9 - 3)) (8 * ((9 - 3) / 2)) (((9 - 3) / 2) * 8) ((9 - 3) / (2 / 8)) ((8 * (9 - 3)) / 2) (((9 - 3) * 8) / 2) (8 / (2 / (9 - 3)))
[edit] J
perm=: (A.&i.~ !) 4
ops=: ' ',.'+-*%' {~ >,{i.each 4 4 4
cmask=: 1 + 0j1 * i.@{:@$@[ e. ]
left=: [ #!.'('~"1 cmask
right=: [ #!.')'~"1 cmask
paren=: 2 :'[: left&m right&n'
parens=: ], 0 paren 3, 0 paren 5, 2 paren 5, [: 0 paren 7 (0 paren 3)
all=: [: parens [:,/ ops ,@,."1/ perm { [:;":each
answer=: ({.@#~ 24 = ".)@all
This implementation tests all 7680 candidate sentences.
Example use:
answer 2 3 5 7 2+7+3*5 answer 8 4 7 1 8*7-4*1 answer 1 1 2 7 (1+2)*1+7
The answer will be either a suitable J sentence or blank if none can be found. "J sentence" means that, for example, the sentence 8*7-4*1 is equivalent to the sentence 8*(7-(4*1)). [Many infix languages use operator precedence to make polynomials easier to express without parenthesis, but J has other mechanisms for expressing polynomials and minimal operator precedence makes the language more regular.]
[edit] Mathematica
The code:
treeR[n_] := Table[o[trees[a], trees[n - a]], {a, 1, n - 1}]
treeR[1] := n
tree[n_] :=
Flatten[treeR[n] //. {o[a_List, b_] :> (o[#, b] & /@ a),
o[a_, b_List] :> (o[a, #] & /@ b)}]
game24play[val_List] :=
Union[StringReplace[StringTake[ToString[#, InputForm], {10, -2}],
"-1*" ~~ n_ :> "-" <> n] & /@ (HoldForm /@
Select[Union@
Flatten[Outer[# /. {o[q_Integer] :> #2[[q]],
n[q_] :> #3[[q]]} &,
Block[{O = 1, N = 1}, # /. {o :> o[O++], n :> n[N++]}] & /@
tree[4], Tuples[{Plus, Subtract, Times, Divide}, 3],
Permutations[Array[v, 4]], 1]],
Quiet[(# /. v[q_] :> val[[q]]) == 24] &] /.
Table[v[q] -> val[[q]], {q, 4}])]
The treeR method recursively computes all possible operator trees for a certain number of inputs. It does this by tabling all combinations of distributions of inputs across the possible values. (For example, treeR[4] is allotted 4 inputs, so it returns {o[treeR[3],treeR[1]],o[treeR[2],treeR[2]],o[treeR[1],treeR[3]]}, where o is the operator (generic at this point). The base case treeR[1] returns n (the input). The final output of tree[4] (the 24 game has 4 random inputs) (tree cleans up the output of treeR) is:
{o[n, o[n, o[n, n]]],
o[n, o[o[n, n], n]],
o[o[n, n], o[n, n]],
o[o[n, o[n, n]], n],
o[o[o[n, n], n], n]}
game24play takes the four random numbers as input and does the following (the % refers to code output from previous bullets):
Block[{O = 1, N = 1}, # /. {o :> o[O++], n :> n[N++]}] & /@ tree[4]- Assign ascending numbers to the input and operator placeholders.
- Ex:
o[1][o[2][n[1], n[2]], o[3][n[3], n[4]]]
Tuples[{Plus, Subtract, Times, Divide}, 3]- Find all combinations (
Tuplesallows repeats) of the four allowed operations. - Ex:
{{Plus, Plus, Plus}, {Plus, Plus, Subtract}, <<60>>, {Divide, Divide, Times}, {Divide, Divide, Divide}}
- Find all combinations (
Permutations[Array[v, 4]]- Find all permutations (
Permutationsdoes not allow repeats) of the four given values. - Ex:
{{v[1],v[2],v[3],v[4]}, {v[1],v[2],v[4],v[3]}, <<20>>, {v[4],v[3],v[1],v[2]}, {v[4],v[3],v[2],v[1]}}
- Find all permutations (
Outer[# /. {o[q_Integer] :> #2[[q]], n[q_] :> #3[[q]]} &, %%%, %%, %, 1]- Perform an outer join on the three above lists (every combination of each element) and with each combination put into the first (the operator tree) the second (the operation at each level) and the third (the value indexes, not actual values).
- Ex:
v[1] + v[2] - v[3] + v[4]
Union@Flatten[%]- Get rid of any sublists caused by
Outerand remove any duplicates (Union).
- Get rid of any sublists caused by
Select[%, Quiet[(# /. v[q_] :> val[[q]]) == 24] &]- Select the elements of the above list where substituting the real values returns 24 (and do it
Quietly because of div-0 concerns).
- Select the elements of the above list where substituting the real values returns 24 (and do it
HoldForm /@ % /. Table[v[q] -> val[[q]], {q, 4}]- Apply
HoldFormso that substituting numbers will not cause evaluation (otherwise it would only ever return lists like{24, 24, 24}!) and substitute the numbers in.
- Apply
Union[StringReplace[StringTake[ToString[#, InputForm], {10, -2}], "-1*" ~~ n_ :> "-" <> n] & /@ %]- For each result, turn the expression into a string (for easy manipulation), strip the "
HoldForm" wrapper, replace numbers like "-1*7" with "-7" (a idiosyncrasy of the conversion process), and remove any lingering duplicates. Some duplicates will still remain, notably constructs like "3 - 3" vs. "-3 + 3" and trivially similar expressions like "(8*3)*(6-5)" vs "(8*3)/(6-5)". Example run input and outputs:
- For each result, turn the expression into a string (for easy manipulation), strip the "
RandomInteger[{1, 9}, 4]
game24play[%]
{7, 2, 9, 5}
{-2 - 9 + 7*5}
{7, 5, 6, 2}
{6*(7 - 5 + 2), (7 - 5)*6*2, 7 + 5 + 6*2}
{7, 6, 7, 7}
{}
{3, 7, 6, 1}
{(-3 + 6)*(7 + 1), ((-3 + 7)*6)/1, (-3 + 7)*6*1,
6 - 3*(-7 + 1), 6*(-3 + 7*1), 6*(-3 + 7/1),
6 + 3*(7 - 1), 6*(7 - 3*1), 6*(7 - 3/1), 7 + 3*6 - 1}
Note that although this program is designed to be extensible to higher numbers of inputs, the largest working set in the program (the output of the Outer function can get very large:
tree[n]returns a list with the length being the (n-1)-th Catalan number.Tuples[{Plus, Subtract, Times, Divide}, 3]has fixed length 64 (or p3 for p operations).Permutations[Array[v, n]]returns n! permutations.
Therefore, the size of the working set is 
, where n!!!! is the quadruple factorial. It goes without saying that this number increases very fast. For this game, the total is 7680 elements. For higher numbers of inputs, it is {7 680, 107 520, 1 935 360, 42 577 920, 1 107 025 920, ...}.
[edit] OCaml
type expression =
| Const of float
| Sum of expression * expression (* e1 + e2 *)
| Diff of expression * expression (* e1 - e2 *)
| Prod of expression * expression (* e1 * e2 *)
| Quot of expression * expression (* e1 / e2 *)
let rec eval = function
| Const c -> c
| Sum (f, g) -> eval f +. eval g
| Diff(f, g) -> eval f -. eval g
| Prod(f, g) -> eval f *. eval g
| Quot(f, g) -> eval f /. eval g
let print_expr expr =
let open_paren prec op_prec =
if prec > op_prec then print_string "(" in
let close_paren prec op_prec =
if prec > op_prec then print_string ")" in
let rec print prec expr = (* prec is the current precedence *)
match expr with
| Const c -> Printf.printf "%g" c
| Sum(f, g) ->
open_paren prec 0;
print 0 f; print_string " + "; print 0 g;
close_paren prec 0
| Diff(f, g) ->
open_paren prec 0;
print 0 f; print_string " - "; print 1 g;
close_paren prec 0
| Prod(f, g) ->
open_paren prec 2;
print 2 f; print_string " * "; print 2 g;
close_paren prec 2
| Quot(f, g) ->
open_paren prec 2;
print 2 f; print_string " / "; print 3 g;
close_paren prec 2
in
print 0 expr
let rec insert v li = match li with
| [] -> [[v]]
| x::xs -> (v::li) :: (List.map (fun y -> x::y) (insert v xs))
let rec permutations li = match li with
| x::xs -> List.flatten (List.map (insert x) (permutations xs))
| _ -> [li]
let rec comp expr = function
| x::xs ->
comp (Sum (expr, x)) xs;
comp (Diff(expr, x)) xs;
comp (Prod(expr, x)) xs;
comp (Quot(expr, x)) xs;
| [] ->
if (eval expr) = 24.0
then (print_expr expr; print_newline())
;;
let () =
Random.self_init();
let digits = Array.init 4 (fun _ -> 1 + Random.int 9) in
print_string "Input digits: ";
Array.iter (Printf.printf " %d") digits; print_newline();
let digits = Array.to_list(Array.map float_of_int digits) in
let digits = List.map (fun v -> Const v) digits in
let all = permutations digits in
List.iter (fun this ->
match this with
| x::xs -> comp x xs
| _ -> assert false
) all
Input digits: 5 7 4 1 7 * 4 - 5 + 1 7 * 4 + 1 - 5 4 * 7 - 5 + 1 4 * 7 + 1 - 5 (5 - 1) * 7 - 4
(notice that the printer only puts parenthesis when needed)
[edit] Perl
Will generate all possible solutions of any given four numbers according to the rules of the 24 game.
Note: the permute function was taken from here
# Fischer-Krause ordered permutation generator
# http://faq.perl.org/perlfaq4.html#How_do_I_permute_N_e
sub permute (&@) {
my $code = shift;
my @idx = 0..$#_;
while ( $code->(@_[@idx]) ) {
my $p = $#idx;
--$p while $idx[$p-1] > $idx[$p];
my $q = $p or return;
push @idx, reverse splice @idx, $p;
++$q while $idx[$p-1] > $idx[$q];
@idx[$p-1,$q]=@idx[$q,$p-1];
}
}
@formats = (
'((%d %s %d) %s %d) %s %d',
'(%d %s (%d %s %d)) %s %d',
'(%d %s %d) %s (%d %s %d)',
'%d %s ((%d %s %d) %s %d)',
'%d %s (%d %s (%d %s %d))',
);
# generate all possible combinations of operators
@op = qw( + - * / );
@operators = map{ $a=$_; map{ $b=$_; map{ "$a $b $_" }@op }@op }@op;
while(1)
{
print "Enter four integers or 'q' to exit: ";
chomp($ent = <>);
last if $ent eq 'q';
if($ent !~ /^[1-9] [1-9] [1-9] [1-9]$/){ print "invalid input\n"; next }
@n = split / /,$ent;
permute { push @numbers,join ' ',@_ }@n;
for $format (@formats)
{
for(@numbers)
{
@n = split;
for(@operators)
{
@o = split;
$str = sprintf $format,$n[0],$o[0],$n[1],$o[1],$n[2],$o[2],$n[3];
$r = eval($str);
print "$str\n" if $r == 24;
}
}
}
}
[edit] PicoLisp
We use Pilog (PicoLisp Prolog) to solve this task
(be play24 (@Lst @Expr) # Define Pilog rule
(permute @Lst (@A @B @C @D))
(member @Op1 (+ - * /))
(member @Op2 (+ - * /))
(member @Op3 (+ - * /))
(or
((equal @Expr (@Op1 (@Op2 @A @B) (@Op3 @C @D))))
((equal @Expr (@Op1 @A (@Op2 @B (@Op3 @C @D))))) )
(@ = 24 (catch '("Div/0") (eval (-> @Expr)))) )
(de play24 (A B C D) # Define PicoLisp function
(pilog
(quote
@L (list A B C D)
(play24 @L @X) )
(println @X) ) )
(play24 5 6 7 8) # Call 'play24' function
Output:
(* (+ 5 7) (- 8 6)) (* 6 (+ 5 (- 7 8))) (* 6 (- 5 (- 8 7))) (* 6 (- 5 (/ 8 7))) (* 6 (+ 7 (- 5 8))) (* 6 (- 7 (- 8 5))) (* 6 (/ 8 (- 7 5))) (/ (* 6 8) (- 7 5)) (* (+ 7 5) (- 8 6)) (* (- 8 6) (+ 5 7)) (* (- 8 6) (+ 7 5)) (* 8 (/ 6 (- 7 5))) (/ (* 8 6) (- 7 5))
[edit] Python
The function is called solve, and is integrated into the game player. The docstring of the solve function shows examples of its use when isolated at the Python command line.
'''
The 24 Game Player
Given any four digits in the range 1 to 9, which may have repetitions,
Using just the +, -, *, and / operators; and the possible use of
brackets, (), show how to make an answer of 24.
An answer of "q" will quit the game.
An answer of "!" will generate a new set of four digits.
An answer of "!!" will ask you for a new set of four digits.
An answer of "?" will compute an expression for the current digits.
Otherwise you are repeatedly asked for an expression until it evaluates to 24
Note: you cannot form multiple digit numbers from the supplied digits,
so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed.
'''
from __future__ import division, print_function
from itertools import permutations, combinations, product, \
chain
from pprint import pprint as pp
import random, ast, re
import sys
if sys.version_info[0] < 3:
input = raw_input
from itertools import izip_longest as zip_longest
else:
from itertools import zip_longest
def choose4():
'four random digits >0 as characters'
return [str(random.randint(1,9)) for i in range(4)]
def ask4():
'get four random digits >0 from the plaayer'
digits = ''
while len(digits) != 4 or not all(d in '123456789' for d in digits):
digits = input('Enter the digits to solve for: ')
digits = ''.join(digits.strip().split())
return list(digits)
def welcome(digits):
print (__doc__)
print ("Your four digits: " + ' '.join(digits))
def check(answer, digits):
allowed = set('() +-*/\t'+''.join(digits))
ok = all(ch in allowed for ch in answer) and \
all(digits.count(dig) == answer.count(dig) for dig in set(digits)) \
and not re.search('\d\d', answer)
if ok:
try:
ast.parse(answer)
except:
ok = False
return ok
def solve(digits):
"""\
>>> for digits in '3246 4788 1111 123456 1127'.split():
solve(list(digits))
Solution found: 2 + 3 * 6 + 4
'2 + 3 * 6 + 4'
Solution found: ( 4 + 7 - 8 ) * 8
'( 4 + 7 - 8 ) * 8'
No solution found for: 1 1 1 1
'!'
Solution found: 1 + 2 + 3 * ( 4 + 5 ) - 6
'1 + 2 + 3 * ( 4 + 5 ) - 6'
Solution found: ( 1 + 2 ) * ( 1 + 7 )
'( 1 + 2 ) * ( 1 + 7 )'
>>> """
digilen = len(digits)
# length of an exp without brackets
exprlen = 2 * digilen - 1
# permute all the digits
digiperm = sorted(set(permutations(digits)))
# All the possible operator combinations
opcomb = list(product('+-*/', repeat=digilen-1))
# All the bracket insertion points:
brackets = ( [()] + [(x,y)
for x in range(0, exprlen, 2)
for y in range(x+4, exprlen+2, 2)
if (x,y) != (0,exprlen+1)]
+ [(0, 3+1, 4+2, 7+3)] ) # double brackets case
for d in digiperm:
for ops in opcomb:
ex = list(chain.from_iterable(zip_longest(d, ops, fillvalue='')))
for b in brackets:
exp = ex[::]
for insertpoint, bracket in zip(b, '()'*(len(b)//2)):
exp.insert(insertpoint, bracket)
txt = ''.join(exp)
try:
num = eval(txt)
except ZeroDivisionError:
continue
if num == 24:
ans = ' '.join(exp).rstrip()
print ("Solution found:",ans)
return ans
print ("No solution found for:", ' '.join(digits))
return '!'
def main():
digits = choose4()
welcome(digits)
trial = 0
answer = ''
chk = ans = False
while not (chk and ans == 24):
trial +=1
answer = input("Expression %i: " % trial)
chk = check(answer, digits)
if answer == '?':
solve(digits)
answer = '!'
if answer.lower() == 'q':
break
if answer == '!':
digits = choose4()
trial = 0
print ("\nNew digits:", ' '.join(digits))
continue
if answer == '!!':
digits = ask4()
trial = 0
print ("\nNew digits:", ' '.join(digits))
continue
if not chk:
print ("The input '%s' was wonky!" % answer)
else:
ans = eval(answer)
print (" = ", ans)
if ans == 24:
print ("Thats right!")
print ("Thank you and goodbye")
main()
Sample Output
The 24 Game Player Given any four digits in the range 1 to 9, which may have repetitions, Using just the +, -, *, and / operators; and the possible use of brackets, (), show how to make an answer of 24. An answer of "q" will quit the game. An answer of "!" will generate a new set of four digits. An answer of "?" will compute an expression for the current digits. Otherwise you are repeatedly asked for an expression until it evaluates to 24 Note: you cannot form multiple digit numbers from the supplied digits, so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed. Your four digits: 6 7 9 5 Expression 1: ? Solution found: 6 - ( 5 - 7 ) * 9 Thank you and goodbye
[edit] R
This uses exhaustive search and makes use of R's ability to work with expressions as data. It is in principle general for any set of operands and binary operators.
library(gtools)
solve24 <- function(vals=c(8, 4, 2, 1),
goal=24,
ops=c("+", "-", "*", "/")) {
val.perms <- as.data.frame(t(
permutations(length(vals), length(vals))))
nop <- length(vals)-1
op.perms <- as.data.frame(t(
do.call(expand.grid,
replicate(nop, list(ops)))))
ord.perms <- as.data.frame(t(
do.call(expand.grid,
replicate(n <- nop, 1:((n <<- n-1)+1)))))
for (val.perm in val.perms)
for (op.perm in op.perms)
for (ord.perm in ord.perms)
{
expr <- as.list(vals[val.perm])
for (i in 1:nop) {
expr[[ ord.perm[i] ]] <- call(as.character(op.perm[i]),
expr[[ ord.perm[i] ]],
expr[[ ord.perm[i]+1 ]])
expr <- expr[ -(ord.perm[i]+1) ]
}
if (identical(eval(expr[[1]]), goal)) return(expr[[1]])
}
return(NA)
}
Example Output:
> solve24()
8 * (4 - 2 + 1)
> solve24(c(6,7,9,5))
6 + (7 - 5) * 9
> solve24(c(8,8,8,8))
[1] NA
> solve24(goal=49) #different goal value
8 * (4 + 2) + 1
> solve24(goal=52) #no solution
[1] NA
> solve24(ops=c('-', '/')) #restricted set of operators
(8 - 2)/(1/4)
[edit] Ruby
Translation of: Tcl
require 'rational'
class TwentyFourGamePlayer
EXPRESSIONS = [
'((%d %s %d) %s %d) %s %d',
'(%d %s (%d %s %d)) %s %d',
'(%d %s %d) %s (%d %s %d)',
'%d %s ((%d %s %d) %s %d)',
'%d %s (%d %s (%d %s %d))',
]
OPERATORS = [:+, :-, :*, :/]
@@objective = Rational(24,1)
def initialize(digits)
@digits = digits
@solutions = []
solve
end
attr_reader :digits, :solutions
def solve
digits.permutation.to_a.uniq.each do |a,b,c,d|
OPERATORS.each do |op1|
OPERATORS.each do |op2|
OPERATORS.each do |op3|
EXPRESSIONS.each do |expr|
# evaluate using rational arithmetic
test = expr.gsub('%d', 'Rational(%d,1)') % [a, op1, b, op2, c, op3, d]
value = eval(test) rescue -1 # catch division by zero
if value == @@objective
@solutions << expr % [a, op1, b, op2, c, op3, d]
end
end;end;end;end
end
end
end
# validate user input
digits = ARGV.map do |arg|
begin
Integer(arg)
rescue ArgumentError
raise "error: not an integer: '#{arg}'"
end
end
digits.size == 4 or raise "error: need 4 digits, only have #{digits.size}"
player = TwentyFourGamePlayer.new(digits)
if player.solutions.empty?
puts "no solutions"
else
puts "found #{player.solutions.size} solutions, including #{player.solutions.first}"
puts player.solutions.sort.join("\n")
end
Sample output:
$ ruby 24game.player.rb 1 1 1 1 no solutions $ ruby 24game.player.rb 1 1 2 7 found 8 solutions, including (1 + 2) * (1 + 7) (1 + 2) * (1 + 7) (1 + 2) * (7 + 1) (1 + 7) * (1 + 2) (1 + 7) * (2 + 1) (2 + 1) * (1 + 7) (2 + 1) * (7 + 1) (7 + 1) * (1 + 2) (7 + 1) * (2 + 1) $ ruby 24game.player.rb 2 3 8 9 found 12 solutions, including (8 / 2) * (9 - 3) ((9 - 3) * 8) / 2 ((9 - 3) / 2) * 8 (8 * (9 - 3)) / 2 (8 / 2) * (9 - 3) (9 - (2 * 3)) * 8 (9 - (3 * 2)) * 8 (9 - 3) * (8 / 2) (9 - 3) / (2 / 8) 8 * ((9 - 3) / 2) 8 * (9 - (2 * 3)) 8 * (9 - (3 * 2)) 8 / (2 / (9 - 3))
[edit] Scala
A non-interactive player.
def permute(l: List[Double]): List[List[Double]] = l match {
case Nil => List(Nil)
case x :: xs =>
for {
ys <- permute(xs)
position <- 0 to ys.length
(left, right) = ys splitAt position
} yield left ::: (x :: right)
}
def computeAllOperations(l: List[Double]): List[(Double,String)] = l match {
case Nil => Nil
case x :: Nil => List((x, "%1.0f" format x))
case x :: xs =>
for {
(y, ops) <- computeAllOperations(xs)
(z, op) <-
if (y == 0)
List((x*y, "*"), (x+y, "+"), (x-y, "(-"))
else
List((x*y, "*"), (x/y, "/"), (x+y, "+"), (x-y, "-"))
} yield (z, "(%1.0f%s%s)" format (x,op,ops))
}
def hasSolution(l: List[Double]) = permute(l) flatMap computeAllOperations filter (_._1 == 24) map (_._2)
Example:
val problemsIterator = (
Iterator
continually List.fill(4)(scala.util.Random.nextInt(9) + 1 toDouble)
filter (!hasSolution(_).isEmpty)
)
val solutionIterator = problemsIterator map hasSolution
scala> solutionIterator.next
res8: List[String] = List((3*(5-(3-6))), (3*(5-(3-6))), (3*(5+(6-3))), (3+(6+(3*5))), (3*(6-(3-5))), (3+(6+(5*3))), (3*(
6+(5-3))), (3*(5+(6-3))), (3+(6+(5*3))), (3*(6+(5-3))), (6+(3+(5*3))), (6*(5-(3/3))), (6*(5-(3/3))), (3+(6+(3*5))), (3*(
6-(3-5))), (6+(3+(3*5))), (6+(3+(3*5))), (6+(3+(5*3))))
scala> solutionIterator.next
res9: List[String] = List((4-(5*(5-9))), (4-(5*(5-9))), (4+(5*(9-5))), (4+(5*(9-5))), (9-(5-(4*5))), (9-(5-(5*4))), (9-(
5-(4*5))), (9-(5-(5*4))))
scala> solutionIterator.next
res10: List[String] = List((2*(4+(3+5))), (2*(3+(4+5))), (2*(3+(5+4))), (4*(3-(2-5))), (4*(3+(5-2))), (2*(4+(5+3))), (2*
(5+(4+3))), (2*(5+(3+4))), (4*(5-(2-3))), (4*(5+(3-2))))
scala> solutionIterator.next
res11: List[String] = List((4*(5-(2-3))), (2*(4+(5+3))), (2*(5+(4+3))), (2*(5+(3+4))), (2*(4+(3+5))), (2*(3+(4+5))), (2*
(3+(5+4))), (4*(5+(3-2))), (4*(3+(5-2))), (4*(3-(2-5))))
[edit] Tcl
This is a complete Tcl script, intended to be invoked from the command line.
Library: tcllib
package require struct::list
# Encoding the various expression trees that are possible
set patterns {
{((A x B) y C) z D}
{(A x (B y C)) z D}
{(A x B) y (C z D)}
{A x ((B y C) z D)}
{A x (B y (C z D))}
}
# Encoding the various permutations of digits
set permutations [struct::list map [struct::list permutations {a b c d}] \
{apply {v {lassign $v a b c d; list A $a B $b C $c D $d}}}]
# The permitted operations
set operations {+ - * /}
# Given a list of four integers (precondition not checked!) return a list of
# solutions to the 24 game using those four integers.
proc find24GameSolutions {values} {
global operations patterns permutations
set found {}
# For each possible structure with numbers at the leaves...
foreach pattern $patterns {
foreach permutation $permutations {
set p [string map [subst {
a [lindex $values 0].0
b [lindex $values 1].0
c [lindex $values 2].0
d [lindex $values 3].0
}] [string map $permutation $pattern]]
# For each possible structure with operators at the branches...
foreach x $operations {
foreach y $operations {
foreach z $operations {
set e [string map [subst {x $x y $y z $z}] $p]
# Try to evaluate (div-zero is an issue!) and add it to
# the result if it is 24
catch {
if {[expr $e] == 24.0} {
lappend found [string map {.0 {}} $e]
}
}
}
}
}
}
}
return $found
}
# Wrap the solution finder into a player
proc print24GameSolutionFor {values} {
set found [lsort -unique [find24GameSolutions $values]]
if {![llength $found]} {
puts "No solution possible"
} else {
puts "Total [llength $found] solutions (may include logical duplicates)"
puts "First solution: [lindex $found 0]"
}
}
print24GameSolutionFor $argv
Demonstrating it in use:
bash$ tclsh8.4 24player.tcl 3 2 8 9 Total 12 solutions (may include logical duplicates) First solution: ((9 - 3) * 8) / 2 bash$ tclsh8.4 24player.tcl 1 1 2 7 Total 8 solutions (may include logical duplicates) First solution: (1 + 2) * (1 + 7) bash$ tclsh8.4 24player.tcl 1 1 1 1 No solution possible
[edit] Ursala
This uses exhaustive search and exact rational arithmetic to enumerate all solutions. The algorithms accommodate data sets with any number of digits and any target value, but will be limited in practice by combinatorial explosion as noted elsewhere. (Rationals are stored as pairs of integers, hence
("n",1) for n/1, etc..)
The tree_shapes function generates a list of binary trees of all possible shapes for a given
number of leaves. The with_leaves function substitutes a list of numbers into the leaves of
a tree in every possible way. The with_roots function substitutes a list of operators into the
non-terminal nodes of a tree in every possible way. The value function evaluates a tree and the
format function displays it in a readable form.
#import std
#import nat
#import rat
tree_shapes = "n". (@vLPiYo //eql iota "n")*~ (rep"n" ~&iiiK0NlrNCCVSPTs) {0^:<>}
with_leaves = ^|DrlDrlK34SPSL/permutations ~&
with_roots = ^DrlDrlK35dlPvVoPSPSL\~&r @lrhvdNCBvLPTo2DlS @hiNCSPtCx ~&K0=>
value = *^ ~&v?\(@d ~&\1) ^|H\~&hthPX '+-*/'-$<sum,difference,product,quotient>
format = *^ ~&v?\-+~&h,%zP@d+- ^H/mat@d *v ~&t?\~& :/`(+ --')'
game"n" "d" = format* value==("n",1)*~ with_roots/'+-*/' with_leaves/"d"*-1 tree_shapes length "d"
test program:
#show+
test_games = mat` * pad` *K7 pad0 game24* <<2,3,8,9>,<5,7,4,1>,<5,6,7,8>>
output:
8/(2/(9-3)) 1-(5-(7*4)) 6*(5+(7-8))
8*(9-(2*3)) 1-(5-(4*7)) 6*(7+(5-8))
8*(9-(3*2)) 1+((7*4)-5) 6*(7-(8-5))
8*((9-3)/2) 1+((4*7)-5) 6*(5-(8-7))
(8/2)*(9-3) (7*4)-(5-1) 6*(8/(7-5))
(9-3)/(2/8) (7*4)+(1-5) 8*(6/(7-5))
(9-3)*(8/2) (4*7)-(5-1) 6*((5+7)-8)
(8*(9-3))/2 (4*7)+(1-5) 6*((7+5)-8)
(9-(2*3))*8 (1-5)+(7*4) 6/((7-5)/8)
(9-(3*2))*8 (1-5)+(4*7) 6*((7-8)+5)
((9-3)/2)*8 (7*(5-1))-4 6*((5-8)+7)
((9-3)*8)/2 (1+(7*4))-5 8/((7-5)/6)
(1+(4*7))-5 (5+7)*(8-6)
((7*4)-5)+1 (7+5)*(8-6)
((7*4)+1)-5 (6*8)/(7-5)
((4*7)-5)+1 (8-6)*(5+7)
((4*7)+1)-5 (8-6)*(7+5)
((5-1)*7)-4 (8*6)/(7-5)
(6/(7-5))*8
(5+(7-8))*6
(7+(5-8))*6
(7-(8-5))*6
(5-(8-7))*6
(8/(7-5))*6
((5+7)-8)*6
((7+5)-8)*6
((7-8)+5)*6
((5-8)+7)*6
Categories: Programming Tasks | Solutions by Programming Task | Argile | Clojure | Common Lisp | Haskell | J | Mathematica | OCaml | Perl | PicoLisp | Python | R | Ruby | Scala | Tcl | Tcllib | Ursala
