/* 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"


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.


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


/* 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"


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


      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


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


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


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)}");
    }

    ///Generates postfix expression trees where 1's represent operators and 0's represent numbers.
    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;
        }
    }

    ///Generates all numbers with the given number of 1's and total length.
    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}")}";
    }
}


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


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


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


# 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'}"


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


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


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


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


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


>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