# 24 game/Solve

24 game/Solve
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.

## 11l

Translation of: Nim
[Char = ((Float, Float) -> Float)] op
op[Char(‘+’)] = (x, y) -> x + y
op[Char(‘-’)] = (x, y) -> x - y
op[Char(‘*’)] = (x, y) -> x * y
op[Char(‘/’)] = (x, y) -> I y != 0 {x / y} E 9999999

F almost_equal(a, b)
R abs(a - b) <= 1e-5

F solve(nums)
V syms = ‘+-*/’
V sorted_nums = sorted(nums).map(Float)
L(x, y, z) cart_product(syms, syms, syms)
V n = copy(sorted_nums)
L
V (a, b, c, d) = (n[0], n[1], n[2], n[3])
I almost_equal(:op[x](:op[y](a, b), :op[z](c, d)), 24.0)
R ‘(’a‘ ’y‘ ’b‘) ’x‘ (’c‘ ’z‘ ’d‘)’
I almost_equal(:op[x](a, :op[y](b, :op[z](c, d))), 24.0)
R a‘ ’x‘ (’b‘ ’y‘ (’c‘ ’z‘ ’d‘))’
I almost_equal(:op[x](:op[y](:op[z](c, d), b), a), 24.0)
R ‘((’c‘ ’z‘ ’d‘) ’y‘ ’b‘) ’x‘ ’a
I almost_equal(:op[x](:op[y](b, :op[z](c, d)), a), 24.0)
R ‘(’b‘ ’y‘ (’c‘ ’z‘ ’d‘)) ’x‘’a
I !n.next_permutation()
L.break

L(nums) [[9, 4, 4, 5],
[1, 7, 2, 7],
[5, 7, 5, 4],
[1, 4, 6, 6],
[2, 3, 7, 3],
[8, 7, 9, 7],
[1, 6, 2, 6],
[7, 9, 4, 1],
[6, 4, 2, 2],
[5, 7, 9, 7],
[3, 3, 8, 8]]
print(‘solve(’nums‘) -> ’solve(nums))
Output:
solve([9, 4, 4, 5]) -> not found
solve([1, 7, 2, 7]) -> ((7 * 7) - 1) / 2
solve([5, 7, 5, 4]) -> 4 * (7 - (5 / 5))
solve([1, 4, 6, 6]) -> 6 + (6 * (4 - 1))
solve([2, 3, 7, 3]) -> ((2 + 7) * 3) - 3
solve([1, 6, 2, 6]) -> 6 + (6 * (1 + 2))
solve([7, 9, 4, 1]) -> (1 - 9) * (4 - 7)
solve([6, 4, 2, 2]) -> (2 - 2) + (4 * 6)
solve([5, 7, 9, 7]) -> (5 + 7) * (9 - 7)
solve([3, 3, 8, 8]) -> 8 / (3 - (8 / 3))


## AArch64 Assembly

Works with: as version Raspberry Pi 3B version Buster 64 bits
/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program game24Solvex64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

.equ NBDIGITS,   4       // digits number
.equ TOTAL,      24
.equ BUFFERSIZE, 80

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessRules:        .ascii "24 Game\n"
.ascii "The program will display four randomly-generated \n"
.asciz "single-digit numbers and search a solution for a total to 24\n\n"

szMessDigits:       .asciz "The four digits are @ @ @ @ and the score is 24. \n"
szMessOK:           .asciz "Solution : \n"
szMessNotOK:        .asciz "No solution for this problem !! \n"
szMessNewGame:      .asciz "New game (y/n) ? \n"
szMessErrOper:      .asciz "Error opérator in display result !!!"
szCarriageReturn:   .asciz "\n"
.align 4
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
sZoneConv:        .skip 24
sBuffer:          .skip BUFFERSIZE
qTabDigit:        .skip 8 * NBDIGITS // digits table
qTabOperand1:     .skip 8 * NBDIGITS // operand 1 table
qTabOperand2:     .skip 8 * NBDIGITS // operand 2 table
qTabOperation:    .skip 8 * NBDIGITS // operator table
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                 // entry of program

bl affichageMess
1:
mov x3,#0
2:                                    // loop generate random digits
mov x0,#8
bl genereraleas
str x0,[x12,x3,lsl 3]             // store in table
bl conversion10                   // call decimal conversion
mov x0,x5
ldr x1,qAdrsZoneConv              // insert conversion in message
bl strInsertAtCharInc
mov x5,x0
cmp x3,#NBDIGITS                  // end ?
blt 2b                            // no -> loop
mov x0,x5
bl affichageMess

mov x0,#0                         // start leval
mov x1,x12                        // address digits table
bl searchSoluce
cmp x0,#-1                        // solution ?
bne 3f                            // no
bl affichageMess
bl writeSoluce                    // yes -> write solution in buffer
ldr x0,qAdrsBuffer                // and display buffer
bl affichageMess
b 10f
3:                                    // display message no solution
bl affichageMess

10:                                   // display new game ?
bl affichageMess
bl affichageMess
bl saisie
cmp x0,#'y'
beq 1b
cmp x0,#'Y'
beq 1b

100:                                  // standard end of the program
mov x0,0                          // return code
mov x8,EXIT                       // request to exit program
svc 0                             // perform the system call

/******************************************************************/
/*            recherche solution                                       */
/******************************************************************/
/* x0 level   */
/* x1 table value address */
/* x0 return -1 if ok     */
searchSoluce:
stp x1,lr,[sp,-16]!             // save  registres
stp x2,x3,[sp,-16]!             // save  registres
stp x4,x5,[sp,-16]!             // save  registres
stp x6,x7,[sp,-16]!             // save  registres
stp x8,x9,[sp,-16]!             // save  registres
stp x10,x11,[sp,-16]!           // save  registres
stp x12,fp,[sp,-16]!            // save  registres
sub sp,sp,#8* NBDIGITS          // reserve size new digits table
mov fp,sp                       // frame pointer = address stack
mov x10,x1                      // save table
mov x13,#NBDIGITS
sub x3,x13,x9                   // last element digits table
ldr x4,[x1,x3,lsl 3]            // load last element
cmp x4,#TOTAL                   // equal to total to search ?
bne 0f                          // no
cmp x9,#NBDIGITS                // all digits are used ?
bne 0f                          // no
mov x0,#-1                      // yes -> it is ok -> end
b 100f
0:
mov x5,#0                       // indice loop 1
1:                                  // begin loop 1
cmp x5,x3
bge 9f
ldr x4,[x10,x5,lsl 3]           // load first operand
str x4,[x8,x9,lsl 3]            // and store in operand1 table
add x6,x5,#1                    // indice loop 2
2:                                  // begin loop 2
cmp x6,x3
bgt 8f
ldr x12,[x10,x6,lsl 3]          // load second operand
str x12,[x8,x9,lsl 3]           // and store in operand2 table
mov x7,#0   // k
mov x8,#0   // n
3:
cmp x7,x5
beq 4f
cmp x7,x6
beq 4f
ldr x0,[x10,x7,lsl 3]           // copy other digits in new table on stack
str x0,[fp,x8,lsl 3]
4:
cmp x7,x3
ble 3b

str x7,[fp,x8,lsl 3]            // store result of addition
mov x7,#'+'
str x7,[x0,x9,lsl 3]            // store operator
mov x0,x9                       // pass new level
mov x1,fp                       // pass new table address on stack
bl searchSoluce
cmp x0,#0
blt 100f
// soustraction test
sub x13,x4,x12
sub x14,x12,x4
cmp x4,x12
csel x7,x13,x14,gt
str x7,[fp,x8,lsl 3]
mov x7,#'-'
str x7,[x0,x9,lsl 3]
mov x0,x9
mov x1,fp
bl searchSoluce
cmp x0,#0
blt 100f

mul x7,x4,x12                    // multiplication test
str x7,[fp,x8,lsl 3]
mov x7,#'*'
str x7,[x0,x9,lsl 3]
mov x0,x9
mov x1,fp
bl searchSoluce
cmp x0,#0
blt 100f
5:                                    // division test
udiv x13,x4,x12
msub x14,x13,x12,x4
cmp x14,#0
bne 6f
str x13,[fp,x8,lsl 3]
mov x7,#'/'
str x7,[x0,x9,lsl 3]
mov x0,x9
mov x1,fp
bl searchSoluce
b 7f
6:
udiv x13,x12,x4
msub x14,x13,x4,x12
cmp x14,#0
bne 7f
str x13,[fp,x8,lsl 3]
mov x7,#'/'
str x7,[x0,x9,lsl 3]
mov x0,x9
mov x1,fp
bl searchSoluce
7:
cmp x0,#0
blt 100f

add x6,x6,#1                // increment indice loop 2
b 2b

8:
add x5,x5,#1                // increment indice loop 1
b 1b
9:

100:
add sp,sp,8* NBDIGITS       // stack alignement
ldp x12,fp,[sp],16          // restaur des  2 registres
ldp x10,x11,[sp],16         // restaur des  2 registres
ldp x8,x9,[sp],16           // restaur des  2 registres
ldp x6,x7,[sp],16           // restaur des  2 registres
ldp x4,x5,[sp],16           // restaur des  2 registres
ldp x2,x3,[sp],16           // restaur des  2 registres
ldp x1,lr,[sp],16           // restaur des  2 registres
ret
/******************************************************************/
/*            write solution                                      */
/******************************************************************/
writeSoluce:
stp x1,lr,[sp,-16]!          // save  registres
stp x2,x3,[sp,-16]!          // save  registres
stp x4,x5,[sp,-16]!          // save  registres
stp x6,x7,[sp,-16]!          // save  registres
stp x8,x9,[sp,-16]!          // save  registres
stp x10,x11,[sp,-16]!        // save  registres
stp x12,fp,[sp,-16]!         // save  registres
mov x4,#0                    // buffer indice
mov x9,#1
1:
ldr x13,[x6,x9,lsl 3]        // operand 1
ldr x11,[x7,x9,lsl 3]        // operand  2
ldr x12,[x8,x9,lsl 3]        // operator
cmp x12,#'-'
beq 2f
cmp x12,#'/'
beq 2f
b 3f
2:                               // if division or soustraction
cmp x13,x11                  // reverse operand if operand 1 is < operand 2
bge 3f
mov x2,x13
mov x13,x11
mov x11,x2
3:                               // conversion operand 1 = x13
mov x1,#10
udiv x2,x13,x1
msub x3,x1,x2,x13
cmp x2,#0
beq 31f
strb w2,[x10,x4]
31:
strb w3,[x10,x4]
ldr x2,[x7,x9,lsl 3]

strb w12,[x10,x4]           // operator

mov x1,#10                  // conversion operand  2 = x11
udiv x2,x11,x1
msub x3,x2,x1,x11
cmp x2,#0
beq 32f
strb w2,[x10,x4]
32:
strb w3,[x10,x4]

mov x0,#'='
strb w0,[x10,x4]             // compute sous total
bne 33f
b 37f
33:
cmp x12,'-'                  // soustraction
bne 34f
sub x0,x13,x11
b 37f
34:
cmp x12,'*'                 // multiplication
bne 35f
mul x0,x13,x11
b 37f
35:
cmp x12,'/'                 // division
bne 36f
udiv x0,x13,x11
b 37f
36:                             // error
bl affichageMess
b 100f
37:                             // and conversion ascii
mov x1,#10
udiv x2,x0,x1
msub x3,x2,x1,x0
cmp x2,#0
beq 36f
strb w2,[x10,x4]
36:
strb w3,[x10,x4]
mov x0,#'\n'
strb w0,[x10,x4]

cmp x9,#NBDIGITS
blt 1b
mov x1,#0
strb w1,[x10,x4]            // store 0 final

100:
ldp x12,fp,[sp],16          // restaur des  2 registres
ldp x10,x11,[sp],16         // restaur des  2 registres
ldp x8,x9,[sp],16           // restaur des  2 registres
ldp x6,x7,[sp],16           // restaur des  2 registres
ldp x4,x5,[sp],16           // restaur des  2 registres
ldp x2,x3,[sp],16           // restaur des  2 registres
ldp x1,lr,[sp],16           // restaur des  2 registres
ret
/******************************************************************/
/*            string entry                                       */
/******************************************************************/
/* x0 return the first character of human entry */
saisie:
stp x1,lr,[sp,-16]!    // save  registres
stp x2,x8,[sp,-16]!    // save  registres
mov x0,#STDIN          // Linux input console
mov x2,#BUFFERSIZE     // buffer size
svc 0                  // call system
ldrb w0,[x1]           // load first character
100:
ldp x2,x8,[sp],16      // restaur des  2 registres
ldp x1,lr,[sp],16      // restaur des  2 registres
ret
/***************************************************/
/*   Generation random number                  */
/***************************************************/
/* x0 contains limit  */
genereraleas:
stp x1,lr,[sp,-16]!     // save  registres
stp x2,x3,[sp,-16]!     // save  registres
stp x4,x5,[sp,-16]!     // save  registres
ldr x2,[x4]
ldr x3,qNbDep1
mul x2,x3,x2
ldr x3,qNbDep2
str x2,[x4]             // maj de la graine pour l appel suivant
cmp x0,#0
beq 100f
mov x0,x2               // dividende
udiv x3,x2,x1
msub x0,x3,x1,x0        // résult = remainder

100:                        // end function

ldp x4,x5,[sp],16       // restaur des  2 registres
ldp x2,x3,[sp],16       // restaur des  2 registres
ldp x1,lr,[sp],16       // restaur des  2 registres
ret
/*****************************************************/
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
Output:
The four digits are 6 8 3 1 and the score is 24.
Solution :
6*8=48
3-1=2
48/2=24

New game (y/n) ?
y
The four digits are 8 6 6 5 and the score is 24.
Solution :
8-5=3
6*3=18
6+18=24

New game (y/n) ?


## 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

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 table iv_set index lv_perm into lv_first.
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.
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.


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

Works with: Argile version 1.0.0
die "Please give 4 digits as argument 1\n" if argc < 2

print a function that given four digits argv[1] subject to the rules of	\
the _24_ game, computes an expression to solve the game if possible.

use std, array

let digits    be an array of 4 byte
let operators be an array of 4 byte
(: reordered arrays :)
let (type of digits)    rdigits
let (type of operators) roperators

.: a function that given four digits <text digits> subject to
the rules of the _24_ game, computes an expression to solve
the game if possible.                                       :. -> text
if #digits != 4 {return "[error: need exactly 4 digits]"}
operators[0] = '+' ; operators[1] = '-'
operators[2] = '*' ; operators[3] = '/'
for each (val int d) from 0 to 3
if (digits[d] < '1') || (digits[d] > '9')
return "[error: non-digit character given]"
(super digits)[d] = digits[d]
let expr = for each operand order stuff
return "" if expr is nil
expr

.:for each operand order stuff:. -> text
for each (val int a) from 0 to 3
for each (val int b) from 0 to 3
next if (b == a)
for each (val int c) from 0 to 3
next if (c == b) or (c == a)
for each (val int d) from 0 to 3
next if (d == c) or (d == b) or (d == a)
rdigits[0] = digits[a] ; rdigits[1] = digits[b]
rdigits[2] = digits[c] ; rdigits[3] = digits[d]
let found = for each operator order stuff
return found unless found is nil
nil

.:for each operator order stuff:. -> text
for each (val int i) from 0 to 3
for each (val int j) from 0 to 3
for each (val int k) from 0 to 3
roperators[0] = operators[i]
roperators[1] = operators[j]
roperators[2] = operators[k]
let found = for each RPN pattern stuff
return found if found isn't nil
nil

our (raw array of text) RPN_patterns = Cdata
"xx.x.x."
"xx.xx.."
"xxx..x."
"xxx.x.."
"xxxx..."
our (raw array of text) formats = Cdata
"((%c%c%c)%c%c)%c%c"
"(%c%c%c)%c(%c%c%c)"
"(%c%c(%c%c%c))%c%c"
"%c%c((%c%c%c)%c%c)"
"%c%c(%c%c(%c%c%c))"
our (raw array of array of 3 int) rrop = Cdata
{0;1;2}; {0;2;1}; {1;0;2}; {2;0;1}; {2;1;0}

.:for each RPN pattern stuff:. -> text
let RPN_stack be an array of 4 real
for each (val int rpn) from 0 to 4
let (nat) sp=0, op=0, dg=0.
let text p
for (p = RPN_patterns[rpn]) (*p != 0) (p++)
if *p == 'x'
if sp >= 4 {die "RPN stack overflow\n"}
if dg >  3 {die "RPN digits overflow\n"}
RPN_stack[sp++] = (rdigits[dg++] - '0') as real
if *p == '.'
if sp < 2 {die "RPN stack underflow\n"}
if op > 2 {die "RPN operators overflow\n"}
sp -= 2
let x = RPN_stack[sp]
let y = RPN_stack[sp + 1]
switch roperators[op++]
case '+' {x += y}
case '-' {x -= y}
case '*' {x *= y}
case '/' {x /= y}
default  {die "RPN operator unknown\n"}
RPN_stack[sp++] = x
if RPN_stack[0] == 24.0
our array of 12 byte buffer (: 4 paren + 3 ops + 4 digits + null :)
snprintf (buffer as text) (size of buffer) (formats[rpn])		\
(rdigits[0]) (roperators[(rrop[rpn][0])]) (rdigits[1])		\
(roperators[(rrop[rpn][1])]) (rdigits[2])		\
(roperators[(rrop[rpn][2])]) (rdigits[3]);
return buffer as text
nil

Examples:

$arc 24_game_solve.arg -o 24_game_solve.c$ gcc -Wall 24_game_solve.c -o 24_game_solve
$./24_game_solve 1234 ((1+2)+3)*4$ ./24_game_solve 9999

$./24_game_solve 5678 ((5+7)-8)*6$ ./24_game_solve 1127
(1+2)*(1+7)

## ARM Assembly

Works with: as version Raspberry Pi
/* ARM assembly Raspberry PI  */
/*  program game24Solver.s   */

/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"
.equ STDIN,      0       @ Linux input console
.equ READ,       3       @ Linux syscall
.equ NBDIGITS,   4       @ digits number
.equ TOTAL,      24
.equ BUFFERSIZE, 80

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessRules:        .ascii "24 Game\n"
.ascii "The program will display four randomly-generated \n"
.asciz "single-digit numbers and search a solution for a total to 24\n\n"

szMessDigits:       .asciz "The four digits are @ @ @ @ and the score is 24. \n"
szMessOK:           .asciz "Solution : \n"
szMessNotOK:        .asciz "No solution for this problem !! \n"
szMessNewGame:      .asciz "New game (y/n) ? \n"
szCarriageReturn:   .asciz "\n"
.align 4
iGraine:            .int 123456
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
sZoneConv:        .skip 24
sBuffer:          .skip BUFFERSIZE
iTabDigit:        .skip 4 * NBDIGITS @ digits table
iTabOperand1:     .skip 4 * NBDIGITS @ operand 1 table
iTabOperand2:     .skip 4 * NBDIGITS @ operand 2 table
iTabOperation:    .skip 4 * NBDIGITS @ operator table
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                 @ entry of program

bl affichageMess
1:
mov r3,#0
2:                                    @ loop generate random digits
mov r0,#8
bl genereraleas
str r0,[r12,r3,lsl #2]            @ store in table
bl conversion10                   @ call decimal conversion
mov r2,#0
strb r2,[r1,r0]                   @ reduce size display area with zéro final
mov r0,r5
ldr r1,iAdrsZoneConv              @ insert conversion in message
bl strInsertAtCharInc
mov r5,r0
cmp r3,#NBDIGITS                  @ end ?
blt 2b                            @ no -> loop
mov r0,r5
bl affichageMess

mov r0,#0                         @ start leval
mov r1,r12                        @ address digits table
bl searchSoluce
cmp r0,#-1                        @ solution ?
bne 3f                            @ no
bl affichageMess
bl writeSoluce                    @ yes -> write solution in buffer
ldr r0,iAdrsBuffer                @ and display buffer
bl affichageMess
b 10f
3:                                    @ display message no solution
bl affichageMess

10:                                   @ display new game ?
bl affichageMess
bl affichageMess
bl saisie
cmp r0,#'y'
beq 1b
cmp r0,#'Y'
beq 1b

100:                                  @ standard end of the program
mov r0, #0                        @ return code
mov r7, #EXIT                     @ request to exit program
svc #0                            @ perform the system call

/******************************************************************/
/*            recherche solution                                       */
/******************************************************************/
/* r0 level   */
/* r1 table value address */
/* r0 return -1 if ok     */
searchSoluce:
push {r1-r12,lr}                @ save registers
sub sp,#4* NBDIGITS             @ reserve size new digits table
mov fp,sp                       @ frame pointer = address stack
mov r10,r1                      @ save table
rsb r3,r9,#NBDIGITS             @ last element digits table
ldr r4,[r1,r3,lsl #2]           @ load last element
cmp r4,#TOTAL                   @ equal to total to search ?
bne 0f                          @ no
cmp r9,#NBDIGITS                @ all digits are used ?
bne 0f                          @ no
mov r0,#-1                      @ yes -> it is ok -> end
b 100f
0:
mov r5,#0                       @ indice loop 1
1:                                  @ begin loop 1
cmp r5,r3
bge 9f
ldr r4,[r10,r5,lsl #2]          @ load first operand
str r4,[r8,r9,lsl #2]           @ and store in operand1 table
add r6,r5,#1                    @ indice loop 2
2:                                  @ begin loop 2
cmp r6,r3
bgt 8f
ldr r12,[r10,r6,lsl #2]         @ load second operand
str r12,[r8,r9,lsl #2]          @ and store in operand2 table
mov r7,#0   @ k
mov r8,#0   @ n
3:
cmp r7,r5
beq 4f
cmp r7,r6
beq 4f
ldr r0,[r10,r7,lsl #2]          @ copy other digits in new table on stack
str r0,[fp,r8,lsl #2]
4:
cmp r7,r3
ble 3b

str r7,[fp,r8,lsl #2]           @ store result of addition
mov r7,#'+'
str r7,[r0,r9,lsl #2]           @ store operator
mov r0,r9                       @ pass new level
mov r1,fp                       @ pass new table address on stack
bl searchSoluce
cmp r0,#0
blt 100f
@ soustraction test
cmp r4,r12
subgt r7,r4,r12
suble r7,r12,r4
str r7,[fp,r8,lsl #2]
mov r7,#'-'
str r7,[r0,r9,lsl #2]
mov r0,r9
mov r1,fp
bl searchSoluce
cmp r0,#0
blt 100f

mul r7,r4,r12                    @ multiplication test
str r7,[fp,r8,lsl #2]
mov r7,#'*'
//vidregtit mult
str r7,[r0,r9,lsl #2]
mov r0,r9
mov r1,fp
bl searchSoluce
cmp r0,#0
blt 100f
5:                                    @ division test
push {r1-r3}
mov r0,r4
mov r1,r12
bl division
// mov r7,r9
cmp r3,#0
bne 6f
str r2,[fp,r8,lsl #2]
mov r7,#'/'
str r7,[r0,r9,lsl #2]
mov r0,r9
mov r1,fp
bl searchSoluce
b 7f
6:
mov r0,r12
mov r1,r4
bl division
cmp r3,#0
bne 7f
str r2,[fp,r8,lsl #2]
mov r7,#'/'
str r7,[r0,r9,lsl #2]
mov r0,r9
mov r1,fp
bl searchSoluce
7:
pop {r1-r3}
cmp r0,#0
blt 100f

add r6,r6,#1                      @ increment indice loop 2
b 2b

8:
add r5,r5,#1                      @ increment indice loop 1
b 1b
9:

100:
add sp,#4* NBDIGITS               @ stack alignement
pop {r1-r12,lr}
bx lr                             @ return
/******************************************************************/
/*            write solution                                      */
/******************************************************************/
writeSoluce:
push {r1-r12,lr}            @ save registers
mov r4,#0                    @ buffer indice
mov r9,#1
1:
ldr r5,[r6,r9,lsl #2]       @ operand 1
ldr r11,[r7,r9,lsl #2]       @ operand  2
ldr r12,[r8,r9,lsl #2]       @ operator
cmp r12,#'-'
beq 2f
cmp r12,#'/'
beq 2f
b 3f
2:                               @ if division or soustraction
cmp r5,r11                   @ reverse operand if operand 1 is < operand 2
movlt r2,r5
movlt r5,r11
movlt r11,r2
3:                               @ conversion operand 1 = r0
mov r0,r5
mov r1,#10
bl division
cmp r2,#0
strneb r2,[r10,r4]
strb r3,[r10,r4]
ldr r2,[r7,r9,lsl #2]

strb r12,[r10,r4]           @ operator

mov r0,r11                  @ conversion operand  2
mov r1,#10
bl division
cmp r2,#0
strneb r2,[r10,r4]
strb r3,[r10,r4]

mov r0,#'='
str r0,[r10,r4]             @ conversion sous total
cmp r12,#'+'
cmp r12,#'-'
subeq r0,r5,r11
cmp r12,#'*'
muleq r0,r5,r11
cmp r12,#'/'
udiveq r0,r5,r11

mov r1,#10
bl division
cmp r2,#0
strneb r2,[r10,r4]
strb r3,[r10,r4]
mov r0,#'\n'
str r0,[r10,r4]

cmp r9,#NBDIGITS
blt 1b
mov r1,#0
strb r1,[r10,r4]            @ store 0 final

100:
pop {r1-r12,lr}
bx lr                       @ return

/******************************************************************/
/*            string entry                                       */
/******************************************************************/
/* r0 return the first character of human entry */
saisie:
push {r1-r7,lr}        @ save registers
mov r0,#STDIN          @ Linux input console
mov r2,#BUFFERSIZE     @ buffer size
svc 0                  @ call system
ldrb r0,[r1]           @ load first character
100:
pop {r1-r7,lr}
bx lr                   @ return
/***************************************************/
/*   Generation random number                  */
/***************************************************/
/* r0 contains limit  */
genereraleas:
push {r1-r4,lr}         @ save registers
ldr r2,[r4]
ldr r3,iNbDep1
mul r2,r3,r2
ldr r3,iNbDep2
str r2,[r4]             @ maj de la graine pour l appel suivant
cmp r0,#0
beq 100f
mov r0,r2               @ dividende
bl division
mov r0,r3               @ résult = remainder

100:                        @ end function
pop {r1-r4,lr}          @ restaur registers
bx lr                   @ return
/*****************************************************/
iNbDep1:     .int 0x343FD
iNbDep2:     .int 0x269EC3
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"
Output:
New game (y/n) ?
y
The four digits are 8 3 9 1 and the score is 24.
Solution :
8*9=72
3*1=3
72/3=24

New game (y/n) ?
y
The four digits are 7 7 9 4 and the score is 24.
No solution for this problem !!

New game (y/n) ?
y
The four digits are 3 5 8 9 and the score is 24.
Solution :
3*9=27
8-5=3
27-3=24

New game (y/n) ?


## AutoHotkey

Works with: AutoHotkey_L

Output is in RPN.

#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 }  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  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  Output: (1+2+3)*4 6*8/(9-7) (1+2)*(1+7) (5+5-6)*6  ## C Tested with GCC 10.2.0, but should work with all versions supporting C99. Provided code prints all solutions or nothing in case no solutions are found. It can be modified or extended to work with more than 4 numbers, goals other than 24 and additional operations. Note: This a brute-force approach with time complexity O(6n.n.(2n-3)!!) and recursion depth n. #include <stdio.h> typedef struct {int val, op, left, right;} Node; Node nodes[10000]; int iNodes; int b; float eval(Node x){ if (x.op != -1){ float l = eval(nodes[x.left]), r = eval(nodes[x.right]); switch(x.op){ case 0: return l+r; case 1: return l-r; case 2: return r-l; case 3: return l*r; case 4: return r?l/r:(b=1,0); case 5: return l?r/l:(b=1,0); } } else return x.val*1.; } void show(Node x){ if (x.op != -1){ printf("("); switch(x.op){ case 0: show(nodes[x.left]); printf(" + "); show(nodes[x.right]); break; case 1: show(nodes[x.left]); printf(" - "); show(nodes[x.right]); break; case 2: show(nodes[x.right]); printf(" - "); show(nodes[x.left]); break; case 3: show(nodes[x.left]); printf(" * "); show(nodes[x.right]); break; case 4: show(nodes[x.left]); printf(" / "); show(nodes[x.right]); break; case 5: show(nodes[x.right]); printf(" / "); show(nodes[x.left]); break; } printf(")"); } else printf("%d", x.val); } int float_fix(float x){ return x < 0.00001 && x > -0.00001; } void solutions(int a[], int n, float t, int s){ if (s == n){ b = 0; float e = eval(nodes[0]); if (!b && float_fix(e-t)){ show(nodes[0]); printf("\n"); } } else{ nodes[iNodes++] = (typeof(Node)){a[s],-1,-1,-1}; for (int op = 0; op < 6; op++){ int k = iNodes-1; for (int i = 0; i < k; i++){ nodes[iNodes++] = nodes[i]; nodes[i] = (typeof(Node)){-1,op,iNodes-1,iNodes-2}; solutions(a, n, t, s+1); nodes[i] = nodes[--iNodes]; } } iNodes--; } }; int main(){ // define problem int a[4] = {8, 3, 8, 3}; float t = 24; // print all solutions nodes[0] = (typeof(Node)){a[0],-1,-1,-1}; iNodes = 1; solutions(a, sizeof(a)/sizeof(int), t, 1); return 0; }  ## C++ Works with: C++11 Works with: GCC version 4.8 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. #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; }  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  ## C# Generate binary trees -> generate permutations -> create expression -> evaluate expression This works with other targets and more numbers but it will of course become slower. Redundant expressions are filtered out (based on https://www.4nums.com/theory/) but I'm not sure I caught them all. Works with: C sharp version 8 using System; using System.Collections.Generic; using static System.Linq.Enumerable; public static class Solve24Game { public static void Main2() { var testCases = new [] { new [] { 1,1,2,7 }, new [] { 1,2,3,4 }, new [] { 1,2,4,5 }, new [] { 1,2,7,7 }, new [] { 1,4,5,6 }, new [] { 3,3,8,8 }, new [] { 4,4,5,9 }, new [] { 5,5,5,5 }, new [] { 5,6,7,8 }, new [] { 6,6,6,6 }, new [] { 6,7,8,9 }, }; foreach (var t in testCases) Test(24, t); Test(100, 9,9,9,9,9,9); static void Test(int target, params int[] numbers) { foreach (var eq in GenerateEquations(target, numbers)) Console.WriteLine(eq); Console.WriteLine(); } } static readonly char[] ops = { '*', '/', '+', '-' }; public static IEnumerable<string> GenerateEquations(int target, params int[] numbers) { var operators = Repeat(ops, numbers.Length - 1).CartesianProduct().Select(e => e.ToArray()).ToList(); return ( from pattern in Patterns(numbers.Length) let expression = CreateExpression(pattern) from ops in operators where expression.WithOperators(ops).HasPreferredTree() from permutation in Permutations(numbers) let expr = expression.WithValues(permutation) where expr.Value == target && expr.HasPreferredValues() select$"{expr.ToString()} = {target}")
.Distinct()
.DefaultIfEmpty($"Cannot make {target} with {string.Join(", ", numbers)}"); } ///<summary>Generates postfix expression trees where 1's represent operators and 0's represent numbers.</summary> static IEnumerable<int> Patterns(int length) { if (length == 1) yield return 0; //0 if (length == 2) yield return 1; //001 if (length < 3) yield break; //Of each tree, the first 2 bits must always be 0 and the last bit must be 1. Generate the bits in between. length -= 2; int len = length * 2 + 3; foreach (int permutation in BinaryPatterns(length, length * 2)) { (int p, int l) = ((permutation << 1) + 1, len); if (IsValidPattern(ref p, ref l)) yield return (permutation << 1) + 1; } } ///<summary>Generates all numbers with the given number of 1's and total length.</summary> static IEnumerable<int> BinaryPatterns(int ones, int length) { int initial = (1 << ones) - 1; int blockMask = (1 << length) - 1; for (int v = initial; v >= initial; ) { yield return v; int w = (v | (v - 1)) + 1; w |= (((w & -w) / (v & -v)) >> 1) - 1; v = w & blockMask; } } static bool IsValidPattern(ref int pattern, ref int len) { bool isNumber = (pattern & 1) == 0; pattern >>= 1; len--; if (isNumber) return true; IsValidPattern(ref pattern, ref len); IsValidPattern(ref pattern, ref len); return len == 0; } static Expr CreateExpression(int pattern) { return Create(); Expr Create() { bool isNumber = (pattern & 1) == 0; pattern >>= 1; if (isNumber) return new Const(0); Expr right = Create(); Expr left = Create(); return new Binary('*', left, right); } } static IEnumerable<IEnumerable<T>> CartesianProduct<T>(this IEnumerable<IEnumerable<T>> sequences) { IEnumerable<IEnumerable<T>> emptyProduct = new[] { Empty<T>() }; return sequences.Aggregate( emptyProduct, (accumulator, sequence) => from acc in accumulator from item in sequence select acc.Concat(new [] { item })); } private static List<int> helper = new List<int>(); public static IEnumerable<T[]> Permutations<T>(params T[] input) { if (input == null || input.Length == 0) yield break; helper.Clear(); for (int i = 0; i < input.Length; i++) helper.Add(i); while (true) { yield return input; int cursor = helper.Count - 2; while (cursor >= 0 && helper[cursor] > helper[cursor + 1]) cursor--; if (cursor < 0) break; int i = helper.Count - 1; while (i > cursor && helper[i] < helper[cursor]) i--; (helper[cursor], helper[i]) = (helper[i], helper[cursor]); (input[cursor], input[i]) = (input[i], input[cursor]); int firstIndex = cursor + 1; for (int lastIndex = helper.Count - 1; lastIndex > firstIndex; ++firstIndex, --lastIndex) { (helper[firstIndex], helper[lastIndex]) = (helper[lastIndex], helper[firstIndex]); (input[firstIndex], input[lastIndex]) = (input[lastIndex], input[firstIndex]); } } } static Expr WithOperators(this Expr expr, char[] operators) { int i = 0; SetOperators(expr, operators, ref i); return expr; static void SetOperators(Expr expr, char[] operators, ref int i) { if (expr is Binary b) { b.Symbol = operators[i++]; SetOperators(b.Right, operators, ref i); SetOperators(b.Left, operators, ref i); } } } static Expr WithValues(this Expr expr, int[] values) { int i = 0; SetValues(expr, values, ref i); return expr; static void SetValues(Expr expr, int[] values, ref int i) { if (expr is Binary b) { SetValues(b.Left, values, ref i); SetValues(b.Right, values, ref i); } else { expr.Value = values[i++]; } } } static bool HasPreferredTree(this Expr expr) => expr switch { Const _ => true, // a / b * c => a * c / b ((_, '/' ,_), '*', _) => false, // c + a * b => a * b + c (var l, '+', (_, '*' ,_) r) when l.Depth < r.Depth => false, // c + a / b => a / b + c (var l, '+', (_, '/' ,_) r) when l.Depth < r.Depth => false, // a * (b + c) => (b + c) * a (var l, '*', (_, '+' ,_) r) when l.Depth < r.Depth => false, // a * (b - c) => (b - c) * a (var l, '*', (_, '-' ,_) r) when l.Depth < r.Depth => false, // (a +- b) + (c */ d) => ((c */ d) + a) +- b ((_, var p, _), '+', (_, var q, _)) when "+-".Contains(p) && "*/".Contains(q) => false, // a + (b + c) => (a + b) + c (var l, '+', (_, '+' ,_) r) => false, // a + (b - c) => (a + b) - c (var l, '+', (_, '-' ,_) r) => false, // a - (b + c) => (a - b) + c (_, '-', (_, '+', _)) => false, // a * (b * c) => (a * b) * c (var l, '*', (_, '*' ,_) r) => false, // a * (b / c) => (a * b) / c (var l, '*', (_, '/' ,_) r) => false, // a / (b / c) => (a * c) / b (var l, '/', (_, '/' ,_) r) => false, // a - (b - c) * d => (c - b) * d + a (_, '-', ((_, '-' ,_), '*', _)) => false, // a - (b - c) / d => (c - b) / d + a (_, '-', ((_, '-' ,_), '/', _)) => false, // a - (b - c) => a + c - b (_, '-', (_, '-', _)) => false, // (a - b) + c => (a + c) - b ((_, '-', var b), '+', var c) => false, (var l, _, var r) => l.HasPreferredTree() && r.HasPreferredTree() }; static bool HasPreferredValues(this Expr expr) => expr switch { Const _ => true, // -a + b => b - a (var l, '+', var r) when l.Value < 0 && r.Value >= 0 => false, // b * a => a * b (var l, '*', var r) when l.Depth == r.Depth && l.Value > r.Value => false, // b + a => a + b (var l, '+', var r) when l.Depth == r.Depth && l.Value > r.Value => false, // (b o c) * (a o d) => (a o d) * (b o c) ((var a, _, _) l, '*', (var c, _, _) r) when l.Value == r.Value && l.Depth == r.Depth && a.Value < c.Value => false, // (b o c) + (a o d) => (a o d) + (b o c) ((var a, var p, _) l, '+', (var c, var q, _) r) when l.Value == r.Value && l.Depth == r.Depth && a.Value < c.Value => false, // (a * c) * b => (a * b) * c ((_, '*', var c), '*', var b) when b.Value < c.Value => false, // (a + c) + b => (a + b) + c ((_, '+', var c), '+', var b) when b.Value < c.Value => false, // (a - b) - c => (a - c) - b ((_, '-', var b), '-', var c) when b.Value < c.Value => false, // a / 1 => a * 1 (_, '/', var b) when b.Value == 1 => false, // a * b / b => a + b - b ((_, '*', var b), '/', var c) when b.Value == c.Value => false, // a * 1 * 1 => a + 1 - 1 ((_, '*', var b), '*', var c) when b.Value == 1 && c.Value == 1 => false, (var l, _, var r) => l.HasPreferredValues() && r.HasPreferredValues() }; private struct Fraction : IEquatable<Fraction>, IComparable<Fraction> { public readonly int Numerator, Denominator; public Fraction(int numerator, int denominator) => (Numerator, Denominator) = (numerator, denominator) switch { (_, 0) => (Math.Sign(numerator), 0), (0, _) => (0, 1), (_, var d) when d < 0 => (-numerator, -denominator), _ => (numerator, denominator) }; public static implicit operator Fraction(int i) => new Fraction(i, 1); public static Fraction operator +(Fraction a, Fraction b) => new Fraction(a.Numerator * b.Denominator + a.Denominator * b.Numerator, a.Denominator * b.Denominator); public static Fraction operator -(Fraction a, Fraction b) => new Fraction(a.Numerator * b.Denominator + a.Denominator * -b.Numerator, a.Denominator * b.Denominator); public static Fraction operator *(Fraction a, Fraction b) => new Fraction(a.Numerator * b.Numerator, a.Denominator * b.Denominator); public static Fraction operator /(Fraction a, Fraction b) => new Fraction(a.Numerator * b.Denominator, a.Denominator * b.Numerator); public static bool operator ==(Fraction a, Fraction b) => a.CompareTo(b) == 0; public static bool operator !=(Fraction a, Fraction b) => a.CompareTo(b) != 0; public static bool operator <(Fraction a, Fraction b) => a.CompareTo(b) < 0; public static bool operator >(Fraction a, Fraction b) => a.CompareTo(b) > 0; public static bool operator <=(Fraction a, Fraction b) => a.CompareTo(b) <= 0; public static bool operator >=(Fraction a, Fraction b) => a.CompareTo(b) >= 0; public bool Equals(Fraction other) => Numerator == other.Numerator && Denominator == other.Denominator; public override string ToString() => Denominator == 1 ? Numerator.ToString() :$"[{Numerator}/{Denominator}]";

public int CompareTo(Fraction other) => (Numerator, Denominator, other.Numerator, other.Denominator) switch {
var (    n1, d1,     n2, d2) when n1 == n2 && d1 == d2 => 0,
(     0,  0,      _,  _) => (-1),
(     _,  _,      0,  0) => 1,
var (    n1, d1,     n2, d2) when d1 == d2 => n1.CompareTo(n2),
(var n1,  0,      _,  _) => Math.Sign(n1),
(     _,  _, var n2,  0) => Math.Sign(n2),
var (    n1, d1,     n2, d2) => (n1 * d2).CompareTo(n2 * d1)
};
}

private abstract class Expr
{
protected Expr(char symbol) => Symbol = symbol;
public char Symbol { get; set; }
public abstract Fraction Value { get; set; }
public abstract int Depth { get; }
public abstract void Deconstruct(out Expr left, out char symbol, out Expr right);
}

private sealed class Const : Expr
{
public Const(Fraction value) : base('c') => Value = value;
public override Fraction Value { get; set; }
public override int Depth => 0;
public override void Deconstruct(out Expr left, out char symbol, out Expr right) => (left, symbol, right) = (this, Symbol, this);
public override string ToString() => Value.ToString();
}

private sealed class Binary : Expr
{
public Binary(char symbol, Expr left, Expr right) : base(symbol) => (Left, Right) = (left, right);
public Expr Left { get; }
public Expr Right { get; }
public override int Depth => Math.Max(Left.Depth, Right.Depth) + 1;
public override void Deconstruct(out Expr left, out char symbol, out Expr right) => (left, symbol, right) = (Left, Symbol, Right);

public override Fraction Value {
get => Symbol switch {
'*' => Left.Value * Right.Value,
'/' => Left.Value / Right.Value,
'+' => Left.Value + Right.Value,
'-' => Left.Value - Right.Value,
_ => throw new InvalidOperationException() };
set {}
}

public override string ToString() => Symbol switch {
'*' => ToString("+-".Contains(Left.Symbol), "+-".Contains(Right.Symbol)),
'/' => ToString("+-".Contains(Left.Symbol), "*/+-".Contains(Right.Symbol)),
'+' => ToString(false, false),
'-' => ToString(false, "+-".Contains(Right.Symbol)),
_ => $"[{Value}]" }; private string ToString(bool wrapLeft, bool wrapRight) =>$"{(wrapLeft ? $"({Left})" :$"{Left}")} {Symbol} {(wrapRight ? $"({Right})" :$"{Right}")}";
}
}

Output:
(1 + 2) * (1 + 7) = 24

(1 + 3) * (2 + 4) = 24
1 * 2 * 3 * 4 = 24
(1 + 2 + 3) * 4 = 24

(5 - 1) * (2 + 4) = 24
(2 + 5 - 1) * 4 = 24

(7 * 7 - 1) / 2 = 24

4 / (1 - 5 / 6) = 24
6 / (5 / 4 - 1) = 24

8 / (3 - 8 / 3) = 24

Cannot make 24 with 4, 4, 5, 9

5 * 5 - 5 / 5 = 24

(8 - 6) * (5 + 7) = 24
6 * 8 / (7 - 5) = 24
(5 + 7 - 8) * 6 = 24

6 + 6 + 6 + 6 = 24
6 * 6 - 6 - 6 = 24

6 * 8 / (9 - 7) = 24

(9 / 9 + 9) * (9 / 9 + 9) = 100

## Ceylon

Don't forget to import ceylon.random in your module.ceylon file.

import ceylon.random {
DefaultRandom
}

shared sealed class Rational(numerator, denominator = 1) satisfies Numeric<Rational> {

shared Integer numerator;
shared Integer denominator;

Integer gcd(Integer a, Integer b) => if (b == 0) then a else gcd(b, a % b);

shared Rational inverted => Rational(denominator, numerator);

shared Rational simplified =>
let (largestFactor = gcd(numerator, denominator))
Rational(numerator / largestFactor, denominator / largestFactor);

divided(Rational other) => (this * other.inverted).simplified;

negated => Rational(-numerator, denominator).simplified;

plus(Rational other) =>
let (top = numerator*other.denominator + other.numerator*denominator,
bottom = denominator * other.denominator)
Rational(top, bottom).simplified;

times(Rational other) =>
Rational(numerator * other.numerator, denominator * other.denominator).simplified;

shared Integer integer => numerator / denominator;
shared Float float => numerator.float / denominator.float;

string => denominator == 1 then numerator.string else "numerator/denominator";

shared actual Boolean equals(Object that) {
if (is Rational that) {
value simplifiedThis = this.simplified;
value simplifiedThat = that.simplified;
return simplifiedThis.numerator==simplifiedThat.numerator &&
simplifiedThis.denominator==simplifiedThat.denominator;
} else {
return false;
}
}
}

shared Rational? rational(Integer numerator, Integer denominator = 1) =>
if (denominator == 0)
then null
else Rational(numerator, denominator).simplified;

shared Rational numeratorOverOne(Integer numerator) => Rational(numerator);

shared abstract class Operation(String lexeme) of addition | subtraction | multiplication | division {
shared formal Rational perform(Rational left, Rational right);
string => lexeme;
}

shared object addition extends Operation("+") {
perform(Rational left, Rational right) => left + right;
}
shared object subtraction extends Operation("-") {
perform(Rational left, Rational right) => left - right;
}
shared object multiplication extends Operation("*") {
perform(Rational left, Rational right) => left * right;
}
shared object division extends Operation("/") {
perform(Rational left, Rational right) => left / right;
}

shared Operation[] operations = Operation.caseValues;

shared interface Expression of NumberExpression | OperationExpression {
shared formal Rational evaluate();
}

shared class NumberExpression(Rational number) satisfies Expression {
evaluate() => number;
string => number.string;
}
shared class OperationExpression(Expression left, Operation op, Expression right) satisfies Expression {
evaluate() => op.perform(left.evaluate(), right.evaluate());
string => "(left op right)";
}

shared void run() {

value twentyfour = numeratorOverOne(24);

value random = DefaultRandom();

function buildExpressions({Rational*} numbers, Operation* ops) {
assert (is NumberExpression[4] numTuple = numbers.collect(NumberExpression).tuple());
assert (is Operation[3] opTuple = ops.sequence().tuple());
value [a, b, c, d] = numTuple;
value [op1, op2, op3] = opTuple;
value opExp = OperationExpression; // this is just to give it a shorter name
return [
opExp(opExp(opExp(a, op1, b), op2, c), op3, d),
opExp(opExp(a, op1, opExp(b, op2, c)), op3, d),
opExp(a, op1, opExp(opExp(b, op2, c), op3, d)),
opExp(a, op1, opExp(b, op2, opExp(c, op3, d)))
];
}

print("Please enter your 4 numbers to see how they form 24 or enter the letter r for random numbers.");

if (exists line = process.readLine()) {

Rational[] chosenNumbers;

if (line.trimmed.uppercased == "R") {
chosenNumbers = random.elements(1..9).take(4).collect((Integer element) => numeratorOverOne(element));
print("The random numbers are chosenNumbers");
} else {
chosenNumbers = line.split().map(Integer.parse).narrow<Integer>().collect(numeratorOverOne);
}

value expressions = {
for (numbers in chosenNumbers.permutations)
for (op1 in operations)
for (op2 in operations)
for (op3 in operations)
for (exp in buildExpressions(numbers, op1, op2, op3))
if (exp.evaluate() == twentyfour)
exp
};

print("The solutions are:");
expressions.each(print);
}
}


## 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))


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.

## COBOL

        >>SOURCE FORMAT FREE
*> This code is dedicated to the public domain
*> This is GNUCobol 2.0
identification division.
program-id. twentyfoursolve.
environment division.
configuration section.
repository. function all intrinsic.
input-output section.
file-control.
select count-file
assign to count-file-name
file status count-file-status
organization line sequential.
data division.
file section.
fd  count-file.
01  count-record pic x(7).

working-storage section.
01  count-file-name pic x(64) value 'solutioncounts'.
01  count-file-status pic xx.

01  command-area.
03  nd pic 9.
03  number-definition.
05  n occurs 4 pic 9.
03  number-definition-9 redefines number-definition
pic 9(4).
03  command-input pic x(16).
03  command pic x(5).
03  number-count pic 9999.
03  l1 pic 99.
03  l2 pic 99.
03  expressions pic zzz,zzz,zz9.

01  number-validation.
03  px pic 99.
03  permutations value
'1234'
& '1243'
& '1324'
& '1342'
& '1423'
& '1432'

& '2134'
& '2143'
& '2314'
& '2341'
& '2413'
& '2431'

& '3124'
& '3142'
& '3214'
& '3241'
& '3423'
& '3432'

& '4123'
& '4132'
& '4213'
& '4231'
& '4312'
& '4321'.
05  permutation occurs 24 pic x(4).
03  cpx pic 9.
03  current-permutation pic x(4).
03  od1 pic 9.
03  od2 pic 9.
03  od3 pic 9.
03  operator-definitions pic x(4) value '+-*/'.
03  cox pic 9.
03  current-operators pic x(3).
03  rpn-forms value
'nnonono'
& 'nnonnoo'
& 'nnnonoo'
& 'nnnoono'
& 'nnnnooo'.
05  rpn-form occurs 5 pic x(7).
03  rpx pic 9.
03  current-rpn-form pic x(7).

01  calculation-area.
03  oqx pic 99.
03  output-queue pic x(7).
03  work-number pic s9999.
03  top-numerator pic s9999 sign leading separate.
03  top-denominator pic s9999 sign leading separate.
03  rsx pic 9.
03  result-stack occurs 8.
05  numerator pic s9999.
05  denominator pic s9999.
03  divide-by-zero-error pic x.

01  totals.
03  s pic 999.
03  s-lim pic 999 value 600.
03  s-max pic 999 value 0.
03  solution occurs 600 pic x(7).
03  sc pic 999.
03  sc1 pic 999.
03  sc2 pic 9.
03  sc-max pic 999 value 0.
03  sc-lim pic 999 value 600.
03  solution-counts value zeros.
05  solution-count occurs 600 pic 999.
03  ns pic 9999.
03  ns-max pic 9999 value 0.
03  ns-lim pic 9999 value 6561.
03  number-solutions occurs 6561.
05 ns-number pic x(4).
05 ns-count pic 999.
03  record-counts pic 9999.
03  total-solutions pic 9999.

01  infix-area.
03  i pic 9.
03  i-s pic 9.
03  i-s1 pic 9.
03  i-work pic x(16).
03  i-stack occurs 7 pic x(13).

procedure division.
start-twentyfoursolve.
display 'start twentyfoursolve'
perform display-instructions
perform get-command
perform until command-input = spaces
display space
initialize command number-count
unstring command-input delimited by all space
into command number-count
move command-input to number-definition
move spaces to command-input
evaluate command
when 'h'
when 'help'
perform display-instructions
when 'list'
if ns-max = 0
end-if
perform list-counts
when 'show'
if ns-max = 0
end-if
perform show-numbers
when other
if number-definition-9 not numeric
display 'invalid number'
else
perform get-solutions
perform display-solutions
end-if
end-evaluate
if command-input = spaces
perform get-command
end-if
end-perform
display 'exit twentyfoursolve'
stop run
.
display-instructions.
display space
display 'enter a number <n> as four integers from 1-9 to see its solutions'
display 'enter list to see counts of solutions for all numbers'
display 'enter show <n> to see numbers having <n> solutions'
display '<enter> ends the program'
.
get-command.
display space
move spaces to command-input
display '(h for help)?' with no advancing
accept command-input
.
display space
move 0 to l1
if l2 = 10
display 'more (<enter>)?' with no advancing
accept command-input
move 0 to l2
end-if
.
list-counts.
add 1 to sc-max giving sc
display 'there are ' sc ' solution counts'
display space
display 'solutions/numbers'
move 0 to l1
move 0 to l2
perform varying sc from 1 by 1 until sc > sc-max
or command-input <> spaces
if solution-count(sc) > 0
subtract 1 from sc giving sc1 *> offset to capture zero counts
display sc1 '/' solution-count(sc) space with no advancing
if l1 = 8
end-if
end-if
end-perform
if l1 > 0
display space
end-if
.
show-numbers. *> with number-count solutions
add 1 to number-count giving sc1 *> offset for zero count
evaluate true
when number-count >= sc-max
display 'no number has ' number-count ' solutions'
exit paragraph
when solution-count(sc1) = 1 and number-count = 1
display '1 number has 1 solution'
when solution-count(sc1) = 1
display '1 number has ' number-count ' solutions'
when number-count = 1
display solution-count(sc1) ' numbers have 1 solution'
when other
display solution-count(sc1) ' numbers have ' number-count ' solutions'
end-evaluate
display space
move 0 to l1
move 0 to l2
perform varying ns from 1 by 1 until ns > ns-max
or command-input <> spaces
if ns-count(ns) = number-count
display ns-number(ns) space with no advancing
if l1 = 14
end-if
end-if
end-perform
if l1 > 0
display space
end-if
.
display-solutions.
evaluate s-max
when 0 display number-definition ' has no solutions'
when 1 display number-definition ' has 1 solution'
when other display number-definition ' has ' s-max ' solutions'
end-evaluate
display space
move 0 to l1
move 0 to l2
perform varying s from 1 by 1 until s > s-max
or command-input <> spaces
*> convert rpn solution(s) to infix
move 0 to i-s
perform varying i from 1 by 1 until i > 7
if solution(s)(i:1) >= '1' and <= '9'
move solution(s)(i:1) to i-stack(i-s)
else
subtract 1 from i-s giving i-s1
move spaces to i-work
string '(' i-stack(i-s1) solution(s)(i:1) i-stack(i-s) ')'
delimited by space into i-work
move i-work to i-stack(i-s1)
subtract 1 from i-s
end-if
end-perform
display solution(s) space i-stack(1) space space with no advancing
if l1 = 3
end-if
end-perform
if l1 > 0
display space
end-if
.
move 0 to ns-max *> numbers and their solution count
move 0 to sc-max *> solution counts
move spaces to count-file-status
open input count-file
if count-file-status <> '00'
perform create-count-file
move 0 to ns-max *> numbers and their solution count
move 0 to sc-max *> solution counts
open input count-file
end-if
move 0 to record-counts
move zeros to solution-counts
perform until count-file-status <> '00'
perform increment-ns-max
move count-record to number-solutions(ns-max)
add 1 to ns-count(ns-max) giving sc *> offset 1 for zero counts
if sc > sc-lim
display 'sc ' sc ' exceeds sc-lim ' sc-lim
stop run
end-if
if sc > sc-max
move sc to sc-max
end-if
end-perform
close count-file
.
create-count-file.
open output count-file
display 'Counting solutions for all numbers'
display 'We will examine 9*9*9*9 numbers'
display 'For each number we will examine 4! permutations of the digits'
display 'For each permutation we will examine 4*4*4 combinations of operators'
display 'For each permutation and combination we will examine 5 rpn forms'
display 'We will count the number of unique solutions for the given number'
display 'Each number and its counts will be written to file ' trim(count-file-name)
compute expressions = 9*9*9*9*factorial(4)*4*4*4*5
display 'So we will evaluate ' trim(expressions) ' statements'
display 'This will take a few minutes'
display 'In the future if ' trim(count-file-name) ' exists, this step will be bypassed'
move 0 to record-counts
move 0 to total-solutions
perform varying n(1) from 1 by 1 until n(1) = 0
perform varying n(2) from 1 by 1 until n(2) = 0
display n(1) n(2) '..' *> show progress
perform varying n(3) from 1 by 1 until n(3) = 0
perform varying n(4) from 1 by 1 until n(4) = 0
perform get-solutions
perform increment-ns-max
move number-definition to ns-number(ns-max)
move s-max to ns-count(ns-max)
move number-solutions(ns-max) to count-record
write count-record
add 1 to ns-count(ns-max) giving sc *> offset by 1 for zero counts
if sc > sc-lim
display 'error: ' sc ' solution count exceeds ' sc-lim
stop run
end-if
end-perform
end-perform
end-perform
end-perform
close count-file
display record-counts ' numbers and counts written to ' trim(count-file-name)
display total-solutions ' total solutions'
display space
.
increment-ns-max.
if ns-max >= ns-lim
display 'error: numbers exceeds ' ns-lim
stop run
end-if
.
get-solutions.
move 0 to s-max
perform varying px from 1 by 1 until px > 24
move permutation(px) to current-permutation
perform varying od1 from 1 by 1 until od1 > 4
move operator-definitions(od1:1) to current-operators(1:1)
perform varying od2 from 1 by 1 until od2 > 4
move operator-definitions(od2:1) to current-operators(2:1)
perform varying od3 from 1 by 1 until od3 > 4
move operator-definitions(od3:1) to current-operators(3:1)
perform varying rpx from 1 by 1 until rpx > 5
move rpn-form(rpx) to current-rpn-form
move 0 to cpx cox
move spaces to output-queue
perform varying oqx from 1 by 1 until oqx > 7
if current-rpn-form(oqx:1) = 'n'
move current-permutation(cpx:1) to nd
move n(nd) to output-queue(oqx:1)
else
move current-operators(cox:1) to output-queue(oqx:1)
end-if
end-perform
perform evaluate-rpn
if divide-by-zero-error = space
and 24 * top-denominator = top-numerator
perform varying s from 1 by 1 until s > s-max
or solution(s) = output-queue
continue
end-perform
if s > s-max
if s >= s-lim
display 'error: solutions ' s ' for ' number-definition ' exceeds ' s-lim
stop run
end-if
move s to s-max
move output-queue to solution(s-max)
end-if
end-if
end-perform
end-perform
end-perform
end-perform
end-perform
.
evaluate-rpn.
move space to divide-by-zero-error
move 0 to rsx *> stack depth
perform varying oqx from 1 by 1 until oqx > 7
if output-queue(oqx:1) >= '1' and <= '9'
*> push the digit onto the stack
move top-numerator to numerator(rsx)
move top-denominator to denominator(rsx)
move output-queue(oqx:1) to top-numerator
move 1 to top-denominator
else
*> apply the operation
evaluate output-queue(oqx:1)
when '+'
compute top-numerator = top-numerator * denominator(rsx)
+ top-denominator * numerator(rsx)
compute top-denominator = top-denominator * denominator(rsx)
when '-'
compute top-numerator = top-denominator * numerator(rsx)
- top-numerator * denominator(rsx)
compute top-denominator = top-denominator * denominator(rsx)
when '*'
compute top-numerator = top-numerator * numerator(rsx)
compute top-denominator = top-denominator * denominator(rsx)
when '/'
compute work-number = numerator(rsx) * top-denominator
compute top-denominator = denominator(rsx) * top-numerator
if top-denominator = 0
move 'y' to divide-by-zero-error
exit paragraph
end-if
move work-number to top-numerator
end-evaluate
*> pop the stack
subtract 1 from rsx
end-if
end-perform
.
end program twentyfoursolve.

Output:
prompt$cobc -xj twentyfoursolve.cob start twentyfoursolve enter a number <n> as four integers from 1-9 to see its solutions enter list to see counts of solutions for all numbers enter show <n> to see numbers having <n> solutions <enter> ends the program (h for help)?5678 5678 has 026 solutions 57+8-6* (((5+7)-8)*6) 57+86-* ((5+7)*(8-6)) 578-+6* ((5+(7-8))*6) 58-7+6* (((5-8)+7)*6) 587--6* ((5-(8-7))*6) 657+8-* (6*((5+7)-8)) 6578-+* (6*(5+(7-8))) 658-7+* (6*((5-8)+7)) 6587--* (6*(5-(8-7))) 675+8-* (6*((7+5)-8)) 6758-+* (6*(7+(5-8))) 675-/8* ((6/(7-5))*8) 675-8// (6/((7-5)/8)) 678-5+* (6*((7-8)+5)) 6785--* (6*(7-(8-5))) 6875-/* (6*(8/(7-5))) 68*75-/ ((6*8)/(7-5)) 75+8-6* (((7+5)-8)*6) 75+86-* ((7+5)*(8-6)) 758-+6* ((7+(5-8))*6) 86-57+* ((8-6)*(5+7)) 86-75+* ((8-6)*(7+5)) 8675-/* (8*(6/(7-5))) 86*75-/ ((8*6)/(7-5)) 875-/6* ((8/(7-5))*6) 875-6// (8/((7-5)/6)) (h for help)?  ## 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'}"  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 (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))  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. Translation of: Scala import std.stdio, std.algorithm, std.range, std.conv, std.string, std.concurrency, permutations2, arithmetic_rational; string solve(in int target, in int[] problem) { static struct T { Rational r; string e; } Generator!T computeAllOperations(in Rational[] L) { return new typeof(return)({ if (!L.empty) { immutable x = L[0]; if (L.length == 1) { yield(T(x, x.text)); } else { foreach (const o; computeAllOperations(L.dropOne)) { immutable y = o.r; auto sub = [T(x * y, "*"), T(x + y, "+"), T(x - y, "-")]; if (y) sub ~= [T(x / y, "/")]; foreach (const e; sub) yield(T(e.r, format("(%s%s%s)", x, e.e, o.e))); } } } }); } foreach (const p; problem.map!Rational.array.permutations!false) foreach (const sol; computeAllOperations(p)) if (sol.r == target) return sol.e; return "No solution"; } void main() { foreach (const prob; [[6, 7, 9, 5], [3, 3, 8, 8], [1, 1, 1, 1]]) writeln(prob, ": ", solve(24, prob)); }  Output: [6, 7, 9, 5]: (6+(9*(7-5))) [3, 3, 8, 8]: (8/(3-(8/3))) [1, 1, 1, 1]: No solution ## EchoLisp The program takes n numbers - not limited to 4 - builds the all possible legal rpn expressions according to the game rules, and evaluates them. Time saving : 4 5 + is the same as 5 4 + . Do not generate twice. Do not generate expressions like 5 6 * + which are not legal. ;; use task [[RPN_to_infix_conversion#EchoLisp]] to print results (define (rpn->string rpn) (if (vector? rpn) (infix->string (rpn->infix rpn)) "😥 Not found")) (string-delimiter "") (define OPS #(* + - // )) ;; use float division (define-syntax-rule (commutative? op) (or (= op *) (= op +))) ;; --------------------------------- ;; calc rpn -> num value or #f if bad rpn ;; rpn is a vector of ops or numbers ;; ---------------------------------- (define (calc rpn) (define S (stack 'S)) (for ((token rpn)) (if (procedure? token) (let [(op2 (pop S)) (op1 (pop S))] (if (and op1 op2) (push S (apply token (list op1 op2))) (push S #f))) ;; not-well formed (push S token )) #:break (not (stack-top S))) (if (= 1 (stack-length S)) (pop S) #f)) ;; check for legal rpn -> #f if not legal (define (rpn? rpn) (define S (stack 'S)) (for ((token rpn)) (if (procedure? token) (push S (and (pop S) (pop S))) (push S token )) #:break (not (stack-top S))) (stack-top S)) ;; -------------------------------------- ;; build-rpn : push next rpn op or number ;; dleft is number of not used digits ;; --------------------------------------- (define count 0) (define (build-rpn into: rpn depth maxdepth digits ops dleft target &hit ) (define cmpop #f) (cond ;; tooo long [(> (++ count) 200_000) (set-box! &hit 'not-found)] ;; stop on first hit [(unbox &hit) &hit] ;; partial rpn must be legal [(not (rpn? rpn)) #f] ;; eval rpn if complete [(> depth maxdepth) (when (= target (calc rpn)) (set-box! &hit rpn))] ;; else, add a digit to rpn [else [when (< depth maxdepth) ;; digits anywhere except last (for [(d digits) (i 10)] #:continue (zero? d) (vector-set! digits i 0) ;; mark used (vector-set! rpn depth d) (build-rpn rpn (1+ depth) maxdepth digits ops (1- dleft) target &hit) (vector-set! digits i d)) ;; mark unused ] ;; add digit ;; or, add an op ;; ops anywhere except positions 0,1 [when (and (> depth 1) (<= (+ depth dleft) maxdepth));; cutter : must use all digits (set! cmpop (and (number? [rpn (1- depth)]) (number? [rpn (- depth 2)]) (> [rpn (1- depth)] [rpn (- depth 2)]))) (for [(op ops)] #:continue (and cmpop (commutative? op)) ;; cutter : 3 4 + === 4 3 + (vector-set! rpn depth op) (build-rpn rpn (1+ depth) maxdepth digits ops dleft target &hit) (vector-set! rpn depth 0))] ;; add op ] ; add something to rpn vector )) ; build-rpn ;;------------------------ ;;gen24 : num random numbers ;;------------------------ (define (gen24 num maxrange) (->> (append (range 1 maxrange)(range 1 maxrange)) shuffle (take num))) ;;------------------------------------------- ;; try-rpn : sets starter values for build-rpn ;;------------------------------------------- (define (try-rpn digits target) (set! digits (list-sort > digits)) ;; seems to accelerate things (define rpn (make-vector (1- (* 2 (length digits))))) (define &hit (box #f)) (set! count 0) (build-rpn rpn starter-depth: 0 max-depth: (1- (vector-length rpn)) (list->vector digits) OPS remaining-digits: (length digits) target &hit ) (writeln target '= (rpn->string (unbox &hit)) 'tries= count)) ;; ------------------------------- ;; (task numdigits target maxrange) ;; -------------------------------- (define (task (numdigits 4) (target 24) (maxrange 10)) (define digits (gen24 numdigits maxrange)) (writeln digits '→ target) (try-rpn digits target))  Output: (task 4) ;; standard 24-game (7 9 2 4) → 24 24 = 9 + 7 + 4 * 2 tries= 35 (task 4) (1 9 3 4) → 24 24 = 9 + (4 + 1) * 3 tries= 468 (task 5 ) ;; 5 digits (4 8 6 9 8) → 24 24 = 9 * 8 * (8 / (6 * 4)) tries= 104 (task 5 100) ;; target = 100 (5 6 5 1 3) → 100 100 = (6 + (5 * 3 - 1)) * 5 tries= 10688 (task 5 (random 100)) (1 1 8 6 8) → 31 31 = 8 * (6 - 1) - (8 + 1) tries= 45673 (task 6 (random 100)) ;; 6 digits (7 2 7 8 3 1) → 40 40 = 8 / (7 / (7 * (3 + 2 * 1))) tries= 154 (task 6 (random 1000) 100) ;; 6 numbers < 100 , target < 1000 (19 15 83 74 61 48) → 739 739 = (83 + (74 - (61 + 48))) * 15 + 19 tries= 29336 (task 6 (random 1000) 100) ;; 6 numbers < 100 (73 29 65 78 22 43) → 1 1 = 😥 Not found tries= 200033 (task 7 (random 1000) 100) ;; 7 numbers < 100 (7 55 94 4 71 58 93) → 705 705 = 94 + 93 + 71 + 58 + 55 * 7 + 4 tries= 5982 (task 6 (random -100) 10) ;; negative target (5 9 7 3 6 3) → -54 -54 = 9 * (7 + (6 - 5 * 3)) * 3 tries= 2576  ## Elixir Translation of: Ruby defmodule Game24 do @expressions [ ["((", "", ")", "", ")", ""], ["(", "(", "", "", "))", ""], ["(", "", ")", "(", "", ")"], ["", "((", "", "", ")", ")"], ["", "(", "", "(", "", "))"] ] def solve(digits) do dig_perm = permute(digits) |> Enum.uniq operators = perm_rep(~w[+ - * /], 3) for dig <- dig_perm, ope <- operators, expr <- @expressions, check?(str = make_expr(dig, ope, expr)), do: str end defp check?(str) do try do {val, _} = Code.eval_string(str) val == 24 rescue ArithmeticError -> false # division by zero end end defp permute([]), do: [[]] defp permute(list) do for x <- list, y <- permute(list -- [x]), do: [x|y] end defp perm_rep([], _), do: [[]] defp perm_rep(_, 0), do: [[]] defp perm_rep(list, i) do for x <- list, y <- perm_rep(list, i-1), do: [x|y] end defp make_expr([a,b,c,d], [x,y,z], [e0,e1,e2,e3,e4,e5]) do e0 <> a <> x <> e1 <> b <> e2 <> y <> e3 <> c <> e4 <> z <> d <> e5 end end case Game24.solve(System.argv) do [] -> IO.puts "no solutions" solutions -> IO.puts "found #{length(solutions)} solutions, including #{hd(solutions)}" IO.inspect Enum.sort(solutions) end  Output: C:\Elixir>elixir game24.exs 1 1 3 4 found 12 solutions, including ((1+1)*3)*4 ["((1+1)*3)*4", "((1+1)*4)*3", "(1+1)*(3*4)", "(1+1)*(4*3)", "(3*(1+1))*4", "(3*4)*(1+1)", "(4*(1+1))*3", "(4*3)*(1+1)", "3*((1+1)*4)", "3*(4*(1+1))", "4*((1+1)*3)", "4*(3*(1+1))"] C:\Elixir>elixir game24.exs 6 7 8 9 found 8 solutions, including (6*8)/(9-7) ["(6*8)/(9-7)", "(6/(9-7))*8", "(8*6)/(9-7)", "(8/(9-7))*6", "6*(8/(9-7))", "6/((9-7)/8)", "8*(6/(9-7))", "8/((9-7)/6)"] C:\Elixir>elixir game24.exs 1 2 2 3 no solutions  ## ERRE ERRE hasn't an "EVAL" function so we must write an evaluation routine; this task is solved via "brute-force". PROGRAM 24SOLVE LABEL 98,99,2540,2550,2560 ! possible brackets CONST NBRACKETS=11,ST_CONST$="+-*/^("

DIM D[4],PERM[24,4]
DIM BRAKETS$[NBRACKETS] DIM OP$[3]
DIM STACK$[50] PROCEDURE COMPATTA_STACK IF NS>1 THEN R=1 WHILE R<NS DO IF INSTR(ST_CONST$,STACK$[R])=0 AND INSTR(ST_CONST$,STACK$[R+1])=0 THEN FOR R1=R TO NS-1 DO STACK$[R1]=STACK$[R1+1] END FOR NS=NS-1 END IF R=R+1 END WHILE END IF END PROCEDURE PROCEDURE CALC_ARITM L=NS1 WHILE L<=NS2 DO IF STACK$[L]="^" THEN
IF L>=NS2 THEN GOTO 99 END IF
N1#=VAL(STACK$[L-1]) N2#=VAL(STACK$[L+1]) NOP=NOP-1
IF STACK$[L]="^" THEN RI#=N1#^N2# END IF STACK$[L-1]=STR$(RI#) N=L WHILE N<=NS2-2 DO STACK$[N]=STACK$[N+2] N=N+1 END WHILE NS2=NS2-2 L=NS1-1 END IF L=L+1 END WHILE L=NS1 WHILE L<=NS2 DO IF STACK$[L]="*" OR STACK$[L]="/" THEN IF L>=NS2 THEN GOTO 99 END IF N1#=VAL(STACK$[L-1]) N2#=VAL(STACK$[L+1]) NOP=NOP-1 IF STACK$[L]="*" THEN
RI#=N1#*N2#
ELSE
IF N2#<>0 THEN RI#=N1#/N2# ELSE NERR=6 RI#=0 END IF
END IF
STACK$[L-1]=STR$(RI#)
N=L
WHILE N<=NS2-2 DO
STACK$[N]=STACK$[N+2]
N=N+1
END WHILE
NS2=NS2-2
L=NS1-1
END IF
L=L+1
END WHILE

L=NS1
WHILE L<=NS2 DO
IF STACK$[L]="+" OR STACK$[L]="-" THEN
EXIT IF L>=NS2
N1#=VAL(STACK$[L-1]) N2#=VAL(STACK$[L+1])  NOP=NOP-1
IF STACK$[L]="+" THEN RI#=N1#+N2# ELSE RI#=N1#-N2# END IF STACK$[L-1]=STR$(RI#) N=L WHILE N<=NS2-2 DO STACK$[N]=STACK$[N+2] N=N+1 END WHILE NS2=NS2-2 L=NS1-1 END IF L=L+1 END WHILE 99: IF NOP<2 THEN ! precedenza tra gli operatori DB#=VAL(STACK$[NS1])
ELSE
IF NOP<3 THEN
DB#=VAL(STACK$[NS1+2]) ELSE DB#=VAL(STACK$[NS1+4])
END IF
END IF
END PROCEDURE

PROCEDURE SVOLGI_PAR
NPA=NPA-1
FOR J=NS TO 1 STEP -1 DO
EXIT IF STACK$[J]="(" END FOR IF J=0 THEN NS1=1 NS2=NS CALC_ARITM NERR=7 ELSE FOR R=J TO NS-1 DO STACK$[R]=STACK$[R+1] END FOR NS1=J NS2=NS-1 CALC_ARITM IF NS1=2 THEN NS1=1 STACK$[1]=STACK$[2] END IF NS=NS1 COMPATTA_STACK END IF END PROCEDURE PROCEDURE MYEVAL(EXPRESSION$,DB#,NERR->DB#,NERR)

NOP=0 NPA=0 NS=1 K$="" NERR=0 STACK$[1]="@"          ! init stack

FOR W=1 TO LEN(EXPRESSION$) DO LOOP CODE=ASC(MID$(EXPRESSION$,W,1)) IF (CODE>=48 AND CODE<=57) OR CODE=46 THEN K$=K$+CHR$(CODE)
W=W+1 IF W>LEN(EXPRESSION$) THEN GOTO 98 END IF ELSE EXIT IF K$=""
IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF IF FLAG=0 THEN STACK$[NS]=K$ELSE STACK$[NS]=STR$(VAL(K$)*FLAG)
END IF
K$="" FLAG=0 EXIT END IF END LOOP IF CODE=43 THEN K$="+" END IF
IF CODE=45 THEN K$="-" END IF IF CODE=42 THEN K$="*" END IF
IF CODE=47 THEN K$="/" END IF IF CODE=94 THEN K$="^" END IF

CASE CODE OF
43,45,42,47,94->  ! +-*/^
IF MID$(EXPRESSION$,W+1,1)="-" THEN FLAG=-1  W=W+1 END IF
IF INSTR(ST_CONST$,STACK$[NS])<>0 THEN
NERR=5
ELSE
NS=NS+1 STACK$[NS]=K$ NOP=NOP+1
IF NOP>=2 THEN
FOR J=NS TO 1 STEP -1 DO
IF STACK$[J]<>"(" THEN GOTO 2540 END IF IF J<NS-2 THEN GOTO 2550 ELSE GOTO 2560 END IF 2540: END FOR 2550: NS1=J+1 NS2=NS CALC_ARITM NS=NS2 STACK$[NS]=K$REGISTRO_X#=VAL(STACK$[NS-1])
END IF
END IF
2560:     END ->

40->  ! (
IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF STACK$[NS]="(" NPA=NPA+1
IF MID$(EXPRESSION$,W+1,1)="-" THEN FLAG=-1 W=W+1 END IF
END ->

41-> ! )
SVOLGI_PAR
IF NERR=7 THEN
NERR=0 NOP=0 NPA=0 NS=1
ELSE
IF NERR=0 OR NERR=1 THEN
DB#=VAL(STACK$[NS]) REGISTRO_X#=DB# ELSE NOP=0 NPA=0 NS=1 END IF END IF END -> OTHERWISE NERR=8 END CASE K$=""
END FOR
98:
IF K$<>"" THEN IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF
IF FLAG=0 THEN STACK$[NS]=K$ ELSE STACK$[NS]=STR$(VAL(K$)*FLAG) END IF END IF IF INSTR(ST_CONST$,STACK$[NS])<>0 THEN NERR=6 ELSE WHILE NPA<>0 DO SVOLGI_PAR END WHILE IF NERR<>7 THEN NS1=1 NS2=NS CALCARITM END IF END IF NS=1 NOP=0 NPA=0 END PROCEDURE BEGIN PRINT(CHR$(12);) ! CLS

! possible brackets
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 DO
READ(BRAKETS$[I]) END FOR INPUT("ENTER 4 DIGITS: ",A$)
ND=0
FOR I=1 TO LEN(A$) DO C$=MID$(A$,I,1)
IF INSTR("123456789",C$)>0 THEN ND=ND+1 D[ND]=VAL(C$)
END IF
END FOR
! precompute permutations. dumb way.
NPERM=1*2*3*4
N=0
FOR I=1 TO 4 DO
FOR J=1 TO 4 DO
FOR K=1 TO 4 DO
FOR L=1 TO 4 DO
! 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
! 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
END FOR
END FOR
END FOR
END FOR

! operations: full search
COUNT=0
OPS$="+-*/" FOR OP1=1 TO 4 DO OP$[1]=MID$(OPS$,OP1,1)
FOR OP2=1 TO 4 DO
OP$[2]=MID$(OPS$,OP2,1) FOR OP3=1 TO 4 DO OP$[3]=MID$(OPS$,OP3,1)
! substitute all brackets
FOR T=1 TO NBRACKETS DO
TMPL$=BRAKETS$[T]
! now,substitute all digits: permutations.
FOR P=1 TO NPERM DO
RES$="" NOP=0 ND=0 FOR I=1 TO LEN(TMPL$) DO
C$=MID$(TMPL$,I,1) CASE C$ OF
"#"->                ! operations
NOP=NOP+1
RES$=RES$+OP$[NOP] END -> "4"-> ! digits ND=NOP+1 RES$=RES$+MID$(STR$(PERM[P,ND]),2) END -> OTHERWISE ! brackets goes here RES$=RES$+C$
END CASE
END FOR
! eval here
MY_EVAL(RES$,DB#,NERR->DB#,NERR) IF DB#=24 AND NERR=0 THEN PRINT("24=";RES$)
COUNT=COUNT+1
END IF
END FOR
END FOR
END FOR
END FOR
END FOR

IF COUNT=0 THEN
PRINT("If you see this, probably task cannot be solved with these digits")
ELSE
PRINT("Total=";COUNT)
END IF

END PROGRAM
Output:
ENTER 4 DIGITS: ? 6759
24=6+(7-5)*9
24=6+((7-5)*9)
24=6+9*(7-5)
24=6+(9*(7-5))
24=6-(5-7)*9
24=6-((5-7)*9)
24=(7-5)*9+6
24=((7-5)*9)+6
24=6-9*(5-7)
24=6-(9*(5-7))
24=9*(7-5)+6
24=(9*(7-5))+6
Total= 12


## Euler Math Toolbox

Via brute force.

>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 >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 ## 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. 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  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) ## Factor Factor is well-suited for this task due to its homoiconicity and because it is a reverse-Polish notation evaluator. All we're doing is grouping each permutation of digits with three selections of the possible operators into quotations (blocks of code that can be stored like sequences). Then we call each quotation and print out the ones that equal 24. The recover word is an exception handler that is used to intercept divide-by-zero errors and continue gracefully by removing those quotations from consideration. USING: continuations grouping io kernel math math.combinatorics prettyprint quotations random sequences sequences.deep ; IN: rosetta-code.24-game : 4digits ( -- seq ) 4 9 random-integers [ 1 + ] map ; : expressions ( digits -- exprs ) all-permutations [ [ + - * / ] 3 selections [ append ] with map ] map flatten 7 group ; : 24= ( exprs -- ) >quotation dup call( -- x ) 24 = [ . ] [ drop ] if ; : 24-game ( -- ) 4digits dup "The numbers: " write . "The solutions: " print expressions [ [ 24= ] [ 2drop ] recover ] each ; 24-game  Output: The numbers: { 4 9 3 1 } The solutions: [ 4 9 3 1 * - * ] [ 4 9 3 1 / - * ] [ 4 9 1 3 * - * ] [ 4 1 9 3 - * * ] [ 4 1 9 3 - / / ] [ 9 3 4 1 + * + ] [ 9 3 1 4 + * + ] [ 1 4 9 3 - * * ] [ 1 4 9 3 * - - ] [ 1 4 3 9 * - - ] The numbers: { 1 7 4 9 } The solutions: The numbers: { 1 5 6 8 } The solutions: [ 6 1 5 8 - - * ] [ 6 1 8 5 - + * ] [ 6 8 1 5 - + * ] [ 6 8 5 1 - - * ]  ## 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  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  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  ## FutureBasic This programme gives just the first-found (simplest) solution. To see the exhaustive list, we would remove the if k > 0 then exit fn statements. begin globals Short k end globals void local fn eval( t as CFStringRef ) CFMutableStringRef s = fn MutableStringNew ExpressionRef x = fn ExpressionWithFormat( t ) CFRange r = fn CFRangeMake(0, fn StringLength( t ) ) CFNumberRef n = fn ExpressionValueWithObject( x, Null, Null ) Float f = dblval( n ) if f = 24 // found, so clean up MutableStringSetString( s, t ) // duplicate string and pretend it was integers all along MutableStringReplaceOccurrencesOfString( s, @".000000", @"", Null, r ) print s; @" = 24" : k ++ end if end fn clear local fn work( t as CFStringRef ) Short a, b, c, d, e, f, g CGFloat n(3) CFStringRef s, os = @"*/+-", o(3) print t, : k = 0 // Put digits (as floats) and operators (as strings) in arrays for a = 0 to 3 : s = mid( t, a, 1 ) : n(a) = fn StringFloatValue( s ) : o(a) = mid( os, a, 1 ) : next // Permutions for the digits ... for d = 0 to 3 : for e = 0 to 3 : for f = 0 to 3 : for g = 0 to 3 if d != e and d != f and d != g and e != f and e != g and f != g // ... without duplications // Combinations for the operators (3 from 4, with replacement) for a = 0 to 3 : for b = 0 to 3 : for c = 0 to 3 fn eval( fn StringWithFormat( @"%f %@ %f %@ %f %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn fn eval( fn StringWithFormat( @"%f %@ ( %f %@ %f ) %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn fn eval( fn StringWithFormat( @"%f %@ %f %@ ( %f %@ %f )", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn fn eval( fn StringWithFormat( @"%f %@ ( %f %@ %f %@ %f )", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn fn eval( fn StringWithFormat( @"( %f %@ %f ) %@ %f %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn fn eval( fn StringWithFormat( @"( %f %@ %f %@ %f ) %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn fn eval( fn StringWithFormat( @"%f %@ ( %f %@ ( %f %@ %f ) )", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn fn eval( fn StringWithFormat( @"( %f %@ %f ) %@ ( %f %@ %f )", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn fn eval( fn StringWithFormat( @"( %f %@ ( %f %@ %f )) %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn fn eval( fn StringWithFormat( @"( ( %f %@ %f ) %@ %f ) %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn fn eval( fn StringWithFormat( @"%f %@ ( ( %f %@ %f ) %@ %f )", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn next : next : next end if next : next : next : next end fn window 1, @"24 Game", ( 0, 0, 250, 250 ) fn work(@"3388") fn work(@"1346") fn work(@"8752") handleevents Output: ## 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/-/"  ## 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") } } }  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 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
}
}
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!" ) }  ## Haskell import Data.List import Data.Ratio import Control.Monad import System.Environment (getArgs) data Expr = Constant Rational | Expr :+ Expr | Expr :- Expr | Expr :* Expr | Expr :/ Expr deriving (Eq) ops = [(:+), (:-), (:*), (:/)] instance Show Expr where show (Constant x) = show$ numerator x
-- In this program, we need only print integers.
show (a :+ b)     = strexp "+" a b
show (a :- b)     = strexp "-" a b
show (a :* b)     = strexp "*" a b
show (a :/ b)     = strexp "/" a b

strexp :: String -> Expr -> Expr -> String
strexp op a b = "(" ++ show a ++ " " ++ op ++ " " ++ show b ++ ")"

templates :: [[Expr] -> Expr]
templates = do
op1 <- ops
op2 <- ops
op3 <- ops
[\[a, b, c, d] -> op1 a $op2 b$ op3 c d,
\[a, b, c, d] -> op1 (op2 a b) $op3 c d, \[a, b, c, d] -> op1 a$ op2 (op3 b c) d,
\[a, b, c, d] -> op1 (op2 a $op3 b c) d, \[a, b, c, d] -> op1 (op2 (op3 a b) c) d] eval :: Expr -> Maybe Rational eval (Constant c) = Just c eval (a :+ b) = liftM2 (+) (eval a) (eval b) eval (a :- b) = liftM2 (-) (eval a) (eval b) eval (a :* b) = liftM2 (*) (eval a) (eval b) eval (a :/ b) = do denom <- eval b guard$ denom /= 0
liftM (/ denom) $eval a solve :: Rational -> [Rational] -> [Expr] solve target r4 = filter (maybe False (== target) . eval)$
liftM2 ($) templates$
nub $permutations$ map Constant r4

main = getArgs >>= mapM_ print . solve 24 . map (toEnum . read)


Example use:

$runghc 24Player.hs 2 3 8 9 (8 * (9 - (3 * 2))) (8 * (9 - (2 * 3))) ((9 - (2 * 3)) * 8) ((9 - (3 * 2)) * 8) ((9 - 3) * (8 / 2)) ((8 / 2) * (9 - 3)) (8 * ((9 - 3) / 2)) (((9 - 3) / 2) * 8) ((9 - 3) / (2 / 8)) ((8 * (9 - 3)) / 2) (((9 - 3) * 8) / 2) (8 / (2 / (9 - 3))) ### Alternative version 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]

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.

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 ?  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


## J

perm=: (A.&i.~ !) 4
ops=: ' ',.'+-*%' {~ >,{i.each 4 4 4
cmask=: 1 + 0j1 * i.@{:@$@[ e. ] left=: [ #!.'('~"1 cmask right=: [ #!.')'~"1 cmask paren=: 2 :'[: left&m right&n' parens=: ], 0 paren 3, 0 paren 5, 2 paren 5, [: 0 paren 7 (0 paren 3) all=: [: parens [:,/ ops ,@,."1/ perm { [:;":each answer=: ({.@#~ 24 = ".)@all  This implementation tests all 7680 candidate sentences. Example use:  answer 2 3 5 7 2+7+3*5 answer 8 4 7 1 8*7-4*1 answer 1 1 2 7 (1+2)*1+7  The answer will be either a suitable J sentence or blank if none can be found. "J sentence" means that, for example, the sentence 8*7-4*1 is equivalent to the sentence 8*(7-(4*1)). [Many infix languages use operator precedence to make polynomials easier to express without parenthesis, but J has other mechanisms for expressing polynomials and minimal operator precedence makes the language more regular.] Here is an alternative version that supports multi-digit numbers. It prefers expressions without parens, but searches for ones with if needed. ops=: > , { 3#<'+-*%' perms=: [: ":"0 [: ~. i.@!@# A. ] build=: 1 : '(#~ 24 = ".) @: u' combp=: dyad define 'a b c d'=. y['f g h'=. x ('(',a,f,b,g,c,')',h,d),('(',a,f,b,')',g,c,h,d),(a,f,'(',b,g,c,')',h,d),:('((',a,f,b,')',g,c,')',h,d) ) math24=: monad define assert. 4 = # y NB. prefer expressions without parens & fallback if needed es=. ([: ,/ ops ([: , (' ',[) ,. ])"1 2/ perms) build y if. 0 = #es do. es =. ([: ,/ [: ,/ ops combp"1 2/ perms) build y end. es -."1 ' ' )  Output:  math24 2 3 5 12 12%3-5%2 math24 2 3 8 9 8*9-2*3 8*9-3*2 8%2%9-3 math24 3 6 6 11 (6+6*11)%3 (6+11*6)%3 ((6*11)+6)%3 ((11*6)+6)%3  ## Java Works with: Java version 7 Playable version, will print solution on request. Note that this version does not extend to different digit ranges. 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)); } }  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. 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+"<br>")} 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");  Examples: (((3*1)*4)*2) ((6*8)/((9-7))) (((1+7))*(2+1)) ## jq Works with: jq version 1.4 The following solution is generic: the objective (e.g. 24) is specified as the argument to solve/1, and the user may specify any number of numbers. Infrastructure: # Generate a stream of the permutations of the input array. def permutations: if length == 0 then [] else range(0;length) as$i
| [.[$i]] + (del(.[$i])|permutations)
end ;

# Generate a stream of arrays of length n,
# with members drawn from the input array.
def take(n):
length as $l | if n == 1 then range(0;$l) as $i | [ .[$i] ]
else take(n-1) + take(1)
end;

# Emit an array with elements that alternate between those in the input array and those in short,
# starting with the former, and using nothing if "short" is too too short.
def intersperse(short):
. as $in | reduce range(0;length) as$i
([]; . + [ $in[$i], (short[$i] // empty) ]); # Emit a stream of all the nested triplet groupings of the input array elements, # e.g. [1,2,3,4,5] => # [1,2,[3,4,5]] # [[1,2,3],4,5] # def triples: . as$in
| if   length == 3 then .
elif length == 1 then $in[0] elif length < 3 then empty else (range(0; (length-1) / 2) * 2 + 1) as$i
| ($in[0:$i] | triples)  as $head | ($in[$i+1:] | triples) as$tail
| [$head,$in[$i],$tail]
end;

Evaluation and pretty-printing of allowed expressions

# Evaluate the input, which must be a number or a triple: [x, op, y]
def eval:
if type == "array" then
.[1] as $op | if .[0] == null or .[2] == null then null else (.[0] | eval) as$left | (.[2] | eval) as $right | if$left == null or $right == null then null elif$op == "+" then $left +$right
elif  $op == "-" then$left - $right elif$op == "*" then $left *$right
elif  $op == "/" then if$right == 0 then null
else $left /$right
end
else "invalid arithmetic operator: \($op)" | error end end else . end; def pp: "\(.)" | explode | map([.] | implode | if . == "," then " " elif . == "\"" then "" else . end) | join(""); 24 Game: def OPERATORS: ["+", "-", "*", "/"]; # Input: an array of 4 digits # o: an array of 3 operators # Output: a stream def EXPRESSIONS(o): intersperse( o ) | triples; def solve(objective): length as$length
| [ (OPERATORS | take($length-1)) as$poperators
| permutations | EXPRESSIONS($poperators) | select( eval == objective) ] as$answers
| if $answers|length > 3 then "That was too easy. I found \($answers|length) answers, e.g. \($answers[0] | pp)" elif$answers|length > 1 then $answers[] | pp else "You lose! There are no solutions." end ; solve(24), "Please try again." Output: $ jq -r -f Solve.jq
[1,2,3,4]
That was too easy. I found 242 answers, e.g. [4 * [1 + [2 + 3]]]
[1,2,3,40,1]
That was too easy. I found 636 answers, e.g. [[[1 / 2] * 40] + [3 + 1]]
[3,8,9]
That was too easy. I found 8 answers, e.g. [[8 / 3] * 9]
[4,5,6]
You lose! There are no solutions.
[1,2,3,4,5,6]
That was too easy. I found 197926 answers, e.g. [[2 * [1 + 4]] + [3 + [5 + 6]]]


## Julia

For julia version 0.5 and higher, the Combinatorics package must be installed and imported (using Combinatorics). Combinatorial functions like nthperm have been moved from Base to that package and are not available by default anymore.

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

Output:
julia> for i in 1:10
nums = rand(1:9, 4)
println("solve24($nums) ->$(solve24(nums))")
end
solve24([9,4,4,5]) -> 0
solve24([1,7,2,7]) -> ((7*7)-1)/2
solve24([5,7,5,4]) -> 4*(7-(5/5))
solve24([1,4,6,6]) -> 6+(6*(4-1))
solve24([2,3,7,3]) -> ((2+7)*3)-3
solve24([8,7,9,7]) -> 0
solve24([1,6,2,6]) -> 6+(6*(1+2))
solve24([7,9,4,1]) -> (7-4)*(9-1)
solve24([6,4,2,2]) -> (2-2)+(6*4)
solve24([5,7,9,7]) -> (5+7)*(9-7)

## Kotlin

Translation of: C
// version 1.1.3

import java.util.Random

const val N_CARDS = 4
const val SOLVE_GOAL = 24
const val MAX_DIGIT = 9

class Frac(val num: Int, val den: Int)

enum class OpType { NUM, ADD, SUB, MUL, DIV }

class Expr(
var op:    OpType = OpType.NUM,
var left:  Expr?  = null,
var right: Expr?  = null,
var value: Int    = 0
)

fun showExpr(e: Expr?, prec: OpType, isRight: Boolean) {
if (e == null) return
val op = when (e.op) {
OpType.NUM -> { print(e.value); return }
OpType.SUB -> " - "
OpType.MUL -> " x "
OpType.DIV -> " / "
}

if ((e.op == prec && isRight) || e.op < prec) print("(")
showExpr(e.left, e.op, false)
print(op)
showExpr(e.right, e.op, true)
if ((e.op == prec && isRight) || e.op < prec) print(")")
}

fun evalExpr(e: Expr?): Frac {
if (e == null) return Frac(0, 1)
if (e.op == OpType.NUM) return Frac(e.value, 1)
val l = evalExpr(e.left)
val r = evalExpr(e.right)
return when (e.op) {
OpType.ADD -> Frac(l.num * r.den + l.den * r.num, l.den * r.den)
OpType.SUB -> Frac(l.num * r.den - l.den * r.num, l.den * r.den)
OpType.MUL -> Frac(l.num * r.num, l.den * r.den)
OpType.DIV -> Frac(l.num * r.den, l.den * r.num)
else       -> throw IllegalArgumentException("Unknown op: ${e.op}") } } fun solve(ea: Array<Expr?>, len: Int): Boolean { if (len == 1) { val final = evalExpr(ea[0]) if (final.num == final.den * SOLVE_GOAL && final.den != 0) { showExpr(ea[0], OpType.NUM, false) return true } } val ex = arrayOfNulls<Expr>(N_CARDS) for (i in 0 until len - 1) { for (j in i + 1 until len) ex[j - 1] = ea[j] val node = Expr() ex[i] = node for (j in i + 1 until len) { node.left = ea[i] node.right = ea[j] for (k in OpType.values().drop(1)) { node.op = k if (solve(ex, len - 1)) return true } node.left = ea[j] node.right = ea[i] node.op = OpType.SUB if (solve(ex, len - 1)) return true node.op = OpType.DIV if (solve(ex, len - 1)) return true ex[j] = ea[j] } ex[i] = ea[i] } return false } fun solve24(n: IntArray) = solve (Array(N_CARDS) { Expr(value = n[it]) }, N_CARDS) fun main(args: Array<String>) { val r = Random() val n = IntArray(N_CARDS) for (j in 0..9) { for (i in 0 until N_CARDS) { n[i] = 1 + r.nextInt(MAX_DIGIT) print("${n[i]}")
}
print(":  ")
println(if (solve24(n)) "" else "No solution")
}
}


Sample output:

 8 4 1 7:  (8 - 4) x (7 - 1)
6 1 4 1:  ((6 + 1) - 1) x 4
8 8 5 4:  (8 / 8 + 5) x 4
9 6 9 8:  8 / ((9 - 6) / 9)
6 6 9 6:  (6 x 6) / 9 x 6
9 9 7 7:  No solution
1 1 2 5:  No solution
6 9 4 1:  6 x (9 - 4 - 1)
7 7 6 4:  7 + 7 + 6 + 4
4 8 8 4:  4 + 8 + 8 + 4


## Liberty BASIC

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

## Lua

Generic solver: pass card of any size with 1st argument and target number with second.

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)
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)

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 / Wolfram Language The code: treeR[n_] := Table[o[trees[a], trees[n - a]], {a, 1, n - 1}] treeR[1] := n tree[n_] := Flatten[treeR[n] //. {o[a_List, b_] :> (o[#, b] & /@ a), o[a_, b_List] :> (o[a, #] & /@ b)}] game24play[val_List] := Union[StringReplace[StringTake[ToString[#, InputForm], {10, -2}], "-1*" ~~ n_ :> "-" <> n] & /@ (HoldForm /@ Select[Union@ Flatten[Outer[# /. {o[q_Integer] :> #2[[q]], n[q_] :> #3[[q]]} &, Block[{O = 1, N = 1}, # /. {o :> o[O++], n :> n[N++]}] & /@ tree[4], Tuples[{Plus, Subtract, Times, Divide}, 3], Permutations[Array[v, 4]], 1]], Quiet[(# /. v[q_] :> val[[q]]) == 24] &] /. Table[v[q] -> val[[q]], {q, 4}])]  The treeR method recursively computes all possible operator trees for a certain number of inputs. It does this by tabling all combinations of distributions of inputs across the possible values. (For example, treeR[4] is allotted 4 inputs, so it returns {o[treeR[3],treeR[1]],o[treeR[2],treeR[2]],o[treeR[1],treeR[3]]}, where o is the operator (generic at this point). The base case treeR[1] returns n (the input). The final output of tree[4] (the 24 game has 4 random inputs) (tree cleans up the output of treeR) is: {o[n, o[n, o[n, n]]], o[n, o[o[n, n], n]], o[o[n, n], o[n, n]], o[o[n, o[n, n]], n], o[o[o[n, n], n], n]} game24play takes the four random numbers as input and does the following (the % refers to code output from previous bullets): • Block[{O = 1, N = 1}, # /. {o :> o[O++], n :> n[N++]}] & /@ tree[4] • Assign ascending numbers to the input and operator placeholders. • Ex: o[1][o[2][n[1], n[2]], o[3][n[3], n[4]]] • Tuples[{Plus, Subtract, Times, Divide}, 3] • Find all combinations (Tuples allows repeats) of the four allowed operations. • Ex: {{Plus, Plus, Plus}, {Plus, Plus, Subtract}, <<60>>, {Divide, Divide, Times}, {Divide, Divide, Divide}} • 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]}} • 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). • Select[%, Quiet[(# /. v[q_] :> val[[q]]) == 24] &] • Select the elements of the above list where substituting the real values returns 24 (and do it Quietly because of div-0 concerns). • 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. • 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: game24play[RandomInteger[{1, 9}, 4]]  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 ${\displaystyle n!}$ permutations. Therefore, the size of the working set is ${\displaystyle 64\cdot n!\,C_{n-1}=64\cdot (n-1)!!!!=64{\frac {(2n-2)!}{(n-1)!}}}$, where ${\displaystyle n!!!!}$ is the quadruple factorial. It goes without saying that this number increases very fast. For this game, the total is 7680 elements. For higher numbers of inputs, it is {7 680, 107 520, 1 935 360, 42 577 920, 1 107 025 920, ...}. An alternative solution operates on Mathematica expressions directly without using any inert intermediate form for the expression tree, but by using Hold to prevent Mathematica from evaluating the expression tree. evaluate[HoldForm[op_[l_, r_]]] := op[evaluate[l], evaluate[r]]; evaluate[x_] := x; combine[l_, r_ /; evaluate[r] != 0] := {HoldForm[Plus[l, r]], HoldForm[Subtract[l, r]], HoldForm[Times[l, r]], HoldForm[Divide[l, r]] }; combine[l_, r_] := {HoldForm[Plus[l, r]], HoldForm[Subtract[l, r]], HoldForm[Times[l, r]]}; split[items_] := Table[{items[[1 ;; i]], items[[i + 1 ;; Length[items]]]}, {i, 1, Length[items] - 1}]; expressions[{x_}] := {x}; expressions[items_] := Flatten[Table[ Flatten[Table[ combine[l, r], {l, expressions[sp[[1]]]}, {r, expressions[sp[[2]]]}], 2], {sp, split[items]}]]; (* Must use all atoms in given order. *) solveMaintainOrder[goal_, items_] := Select[expressions[items], (evaluate[#] == goal) &]; (* Must use all atoms, but can permute them. *) solveCanPermute[goal_, items_] := Flatten[Table[ solveMaintainOrder[goal, pitems], {pitems, Permutations[items]}]]; (* Can use any subset of atoms. *) solveSubsets[goal_, items_] := Flatten[Table[ solveCanPermute[goal, is], {is, Subsets[items, {1, Length[items]}]}], 2]; (* Demonstration to find all the ways to create 1/5 from {2, 3, 4, 5}. *) solveMaintainOrder[1/5, Range[2, 5]] solveCanPermute[1/5, Range[2, 5]] solveSubsets[1/5, Range[2, 5]]  ## Nim Translation of: Python Succinct Works with: Nim Compiler version 0.19.4 import algorithm, sequtils, strformat type Operation = enum opAdd = "+" opSub = "-" opMul = "*" opDiv = "/" const Ops = @[opAdd, opSub, opMul, opDiv] func opr(o: Operation, a, b: float): float = case o of opAdd: a + b of opSub: a - b of opMul: a * b of opDiv: a / b func solve(nums: array[4, int]): string = func ~=(a, b: float): bool = abs(a - b) <= 1e-5 result = "not found" let sortedNums = nums.sorted.mapIt float it for i in product Ops.repeat 3: let (x, y, z) = (i[0], i[1], i[2]) var nums = sortedNums while true: let (a, b, c, d) = (nums[0], nums[1], nums[2], nums[3]) if x.opr(y.opr(a, b), z.opr(c, d)) ~= 24.0: return fmt"({a:0} {y} {b:0}) {x} ({c:0} {z} {d:0})" if x.opr(a, y.opr(b, z.opr(c, d))) ~= 24.0: return fmt"{a:0} {x} ({b:0} {y} ({c:0} {z} {d:0}))" if x.opr(y.opr(z.opr(c, d), b), a) ~= 24.0: return fmt"(({c:0} {z} {d:0}) {y} {b:0}) {x} {a:0}" if x.opr(y.opr(b, z.opr(c, d)), a) ~= 24.0: return fmt"({b:0} {y} ({c:0} {z} {d:0})) {x} {a:0}" if not nextPermutation(nums): break proc main() = for nums in [ [9, 4, 4, 5], [1, 7, 2, 7], [5, 7, 5, 4], [1, 4, 6, 6], [2, 3, 7, 3], [8, 7, 9, 7], [1, 6, 2, 6], [7, 9, 4, 1], [6, 4, 2, 2], [5, 7, 9, 7], [3, 3, 8, 8], # Difficult case requiring precise division ]: echo fmt"solve({nums}) -> {solve(nums)}" when isMainModule: main()  Output: solve([9, 4, 4, 5]) -> not found solve([1, 7, 2, 7]) -> ((7 * 7) - 1) / 2 solve([5, 7, 5, 4]) -> 4 * (7 - (5 / 5)) solve([1, 4, 6, 6]) -> 6 - (6 * (1 - 4)) solve([2, 3, 7, 3]) -> (7 - 3) * (2 * 3) solve([8, 7, 9, 7]) -> not found solve([1, 6, 2, 6]) -> (6 - 2) / (1 / 6) solve([7, 9, 4, 1]) -> (1 - 9) * (4 - 7) solve([6, 4, 2, 2]) -> 2 * (4 / (2 / 6)) solve([5, 7, 9, 7]) -> (5 + 7) * (9 - 7) solve([3, 3, 8, 8]) -> 8 / (3 - (8 / 3))  ## 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  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 # Fischer-Krause ordered permutation generator # http://faq.perl.org/perlfaq4.html#How_do_I_permute_N_e sub permute :prototype(&@) { 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;
}
}
}
}

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>

## Phix

-- demo\rosetta\24_game_solve.exw
with javascript_semantics
-- The following 5 parse expressions are possible.
-- Obviously numbers 1234 represent 24 permutations from
--  {1,2,3,4} to {4,3,2,1} of indexes to the real numbers.
-- Likewise "+-*" is like "123" representing 64 combinations
--  from {1,1,1} to {4,4,4} of indexes to "+-*/".
-- Both will be replaced if/when the strings get printed.
-- Last hint is because of no precedence, just parenthesis.
--
constant OPS = "+-*/"
constant expressions = {"1+(2-(3*4))",
"1+((2-3)*4)",
"(1+2)-(3*4)",
"(1+(2-3))*4",
"((1+2)-3)*4"}  -- (equivalent to "1+2-3*4")

-- The above represented as three sequential operations (the result gets
--  left in <(map)1>, ie vars[perms[operations[i][3][1]]] aka vars[lhs]):
constant operations = {{{3,'*',4},{2,'-',3},{1,'+',2}}, --3*=4; 2-=3; 1+=2
{{2,'-',3},{2,'*',4},{1,'+',2}}, --2-=3; 2*=4; 1+=2
{{1,'+',2},{3,'*',4},{1,'-',3}}, --1+=2; 3*=4; 1-=3
{{2,'-',3},{1,'+',2},{1,'*',4}}, --2-=3; 1+=2; 1*=4
{{1,'+',2},{1,'-',3},{1,'*',4}}} --1+=2; 1-=3; 1*=4

function evalopset(sequence opset, perms, ops, vars)
-- invoked 5*24*64 = 7680 times, to try all possible expressions/vars/operators
-- (btw, vars is copy-on-write, like all parameters not explicitly returned, so
--       we can safely re-use it without clobbering the callee version.)
-- (update: with js made that illegal and reported it correctly and forced the
--          addition of the deep_copy(), all exactly the way it should.)
integer lhs,op,rhs
vars = deep_copy(vars)
for i=1 to length(opset) do
{lhs,op,rhs} = opset[i]
lhs = perms[lhs]
op = ops[find(op,OPS)]
rhs = perms[rhs]
if op='+' then
vars[lhs] += vars[rhs]
elsif op='-' then
vars[lhs] -= vars[rhs]
elsif op='*' then
vars[lhs] *= vars[rhs]
elsif op='/' then
if vars[rhs]=0 then return 1e300*1e300 end if
vars[lhs] /= vars[rhs]
end if
end for
return vars[lhs]
end function

integer nSolutions
sequence xSolutions

procedure success(string expr, sequence perms, ops, vars, atom r)
for i=1 to length(expr) do
integer ch = expr[i]
if ch>='1' and ch<='9' then
expr[i] = vars[perms[ch-'0']]+'0'
else
ch = find(ch,OPS)
if ch then
expr[i] = ops[ch]
end if
end if
end for
if not find(expr,xSolutions) then
-- avoid duplicates for eg {1,1,2,7} because this has found
-- the "same" solution but with the 1st and 2nd 1s swapped,
-- and likewise whenever an operator is used more than once.
printf(1,"success: %s = %s\n",{expr,sprint(r)})
nSolutions += 1
xSolutions = append(xSolutions,expr)
end if
end procedure

procedure tryperms(sequence perms, ops, vars)
for i=1 to length(operations) do
-- 5 parse expressions
atom r = evalopset(operations[i], perms, ops, vars)
r = round(r,1e9) -- fudge tricky 8/(3-(8/3)) case
if r=24 then
success(expressions[i], perms, ops, vars, r)
end if
end for
end procedure

procedure tryops(sequence ops, vars)
for p=1 to factorial(4) do
-- 24 var permutations
tryperms(permute(p,{1,2,3,4}),ops, vars)
end for
end procedure

global procedure solve24(sequence vars)
nSolutions = 0
xSolutions = {}
for op1=1 to 4 do
for op2=1 to 4 do
for op3=1 to 4 do
-- 64 operator combinations
tryops({OPS[op1],OPS[op2],OPS[op3]},vars)
end for
end for
end for

printf(1,"\n%d solutions\n",{nSolutions})
end procedure

solve24({1,1,2,<`