Jump to content

24 game/Solve

From Rosetta Code
(Redirected from 24 game Player)
Task
24 game/Solve
You are encouraged to solve this task according to the task description, using any language you may know.
task

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.


Related task



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
   R ‘not found’

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([8, 7, 9, 7]) -> not found
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
qGraine:            .quad 123456
/*********************************/
/* 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 
    
    ldr x0,qAdrszMessRules            // display rules
    bl affichageMess
1:
    mov x3,#0
    ldr x12,qAdrqTabDigit
    ldr x5,qAdrszMessDigits
2:                                    // loop generate random digits 
    mov x0,#8
    bl genereraleas 
    add x0,x0,#1
    str x0,[x12,x3,lsl 3]             // store in table
    ldr x1,qAdrsZoneConv
    bl conversion10                   // call decimal conversion
    mov x0,x5
    ldr x1,qAdrsZoneConv              // insert conversion in message
    bl strInsertAtCharInc
    mov x5,x0
    add x3,x3,#1
    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 
    ldr x0,qAdrszMessOK
    bl affichageMess
    bl writeSoluce                    // yes -> write solution in buffer 
    ldr x0,qAdrsBuffer                // and display buffer
    bl affichageMess
    b 10f
3:                                    // display message no solution
    ldr x0,qAdrszMessNotOK
    bl affichageMess


10:                                   // display new game ?
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    ldr x0,qAdrszMessNewGame
    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
 
qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrszMessRules:          .quad szMessRules
qAdrszMessDigits:         .quad szMessDigits
qAdrszMessNotOK:          .quad szMessNotOK
qAdrszMessOK:             .quad szMessOK
qAdrszMessNewGame:        .quad szMessNewGame
qAdrsZoneConv:            .quad sZoneConv
qAdrqTabDigit:            .quad qTabDigit
/******************************************************************/
/*            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
    add x9,x0,#1                    // new  level
    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
    ldr x8,qAdrqTabOperand1
    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
    ldr x8,qAdrqTabOperand2
    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]
    add x8,x8,#1
4:
    add x7,x7,#1
    cmp x7,x3
    ble 3b

    add x7,x4,x12                   // addition test
    str x7,[fp,x8,lsl 3]            // store result of addition
    mov x7,#'+'
    ldr x0,qAdrqTabOperation
    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,#'-'
    ldr x0,qAdrqTabOperation
    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,#'*'
    ldr x0,qAdrqTabOperation
    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,#'/'
    ldr x0,qAdrqTabOperation
    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,#'/'
    ldr x0,qAdrqTabOperation
    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
qAdrqTabOperand1:         .quad qTabOperand1
qAdrqTabOperand2:         .quad qTabOperand2
qAdrqTabOperation:        .quad qTabOperation
/******************************************************************/
/*            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
    ldr x6,qAdrqTabOperand1
    ldr x7,qAdrqTabOperand2
    ldr x8,qAdrqTabOperation
    ldr x10,qAdrsBuffer
    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
    add x2,x2,#0x30
    strb w2,[x10,x4]
    add x4,x4,#1
31:
    add x3,x3,#0x30
    strb w3,[x10,x4]
    add x4,x4,#1
    ldr x2,[x7,x9,lsl 3]

    strb w12,[x10,x4]           // operator
    add x4,x4,#1
    
    mov x1,#10                  // conversion operand  2 = x11
    udiv x2,x11,x1
    msub x3,x2,x1,x11
    cmp x2,#0
    beq 32f
    add x2,x2,#0x30
    strb w2,[x10,x4]
    add x4,x4,#1
32:
    add x3,x3,#0x30
    strb w3,[x10,x4]
    add x4,x4,#1
    
    mov x0,#'='
    strb w0,[x10,x4]             // compute sous total
    add x4,x4,#1
    cmp x12,'+'                  // addition
    bne 33f
    add x0,x13,x11
    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
    ldr x0,qAdrszMessErrOper
    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
    add x2,x2,#0x30
    strb w2,[x10,x4]
    add x4,x4,#1
36:
    add x3,x3,#0x30
    strb w3,[x10,x4]
    add x4,x4,#1
    mov x0,#'\n'
    strb w0,[x10,x4]
    add x4,x4,#1
    
    add x9,x9,1
    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
qAdrsBuffer:         .quad sBuffer
qAdrszMessErrOper:   .quad szMessErrOper
/******************************************************************/
/*            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
    ldr x1,qAdrsBuffer     // buffer address 
    mov x2,#BUFFERSIZE     // buffer size 
    mov x8,#READ           // request to read datas
    svc 0                  // call system
    ldr x1,qAdrsBuffer     // buffer address 
    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 x4,qAdrqGraine
    ldr x2,[x4]
    ldr x3,qNbDep1
    mul x2,x3,x2
    ldr x3,qNbDep2
    add x2,x2,x3
    str x2,[x4]             // maj de la graine pour l appel suivant 
    cmp x0,#0
    beq 100f
    add x1,x0,#1            // divisor
    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
/*****************************************************/
qAdrqGraine: .quad qGraine
qNbDep1:     .quad 0x0019660d
qNbDep2:     .quad 0x3c6ef35f
/********************************************************/
/*        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 the elements.
    read table iv_set index lv_perm into lv_first.
    add 1 to lv_perm.
    read table iv_set index lv_perm into lv_second.
    subtract 1 from lv_perm.
    if lv_first < lv_second.
      lv_changed = 'X'.
      exit.
    endif.
    subtract 1 from lv_perm.
  enddo.

  " Last permutation.
  if lv_changed <> 'X'.
    ev_last = 'X'.
    exit.
  endif.

  " Swap tail decresing to get a tail increasing.
  lv_count = lv_perm + 1.
  do.
    lv_first = lv_len + lv_perm - lv_count + 1.
    if lv_count >= lv_first.
      exit.
    endif.

    read table iv_set index lv_count into lv_temp.
    read table iv_set index lv_first into lv_temp_2.
    modify iv_set index lv_count from lv_temp_2.
    modify iv_set index lv_first from lv_temp.
    add 1 to lv_count.
  enddo.

  lv_count = lv_len - 1.
  do.
    if lv_count <= lv_perm.
      exit.
    endif.

    read table iv_set index lv_count into lv_first.
    read table iv_set index lv_perm into lv_second.
    read table iv_set index lv_len into lv_third.
    if ( lv_first < lv_third ) and ( lv_first > lv_second ).
      lv_len = lv_count.
    endif.

    subtract 1 from lv_count.
  enddo.

  read table iv_set index lv_perm into lv_temp.
  read table iv_set index lv_len into lv_temp_2.
  modify iv_set index lv_perm from lv_temp_2.
  modify iv_set index lv_len from lv_temp.
endform.

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 
    
    ldr r0,iAdrszMessRules            @ display rules
    bl affichageMess
1:
    mov r3,#0
    ldr r12,iAdriTabDigit
    ldr r5,iAdrszMessDigits
2:                                    @ loop generate random digits 
    mov r0,#8
    bl genereraleas 
    add r0,r0,#1
    str r0,[r12,r3,lsl #2]            @ store in table
    ldr r1,iAdrsZoneConv
    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
    add r3,r3,#1
    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 
    ldr r0,iAdrszMessOK
    bl affichageMess
    bl writeSoluce                    @ yes -> write solution in buffer 
    ldr r0,iAdrsBuffer                @ and display buffer
    bl affichageMess
    b 10f
3:                                    @ display message no solution
    ldr r0,iAdrszMessNotOK
    bl affichageMess


10:                                   @ display new game ?
    ldr r0,iAdrszCarriageReturn
    bl affichageMess
    ldr r0,iAdrszMessNewGame
    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
 
iAdrszCarriageReturn:     .int szCarriageReturn
iAdrszMessRules:          .int szMessRules
iAdrszMessDigits:         .int szMessDigits
iAdrszMessNotOK:          .int szMessNotOK
iAdrszMessOK:             .int szMessOK
iAdrszMessNewGame:        .int szMessNewGame
iAdrsZoneConv:            .int sZoneConv
iAdriTabDigit:            .int iTabDigit
/******************************************************************/
/*            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
    add r9,r0,#1                    @ new  level
    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
    ldr r8,iAdriTabOperand1
    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
    ldr r8,iAdriTabOperand2
    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]
    add r8,r8,#1
4:
    add r7,r7,#1
    cmp r7,r3
    ble 3b

    add r7,r4,r12                   @ addition test
    str r7,[fp,r8,lsl #2]           @ store result of addition
    mov r7,#'+'
    ldr r0,iAdriTabOperation
    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,#'-'
    ldr r0,iAdriTabOperation
    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
    ldr r0,iAdriTabOperation
    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,#'/'
    ldr r0,iAdriTabOperation
    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,#'/'
    ldr r0,iAdriTabOperation
    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 
iAdriTabOperand1:         .int iTabOperand1
iAdriTabOperand2:         .int iTabOperand2
iAdriTabOperation:        .int iTabOperation
/******************************************************************/
/*            write solution                                      */ 
/******************************************************************/
writeSoluce:
    push {r1-r12,lr}            @ save registers
    ldr r6,iAdriTabOperand1
    ldr r7,iAdriTabOperand2
    ldr r8,iAdriTabOperation
    ldr r10,iAdrsBuffer
    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
    addne r2,r2,#0x30
    strneb r2,[r10,r4]
    addne r4,r4,#1
    add r3,r3,#0x30
    strb r3,[r10,r4]
    add r4,r4,#1
    ldr r2,[r7,r9,lsl #2]

    strb r12,[r10,r4]           @ operator
    add r4,r4,#1
    
    mov r0,r11                  @ conversion operand  2
    mov r1,#10
    bl division
    cmp r2,#0
    addne r2,r2,#0x30
    strneb r2,[r10,r4]
    addne r4,r4,#1
    add r3,r3,#0x30
    strb r3,[r10,r4]
    add r4,r4,#1
    
    mov r0,#'='
    str r0,[r10,r4]             @ conversion sous total
    add r4,r4,#1
    cmp r12,#'+'
    addeq r0,r5,r11
    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
    addne r2,r2,#0x30
    strneb r2,[r10,r4]
    addne r4,r4,#1
    add r3,r3,#0x30
    strb r3,[r10,r4]
    add r4,r4,#1
    mov r0,#'\n'
    str r0,[r10,r4]
    add r4,r4,#1
    
    add r9,#1
    cmp r9,#NBDIGITS
    blt 1b
    mov r1,#0
    strb r1,[r10,r4]            @ store 0 final
    
100:
    pop {r1-r12,lr}
    bx lr                       @ return 
iAdrsBuffer:         .int sBuffer

/******************************************************************/
/*            string entry                                       */ 
/******************************************************************/
/* r0 return the first character of human entry */
saisie:
    push {r1-r7,lr}        @ save registers
    mov r0,#STDIN          @ Linux input console
    ldr r1,iAdrsBuffer     @ buffer address 
    mov r2,#BUFFERSIZE     @ buffer size 
    mov r7,#READ           @ request to read datas
    svc 0                  @ call system
    ldr r1,iAdrsBuffer     @ buffer address 
    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 r4,iAdriGraine
    ldr r2,[r4]
    ldr r3,iNbDep1
    mul r2,r3,r2
    ldr r3,iNbDep2
    add r2,r2,r3
    str r2,[r4]             @ maj de la graine pour l appel suivant 
    cmp r0,#0
    beq 100f
    add r1,r0,#1            @ divisor
    mov r0,r2               @ dividende
    bl division
    mov r0,r3               @ résult = remainder
  
100:                        @ end function
    pop {r1-r4,lr}          @ restaur registers
    bx lr                   @ return
/*****************************************************/
iAdriGraine: .int iGraine
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
                perform load-solution-counts
            end-if
            perform list-counts
        when 'show'
            if ns-max = 0
                perform load-solution-counts
            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
    .
ask-for-more.
    display space
    move 0 to l1
    add 1 to l2
    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
            add 1 to l1
            if l1 = 8
                perform ask-for-more
            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
            add 1 to l1
            if l1 = 14
                perform ask-for-more
            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'
                add 1 to i-s
                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
        add 1 to l1
        if l1 = 3
            perform ask-for-more
        end-if
    end-perform
    if l1 > 0
        display space
    end-if
    .
load-solution-counts.
    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
    read count-file
    move 0 to record-counts
    move zeros to solution-counts
    perform until count-file-status <> '00'
        add 1 to record-counts
        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
        add 1 to solution-count(sc)
        read count-file
    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 s-max to total-solutions
                    add 1 to record-counts
                    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
                    add 1 to solution-count(sc)
                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
    add 1 to ns-max
    .
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'
                                add 1 to cpx
                                move current-permutation(cpx:1) to nd
                                move n(nd) to output-queue(oqx:1)
                            else
                                add 1 to cox
                                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
            add 1 to rsx
            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

Modern version using OpenMP

module game24_module
    use omp_lib
    use iso_fortran_env, only: int64
    implicit none
    ! Define constants
    integer, parameter :: max_limit = 8     ! Maximum allowed value for the number of inputs
    integer, parameter :: expr_len = 200   ! Maximum length for expressions

    ! Precomputed total calls for n=6,7,8
    integer(int64), parameter :: total_calls_n6 = 20000000_int64
    integer(int64), parameter :: total_calls_n7 = 2648275200_int64
    integer(int64), parameter :: total_calls_n8 = 444557593600_int64

    !----------------------- Progress Indicator Variables ---------------------
    integer(int64) :: total_calls = 0           ! Total number of recursive calls
    integer(int64) :: completed_calls = 0       ! Number of completed recursive calls
    integer :: last_percentage = -1              ! Last percentage reported
    integer, parameter :: progress_bar_width = 50  ! Width of the progress bar
    character(len=1) :: carriage_return = char(13) ! Carriage return character
    logical :: show_progress = .false.           ! Flag to show progress bar
    !--------------------------------------------------------------------------
contains

    !-----------------------------------------------------------------------
    ! ! Aborted function: calculate_total_calls
    ! ! Description:
    ! !   Estimates the total number of recursive calls for a given n,
    ! !   considering commutativity (addition and multiplication).
    ! ! Arguments:
    ! !   n: The number of input numbers.
    ! ! Returns:
    ! !   The estimated total number of recursive calls as an integer.
    ! !-----------------------------------------------------------------------
    ! integer function calculate_total_calls(n)
    !     implicit none
    !     integer, intent(in) :: n
    !     integer :: k
    !     calculate_total_calls = 1
    !     do k = 2, n
    !         ! For each pair, there are 6 possible operations:
    !         ! 1 addition, 1 multiplication (commutative)
    !         ! 2 subtraction, 2 division (non-commutative)
    !         calculate_total_calls = calculate_total_calls * ((k * (k - 1)) / 2) * 6
    !     end do
    ! end function calculate_total_calls

    !-----------------------------------------------------------------------
    ! Subroutine: convert_to_number
    ! Description:
    !   Converts user input (numbers or card values) into numeric values.
    !   Handles card values such as 'A', 'J', 'Q', 'K' and converts them into
    !   corresponding numbers (A=1, J=11, Q=12, K=13).
    ! Arguments:
    !   input_str: Input string representing the number or card.
    !   number:    Output real number after conversion.
    !   ios:       I/O status indicator (0 for success, non-zero for error).
    !-----------------------------------------------------------------------
    subroutine convert_to_number(input_str, number, ios)
        implicit none
        character(len=*), intent(in) :: input_str
        real, intent(out)            :: number
        integer, intent(out)         :: ios
        character(len=1)             :: first_char
        real                         :: temp_number

        ios = 0  ! Reset the I/O status to 0 (valid input by default)
        first_char = input_str(1:1)

        select case (first_char)
        case ('A', 'a')
            number = 1.0
        case ('J', 'j')
            number = 11.0
        case ('Q', 'q')
            number = 12.0
        case ('K', 'k')
            number = 13.0
        case default
            read (input_str, *, iostat=ios) temp_number  ! Attempt to read a real number

            ! If input is not a valid real number or is not an integer, set ios to 1
            if (ios /= 0 .or. mod(temp_number, 1.0) /= 0.0) then
                ios = 1  ! Invalid input
            else
                number = temp_number  ! Valid integer input
            end if
        end select
    end subroutine convert_to_number

    !-----------------------------------------------------------------------
    ! Subroutine: remove_decimal_zeros
    ! Description:
    !   Removes trailing zeros after the decimal point from a string.
    ! Arguments:
    !   str:    Input string that may contain trailing zeros.
    !   result: Output string with trailing zeros removed.
    !-----------------------------------------------------------------------
    subroutine remove_decimal_zeros(str, result)
        implicit none
        character(len=*), intent(in)  :: str       ! Input: String to remove zeros from
        character(len=*), intent(out) :: result    ! Output: String without trailing zeros
        integer                        :: i, len_str  ! Loop counter and string length

        len_str = len_trim(str)
        result = adjustl(str(1:len_str))

        ! Find the position of the decimal point
        i = index(result, '.')

        ! If there's a decimal point, remove trailing zeros
        if (i > 0) then
            do while (len_str > i .and. result(len_str:len_str) == '0')
                len_str = len_str - 1
            end do
            if (result(len_str:len_str) == '.') len_str = len_str - 1
            result = result(1:len_str)
        end if
    end subroutine remove_decimal_zeros

    !-----------------------------------------------------------------------
    ! Subroutine: create_new_arrays
    ! Description:
    !   Creates new arrays after performing an operation.
    ! Arguments:
    !   nums:      Input array of numbers.
    !   exprs:     Input array of expressions.
    !   idx1:      Index of the first element to remove.
    !   idx2:      Index of the second element to remove.
    !   result:    Result of the operation.
    !   new_expr:  New expression string.
    !   new_nums:  Output array of numbers with elements removed and result added.
    !   new_exprs: Output array of expressions with elements removed and new_expr added.
    !-----------------------------------------------------------------------
    subroutine create_new_arrays(nums, exprs, idx1, idx2, result, new_expr, new_nums, new_exprs)
        implicit none
        real, intent(in)                        :: nums(:)       ! Input: Array of numbers
        character(len=expr_len), intent(in)     :: exprs(:)      ! Input: Array of expressions
        integer, intent(in)                     :: idx1, idx2    ! Input: Indices of elements to remove
        real, intent(in)                        :: result        ! Input: Result of the operation
        character(len=expr_len), intent(in)     :: new_expr      ! Input: New expression
        real, allocatable, intent(out)          :: new_nums(:)   ! Output: New array of numbers
        character(len=expr_len), allocatable, intent(out) :: new_exprs(:) ! Output: New array of expressions
        integer                                 :: i, j, n       ! Loop counters and size of input arrays

        n = size(nums)
        allocate (new_nums(n - 1))
        allocate (new_exprs(n - 1))

        j = 0
        do i = 1, n
            if (i /= idx1 .and. i /= idx2) then
                j = j + 1
                new_nums(j) = nums(i)
                new_exprs(j) = exprs(i)
            end if
        end do

        ! Add the result of the operation to the new arrays
        new_nums(n - 1) = result
        new_exprs(n - 1) = new_expr
    end subroutine create_new_arrays

    !-----------------------------------------------------------------------
    ! Subroutine: update_progress_bar
    ! Description:
    !   Updates and displays the horizontal percentage-based progress bar.
    ! Arguments:
    !   None
    !-----------------------------------------------------------------------
    subroutine update_progress_bar()
        implicit none
        real :: percentage
        integer :: filled_length
        character(len=progress_bar_width) :: bar
        integer :: int_percentage

        if (total_calls == 0 .or. .not. show_progress) return  ! Avoid division by zero and check the flag

        percentage = real(completed_calls) / real(total_calls) * 100.0

        ! Ensure percentage does not exceed 100%
        if (percentage > 100.0) percentage = 100.0

        ! Calculate integer percentage
        int_percentage = int(percentage)

        ! Update progress bar only when percentage increases by at least 1%
        if (int_percentage > last_percentage) then
            last_percentage = int_percentage

            ! Calculate the filled length of the progress bar
            filled_length = min(int(percentage / 100.0 * progress_bar_width), progress_bar_width)

            ! Construct the progress bar string
            bar = repeat('=', filled_length)
            if (filled_length < progress_bar_width) then
                bar = bar//'>'//repeat(' ', progress_bar_width - filled_length - 1)
            end if

            ! Print the progress bar and integer percentage
            write (*, '(A, F4.1, A)', advance='no') carriage_return//'['//bar//'] ', percentage, '%'
            call flush (0)  ! Ensure output is displayed immediately
        end if
    end subroutine update_progress_bar

    !-----------------------------------------------------------------------
    ! Recursive Subroutine: solve_24
    ! Description:
    !   Recursively solves the 24 game by trying all possible operations.
    !   Utilizes OpenMP tasks for parallelization.
    ! Arguments:
    !   nums:   Array of numbers to use in the game.
    !   exprs:  Array of string expressions representing the numbers.
    !   found:  Logical flag indicating if a solution has been found.
    !-----------------------------------------------------------------------
    recursive subroutine solve_24(nums, exprs, found)
        use omp_lib
        implicit none
        real, intent(in)                         :: nums(:)       ! Input: Array of numbers
        character(len=expr_len), intent(in)      :: exprs(:)      ! Input: Array of expressions
        logical, intent(inout)                   :: found         ! Input/Output: Flag indicating if a solution is found
        integer                                  :: n             ! Size of the input arrays
        integer                                  :: i, j, op      ! Loop counters
        real                                     :: a, b, result  ! Temporary variables for calculations
        real, allocatable                        :: new_nums(:)   ! Temp array to store numbers after an operation
        character(len=expr_len), allocatable     :: new_exprs(:)  ! Temp array to store expressions after an operation
        character(len=expr_len)                  :: expr_a, expr_b, new_expr ! Temp variables for expressions

        n = size(nums)

        ! Increment the completed_calls counter and update progress bar
        if (show_progress) then
            !$omp atomic
            completed_calls = completed_calls + 1
            call update_progress_bar()
        end if

        ! If a solution is found, return
        if (found) return

        ! Base case: If only one number is left, check if it is 24
        if (n == 1) then
            if (abs(nums(1) - 24.0) < 1e-4) then
                if (show_progress) then
                    write (*, '(A, F5.1, A)', advance='no') carriage_return//'['//repeat('=', progress_bar_width)//'] ', 100.0, '%'
                    write (*, '(A)') ''  ! Insert a blank line
                end if
                !$omp critical
                write (*, '(A, A, A, F10.7, A)') 'Solution found:', trim(exprs(1)), '= 24 (', nums(1), ')'
                found = .true.
                !$omp end critical
            end if
            return
        end if

        ! Iterate over all pairs of numbers
        do i = 1, n - 1
            do j = i + 1, n
                a = nums(i)
                b = nums(j)
                expr_a = exprs(i)
                expr_b = exprs(j)

                ! Iterate over all operators
                do op = 1, 4
                    ! Avoid division by zero
                    if ((op == 4 .and. abs(b) < 1e-6)) cycle

                    ! Perform the operation and create the new expression
                    select case (op)
                    case (1)
                        result = a + b
                        new_expr = '('//trim(expr_a)//'+'//trim(expr_b)//')'
                    case (2)
                        result = a - b
                        new_expr = '('//trim(expr_a)//'-'//trim(expr_b)//')'
                    case (3)
                        result = a * b
                        new_expr = '('//trim(expr_a)//'*'//trim(expr_b)//')'
                    case (4)
                        result = a / b
                        new_expr = '('//trim(expr_a)//'/'//trim(expr_b)//')'
                    end select

                    ! Create new arrays with the selected numbers removed
                    call create_new_arrays(nums, exprs, i, j, result, new_expr, new_nums, new_exprs)

                    ! For the first few recursion levels, create parallel tasks
                    if (n >= 6 .and. omp_get_level() < 2) then
                        !$omp task shared(found) firstprivate(new_nums, new_exprs)
                        call solve_24(new_nums, new_exprs, found)
                        !$omp end task
                    else
                        call solve_24(new_nums, new_exprs, found)
                    end if

                    ! If a solution is found, deallocate memory and return
                    if (found) then
                        deallocate (new_nums)
                        deallocate (new_exprs)
                        return
                    end if

                    ! Handle commutative operations only once
                    if (op == 1 .or. op == 3) cycle

                    ! Swap operands for subtraction and division
                    if (op == 2 .or. op == 4) then
                        if (op == 4 .and. abs(a) < 1e-6) cycle  ! Avoid division by zero

                        select case (op)
                        case (2)
                            result = b - a
                            new_expr = '('//trim(expr_b)//'-'//trim(expr_a)//')'
                        case (4)
                            result = b / a
                            new_expr = '('//trim(expr_b)//'/'//trim(expr_a)//')'
                        end select

                        ! Create new arrays with the selected numbers removed
                        call create_new_arrays(nums, exprs, i, j, result, new_expr, new_nums, new_exprs)

                        ! For the first few recursion levels, create parallel tasks
                        if (n >= 6 .and. omp_get_level() < 2) then
                            !$omp task shared(found) firstprivate(new_nums, new_exprs)
                            call solve_24(new_nums, new_exprs, found)
                            !$omp end task
                        else
                            ! Recursively call the solve_24 function with the new arrays
                            call solve_24(new_nums, new_exprs, found)
                        end if

                        ! If a solution is found, deallocate memory and return
                        if (found) then
                            deallocate (new_nums)
                            deallocate (new_exprs)
                            return
                        end if
                    end if

                end do  ! End of operator loop
            end do  ! End of j loop
        end do  ! End of i loop
    end subroutine solve_24

end module game24_module

program game24
    use game24_module
    implicit none

    ! Declare variables
    integer                        :: maxn            ! Number of numbers to be entered by the user
    real, allocatable              :: numbers(:)      ! Array to store the numbers entered by the user
    character(len=expr_len), allocatable :: expressions(:)  ! Array to store the expressions
    integer                        :: i, ios          ! Loop counter and I/O status
    logical                        :: found_solution  ! Flag to indicate if a solution was found
    character(len=10)              :: user_input      ! Variable to store user input
    character(len=1)               :: play_again      ! Variable to store the user's decision

    do  ! Game loop to allow restarting the game

        ! Prompt the user for the number of numbers to use in the game
        do
            write (*, '(A,I0,A)', advance='no') 'Enter the number of numbers (1 to ', max_limit, '): '
            read (*, *, iostat=ios) maxn

            ! Check if the input is valid
            if (ios /= 0) then
                write (*, '(A,I0,A)') 'Invalid input. Please enter an integer between 1 and ', max_limit, '.'
                cycle
            end if

            ! Validate the input: Ensure the number of numbers is within the valid range
            if (maxn < 1 .or. maxn > max_limit) then
                write (*, '(A,I0,A)') 'Error: Number of numbers must be between 1 and ', max_limit, '. Try again.'
                cycle
            end if

            exit  ! Exit loop if the input is valid
        end do

        ! Allocate memory for the arrays based on the number of numbers
        allocate (numbers(maxn))
        allocate (expressions(maxn))

        ! Prompt the user to enter the numbers or card values
        write (*, '(A,I0,A)') 'Enter ', maxn, ' numbers or card values (A=1, J=11, Q=12, K=13).'
        do i = 1, maxn
            do
                ! Prompt the user to enter a number or card value
                write (*, '(A,I0,A)', advance='no') 'Enter value for card ', i, ': '
                read (*, '(A)', iostat=ios) user_input

                ! Check if input is an integer or valid card symbol (A, J, Q, K)
                call convert_to_number(user_input, numbers(i), ios)

                ! If the input is valid, exit loop
                if (ios == 0) exit

                ! Invalid input: prompt the user to try again
                write (*, '(A)') 'Invalid input. Please enter an integer or valid card symbol (A, J, Q, K).'
            end do

            ! Convert the number to a string expression and remove trailing zeros
            write (expressions(i), '(F0.2)') numbers(i)
            call remove_decimal_zeros(expressions(i), expressions(i))
        end do

        ! Initialize the solution flag to false
        found_solution = .false.

        ! Assign precomputed total_calls based on n
        select case (maxn)
        case (6)
            total_calls = total_calls_n6
        case (7)
            total_calls = total_calls_n7
        case (8)
            total_calls = total_calls_n8
        case default
            total_calls = 0
        end select

        ! Decide whether to show progress bar based on n
        if (maxn >= 6) then
            show_progress = .true.
            completed_calls = 0
            last_percentage = -1

            ! Initialize progress bar display
            write (*, '(A)', advance='no') '['//repeat(' ', progress_bar_width)//'] 0%'
            call flush (0)  ! Ensure the output is displayed immediately
        else
            show_progress = .false.
        end if

        ! Start parallel region
        !$omp parallel
        !$omp single nowait
        call solve_24(numbers, expressions, found_solution)
        !$omp end single
        !$omp end parallel

        ! After search completes, ensure the progress bar reaches 100% if shown
        if (show_progress .and. .not. found_solution) then
            write (*, '(A, A)', advance='no') carriage_return//'['//repeat('=', progress_bar_width)//'] 100%  '
            call flush (0)
            write (*, '(A)') ''  ! Insert a blank line
        end if

        ! If a solution was found and progress bar is shown, ensure a blank line
        if (show_progress .and. found_solution) then
            ! Progress bar already refreshed to 100% and blank line inserted in solve_24
        end if

        ! If no solution was found, print a message
        if (.not. found_solution) then
            write (*, '(A)') 'No valid solution found.'
        end if

        ! Deallocate the memory used by the arrays
        deallocate (numbers)
        deallocate (expressions)

        ! Ask the user if they want to play again
        if (show_progress) then
            write (*, '(A)', advance='no') carriage_return//'Play again? (Enter y/n to continue or any other key to exit): '
        else
            write (*, '(A)', advance='no') 'Play again? (Enter y/n to continue or any other key to exit): '
        end if
        read (*, '(A)') play_again  ! Read user input

        ! Check if the user wants to exit
        if (play_again /= 'y' .and. play_again /= 'Y') exit

    end do  ! End of game loop

    write (*, '(A)') 'Exiting the game...'

end program game24
Output:
n inputs outputs
4 (A, 2, 3, 4) (4*(3+(1+2))) = 24 (24.0000000)
4 (3, 3, 8, 8) (8/(3-(8/3))) = 24 (24.0000057)
6 (174, 985, 244, 192, 784, 454) No valid solution found.
7 (174, 985, 244, 192, 784, 454, 520) (((454*(520-244))-(192*754))/(174-985)) = 24 (24.0000000)
8 (17495, 3, -7, q, Q, a, A, 74) ((12+12)+((1+1)/((74--7)*(17495+3)))) = 24 (24.0000019)

FreeBASIC

Translation of: Swift
Type GameState
    digitos(3) As Double
    operaciones(2) As String
End Type

Function randomDigits() As String
    Dim As String resultado = ""
    For i As Integer = 0 To 3
        resultado &= Str(Int(Rnd * 9) + 1)
    Next
    Return resultado
End Function

Function evaluate(digitos() As Double, operaciones() As String) As Double
    Dim As Double valor = digitos(0)
    
    For i As Integer = 0 To 2
        Select Case operaciones(i)
			Case "+": valor += digitos(i +1)
			Case "-": valor -= digitos(i +1)
			Case "*": valor *= digitos(i +1)
			Case "/": If digitos(i +1) <> 0 Then valor /= digitos(i +1)
        End Select
    Next
    
    Return valor
End Function

Sub permute(digitos() As Double, soluciones() As GameState, Byref solutionCnt As Integer, k As Integer)
    Dim As String*1 opChars(3) = {"+", "-", "*", "/"}
    Dim As String ops(2)
    Dim As Integer i, j, l, m
    
    If k = 4 Then
        For i = 0 To 3
            ops(0) = opChars(i)
            For j = 0 To 3
                ops(1) = opChars(j)
                For l = 0 To 3
                    ops(2) = opChars(l)
                    If Abs(evaluate(digitos(), ops()) - 24) < 0.001 Then
                        With soluciones(solutionCnt)
                            For m = 0 To 3: .digitos(m) = digitos(m): Next
                            For m = 0 To 2: .operaciones(m) = ops(m): Next
                        End With
                        solutionCnt += 1
                        Exit For 'Stop after first solution
                    End If
                Next
                If solutionCnt Then Exit For
            Next
            If solutionCnt Then Exit For
        Next
    Else
        For i = k To 3
            Swap digitos(i), digitos(k)
            permute(digitos(), soluciones(), solutionCnt, k +1)
            If solutionCnt Then Exit For
            Swap digitos(k), digitos(i)
        Next
    End If
End Sub

' Main program
Randomize Timer
Dim As Integer i
Dim As String cmd
Dim As Double digitos(3)
Dim As String operaciones(2)

Do
    Cls
    Print "24 Game"
    Print "Generating 4 digitos..."    
    
    Dim As String inputDigits = randomDigits()
    Print "Make 24 using these digitos: ";
    For i = 1 To Len(inputDigits)
        Print Mid(inputDigits, i, 1); " ";
    Next
    Print
    
    Line Input "Enter your expression (e.g. 4+5*3-2): ", cmd
    
    Dim As Integer digitCnt = 0, opCnt = 0    
    ' Parse user input
    For i = 1 To Len(cmd)
        Select Case Mid(cmd, i, 1)
        Case "1" To "9"
            digitos(digitCnt) = Val(Mid(cmd, i, 1))
            digitCnt += 1
        Case "+", "-", "*", "/"
            operaciones(opCnt) = Mid(cmd, i, 1)
            opCnt += 1
        End Select
    Next
    
    Dim As Double resultado = evaluate(digitos(), operaciones())
    Print "Your resultado: "; resultado
    
    If Abs(resultado - 24) < 0.001 Then
        Print !"\nCongratulations, you found a solution!"
    Else
        Print !"\nThe valor of your expression is "; resultado; " instead of 24!"
        
        Dim As GameState soluciones(1000)
        Dim As Integer solucCnt = 0
        
        permute(digitos(), soluciones(), solucCnt, 0)
        
        If solucCnt > 0 Then
            Print !"\nA possible solution could have been: ";
            With soluciones(0)
                Print .digitos(0) & .operaciones(0) & .digitos(1) & .operaciones(1) & .digitos(2) & .operaciones(2) & .digitos(3)
            End With
        Else
            Print !"\nThere was no known solution for these digitos."
        End If
    End If
    
    Print !"\nDo you want to try again? (press N for exit, other key to continue)"
Loop Until (Ucase(Input(1)) = "N")

Sleep
Output:
24 Game
Generating 4 digitos...
Make 24 using these digitos: 6 6 5 5
Enter your expression (e.g. 4+5*3-2): 5+5-6*6
Your resultado:  24

Congratulations, you found a solution!

Do you want to try again? (press N for exit, other key to continue)

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:
3388	8 / ( 3 - 8 / 3 ) = 24
1346	6 / ( 1 - 3 / 4 ) = 24
8752	8 * ( 5 * 2 - 7 ) = 24

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
        }
        ret.add( next )
    }
    return ret
}

function getOp( i : int ) : char[] {
    var ret = new char[3]
    var ops = { '+', '-', '*', '/' }
    ret[0] = ops[i / 16]
    ret[1] = ops[(i / 4) % 4 ]
    ret[2] = ops[i % 4 ]
    return ret
}

function isSoln( nums : List<Integer>, ops : char[] ) : boolean {
    var stk = new Stack<Double>()
    for( n in nums ) {
        stk.push( n )
    }

    for( c in ops ) {
        var r = stk.pop().doubleValue()
        var l = stk.pop().doubleValue()
        if( c == '+' ) {
            stk.push( l + r )
        } else if( c == '-' ) {
            stk.push( l - r )
        } else if( c == '*' ) {
            stk.push( l * r )
        } else if( c == '/' ) {
            // Avoid division by 0
            if( r == 0.0 ) {
                return false
            }
            stk.push( l / r )
        }
    }

    return java.lang.Math.abs( stk.pop().doubleValue() - 24.0 ) < 0.001
}

function printSoln( nums : List<Integer>, ops : char[] ) {
    // RPN: a b c d + - *
    // Infix (a * (b - (c + d)))
    print( "Found soln: (${nums.get(0)} ${ops[0]} (${nums.get(1)} ${ops[1]} (${nums.get(2)} ${ops[2]} ${nums.get(3)})))" )
}

System.out.print( "#> " )
var vals = readVals()

var opPerms = 0..63
var solnFound = false

for( i in permutations( vals ) ) {
    for( j in opPerms ) {
        var opList = getOp( j )
        if( isSoln( i, opList ) ) {
            printSoln( i, opList )
            solnFound = true
        }
    }
}

if( ! solnFound ) {
    print( "No solution!" )
}

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 := trim(read()) | fail
   e ?  case tab(find(" ")|0) of {
      "q"|"quit" : break
      "u"|"use"  : e := tab(0)
      "f"|"first": first := 1 & next
      "a"|"all"  : first := &null & next
      ""         : e := " " ||(1+?8) || " " || (1+?8) ||" " || (1+?8) || " " || (1+?8)
      }
      
   writes("Attempting to solve 24 for",e)
   
   e := deletec(e,' \t') # no whitespace   
   if e ? ( tab(many('123456789')), pos(5), pos(0) ) then 
      write(":")
   else write(" - invalid, only the digits '1..9' are allowed.") & next  
   
   eS := set()
   every ex := map(!eL,"wxyz",e) do {
      if member(eS,ex) then next # skip duplicates of final expression
      insert(eS,ex)
      if ex ? (ans := eval(E()), pos(0)) then # parse and evaluate
         if ans = 24 then {
            write("Success ",image(ex)," evaluates to 24.")
            if \first then break
            }
      }
   }
write("Quiting.")
end

procedure eval(X)    #: return the evaluated AST
   if type(X) == "list" then {
      x := eval(get(X)) 
      while o := get(X) do 
         if y := get(X) then
            x := o( real(x), (o ~== "/" | fail, eval(y) ))
         else write("Malformed expression.") & fail
   }
   return \x | X
end

procedure E()    #: expression
   put(lex := [],T())
   while put(lex,tab(any('+-*/'))) do
      put(lex,T())  
   suspend if *lex = 1 then lex[1] else lex     # strip useless []  
end   
 
procedure T()                   #: Term
   suspend 2(="(", E(), =")") | # parenthesized subexpression, or ...
       tab(any(&digits))        # just a value
end


strings.icn provides deletec and permutes

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]]]
Please try again.
[1,2,3,40,1]
That was too easy. I found 636 answers, e.g. [[[1 / 2] * 40] + [3 + 1]]
Please try again.
[3,8,9]
That was too easy. I found 8 answers, e.g. [[8 / 3] * 9]
Please try again.
[4,5,6]
You lose! There are no solutions.
Please try again.
[1,2,3,4,5,6]
That was too easy. I found 197926 answers, e.g. [[2 * [1 + 4]] + [3 + [5 + 6]]]
Please try again.

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.ADD -> " + "
        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