24 game/Solve: Difference between revisions
m Consistency in phrasing |
m →{{header|C++}}: Couple corrections to the code |
||
Line 1,056: | Line 1,056: | ||
if(d[0] * d[1] == gameGoal * (d[2] - d[3])) printOperation("( ", " * ", " ) / ( ", " - ", " )"); |
if(d[0] * d[1] == gameGoal * (d[2] - d[3])) printOperation("( ", " * ", " ) / ( ", " - ", " )"); |
||
// Operations with 2 symbols *, one symbol /: |
// Operations with 2 symbols *, one symbol /: |
||
if(d[0] * d[1] * d[2] == gameGoal * d[3]) printOperation("", " * ", " |
if(d[0] * d[1] * d[2] == gameGoal * d[3]) printOperation("", " * ", " * ", " / "); |
||
if(d[0] * d[1] == gameGoal * d[2] * d[3]) printOperation("", " * ", " / ( ", " * ", " )"); |
if(d[0] * d[1] == gameGoal * d[2] * d[3]) printOperation("", " * ", " / ( ", " * ", " )"); |
||
// Operations with 2 symbols /, one symbol -: |
// Operations with 2 symbols /, one symbol -: |
||
if(d[0] * d[3] == gameGoal * (d[1] * d[3] - d[2])) printOperation("", " / ( ", " - ", " / ", " )"); |
if(d[0] * d[3] == gameGoal * (d[1] * d[3] - d[2])) printOperation("", " / ( ", " - ", " / ", " )"); |
||
// Operations with 2 symbols /, one symbol *: |
|||
if(d[0] * d[1] == gameGoal * d[2] * d[3]) printOperation("( ", " * ", " / ", " ) / ", ""); |
|||
} while(std::next_permutation(d.begin(), d.end())); // All operations are repeated for all possible permutations of the numbers. |
} while(std::next_permutation(d.begin(), d.end())); // All operations are repeated for all possible permutations of the numbers. |
||
} |
} |
Revision as of 23:05, 20 October 2014
You are encouraged to solve this task according to the task description, using any language you may know.
Write a program that takes four digits, either from user input or by random generation, and computes arithmetic expressions following the rules of the 24 game.
Show examples of solutions generated by the program.
C.F: Arithmetic Evaluator
ABAP
Will generate all possible solutions of any given four numbers according to the rules of the 24 game.
Note: the permute function was locally from here <lang ABAP>data: lv_flag type c,
lv_number type i, lt_numbers type table of i.
constants: c_no_val type i value 9999.
append 1 to lt_numbers. append 1 to lt_numbers. append 2 to lt_numbers. append 7 to lt_numbers.
write 'Evaluating 24 with the following input: '. loop at lt_numbers into lv_number.
write lv_number.
endloop. perform solve_24 using lt_numbers.
form eval_formula using iv_eval type string changing ev_out type i.
call function 'EVAL_FORMULA' "analysis of a syntactically correct formula exporting formula = iv_eval importing value = ev_out exceptions others = 1.
if sy-subrc <> 0. ev_out = -1. endif.
endform.
" Solve a 24 puzzle. form solve_24 using it_numbers like lt_numbers.
data: lv_flag type c, lv_op1 type c, lv_op2 type c, lv_op3 type c, lv_var1 type c, lv_var2 type c, lv_var3 type c, lv_var4 type c, lv_eval type string, lv_result type i, lv_var type i.
define retrieve_var. read table it_numbers index &1 into lv_var. &2 = lv_var. end-of-definition.
define retrieve_val. perform eval_formula using lv_eval changing lv_result. if lv_result = 24. write / lv_eval. endif. end-of-definition. " Loop through all the possible number permutations. do. " Init. the operations table.
retrieve_var: 1 lv_var1, 2 lv_var2, 3 lv_var3, 4 lv_var4. do 4 times. case sy-index. when 1. lv_op1 = '+'. when 2. lv_op1 = '*'. when 3. lv_op1 = '-'. when 4. lv_op1 = '/'. endcase. do 4 times. case sy-index. when 1. lv_op2 = '+'. when 2. lv_op2 = '*'. when 3. lv_op2 = '-'. when 4. lv_op2 = '/'. endcase. do 4 times. case sy-index. when 1. lv_op3 = '+'. when 2. lv_op3 = '*'. when 3. lv_op3 = '-'. when 4. lv_op3 = '/'. endcase. concatenate '(' '(' lv_var1 lv_op1 lv_var2 ')' lv_op2 lv_var3 ')' lv_op3 lv_var4 into lv_eval separated by space. retrieve_val. concatenate '(' lv_var1 lv_op1 lv_var2 ')' lv_op2 '(' lv_var3 lv_op3 lv_var4 ')' into lv_eval separated by space. retrieve_val. concatenate '(' lv_var1 lv_op1 '(' lv_var2 lv_op2 lv_var3 ')' ')' lv_op3 lv_var4 into lv_eval separated by space. retrieve_val. concatenate lv_var1 lv_op1 '(' '(' lv_var2 lv_op2 lv_var3 ')' lv_op3 lv_var4 ')' into lv_eval separated by space. retrieve_val. concatenate lv_var1 lv_op1 '(' lv_var2 lv_op2 '(' lv_var3 lv_op3 lv_var4 ')' ')' into lv_eval separated by space. retrieve_val. enddo. enddo. enddo.
" Once we've reached the last permutation -> Exit. perform permute using it_numbers changing lv_flag. if lv_flag = 'X'. exit. endif. enddo.
endform.
" Permutation function - this is used to permute:
" A = {A1...AN} -> Set of supplied variables.
" B = {B1...BN - 1} -> Set of operators.
" Can be used for an unbounded size set. Relies
" on lexicographic ordering of the set.
form permute using iv_set like lt_numbers
changing ev_last type c. data: lv_len type i, lv_first type i, lv_third type i, lv_count type i, lv_temp type i, lv_temp_2 type i, lv_second type i, lv_changed type c, lv_perm type i. describe table iv_set lines lv_len.
lv_perm = lv_len - 1. lv_changed = ' '. " Loop backwards through the table, attempting to find elements which " can be permuted. If we find one, break out of the table and set the " flag indicating a switch. do. if lv_perm <= 0. exit. endif. " Read the elements. read table iv_set index lv_perm into lv_first. add 1 to lv_perm. read table iv_set index lv_perm into lv_second. subtract 1 from lv_perm. if lv_first < lv_second. lv_changed = 'X'. exit. endif. subtract 1 from lv_perm. enddo.
" Last permutation. if lv_changed <> 'X'. ev_last = 'X'. exit. endif.
" Swap tail decresing to get a tail increasing. lv_count = lv_perm + 1. do. lv_first = lv_len + lv_perm - lv_count + 1. if lv_count >= lv_first. exit. endif.
read table iv_set index lv_count into lv_temp. read table iv_set index lv_first into lv_temp_2. modify iv_set index lv_count from lv_temp_2. modify iv_set index lv_first from lv_temp. add 1 to lv_count. enddo.
lv_count = lv_len - 1. do. if lv_count <= lv_perm. exit. endif.
read table iv_set index lv_count into lv_first. read table iv_set index lv_perm into lv_second. read table iv_set index lv_len into lv_third. if ( lv_first < lv_third ) and ( lv_first > lv_second ). lv_len = lv_count. endif.
subtract 1 from lv_count. enddo.
read table iv_set index lv_perm into lv_temp. read table iv_set index lv_len into lv_temp_2. modify iv_set index lv_perm from lv_temp_2. modify iv_set index lv_len from lv_temp.
endform.</lang>
Sample Runs:
Evaluating 24 with the following input: 1 1 2 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 ) Evaluating 24 with the following input: 1 ( ( 1 + 2 ) + 3 ) * 4 ( 1 + ( 2 + 3 ) ) * 4 ( ( 1 * 2 ) * 3 ) * 4 ( 1 * 2 ) * ( 3 * 4 ) ( 1 * ( 2 * 3 ) ) * 4 1 * ( ( 2 * 3 ) * 4 ) 1 * ( 2 * ( 3 * 4 ) ) ( ( 1 * 2 ) * 4 ) * 3 ( 1 * 2 ) * ( 4 * 3 ) ( 1 * ( 2 * 4 ) ) * 3 1 * ( ( 2 * 4 ) * 3 ) 1 * ( 2 * ( 4 * 3 ) ) ( ( 1 + 3 ) + 2 ) * 4 ( 1 + ( 3 + 2 ) ) * 4 ( 1 + 3 ) * ( 2 + 4 ) ( ( 1 * 3 ) * 2 ) * 4 ( 1 * 3 ) * ( 2 * 4 ) ( 1 * ( 3 * 2 ) ) * 4 1 * ( ( 3 * 2 ) * 4 ) 1 * ( 3 * ( 2 * 4 ) ) ( 1 + 3 ) * ( 4 + 2 ) ( ( 1 * 3 ) * 4 ) * 2 ( 1 * 3 ) * ( 4 * 2 ) ( 1 * ( 3 * 4 ) ) * 2 1 * ( ( 3 * 4 ) * 2 ) 1 * ( 3 * ( 4 * 2 ) ) ( ( 1 * 4 ) * 2 ) * 3 ( 1 * 4 ) * ( 2 * 3 ) ( 1 * ( 4 * 2 ) ) * 3 1 * ( ( 4 * 2 ) * 3 ) 1 * ( 4 * ( 2 * 3 ) ) ( ( 1 * 4 ) * 3 ) * 2 ( 1 * 4 ) * ( 3 * 2 ) ( 1 * ( 4 * 3 ) ) * 2 1 * ( ( 4 * 3 ) * 2 ) 1 * ( 4 * ( 3 * 2 ) ) ( ( 2 + 1 ) + 3 ) * 4 ( 2 + ( 1 + 3 ) ) * 4 ( ( 2 * 1 ) * 3 ) * 4 ( 2 * 1 ) * ( 3 * 4 ) ( 2 * ( 1 * 3 ) ) * 4 2 * ( ( 1 * 3 ) * 4 ) 2 * ( 1 * ( 3 * 4 ) ) ( ( 2 / 1 ) * 3 ) * 4 ( 2 / 1 ) * ( 3 * 4 ) ( 2 / ( 1 / 3 ) ) * 4 2 / ( 1 / ( 3 * 4 ) ) 2 / ( ( 1 / 3 ) / 4 ) ( ( 2 * 1 ) * 4 ) * 3 ( 2 * 1 ) * ( 4 * 3 ) ( 2 * ( 1 * 4 ) ) * 3 2 * ( ( 1 * 4 ) * 3 ) 2 * ( 1 * ( 4 * 3 ) ) ( ( 2 / 1 ) * 4 ) * 3 ( 2 / 1 ) * ( 4 * 3 ) ( 2 / ( 1 / 4 ) ) * 3 2 / ( 1 / ( 4 * 3 ) ) 2 / ( ( 1 / 4 ) / 3 ) ( ( 2 + 3 ) + 1 ) * 4 ( 2 + ( 3 + 1 ) ) * 4 ( ( 2 * 3 ) * 1 ) * 4 ( 2 * 3 ) * ( 1 * 4 ) ( 2 * ( 3 * 1 ) ) * 4 2 * ( ( 3 * 1 ) * 4 ) 2 * ( 3 * ( 1 * 4 ) ) ( ( 2 * 3 ) / 1 ) * 4 ( 2 * ( 3 / 1 ) ) * 4 2 * ( ( 3 / 1 ) * 4 ) ( 2 * 3 ) / ( 1 / 4 ) 2 * ( 3 / ( 1 / 4 ) ) ( ( 2 * 3 ) * 4 ) * 1 ( 2 * 3 ) * ( 4 * 1 ) ( 2 * ( 3 * 4 ) ) * 1 2 * ( ( 3 * 4 ) * 1 ) 2 * ( 3 * ( 4 * 1 ) ) ( ( 2 * 3 ) * 4 ) / 1 ( 2 * 3 ) * ( 4 / 1 ) ( 2 * ( 3 * 4 ) ) / 1 2 * ( ( 3 * 4 ) / 1 ) 2 * ( 3 * ( 4 / 1 ) ) ( 2 + 4 ) * ( 1 + 3 ) ( ( 2 * 4 ) * 1 ) * 3 ( 2 * 4 ) * ( 1 * 3 ) ( 2 * ( 4 * 1 ) ) * 3 2 * ( ( 4 * 1 ) * 3 ) 2 * ( 4 * ( 1 * 3 ) ) ( ( 2 * 4 ) / 1 ) * 3 ( 2 * ( 4 / 1 ) ) * 3 2 * ( ( 4 / 1 ) * 3 ) ( 2 * 4 ) / ( 1 / 3 ) 2 * ( 4 / ( 1 / 3 ) ) ( 2 + 4 ) * ( 3 + 1 ) ( ( 2 * 4 ) * 3 ) * 1 ( 2 * 4 ) * ( 3 * 1 ) ( 2 * ( 4 * 3 ) ) * 1 2 * ( ( 4 * 3 ) * 1 ) 2 * ( 4 * ( 3 * 1 ) ) ( ( 2 * 4 ) * 3 ) / 1 ( 2 * 4 ) * ( 3 / 1 ) ( 2 * ( 4 * 3 ) ) / 1 2 * ( ( 4 * 3 ) / 1 ) 2 * ( 4 * ( 3 / 1 ) ) ( ( 3 + 1 ) + 2 ) * 4 ( 3 + ( 1 + 2 ) ) * 4 ( 3 + 1 ) * ( 2 + 4 ) ( ( 3 * 1 ) * 2 ) * 4 ( 3 * 1 ) * ( 2 * 4 ) ( 3 * ( 1 * 2 ) ) * 4 3 * ( ( 1 * 2 ) * 4 ) 3 * ( 1 * ( 2 * 4 ) ) ( ( 3 / 1 ) * 2 ) * 4 ( 3 / 1 ) * ( 2 * 4 ) ( 3 / ( 1 / 2 ) ) * 4 3 / ( 1 / ( 2 * 4 ) ) 3 / ( ( 1 / 2 ) / 4 ) ( 3 + 1 ) * ( 4 + 2 ) ( ( 3 * 1 ) * 4 ) * 2 ( 3 * 1 ) * ( 4 * 2 ) ( 3 * ( 1 * 4 ) ) * 2 3 * ( ( 1 * 4 ) * 2 ) 3 * ( 1 * ( 4 * 2 ) ) ( ( 3 / 1 ) * 4 ) * 2 ( 3 / 1 ) * ( 4 * 2 ) ( 3 / ( 1 / 4 ) ) * 2 3 / ( 1 / ( 4 * 2 ) ) 3 / ( ( 1 / 4 ) / 2 ) ( ( 3 + 2 ) + 1 ) * 4 ( 3 + ( 2 + 1 ) ) * 4 ( ( 3 * 2 ) * 1 ) * 4 ( 3 * 2 ) * ( 1 * 4 ) ( 3 * ( 2 * 1 ) ) * 4 3 * ( ( 2 * 1 ) * 4 ) 3 * ( 2 * ( 1 * 4 ) ) ( ( 3 * 2 ) / 1 ) * 4 ( 3 * ( 2 / 1 ) ) * 4 3 * ( ( 2 / 1 ) * 4 ) ( 3 * 2 ) / ( 1 / 4 ) 3 * ( 2 / ( 1 / 4 ) ) ( ( 3 * 2 ) * 4 ) * 1 ( 3 * 2 ) * ( 4 * 1 ) ( 3 * ( 2 * 4 ) ) * 1 3 * ( ( 2 * 4 ) * 1 ) 3 * ( 2 * ( 4 * 1 ) ) ( ( 3 * 2 ) * 4 ) / 1 ( 3 * 2 ) * ( 4 / 1 ) ( 3 * ( 2 * 4 ) ) / 1 3 * ( ( 2 * 4 ) / 1 ) 3 * ( 2 * ( 4 / 1 ) ) ( ( 3 * 4 ) * 1 ) * 2 ( 3 * 4 ) * ( 1 * 2 ) ( 3 * ( 4 * 1 ) ) * 2 3 * ( ( 4 * 1 ) * 2 ) 3 * ( 4 * ( 1 * 2 ) ) ( ( 3 * 4 ) / 1 ) * 2 ( 3 * ( 4 / 1 ) ) * 2 3 * ( ( 4 / 1 ) * 2 ) ( 3 * 4 ) / ( 1 / 2 ) 3 * ( 4 / ( 1 / 2 ) ) ( ( 3 * 4 ) * 2 ) * 1 ( 3 * 4 ) * ( 2 * 1 ) ( 3 * ( 4 * 2 ) ) * 1 3 * ( ( 4 * 2 ) * 1 ) 3 * ( 4 * ( 2 * 1 ) ) ( ( 3 * 4 ) * 2 ) / 1 ( 3 * 4 ) * ( 2 / 1 ) ( 3 * ( 4 * 2 ) ) / 1 3 * ( ( 4 * 2 ) / 1 ) 3 * ( 4 * ( 2 / 1 ) ) 4 * ( ( 1 + 2 ) + 3 ) 4 * ( 1 + ( 2 + 3 ) ) ( ( 4 * 1 ) * 2 ) * 3 ( 4 * 1 ) * ( 2 * 3 ) ( 4 * ( 1 * 2 ) ) * 3 4 * ( ( 1 * 2 ) * 3 ) 4 * ( 1 * ( 2 * 3 ) ) ( ( 4 / 1 ) * 2 ) * 3 ( 4 / 1 ) * ( 2 * 3 ) ( 4 / ( 1 / 2 ) ) * 3 4 / ( 1 / ( 2 * 3 ) ) 4 / ( ( 1 / 2 ) / 3 ) 4 * ( ( 1 + 3 ) + 2 ) 4 * ( 1 + ( 3 + 2 ) ) ( ( 4 * 1 ) * 3 ) * 2 ( 4 * 1 ) * ( 3 * 2 ) ( 4 * ( 1 * 3 ) ) * 2 4 * ( ( 1 * 3 ) * 2 ) 4 * ( 1 * ( 3 * 2 ) ) ( ( 4 / 1 ) * 3 ) * 2 ( 4 / 1 ) * ( 3 * 2 ) ( 4 / ( 1 / 3 ) ) * 2 4 / ( 1 / ( 3 * 2 ) ) 4 / ( ( 1 / 3 ) / 2 ) ( 4 + 2 ) * ( 1 + 3 ) 4 * ( ( 2 + 1 ) + 3 ) 4 * ( 2 + ( 1 + 3 ) ) ( ( 4 * 2 ) * 1 ) * 3 ( 4 * 2 ) * ( 1 * 3 ) ( 4 * ( 2 * 1 ) ) * 3 4 * ( ( 2 * 1 ) * 3 ) 4 * ( 2 * ( 1 * 3 ) ) ( ( 4 * 2 ) / 1 ) * 3 ( 4 * ( 2 / 1 ) ) * 3 4 * ( ( 2 / 1 ) * 3 ) ( 4 * 2 ) / ( 1 / 3 ) 4 * ( 2 / ( 1 / 3 ) ) ( 4 + 2 ) * ( 3 + 1 ) 4 * ( ( 2 + 3 ) + 1 ) 4 * ( 2 + ( 3 + 1 ) ) ( ( 4 * 2 ) * 3 ) * 1 ( 4 * 2 ) * ( 3 * 1 ) ( 4 * ( 2 * 3 ) ) * 1 4 * ( ( 2 * 3 ) * 1 ) 4 * ( 2 * ( 3 * 1 ) ) ( ( 4 * 2 ) * 3 ) / 1 ( 4 * 2 ) * ( 3 / 1 ) ( 4 * ( 2 * 3 ) ) / 1 4 * ( ( 2 * 3 ) / 1 ) 4 * ( 2 * ( 3 / 1 ) ) 4 * ( ( 3 + 1 ) + 2 ) 4 * ( 3 + ( 1 + 2 ) ) ( ( 4 * 3 ) * 1 ) * 2 ( 4 * 3 ) * ( 1 * 2 ) ( 4 * ( 3 * 1 ) ) * 2 4 * ( ( 3 * 1 ) * 2 ) 4 * ( 3 * ( 1 * 2 ) ) ( ( 4 * 3 ) / 1 ) * 2 ( 4 * ( 3 / 1 ) ) * 2 4 * ( ( 3 / 1 ) * 2 ) ( 4 * 3 ) / ( 1 / 2 ) 4 * ( 3 / ( 1 / 2 ) ) 4 * ( ( 3 + 2 ) + 1 ) 4 * ( 3 + ( 2 + 1 ) ) ( ( 4 * 3 ) * 2 ) * 1 ( 4 * 3 ) * ( 2 * 1 ) ( 4 * ( 3 * 2 ) ) * 1 4 * ( ( 3 * 2 ) * 1 ) 4 * ( 3 * ( 2 * 1 ) ) ( ( 4 * 3 ) * 2 ) / 1 ( 4 * 3 ) * ( 2 / 1 ) ( 4 * ( 3 * 2 ) ) / 1 4 * ( ( 3 * 2 ) / 1 ) 4 * ( 3 * ( 2 / 1 ) ) Evaluating 24 with the following input: 5 6 7 8 5 * ( 6 - ( 8 / 7 ) ) ( 5 + 7 ) * ( 8 - 6 ) ( ( 5 + 7 ) - 8 ) * 6 ( 5 + ( 7 - 8 ) ) * 6 ( ( 5 - 8 ) + 7 ) * 6 ( 5 - ( 8 - 7 ) ) * 6 6 * ( ( 5 + 7 ) - 8 ) 6 * ( 5 + ( 7 - 8 ) ) 6 * ( ( 5 - 8 ) + 7 ) 6 * ( 5 - ( 8 - 7 ) ) 6 * ( ( 7 + 5 ) - 8 ) 6 * ( 7 + ( 5 - 8 ) ) ( 6 / ( 7 - 5 ) ) * 8 6 / ( ( 7 - 5 ) / 8 ) 6 * ( ( 7 - 8 ) + 5 ) 6 * ( 7 - ( 8 - 5 ) ) ( 6 * 8 ) / ( 7 - 5 ) 6 * ( 8 / ( 7 - 5 ) ) ( 6 - ( 8 / 7 ) ) * 5 ( 7 + 5 ) * ( 8 - 6 ) ( ( 7 + 5 ) - 8 ) * 6 ( 7 + ( 5 - 8 ) ) * 6 ( ( 7 - 8 ) + 5 ) * 6 ( 7 - ( 8 - 5 ) ) * 6 ( 8 - 6 ) * ( 5 + 7 ) ( 8 * 6 ) / ( 7 - 5 ) 8 * ( 6 / ( 7 - 5 ) ) ( 8 - 6 ) * ( 7 + 5 ) ( 8 / ( 7 - 5 ) ) * 6 8 / ( ( 7 - 5 ) / 6 )
Argile
<lang Argile>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</lang>
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)
AutoHotkey
Output is in RPN. <lang AHK>#NoEnv InputBox, NNNN ; user input 4 digits NNNN := RegExReplace(NNNN, "(\d)(?=\d)", "$1,") ; separate with commas for the sort command sort NNNN, d`, ; sort in ascending order for the permutations to work StringReplace NNNN, NNNN, `,, , All ; remove comma separators after sorting
ops := "+-*/" patterns := [ "x x.x.x." ,"x x.x x.." ,"x x x..x." ,"x x x.x.." ,"x x x x..." ]
- build bruteforce operator list ("+++, ++-, ++* ... ///")
a := b := c := 0 While (++a<5){
While (++b<5){ While (++c<5){ l := SubStr(ops, a, 1) . SubStr(ops, b, 1) . SubStr(ops, c, 1)
; build bruteforce template ("x x+x+x+, x x+x x++ ... x x x x///") For each, pattern in patterns { Loop 3 StringReplace, pattern, pattern, ., % SubStr(l, A_Index, 1) pat .= pattern "`n" } }c := 0 }b := 0
} StringTrimRight, pat, pat, 1 ; remove trailing newline
- permutate input. As the lexicographic algorithm is used, each permutation generated is unique
While NNNN { StringSplit, N, NNNN ; substitute numbers in for x's and evaluate Loop Parse, pat, `n { eval := A_LoopField ; current line Loop 4 StringReplace, eval, eval, x, % N%A_Index% ; substitute number for "x" If Round(evalRPN(eval), 4) = 24 final .= eval "`n" } NNNN := perm_next(NNNN) ; next lexicographic permutation of user's digits } MsgBox % final ? clipboard := final : "No solution"
- simple stack-based evaluation. Integers only. Whitespace is used to push a value.
evalRPN(s){ stack := [] Loop Parse, s If A_LoopField is number t .= A_LoopField else { If t stack.Insert(t), t := "" If InStr("+-/*", l := A_LoopField) { a := stack.Remove(), b := stack.Remove() stack.Insert( l = "+" ? b + a :l = "-" ? b - a :l = "*" ? b * a :l = "/" ? b / a :0 ) } } return stack.Remove() }
perm_Next(str){ p := 0, sLen := StrLen(str) Loop % sLen { If A_Index=1 continue t := SubStr(str, sLen+1-A_Index, 1) n := SubStr(str, sLen+2-A_Index, 1) If ( t < n ) { p := sLen+1-A_Index, pC := SubStr(str, p, 1) break } } If !p return false Loop { t := SubStr(str, sLen+1-A_Index, 1) If ( t > pC ) { n := sLen+1-A_Index, nC := SubStr(str, n, 1) break } } return SubStr(str, 1, p-1) . nC . Reverse(SubStr(str, p+1, n-p-1) . pC . SubStr(str, n+1)) }
Reverse(s){ Loop Parse, s o := A_LoopField o return o }</lang>
- Output:
for 1127
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+*
And for 8338:
8 3 8 3/-/
BBC BASIC
<lang bbcbasic>
PROCsolve24("1234") PROCsolve24("6789") PROCsolve24("1127") PROCsolve24("5566") END DEF PROCsolve24(s$) LOCAL F%, I%, J%, K%, L%, P%, T%, X$, o$(), p$(), t$() DIM o$(4), p$(24,4), t$(11) o$() = "", "+", "-", "*", "/" RESTORE FOR T% = 1 TO 11 READ t$(T%) NEXT DATA "abcdefg", "(abc)defg", "ab(cde)fg", "abcd(efg)", "(abc)d(efg)", "(abcde)fg" DATA "ab(cdefg)", "((abc)de)fg", "(ab(cde))fg", "ab((cde)fg)", "ab(cd(efg))" FOR I% = 1 TO 4 FOR J% = 1 TO 4 FOR K% = 1 TO 4 FOR L% = 1 TO 4 IF I%<>J% IF J%<>K% IF K%<>L% IF I%<>K% IF J%<>L% IF I%<>L% THEN P% += 1 p$(P%,1) = MID$(s$,I%,1) p$(P%,2) = MID$(s$,J%,1) p$(P%,3) = MID$(s$,K%,1) p$(P%,4) = MID$(s$,L%,1) ENDIF NEXT NEXT NEXT NEXT FOR I% = 1 TO 4 FOR J% = 1 TO 4 FOR K% = 1 TO 4 FOR T% = 1 TO 11 FOR P% = 1 TO 24 X$ = t$(T%) MID$(X$, INSTR(X$,"a"), 1) = p$(P%,1) MID$(X$, INSTR(X$,"b"), 1) = o$(I%) MID$(X$, INSTR(X$,"c"), 1) = p$(P%,2) MID$(X$, INSTR(X$,"d"), 1) = o$(J%) MID$(X$, INSTR(X$,"e"), 1) = p$(P%,3) MID$(X$, INSTR(X$,"f"), 1) = o$(K%) MID$(X$, INSTR(X$,"g"), 1) = p$(P%,4) F% = TRUE : ON ERROR LOCAL F% = FALSE IF F% IF EVAL(X$) = 24 THEN PRINT X$ : EXIT FOR I% RESTORE ERROR NEXT NEXT NEXT NEXT NEXT IF I% > 4 PRINT "No solution found" ENDPROC
</lang>
- Output:
(1+2+3)*4 6*8/(9-7) (1+2)*(1+7) (5+5-6)*6
C
This is a solver that's generic enough to deal with more than 4 numbers, goals other than 24, or different digit ranges. It guarantees a solution if there is one. Its output format is reasonably good looking, though not necessarily optimal. <lang C>#include <stdio.h>
- include <stdlib.h>
- include <time.h>
- define n_cards 4
- define solve_goal 24
- define max_digit 9
typedef struct { int num, denom; } frac_t, *frac; typedef enum { C_NUM = 0, C_ADD, C_SUB, C_MUL, C_DIV } op_type;
typedef struct expr_t *expr; typedef struct expr_t {
op_type op; expr left, right; int value;
} expr_t;
void show_expr(expr e, op_type prec, int is_right) {
const char * op; switch(e->op) { case C_NUM: printf("%d", e->value); return; case C_ADD: op = " + "; break; case C_SUB: op = " - "; break; case C_MUL: op = " x "; break; case C_DIV: op = " / "; break; }
if ((e->op == prec && is_right) || e->op < prec) printf("("); show_expr(e->left, e->op, 0); printf("%s", op); show_expr(e->right, e->op, 1); if ((e->op == prec && is_right) || e->op < prec) printf(")");
}
void eval_expr(expr e, frac f) {
frac_t left, right; if (e->op == C_NUM) { f->num = e->value; f->denom = 1; return; } eval_expr(e->left, &left); eval_expr(e->right, &right); switch (e->op) { case C_ADD: f->num = left.num * right.denom + left.denom * right.num; f->denom = left.denom * right.denom; return; case C_SUB: f->num = left.num * right.denom - left.denom * right.num; f->denom = left.denom * right.denom; return; case C_MUL: f->num = left.num * right.num; f->denom = left.denom * right.denom; return; case C_DIV: f->num = left.num * right.denom; f->denom = left.denom * right.num; return; default: fprintf(stderr, "Unknown op: %d\n", e->op); return; }
} int solve(expr ex_in[], int len) {
int i, j; expr_t node; expr ex[n_cards]; frac_t final;
if (len == 1) { eval_expr(ex_in[0], &final); if (final.num == final.denom * solve_goal && final.denom) { show_expr(ex_in[0], 0, 0); return 1; } return 0; }
for (i = 0; i < len - 1; i++) { for (j = i + 1; j < len; j++) ex[j - 1] = ex_in[j]; ex[i] = &node; for (j = i + 1; j < len; j++) { node.left = ex_in[i]; node.right = ex_in[j]; for (node.op = C_ADD; node.op <= C_DIV; node.op++) if (solve(ex, len - 1)) return 1;
node.left = ex_in[j]; node.right = ex_in[i]; node.op = C_SUB; if (solve(ex, len - 1)) return 1; node.op = C_DIV; if (solve(ex, len - 1)) return 1;
ex[j] = ex_in[j]; } ex[i] = ex_in[i]; }
return 0;
}
int solve24(int n[]) {
int i; expr_t ex[n_cards]; expr e[n_cards]; for (i = 0; i < n_cards; i++) { e[i] = ex + i; ex[i].op = C_NUM; ex[i].left = ex[i].right = 0; ex[i].value = n[i]; } return solve(e, n_cards);
}
int main() {
int i, j, n[] = { 3, 3, 8, 8, 9 }; srand(time(0));
for (j = 0; j < 10; j++) { for (i = 0; i < n_cards; i++) { n[i] = 1 + (double) rand() * max_digit / RAND_MAX; printf(" %d", n[i]); } printf(": "); printf(solve24(n) ? "\n" : "No solution\n"); }
return 0;
}</lang>
- Output:
1 8 2 1: 1 x 8 x (2 + 1) 6 8 2 8: 6 + 8 + 2 + 8 4 2 8 1: (4 - 2 + 1) x 8 3 1 9 9: (9 - 1) / (3 / 9) 5 7 5 1: No solution 5 8 4 1: (5 + 1) x (8 - 4) 8 3 4 9: 8 + 3 + 4 + 9 3 7 4 4: ((3 + 7) - 4) x 4 5 6 4 1: 4 / (1 - 5 / 6) 5 5 9 8: 5 x 5 - 9 + 8
For the heck of it, using seven numbers ranging from 0 to 99, trying to calculate 1:
54 64 44 67 60 54 97: (54 + 64 + 44) / 54 + 60 / (67 - 97) 83 3 52 50 14 48 55: 55 - (((83 + 3 + 52) - 50 + 14) - 48) 70 14 26 6 4 50 19: ((70 + 14 + 26) / 4 - 19) x 6 - 50 75 29 61 95 1 6 73: 6 / (73 - ((75 + 29 + 61) - 95)) - 1 99 65 59 54 29 3 21: 3 - (99 + 65 + 54) / (59 + 29 + 21) 88 57 18 72 60 70 22: (72 - 70) x (60 + 22) - (88 + 57 + 18) 73 18 76 44 32 3 49: 32 / (49 - (44 + 3)) - ((73 + 18) - 76) 36 53 68 12 82 30 8: ((36 + 53 + 68) - 82) / 30 - 12 / 8 83 35 81 82 99 40 36: ((83 + 35) x 81 - 82 x 99) / 40 / 36 29 43 57 18 1 74 89: (1 + 74) / (((29 + 43) - 57) / 18) - 89
C++
This code may be extended to work with more than 4 numbers, goals other than 24, or different digit ranges. Operations have been manually determined for these parameters, with the belief they are complete.
<lang cpp>
- include <iostream>
- include <ratio>
- include <array>
- include <algorithm>
- include <random>
typedef short int Digit; // Typedef for the digits data type.
constexpr Digit nDigits{4}; // Amount of digits that are taken into the game. constexpr Digit maximumDigit{9}; // Maximum digit that may be taken into the game. constexpr short int gameGoal{24}; // Desired result.
typedef std::array<Digit, nDigits> digitSet; // Typedef for the set of digits in the game. digitSet d;
void printTrivialOperation(std::string operation) { // Prints a commutative operation taking all the digits. bool printOperation(false); for(const Digit& number : d) { if(printOperation) std::cout << operation; else printOperation = true; std::cout << number; } std::cout << std::endl; }
void printOperation(std::string prefix, std::string operation1, std::string operation2, std::string operation3, std::string suffix = "") { std::cout << prefix << d[0] << operation1 << d[1] << operation2 << d[2] << operation3 << d[3] << suffix << std::endl; }
int main() { std::mt19937_64 randomGenerator; std::uniform_int_distribution<Digit> digitDistro{1, maximumDigit}; // Let us set up a number of trials: for(int trial{10}; trial; --trial) { for(Digit& digit : d) { digit = digitDistro(randomGenerator); std::cout << digit << " "; } std::cout << std::endl; std::sort(d.begin(), d.end()); // We start with the most trivial, commutative operations: if(std::accumulate(d.cbegin(), d.cend(), 0) == gameGoal) printTrivialOperation(" + "); if(std::accumulate(d.cbegin(), d.cend(), 1, std::multiplies<Digit>{}) == gameGoal) printTrivialOperation(" * "); // Now let's start working on every permutation of the digits. do { // Operations with 2 symbols + and one symbol -: if(d[0] + d[1] + d[2] - d[3] == gameGoal) printOperation("", " + ", " + ", " - "); // If gameGoal is ever changed to a smaller value, consider adding more operations in this category. // Operations with 2 symbols + and one symbol *: if(d[0] * d[1] + d[2] + d[3] == gameGoal) printOperation("", " * ", " + ", " + "); if(d[0] * (d[1] + d[2]) + d[3] == gameGoal) printOperation("", " * ( ", " + ", " ) + "); if(d[0] * (d[1] + d[2] + d[3]) == gameGoal) printOperation("", " * ( ", " + ", " + ", " )"); // Operations with one symbol + and 2 symbols *: if((d[0] * d[1] * d[2]) + d[3] == gameGoal) printOperation("( ", " * ", " * ", " ) + "); if(d[0] * d[1] * (d[2] + d[3]) == gameGoal) printOperation("( ", " * ", " * ( ", " + ", " )"); if((d[0] * d[1]) + (d[2] * d[3]) == gameGoal) printOperation("( ", " * ", " ) + ( ", " * ", " )"); // Operations with one symbol - and 2 symbols *: if((d[0] * d[1] * d[2]) - d[3] == gameGoal) printOperation("( ", " * ", " * ", " ) - "); if(d[0] * d[1] * (d[2] - d[3]) == gameGoal) printOperation("( ", " * ", " * ( ", " - ", " )"); if((d[0] * d[1]) - (d[2] * d[3]) == gameGoal) printOperation("( ", " * ", " ) - ( ", " * ", " )"); // Operations with one symbol +, one symbol *, and one symbol -: if(d[0] * d[1] + d[2] - d[3] == gameGoal) printOperation("", " * ", " + ", " - "); if(d[0] * (d[1] + d[2]) - d[3] == gameGoal) printOperation("", " * ( ", " + ", " ) - "); if(d[0] * (d[1] - d[2]) + d[3] == gameGoal) printOperation("", " * ( ", " - ", " ) + "); if(d[0] * (d[1] + d[2] - d[3]) == gameGoal) printOperation("", " * ( ", " + ", " - ", " )"); if(d[0] * d[1] - (d[2] + d[3]) == gameGoal) printOperation("", " * ", " - ( ", " + ", " )"); // Operations with one symbol *, one symbol /, one symbol +: if(d[0] * d[1] == (gameGoal - d[3]) * d[2]) printOperation("( ", " * ", " / ", " ) + "); if(((d[0] * d[1]) + d[2]) == gameGoal * d[3]) printOperation("(( ", " * ", " ) + ", " ) / "); if((d[0] + d[1]) * d[2] == gameGoal * d[3]) printOperation("(( ", " + ", " ) * ", " ) / "); if(d[0] * d[1] == gameGoal * (d[2] + d[3])) printOperation("( ", " * ", " ) / ( ", " + ", " )"); // Operations with one symbol *, one symbol /, one symbol -: if(d[0] * d[1] == (gameGoal + d[3]) * d[2]) printOperation("( ", " * ", " / ", " ) - "); if(((d[0] * d[1]) - d[2]) == gameGoal * d[3]) printOperation("(( ", " * ", " ) - ", " ) / "); if((d[0] - d[1]) * d[2] == gameGoal * d[3]) printOperation("(( ", " - ", " ) * ", " ) / "); if(d[0] * d[1] == gameGoal * (d[2] - d[3])) printOperation("( ", " * ", " ) / ( ", " - ", " )"); // Operations with 2 symbols *, one symbol /: if(d[0] * d[1] * d[2] == gameGoal * d[3]) printOperation("", " * ", " * ", " / "); if(d[0] * d[1] == gameGoal * d[2] * d[3]) printOperation("", " * ", " / ( ", " * ", " )"); // Operations with 2 symbols /, one symbol -: if(d[0] * d[3] == gameGoal * (d[1] * d[3] - d[2])) printOperation("", " / ( ", " - ", " / ", " )"); // Operations with 2 symbols /, one symbol *: if(d[0] * d[1] == gameGoal * d[2] * d[3]) printOperation("( ", " * ", " / ", " ) / ", ""); } while(std::next_permutation(d.begin(), d.end())); // All operations are repeated for all possible permutations of the numbers. } return 0; } </lang>
- Output:
8 3 7 9 3 * ( 7 + 9 - 8 ) 3 * ( 9 + 7 - 8 ) 1 4 3 1 ( 3 * 4 * ( 1 + 1 ) ( 4 * 3 * ( 1 + 1 ) 5 4 3 6 6 * ( 3 + 5 - 4 ) 6 * ( 5 + 3 - 4 ) 2 5 5 8 5 4 7 3 3 * 4 + 5 + 7 3 * 4 + 7 + 5 ( 3 * 4 * ( 7 - 5 ) 3 * ( 5 + 7 - 4 ) 3 * ( 7 + 5 - 4 ) 4 * 3 + 5 + 7 4 * 3 + 7 + 5 ( 4 * 3 * ( 7 - 5 ) 4 * 5 + 7 - 3 5 * 4 + 7 - 3 5 * ( 7 - 3 ) + 4 3 3 9 2 2 * 9 + 3 + 3 3 * ( 2 + 3 ) + 9 3 * ( 2 + 9 - 3 ) 3 * ( 3 + 2 ) + 9 3 * ( 9 - 2 ) + 3 3 * ( 9 + 2 - 3 ) 9 * 2 + 3 + 3 3 2 7 9 3 * ( 7 - 2 ) + 9 (( 7 + 9 ) * 3 ) / 2 (( 9 + 7 ) * 3 ) / 2 7 1 5 3 7 6 9 4 (( 7 + 9 ) * 6 ) / 4 (( 9 + 7 ) * 6 ) / 4 3 5 3 1 ( 1 * 3 * ( 3 + 5 ) ( 1 * 3 * ( 5 + 3 ) ( 3 * 1 * ( 3 + 5 ) ( 3 * 1 * ( 5 + 3 ) (( 3 + 5 ) * 3 ) / 1 (( 5 + 3 ) * 3 ) / 1
Clojure
<lang Clojure>(ns rosettacode.24game.solve
(:require [clojure.math.combinatorics :as c] [clojure.walk :as w]))
(def ^:private op-maps
(map #(zipmap [:o1 :o2 :o3] %) (c/selections '(* + - /) 3)))
(def ^:private patterns '(
(:o1 (:o2 :n1 :n2) (:o3 :n3 :n4)) (:o1 :n1 (:o2 :n2 (:o3 :n3 :n4))) (:o1 (:o2 (:o3 :n1 :n2) :n3) :n4)))
(defn play24 [& digits]
{:pre (and (every? #(not= 0 %) digits) (= (count digits) 4))} (->> (for [:let [digit-maps (->> digits sort c/permutations (map #(zipmap [:n1 :n2 :n3 :n4] %)))] om op-maps, dm digit-maps] (w/prewalk-replace dm (w/prewalk-replace om patterns))) (filter #(= (eval %) 24)) (map println) doall count))</lang>
The function play24
works by substituting the given digits and the four operations into the binary tree patterns (o (o n n) (o n n)), (o (o (o n n) 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 substitute in operations and digits, which are replaced into the tree patterns.
CoffeeScript
<lang coffeescript>
- This program tries to find some way to turn four digits into an arithmetic
- expression that adds up to 24.
- Example solution for 5, 7, 8, 8:
- (((8 + 7) * 8) / 5)
solve_24_game = (digits...) ->
# Create an array of objects for our helper functions arr = for digit in digits { val: digit expr: digit } combo4 arr...
combo4 = (a, b, c, d) ->
arr = [a, b, c, d] # Reduce this to a three-node problem by combining two # nodes from the array. permutations = [ [0, 1, 2, 3] [0, 2, 1, 3] [0, 3, 1, 2] [1, 2, 0, 3] [1, 3, 0, 2] [2, 3, 0, 1] ] for permutation in permutations [i, j, k, m] = permutation for combo in combos arr[i], arr[j] answer = combo3 combo, arr[k], arr[m] return answer if answer null
combo3 = (a, b, c) ->
arr = [a, b, c] permutations = [ [0, 1, 2] [0, 2, 1] [1, 2, 0] ] for permutation in permutations [i, j, k] = permutation for combo in combos arr[i], arr[j] answer = combo2 combo, arr[k] return answer if answer null
combo2 = (a, b) ->
for combo in combos a, b return combo.expr if combo.val == 24 null
combos = (a, b) ->
[ val: a.val + b.val expr: "(#{a.expr} + #{b.expr})" , val: a.val * b.val expr: "(#{a.expr} * #{b.expr})" , val: a.val - b.val expr: "(#{a.expr} - #{b.expr})" , val: b.val - a.val expr: "(#{b.expr} - #{a.expr})" , val: a.val / b.val expr: "(#{a.expr} / #{b.expr})" , val: b.val / a.val expr: "(#{b.expr} / #{a.expr})" , ]
- test
do ->
rand_digit = -> 1 + Math.floor (9 * Math.random())
for i in [1..15] a = rand_digit() b = rand_digit() c = rand_digit() d = rand_digit() solution = solve_24_game a, b, c, d console.log "Solution for #{[a,b,c,d]}: #{solution ? 'no solution'}"
</lang>
- Output:
> coffee 24_game.coffee Solution for 8,3,1,8: ((1 + 8) * (8 / 3)) Solution for 6,9,5,7: (6 - ((5 - 7) * 9)) Solution for 4,2,1,1: no solution Solution for 3,5,1,3: (((3 + 5) * 1) * 3) Solution for 6,4,1,7: ((7 - (4 - 1)) * 6) Solution for 8,1,3,1: (((8 + 1) - 1) * 3) Solution for 6,1,3,3: (((6 + 1) * 3) + 3) Solution for 7,1,5,6: (((7 - 1) * 5) - 6) Solution for 4,2,3,1: ((3 + 1) * (4 + 2)) Solution for 8,8,5,8: ((5 * 8) - (8 + 8)) Solution for 3,8,4,1: ((1 - (3 - 8)) * 4) Solution for 6,4,3,8: ((8 - (6 / 3)) * 4) Solution for 2,1,8,7: (((2 * 8) + 1) + 7) Solution for 5,2,7,5: ((2 * 7) + (5 + 5)) Solution for 2,4,8,9: ((9 - (2 + 4)) * 8)
Common Lisp
<lang 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))</lang>
- 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
D
This uses the Rational struct and permutations functions of two other Rosetta Code Tasks.
<lang d>import std.stdio, std.algorithm, std.range, std.typecons, std.conv,
std.string, permutations2, arithmetic_rational;
string solve(in int target, in int[] problem) {
static struct ComputeAllOperations { //static struct T { Rational r; string e; } alias T = Tuple!(Rational,"r", string,"e"); Rational[] L;
int opApply(in int delegate(ref T) dg) { int result;
if (!L.empty) { auto x = L[0]; auto xs = L[1 .. $]; if (L.length == 1) { T aux = T(x, text(x)); result = dg(aux); } else { OUTER: foreach (o; ComputeAllOperations(xs)) { auto y = o.r; auto sub = [T(x * y, "*"), T(x + y, "+"), T(x - y, "-")]; if (y) sub ~= [T(x/y, "/")]; foreach (e; sub) { auto aux = T(e.r, format("(%s%s%s)", x, e.e, o.e)); result = dg(aux); if (result) break OUTER; } } } }
return result; } }
foreach (p; problem.map!Rational.array.permutations) foreach (sol; ComputeAllOperations(p)) if (sol.r == target) return sol.e; return "No solution";
}
void main() {
foreach (prob; [[6, 7, 9, 5], [3, 3, 8, 8], [1, 1, 1, 1]]) writeln(prob, ": ", solve(24, prob));
}</lang>
- Output:
[6, 7, 9, 5]: (6+(9*(7-5))) [3, 3, 8, 8]: (8/(3-(8/3))) [1, 1, 1, 1]: No solution
Euler Math Toolbox
Via brute force.
<lang Euler Math Toolbox> >function try24 (v) ... $n=cols(v); $if n==1 and v[1]~=24 then $ "Solved the problem", $ return 1; $endif $loop 1 to n $ w=tail(v,2); $ loop 1 to n-1 $ h=w; a=v[1]; b=w[1]; $ w[1]=a+b; if try24(w); ""+a+"+"+b+"="+(a+b), return 1; endif; $ w[1]=a-b; if try24(w); ""+a+"-"+b+"="+(a-b), return 1; endif; $ w[1]=a*b; if try24(w); ""+a+"*"+b+"="+(a*b), return 1; endif; $ if not b~=0 then $ w[1]=a/b; if try24(w); ""+a+"/"+b+"="+(a/b), return 1; endif; $ endif; $ w=rotright(w); $ end; $ v=rotright(v); $end; $return 0; $endfunction </lang>
<lang Euler Math Toolbox> >try24([1,2,3,4]);
Solved the problem 6*4=24 3+3=6 1+2=3
>try24([8,7,7,1]);
Solved the problem 22+2=24 14+8=22 7+7=14
>try24([8,4,7,1]);
Solved the problem 6*4=24 7-1=6 8-4=4
>try24([3,4,5,6]);
Solved the problem 4*6=24 -1+5=4 3-4=-1
</lang>
F#
The program wants to give all solutions for a given set of 4 digits. It eliminates all duplicate solutions which result from transposing equal digits. The basic solution is an adaption of the OCaml program. <lang fsharp>open System
let rec gcd x y = if x = y || x = 0 then y else if x < y then gcd y x else gcd y (x-y) let abs (x : int) = Math.Abs x let sign (x: int) = Math.Sign x let cint s = Int32.Parse(s)
type Rat(x : int, y : int) =
let g = if y = 0 then 0 else gcd (abs x) (abs y) member this.n = if g = 0 then sign y * sign x else sign y * x / g // store a minus sign in the numerator member this.d = if y = 0 then 0 else sign y * y / g static member (~-) (x : Rat) = Rat(-x.n, x.d) static member (+) (x : Rat, y : Rat) = Rat(x.n * y.d + y.n * x.d, x.d * y.d) static member (-) (x : Rat, y : Rat) = x + Rat(-y.n, y.d) static member (*) (x : Rat, y : Rat) = Rat(x.n * y.n, x.d * y.d) static member (/) (x : Rat, y : Rat) = x * Rat(y.d, y.n) interface System.IComparable with member this.CompareTo o = match o with | :? Rat as that -> compare (this.n * that.d) (that.n * this.d) | _ -> invalidArg "o" "cannot compare values of differnet types." override this.Equals(o) = match o with | :? Rat as that -> this.n = that.n && this.d = that.d | _ -> false override this.ToString() = if this.d = 1 then this.n.ToString() else sprintf @"<%d,%d>" this.n this.d new(x : string, y : string) = if y = "" then Rat(cint x, 1) else Rat(cint x, cint y)
type expression =
| Const of Rat | Sum of expression * expression | Diff of expression * expression | Prod of expression * expression | Quot of expression * expression
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 concat (s : seq<string>) = System.String.Concat s let paren p prec op_prec = if prec > op_prec then p else "" let rec print prec = function | Const c -> c.ToString() | Sum(f, g) -> concat [ (paren "(" prec 0); (print 0 f); " + "; (print 0 g); (paren ")" prec 0) ] | Diff(f, g) -> concat [ (paren "(" prec 0); (print 0 f); " - "; (print 1 g); (paren ")" prec 0) ] | Prod(f, g) -> concat [ (paren "(" prec 2); (print 2 f); " * "; (print 2 g); (paren ")" prec 2) ] | Quot(f, g) -> concat [ (paren "(" prec 2); (print 2 f); " / "; (print 3 g); (paren ")" prec 2) ] print 0 expr
let rec normal expr =
let norm epxr = match expr with | Sum(x, y) -> if eval x <= eval y then expr else Sum(normal y, normal x) | Prod(x, y) -> if eval x <= eval y then expr else Prod(normal y, normal x) | _ -> expr match expr with | Const c -> expr | Sum(x, y) -> norm (Sum(normal x, normal y)) | Prod(x, y) -> norm (Prod(normal x, normal y)) | Diff(x, y) -> Diff(normal x, normal y) | Quot(x, y) -> Quot(normal x, normal y)
let rec insert v = function
| [] -> v | x::xs as li -> (v::li) :: (List.map (fun y -> x::y) (insert v xs))
let permutations li =
List.foldBack (fun x z -> List.concat (List.map (insert x) z)) li [[]]
let rec comp expr rest = seq {
match rest with | x::xs -> yield! comp (Sum (expr, x)) xs; yield! comp (Diff(x, expr)) xs; yield! comp (Diff(expr, x)) xs; yield! comp (Prod(expr, x)) xs; yield! comp (Quot(x, expr)) xs; yield! comp (Quot(expr, x)) xs; | [] -> if eval expr = Rat(24,1) then yield print_expr (normal expr)
}
[<EntryPoint>] let main argv =
let digits = List.init 4 (fun i -> Const (Rat(argv.[i],""))) let solutions = permutations digits |> Seq.groupBy (sprintf "%A") |> Seq.map snd |> Seq.map Seq.head |> Seq.map (fun x -> comp (List.head x) (List.tail x)) |> Seq.choose (fun x -> if Seq.isEmpty x then None else Some x) |> Seq.concat if Seq.isEmpty solutions then printfn "No solutions." else solutions |> Seq.groupBy id |> Seq.iter (fun x -> printfn "%s" (fst x)) 0</lang>
- Output:
>solve24 3 3 3 4 4 * (3 * 3 - 3) 3 + 3 * (3 + 4) >solve24 3 3 3 5 No solutions. solve24 3 3 3 6 6 + 3 * (3 + 3) (3 / 3 + 3) * 6 3 * (3 + 6) - 3 3 + 3 + 3 * 6 >solve24 3 3 8 8 8 / (3 - 8 / 3) >solve24 3 8 8 9 3 * (9 - 8 / 8) (9 - 8) * 3 * 8 3 / (9 - 8) * 8 8 / ((9 - 8) / 3) 3 * (9 - 8) * 8 3 * 8 / (9 - 8) 3 / ((9 - 8) / 8)
Fortran
<lang Fortran>program solve_24
use helpers implicit none real :: vector(4), reals(4), p, q, r, s integer :: numbers(4), n, i, j, k, a, b, c, d character, parameter :: ops(4) = (/ '+', '-', '*', '/' /) logical :: last real,parameter :: eps = epsilon(1.0)
do n=1,12 call random_number(vector) reals = 9 * vector + 1 numbers = int(reals) call Insertion_Sort(numbers) permutations: do a = numbers(1); b = numbers(2); c = numbers(3); d = numbers(4) reals = real(numbers) p = reals(1); q = reals(2); r = reals(3); s = reals(4) ! combinations of operators: do i=1,4 do j=1,4 do k=1,4 if ( abs(op(op(op(p,i,q),j,r),k,s)-24.0) < eps ) then write (*,*) numbers, ' : ', '((',a,ops(i),b,')',ops(j),c,')',ops(k),d exit permutations else if ( abs(op(op(p,i,op(q,j,r)),k,s)-24.0) < eps ) then write (*,*) numbers, ' : ', '(',a,ops(i),'(',b,ops(j),c,'))',ops(k),d exit permutations else if ( abs(op(p,i,op(op(q,j,r),k,s))-24.0) < eps ) then write (*,*) numbers, ' : ', a,ops(i),'((',b,ops(j),c,')',ops(k),d,')' exit permutations else if ( abs(op(p,i,op(q,j,op(r,k,s)))-24.0) < eps ) then write (*,*) numbers, ' : ', a,ops(i),'(',b,ops(j),'(',c,ops(k),d,'))' exit permutations else if ( abs(op(op(p,i,q),j,op(r,k,s))-24.0) < eps ) then write (*,*) numbers, ' : ', '(',a,ops(i),b,')',ops(j),'(',c,ops(k),d,')' exit permutations end if end do end do end do call nextpermutation(numbers,last) if ( last ) then write (*,*) numbers, ' : no solution.' exit permutations end if end do permutations
end do
contains
pure real function op(x,c,y) integer, intent(in) :: c real, intent(in) :: x,y select case ( ops(c) ) case ('+') op = x+y case ('-') op = x-y case ('*') op = x*y case ('/') op = x/y end select end function op
end program solve_24</lang>
<lang Fortran>module helpers
contains
pure subroutine Insertion_Sort(a) integer, intent(inout) :: a(:) integer :: temp, i, j do i=2,size(a) j = i-1 temp = a(i) do while ( j>=1 .and. a(j)>temp ) a(j+1) = a(j) j = j - 1 end do a(j+1) = temp end do end subroutine Insertion_Sort
subroutine nextpermutation(perm,last) integer, intent(inout) :: perm(:) logical, intent(out) :: last integer :: k,l k = largest1() last = k == 0 if ( .not. last ) then l = largest2(k) call swap(l,k) call reverse(k) end if contains pure integer function largest1() integer :: k, max max = 0 do k=1,size(perm)-1 if ( perm(k) < perm(k+1) ) then max = k end if end do largest1 = max end function largest1
pure integer function largest2(k) integer, intent(in) :: k integer :: l, max max = k+1 do l=k+2,size(perm) if ( perm(k) < perm(l) ) then max = l end if end do largest2 = max end function largest2
subroutine swap(l,k) integer, intent(in) :: k,l integer :: temp temp = perm(k) perm(k) = perm(l) perm(l) = temp end subroutine swap subroutine reverse(k) integer, intent(in) :: k integer :: i do i=1,(size(perm)-k)/2 call swap(k+i,size(perm)+1-i) end do end subroutine reverse end subroutine nextpermutation
end module helpers</lang>
- Output:
(using g95)
3 6 7 9 : 3 *(( 6 - 7 )+ 9 ) 3 9 5 8 : (( 3 * 9 )+ 5 )- 8 4 5 6 9 : (( 4 + 5 )+ 6 )+ 9 2 9 9 8 : ( 2 +( 9 / 9 ))* 8 1 4 7 5 : ( 1 +( 4 * 7 ))- 5 8 7 7 6 : no solution. 3 3 8 9 : ( 3 *( 3 + 8 ))- 9 1 5 6 7 : ( 1 +( 5 * 6 ))- 7 2 3 5 3 : 2 *(( 3 * 5 )- 3 ) 4 5 6 9 : (( 4 + 5 )+ 6 )+ 9 1 1 3 6 : ( 1 +( 1 * 3 ))* 6 2 4 6 8 : (( 2 / 4 )* 6 )* 8
GAP
<lang gap># Solution in RPN check := function(x, y, z) local r, c, s, i, j, k, a, b, p; i := 0; j := 0; k := 0; s := [ ]; r := ""; for c in z do if c = 'x' then i := i + 1; k := k + 1; s[k] := x[i]; Append(r, String(x[i])); else j := j + 1; b := s[k]; k := k - 1; a := s[k]; p := y[j]; r[Size(r) + 1] := p; if p = '+' then a := a + b; elif p = '-' then a := a - b; elif p = '*' then a := a * b; elif p = '/' then if b = 0 then continue; else a := a / b; fi; else return fail; fi; s[k] := a; fi; od; if s[1] = 24 then return r; else return fail; fi; end;
Player24 := function(digits) local u, v, w, x, y, z, r; u := PermutationsList(digits); v := Tuples("+-*/", 3); w := ["xx*x*x*", "xx*xx**", "xxx**x*", "xxx*x**", "xxxx***"]; for x in u do for y in v do for z in w do r := check(x, y, z); if r <> fail then return r; fi; od; od; od; return fail; end;
Player24([1,2,7,7]);
- "77*1-2/"
Player24([9,8,7,6]);
- "68*97-/"
Player24([1,1,7,7]);
- fail
- Solutions with only one distinct digit are found only for 3, 4, 5, 6:
Player24([3,3,3,3]);
- "33*3*3-"
Player24([4,4,4,4]);
- "44*4+4+"
Player24([5,5,5,5]);
- "55*55/-"
Player24([6,6,6,6]);
- "66*66+-"
- A tricky one:
Player24([3,3,8,8]); "8383/-/"</lang>
Go
<lang go>package main
import ( "fmt" "math/rand" "time" )
const ( op_num = iota op_add op_sub op_mul op_div )
type frac struct { num, denom int }
// Expression: can either be a single number, or a result of binary // operation from left and right node type Expr struct { op int left, right *Expr value frac }
var n_cards = 4 var goal = 24 var digit_range = 9
func (x *Expr) String() string { if x.op == op_num { return fmt.Sprintf("%d", x.value.num) }
var bl1, br1, bl2, br2, opstr string switch { case x.left.op == op_num: case x.left.op >= x.op: case x.left.op == op_add && x.op == op_sub: bl1, br1 = "", "" default: bl1, br1 = "(", ")" }
if x.right.op == op_num || x.op < x.right.op { bl2, br2 = "", "" } else { bl2, br2 = "(", ")" }
switch { case x.op == op_add: opstr = " + " case x.op == op_sub: opstr = " - " case x.op == op_mul: opstr = " * " case x.op == op_div: opstr = " / " }
return bl1 + x.left.String() + br1 + opstr + bl2 + x.right.String() + br2 }
func expr_eval(x *Expr) (f frac) { if x.op == op_num { return x.value }
l, r := expr_eval(x.left), expr_eval(x.right)
switch x.op { case op_add: f.num = l.num*r.denom + l.denom*r.num f.denom = l.denom * r.denom return
case op_sub: f.num = l.num*r.denom - l.denom*r.num f.denom = l.denom * r.denom return
case op_mul: f.num = l.num * r.num f.denom = l.denom * r.denom return
case op_div: f.num = l.num * r.denom f.denom = l.denom * r.num return } return }
func solve(ex_in []*Expr) bool { // only one expression left, meaning all numbers are arranged into // a binary tree, so evaluate and see if we get 24 if len(ex_in) == 1 { f := expr_eval(ex_in[0]) if f.denom != 0 && f.num == f.denom*goal { fmt.Println(ex_in[0].String()) return true } return false }
var node Expr ex := make([]*Expr, len(ex_in)-1)
// try to combine a pair of expressions into one, thus reduce // the list length by 1, and recurse down for i := range ex { copy(ex[i:len(ex)], ex_in[i+1:len(ex_in)])
ex[i] = &node for j := i + 1; j < len(ex_in); j++ { node.left = ex_in[i] node.right = ex_in[j]
// try all 4 operators for o := op_add; o <= op_div; o++ { node.op = o if solve(ex) { return true } }
// also - and / are not commutative, so swap arguments node.left = ex_in[j] node.right = ex_in[i]
node.op = op_sub if solve(ex) { return true }
node.op = op_div if solve(ex) { return true }
if j < len(ex) { ex[j] = ex_in[j] } } ex[i] = ex_in[i] } return false }
func main() { cards := make([]*Expr, n_cards) rand.Seed(time.Now().Unix())
for k := 0; k < 10; k++ { for i := 0; i < n_cards; i++ { cards[i] = &Expr{op_num, nil, nil, frac{rand.Intn(digit_range-1) + 1, 1}} fmt.Printf(" %d", cards[i].value.num) } fmt.Print(": ") if !solve(cards) { fmt.Println("No solution") } } }</lang>
- Output:
8 6 7 6: No solution 7 2 6 6: (7 - 2) * 6 - 6 4 8 7 3: 4 * (7 - 3) + 8 3 8 8 7: 3 * 8 * (8 - 7) 5 7 3 7: No solution 5 7 8 3: 5 * 7 - 8 - 3 3 6 5 2: ((3 + 5) * 6) / 2 8 4 5 4: (8 - 4) * 5 + 4 2 2 8 8: (2 + 2) * 8 - 8 6 8 8 2: 6 + 8 + 8 + 2
Gosu
<lang Gosu> uses java.lang.Integer uses java.lang.Double uses java.lang.System uses java.util.ArrayList uses java.util.LinkedList uses java.util.List uses java.util.Scanner uses java.util.Stack
function permutations<T>( lst : List<T> ) : List<List<T>> {
if( lst.size() == 0 ) return {} if( lst.size() == 1 ) return { lst }
var pivot = lst.get(lst.size()-1)
var sublist = new ArrayList<T>( lst ) sublist.remove( sublist.size() - 1 )
var subPerms = permutations( sublist )
var ret = new ArrayList<List<T>>() for( x in subPerms ) { for( e in x index i ) { var next = new LinkedList<T>( x ) next.add( i, pivot ) ret.add( next ) } x.add( pivot ) ret.add( x ) } return ret
}
function readVals() : List<Integer> {
var line = new java.io.BufferedReader( new java.io.InputStreamReader( System.in ) ).readLine() var scan = new Scanner( line )
var ret = new ArrayList<Integer>() for( i in 0..3 ) { var next = scan.nextInt() if( 0 >= next || next >= 10 ) { print( "Invalid entry: ${next}" ) return null } ret.add( next ) } return ret
}
function getOp( i : int ) : char[] {
var ret = new char[3] var ops = { '+', '-', '*', '/' } ret[0] = ops[i / 16] ret[1] = ops[(i / 4) % 4 ] ret[2] = ops[i % 4 ] return ret
}
function isSoln( nums : List<Integer>, ops : char[] ) : boolean {
var stk = new Stack<Double>() for( n in nums ) { stk.push( n ) }
for( c in ops ) { var r = stk.pop().doubleValue() var l = stk.pop().doubleValue() if( c == '+' ) { stk.push( l + r ) } else if( c == '-' ) { stk.push( l - r ) } else if( c == '*' ) { stk.push( l * r ) } else if( c == '/' ) { // Avoid division by 0 if( r == 0.0 ) { return false } stk.push( l / r ) } }
return java.lang.Math.abs( stk.pop().doubleValue() - 24.0 ) < 0.001
}
function printSoln( nums : List<Integer>, ops : char[] ) {
// RPN: a b c d + - * // Infix (a * (b - (c + d))) print( "Found soln: (${nums.get(0)} ${ops[0]} (${nums.get(1)} ${ops[1]} (${nums.get(2)} ${ops[2]} ${nums.get(3)})))" )
}
System.out.print( "#> " ) var vals = readVals()
var opPerms = 0..63 var solnFound = false
for( i in permutations( vals ) ) {
for( j in opPerms ) { var opList = getOp( j ) if( isSoln( i, opList ) ) { printSoln( i, opList ) solnFound = true } }
}
if( ! solnFound ) {
print( "No solution!" )
} </lang>
Haskell
<lang 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)</lang>
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)))
Alternative version
<lang haskell>import Control.Applicative import Data.List import Text.PrettyPrint
data Expr = C Int | Op String Expr Expr
toDoc (C x ) = int x toDoc (Op op x y) = parens $ toDoc x <+> text op <+> toDoc y
ops :: [(String, Int -> Int -> Int)] ops = [("+",(+)), ("-",(-)), ("*",(*)), ("/",div)]
solve :: Int -> [Int] -> [Expr]
solve res = filter ((Just res ==) . eval) . genAst
where genAst [x] = [C x] genAst xs = do (ys,zs) <- split xs let f (Op op _ _) = op `notElem` ["+","*"] || ys <= zs filter f $ Op <$> map fst ops <*> genAst ys <*> genAst zs
eval (C x ) = Just x eval (Op "/" _ y) | Just 0 <- eval y = Nothing eval (Op op x y) = lookup op ops <*> eval x <*> eval y
select :: Int -> [Int] -> Int
select 0 _ = [[]]
select n xs = [x:zs | k <- [0..length xs - n]
, let (x:ys) = drop k xs , zs <- select (n - 1) ys ]
split :: [Int] -> [([Int],[Int])] split xs = [(ys, xs \\ ys) | n <- [1..length xs - 1]
, ys <- nub . sort $ select n xs ]
main = mapM_ (putStrLn . render . toDoc) $ solve 24 [2,3,8,9]</lang>
- Output:
((8 / 2) * (9 - 3)) ((2 / 9) + (3 * 8)) ((3 * 8) - (2 / 9)) ((8 - (2 / 9)) * 3) (((2 / 9) + 8) * 3) (((8 + 9) / 2) * 3) ((2 + (8 * 9)) / 3) ((3 - (2 / 9)) * 8) ((9 - (2 * 3)) * 8) (((2 / 9) + 3) * 8) (((2 + 9) / 3) * 8) (((9 - 3) / 2) * 8) (((9 - 3) * 8) / 2)
Icon and Unicon
This shares code with and solves the 24 game. A series of pattern expressions are built up and then populated with the permutations of the selected digits. Equations are skipped if they have been seen before. The procedure 'eval' was modified to catch zero divides. The solution will find either all occurrences or just the first occurrence of a solution.
<lang Icon>invocable all link strings # for csort, deletec, permutes
procedure main() static eL initial {
eoP := [] # set-up expression and operator permutation patterns every ( e := !["a@b#c$d", "a@(b#c)$d", "a@b#(c$d)", "a@(b#c$d)", "a@(b#(c$d))"] ) & ( o := !(opers := "+-*/") || !opers || !opers ) do put( eoP, map(e,"@#$",o) ) # expr+oper perms eL := [] # all cases every ( e := !eoP ) & ( p := permutes("wxyz") ) do put(eL, map(e,"abcd",p))
}
write("This will attempt to find solutions to 24 for sets of numbers by\n",
"combining 4 single digits between 1 and 9 to make 24 using only + - * / and ( ).\n", "All operations have equal precedence and are evaluated left to right.\n", "Enter 'use n1 n2 n3 n4' or just hit enter (to use a random set),", "'first'/'all' shows the first or all solutions, 'quit' to end.\n\n")
repeat {
e := trim(read()) | fail e ? case tab(find(" ")|0) of { "q"|"quit" : break "u"|"use" : e := tab(0) "f"|"first": first := 1 & next "a"|"all" : first := &null & next "" : e := " " ||(1+?8) || " " || (1+?8) ||" " || (1+?8) || " " || (1+?8) } writes("Attempting to solve 24 for",e) e := deletec(e,' \t') # no whitespace if e ? ( tab(many('123456789')), pos(5), pos(0) ) then write(":") else write(" - invalid, only the digits '1..9' are allowed.") & next eS := set() every ex := map(!eL,"wxyz",e) do { if member(eS,ex) then next # skip duplicates of final expression insert(eS,ex) if ex ? (ans := eval(E()), pos(0)) then # parse and evaluate if ans = 24 then { write("Success ",image(ex)," evaluates to 24.") if \first then break } } }
write("Quiting.") end
procedure eval(X) #: return the evaluated AST
if type(X) == "list" then { x := eval(get(X)) while o := get(X) do if y := get(X) then x := o( real(x), (o ~== "/" | fail, eval(y) )) else write("Malformed expression.") & fail } return \x | X
end
procedure E() #: expression
put(lex := [],T()) while put(lex,tab(any('+-*/'))) do put(lex,T()) suspend if *lex = 1 then lex[1] else lex # strip useless []
end
procedure T() #: Term
suspend 2(="(", E(), =")") | # parenthesized subexpression, or ... tab(any(&digits)) # just a value
end</lang>
strings.icn provides deletec and permutes
J
<lang 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</lang>
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.]
Java
Playable version, will print solution on request. <lang java>import java.util.*;
public class Game24Player {
final String[] patterns = {"nnonnoo", "nnonono", "nnnoono", "nnnonoo", "nnnnooo"}; final String ops = "+-*/^";
String solution; List<Integer> digits;
public static void main(String[] args) { new Game24Player().play(); }
void play() { digits = getSolvableDigits();
Scanner in = new Scanner(System.in); while (true) { System.out.print("Make 24 using these digits: "); System.out.println(digits); System.out.println("(Enter 'q' to quit, 's' for a solution)"); System.out.print("> ");
String line = in.nextLine(); if (line.equalsIgnoreCase("q")) { System.out.println("\nThanks for playing"); return; }
if (line.equalsIgnoreCase("s")) { System.out.println(solution); digits = getSolvableDigits(); continue; }
char[] entry = line.replaceAll("[^*+-/)(\\d]", "").toCharArray();
try { validate(entry);
if (evaluate(infixToPostfix(entry))) { System.out.println("\nCorrect! Want to try another? "); digits = getSolvableDigits(); } else { System.out.println("\nNot correct."); }
} catch (Exception e) { System.out.printf("%n%s Try again.%n", e.getMessage()); } } }
void validate(char[] input) throws Exception { int total1 = 0, parens = 0, opsCount = 0;
for (char c : input) { if (Character.isDigit(c)) total1 += 1 << (c - '0') * 4; else if (c == '(') parens++; else if (c == ')') parens--; else if (ops.indexOf(c) != -1) opsCount++; if (parens < 0) throw new Exception("Parentheses mismatch."); }
if (parens != 0) throw new Exception("Parentheses mismatch.");
if (opsCount != 3) throw new Exception("Wrong number of operators.");
int total2 = 0; for (int d : digits) total2 += 1 << d * 4;
if (total1 != total2) throw new Exception("Not the same digits."); }
boolean evaluate(char[] line) throws Exception { Stack<Float> s = new Stack<>(); try { for (char c : line) { if ('0' <= c && c <= '9') s.push((float) c - '0'); else s.push(applyOperator(s.pop(), s.pop(), c)); } } catch (EmptyStackException e) { throw new Exception("Invalid entry."); } return (Math.abs(24 - s.peek()) < 0.001F); }
float applyOperator(float a, float b, char c) { switch (c) { case '+': return a + b; case '-': return b - a; case '*': return a * b; case '/': return b / a; default: return Float.NaN; } }
List<Integer> randomDigits() { Random r = new Random(); List<Integer> result = new ArrayList<>(4); for (int i = 0; i < 4; i++) result.add(r.nextInt(9) + 1); return result; }
List<Integer> getSolvableDigits() { List<Integer> result; do { result = randomDigits(); } while (!isSolvable(result)); return result; }
boolean isSolvable(List<Integer> digits) { Set<List<Integer>> dPerms = new HashSet<>(4 * 3 * 2); permute(digits, dPerms, 0);
int total = 4 * 4 * 4; List<List<Integer>> oPerms = new ArrayList<>(total); permuteOperators(oPerms, 4, total);
StringBuilder sb = new StringBuilder(4 + 3);
for (String pattern : patterns) { char[] patternChars = pattern.toCharArray();
for (List<Integer> dig : dPerms) { for (List<Integer> opr : oPerms) {
int i = 0, j = 0; for (char c : patternChars) { if (c == 'n') sb.append(dig.get(i++)); else sb.append(ops.charAt(opr.get(j++))); }
String candidate = sb.toString(); try { if (evaluate(candidate.toCharArray())) { solution = postfixToInfix(candidate); return true; } } catch (Exception ignored) { } sb.setLength(0); } } } return false; }
String postfixToInfix(String postfix) { class Expression { String op, ex; int prec = 3;
Expression(String e) { ex = e; }
Expression(String e1, String e2, String o) { ex = String.format("%s %s %s", e1, o, e2); op = o; prec = ops.indexOf(o) / 2; } }
Stack<Expression> expr = new Stack<>();
for (char c : postfix.toCharArray()) { int idx = ops.indexOf(c); if (idx != -1) {
Expression r = expr.pop(); Expression l = expr.pop();
int opPrec = idx / 2;
if (l.prec < opPrec) l.ex = '(' + l.ex + ')';
if (r.prec <= opPrec) r.ex = '(' + r.ex + ')';
expr.push(new Expression(l.ex, r.ex, "" + c)); } else { expr.push(new Expression("" + c)); } } return expr.peek().ex; }
char[] infixToPostfix(char[] infix) throws Exception { StringBuilder sb = new StringBuilder(); Stack<Integer> s = new Stack<>(); try { for (char c : infix) { int idx = ops.indexOf(c); if (idx != -1) { if (s.isEmpty()) s.push(idx); else { while (!s.isEmpty()) { int prec2 = s.peek() / 2; int prec1 = idx / 2; if (prec2 >= prec1) sb.append(ops.charAt(s.pop())); else break; } s.push(idx); } } else if (c == '(') { s.push(-2); } else if (c == ')') { while (s.peek() != -2) sb.append(ops.charAt(s.pop())); s.pop(); } else { sb.append(c); } } while (!s.isEmpty()) sb.append(ops.charAt(s.pop()));
} catch (EmptyStackException e) { throw new Exception("Invalid entry."); } return sb.toString().toCharArray(); }
void permute(List<Integer> lst, Set<List<Integer>> res, int k) { for (int i = k; i < lst.size(); i++) { Collections.swap(lst, i, k); permute(lst, res, k + 1); Collections.swap(lst, k, i); } if (k == lst.size()) res.add(new ArrayList<>(lst)); }
void permuteOperators(List<List<Integer>> res, int n, int total) { for (int i = 0, npow = n * n; i < total; i++) res.add(Arrays.asList((i / npow), (i % npow) / n, i % n)); }
}</lang>
- Output:
Make 24 using these digits: [5, 7, 1, 8] (Enter 'q' to quit, 's' for a solution) > (8-5) * (7+1) Correct! Want to try another? Make 24 using these digits: [3, 9, 2, 9] (Enter 'q' to quit, 's' for a solution) > (3*2) + 9 + 9 Correct! Want to try another? Make 24 using these digits: [4, 4, 8, 5] (Enter 'q' to quit, 's' for a solution) > s 4 * 5 - (4 - 8) Make 24 using these digits: [2, 5, 9, 1] (Enter 'q' to quit, 's' for a solution) > 2+5+9+1 Not correct. Make 24 using these digits: [2, 5, 9, 1] (Enter 'q' to quit, 's' for a solution) > 2 * 9 + 5 + 1 Correct! Want to try another? Make 24 using these digits: [8, 4, 3, 1] (Enter 'q' to quit, 's' for a solution) > s (8 + 4) * (3 - 1) Make 24 using these digits: [9, 4, 5, 6] (Enter 'q' to quit, 's' for a solution) > (9 +4) * 2 - 2 Not the same digits. Try again. Make 24 using these digits: [9, 4, 5, 6] (Enter 'q' to quit, 's' for a solution) > q Thanks for playing
JavaScript
This is a translation of the C code. <lang javascript>var ar=[],order=[0,1,2],op=[],val=[]; var NOVAL=9999,oper="+-*/",out;
function rnd(n){return Math.floor(Math.random()*n)}
function say(s){
try{document.write(s+"
")} catch(e){WScript.Echo(s)}
}
function getvalue(x,dir){
var r=NOVAL; if(dir>0)++x; while(1){ if(val[x]!=NOVAL){ r=val[x]; val[x]=NOVAL; break; } x+=dir; } return r*1;
}
function calc(){
var c=0,l,r,x; val=ar.join('/').split('/'); while(c<3){ x=order[c]; l=getvalue(x,-1); r=getvalue(x,1); switch(op[x]){ case 0:val[x]=l+r;break; case 1:val[x]=l-r;break; case 2:val[x]=l*r;break; case 3: if(!r||l%r)return 0; val[x]=l/r; } ++c; } return getvalue(-1,1);
}
function shuffle(s,n){
var x=n,p=eval(s),r,t; while(x--){ r=rnd(n); t=p[x]; p[x]=p[r]; p[r]=t; }
}
function parenth(n){
while(n>0)--n,out+='('; while(n<0)++n,out+=')';
}
function getpriority(x){
for(var z=3;z--;)if(order[z]==x)return 3-z; return 0;
}
function showsolution(){
var x=0,p=0,lp=0,v=0; while(x<4){ if(x<3){ lp=p; p=getpriority(x); v=p-lp; if(v>0)parenth(v); } out+=ar[x]; if(x<3){ if(v<0)parenth(v); out+=oper.charAt(op[x]); } ++x; } parenth(-p); say(out);
}
function solve24(s){
var z=4,r; while(z--)ar[z]=s.charCodeAt(z)-48; out=""; for(z=100000;z--;){ r=rnd(256); op[0]=r&3; op[1]=(r>>2)&3; op[2]=(r>>4)&3; shuffle("ar",4); shuffle("order",3); if(calc()!=24)continue; showsolution(); break; }
}
solve24("1234"); solve24("6789"); solve24("1127");</lang>
Examples:
(((3*1)*4)*2) ((6*8)/((9-7))) (((1+7))*(2+1))
Julia
<lang julia>function solve24(nums)
length(nums) != 4 && error("Input must be a 4-element Array") syms = [+,-,*,/] for x in syms, y in syms, z in syms for i = 1:24 a,b,c,d = nthperm(nums,i) if round(x(y(a,b),z(c,d)),5) == 24 return "($a$y$b)$x($c$z$d)" elseif round(x(a,y(b,z(c,d))),5) == 24 return "$a$x($b$y($c$z$d))" elseif round(x(y(z(c,d),b),a),5) == 24 return "(($c$z$d)$y$b)$x$a" elseif round(x(y(b,z(c,d)),a),5) == 24 return "($b$y($c$z$d))$x$a" end end end return "0"
end</lang>
- Output:
julia> solve24([6, 8, 2, 8]) "(6+8)+(2+8)" julia> solve24([4, 2, 8, 1]) "8*(4+(1-2))" julia> solve24([3, 1, 9, 9])# "(9-1)*(9/3)" julia> solve24([5, 7, 5, 1])# "0" julia> solve24([5, 8, 4, 1]) "8+(4*(5-1))" julia> solve24([8, 3, 4, 9]) "(8+3)+(4+9)" julia> solve24([3, 7, 4, 4])# "4*(3+(7-4))" julia> solve24([5, 6, 4, 1]) "4/(1-(5/6))" julia> solve24([5, 5, 9, 8]) "(8-9)+(5*5)"
Liberty BASIC
<lang lb>dim d(4) input "Enter 4 digits: "; a$ nD=0 for i =1 to len(a$)
c$=mid$(a$,i,1) if instr("123456789",c$) then nD=nD+1 d(nD)=val(c$) end if
next 'for i = 1 to 4 ' print d(i); 'next
'precompute permutations. Dumb way. nPerm = 1*2*3*4 dim perm(nPerm, 4) n = 0 for i = 1 to 4
for j = 1 to 4 for k = 1 to 4 for l = 1 to 4 'valid permutation (no dupes?) if i<>j and i<>k and i<>l _ and j<>k and j<>l _ and k<>l then n=n+1 '
' perm(n,1)=i ' perm(n,2)=j ' perm(n,3)=k ' perm(n,4)=l
'actually, we can as well permute given digits perm(n,1)=d(i) perm(n,2)=d(j) perm(n,3)=d(k) perm(n,4)=d(l) end if next next next
next 'check if permutations look OK. They are 'for i =1 to n ' print i, ' for j =1 to 4: print perm(i,j);:next ' print 'next
'possible brackets NBrackets = 11 dim Brakets$(NBrackets) DATA "4#4#4#4" DATA "(4#4)#4#4" DATA "4#(4#4)#4" DATA "4#4#(4#4)" DATA "(4#4)#(4#4)" DATA "(4#4#4)#4" DATA "4#(4#4#4)" DATA "((4#4)#4)#4" DATA "(4#(4#4))#4" DATA "4#((4#4)#4)" DATA "4#(4#(4#4))" for i = 1 to NBrackets
read Tmpl$: Brakets$(i) = Tmpl$
next
'operations: full search count = 0 Ops$="+ - * /" dim Op$(3) For op1=1 to 4
Op$(1)=word$(Ops$,op1) For op2=1 to 4 Op$(2)=word$(Ops$,op2) For op3=1 to 4 Op$(3)=word$(Ops$,op3) 'print "*" 'substitute all brackets for t = 1 to NBrackets Tmpl$=Brakets$(t) 'print , Tmpl$ 'now, substitute all digits: permutations. for p = 1 to nPerm res$= "" nOp=0 nD=0 for i = 1 to len(Tmpl$) c$ = mid$(Tmpl$, i, 1) select case c$ case "#" 'operations nOp = nOp+1 res$ = res$+Op$(nOp) case "4" 'digits nD = nOp+1 res$ = res$; perm(p,nD) case else 'brackets goes here res$ = res$+ c$ end select next 'print,, res$ 'eval here if evalWithErrCheck(res$) = 24 then print "24 = ";res$ end 'comment it out if you want to see all versions end if count = count + 1 next next Next Next
next
print "If you see this, probably task cannot be solved with these digits" 'print count end
function evalWithErrCheck(expr$)
on error goto [handler] evalWithErrCheck=eval(expr$) exit function
[handler] end function</lang>
Lua
Generic solver: pass card of any size with 1st argument and target number with second.
<lang lua> local SIZE = #arg[1] local GOAL = tonumber(arg[2]) or 24
local input = {} for v in arg[1]:gmatch("%d") do table.insert(input, v) end assert(#input == SIZE, 'Invalid input')
local operations = {'+', '-', '*', '/'}
local function BinaryTrees(vert) if vert == 0 then return {false} else local buf = {} for leften = 0, vert - 1 do local righten = vert - leften - 1 for _, left in pairs(BinaryTrees(leften)) do for _, right in pairs(BinaryTrees(righten)) do table.insert(buf, {left, right}) end end end return buf end end local trees = BinaryTrees(SIZE-1) local c, opc, oper, str local max = math.pow(#operations, SIZE-1) local function op(a,b) opc = opc + 1 local i = math.floor(oper/math.pow(#operations, opc-1))%#operations+1 return '('.. a .. operations[i] .. b ..')' end
local function EvalTree(tree) if tree == false then c = c + 1 return input[c-1] else return op(EvalTree(tree[1]), EvalTree(tree[2])) end end
local function printResult() for _, v in ipairs(trees) do for i = 0, max do c, opc, oper = 1, 0, i str = EvalTree(v) loadstring('res='..str)() if(res == GOAL) then print(str, '=', res) end end end end
local uniq = {} local function permgen (a, n) if n == 0 then local str = table.concat(a) if not uniq[str] then printResult() uniq[str] = true end else for i = 1, n do a[n], a[i] = a[i], a[n] permgen(a, n - 1) a[n], a[i] = a[i], a[n] end end end
permgen(input, SIZE) </lang>
- Output:
$ lua 24game.solve.lua 2389 (8*(9-(3*2))) = 24 (8*((9-3)/2)) = 24 ((8*(9-3))/2) = 24 ((9-3)*(8/2)) = 24 (((9-3)*8)/2) = 24 (8*(9-(2*3))) = 24 (8/(2/(9-3))) = 24 ((8/2)*(9-3)) = 24 ((9-3)/(2/8)) = 24 ((9-(3*2))*8) = 24 (((9-3)/2)*8) = 24 ((9-(2*3))*8) = 24 $ lua 24game.solve.lua 1172 ((1+7)*(2+1)) = 24 ((7+1)*(2+1)) = 24 ((1+2)*(7+1)) = 24 ((2+1)*(7+1)) = 24 ((1+2)*(1+7)) = 24 ((2+1)*(1+7)) = 24 ((1+7)*(1+2)) = 24 ((7+1)*(1+2)) = 24 $ lua 24game.solve.lua 123456789 1000 (2*(3+(4-(5+(6-(7*(8*(9*1)))))))) = 1000 (2*(3+(4-(5+(6-(7*(8*(9/1)))))))) = 1000 (2*(3*(4*(5+(6*(7-(8/(9*1)))))))) = 1000 (2*(3*(4*(5+(6*(7-(8/(9/1)))))))) = 1000 (2*(3+(4-(5+(6-(7*((8*9)*1))))))) = 1000 (2*(3+(4-(5+(6-(7*((8*9)/1))))))) = 1000 (2*(3*(4*(5+(6*(7-((8/9)*1))))))) = 1000 (2*(3*(4*(5+(6*(7-((8/9)/1))))))) = 1000 .....
Mathematica
The code: <lang Mathematica> 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] :> #2q, n[q_] :> #3q} &, 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_] :> valq) == 24] &] /. Table[v[q] -> valq, {q, 4}])]</lang>
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 (
Tuples
allows 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 (
Permutations
does 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
Outer
and 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
Quiet
ly 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
HoldForm
so 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 "
<lang Mathematica>game24play[RandomInteger[{1, 9}, 4]]</lang>
- Output:
{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 permutations.
Therefore, the size of the working set is , where 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, ...}.
OCaml
<lang 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 = function (* prec is the current precedence *) | 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 = function
| [] -> v | x::xs as li -> (v::li) :: (List.map (fun y -> x::y) (insert v xs))
let permutations li =
List.fold_right (fun x z -> List.concat (List.map (insert x) z)) 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 (function | x::xs -> comp x xs | [] -> assert false ) all</lang>
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)
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
<lang Perl># Fischer-Krause ordered permutation generator
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; } } } }</lang>
- Output:
E:\Temp>24solve.pl Enter four integers or 'q' to exit: 1 3 3 8 ((1 + 8) * 3) - 3 ((1 + 8) * 3) - 3 ((8 + 1) * 3) - 3 ((8 - 1) * 3) + 3 ((8 + 1) * 3) - 3 ((8 - 1) * 3) + 3 (3 * (1 + 8)) - 3 (3 * (8 + 1)) - 3 (3 * (8 - 1)) + 3 (3 * (1 + 8)) - 3 (3 * (8 + 1)) - 3 (3 * (8 - 1)) + 3 3 - ((1 - 8) * 3) 3 + ((8 - 1) * 3) 3 - ((1 - 8) * 3) 3 + ((8 - 1) * 3) 3 - (3 * (1 - 8)) 3 + (3 * (8 - 1)) 3 - (3 * (1 - 8)) 3 + (3 * (8 - 1)) Enter four integers or 'q' to exit: q E:\Temp>
Perl 6
A loose translation of the Perl entry. Does not return every possible permutation of the possible solutions. Filters out duplicates (from repeated digits) and only reports the solution for a particular order of digits and operators with the fewest parenthesis (avoids reporting duplicate solutions only differing by unnecessary parenthesis).
Since Perl 6 uses Rational numbers for division (whenever possible) there is no loss of precision as is common with floating point division. So a comparison like (1 + 7) / (1 / 3) == 24 "Just Works"™
<lang Perl6>my @digits; my $amount = 4;
- Get $amount digits from the user,
- ask for more if they don't supply enough
while @digits.elems < $amount {
@digits ,= (prompt "Enter {$amount - @digits} digits from 1 to 9, " ~ '(repeats allowed): ').comb(/<[1..9]>/);
}
- Throw away any extras
@digits = @digits[^$amount];
- Generate combinations of operators
my @op = <+ - * />; my @ops = map {my $a = $_; map {my $b = $_; map {[$a,$b,$_]}, @op}, @op}, @op;
- Enough sprintf formats to cover most precedence orderings
my @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)', '%d %s (%d %s %d %s %d)', '%d %s (%d %s (%d %s %d))',
);
- Brute force test the different permutations
for unique permutations @digits -> @p {
for @ops -> @o { for @formats -> $format { my $string = sprintf $format, @p[0], @o[0], @p[1], @o[1], @p[2], @o[2], @p[3]; my $result = try { eval($string) }; say "$string = 24" and last if $result and $result == 24; } }
}
- Perl 6 translation of Fischer-Krause ordered permutation algorithm
sub permutations (@array) {
my @index = ^@array; my $last = @index[*-1]; my (@permutations, $rev, $fwd); loop { push @permutations, [@array[@index]]; $rev = $last; --$rev while $rev and @index[$rev-1] > @index[$rev]; return @permutations unless $rev; $fwd = $rev; push @index, @index.splice($rev).reverse;
++$fwd while @index[$rev-1] > @index[$fwd]; @index[$rev-1,$fwd] = @index[$fwd,$rev-1];
}
}
- Only return unique sub-arrays
sub unique (@array) {
my %h = map { $_.Str => $_ }, @array; %h.values;
} </lang>
- Output:
Enter 4 digits from 1 to 9, (repeats allowed): 3711 3 * (7 + 1 * 1) = 24 3 * (7 + 1 / 1) = 24 3 * (7 * 1 + 1) = 24 3 * (7 / 1 + 1) = 24 (3 + 1) * (7 - 1) = 24 3 * (1 + 7 * 1) = 24 3 * (1 + 7 / 1) = 24 (3 * 1) * (7 + 1) = 24 (3 / 1) * (7 + 1) = 24 3 / (1 / (7 + 1)) = 24 3 * (1 + 1 * 7) = 24 (3 * 1) * (1 + 7) = 24 3 * (1 / 1 + 7) = 24 (3 / 1) * (1 + 7) = 24 3 / (1 / (1 + 7)) = 24 (7 + 1) * 3 * 1 = 24 (7 + 1) * 3 / 1 = 24 (7 - 1) * (3 + 1) = 24 (7 + 1) * 1 * 3 = 24 (7 + 1) / 1 * 3 = 24 (7 + 1) / (1 / 3) = 24 (7 - 1) * (1 + 3) = 24 (7 * 1 + 1) * 3 = 24 (7 / 1 + 1) * 3 = 24 (1 + 3) * (7 - 1) = 24 (1 * 3) * (7 + 1) = 24 (1 * 3) * (1 + 7) = 24 (1 + 7) * 3 * 1 = 24 (1 + 7) * 3 / 1 = 24 (1 + 7) * 1 * 3 = 24 (1 + 7) / 1 * 3 = 24 (1 + 7) / (1 / 3) = 24 (1 * 7 + 1) * 3 = 24 (1 + 1 * 7) * 3 = 24 (1 * 1 + 7) * 3 = 24 (1 / 1 + 7) * 3 = 24 Enter 4 digits from 1 to 9, (repeats allowed): 5 5 5 5 5 * 5 - 5 / 5 = 24 Enter 4 digits from 1 to 9, (repeats allowed): 8833 8 / (3 - 8 / 3) = 24
PicoLisp
We use Pilog (PicoLisp Prolog) to solve this task <lang PicoLisp>(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</lang>
- 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))
ProDOS
Note This example uses the math module: <lang ProDOS>editvar /modify -random- = <10
- a
editvar /newvar /withothervar /value=-random- /title=1 editvar /newvar /withothervar /value=-random- /title=2 editvar /newvar /withothervar /value=-random- /title=3 editvar /newvar /withothervar /value=-random- /title=4 printline These are your four digits: -1- -2- -3- -4- printline Use an algorithm to make the number 24. editvar /newvar /value=a /userinput=1 /title=Algorithm: do -a- if -a- /hasvalue 24 printline Your algorithm worked! & goto :b ( ) else printline Your algorithm did not work. editvar /newvar /value=b /userinput=1 /title=Do you want to see how you could have done it? if -b- /hasvalue y goto :c else goto :b
- b
editvar /newvar /value=c /userinput=1 /title=Do you want to play again? if -c- /hasvalue y goto :a else exitcurrentprogram
- c
editvar /newvar /value=do -1- + -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- - -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- / -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- * -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- + -2- - -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- + -2- / -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- + -2- * -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- + -2- + -3- - -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- + -2- + -3- / -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- + -2- + -3- * -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- - -2- - -3- - -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- / -2- / -3- / -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve editvar /newvar /value=do -1- * -2- * -3- * -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
- solve
printline you could have done it by doing -c- stoptask goto :b</lang>
- Output:
These are your four digits: 1 4 5 2 Use an algorithm to make the number 24. Algorithm: 4 + 2 - 5 + 1 Your algorithm did not work. Do you want to play again? y These are your four digits: 1 8 9 6 Use an algorithm to make the number 24. Algorithm: 1 + 8 + 9 + 6 Your algorithm worked! Do you want to play again? n
Prolog
Works with SWI-Prolog.
The game is generic, you can choose to play with a goal different of 24,
any number of numbers in other ranges than 1 .. 9 !
rdiv/2 is use instead of //2 to enable the program to solve difficult cases as [3 3 8 8].
<lang Prolog>play24(Len, Range, Goal) :- game(Len, Range, Goal, L, S), maplist(my_write, L), format(': ~w~n', [S]).
game(Len, Range, Value, L, S) :- length(L, Len), maplist(choose(Range), L), compute(L, Value, [], S).
choose(Range, V) :-
V is random(Range) + 1.
write_tree([M], [M]).
write_tree([+, M, N], S) :- write_tree(M, MS), write_tree(N, NS), append(MS, [+ | NS], S).
write_tree([-, M, N], S) :- write_tree(M, MS), write_tree(N, NS), ( is_add(N) -> append(MS, [-, '(' | NS], Temp), append(Temp, ')', S) ; append(MS, [- | NS], S)).
write_tree([Op, M, N], S) :-
member(Op, [*, /]),
write_tree(M, MS),
write_tree(N, NS),
( is_add(M) -> append(['(' | MS], [')'], TempM)
; TempM = MS),
( is_add(N) -> append(['(' | NS], [')'], TempN)
; TempN = NS),
append(TempM, [Op | TempN], S).
is_add([Op, _, _]) :- member(Op, [+, -]).
compute([Value], Value, _R-S1, S) :- write_tree(S1, S2), with_output_to(atom(S), maplist(write, S2)).
compute(L, Value, CS, S) :- select(M, L, L1), select(N, L1, L2), next_value(M, N, R, CS, Expr), compute([R|L2], Value, Expr, S).
next_value(M, N, R, CS,[[R - [+, M1, N1]] | CS2]) :- R is M+N, ( member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM ; M1 = [M], CS1 = CS ), ( member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN ; N1 = [N], CS2 = CS1 ).
next_value(M, N, R, CS,[[R - [-, M1, N1]] | CS2]) :- R is M-N, ( member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM ; M1 = [M], CS1 = CS ), ( member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN ; N1 = [N], CS2 = CS1 ).
next_value(M, N, R, CS,[[R - [*, M1, N1]] | CS2]) :- R is M*N, ( member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM ; M1 = [M], CS1 = CS ), ( member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN ; N1 = [N], CS2 = CS1 ).
next_value(M, N, R, CS,[[R - [/, M1, N1]] | CS2]) :- N \= 0, R is rdiv(M,N), ( member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM ; M1 = [M], CS1 = CS ), ( member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN ; N1 = [N], CS2 = CS1 ).
my_write(V) :- format('~w ', [V]).</lang>
- Output:
?- play24(4,9, 24). 6 2 3 4 : (6-2+4)*3 true ; 6 2 3 4 : 3*(6-2+4) true ; 6 2 3 4 : (6-2+4)*3 true ; 6 2 3 4 : 3*(6-2+4) true ; 6 2 3 4 : (6*2-4)*3 true ; 6 2 3 4 : 3*(6*2-4) true ; 6 2 3 4 : 3*4+6*2 true ; 6 2 3 4 : 3*4+6*2 true ; 6 2 3 4 : 4*3+6*2 true ; 6 2 3 4 : 4*3+6*2 true ; 6 2 3 4 : (6/2+3)*4 true ; 6 2 3 4 : 4*(6/2+3) true ; 6 2 3 4 : (6/2+3)*4 true ; 6 2 3 4 : 4*(6/2+3) true ; 6 2 3 4 : (6-3)*2*4 true ; 6 2 3 4 : 4*(6-3)*2 true ; 6 2 3 4 : (6-3)*4*2 ... ?- play24(7,99, 1). 66 40 2 76 95 59 12 : (66+40)/2-76+95-59-12 true ; 66 40 2 76 95 59 12 : (66+40)/2-76+95-12-59 true ; 66 40 2 76 95 59 12 : (66+40)/2-76-59+95-12 true ; 66 40 2 76 95 59 12 : (66+40)/2-76-59-12+95 true ; 66 40 2 76 95 59 12 : 95+(66+40)/2-76-59-12 true ; 66 40 2 76 95 59 12 : 95+(66+40)/2-76-59-12 true ; 66 40 2 76 95 59 12 : 95-12+(66+40)/2-76-59 true ; 66 40 2 76 95 59 12 : (66+40)/2-76-59+95-12 ....
Minimal version
Little efforts to remove dublicates (e.g. output for [4,6,9,9]). <lang prolog>:- initialization(main).
solve(N,Xs,Ast) :-
Err = evaluation_error(zero_divisor) , gen_ast(Xs,Ast), catch(Ast =:= N, error(Err,_), fail) .
gen_ast([N],N) :- between(1,9,N). gen_ast(Xs,Ast) :-
Ys = [_|_], Zs = [_|_], split(Xs,Ys,Zs) , ( member(Op, [(+),(*)]), Ys @=< Zs ; member(Op, [(-),(//)]) ) , gen_ast(Ys,A), gen_ast(Zs,B), Ast =.. [Op,A,B] .
split(Xs,Ys,Zs) :- sublist(Ys,Xs), select_all(Ys,Xs,Zs).
% where select_all([],Xs,Xs). select_all([Y|Ys],Xs,Zs) :- select(Y,Xs,X1), !, select_all(Ys,X1,Zs).
test(T) :- solve(24, [2,3,8,9], T).
main :- forall(test(T), (write(T), nl)), halt.</lang>
- Output:
(9-3)*8//2 3*8-2//9 (8+9)//2*3 (8-2//9)*3 (2//9+8)*3 (2+8*9)//3 2//9+3*8 8//2*(9-3) (9-3)//2*8 (9-2*3)*8 (3-2//9)*8 (2//9+3)*8 (2+9)//3*8
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. <lang Python>
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 from fractions import Fraction as F 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 player' 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 3838'.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 )' Solution found: 8 / ( 3 - 8 / 3 ) '8 / ( 3 - 8 / 3 )' >>> """ 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: if '/' in ops: d2 = [('F(%s)' % i) for i in d] # Use Fractions for accuracy else: d2 = d ex = list(chain.from_iterable(zip_longest(d2, 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: if '/' in ops: exp = [ (term if not term.startswith('F(') else term[2]) for term in exp ] 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: if '/' in answer: # Use Fractions for accuracy in divisions answer = .join( (('F(%s)' % char) if char in '123456789' else char) for char in answer ) ans = eval(answer) print (" = ", ans) if ans == 24: print ("Thats right!") print ("Thank you and goodbye")
main()</lang>
- 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
Difficult case requiring precise division
The digits 3,3,8 and 8 have a solution that is not equal to 24 when using Pythons double-precision floating point because of a division in all answers. The solver above switches to precise fractional arithmetic when division is involved and so can both recognise and solve for cases like this, (rather than allowing some range of closeness to 24).
Evaluation needing precise division
- Output:
... Expression 1: !! Enter the digits to solve for: 3388 New digits: 3 3 8 8 Expression 1: 8/(3-(8/3)) = 24 Thats right! Thank you and goodbye
Solving needing precise division
- Output:
... Expression 1: !! Enter the digits to solve for: 3388 New digits: 3 3 8 8 Expression 1: ? Solution found: 8 / ( 3 - 8 / 3 )
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. <lang r> 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(expr1), goal)) return(expr1) }
return(NA)
} </lang>
- Output:
<lang r> > 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) </lang>
Racket
The sequence of all possible variants of expressions with given numbers n1, n2, n3, n4 and operations o1, o2, o3. <lang racket> (define (in-variants n1 o1 n2 o2 n3 o3 n4)
(let ([o1n (object-name o1)] [o2n (object-name o2)] [o3n (object-name o3)]) (with-handlers ((exn:fail:contract:divide-by-zero? (λ (_) empty-sequence))) (in-parallel (list (o1 (o2 (o3 n1 n2) n3) n4) (o1 (o2 n1 (o3 n2 n3)) n4) (o1 (o2 n1 n2) (o3 n3 n4)) (o1 n1 (o2 (o3 n2 n3) n4)) (o1 n1 (o2 n2 (o3 n3 n4)))) (list `(((,n1 ,o3n ,n2) ,o2n ,n3) ,o1n ,n4) `((,n1 ,o2n (,n2 ,o3n ,n3)) ,o1n ,n4) `((,n1 ,o2n ,n2) ,o1n (,n3 ,o3n ,n4)) `(,n1 ,o1n ((,n2 ,o3n ,n3) ,o2n ,n4)) `(,n1 ,o1n (,n2 ,o2n (,n3 ,o3n ,n4))))))))
</lang>
Search for all solutions using brute force: <lang racket> (define (find-solutions numbers (goal 24))
(define in-operations (list + - * /)) (remove-duplicates (for*/list ([n1 numbers] [n2 (remove-from numbers n1)] [n3 (remove-from numbers n1 n2)] [n4 (remove-from numbers n1 n2 n3)] [o1 in-operations] [o2 in-operations] [o3 in-operations] [(res expr) (in-variants n1 o1 n2 o2 n3 o3 n4)] #:when (= res goal)) expr)))
(define (remove-from numbers . n) (foldr remq numbers n)) </lang>
Examples:
> (find-solutions '(3 8 3 8)) '((8 / (3 - (8 / 3)))) > (find-solutions '(3 8 2 9)) '(((8 / 2) * (9 - 3)) (8 / (2 / (9 - 3))) (8 * (9 - (3 * 2))) (8 * ((9 - 3) / 2)) ((8 * (9 - 3)) / 2) (8 * (9 - (2 * 3))) ((9 - 3) * (8 / 2)) (((9 - 3) * 8) / 2) ((9 - (3 * 2)) * 8) (((9 - 3) / 2) * 8) ((9 - 3) / (2 / 8)) ((9 - (2 * 3)) * 8))
In order to find just one solution effectively one needs to change for*/list to for*/first in the function find-solutions.
REXX
<lang rexx>/*REXX program to help the user find solutions to the game of 24. */ /* ┌──────────────────────────────────────────────────────────────────┐
│ Argument is either of two forms: ssss ==or== ssss-ffff │ │ │ │ where one or both strings must be exactly four numerals (digits) │ │ comprised soley of the numerals (digits) 1 ──> 9 (no zeroes). │ │ │ │ In SSSS-FFFF SSSS is the start, │ │ FFFF is the start. │ └──────────────────────────────────────────────────────────────────┘ */
parse arg orig /*get the guess from the argument. */ parse var orig start '-' finish /*get the start and finish (maybe). */ start=space(start,0) /*remove any blanks from the START. */ finish=space(finish,0) /*remove any blanks from the FINISH. */ finish=word(finish start,1) /*if no FINISH specified, use START.*/ digs=123456789 /*numerals (digits) that can be used. */ call validate start call validate finish opers='+-*/' /*define the legal arithmetic operators*/ ops=length(opers) /* ... and the count of them (length). */
do j=1 for ops /*define a version for fast execution. */ o.j=substr(opers,j,1) end /*j*/
finds=0 /*number of found solutions (so far). */ x.=0 /*a method to hold unique expressions. */ indent=left(,30) /*used to indent display of solutions. */
/*alternative: indent=copies(' ',30) */
Lpar='(' /*a string to make REXX code prettier. */ Rpar=')' /*ditto. */
do g=start to finish /*process a (possible) range of values.*/ if pos(0,g)\==0 then iterate /*ignore values with zero in them. */
do _=1 for 4 /*define versions for faster execution.*/ g._=substr(g,_,1) end /*_*/
do i=1 for ops /*insert an operator after 1st number. */ do j=1 for ops /*insert an operator after 2nd number. */ do k=1 for ops /*insert an operator after 2nd number. */ do m=0 to 3; L.= /*assume no left parenthesis so far. */ do n=m+1 to 4 /*match left paren with a right paren. */ L.m=Lpar /*define a left paren, m=0 means ignore*/ R.="" /*un-define all right parenthesis. */ if m==1 & n==2 then L.="" /*special case: (n)+ ... */ else if m\==0 then R.n=Rpar /*no (, no )*/ e= L.1 g.1 o.i L.2 g.2 o.j L.3 g.3 R.3 o.k g.4 R.4 e=space(e,0) /*remove all blanks from the expression*/
/*(below) change expression: */ /* /(yyy) ===> /div(yyy) */ /*Enables to check for division by zero*/ origE=e /*keep old version for the display. */ if pos('/(',e)\==0 then e=changestr('/(',e,"/div(") /*The above could be replaced by: */ /* e=changestr('/(',e,"/div(") */
/*INTERPRET stresses REXX's groin, so */ /* try to avoid repeated heavy lifting.*/ if x.e then iterate /*was the expression already used? */ x.e=1 /*mark this expression as unique. */ /*have REXX do the heavy lifting (ugh).*/ interpret 'x=' e /*... strain... */ x=x/1 /*remove trailing decimal points(maybe)*/ if x\==24 then iterate /*Not correct? Try again. */ finds=finds+1 /*bump number of found solutions. */ _=translate(origE, '][', ")(") /*show [], not (). */ say indent 'a solution:' _ /*display a solution. */ end /*n*/ end /*m*/ end /*k*/ end /*j*/ end /*i*/ end /*g*/
sols=finds if sols==0 then sols='No' /*make the sentence not so geek-like. */ say; say sols 'unique solution's(finds) "found for" orig /*pluralize.*/ exit /*───────────────────────────DIV subroutine─────────────────────────────*/ div: procedure; parse arg q /*tests if dividing by 0 (zero). */ if q=0 then q=1e9 /*if dividing by zero, change divisor. */ return q /*changing Q invalidates the expression*/ /*───────────────────────────GER subroutine─────────────────────────────*/ ger: say; say '*** error! ***'; if _\== then say 'guess=' _ say arg(1); say; exit 13 /*───────────────────────────S subroutine───────────────────────────────*/ s: if arg(1)==1 then return ; return 's' /*simple pluralizer.*/ /*───────────────────────────validate subroutine────────────────────────*/ validate: parse arg y; errCode=0; _v=verify(y,digs)
select when y== then call ger 'no digits entered.' when length(y)<4 then call ger 'not enough digits entered, must be 4' when length(y)>4 then call ger 'too many digits entered, must be 4' when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)" when _v\==0 then call ger 'illegal character:' substr(y,_v,1) otherwise nop end /*select*/
return \errCode</lang>
Some older REXXes don't have a changestr bif, so one is included here ──► CHANGESTR.REX.
output when the following input is used: 1111-1234
a solution: [1+1+1]*8 a solution: [1+1+2]*6 a solution: [1+1*2]*8 a solution: [1*1+2]*8 a solution: 1*[1+2]*8 a solution: [1/1+2]*8 a solution: [1+1*3]*6 a solution: [1*1+3]*6 a solution: 1*[1+3]*6 a solution: [1/1+3]*6 a solution: 1-1+3*8 a solution: [1-1+3]*8 a solution: [1-1+3*8] a solution: 1-1+[3*8] a solution: 1-[1-3*8] a solution: 1*1*3*8 a solution: [1*1*3]*8 a solution: [1*1*3*8] a solution: 1*[1*3]*8 a solution: 1*[1*3*8] a solution: 1*1*[3*8] a solution: 1/1*3*8 a solution: [1/1*3]*8 a solution: [1/1*3*8] a solution: 1/1*[3*8] a solution: 1/[1/3]*8 a solution: 1/[1/3/8] a solution: [1+1+4]*4 a solution: 1-1+4*6 a solution: [1-1+4]*6 a solution: [1-1+4*6] a solution: 1-1+[4*6] a solution: 1-[1-4*6] a solution: 1*1*4*6 a solution: [1*1*4]*6 a solution: [1*1*4*6] a solution: 1*[1*4]*6 a solution: 1*[1*4*6] a solution: 1*1*[4*6] a solution: 1/1*4*6 a solution: [1/1*4]*6 a solution: [1/1*4*6] a solution: 1/1*[4*6] a solution: 1/[1/4]*6 a solution: 1/[1/4/6] a solution: [1+1*5]*4 a solution: [1*1+5]*4 a solution: 1*[1+5]*4 a solution: [1/1+5]*4 a solution: [1+1+6]*3 a solution: 1-1+6*4 a solution: [1-1+6]*4 a solution: [1-1+6*4] a solution: 1-1+[6*4] a solution: 1-[1-6*4] a solution: 1*1*6*4 a solution: [1*1*6]*4 a solution: [1*1*6*4] a solution: 1*[1*6]*4 a solution: 1*[1*6*4] a solution: 1*1*[6*4] a solution: 1/1*6*4 a solution: [1/1*6]*4 a solution: [1/1*6*4] a solution: 1/1*[6*4] a solution: 1/[1/6]*4 a solution: [1+1*7]*3 a solution: [1*1+7]*3 a solution: 1*[1+7]*3 a solution: [1/1+7]*3 a solution: 1-1+8*3 a solution: [1-1+8]*3 a solution: [1-1+8*3] a solution: 1-1+[8*3] a solution: 1-[1-8*3] a solution: 1*1*8*3 a solution: [1*1*8]*3 a solution: [1*1*8*3] a solution: 1*[1*8]*3 a solution: 1*[1*8*3] a solution: 1*1*[8*3] a solution: 1/1*8*3 a solution: [1/1*8]*3 a solution: [1/1*8*3] a solution: 1/1*[8*3] a solution: 1/[1/8]*3 a solution: 1/[1/8/3] a solution: [1+2+1]*6 a solution: [1+2*1]*8 a solution: [1+2/1]*8 a solution: [1*2+1]*8 a solution: 1*[2+1]*8 a solution: [1*2+2]*6 a solution: 1*[2+2]*6 a solution: 1*2*2*6 a solution: [1*2*2]*6 a solution: [1*2*2*6] a solution: 1*[2*2]*6 a solution: 1*[2*2*6] a solution: 1*2*[2*6] a solution: [1+2+3]*4 a solution: 1*2*3*4 a solution: [1*2*3]*4 a solution: [1*2*3*4] a solution: 1*[2*3]*4 a solution: 1*[2*3*4] a solution: 1*2*[3*4] 107 unique solutions found for 1111-1234
Ruby
<lang ruby>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))', ].map{|expr| [expr, expr.gsub('%d', 'Rational(%d,1)')]} OPERATORS = [:+, :-, :*, :/].repeated_permutation(3) OBJECTIVE = Rational(24,1) def self.solve(digits) solutions = [] digits.permutation.to_a.uniq.each do |a,b,c,d| OPERATORS.each do |op1,op2,op3| EXPRESSIONS.each do |expr,expr_rat| # evaluate using rational arithmetic test = expr_rat % [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 solutions 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}"
solutions = TwentyFourGamePlayer.solve(digits) if solutions.empty?
puts "no solutions"
else
puts "found #{solutions.size} solutions, including #{solutions.first}" puts solutions.sort
end</lang>
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))
Scala
A non-interactive player.
<lang scala>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)</lang>
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))))
Swift
<lang swift> import Darwin import Foundation
var solution = String()
println("24 Game") println("Generating 4 digits...")
func randomDigits() -> [Int] {
var result = [Int](); for var i = 0; i < 4; i++ { result.append(Int(arc4random_uniform(9)+1)) } return result;
}
// Choose 4 digits let digits = randomDigits()
print("Make 24 using these digits : ")
for digit in digits {
print("\(digit) ")
} println()
// get input from operator var input = NSString(data:NSFileHandle.fileHandleWithStandardInput().availableData, encoding:NSUTF8StringEncoding)
var enteredDigits = [Double]()
var enteredOperations = [Character]()
let inputString = input as String
// store input in the appropriate table for character in inputString {
switch character { case "1", "2", "3", "4", "5", "6", "7", "8", "9": let digit = String(character) enteredDigits.append(Double(digit.toInt()!)) case "+", "-", "*", "/": enteredOperations.append(character) case "\n": println() default: println("Invalid expression") }
}
// check value of expression provided by the operator var value = Double()
if enteredDigits.count == 4 && enteredOperations.count == 3 {
value = enteredDigits[0] for (i, operation) in enumerate(enteredOperations) { switch operation { case "+": value = value + enteredDigits[i+1] case "-": value = value - enteredDigits[i+1] case "*": value = value * enteredDigits[i+1] case "/": value = value / enteredDigits[i+1] default: println("This message should never happen!") } }
}
func evaluate(dPerm: [Double], oPerm: [String]) -> Bool {
var value = 0.0 if dPerm.count == 4 && oPerm.count == 3 { value = dPerm[0] for (i, operation) in enumerate(oPerm) { switch operation { case "+": value = value + dPerm[i+1] case "-": value = value - dPerm[i+1] case "*": value = value * dPerm[i+1] case "/": value = value / dPerm[i+1] default: println("This message should never happen!") } } } return (abs(24 - value) < 0.001)
}
func isSolvable(inout digits: [Double]) -> Bool {
var result = false var dPerms = Double() permute(&digits, &dPerms, 0); let total = 4 * 4 * 4 var oPerms = String() permuteOperators(&oPerms, 4, total); var expression = String() for dig in dPerms { for opr in oPerms { if evaluate(dig, opr) { for digit in dig { expression += "\(digit)" } for oper in opr { expression += oper } solution = beautify(expression) result = true } expression = "" } } return result
}
func permute(inout lst: [Double], inout res: Double, k: Int) -> Void {
for (var i = k; i < lst.count; i++) { swap(&lst[i], &lst[k]) permute(&lst, &res, k + 1) swap(&lst[k], &lst[i]) } if (k == lst.count) { res.append(lst) }
}
// n=4, total=64, npow=16 func permuteOperators(inout res: String, n: Int, total: Int) -> Void {
let posOperations = ["+", "-", "*", "/"] for (var i = 0, npow = n * n; i < total; i++) { res.append([posOperations[(i / npow)], posOperations[((i % npow) / n)], posOperations[(i % n)]]) }
}
func beautify(infix: String) -> String {
var newString = infix as NSString var solution = NSMutableString()
solution.appendString(newString.substringWithRange(NSMakeRange(0, 1))) solution.appendString(newString.substringWithRange(NSMakeRange(12, 1))) solution.appendString(newString.substringWithRange(NSMakeRange(3, 1))) solution.appendString(newString.substringWithRange(NSMakeRange(13, 1))) solution.appendString(newString.substringWithRange(NSMakeRange(6, 1))) solution.appendString(newString.substringWithRange(NSMakeRange(14, 1))) solution.appendString(newString.substringWithRange(NSMakeRange(9, 1))) return solution
}
if value != 24 {
println("The value of the provided expression is \(value) instead of 24!") if isSolvable(&enteredDigits) { println("A possible solution could have been " + solution) } else { println("Anyway, there was no known solution to this one.") }
} else {
println("Congratulations, you found a solution!")
} </lang>
The program in action:
24 Game Generating 4 digits... Make 24 using these digits : 2 4 1 9 2+1*4+9 The value of the provided expression is 21.0 instead of 24! A possible solution could have been 9-2-1*4 24 Game Generating 4 digits... Make 24 using these digits : 2 7 2 3 7-2*2*3 The value of the provided expression is 30.0 instead of 24! A possible solution could have been 3+7+2*2 24 Game Generating 4 digits... Make 24 using these digits : 4 6 3 4 4+4+6+3 The value of the provided expression is 17.0 instead of 24! A possible solution could have been 3*4-6*4 24 Game Generating 4 digits... Make 24 using these digits : 8 8 2 6 8+8+2+6 Congratulations, you found a solution! 24 Game Generating 4 digits... Make 24 using these digits : 6 7 8 9 6+7+8+9 The value of the provided expression is 30.0 instead of 24! Anyway, there was no known solution to this one.
Tcl
This is a complete Tcl script, intended to be invoked from the command line.
<lang tcl>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</lang> 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
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.
<lang Ursala>#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"</lang> test program: <lang Ursala>#show+
test_games = mat` * pad` *K7 pad0 game24* <<2,3,8,9>,<5,7,4,1>,<5,6,7,8>></lang> 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
zkl
A brute for search for all solutions. Lexicographical duplicates are removed.
File solve24.zkl: <lang zkl>var H=Utils.Helpers; fcn u(xs){xs.reduce(fcn(us,s){us.holds(s) and us or us.append(s)},L())} var ops=u(H.combosK(3,"+-*/".split("")).apply(H.permute).flatten()); var fs=T(
fcn f0(a,b,c,d,x,y,z){Op(z)(Op(y)(Op(x)(a,b),c),d)}, // ((AxB)yC)zD fcn f1(a,b,c,d,x,y,z){Op(y)(Op(x)(a,b),Op(z)(c,d))}, // (AxB)y(CzD) fcn f2(a,b,c,d,x,y,z){Op(z)(Op(x)(a,Op(y)(b,c)),d)}, // (Ax(ByC))zD fcn f3(a,b,c,d,x,y,z){Op(x)(a,Op(z)(Op(y)(b,c),d))}, // Ax((ByC)zD) fcn f4(a,b,c,d,x,y,z){Op(x)(a,Op(y)(b,Op(z)(c,d)))}, // Ax(By(CzD))
);
var fts= // format strings for human readable formulas
T("((d.d).d).d", "(d.d).(d.d)", "(d.(d.d)).d", "d.((d.d).d)", "d.(d.(d.d))") .apply(T(T("replace","d","%d"),T("replace",".","%s")));
fcn f2s(digits,ops,f){ // formula (fs[n]) to string
fts[f.name[1].toInt()] .fmt(H.listZip(digits,ops).flatten().xplode(),digits[3]);
}
fcn game24Solver(digitsString){
digits:=digitsString.split("").apply("toFloat"); [[(digits4,ops3,f); H.permute(digits); ops; fs,{try{f(digits4.xplode(),ops3.xplode()).closeTo(24,0.001)} catch(MathError){False}}; {f2s(digits4,ops3,f)}]];
}
solutions:=u(game24Solver(ask(0,"digits: "))); println(solutions.len()," solutions:"); solutions.apply2(Console.println);</lang> One trick used is to look at the solving functions name and use the digit in it to index into the formats list.
- Output:
zkl solve24.zkl 6795 6 solutions: 6+((7-5)*9) 6-((5-7)*9) 6-(9*(5-7)) 6+(9*(7-5)) (9*(7-5))+6 ((7-5)*9)+6 zkl solve24.zkl 1111 0 solutions: zkl solve24.zkl 3388 1 solutions: 8/(3-(8/3)) zkl solve24.zkl 1234 242 solutions: ((1+2)+3)*4 ...
- Programming Tasks
- Solutions by Programming Task
- ABAP
- Argile
- AutoHotkey
- BBC BASIC
- C
- C++
- Clojure
- CoffeeScript
- Common Lisp
- D
- Euler Math Toolbox
- F Sharp
- Fortran
- GAP
- Go
- Gosu
- Haskell
- Icon
- Unicon
- Icon Programming Library
- J
- Java
- JavaScript
- Julia
- Liberty BASIC
- Lua
- Mathematica
- OCaml
- Perl
- Perl 6
- PicoLisp
- ProDOS
- Prolog
- Python
- R
- Racket
- REXX
- Ruby
- Scala
- Swift
- Tcl
- Tcllib
- Ursala
- Zkl
- GUISS/Omit
- ML/I/Omit