A-M baby

Task/24-game-Solve/0DESCRIPTION

@@ -0,0 +1,6 @@
+Write a function that given four digits subject to the rules of the [[24 game]], computes an expression to solve the game if possible.
+
+Show examples of solutions generated by the function
+
+
+C.F: [[Arithmetic Evaluator]]

Task/24-game-Solve/ABAP/24-game-solve.abap

@@ -0,0 +1,198 @@
+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.

Task/24-game-Solve/Argile/24-game-solve.argile

@@ -0,0 +1,98 @@
+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

Task/24-game-Solve/AutoHotkey/24-game-solve.ahk

@@ -0,0 +1,108 @@
+#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
+}

Task/24-game-Solve/BBC-BASIC/24-game-solve.bbc

@@ -0,0 +1,56 @@
+      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

Task/24-game-Solve/C/24-game-solve.c

@@ -0,0 +1,141 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+#define n_cards 4
+#define solve_goal 24
+#define max_digit 9
+
+typedef struct { int num, denom; } frac_t, *frac;
+typedef enum { C_NUM = 0, C_ADD, C_SUB, C_MUL, C_DIV, } op_type;
+
+typedef struct expr_t *expr;
+typedef struct expr_t {
+        op_type op;
+        expr left, right;
+        int value;
+} expr_t;
+
+void show_expr(expr e, op_type prec, int is_right)
+{
+        const char * op;
+        switch(e->op) {
+        case C_NUM:     printf("%d", e->value);
+                        return;
+        case C_ADD:     op = " + "; break;
+        case C_SUB:     op = " - "; break;
+        case C_MUL:     op = " x "; break;
+        case C_DIV:     op = " / "; break;
+        }
+
+        if ((e->op == prec && is_right) || e->op < prec) printf("(");
+        show_expr(e->left, e->op, 0);
+        printf("%s", op);
+        show_expr(e->right, e->op, 1);
+        if ((e->op == prec && is_right) || e->op < prec) printf(")");
+}
+
+void eval_expr(expr e, frac f)
+{
+        frac_t left, right;
+        if (e->op == C_NUM) {
+                f->num = e->value;
+                f->denom = 1;
+                return;
+        }
+        eval_expr(e->left, &left);
+        eval_expr(e->right, &right);
+        switch (e->op) {
+        case C_ADD:
+                f->num = left.num * right.denom + left.denom * right.num;
+                f->denom = left.denom * right.denom;
+                return;
+        case C_SUB:
+                f->num = left.num * right.denom - left.denom * right.num;
+                f->denom = left.denom * right.denom;
+                return;
+        case C_MUL:
+                f->num = left.num * right.num;
+                f->denom = left.denom * right.denom;
+                return;
+        case C_DIV:
+                f->num = left.num * right.denom;
+                f->denom = left.denom * right.num;
+                return;
+        default:
+                fprintf(stderr, "Unknown op: %d\n", e->op);
+                return;
+        }
+}
+int solve(expr ex_in[], int len)
+{
+        int i, j;
+        expr_t node;
+        expr ex[n_cards];
+        frac_t final;
+
+        if (len == 1) {
+                eval_expr(ex_in[0], &final);
+                if (final.num == final.denom * solve_goal && final.denom) {
+                        show_expr(ex_in[0], 0, 0);
+                        return 1;
+                }
+                return 0;
+        }
+
+        for (i = 0; i < len - 1; i++) {
+                for (j = i + 1; j < len; j++)
+                        ex[j - 1] = ex_in[j];
+                ex[i] = &node;
+                for (j = i + 1; j < len; j++) {
+                        node.left = ex_in[i];
+                        node.right = ex_in[j];
+                        for (node.op = C_ADD; node.op <= C_DIV; node.op++)
+                                if (solve(ex, len - 1))
+                                        return 1;
+
+                        node.left = ex_in[j];
+                        node.right = ex_in[i];
+                        node.op = C_SUB;
+                        if (solve(ex, len - 1)) return 1;
+                        node.op = C_DIV;
+                        if (solve(ex, len - 1)) return 1;
+
+                        ex[j] = ex_in[j];
+                }
+                ex[i] = ex_in[i];
+        }
+
+        return 0;
+}
+
+int solve24(int n[])
+{
+        int i;
+        expr_t ex[n_cards];
+        expr   e[n_cards];
+        for (i = 0; i < n_cards; i++) {
+                e[i] = ex + i;
+                ex[i].op = C_NUM;
+                ex[i].left = ex[i].right = 0;
+                ex[i].value = n[i];
+        }
+        return solve(e, n_cards);
+}
+
+int main()
+{
+        int i, j, n[] = { 3, 3, 8, 8, 9 };
+        srand(time(0));
+
+        for (j = 0; j < 10; j++) {
+                for (i = 0; i < n_cards; i++) {
+                        n[i] = 1 + (double) rand() * max_digit / RAND_MAX;
+                        printf(" %d", n[i]);
+                }
+                printf(":  ");
+                printf(solve24(n) ? "\n" : "No solution\n");
+        }
+
+        return 0;
+}

Task/24-game-Solve/Clojure/24-game-solve.clj

@@ -0,0 +1,30 @@
+(use 'clojure.contrib.combinatorics)
+
+(defn nested-replace [l m]
+(cond
+(= l '()) '()
+(m (first l)) (concat (list (m (first l))) (nested-replace (rest l) m))
+(seq? (first l)) (concat (list (nested-replace (first l) m)) (nested-replace (rest l) m))
+true (concat (list (first l)) (nested-replace (rest l) m))))
+
+(defn format-solution [sol]
+(cond
+(number? sol) sol
+(seq? sol)
+    (list (format-solution (second sol)) (first sol) (format-solution (nth sol 2)))))
+
+(defn play24 [& digits] (count (map #(-> % format-solution println)
+(let [operator-map-list (map (fn [a] {:op1 (nth a 0) :op2 (nth a 1) :op3 (nth a 2)})
+       (selections '(* + - /) 3))
+     digits-map-list
+       (map (fn [a] {:num1 (nth a 0) :num2 (nth a 1) :num3 (nth a 2) :num4 (nth a 3)})
+         (permutations digits))
+     patterns-list (list
+       '(:op1 (:op2 :num1 :num2) (:op3 :num3 :num4))
+       '(:op1 :num1 (:op2 :num2 (:op3 :num3 :num4))))
+       ;other patterns can be added here, e.g. '(:op1 (:op2 (:op3 :num1 :num2) :num3) :num4)
+     op-subbed (reduce concat '()
+       (map (fn [a] (map #(nested-replace a % ) operator-map-list)) patterns-list))
+     full-subbed (reduce concat '()
+       (map (fn [a] (map #(nested-replace % a) op-subbed)) digits-map-list))]
+     (filter #(= (try (eval %) (catch Exception e nil)) 24) full-subbed)))))

Task/24-game-Solve/CoffeeScript/24-game-solve-1.coffee

@@ -0,0 +1,87 @@
+# 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'}"

Task/24-game-Solve/CoffeeScript/24-game-solve-2.coffee

@@ -0,0 +1,16 @@
+> coffee 24_game.coffee
+Solution for 8,3,1,8: ((1 + 8) * (8 / 3))
+Solution for 6,9,5,7: (6 - ((5 - 7) * 9))
+Solution for 4,2,1,1: no solution
+Solution for 3,5,1,3: (((3 + 5) * 1) * 3)
+Solution for 6,4,1,7: ((7 - (4 - 1)) * 6)
+Solution for 8,1,3,1: (((8 + 1) - 1) * 3)
+Solution for 6,1,3,3: (((6 + 1) * 3) + 3)
+Solution for 7,1,5,6: (((7 - 1) * 5) - 6)
+Solution for 4,2,3,1: ((3 + 1) * (4 + 2))
+Solution for 8,8,5,8: ((5 * 8) - (8 + 8))
+Solution for 3,8,4,1: ((1 - (3 - 8)) * 4)
+Solution for 6,4,3,8: ((8 - (6 / 3)) * 4)
+Solution for 2,1,8,7: (((2 * 8) + 1) + 7)
+Solution for 5,2,7,5: ((2 * 7) + (5 + 5))
+Solution for 2,4,8,9: ((9 - (2 + 4)) * 8)

Task/24-game-Solve/Common-Lisp/24-game-solve.lisp

@@ -0,0 +1,56 @@
+(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))

Task/24-game-Solve/D/24-game-solve.d

@@ -0,0 +1,47 @@
+import std.stdio, std.algorithm, std.range, std.typecons, std.conv,
+       std.string, permutations2, arithmetic_rational;
+
+string solve(in int target, in int[] problem) {
+  static struct ComputeAllOperations {
+    //static struct T { Rational r; string e; }
+    alias T = Tuple!(Rational,"r", string,"e");
+    Rational[] L;
+
+    int opApply(in int delegate(ref T) dg) {
+      int result;
+
+      if (!L.empty) {
+        auto x = L[0];
+        auto xs = L[1 .. $];
+        if (L.length == 1) {
+          T aux = T(x, text(x));
+          result = dg(aux);
+        } else {
+          OUTER: foreach (o; ComputeAllOperations(xs)) {
+            auto y = o.r;
+            auto sub = [T(x * y, "*"), T(x + y, "+"), T(x - y, "-")];
+            if (y) sub ~= [T(x/y, "/")];
+            foreach (e; sub) {
+              auto aux = T(e.r, format("(%s%s%s)", x, e.e, o.e));
+              result = dg(aux); if (result) break OUTER;
+            }
+          }
+        }
+      }
+
+      return result;
+    }
+  }
+
+
+  foreach (p; problem.map!Rational.array.permutations)
+    foreach (sol; ComputeAllOperations(p))
+      if (sol.r == target)
+        return sol.e;
+  return "No solution";
+}
+
+void main() {
+  foreach (prob; [[6, 7, 9, 5], [3, 3, 8, 8], [1, 1, 1, 1]])
+    writeln(prob, ": ", solve(24, prob));
+}

Task/24-game-Solve/Euler-Math-Toolbox/24-game-solve-1.euler

@@ -0,0 +1,22 @@
+>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

Task/24-game-Solve/Euler-Math-Toolbox/24-game-solve-2.euler

@@ -0,0 +1,20 @@
+>try24([1,2,3,4]);
+ Solved the problem
+ 6*4=24
+ 3+3=6
+ 1+2=3
+>try24([8,7,7,1]);
+ Solved the problem
+ 22+2=24
+ 14+8=22
+ 7+7=14
+>try24([8,4,7,1]);
+ Solved the problem
+ 6*4=24
+ 7-1=6
+ 8-4=4
+>try24([3,4,5,6]);
+ Solved the problem
+ 4*6=24
+ -1+5=4
+ 3-4=-1

Task/24-game-Solve/Fortran/24-game-solve-1.f

@@ -0,0 +1,69 @@
+program solve_24
+  use helpers
+  implicit none
+  real                 :: vector(4), reals(4), p, q, r, s
+  integer              :: numbers(4), n, i, j, k, a, b, c, d
+  character, parameter :: ops(4) = (/ '+', '-', '*', '/' /)
+  logical              :: last
+  real,parameter       :: eps = epsilon(1.0)
+
+  do n=1,12
+    call random_number(vector)
+    reals   = 9 * vector + 1
+    numbers = int(reals)
+    call Insertion_Sort(numbers)
+
+    permutations: do
+      a = numbers(1); b = numbers(2); c = numbers(3); d = numbers(4)
+      reals = real(numbers)
+      p = reals(1);   q = reals(2);   r = reals(3);   s = reals(4)
+      ! combinations of operators:
+      do i=1,4
+        do j=1,4
+          do k=1,4
+            if      ( abs(op(op(op(p,i,q),j,r),k,s)-24.0) < eps ) then
+              write (*,*) numbers, ' : ', '((',a,ops(i),b,')',ops(j),c,')',ops(k),d
+              exit permutations
+            else if ( abs(op(op(p,i,op(q,j,r)),k,s)-24.0) < eps ) then
+              write (*,*) numbers, ' : ', '(',a,ops(i),'(',b,ops(j),c,'))',ops(k),d
+              exit permutations
+            else if ( abs(op(p,i,op(op(q,j,r),k,s))-24.0) < eps ) then
+              write (*,*) numbers, ' : ', a,ops(i),'((',b,ops(j),c,')',ops(k),d,')'
+              exit permutations
+            else if ( abs(op(p,i,op(q,j,op(r,k,s)))-24.0) < eps ) then
+              write (*,*) numbers, ' : ', a,ops(i),'(',b,ops(j),'(',c,ops(k),d,'))'
+              exit permutations
+            else if ( abs(op(op(p,i,q),j,op(r,k,s))-24.0) < eps ) then
+              write (*,*) numbers, ' : ', '(',a,ops(i),b,')',ops(j),'(',c,ops(k),d,')'
+              exit permutations
+            end if
+          end do
+        end do
+      end do
+      call nextpermutation(numbers,last)
+      if ( last ) then
+        write (*,*) numbers, ' : no solution.'
+        exit permutations
+      end if
+    end do permutations
+
+  end do
+
+contains
+
+  pure real function op(x,c,y)
+    integer, intent(in) :: c
+    real, intent(in)    :: x,y
+    select case ( ops(c) )
+      case ('+')
+        op = x+y
+      case ('-')
+        op = x-y
+      case ('*')
+        op = x*y
+      case ('/')
+        op = x/y
+    end select
+  end function op
+
+end program solve_24

Task/24-game-Solve/Fortran/24-game-solve-2.f

@@ -0,0 +1,72 @@
+module helpers
+
+contains
+
+  pure subroutine Insertion_Sort(a)
+    integer, intent(inout) :: a(:)
+    integer                :: temp, i, j
+    do i=2,size(a)
+      j = i-1
+      temp = a(i)
+      do while ( j>=1 .and. a(j)>temp )
+        a(j+1) = a(j)
+        j = j - 1
+      end do
+      a(j+1) = temp
+    end do
+  end subroutine Insertion_Sort
+
+  subroutine nextpermutation(perm,last)
+    integer, intent(inout) :: perm(:)
+    logical, intent(out)   :: last
+    integer :: k,l
+    k = largest1()
+    last = k == 0
+    if ( .not. last ) then
+      l = largest2(k)
+      call swap(l,k)
+      call reverse(k)
+    end if
+  contains
+    pure integer function largest1()
+      integer :: k, max
+      max = 0
+      do k=1,size(perm)-1
+        if ( perm(k) < perm(k+1) ) then
+          max = k
+        end if
+      end do
+      largest1 = max
+    end function largest1
+
+    pure integer function largest2(k)
+      integer, intent(in) :: k
+      integer             :: l, max
+      max = k+1
+      do l=k+2,size(perm)
+        if ( perm(k) < perm(l) ) then
+          max = l
+        end if
+      end do
+      largest2 = max
+    end function largest2
+
+    subroutine swap(l,k)
+      integer, intent(in) :: k,l
+      integer             :: temp
+      temp    = perm(k)
+      perm(k) = perm(l)
+      perm(l) = temp
+    end subroutine swap
+
+    subroutine reverse(k)
+      integer, intent(in) :: k
+      integer             :: i
+      do i=1,(size(perm)-k)/2
+        call swap(k+i,size(perm)+1-i)
+      end do
+    end subroutine reverse
+
+  end subroutine nextpermutation
+
+end module helpers

Task/24-game-Solve/GAP/24-game-solve.gap

@@ -0,0 +1,84 @@
+# Solution in '''RPN'''
+check := function(x, y, z)
+	local r, c, s, i, j, k, a, b, p;
+	i := 0;
+	j := 0;
+	k := 0;
+	s := [ ];
+	r := "";
+	for c in z do
+		if c = 'x' then
+			i := i + 1;
+			k := k + 1;
+			s[k] := x[i];
+			Append(r, String(x[i]));
+		else
+			j := j + 1;
+			b := s[k];
+			k := k - 1;
+			a := s[k];
+			p := y[j];
+			r[Size(r) + 1] := p;
+			if p = '+' then
+				a := a + b;
+			elif p = '-' then
+				a := a - b;
+			elif p = '*' then
+				a := a * b;
+			elif p = '/' then
+				if b = 0 then
+					continue;
+				else
+					a := a / b;
+				fi;
+			else
+				return fail;
+			fi;
+			s[k] := a;
+		fi;
+	od;
+	if s[1] = 24 then
+		return r;
+	else
+		return fail;
+	fi;
+end;
+	
+Player24 := function(digits)
+	local u, v, w, x, y, z, r;
+	u := PermutationsList(digits);
+	v := Tuples("+-*/", 3);
+	w := ["xx*x*x*", "xx*xx**", "xxx**x*", "xxx*x**", "xxxx***"];
+	for x in u do
+		for y in v do
+			for z in w do
+				r := check(x, y, z);
+				if r <> fail then
+					return r;
+				fi;
+			od;
+		od;
+	od;
+	return fail;
+end;
+
+Player24([1,2,7,7]);
+# "77*1-2/"
+Player24([9,8,7,6]);
+# "68*97-/"
+Player24([1,1,7,7]);
+# fail
+
+# Solutions with only one distinct digit are found only for 3, 4, 5, 6:
+Player24([3,3,3,3]);
+# "33*3*3-"
+Player24([4,4,4,4]);
+# "44*4+4+"
+Player24([5,5,5,5]);
+# "55*55/-"
+Player24([6,6,6,6]);
+# "66*66+-"
+
+# A tricky one:
+Player24([3,3,8,8]);
+"8383/-/"

Task/24-game-Solve/Go/24-game-solve.go

@@ -0,0 +1,171 @@
+package main
+
+import (
+	"fmt"
+	"math/rand"
+	"time"
+)
+
+const (
+	op_num = iota
+	op_add
+	op_sub
+	op_mul
+	op_div
+)
+
+type frac struct {
+	num, denom int
+}
+
+// Expression: can either be a single number, or a result of binary
+// operation from left and right node
+type Expr struct {
+	op          int
+	left, right *Expr
+	value       frac
+}
+
+var n_cards = 4
+var goal = 24
+var digit_range = 9
+
+func (x *Expr) String() string {
+	if x.op == op_num {
+		return fmt.Sprintf("%d", x.value.num)
+	}
+
+	var bl1, br1, bl2, br2, opstr string
+	switch {
+	case x.left.op == op_num:
+	case x.left.op >= x.op:
+	case x.left.op == op_add && x.op == op_sub:
+		bl1, br1 = "", ""
+	default:
+		bl1, br1 = "(", ")"
+	}
+
+	if x.right.op == op_num || x.op < x.right.op {
+		bl2, br2 = "", ""
+	} else {
+		bl2, br2 = "(", ")"
+	}
+
+	switch {
+	case x.op == op_add:
+		opstr = " + "
+	case x.op == op_sub:
+		opstr = " - "
+	case x.op == op_mul:
+		opstr = " * "
+	case x.op == op_div:
+		opstr = " / "
+	}
+
+	return bl1 + x.left.String() + br1 + opstr +
+		bl2 + x.right.String() + br2
+}
+
+func expr_eval(x *Expr) (f frac) {
+	if x.op == op_num {
+		return x.value
+	}
+
+	l, r := expr_eval(x.left), expr_eval(x.right)
+
+	switch {
+	case x.op == op_add:
+		f.num = l.num*r.denom + l.denom*r.num
+		f.denom = l.denom * r.denom
+		return
+
+	case x.op == op_sub:
+		f.num = l.num*r.denom - l.denom*r.num
+		f.denom = l.denom * r.denom
+		return
+
+	case x.op == op_mul:
+		f.num = l.num * r.num
+		f.denom = l.denom * r.denom
+		return
+
+	case x.op == op_div:
+		f.num = l.num * r.denom
+		f.denom = l.denom * r.num
+		return
+	}
+	return
+}
+
+func solve(ex_in []*Expr) bool {
+	// only one expression left, meaning all numbers are arranged into
+	// a binary tree, so evaluate and see if we get 24
+	if len(ex_in) == 1 {
+		f := expr_eval(ex_in[0])
+		if f.denom != 0 && f.num == f.denom*goal {
+			fmt.Println(ex_in[0].String())
+			return true
+		}
+		return false
+	}
+
+	var node Expr
+	ex := make([]*Expr, len(ex_in)-1)
+
+	// try to combine a pair of expressions into one, thus reduce
+	// the list length by 1, and recurse down
+	for i := range ex {
+		copy(ex[i:len(ex)], ex_in[i+1:len(ex_in)])
+
+		ex[i] = &node
+		for j := i + 1; j < len(ex_in); j++ {
+			node.left = ex_in[i]
+			node.right = ex_in[j]
+
+			// try all 4 operators
+			for o := op_add; o <= op_div; o++ {
+				node.op = o
+				if solve(ex) {
+					return true
+				}
+			}
+
+			// also - and / are not commutative, so swap arguments
+			node.left = ex_in[j]
+			node.right = ex_in[i]
+
+			node.op = op_sub
+			if solve(ex) {
+				return true
+			}
+
+			node.op = op_div
+			if solve(ex) {
+				return true
+			}
+
+			if j < len(ex) {
+				ex[j] = ex_in[j]
+			}
+		}
+		ex[i] = ex_in[i]
+	}
+	return false
+}
+
+func main() {
+	cards := make([]*Expr, n_cards)
+	rand.Seed(time.Now().Unix())
+
+	for k := 0; k < 10; k++ {
+		for i := 0; i < n_cards; i++ {
+			cards[i] = &Expr{op_num, nil, nil,
+				frac{rand.Intn(digit_range-1) + 1, 1}}
+			fmt.Printf(" %d", cards[i].value.num)
+		}
+		fmt.Print(":  ")
+		if !solve(cards) {
+			fmt.Println("No solution")
+		}
+	}
+}

Task/24-game-Solve/Gosu/24-game-solve.gosu

@@ -0,0 +1,110 @@
+uses java.lang.Integer
+uses java.lang.Double
+uses java.lang.System
+uses java.util.ArrayList
+uses java.util.LinkedList
+uses java.util.List
+uses java.util.Scanner
+uses java.util.Stack
+
+function permutations<T>( lst : List<T> ) : List<List<T>> {
+    if( lst.size() == 0 ) return {}
+    if( lst.size() == 1 ) return { lst }
+
+    var pivot = lst.get(lst.size()-1)
+
+    var sublist = new ArrayList<T>( lst )
+    sublist.remove( sublist.size() - 1 )
+
+    var subPerms = permutations( sublist )
+
+    var ret = new ArrayList<List<T>>()
+    for( x in subPerms ) {
+        for( e in x index i ) {
+            var next = new LinkedList<T>( x )
+            next.add( i, pivot )
+            ret.add( next )
+        }
+        x.add( pivot )
+        ret.add( x )
+    }
+    return ret
+}
+
+function readVals() : List<Integer> {
+    var line = new java.io.BufferedReader( new java.io.InputStreamReader( System.in ) ).readLine()
+    var scan = new Scanner( line )
+
+    var ret = new ArrayList<Integer>()
+    for( i in 0..3 ) {
+        var next = scan.nextInt()
+        if( 0 >= next || next >= 10 ) {
+            print( "Invalid entry: ${next}" )
+            return null
+        }
+        ret.add( next )
+    }
+    return ret
+}
+
+function getOp( i : int ) : char[] {
+    var ret = new char[3]
+    var ops = { '+', '-', '*', '/' }
+    ret[0] = ops[i / 16]
+    ret[1] = ops[(i / 4) % 4 ]
+    ret[2] = ops[i % 4 ]
+    return ret
+}
+
+function isSoln( nums : List<Integer>, ops : char[] ) : boolean {
+    var stk = new Stack<Double>()
+    for( n in nums ) {
+        stk.push( n )
+    }
+
+    for( c in ops ) {
+        var r = stk.pop().doubleValue()
+        var l = stk.pop().doubleValue()
+        if( c == '+' ) {
+            stk.push( l + r )
+        } else if( c == '-' ) {
+            stk.push( l - r )
+        } else if( c == '*' ) {
+            stk.push( l * r )
+        } else if( c == '/' ) {
+            // Avoid division by 0
+            if( r == 0.0 ) {
+                return false
+            }
+            stk.push( l / r )
+        }
+    }
+
+    return java.lang.Math.abs( stk.pop().doubleValue() - 24.0 ) < 0.001
+}
+
+function printSoln( nums : List<Integer>, ops : char[] ) {
+    // RPN: a b c d + - *
+    // Infix (a * (b - (c + d)))
+    print( "Found soln: (${nums.get(0)} ${ops[0]} (${nums.get(1)} ${ops[1]} (${nums.get(2)} ${ops[2]} ${nums.get(3)})))" )
+}
+
+System.out.print( "#> " )
+var vals = readVals()
+
+var opPerms = 0..63
+var solnFound = false
+
+for( i in permutations( vals ) ) {
+    for( j in opPerms ) {
+        var opList = getOp( j )
+        if( isSoln( i, opList ) ) {
+            printSoln( i, opList )
+            solnFound = true
+        }
+    }
+}
+
+if( ! solnFound ) {
+    print( "No solution!" )
+}

Task/24-game-Solve/Haskell/24-game-solve-1.hs

@@ -0,0 +1,50 @@
+import Data.List
+import Data.Ratio
+import Control.Monad
+import System.Environment (getArgs)
+
+data Expr = Constant Rational |
+    Expr :+ Expr | Expr :- Expr |
+    Expr :* Expr | Expr :/ Expr
+    deriving (Eq)
+
+ops = [(:+), (:-), (:*), (:/)]
+
+instance Show Expr where
+    show (Constant x) = show $ numerator x
+      -- In this program, we need only print integers.
+    show (a :+ b)     = strexp "+" a b
+    show (a :- b)     = strexp "-" a b
+    show (a :* b)     = strexp "*" a b
+    show (a :/ b)     = strexp "/" a b
+
+strexp :: String -> Expr -> Expr -> String
+strexp op a b = "(" ++ show a ++ " " ++ op ++ " " ++ show b ++ ")"
+
+templates :: [[Expr] -> Expr]
+templates = do
+    op1 <- ops
+    op2 <- ops
+    op3 <- ops
+    [\[a, b, c, d] -> op1 a $ op2 b $ op3 c d,
+     \[a, b, c, d] -> op1 (op2 a b) $ op3 c d,
+     \[a, b, c, d] -> op1 a $ op2 (op3 b c) d,
+     \[a, b, c, d] -> op1 (op2 a $ op3 b c) d,
+     \[a, b, c, d] -> op1 (op2 (op3 a b) c) d]
+
+eval :: Expr -> Maybe Rational
+eval (Constant c) = Just c
+eval (a :+ b)     = liftM2 (+) (eval a) (eval b)
+eval (a :- b)     = liftM2 (-) (eval a) (eval b)
+eval (a :* b)     = liftM2 (*) (eval a) (eval b)
+eval (a :/ b)     = do
+    denom <- eval b
+    guard $ denom /= 0
+    liftM (/ denom) $ eval a
+
+solve :: Rational -> [Rational] -> [Expr]
+solve target r4 = filter (maybe False (== target) . eval) $
+    liftM2 ($) templates $
+    nub $ permutations $ map Constant r4
+
+main = getArgs >>= mapM_ print . solve 24 . map (toEnum . read)

Task/24-game-Solve/Haskell/24-game-solve-2.hs

@@ -0,0 +1,76 @@
+invocable all
+link strings   # for csort, deletec, permutes
+
+procedure main()
+static eL
+initial {
+   eoP := []  # set-up expression and operator permutation patterns
+   every ( e := !["a@b#c$d", "a@(b#c)$d", "a@b#(c$d)", "a@(b#c$d)", "a@(b#(c$d))"] ) &
+         ( o := !(opers := "+-*/") || !opers || !opers ) do
+      put( eoP, map(e,"@#$",o) )    # expr+oper perms
+
+   eL := []   # all cases
+   every ( e := !eoP ) & ( p := permutes("wxyz") ) do
+      put(eL, map(e,"abcd",p))
+
+   }
+
+write("This will attempt to find solutions to 24 for sets of numbers by\n",
+      "combining 4 single digits between 1 and 9 to make 24 using only + - * / and ( ).\n",
+      "All operations have equal precedence and are evaluated left to right.\n",
+      "Enter 'use n1 n2 n3 n4' or just hit enter (to use a random set),",
+      "'first'/'all' shows the first or all solutions, 'quit' to end.\n\n")
+
+repeat {
+   e := trim(read()) | fail
+   e ?  case tab(find(" ")|0) of {
+      "q"|"quit" : break
+      "u"|"use"  : e := tab(0)
+      "f"|"first": first := 1 & next
+      "a"|"all"  : first := &null & next
+      ""         : e := " " ||(1+?8) || " " || (1+?8) ||" " || (1+?8) || " " || (1+?8)
+      }
+
+   writes("Attempting to solve 24 for",e)
+
+   e := deletec(e,' \t') # no whitespace
+   if e ? ( tab(many('123456789')), pos(5), pos(0) ) then
+      write(":")
+   else write(" - invalid, only the digits '1..9' are allowed.") & next
+
+   eS := set()
+   every ex := map(!eL,"wxyz",e) do {
+      if member(eS,ex) then next # skip duplicates of final expression
+      insert(eS,ex)
+      if ex ? (ans := eval(E()), pos(0)) then # parse and evaluate
+         if ans = 24 then {
+            write("Success ",image(ex)," evaluates to 24.")
+            if \first then break
+            }
+      }
+   }
+write("Quiting.")
+end
+
+procedure eval(X)    #: return the evaluated AST
+   if type(X) == "list" then {
+      x := eval(get(X))
+      while o := get(X) do
+         if y := get(X) then
+            x := o( real(x), (o ~== "/" | fail, eval(y) ))
+         else write("Malformed expression.") & fail
+   }
+   return \x | X
+end
+
+procedure E()    #: expression
+   put(lex := [],T())
+   while put(lex,tab(any('+-*/'))) do
+      put(lex,T())
+   suspend if *lex = 1 then lex[1] else lex     # strip useless []
+end
+
+procedure T()                   #: Term
+   suspend 2(="(", E(), =")") | # parenthesized subexpression, or ...
+       tab(any(&digits))        # just a value
+end

Task/24-game-Solve/J/24-game-solve.j

@@ -0,0 +1,9 @@
+perm=: (A.&i.~ !) 4
+ops=: ' ',.'+-*%' {~ >,{i.each 4 4 4
+cmask=: 1 + 0j1 * i.@{:@$@[ e. ]
+left=:  [ #!.'('~"1 cmask
+right=: [ #!.')'~"1 cmask
+paren=: 2 :'[: left&m right&n'
+parens=: ], 0 paren 3, 0 paren 5, 2 paren 5, [: 0 paren 7 (0 paren 3)
+all=: [: parens [:,/ ops ,@,."1/ perm { [:;":each
+answer=: ({.@#~ 24 = ".)@all

Task/24-game-Solve/JavaScript/24-game-solve.js

@@ -0,0 +1,104 @@
+var ar=[],order=[0,1,2],op=[],val=[];
+var NOVAL=9999,oper="+-*/",out;
+
+function rnd(n){return Math.floor(Math.random()*n)}
+
+function say(s){
+ try{document.write(s+"<br>")}
+ catch(e){WScript.Echo(s)}
+}
+
+function getvalue(x,dir){
+ var r=NOVAL;
+ if(dir>0)++x;
+ while(1){
+  if(val[x]!=NOVAL){
+   r=val[x];
+   val[x]=NOVAL;
+   break;
+  }
+  x+=dir;
+ }
+ return r*1;
+}
+
+function calc(){
+ var c=0,l,r,x;
+ val=ar.join('/').split('/');
+ while(c<3){
+  x=order[c];
+  l=getvalue(x,-1);
+  r=getvalue(x,1);
+  switch(op[x]){
+   case 0:val[x]=l+r;break;
+   case 1:val[x]=l-r;break;
+   case 2:val[x]=l*r;break;
+   case 3:
+   if(!r||l%r)return 0;
+   val[x]=l/r;
+  }
+  ++c;
+ }
+ return getvalue(-1,1);
+}
+
+function shuffle(s,n){
+ var x=n,p=eval(s),r,t;
+ while(x--){
+  r=rnd(n);
+  t=p[x];
+  p[x]=p[r];
+  p[r]=t;
+ }
+}
+
+function parenth(n){
+ while(n>0)--n,out+='(';
+ while(n<0)++n,out+=')';
+}
+
+function getpriority(x){
+ for(var z=3;z--;)if(order[z]==x)return 3-z;
+ return 0;
+}
+
+function showsolution(){
+ var x=0,p=0,lp=0,v=0;
+ while(x<4){
+  if(x<3){
+   lp=p;
+   p=getpriority(x);
+   v=p-lp;
+   if(v>0)parenth(v);
+  }
+  out+=ar[x];
+  if(x<3){
+   if(v<0)parenth(v);
+   out+=oper.charAt(op[x]);
+  }
+  ++x;
+ }
+ parenth(-p);
+ say(out);
+}
+
+function solve24(s){
+ var z=4,r;
+ while(z--)ar[z]=s.charCodeAt(z)-48;
+ out="";
+ for(z=100000;z--;){
+  r=rnd(256);
+  op[0]=r&3;
+  op[1]=(r>>2)&3;
+  op[2]=(r>>4)&3;
+  shuffle("ar",4);
+  shuffle("order",3);
+  if(calc()!=24)continue;
+  showsolution();
+  break;
+ }
+}
+
+solve24("1234");
+solve24("6789");
+solve24("1127");

Task/24-game-Solve/Liberty-BASIC/24-game-solve.liberty

@@ -0,0 +1,123 @@
+dim d(4)
+input "Enter 4 digits: "; a$
+nD=0
+for i =1 to len(a$)
+    c$=mid$(a$,i,1)
+    if instr("123456789",c$) then
+        nD=nD+1
+        d(nD)=val(c$)
+    end if
+next
+'for i = 1 to 4
+'    print d(i);
+'next
+
+'precompute permutations. Dumb way.
+nPerm = 1*2*3*4
+dim perm(nPerm, 4)
+n = 0
+for i = 1 to 4
+    for j = 1 to 4
+        for k = 1 to 4
+            for l = 1 to 4
+            'valid permutation (no dupes?)
+                if i<>j and i<>k and i<>l _
+                    and j<>k and j<>l _
+                        and k<>l then
+                    n=n+1
+                    '
+'                    perm(n,1)=i
+'                    perm(n,2)=j
+'                    perm(n,3)=k
+'                    perm(n,4)=l
+                    'actually, we can as well permute given digits
+                    perm(n,1)=d(i)
+                    perm(n,2)=d(j)
+                    perm(n,3)=d(k)
+                    perm(n,4)=d(l)
+                end if
+            next
+        next
+    next
+next
+'check if permutations look OK. They are
+'for i =1 to n
+'    print i,
+'    for j =1 to 4: print perm(i,j);:next
+'    print
+'next
+
+'possible brackets
+NBrackets = 11
+dim Brakets$(NBrackets)
+DATA "4#4#4#4"
+DATA "(4#4)#4#4"
+DATA "4#(4#4)#4"
+DATA "4#4#(4#4)"
+DATA "(4#4)#(4#4)"
+DATA "(4#4#4)#4"
+DATA "4#(4#4#4)"
+DATA "((4#4)#4)#4"
+DATA "(4#(4#4))#4"
+DATA "4#((4#4)#4)"
+DATA "4#(4#(4#4))"
+for i = 1 to NBrackets
+    read Tmpl$: Brakets$(i) = Tmpl$
+next
+
+'operations: full search
+count = 0
+Ops$="+ - * /"
+dim Op$(3)
+For op1=1 to 4
+    Op$(1)=word$(Ops$,op1)
+    For op2=1 to 4
+        Op$(2)=word$(Ops$,op2)
+        For op3=1 to 4
+            Op$(3)=word$(Ops$,op3)
+            'print "*"
+            'substitute all brackets
+            for t = 1 to NBrackets
+                Tmpl$=Brakets$(t)
+                'print , Tmpl$
+                'now, substitute all digits: permutations.
+                for p = 1 to nPerm
+                    res$= ""
+                    nOp=0
+                    nD=0
+                    for i = 1 to len(Tmpl$)
+                        c$ = mid$(Tmpl$, i, 1)
+                        select case c$
+                        case "#"                'operations
+                            nOp = nOp+1
+                            res$ = res$+Op$(nOp)
+                        case "4"                'digits
+                            nD = nOp+1
+                            res$ = res$; perm(p,nD)
+                        case else               'brackets goes here
+                            res$ = res$+ c$
+                        end select
+                    next
+                    'print,, res$
+                    'eval here
+                    if evalWithErrCheck(res$) = 24 then
+                        print "24 = ";res$
+                        end 'comment it out if you want to see all versions
+                    end if
+                    count = count + 1
+                next
+            next
+        Next
+    Next
+next
+
+print "If you see this, probably task cannot be solved with these digits"
+'print count
+end
+
+function evalWithErrCheck(expr$)
+    on error goto [handler]
+    evalWithErrCheck=eval(expr$)
+    exit function
+[handler]
+end function

Task/24-game-Solve/Lua/24-game-solve.lua

@@ -0,0 +1,74 @@
+local SIZE = #arg[1]
+local GOAL = tonumber(arg[2]) or 24
+
+local input = {}
+for v in arg[1]:gmatch("%d") do
+	table.insert(input, v)
+end
+assert(#input == SIZE, 'Invalid input')
+
+local operations = {'+', '-', '*', '/'}
+
+local function BinaryTrees(vert)
+	if vert == 0 then
+		return {false}
+	else
+		local buf = {}
+		for leften = 0, vert - 1 do
+			local righten = vert - leften - 1
+			for _, left in pairs(BinaryTrees(leften)) do
+				for _, right in pairs(BinaryTrees(righten)) do
+					table.insert(buf, {left, right})
+				end
+			end
+		end
+		return buf
+	end
+end
+local trees = BinaryTrees(SIZE-1)
+local c, opc, oper, str
+local max = math.pow(#operations, SIZE-1)
+local function op(a,b)
+	opc = opc + 1
+	local i = math.floor(oper/math.pow(#operations, opc-1))%#operations+1
+	return '('.. a .. operations[i] .. b ..')'
+end
+
+local function EvalTree(tree)
+	if tree == false then
+		c = c + 1
+		return input[c-1]
+	else
+		return op(EvalTree(tree[1]), EvalTree(tree[2]))
+	end
+end
+
+local function printResult()
+	for _, v in ipairs(trees) do
+		for i = 0, max do
+			c, opc, oper = 1, 0, i
+			str = EvalTree(v)
+			loadstring('res='..str)()
+			if(res == GOAL) then print(str, '=', res) end
+		end
+	end
+end
+
+local uniq = {}
+local function permgen (a, n)
+	if n == 0 then
+		local str = table.concat(a)
+		if not uniq[str] then
+			printResult()
+			uniq[str] = true
+		end
+	else
+		for i = 1, n do
+			a[n], a[i] = a[i], a[n]
+			permgen(a, n - 1)
+			a[n], a[i] = a[i], a[n]
+		end
+	end
+end
+
+permgen(input, SIZE)

Task/24-game-Solve/Mathematica/24-game-solve-1.mathematica

@@ -0,0 +1,16 @@
+treeR[n_] := Table[o[trees[a], trees[n - a]], {a, 1, n - 1}]
+treeR[1] := n
+tree[n_] :=
+ Flatten[treeR[n] //. {o[a_List, b_] :> (o[#, b] & /@ a),
+    o[a_, b_List] :> (o[a, #] & /@ b)}]
+game24play[val_List] :=
+ Union[StringReplace[StringTake[ToString[#, InputForm], {10, -2}],
+     "-1*" ~~ n_ :> "-" <> n] & /@ (HoldForm /@
+      Select[Union@
+        Flatten[Outer[# /. {o[q_Integer] :> #2[[q]],
+             n[q_] :> #3[[q]]} &,
+          Block[{O = 1, N = 1}, # /. {o :> o[O++], n :> n[N++]}] & /@
+           tree[4], Tuples[{Plus, Subtract, Times, Divide}, 3],
+          Permutations[Array[v, 4]], 1]],
+       Quiet[(# /. v[q_] :> val[[q]]) == 24] &] /.
+     Table[v[q] -> val[[q]], {q, 4}])]

Task/24-game-Solve/Mathematica/24-game-solve-2.mathematica

@@ -0,0 +1 @@
+game24play[RandomInteger[{1, 9}, 4]]

Task/24-game-Solve/Perl/24-game-solve.pl

@@ -0,0 +1,54 @@
+# Fischer-Krause ordered permutation generator
+# http://faq.perl.org/perlfaq4.html#How_do_I_permute_N_e
+sub permute (&@) {
+		my $code = shift;
+		my @idx = 0..$#_;
+		while ( $code->(@_[@idx]) ) {
+			my $p = $#idx;
+			--$p while $idx[$p-1] > $idx[$p];
+			my $q = $p or return;
+			push @idx, reverse splice @idx, $p;
+			++$q while $idx[$p-1] > $idx[$q];
+			@idx[$p-1,$q]=@idx[$q,$p-1];
+		}
+	}
+
+@formats = (
+	'((%d %s %d) %s %d) %s %d',
+	'(%d %s (%d %s %d)) %s %d',
+	'(%d %s %d) %s (%d %s %d)',
+	'%d %s ((%d %s %d) %s %d)',
+	'%d %s (%d %s (%d %s %d))',
+	);
+
+# generate all possible combinations of operators
+@op = qw( + - * / );
+@operators = map{ $a=$_; map{ $b=$_; map{ "$a $b $_" }@op }@op }@op;
+
+while(1)
+{
+	print "Enter four integers or 'q' to exit: ";
+	chomp($ent = <>);
+	last if $ent eq 'q';
+
+	
+	if($ent !~ /^[1-9] [1-9] [1-9] [1-9]$/){ print "invalid input\n"; next }
+
+	@n = split / /,$ent;
+	permute { push @numbers,join ' ',@_ }@n;
+
+	for $format (@formats)
+	{
+		for(@numbers)
+		{
+			@n = split;
+			for(@operators)
+			{
+				@o = split;
+				$str = sprintf $format,$n[0],$o[0],$n[1],$o[1],$n[2],$o[2],$n[3];
+				$r = eval($str);
+				print "$str\n" if $r == 24;
+			}
+		}
+	}
+}

Task/24-game-Solve/PicoLisp/24-game-solve.l

@@ -0,0 +1,18 @@
+(be play24 (@Lst @Expr)                # Define Pilog rule
+   (permute @Lst (@A @B @C @D))
+   (member @Op1 (+ - * /))
+   (member @Op2 (+ - * /))
+   (member @Op3 (+ - * /))
+   (or
+      ((equal @Expr (@Op1 (@Op2 @A @B) (@Op3 @C @D))))
+      ((equal @Expr (@Op1 @A (@Op2 @B (@Op3 @C @D))))) )
+   (@ = 24 (catch '("Div/0") (eval (-> @Expr)))) )
+
+(de play24 (A B C D)                   # Define PicoLisp function
+   (pilog
+      (quote
+         @L (list A B C D)
+         (play24 @L @X) )
+      (println @X) ) )
+
+(play24 5 6 7 8)                       # Call 'play24' function

Task/24-game-Solve/Prolog/24-game-solve.pro

@@ -0,0 +1,91 @@
+play24(Len, Range, Goal) :-
+	game(Len, Range, Goal, L, S),
+	maplist(my_write, L),
+	format(': ~w~n', [S]).
+
+game(Len, Range, Value, L, S) :-
+	length(L, Len),
+	maplist(choose(Range), L),
+	compute(L, Value, [], S).
+
+
+choose(Range, V) :-
+	V is random(Range) + 1.
+
+
+write_tree([M], [M]).
+
+write_tree([+, M, N], S) :-
+	write_tree(M, MS),
+	write_tree(N, NS),
+	append(MS, [+ | NS], S).
+
+write_tree([-, M, N], S) :-
+	write_tree(M, MS),
+	write_tree(N, NS),
+	(   is_add(N) -> append(MS, [-, '(' | NS], Temp), append(Temp, ')', S)
+	;   append(MS, [- | NS], S)).
+
+
+write_tree([Op, M, N], S) :-
+	member(Op, [*, /]),
+	write_tree(M, MS),
+	write_tree(N, NS),
+	(   is_add(M) -> append(['(' | MS], [')'], TempM)
+	;  TempM = MS),
+	(   is_add(N) -> append(['(' | NS], [')'], TempN)
+	;   TempN = NS),
+	append(TempM, [Op | TempN], S).
+
+is_add([Op, _, _]) :-
+	member(Op, [+, -]).
+
+compute([Value], Value, [[_R-S1]], S) :-
+	write_tree(S1, S2),
+	with_output_to(atom(S), maplist(write, S2)).
+
+compute(L, Value, CS, S) :-
+	select(M, L, L1),
+	select(N, L1, L2),
+	next_value(M, N, R, CS, Expr),
+	compute([R|L2], Value, Expr, S).
+
+next_value(M, N, R, CS,[[R - [+, M1, N1]] | CS2]) :-
+	R is M+N,
+	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
+	;   M1 = [M], CS1 = CS
+	),
+	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
+	;   N1 = [N], CS2 = CS1
+	).
+
+next_value(M, N, R, CS,[[R - [-, M1, N1]] | CS2]) :-
+	R is M-N,
+	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
+	;   M1 = [M], CS1 = CS
+	),
+	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
+	;   N1 = [N], CS2 = CS1
+	).
+
+next_value(M, N, R, CS,[[R - [*, M1, N1]] | CS2]) :-
+	R is M*N,
+	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
+	;   M1 = [M], CS1 = CS
+	),
+	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
+	;   N1 = [N], CS2 = CS1
+	).
+
+next_value(M, N, R, CS,[[R - [/, M1, N1]] | CS2]) :-
+	N \= 0,
+	R is rdiv(M,N),
+	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
+	;   M1 = [M], CS1 = CS
+	),
+	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
+	;   N1 = [N], CS2 = CS1
+	).
+
+my_write(V) :-
+	format('~w ', [V]).

Task/24-game-Solve/Python/24-game-solve.py

@@ -0,0 +1,159 @@
+'''
+ The 24 Game Player
+
+ Given any four digits in the range 1 to 9, which may have repetitions,
+ Using just the +, -, *, and / operators; and the possible use of
+ brackets, (), show how to make an answer of 24.
+
+ An answer of "q"  will quit the game.
+ An answer of "!"  will generate a new set of four digits.
+ An answer of "!!" will ask you for a new set of four digits.
+ An answer of "?"  will compute an expression for the current digits.
+
+ Otherwise you are repeatedly asked for an expression until it evaluates to 24
+
+ Note: you cannot form multiple digit numbers from the supplied digits,
+ so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed.
+
+'''
+
+from   __future__ import division, print_function
+from   itertools  import permutations, combinations, product, \
+                         chain
+from   pprint     import pprint as pp
+from   fractions  import Fraction as F
+import random, ast, re
+import sys
+
+if sys.version_info[0] < 3:
+    input = raw_input
+    from itertools import izip_longest as zip_longest
+else:
+    from itertools import zip_longest
+
+
+def choose4():
+    'four random digits >0 as characters'
+    return [str(random.randint(1,9)) for i in range(4)]
+
+def ask4():
+    'get four random digits >0 from the player'
+    digits = ''
+    while len(digits) != 4 or not all(d in '123456789' for d in digits):
+        digits = input('Enter the digits to solve for: ')
+        digits = ''.join(digits.strip().split())
+    return list(digits)
+
+def welcome(digits):
+    print (__doc__)
+    print ("Your four digits: " + ' '.join(digits))
+
+def check(answer, digits):
+    allowed = set('() +-*/\t'+''.join(digits))
+    ok = all(ch in allowed for ch in answer) and \
+         all(digits.count(dig) == answer.count(dig) for dig in set(digits)) \
+         and not re.search('\d\d', answer)
+    if ok:
+        try:
+            ast.parse(answer)
+        except:
+            ok = False
+    return ok
+
+def solve(digits):
+    """\
+    >>> for digits in '3246 4788 1111 123456 1127 3838'.split():
+            solve(list(digits))
+
+
+    Solution found: 2 + 3 * 6 + 4
+    '2 + 3 * 6 + 4'
+    Solution found: ( 4 + 7 - 8 ) * 8
+    '( 4 + 7 - 8 ) * 8'
+    No solution found for: 1 1 1 1
+    '!'
+    Solution found: 1 + 2 + 3 * ( 4 + 5 ) - 6
+    '1 + 2 + 3 * ( 4 + 5 ) - 6'
+    Solution found: ( 1 + 2 ) * ( 1 + 7 )
+    '( 1 + 2 ) * ( 1 + 7 )'
+    Solution found: 8 / ( 3 - 8 / 3 )
+    '8 / ( 3 - 8 / 3 )'
+    >>> """
+    digilen = len(digits)
+    # length of an exp without brackets
+    exprlen = 2 * digilen - 1
+    # permute all the digits
+    digiperm = sorted(set(permutations(digits)))
+    # All the possible operator combinations
+    opcomb   = list(product('+-*/', repeat=digilen-1))
+    # All the bracket insertion points:
+    brackets = ( [()] + [(x,y)
+                         for x in range(0, exprlen, 2)
+                         for y in range(x+4, exprlen+2, 2)
+                         if (x,y) != (0,exprlen+1)]
+                 + [(0, 3+1, 4+2, 7+3)] ) # double brackets case
+    for d in digiperm:
+        for ops in opcomb:
+            if '/' in ops:
+                d2 = [('F(%s)' % i) for i in d] # Use Fractions for accuracy
+            else:
+                d2 = d
+            ex = list(chain.from_iterable(zip_longest(d2, ops, fillvalue='')))
+            for b in brackets:
+                exp = ex[::]
+                for insertpoint, bracket in zip(b, '()'*(len(b)//2)):
+                    exp.insert(insertpoint, bracket)
+                txt = ''.join(exp)
+                try:
+                    num = eval(txt)
+                except ZeroDivisionError:
+                    continue
+                if num == 24:
+                    if '/' in ops:
+                        exp = [ (term if not term.startswith('F(') else term[2])
+                               for term in exp ]
+                    ans = ' '.join(exp).rstrip()
+                    print ("Solution found:",ans)
+                    return ans
+    print ("No solution found for:", ' '.join(digits))
+    return '!'
+
+def main():
+    digits = choose4()
+    welcome(digits)
+    trial = 0
+    answer = ''
+    chk = ans = False
+    while not (chk and ans == 24):
+        trial +=1
+        answer = input("Expression %i: " % trial)
+        chk = check(answer, digits)
+        if answer == '?':
+            solve(digits)
+            answer = '!'
+        if answer.lower() == 'q':
+            break
+        if answer == '!':
+            digits = choose4()
+            trial = 0
+            print ("\nNew digits:", ' '.join(digits))
+            continue
+        if answer == '!!':
+            digits = ask4()
+            trial = 0
+            print ("\nNew digits:", ' '.join(digits))
+            continue
+        if not chk:
+            print ("The input '%s' was wonky!" % answer)
+        else:
+            if '/' in answer:
+                # Use Fractions for accuracy in divisions
+                answer = ''.join( (('F(%s)' % char) if char in '123456789' else char)
+                                  for char in answer )
+            ans = eval(answer)
+            print (" = ", ans)
+            if ans == 24:
+                print ("Thats right!")
+    print ("Thank you and goodbye")
+
+main()

Task/24-game-Solve/R/24-game-solve-1.r

@@ -0,0 +1,34 @@
+library(gtools)
+
+solve24 <- function(vals=c(8, 4, 2, 1),
+                    goal=24,
+                    ops=c("+", "-", "*", "/")) {
+
+  val.perms <- as.data.frame(t(
+                  permutations(length(vals), length(vals))))
+
+  nop <- length(vals)-1
+  op.perms <- as.data.frame(t(
+                  do.call(expand.grid,
+                          replicate(nop, list(ops)))))
+
+  ord.perms <- as.data.frame(t(
+                   do.call(expand.grid,
+                           replicate(n <- nop, 1:((n <<- n-1)+1)))))
+
+  for (val.perm in val.perms)
+    for (op.perm in op.perms)
+      for (ord.perm in ord.perms)
+        {
+          expr <- as.list(vals[val.perm])
+          for (i in 1:nop) {
+            expr[[ ord.perm[i] ]] <- call(as.character(op.perm[i]),
+                                          expr[[ ord.perm[i]   ]],
+                                          expr[[ ord.perm[i]+1 ]])
+            expr <- expr[ -(ord.perm[i]+1) ]
+          }
+          if (identical(eval(expr[[1]]), goal)) return(expr[[1]])
+        }
+
+  return(NA)
+}

Task/24-game-Solve/R/24-game-solve-2.r

@@ -0,0 +1,12 @@
+> solve24()
+8 * (4 - 2 + 1)
+> solve24(c(6,7,9,5))
+6 + (7 - 5) * 9
+> solve24(c(8,8,8,8))
+[1] NA
+> solve24(goal=49) #different goal value
+8 * (4 + 2) + 1
+> solve24(goal=52) #no solution
+[1] NA
+> solve24(ops=c('-', '/')) #restricted set of operators
+(8 - 2)/(1/4)

Task/24-game-Solve/REXX/24-game-solve.rexx

@@ -0,0 +1,99 @@
+/*REXX program to help the user find solutions to the game of  24.      */
+/* ┌──────────────────────────────────────────────────────────────────┐
+   │ Argument is either of two forms:     ssss    ==or==   ssss-ffff  │
+   │                                                                  │
+   │ where one or both strings must be exactly four numerals (digits) │
+   │ comprised soley of the numerals (digits)  1 ──> 9   (no zeroes). │
+   │                                                                  │
+   │ In    SSSS-FFFF           SSSS  is the start,                    │
+   │                           FFFF  is the start.                    │
+   └──────────────────────────────────────────────────────────────────┘ */
+parse arg orig                   /*get the  guess  from the argument.   */
+parse var orig start '-' finish  /*get the start and finish  (maybe).   */
+start=space(start,0)             /*remove any blanks from the  START.   */
+finish=space(finish,0)           /*remove any blanks from the  FINISH.  */
+finish=word(finish start,1)      /*if no  FINISH  specified, use  START.*/
+digs=123456789                   /*numerals (digits) that can be used.  */
+call validate start
+call validate finish
+opers='+-*/'                     /*define the legal arithmetic operators*/
+ops=length(opers)                /* ... and the count of them (length). */
+         do j=1 for ops          /*define a version for fast execution. */
+         o.j=substr(opers,j,1)
+         end   /*j*/
+finds=0                          /*number of found solutions (so far).  */
+x.=0                             /*a method to hold unique expressions. */
+indent=left('',30)               /*used to indent display of solutions. */
+                                 /*alternative:  indent=copies(' ',30)  */
+Lpar='('                         /*a string to make REXX code prettier. */
+Rpar=')'                         /*ditto.                               */
+
+  do g=start to finish           /*process a (possible) range of values.*/
+  if pos(0,g)\==0 then iterate   /*ignore values with zero in them.     */
+
+          do _=1 for 4           /*define versions for faster execution.*/
+          g._=substr(g,_,1)
+          end   /*_*/
+
+    do i=1     for ops           /*insert an operator after 1st number. */
+      do j=1   for ops           /*insert an operator after 2nd number. */
+        do k=1 for ops           /*insert an operator after 2nd number. */
+          do m=0 to 3;  L.=      /*assume no left parenthesis so far.   */
+            do n=m+1 to 4        /*match left paren with a right paren. */
+            L.m=Lpar             /*define a left paren, m=0 means ignore*/
+            R.=""                /*un-define all right parenthesis.     */
+            if m==1 & n==2 then L.=""       /*special case:  (n)+ ...   */
+                           else if m\==0 then R.n=Rpar      /*no (, no )*/
+            e= L.1  g.1  o.i  L.2  g.2  o.j  L.3  g.3  R.3  o.k  g.4  R.4
+            e=space(e,0)         /*remove all blanks from the expression*/
+
+                                 /*(below) change expression:           */
+                                 /*       /(yyy)   ===>   /div(yyy)     */
+                                 /*Enables to check for division by zero*/
+            origE=e              /*keep old version for the display.    */
+            if pos('/(',e)\==0 then e=changestr('/(',e,"/div(")
+                                 /*The above could be replaced by:      */
+                                 /*   e=changestr('/(',e,"/div(")       */
+
+                                 /*INTERPRET stresses REXX's groin, so  */
+                                 /* try to avoid repeated heavy lifting.*/
+            if x.e then iterate  /*was the expression already used?     */
+            x.e=1                /*mark this expression as unique.      */
+                                 /*have REXX do the heavy lifting (ugh).*/
+            interpret 'x=' e     /*... strain...                        */
+            x=x/1                /*remove trailing decimal points(maybe)*/
+            if x\==24 then iterate        /*Not correct?  Try again.    */
+            finds=finds+1        /*bump number of found solutions.      */
+            _=translate(origE, '][', ")(")     /*show  [],  not  ().    */
+            say indent 'a solution:' _         /*display a solution.    */
+            end   /*n*/
+          end     /*m*/
+        end       /*k*/
+      end         /*j*/
+    end           /*i*/
+  end             /*g*/
+
+sols=finds
+if sols==0 then sols='No'        /*make the sentence not so geek-like.  */
+say;   say sols 'unique solution's(finds) "found for" orig  /*pluralize.*/
+exit
+/*───────────────────────────DIV subroutine─────────────────────────────*/
+div: procedure;   parse arg q    /*tests if dividing by  0  (zero).     */
+if q=0 then q=1e9                /*if dividing by zero, change divisor. */
+return q                         /*changing Q invalidates the expression*/
+/*───────────────────────────GER subroutine─────────────────────────────*/
+ger:  say;     say '*** error! ***';     if _\=='' then say 'guess=' _
+say arg(1);     say;      exit 13
+/*───────────────────────────S subroutine───────────────────────────────*/
+s: if arg(1)==1 then return '';   return 's'        /*simple pluralizer.*/
+/*───────────────────────────validate subroutine────────────────────────*/
+validate: parse arg y;   errCode=0;   _v=verify(y,digs)
+    select
+    when y==''        then call ger 'no digits entered.'
+    when length(y)<4  then call ger 'not enough digits entered, must be 4'
+    when length(y)>4  then call ger 'too many digits entered, must be 4'
+    when pos(0,y)\==0 then call ger "can't use the digit  0 (zero)"
+    when _v\==0       then call ger 'illegal character:' substr(y,_v,1)
+    otherwise nop
+    end    /*select*/
+return \errCode

Task/24-game-Solve/Ruby/24-game-solve.rb

@@ -0,0 +1,57 @@
+require 'rational'
+
+class TwentyFourGamePlayer
+  EXPRESSIONS = [
+    '((%d %s %d) %s %d) %s %d',
+    '(%d %s (%d %s %d)) %s %d',
+    '(%d %s %d) %s (%d %s %d)',
+    '%d %s ((%d %s %d) %s %d)',
+    '%d %s (%d %s (%d %s %d))',
+  ]
+  OPERATORS = [:+, :-, :*, :/]
+
+  @@objective = Rational(24,1)
+
+  def initialize(digits)
+    @digits = digits
+    @solutions = []
+    solve
+  end
+
+  attr_reader :digits, :solutions
+
+  def solve
+    digits.permutation.to_a.uniq.each do |a,b,c,d|
+      OPERATORS.each   do |op1|
+      OPERATORS.each   do |op2|
+      OPERATORS.each   do |op3|
+      EXPRESSIONS.each do |expr|
+        # evaluate using rational arithmetic
+        test = expr.gsub('%d', 'Rational(%d,1)') % [a, op1, b, op2, c, op3, d]
+        value = eval(test) rescue -1  # catch division by zero
+        if value == @@objective
+          @solutions << expr % [a, op1, b, op2, c, op3, d]
+        end
+      end;end;end;end
+    end
+  end
+
+end
+
+# validate user input
+digits = ARGV.map do |arg|
+  begin
+    Integer(arg)
+  rescue ArgumentError
+    raise "error: not an integer: '#{arg}'"
+  end
+end
+digits.size == 4 or raise "error: need 4 digits, only have #{digits.size}"
+
+player = TwentyFourGamePlayer.new(digits)
+if player.solutions.empty?
+  puts "no solutions"
+else
+  puts "found #{player.solutions.size} solutions, including #{player.solutions.first}"
+  puts player.solutions.sort.join("\n")
+end

Task/24-game-Solve/Scala/24-game-solve.scala

@@ -0,0 +1,25 @@
+def permute(l: List[Double]): List[List[Double]] = l match {
+  case Nil => List(Nil)
+  case x :: xs =>
+    for {
+      ys <- permute(xs)
+      position <- 0 to ys.length
+      (left, right) = ys splitAt position
+    } yield left ::: (x :: right)
+}
+
+def computeAllOperations(l: List[Double]): List[(Double,String)] = l match {
+  case Nil => Nil
+  case x :: Nil => List((x, "%1.0f" format x))
+  case x :: xs =>
+    for {
+      (y, ops) <- computeAllOperations(xs)
+      (z, op) <-
+        if (y == 0)
+          List((x*y, "*"), (x+y, "+"), (x-y, "-"))
+        else
+          List((x*y, "*"), (x/y, "/"), (x+y, "+"), (x-y, "-"))
+    } yield (z, "(%1.0f%s%s)" format (x,op,ops))
+}
+
+def hasSolution(l: List[Double]) = permute(l) flatMap computeAllOperations filter (_._1 == 24) map (_._2)

Task/24-game-Solve/Tcl/24-game-solve.tcl

@@ -0,0 +1,62 @@
+package require struct::list
+# Encoding the various expression trees that are possible
+set patterns {
+    {((A x B) y C) z D}
+    {(A x (B y C)) z D}
+    {(A x B) y (C z D)}
+    {A x ((B y C) z D)}
+    {A x (B y (C z D))}
+}
+# Encoding the various permutations of digits
+set permutations [struct::list map [struct::list permutations {a b c d}] \
+        {apply {v {lassign $v a b c d; list A $a B $b C $c D $d}}}]
+# The permitted operations
+set operations {+ - * /}
+
+# Given a list of four integers (precondition not checked!) return a list of
+# solutions to the 24 game using those four integers.
+proc find24GameSolutions {values} {
+    global operations patterns permutations
+    set found {}
+    # For each possible structure with numbers at the leaves...
+    foreach pattern $patterns {
+	foreach permutation $permutations {
+	    set p [string map [subst {
+		a [lindex $values 0].0
+		b [lindex $values 1].0
+		c [lindex $values 2].0
+		d [lindex $values 3].0
+	    }] [string map $permutation $pattern]]
+
+            # For each possible structure with operators at the branches...
+	    foreach x $operations {
+		foreach y $operations {
+		    foreach z $operations {
+			set e [string map [subst {x $x y $y z $z}] $p]
+
+			# Try to evaluate (div-zero is an issue!) and add it to
+			# the result if it is 24
+			catch {
+			    if {[expr $e] == 24.0} {
+				lappend found [string map {.0 {}} $e]
+			    }
+			}
+		    }
+		}
+	    }
+	}
+    }
+    return $found
+}
+
+# Wrap the solution finder into a player
+proc print24GameSolutionFor {values} {
+    set found [lsort -unique [find24GameSolutions $values]]
+    if {![llength $found]} {
+	puts "No solution possible"
+    } else {
+	puts "Total [llength $found] solutions (may include logical duplicates)"
+        puts "First solution: [lindex $found 0]"
+    }
+}
+print24GameSolutionFor $argv