24 game

From Rosetta Code
Revision as of 00:59, 10 November 2013 by rosettacode>PKai (Added F# version)
Task
24 game
You are encouraged to solve this task according to the task description, using any language you may know.

The 24 Game tests one's mental arithmetic.

Write a program that randomly chooses and displays four digits, each from one to nine, with repetitions allowed. The program should prompt for the player to enter an equation using just those, and all of those four digits. The program should check then evaluate the expression. The goal is for the player to enter an expression that evaluates to 24.

  • Only multiplication, division, addition, and subtraction operators/functions are allowed.
  • Division should use floating point or rational arithmetic, etc, to preserve remainders.
  • Brackets are allowed, if using an infix expression evaluator.
  • Forming multiple digit numbers from the supplied digits is disallowed. (So an answer of 12+12 when given 1, 2, 2, and 1 is wrong).
  • The order of the digits when given does not have to be preserved.

Note:

  • The type of expression evaluator used is not mandated. An RPN evaluator is equally acceptable for example.
  • The task is not for the program to generate the expression, or test whether an expression is even possible.

C.f: 24 game Player

Reference

  1. The 24 Game on h2g2.

ABAP

See 24 game/ABAP

Ada

game24.adb: <lang Ada>with Ada.Text_IO; with Ada.Numerics.Discrete_Random; procedure Game_24 is

  subtype Operation is Character;
  type Op_Array is array (Positive range <>) of Operation;
  type Digit is range 1 .. 9;
  type Digit_Array is array (Positive range <>) of Digit;
  package Digit_IO is new Ada.Text_IO.Integer_IO (Digit);
  package Random_Digit is new Ada.Numerics.Discrete_Random (Digit);
  Digit_Generator : Random_Digit.Generator;
  Given_Digits : array (1 .. 4) of Digit;

begin

  Ada.Text_IO.Put_Line ("24 Game");
  Ada.Text_IO.Put_Line ("Generating 4 digits...");
  Random_Digit.Reset (Digit_Generator);
  for I in Given_Digits'Range loop
     Given_Digits (I) := Random_Digit.Random (Digit_Generator);
  end loop;
  Ada.Text_IO.Put ("Your Digits:");
  for I in Given_Digits'Range loop
     Digit_IO.Put (Given_Digits (I));
  end loop;
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put ("Enter your Expression: ");
  declare
     Value : Integer;
     Input_Operations : Op_Array (1 .. 3);
     Input_Digits : Digit_Array (1 .. 4);
     Unused_Digits : array (Given_Digits'Range) of Boolean :=
       (others => True);
  begin
     -- get input
     for I in 1 .. 4 loop
        Digit_IO.Get (Input_Digits (I));
        exit when I = 4;
        Ada.Text_IO.Get (Input_Operations (I));
     end loop;
     -- check input
     for I in Input_Digits'Range loop
        declare
           Found : Boolean := False;
        begin
           for J in Given_Digits'Range loop
              if Unused_Digits (J) and then
                Given_Digits (J) = Input_Digits (I) then
                 Unused_Digits (J) := False;
                 Found := True;
                 exit;
              end if;
           end loop;
           if not Found then
              Ada.Text_IO.Put_Line ("Illegal Number used:" &
                                    Digit'Image (Input_Digits (I)));
              return;
           end if;
        end;
     end loop;
     -- check value
     Value := Integer (Input_Digits (Input_Digits'First));
     for I in Input_Operations'Range loop
        case Input_Operations (I) is
           when '+' =>
              Value := Value + Integer (Input_Digits (I + 1));
           when '-' =>
              Value := Value - Integer (Input_Digits (I + 1));
           when '*' =>
              Value := Value * Integer (Input_Digits (I + 1));
           when '/' =>
              Value := Value / Integer (Input_Digits (I + 1));
           when others =>
              Ada.Text_IO.Put_Line ("Illegal Op used:" &
                                    Input_Operations (I));
              return;
        end case;
     end loop;
     if Value /= 24 then
        Ada.Text_IO.Put_Line ("Value" & Integer'Image (Value) &
                              " is not 24!");
     else
        Ada.Text_IO.Put_Line ("You won!");
     end if;
  end;

end Game_24;</lang>

Output:

24 Game
Generating 4 digits...
Your Digits: 4 9 5 5
Enter your Expression: 4*5+9-5
You won!
24 Game
Generating 4 digits...
Your Digits: 4 1 9 7
Enter your Expression: 4*9-7+1
Value 30 is not 24!

Argile

Works with: Argile version 1.0.0

<lang Argile>use std, array, list

do

 generate random digits
 show random digits
 let result = parse expression (get input line)
 if result != ERROR
   if some digits are unused
     print "Wrong ! (you didn't use all digits)" ; failure++
   else if result == 24.0
     print "Correct !" ; success++
   else
     print "Wrong ! (you got "result")" ; failure++
while play again ?

print "success:"success" failure:"failure" total:"(success+failure) as int

let success = 0, failure = 0.

.: generate random digits :.

  our nat seed = 0xc6f31 (: default seed when /dev/urandom doesn't exist :)
  let urandom = fopen "/dev/urandom" "r"
  if  urandom isn't nil
    fread &seed size of seed 1 urandom
    fclose urandom
  Cfunc srandom seed
  seed = (Cfunc random) as nat
  for each (val int d) from 0 to 3
    digits[d] = '1' + (seed % 9)
    seed /= 9

let digits be an array of 4 byte

.: show random digits :.

  print "Enter an expression that equates to 24 using only all these digits:"
  printf "%c , %c , %c , %c\n"(digits[0])(digits[1])(digits[2])(digits[3])
  printf "24 = "

.: some digits are unused :. -> bool

  for each (val int d) from 0 to 3
    return true if digits[d] != '\0'
  false

.: get input line :. -> text

  our array of 64 byte line
  Cfunc fgets (line) (size of line) (stdin)
  let int i
  for (i = 0) (line[i] != 0) (i++)
    line[i] = '\0' if (line[i] == '\n')
  line as text

.: play again ? :. -> bool

  while true
    printf "Play again ? (y/n) " ; Cfunc fflush stdout
    let answer = get input line
    switch answer[0]
      case 'n' {return false}
      case 'y' {return true }
      default  {continue    }
  false

=: ERROR := -> real {-32202.0}

.: parse expression <text expr> :. -> real

  let x = 0.0, x_is_set = false, op = ' '.
  let stack be a list of State ; class State {byte op; real x}
  for (stack = nil) (*expr != 0) (expr++)
    switch *expr
      case '+' ; case '-' ; case '*' ; case '/'
        error "bad syntax" if not x_is_set

op = *expr

      case '1' ; case '2' ; case '3' ; case '4' ; case '5'
      case '6' ; case '7' ; case '8' ; case '9'

error "missing operator" if (x_is_set and op == ' ') error "unavailable digit" unless consume digit expr[0] do operation with (expr[0] - '0') as real

      case (Cgen "'('")

error "missing operator" if (op == ' ' but x_is_set) (new list (new State) (code of del State())) << stack op = ' ' ; x_is_set = false (: start fresh state :)

      case (Cgen "')'")
        error "mismatched parenthesis" if stack is nil

error "wrong syntax" if not x_is_set let y = x x = stack.data.x ; op = stack.data.op delete pop stack do operation with y

      default {error "disallowed character"}
      .:new State          :. -> State {let s=new(State); s.x=x; s.op=op; s}
      .:del State <State s>:.          {               free s              }
      .:do operation with <real y>:.
 	 switch op

case '+' {x += y} case '-' {x -= y} case '*' {x *= y} case '/' {x /= y} default {x = y; x_is_set = true}

        op = ' '
  =:error<text msg>:= ->real {eprint "Error: "msg" at ["expr"]";return ERROR}
  .:consume digit <byte b>:. -> bool
    for each (val int d) from 0 to 3
      if digits[d] == b
        digits[d] = '\0'
      	 return true
    false
  if stack isn't nil
    delete all stack
    error "unclosed parenthesis"
  return x

</lang> compile with: arc 24_game.arg -o 24_game.c && gcc 24_game.c -o 24_game /usr/lib/libargrt.a

AutoHotkey

<lang autohotkey>AutoExecute:

   Title := "24 Game" 
   Gui, -MinimizeBox 
   Gui, Add, Text, w230 vPuzzle 
   Gui, Add, Edit, wp vAnswer 
   Gui, Add, Button, w70, &Generate 
   Gui, Add, Button, x+10 wp Default, &Submit 
   Gui, Add, Button, x+10 wp, E&xit 


ButtonGenerate: ; new set of numbers

   Loop, 4 
       Random, r%A_Index%, 1, 9 
   Puzzle = %r1%, %r2%, %r3%, and %r4% 
   GuiControl,, Puzzle, The numbers are:  %Puzzle%  - Good luck! 
   GuiControl,, Answer ; empty the edit box 
   ControlFocus, Edit1 
   Gui, -Disabled 
   Gui, Show,, %Title% 

Return ; end of auto execute section


ButtonSubmit: ; check solution

   Gui, Submit, NoHide 
   Gui, +Disabled 
   ; check numbers used 
   RegExMatch(Answer, "(\d)\D+(\d)\D+(\d)\D+(\d)", $) 
   ListPuzzle := r1 "," r2 "," r3 "," r4 
   ListAnswer := $1 "," $2 "," $3 "," $4 
   Sort, ListPuzzle, D, 
   Sort, ListAnswer, D, 
   If Not ListPuzzle = ListAnswer { 
       MsgBox, 48, Error - %Title%, Numbers used!`n%Answer% 
       Goto, TryAgain 
   } 
   ; check operators used 
   StringReplace, $, $, +,, All 
   StringReplace, $, $, -,, All 
   StringReplace, $, $, *,, All 
   StringReplace, $, $, /,, All 
   StringReplace, $, $, (,, All 
   StringReplace, $, $, ),, All 
   Loop, 9 
       StringReplace, $, $, %A_Index%,, All 
   If StrLen($) > 0 
   Or InStr(Answer, "**") 
   Or InStr(Answer, "//") 
   Or InStr(Answer, "++") 
   Or InStr(Answer, "--") { 
       MsgBox, 48, Error - %Title%, Operators used!`n%Answer% 
       Goto, TryAgain 
   } 
   ; check result 
   Result := Eval(Answer) 
   If Not Result = 24 { 
       MsgBox, 48, Error - %Title%, Result incorrect!`n%Result% 
       Goto, TryAgain 
   } 
   ; if we are sill here 
   MsgBox, 4, %Title%, Correct solution! Play again? 
   IfMsgBox, Yes 
       Gosub, ButtonGenerate 
   Else 
       ExitApp 

Return


TryAgain: ; alternative ending of routine ButtonSubmit

   ControlFocus, Edit1 
   Gui, -Disabled 
   Gui, Show 

Return


GuiClose: GuiEscape: ButtonExit:

   ExitApp 

Return


---------------------------------------------------------------------------

Eval(Expr) { ; evaluate expression using separate AHK process

---------------------------------------------------------------------------
   ; credit for this function goes to AutoHotkey forum member Laszlo 
   ; http://www.autohotkey.com/forum/topic9578.html 
   ;----------------------------------------------------------------------- 
   static File := "24$Temp.ahk" 
   ; delete old temporary file, and write new 
   FileDelete, %File% 
   FileContent := "#NoTrayIcon`r`n" 
               .  "FileDelete, " File "`r`n" 
               .  "FileAppend, `% " Expr ", " File "`r`n" 
   FileAppend, %FileContent%, %File% 
   ; run AHK to execute temp script, evaluate expression 
   RunWait, %A_AhkPath% %File% 
   ; get result 
   FileRead, Result, %File% 
   FileDelete, %File% 
   Return, Result 

}</lang>

AutoIt

<lang AutoIt>

AutoIt Script Example
by Daniel Barnes
spam me at djbarnes at orcon dot net dot en zed
13/08/2012
Choose four random digits (1-9) with repetitions allowed

global $digits FOR $i = 1 TO 4 $digits &= Random(1,9,1) NEXT

While 1 main() WEnd

Func main() $text = "Enter an equation (using all of, and only, the single digits "&$digits &")"&@CRLF $text &= "which evaluates to exactly 24. Only multiplication (*) division (/)"&@CRLF $text &= "addition (+) and subtraction (-) operations and parentheses are allowed:" $input = InputBox ("24 Game",$text,"","",400,150) If @error Then exit

;remove any spaces in input $input = StringReplace($input," ","")

;check correct characters were used For $i = 1 To StringLen($input) $chr = StringMid($input,$i,1) If Not StringInStr("123456789*/+-()",$chr) Then MsgBox (0, "ERROR","Invalid character used: '"&$chr&"'") return endif Next

;validate the equation uses all of the 4 characters, and nothing else $test = $input $test = StringReplace($test,"(","") $test = StringReplace($test,")","")

;validate the length of the input - if its not 7 characters long then the user has done something wrong If StringLen ($test) <> 7 Then MsgBox (0,"ERROR","The equation "&$test&" is invalid") return endif

$test = StringReplace($test,"/","") $test = StringReplace($test,"*","") $test = StringReplace($test,"-","") $test = StringReplace($test,"+","")

For $i = 1 To StringLen($digits) $digit = StringMid($digits,$i,1) For $ii = 1 To StringLen($test) If StringMid($test,$ii,1) = $digit Then $test = StringLeft($test,$ii-1) & StringRight($test,StringLen($test)-$ii) ExitLoop endif Next Next If $test <> "" Then MsgBox (0, "ERROR", "The equation didn't use all 4 characters, and nothing else!") return endif

$try = Execute($input)

If $try = 24 Then MsgBox (0, "24 Game","Well done. Your equation ("&$input&") = 24!") Exit Else MsgBox (0, "24 Game","Fail. Your equation ("&$input&") = "&$try&"!") return endif EndFunc </lang>

BBC BASIC

<lang bbcbasic> REM Choose four random digits (1-9) with repetitions allowed:

     DIM digits%(4), check%(4)
     FOR choice% = 1 TO 4
       digits%(choice%) = RND(9)
     NEXT choice%
     
     REM Prompt the player:
     PRINT "Enter an equation (using all of, and only, the single digits ";
     FOR index% = 1 TO 4
       PRINT ; digits%(index%) ;
       IF index%<>4 PRINT " " ;
     NEXT
     PRINT ")"
     PRINT "which evaluates to exactly 24.  Only multiplication (*), division (/),"
     PRINT "addition (+) & subtraction (-) operations and parentheses are allowed:"
     INPUT "24 = " equation$
     
     REPEAT
       
       REM Check that the correct digits are used:
       check%() = 0
       FOR char% = 1 TO LEN(equation$)
         digit% = INSTR("0123456789", MID$(equation$, char%, 1)) - 1
         IF digit% >= 0 THEN
           FOR index% = 1 TO 4
             IF digit% = digits%(index%) THEN
               IF NOT check%(index%) check%(index%) = TRUE : EXIT FOR
             ENDIF
           NEXT index%
           IF index% > 4 THEN
             PRINT "Sorry, you used the illegal digit "; digit%
             EXIT REPEAT
           ENDIF
         ENDIF
       NEXT char%
       
       FOR index% = 1 TO 4
         IF NOT check%(index%) THEN
           PRINT "Sorry, you failed to use the digit " ; digits%(index%)
           EXIT REPEAT
         ENDIF
       NEXT index%
       
       REM Check that no pairs of digits are used:
       FOR pair% = 11 TO 99
         IF INSTR(equation$, STR$(pair%)) THEN
           PRINT "Sorry, you may not use a pair of digits "; pair%
           EXIT REPEAT
         ENDIF
       NEXT pair%
       
       REM Check whether the equation evaluates to 24:
       ON ERROR LOCAL PRINT "Sorry, there was an error in the equation" : EXIT REPEAT
       result = EVAL(equation$)
       RESTORE ERROR
       IF result = 24 THEN
         PRINT "Congratulations, you succeeded in the task!"
       ELSE
         PRINT "Sorry, your equation evaluated to " ; result " rather than 24!"
       ENDIF
       
     UNTIL TRUE
     
     INPUT '"Play again", answer$
     IF LEFT$(answer$,1) = "y" OR LEFT$(answer$,1) = "Y" THEN CLS : RUN
     QUIT</lang>

Bracmat

<lang Bracmat> ( 24-game

 =     m-w m-z 4numbers answer expr numbers
     , seed get-random convertBinaryMinusToUnary
     , convertDivisionToMultiplication isExpresssion reciprocal
   .   (seed=.!arg:(~0:~/#?m-w.~0:~/#?m-z))
     & seed$!arg
     & ( get-random
       =   
         .   36969*mod$(!m-z.65536)+div$(!m-z.65536):?m-z
           & 18000*mod$(!m-w.65536)+div$(!m-w.65536):?m-w
           & mod$(!m-z*65536+!m-w.9)+1
       )
     & ( convertBinaryMinusToUnary
       =   a z
         .     @(!arg:%?a "-" ?z)
             & str$(!a "+-1*" convertBinaryMinusToUnary$!z)
           | !arg
       )
     & (reciprocal=.!arg^-1)
     & ( convertDivisionToMultiplication
       =   a z
         .     @(!arg:?a "/" ?z)
             & str$(!a "*reciprocal$" convertDivisionToMultiplication$!z)
           | !arg
       )
     & ( isExpresssion
       =   A Z expr
         .   @( !arg
              :   ?A
                  ("+"|"-"|"*"|"/")
                  ( ?Z
                  & isExpresssion$!A
                  & isExpresssion$!Z
                  )
              )
           |   !numbers:?A !arg ?Z
             & !A !Z:?numbers
           |   ( @(!arg:"(" ?expr ")")
               | @(!arg:(" "|\t) ?expr)
               | @(!arg:?expr (" "|\t))
               )
             & isExpresssion$!expr
       )
     &   out
       $ "Enter an expression that evaluates to 24 by combining the following numbers."
     & out$"You may only use the operators + - * /"
     & out$"Parentheses and spaces are allowed."
     &   whl
       ' (   get-random$() get-random$() get-random$() get-random$
           : ?4numbers
         & out$!4numbers
         &   whl
           ' ( get'(,STR):?expr:~
             & !4numbers:?numbers
             & ~(isExpresssion$!expr&!numbers:)
             &   out
               $ ( str
                 $ ( "["
                     !expr
                     "] is not a valid expression. Try another expression."
                   )
                 )
             )
         & !expr:~
         & convertBinaryMinusToUnary$!expr:?expr
         & convertDivisionToMultiplication$!expr:?expr
         & get$(!expr,MEM):?answer
         & out$(str$(!expr " = " !answer))
         &   !answer
           : ( 24&out$Right!
             | #&out$Wrong!
             )
         & out$"Try another one:"
         )
     & out$bye
 )

& 24-game$(13.14) & ;</lang>

Enter an expression that evaluates to 24 by combining the following numbers.
You may only use the operators + - * /
Parentheses and spaces are allowed.
4 2 2 7
4*7 - 2-2
4*7 +-1* 2+-1*2 = 24
Right!
Try another one:
4 7 9 8
((4) *(8 - (9- 7))
[((4) *(8 - (9- 7))] is not a valid expression. Try another expression.
((4) *(8 - (9- 7)))
((4) *(8 +-1* (9+-1* 7))) = 24
Right!
Try another one:
9 5 8 5
5 * 5 - (9 - 8)
5 * 5 +-1* (9 +-1* 8) = 24
Right!
Try another one:
5 9 7 8
5*8 - 9 - 7
5*8 +-1* 9 +-1* 7 = 24
Right!
Try another one:
7 8 6 2
8 * ((7 - 6) + 2)
8 * ((7 +-1* 6) + 2) = 24
Right!
Try another one:
8 6 8 1
8 * (1 + 8 - 6)
8 * (1 + 8 +-1* 6) = 24
Right!
Try another one:
8 2 2 4
8 * (2 + 4)/2
8 * (2 + 4)*reciprocal$2 = 24
Right!
Try another one:
8 4 6 7

bye

C

Simple recursive descent parser. It doesn't have a real lexer, because all tokens are single character (digits, operators and parens). Code is a little too long. <lang C>#include <stdio.h>

  1. include <ctype.h>
  2. include <stdlib.h>
  3. include <ucontext.h>

ucontext_t ctx; const char *msg;

enum { OP_NONE = 0, OP_NUM, OP_ADD, OP_SUB, OP_MUL, OP_DIV };

typedef struct expr_t *expr, expr_t; struct expr_t { int op, val, used; expr left, right; };

  1. define N_DIGITS 4

expr_t digits[N_DIGITS];

void gen_digits() { int i; for (i = 0; i < N_DIGITS; i++) digits[i].val = 1 + rand() % 9; }

  1. define MAX_INPUT 64

char str[MAX_INPUT]; int pos;

  1. define POOL_SIZE 8

expr_t pool[POOL_SIZE]; int pool_ptr;

void reset() { int i; msg = 0; pool_ptr = pos = 0; for (i = 0; i < POOL_SIZE; i++) { pool[i].op = OP_NONE; pool[i].left = pool[i].right = 0; } for (i = 0; i < N_DIGITS; i++) digits[i].used = 0; }

/* longish jumpish back to input cycle */ void bail(const char *s) { msg = s; setcontext(&ctx); }

expr new_expr() { if (pool_ptr < POOL_SIZE) return pool + pool_ptr++; return 0; }

/* check next input char */ int next_tok() { while (isspace(str[pos])) pos++; return str[pos]; }

/* move input pointer forward */ int take() { if (str[pos] != '\0') return ++pos; return 0; }

/* BNF(ish) expr = term { ("+")|("-") term } term = fact { ("*")|("/") expr } fact = number | '(' expr ')'

  • /

expr get_fact(); expr get_term(); expr get_expr();

expr get_expr() { int c; expr l, r, ret; if (!(ret = get_term())) bail("Expected term"); while ((c = next_tok()) == '+' || c == '-') { if (!take()) bail("Unexpected end of input"); if (!(r = get_term())) bail("Expected term");

l = ret; ret = new_expr(); ret->op = (c == '+') ? OP_ADD : OP_SUB; ret->left = l; ret->right = r; } return ret; }

expr get_term() { int c; expr l, r, ret; ret = get_fact(); while((c = next_tok()) == '*' || c == '/') { if (!take()) bail("Unexpected end of input");

r = get_fact(); l = ret; ret = new_expr(); ret->op = (c == '*') ? OP_MUL : OP_DIV; ret->left = l; ret->right = r; } return ret; }

expr get_digit() { int i, c = next_tok(); expr ret; if (c >= '0' && c <= '9') { take(); ret = new_expr(); ret->op = OP_NUM; ret->val = c - '0'; for (i = 0; i < N_DIGITS; i++) if (digits[i].val == ret->val && !digits[i].used) { digits[i].used = 1; return ret; } bail("Invalid digit"); } return 0; }

expr get_fact() { int c; expr l = get_digit(); if (l) return l; if ((c = next_tok()) == '(') { take(); l = get_expr(); if (next_tok() != ')') bail("Unbalanced parens"); take(); return l; } return 0; }

expr parse() { int i; expr ret = get_expr(); if (next_tok() != '\0') bail("Trailing garbage"); for (i = 0; i < N_DIGITS; i++) if (!digits[i].used) bail("Not all digits are used"); return ret; }

typedef struct frac_t frac_t, *frac; struct frac_t { int denom, num; };

int gcd(int m, int n) { int t; while (m) { t = m; m = n % m; n = t; } return n; }

/* evaluate expression tree. result in fraction form */ void eval_tree(expr e, frac res) { frac_t l, r; int t; if (e->op == OP_NUM) { res->num = e->val; res->denom = 1; return; }

eval_tree(e->left, &l); eval_tree(e->right, &r);

switch(e->op) { case OP_ADD: res->num = l.num * r.denom + l.denom * r.num; res->denom = l.denom * r.denom; break; case OP_SUB: res->num = l.num * r.denom - l.denom * r.num; res->denom = l.denom * r.denom; break; case OP_MUL: res->num = l.num * r.num; res->denom = l.denom * r.denom; break; case OP_DIV: res->num = l.num * r.denom; res->denom = l.denom * r.num; break; } if ((t = gcd(res->denom, res->num))) { res->denom /= t; res->num /= t; } }

void get_input() { int i; reinput: reset(); printf("\nAvailable digits are:"); for (i = 0; i < N_DIGITS; i++) printf(" %d", digits[i].val); printf(". Type an expression and I'll check it for you, or make new numbers.\n" "Your choice? [Expr/n/q] ");

while (1) { for (i = 0; i < MAX_INPUT; i++) str[i] = '\n'; fgets(str, MAX_INPUT, stdin); if (*str == '\0') goto reinput; if (str[MAX_INPUT - 1] != '\n') bail("string too long");

for (i = 0; i < MAX_INPUT; i++) if (str[i] == '\n') str[i] = '\0'; if (str[0] == 'q') { printf("Bye\n"); exit(0); } if (str[0] == 'n') { gen_digits(); goto reinput; } return; } }

int main() { frac_t f; srand(time(0));

gen_digits(); while(1) { get_input(); getcontext(&ctx); /* if parse error, jump back here with err msg set */ if (msg) { /* after error jump; announce, reset, redo */ printf("%s at '%.*s'\n", msg, pos, str); continue; }

eval_tree(parse(), &f);

if (f.denom == 0) bail("Divide by zero"); if (f.denom == 1 && f.num == 24) printf("You got 24. Very good.\n"); else { if (f.denom == 1) printf("Eval to: %d, ", f.num); else printf("Eval to: %d/%d, ", f.num, f.denom); printf("no good. Try again.\n"); } } return 0;

}</lang>Output

Available digits are: 5 2 3 9. Type an expression and I'll check it for you, or make new numbers.
Your choice? [Expr/n/q] 5*2*3/9
Eval to: 10/3, no good.  Try again.

Available digits are: 5 2 3 9. Type an expression and I'll check it for you, or make new numbers.
Your choice? [Expr/n/q] (5*(2+3)-9
Unbalanced parens at '(5*(2+3)-9'

Available digits are: 5 2 3 9. Type an expression and I'll check it for you, or make new numbers.
Your choice? [Expr/n/q] 3*9-(5-2)
You got 24.  Very good.

Available digits are: 5 2 3 9. Type an expression and I'll check it for you, or make new numbers.
Your choice? [Expr/n/q] n

Available digits are: 4 4 4 7. Type an expression and I'll check it for you, or make new numbers.
Your choice? [Expr/n/q] q
Bye

See 24 game/C

C++

Works with: C++11

This uses the C++11 standard to simplify several parts of the code. Input is given in RPN format.

<lang cpp>#include <random>

  1. include <iostream>
  2. include <stack>
  3. include <set>
  4. include <string>
  5. include <functional>

using namespace std;

class RPNParse { public:

 stack<double> stk;
 multiset<int> digits;
 void op(function<double(double,double)> f)
 {
   if(stk.size() < 2)
     throw "Improperly written expression";
   int b = stk.top(); stk.pop();
   int a = stk.top(); stk.pop();
   stk.push(f(a, b));
 }
 void parse(char c)
 {
   if(c >= '0' && c <= '9')
   {
     stk.push(c - '0');
     digits.insert(c - '0');
   }
   else if(c == '+')
     op([](double a, double b) {return a+b;});
   else if(c == '-')
     op([](double a, double b) {return a-b;});
   else if(c == '*')
     op([](double a, double b) {return a*b;});
   else if(c == '/')
     op([](double a, double b) {return a/b;});
 }
 void parse(string s)
 {
   for(int i = 0; i < s.size(); ++i)
     parse(s[i]);
 }
 double getResult()
 {
   if(stk.size() != 1)
     throw "Improperly written expression";
   return stk.top();
 }

};

int main() {

 random_device seed;
 mt19937 engine(seed());
 uniform_int_distribution<> distribution(1, 9);
 auto rnd = bind(distribution, engine);
 multiset<int> digits;
 cout << "Make 24 with the digits: ";
 for(int i = 0; i < 4; ++i)
 {
   int n = rnd();
   cout << " " << n;
   digits.insert(n);
 }
 cout << endl;
 RPNParse parser;
 try
 {
   string input;
   getline(cin, input);
   parser.parse(input);
   if(digits != parser.digits)
     cout << "Error: Not using the given digits" << endl;
   else
   {
     double r = parser.getResult();
     cout << "Result: " << r << endl;
     if(r > 23.999 && r < 24.001)
       cout << "Good job!" << endl;
     else
       cout << "Try again." << endl;
   }
 }
 catch(char* e)
 {
   cout << "Error: " << e << endl;
 }
 return 0;

}</lang>

Sample output:

Make 24 with the digits:  1 4 9 9
9 9 + 4 * 1 +
Result: 73
Try again.

Make 24 with the digits:  3 9 9 2
9 9 + 3 2 * +
Result: 24
Good job!

C#

See 24 game/CSharp

Clojure

<lang Clojure> (ns rosettacode.24game)

(defn gen-new-game-nums [amount] (repeatedly amount #(inc ( rand-int 9))))

(defn orderless-seq-eq? [seq1 seq2] (apply = (map frequencies (list seq1 seq2))))

(defn valid-input?

 "checks whether the expression is somewhat valid prefix notation
(+ 1 2 3 4) (+ 3 (+ 4 5) 6)
this is done by making sure the only contents of the list are numbers operators and brackets
flatten gets rid of the brackets, so we just need to test for operators and integers after that"
 [user-input]
 (if (re-find #"^\(([\d-+/*] )+\d?\)$" (pr-str (flatten user-input)))
   true
   false))

(defn game-numbers-and-user-input-same?

 "input form: (+ 1 2 (+ 3 4))

tests to see if the numbers the user entered are the same as the ones given to them by the game"

 [game-nums user-input]
 (orderless-seq-eq? game-nums (filter integer? (flatten  user-input))))

(defn win [] (println "you won the game!\n")) (defn lose [] (println "you guessed wrong, or your input was not in prefix notation. eg: '(+ 1 2 3 4)'\n")) (defn game-start [goal game-numbers] (do

                                      (println "Your numbers are " game-numbers)
                                      (println "Your goal is " goal)
                                      (println "Use the numbers and +*-/ to reach your goal\n")
                                      (println "'q' to Quit\n")))

(defn play-game

 "typing in 'q' quits.
  to play use (play-game) (play-game 24) or (play-game 24 '(1 2 3 4)"
 ([] (play-game 24))
 ([goal] (play-game goal (gen-new-game-nums 4)))
 ([goal game-numbers]
    (game-start goal game-numbers)
    (let [input  (read-line)
          input-as-code (read-string input)]
      (if (and (valid-input? input-as-code)
               (game-numbers-and-user-input-same? game-numbers input-as-code)
               (try (= goal (eval input-as-code)) (catch Exception e (do (lose) (play-game goal game-numbers)))))
        (win)
        (when (not (= input "q"))
          (do (lose) (recur goal game-numbers)))))))

</lang>

CoffeeScript

Works with: node.js

<lang coffeescript>tty = require 'tty' tty.setRawMode true

buffer = "" numbers = []

for n in [0...4]

   numbers.push Math.max 1, Math.floor(Math.random() * 9)
   

console.log "You can use the numbers: #{numbers.join ' '}"

process.stdin.on 'keypress', (char, key) ->

   # accept operator
   if char and isNaN(char) and /[()*\/+-]/.test(char) and buffer.substr(-1) isnt char
       buffer += char
       process.stdout.write char
   # accept number
   else if !isNaN(+char) and (buffer ==  or isNaN(buffer.substr -1))
       buffer += char
       process.stdout.write char
   
   # check then evaluate expression
   if key?.name is 'enter'
       result = calculate()
       process.stdout.write '\n'
       if result and result is 24
           console.log " = 24! congratulations."
       else
           console.log "#{result}. nope."
       process.exit 0
   
   # quit
   if key?.name is 'escape' or (key?.name == 'c' and key.ctrl)
       process.exit 0

calculate = () ->

   if /[^\d\s()+*\/-]/.test buffer
       console.log "invalid characters"
       process.exit 1
   
   used = buffer.match(/\d/g)
   if used?.length != 4 or used.sort().join() != numbers.sort().join()
       console.log "you must use the 4 numbers provided"
       process.exit 1
   
   res = try eval buffer catch e
   return res or 'invalid expression'


  1. begin taking input

process.stdin.resume() </lang>

Common Lisp

<lang lisp>(define-condition choose-digits () ()) (define-condition bad-equation (error) ())

(defun 24-game ()

 (let (chosen-digits)
   (labels ((prompt ()
              (format t "Chosen digits: ~{~D~^, ~}~%~
                         Enter expression (or `bye' to quit, `!' to choose new digits): "
                      chosen-digits)
              (read))
            (lose () (error 'bad-equation))
            (choose () (setf chosen-digits (loop repeat 4 collecting (random 10))))
            (check (e)
              (typecase e
                ((eql bye) (return-from 24-game))
                ((eql !) (signal 'choose-digits))
                (atom (lose))
                (cons (check-sub (car e) (check-sub (cdr e) chosen-digits)) e)))
            (check-sub (sub allowed-digits)
              (typecase sub
                ((member nil + - * /) allowed-digits)
                (integer
                 (if (member sub allowed-digits)
                     (remove sub allowed-digits :count 1)
                     (lose)))
                (cons (check-sub (car sub) (check-sub (cdr sub) allowed-digits)))
                (t (lose))))
            (win ()
              (format t "You win.~%")
              (return-from 24-game)))
     (choose)
     (loop
      (handler-case
          (if (= 24 (eval (check (prompt)))) (win) (lose))
        (error () (format t "Bad equation, try again.~%"))
        (choose-digits () (choose)))))))</lang>

Verbose Implementation

Works with: clisp version 2.47

<lang lisp> (defconstant +ops+ '(* / + -))

(defun expr-numbers (e &optional acc)

 "Return all the numbers in argument positions in the expression."
 (cond
  ((numberp e) (cons e acc))
  ((consp e)
   (append (apply #'append
                  (mapcar #'expr-numbers (cdr e)))
           acc))))

(defun expr-well-formed-p (e)

 "Return non-nil if the given expression is well-formed."
 (cond
  ((numberp e) t)
  ((consp e)
   (and (member (car e) +ops+)
        (every #'expr-well-formed-p (cdr e))))
  (t nil)))

(defun expr-valid-p (e available-digits)

 "Return non-nil if the expression is well-formed and uses exactly

the digits specified."

 (and (expr-well-formed-p e)
      (equalp (sort (copy-seq available-digits) #'<)
              (sort (expr-numbers e) #'<))))

(defun expr-get (&optional using)

 (emit "Enter lisp form~@[ using the digit~P ~{~D~^ ~}~]: "
       (when using
         (length using)) using)
 (let (*read-eval*)
   (read)))

(defun digits ()

 (sort (loop repeat 4 collect (1+ (random 9))) #'<))

(defun emit (fmt &rest args)

 (format t "~&~?" fmt args))

(defun prompt (digits)

 (emit "Using only these operators:~%~%~
          ~2T~{~A~^ ~}~%~%~
        And exactly these numbers \(no repetition\):~%~%~
          ~2T~{~D~^ ~}~%~%~
        ~A"
       +ops+ digits (secondary-prompt)))

(defun secondary-prompt ()

 (fill-to 50 "Enter a lisp form which evaluates to ~
              the integer 24, or \"!\" to get fresh ~
              digits, or \"q\" to abort."))

(defun fill-to (n fmt &rest args)

 "Poor-man's text filling mechanism."
 (loop with s = (format nil "~?" fmt args)
       for c across s
       and i from 0
       and j = 0 then (1+ j) ; since-last-newline ctr
       when (char= c #\Newline)
       do (setq j 0)
       else when (and (not (zerop j))
                      (zerop (mod j n)))
       do (loop for k from i below (length s)
                when (char= #\Space (schar s k))
                do (progn
                     (setf (schar s k) #\Newline
                           j 0)
                     (loop-finish)))
       finally (return s)))

(defun 24-game ()

 (loop with playing-p = t
       and initial-digits = (digits)
       for attempts from 0
       and digits = initial-digits then (digits)
       while playing-p
       do (loop for e = (expr-get (unless (zerop attempts)
                                    digits))
                do
                (case e
                  (! (loop-finish))
                  (Q (setq playing-p nil)
                     (loop-finish))
                  (R (emit "Current digits: ~S" digits))
                  (t
                   (if (expr-valid-p e digits)
                       (let ((v (eval e)))
                         (if (eql v 24)
                             (progn
                               (emit "~%~%---> A winner is you! <---~%~%")
                               (setq playing-p nil)
                               (loop-finish))
                           (emit "Sorry, the form you entered ~
                                  computes to ~S, not 24.~%~%"
                                 v)))
                     (emit "Sorry, the form you entered did not ~
                            compute.~%~%")))))
       initially (prompt initial-digits)))</lang>

Example Usage:

CL-USER 97 > (24-game)
Using only these operators:

  * / + -

And exactly these numbers (no repetition):

  3 7 7 9

Enter a lisp form which evaluates to the integer 24,
or "!" to get fresh digits, or "q" to abort.
Enter lisp form: (eval (read-from-string "(/ 1 0)"))
Sorry, the form you entered did not compute.

Enter lisp form: !
Enter lisp form using the digits 4 5 7 8: !
Enter lisp form using the digits 1 2 4 5: (* 4 (* 5 (- 2 1)))
Sorry, the form you entered computes to 20, not 24.

Enter lisp form using the digits 1 2 4 5: (* 4 (+ 5 (- 2 1)))


---> A winner is you! <---

NIL

D

<lang d>import std.stdio, std.random, std.math, std.algorithm, std.range,

      std.typetuple;

void main() {

   void op(char c)() {
       if (stack.length < 2)
           throw new Exception("Wrong expression.");
       stack[$ - 2] = mixin("stack[$ - 2]" ~ c ~ "stack[$ - 1]");
       stack.popBack();
   }
   const problem = iota(4).map!(_ => uniform(1, 10))().array();
   writeln("Make 24 with the digits: ", problem);
   double[] stack;
   int[] digits;
   foreach (const char c; readln())
       switch (c) {
           case ' ', '\t', '\n': break;
           case '1': .. case '9':
               stack ~= c - '0';
               digits ~= c - '0';
               break;
           foreach (o; TypeTuple!('+', '-', '*', '/')) {
               case o: op!o(); break;
           }
           break;
           default: throw new Exception("Wrong char: " ~ c);
       }
   if (!digits.sort().equal(problem.dup.sort()))
       throw new Exception("Not using the given digits.");
   if (stack.length != 1)
       throw new Exception("Wrong expression.");
   writeln("Result: ", stack[0]);
   writeln(abs(stack[0] - 24) < 0.001 ? "Good job!" : "Try again.");

}</lang> Example:

Make 24 with the digits: [1, 8, 9, 8]
8 1 - 9 + 8 +
Result: 24
Good job!

Erlang

<lang Erlang>-module(g24). -export([main/0]).

main() ->

   random:seed(now()),
   io:format("24 Game~n"),
   play().

play() ->

   io:format("Generating 4 digits...~n"),
   Digts = [random:uniform(X) || X <- [9,9,9,9]],
   io:format("Your digits\t~w~n", [Digts]),
   read_eval(Digts),
   play().

read_eval(Digits) ->

   Exp = string:strip(io:get_line(standard_io, "Your expression: "), both, $\n),
   case {correct_nums(Exp, Digits), eval(Exp)} of
       {ok, X} when X == 24 -> io:format("You Win!~n");
       {ok, X} -> io:format("You Lose with ~p!~n",[X]);
       {List, _} -> io:format("The following numbers are wrong: ~p~n", [List])
   end.

correct_nums(Exp, Digits) ->

   case re:run(Exp, "([0-9]+)", [global, {capture, all_but_first, list}]) of
       nomatch ->
           "No number entered";
       {match, IntLs} ->
           case [X || [X] <- IntLs, not lists:member(list_to_integer(X), Digits)] of
               [] -> ok;
               L -> L
           end
   end.

eval(Exp) ->

   {X, _} = eval(re:replace(Exp, "\\s", "", [{return, list},global]),
                 0),
   X.

eval([], Val) ->

   {Val,[]};

eval([$(|Rest], Val) ->

   {NewVal, Exp} = eval(Rest, Val),
   eval(Exp, NewVal);

eval([$)|Rest], Val) ->

   {Val, Rest};

eval([$[|Rest], Val) ->

   {NewVal, Exp} = eval(Rest, Val),
   eval(Exp, NewVal);

eval([$]|Rest], Val) ->

   {Val, Rest};

eval([$+|Rest], Val) ->

   {NewOperand, Exp} = eval(Rest, 0),
   eval(Exp, Val + NewOperand);

eval([$-|Rest], Val) ->

   {NewOperand, Exp} = eval(Rest, 0),
   eval(Exp, Val - NewOperand);

eval([$*|Rest], Val) ->

   {NewOperand, Exp} = eval(Rest, 0),
   eval(Exp, Val * NewOperand);

eval([$/|Rest], Val) ->

   {NewOperand, Exp} = eval(Rest, 0),
   eval(Exp, Val / NewOperand);

eval([X|Rest], 0) when X >= $1, X =< $9 ->

   eval(Rest, X-$0).

</lang>

The evaluator uses a simple infix scheme that doesn't care about operator precedence, but does support brackets and parentheses alike. Thus, ((9+1)*2)+2+2 is evaluated as:

9 + 1 = 10
10 * 2 = 20
2 + 2 = 4
20 + 4

Example:

1> c(g24).    
{ok,g24}
2> g24:main().
24 Game
Generating 4 digits...
Your digits     [7,4,6,8]
Your expression: 6*4
You Win!
Generating 4 digits...
Your digits     [4,1,5,8]
Your expression: 6*4
The following numbers are wrong: ["6"]
Generating 4 digits...
Your digits     [8,5,8,2]
Your expression: 2*([8/5]*2)
You Lose with 6.4!
Generating 4 digits...
Your digits     [7,4,8,1]


F#

<lang fsharp>open System open System.Text.RegularExpressions

// Some utilities let (|Parse|_|) regex str =

  let m = Regex(regex).Match(str)
  if m.Success then Some ([for g in m.Groups -> g.Value]) else None

let rec gcd x y = if x = y || x = 0 then y else if x < y then gcd y x else gcd y (x-y) let abs (x : int) = Math.Abs x let sign (x: int) = Math.Sign x let cint s = Int32.Parse(s) let replace m (s : string) t = Regex.Replace(t, m, s)

// computing in Rationals type Rat(x : int, y : int) =

   let g = if y <> 0 then gcd (abs x) (abs y) else raise <| DivideByZeroException()
   member this.n = sign y * x / g   // store a minus sign in the numerator
   member this.d =
       if y <> 0 then sign y * y / g else raise <| DivideByZeroException()
   static member (~-) (x : Rat) = Rat(-x.n, x.d)
   static member (+) (x : Rat, y : Rat) = Rat(x.n * y.d + y.n * x.d, x.d * y.d)
   static member (-) (x : Rat, y : Rat) = x + Rat(-y.n, y.d)
   static member (*) (x : Rat, y : Rat) = Rat(x.n * y.n, x.d * y.d)
   static member (/) (x : Rat, y : Rat) = x * Rat(y.d, y.n)
   override this.ToString() = sprintf @"<%d,%d>" this.n this.d
   new(x : string, y : string) = if y = "" then Rat(cint x, 1) else Rat(cint x, cint y)

// Due to the constraints imposed by the game (reduced set // of operators, all left associativ) we can get away with a repeated reduction // to evaluate the algebraic expression. let rec reduce (str :string) =

   let eval (x : Rat) (y : Rat) = function
   | "*" -> x * y | "/" -> x / y | "+" -> x + y | "-" -> x - y | _ -> failwith "unknown op"
   let subst s r = str.Replace(s, r.ToString())
   let rstr =
       match str with
       | Parse @"\(<(-?\d+),(\d+)>([*/+-])<(-?\d+),(\d+)>\)" [matched; xn; xd; op; yn; yd] -> 
           subst matched <| eval (Rat(xn,xd)) (Rat(yn,yd)) op
       | Parse @"<(-?\d+),(\d+)>([*/])<(-?\d+),(\d+)>" [matched; xn; xd; op; yn; yd] -> 
           subst matched <| eval (Rat(xn,xd)) (Rat(yn,yd)) op
       | Parse @"<(-?\d+),(\d+)>([+-])<(-?\d+),(\d+)>" [matched; xn; xd; op; yn; yd] -> 
           subst matched <| eval (Rat(xn,xd)) (Rat(yn,yd)) op
       | Parse @"\(<(-?\d+),(\d+)>\)" [matched; xn; xd] -> 
           subst matched <| Rat(xn,xd)
       | Parse @"(?<!>)-<(-?\d+),(\d+)>" [matched; xn; xd] -> 
           subst matched <| -Rat(xn,xd)
       | _ -> str
   if str = rstr then str else reduce rstr

let gameLoop() =

   let checkInput dddd input =
       match input with
       | "n" | "q" -> Some(input)
       | Parse @"[^1-9()*/+-]" [c] ->
           printfn "You used an illegal character in your expression: %s" c
           None
       | Parse @"^\D*(\d)\D+(\d)\D+(\d)\D+(\d)(?:\D*(\d))*\D*$" [m; d1; d2; d3; d4; d5] ->
           if d5 = "" && (String.Join(" ", Array.sort [|d1;d2;d3;d4|])) = dddd then Some(input)
           elif d5 = "" then
               printfn "Use this 4 digits with operators in between: %s." dddd
               None
           else 
               printfn "Use only this 4 digits with operators in between: %s." dddd
               None
       | _ ->
           printfn "Use all 4 digits with operators in between: %s." dddd
           None
       
   let rec userLoop dddd  =
       let tryAgain msg =
           printfn "%s" msg
           userLoop dddd
       printf "[Expr|n|q]: "
       match Console.ReadLine() |> replace @"\s" "" |> checkInput dddd with
       | Some(input) -> 
           let data = input |> replace @"((?<!\d)-)?\d+" @"<$&,1>"
           match data with
           | "n" -> true | "q" -> false
           | _ ->
               try
                   match reduce data with
                   | Parse @"^<(-?\d+),(\d+)>$" [_; x; y] ->
                       let n, d = (cint x), (cint y)
                       if n = 24 then
                           printfn "Correct!"
                           true
                       elif d=1 then tryAgain <| sprintf "Wrong! Value = %d." n
                       else tryAgain <| sprintf "Wrong! Value = %d/%d." n d
                   | _ -> tryAgain "Wrong! not a well-formed expression!"
               with
                   | :? System.DivideByZeroException ->
                       tryAgain "Wrong! Your expression results in a division by zero!"
                   | ex ->
                       tryAgain <| sprintf "There is an unforeseen problem with yout input: %s" ex.Message
       | None -> userLoop dddd
   let random = new Random(DateTime.Now.Millisecond)
   let rec loop() =
       let dddd = String.Join(" ", Array.init 4 (fun _ -> 1 + random.Next 9) |> Array.sort)
       printfn "\nCompute 24 from the following 4 numbers: %s" dddd
       printfn "Use them in any order with * / + - and parentheses; n = new numbers; q = quit"
       if userLoop dddd then loop()
   loop()

gameLoop()</lang>

Output:
Compute 24 from the following 4 numbers: 3 3 3 5
Use them in any order with * / + - and parentheses; n = new numbers; q = quit
[Expr|n|q]: n

Compute 24 from the following 4 numbers: 3 5 6 7
Use them in any order with * / + - and parentheses; n = new numbers; q = quit
[Expr|n|q]: (7 + 5) + 6/3
Wrong! Value = 14.
[Expr|n|q]: (7 + 5) * 6/3
Correct!

Compute 24 from the following 4 numbers: 3 3 4 5
Use them in any order with * / + - and parentheses; n = new numbers; q = quit
[Expr|n|q]: q

Factor

<lang factor>USING:

   combinators.short-circuit
   continuations
   eval
   formatting
   fry
   kernel
   io
   math math.ranges
   prettyprint
   random
   sequences
   sets ;

IN: 24game

choose4 ( -- seq )
   4 [ 9 [1,b] random ] replicate ;
step ( numbers -- ? )
   readln
   [
       parse-string
       {
           ! Is only allowed tokens used?
           [ swap { + - / * } append subset? ]
           ! Digit count in expression should be equal to the given numbers.
           [ [ number? ] count swap length = ]
           ! Of course it must evaluate to 24
           [ nip call( -- x ) 24 = ]
       } 2&&
       [ f "You got it!" ]
       [ t "Expression isnt valid, or doesnt evaluate to 24." ]
       if
   ]
   [ 3drop f "Could not parse that." ]
   recover print flush ;
main ( -- )
   choose4
   [ "Your numbers are %[%s, %], make an expression\n" printf flush ]
   [ '[ _ step ] loop ]
   bi ;

</lang> Sample: <lang factor> IN: scratchpad main Your numbers are { 4, 1, 8, 2 }, make an expression 8 4 + 2 * 1 / You got it! </lang>

Falcon

<lang falcon>load compiler

function genRandomNumbers( amount )

 rtn = []
 for i in [ 0 : amount ]: rtn += random( 1, 9 )
 return( rtn )

end

function getAnswer( exp )

 ic = ICompiler()
 ic.compileAll(exp)
 return( ic.result )

end

function validInput( str )

 for i in [ 0 : str.len() ]
   if str[i] notin ' ()[]0123456789-+/*'
     > 'INVALID Character = ', str[i]
     return( false )
   end
 end
 return( true )

end

printl(' The 24 Game

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

num = genRandomNumbers( 4 )

while( true )

 >>  "Here are the numbers to choose from: "
 map({ a => print(a, " ") }, num)
 >
 exp = input()
 switch exp
   case "q", "Q"
     exit()
   case "!"
     > 'Generating new numbers list'
     num = genRandomNumbers( 4 )
   default
     if not validInput( exp ): continue
     answer = getAnswer( exp )
     if answer == 24
       > "By George you GOT IT! Your expression equals 24"
     else
       > "Ahh Sorry, So Sorry your answer of ", answer, " does not equal 24."
     end
 end

end</lang>


Fortran

Indicate operator precedence by parentheses; e.g. (3+(5*6))-9. No whitespace is admissible. The program uses Insertion_sort in Fortran. <lang Fortran>program game_24

 implicit none
 real               :: vector(4), reals(11), result, a, b, c, d
 integer            :: numbers(4), ascii(11), i
 character(len=11)  :: expression
 character          :: syntax(11)
 ! patterns:
 character, parameter :: one(11)   = (/ '(','(','1','x','1',')','x','1',')','x','1' /)
 character, parameter :: two(11)   = (/ '(','1','x','(','1','x','1',')',')','x','1' /)
 character, parameter :: three(11) = (/ '1','x','(','(','1','x','1',')','x','1',')' /)
 character, parameter :: four(11)  = (/ '1','x','(','1','x','(','1','x','1',')',')' /)
 character, parameter :: five(11)  = (/ '(','1','x','1',')','x','(','1','x','1',')' /)
 
 do
   call random_number(vector)
   numbers = 9 * vector + 1
   write (*,*) 'Digits: ',numbers
   write (*,'(a)',advance='no') 'Your expression: '
   read (*,'(a11)') expression
   forall (i=1:11) syntax(i) = expression(i:i)
   ascii = iachar(syntax)
   where (syntax >= '0' .and. syntax <= '9')
     syntax = '1'  ! number
   elsewhere (syntax == '+' .or. syntax == '-' .or. syntax == '*' .or. syntax == '/')
     syntax = 'x'  ! op
   elsewhere (syntax /= '(' .and. syntax /= ')')
     syntax = '-'  ! error
   end where
   reals = real(ascii-48)
   if ( all(syntax == one) ) then
     a = reals(3); b = reals(5); c = reals(8); d = reals(11)
     call check_numbers(a,b,c,d)
     result = op(op(op(a,4,b),7,c),10,d)
   else if ( all(syntax == two) ) then
     a = reals(2); b = reals(5); c = reals(7); d = reals(11)
     call check_numbers(a,b,c,d)
     result = op(op(a,3,op(b,6,c)),10,d)
   else if ( all(syntax == three) ) then
     a = reals(1); b = reals(5); c = reals(7); d = reals(10)
     call check_numbers(a,b,c,d)
     result = op(a,2,op(op(b,6,c),9,d))
   else if ( all(syntax == four) ) then
     a = reals(1); b = reals(4); c = reals(7); d = reals(9)
     call check_numbers(a,b,c,d)
     result = op(a,2,op(b,5,op(c,8,d)))
   else if ( all(syntax == five) ) then
     a = reals(2); b = reals(4); c = reals(8); d = reals(10)
     call check_numbers(a,b,c,d)
     result = op(op(a,3,b),6,op(c,9,d))
   else
     stop 'Input string: incorrect syntax.'
   end if
   if ( abs(result-24.0) < epsilon(1.0) ) then
     write (*,*) 'You won!'
   else
     write (*,*) 'Your result (',result,') is incorrect!'
   end if
 
   write (*,'(a)',advance='no') 'Another one? [y/n] '
   read (*,'(a1)') expression
   if ( expression(1:1) == 'n' .or. expression(1:1) == 'N' ) then
     stop
   end if  
 end do
 

contains

 pure real function op(x,c,y)
   integer, intent(in) :: c
   real, intent(in) :: x,y
   select case ( char(ascii(c)) )
     case ('+')
       op = x+y
     case ('-')
       op = x-y
     case ('*')
       op = x*y
     case ('/')
       op = x/y
   end select
 end function op
 
 subroutine check_numbers(a,b,c,d)
   real, intent(in) :: a,b,c,d
   integer          :: test(4)
   test = (/ nint(a),nint(b),nint(c),nint(d) /)
   call Insertion_Sort(numbers)
   call Insertion_Sort(test)
   if ( any(test /= numbers) ) then
     stop 'You cheat ;-) (Incorrect numbers)'
   end if
 end subroutine check_numbers
 
 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

end program game_24 </lang>

GAP

<lang gap># Solution in RPN Play24 := function() local input, digits, line, c, chars, stack, stackptr, cur, p, q, ok, a, b, run; input := InputTextUser(); run := true; while run do digits := List([1 .. 4], n -> Random(1, 9)); while true do Display(digits); line := ReadLine(input); line := Chomp(line); if line = "end" then run := false; break; elif line = "next" then break; else ok := true; stack := [ ]; stackptr := 0; chars := "123456789+-*/ "; cur := ShallowCopy(digits); for c in line do if c = ' ' then continue; fi; p := Position(chars, c); if p = fail then ok := false; break; fi; if p < 10 then q := Position(cur, p); if q = fail then ok := false; break; fi; Unbind(cur[q]); stackptr := stackptr + 1; stack[stackptr] := p; else if stackptr < 2 then ok := false; break; fi; b := stack[stackptr]; a := stack[stackptr - 1]; stackptr := stackptr - 1; if c = '+' then a := a + b; elif c = '-' then a := a - b; elif c = '*' then a := a * b; elif c = '/' then if b = 0 then ok := false; break; fi; a := a / b; else ok := false; break; fi; stack[stackptr] := a; fi; od; if ok and stackptr = 1 and Size(cur) = 0 then if stack[1] = 24 then Print("Good !\n"); break; else Print("Bad value: ", stack[1], "\n"); continue; fi; fi; Print("Invalid expression\n"); fi; od; od; CloseStream(input); end;

  1. example session
  2. type "end" to quit the game, "next" to try another list of digits

gap> Play24(); [ 7, 6, 8, 5 ] 86*75-/ Good ! [ 5, 9, 2, 7 ] end gap></lang>

Go

RPN solution. <lang go>package main

import (

   "fmt"
   "math"
   "math/rand"
   "time"

)

func main() {

   rand.Seed(time.Now().Unix())
   n := make([]rune, 4)
   for i := range n {
       n[i] = rune(rand.Intn(9) + '1')
   }
   fmt.Printf("Your numbers: %c\n", n)
   fmt.Print("Enter RPN: ")
   var expr string
   fmt.Scan(&expr)
   if len(expr) != 7 {
       fmt.Println("invalid. expression length must be 7." +
           " (4 numbers, 3 operators, no spaces)")
       return
   }
   stack := make([]float64, 0, 4)
   for _, r := range expr {
       if r >= '0' && r <= '9' {
           if len(n) == 0 {
               fmt.Println("too many numbers.")
               return
           }
           i := 0
           for n[i] != r {
               i++
               if i == len(n) {
                   fmt.Println("wrong numbers.")
                   return
               }
           }
           n = append(n[:i], n[i+1:]...)
           stack = append(stack, float64(r-'0'))
           continue
       }
       if len(stack) < 2 {
           fmt.Println("invalid expression syntax.")
           return
       }
       switch r {
       case '+':
           stack[len(stack)-2] += stack[len(stack)-1]
       case '-':
           stack[len(stack)-2] -= stack[len(stack)-1]
       case '*':
           stack[len(stack)-2] *= stack[len(stack)-1]
       case '/':
           stack[len(stack)-2] /= stack[len(stack)-1]
       default:
           fmt.Printf("%c invalid.\n", r)
           return
       }
       stack = stack[:len(stack)-1]
   }
   if math.Abs(stack[0]-24) > 1e-6 {
       fmt.Println("incorrect.", stack[0], "!= 24")
   } else {
       fmt.Println("correct.")
   }

}</lang> Example game:

Your numbers: [5 8 1 3]
Enter RPN: 83-5*1-
correct.

Gosu

<lang Gosu> uses java.lang.Double uses java.lang.Integer uses java.util.ArrayList uses java.util.List uses java.util.Scanner uses java.util.Stack

function doEval( scanner : Scanner, allowed : List<Integer> ) : double {

   var stk = new Stack<Double>()
   while( scanner.hasNext() ) {
       if( scanner.hasNextInt() ) {
           var n = scanner.nextInt()
           // Make sure they're allowed to use n
           if( n <= 0 || n >= 10 ) {
               print( n + " isn't allowed" )
               return 0
           }
           var idx = allowed.indexOf( n )
           if( idx == -1 ) {
               print( "You aren't allowed to use so many " + n + "s!" )
               return 0
           }
           // Add the input number to the stack
           stk.push( new Double( n ) )
           // Mark n as used
           allowed.remove( idx )
       } else {
           // It has to be an operator...
           if( stk.size() < 2 ) {
               print( "Invalid Expression: Stack underflow!" )
               return 0
           }
           // Gets the next operator as a single character token
           var s = scanner.next("[\\+-/\\*]")
           // Get the operands
           var r = stk.pop().doubleValue()
           var l = stk.pop().doubleValue()
           // Determine which operator and invoke it
           if( s.equals( "+" ) ) {
               stk.push( new Double( l + r ) )
           } else if( s.equals( "-" ) ) {
               stk.push( new Double( l - r ) )
           } else if( s.equals( "*" ) ) {
               stk.push( new Double( l * r ) )
           } else if( s.equals( "/" ) ) {
               if( r == 0.0 ) {
                   print( "Invalid Expression: Division by zero!" )
                   return 0
               }
               stk.push( new Double( l / r ) )
           } else {
               print( "Internal Error: looking for operator yielded '" + s + "'" )
               return 0
           }
       }
   }
   // Did they skip any numbers?
   if( allowed.size() != 0 ) {
       print( "You didn't use ${allowed}" )
       return 0
   }
   // Did they use enough operators?
   if( stk.size() != 1 ) {
       print( "Invalid Expression: Not enough operators!" )
       return 0
   }
   return stk.pop().doubleValue()

}

// Pick 4 random numbers from [1..9] var nums = new ArrayList<Integer>() var gen = new java.util.Random( new java.util.Date().getTime() ) for( i in 0..3 ) {

   nums.add( gen.nextInt(9) + 1 )

}

// Prompt the user print( "Using addition, subtraction, multiplication and division, write an" ) print( "expression that evaluates to 24 using" ) print( "${nums.get(0)}, ${nums.get(1)}, ${nums.get(2)} and ${nums.get(3)}" ) print( "" ) print( "Please enter your expression in RPN" )

// Build a tokenizer over a line of input var sc = new Scanner( new java.io.BufferedReader( new java.io.InputStreamReader( java.lang.System.in ) ).readLine() )

// eval the expression var val = doEval( sc, nums )

// winner? if( java.lang.Math.abs( val - 24.0 ) < 0.001 ) {

   print( "You win!" )

} else {

   print( "You lose!" )

} </lang>

Groovy

Translation of: Ruby

This solution breaks strict adherence to the rules in only one way: any line that starts with the letter "q" causes the game to quit. <lang groovy>final random = new Random() final input = new Scanner(System.in)


def evaluate = { expr ->

   if (expr == 'QUIT') {
       return 'QUIT'
   } else {
       try { Eval.me(expr.replaceAll(/(\d)/, '$1.0')) }
       catch (e) { 'syntax error' }
   }

}


def readGuess = { digits ->

   while (true) {
       print "Enter your guess using ${digits} (q to quit): "
       def expr = input.nextLine()
       
       switch (expr) {
           case ~/^[qQ].*/:
               return 'QUIT'
           case ~/.*[^\d\s\+\*\/\(\)-].*/:
               def badChars = expr.replaceAll(~/[\d\s\+\*\/\(\)-]/, )
               println "invalid characters in input: ${(badChars as List) as Set}"
               break
           case { (it.replaceAll(~/\D/, ) as List).sort() != ([]+digits).sort() }:
               println you didn't use the right digits
               break
           case ~/.*\d\d.*/:
               println 'no multi-digit numbers allowed'
               break
           default:
               return expr
       }
   }

}


def digits = (1..4).collect { (random.nextInt(9) + 1) as String }

while (true) {

   def guess = readGuess(digits)
   def result = evaluate(guess)
   
   switch (result) {
       case 'QUIT':
           println 'Awwww. Maybe next time?'
           return
           
       case 24:
           println 'Yes! You got it.'
           return
           
       case 'syntax error':
           println "A ${result} was found in ${guess}" 
           break
           
       default:
           println "Nope: ${guess} == ${result}, not 24"
           println 'One more try, then?'
   }

}</lang>

Sample Run:

$ groovy TwentyFour.gsh
Enter your guess using [4, 8, 3, 6] (q to quit): 4836
no multi-digit numbers allowed
Enter your guess using [4, 8, 3, 6] (q to quit): 4  ++ ++ 8/ 3-6
A syntax error was found in 4  ++ ++ 8/ 3-6
Enter your guess using [4, 8, 3, 6] (q to quit): btsjsb
invalid characters in input: [t, s, b, j]
Enter your guess using [4, 8, 3, 6] (q to quit): 1+3+2+2
you didn't use the right digits
Enter your guess using [4, 8, 3, 6] (q to quit): q
Awwww. Maybe next time?

$ groovy TwentyFour.gsh
Enter your guess using [6, 3, 2, 6] (q to quit): 6+6+3+2
Nope: 6+6+3+2 == 17.0, not 24
One more try, then?
Enter your guess using [6, 3, 2, 6] (q to quit): (6*3 - 6) * 2
Yes! You got it.

Haskell

<lang Haskell>import Char import Control.Monad.Error import Data.List import IO import Maybe import Random

main = do

   hSetBuffering stdout NoBuffering
   mapM_ putStrLn 
       [ "THE 24 GAME\n"
       , "Given four digits in the range 1 to 9"
       , "Use the +, -, *, and / operators in reverse polish notation"
       , "To show how to make an answer of 24.\n"
       ]
   digits <- liftM (sort . take 4 . randomRs (1,9)) getStdGen :: IO [Int]
   putStrLn ("Your digits: " ++ intercalate " " (map show digits))
   guessLoop digits
   where guessLoop digits =
             putStr "Your expression: " >>
             liftM (processGuess digits . words) getLine >>=
             either (\m -> putStrLn m >> guessLoop digits) putStrLn

processGuess _ [] = Right "" processGuess digits xs | not $ matches = Left "Wrong digits used"

   where matches = digits == (sort . map read $ filter (all isDigit) xs)

processGuess digits xs = calc xs >>= check

   where check 24 = Right "Correct"
         check x  = Left (show (fromRational (x :: Rational)) ++ " is wrong")

-- A Reverse Polish Notation calculator with full error handling calc = result []

   where result [n] [] = Right n
         result _   [] = Left "Too few operators"
         result ns  (x:xs) = simplify ns x >>= flip result xs

simplify (a:b:ns) s | isOp s = Right ((fromJust $ lookup s ops) b a : ns) simplify _ s | isOp s = Left ("Too few values before " ++ s) simplify ns s | all isDigit s = Right (fromIntegral (read s) : ns) simplify _ s = Left ("Unrecognized symbol: " ++ s)

isOp v = elem v $ map fst ops

ops = [("+",(+)), ("-",(-)), ("*",(*)), ("/",(/))]</lang>

HicEst

<lang HicEst>DIMENSION digits(4), input_digits(100), difference(4) CHARACTER expression*100, prompt*100, answers='Wrong,Correct,', protocol='24 game.txt'

1 digits = CEILING( RAN(9) ) 2 DLG(Edit=expression, Text=digits, TItle=prompt)

  READ(Text=expression, ItemS=n) input_digits
  IF(n == 4) THEN
    ALIAS(input_digits,1,  input,4)
    SORT(Vector=digits, Sorted=digits)
    SORT(Vector=input, Sorted=input)
    difference = ABS(digits - input)
    IF( SUM(difference) == 0 ) THEN
      EDIT(Text=expression, ScaNnot='123456789+-*/ ()', GetPos=i, CoPyto=prompt)
      IF( i > 0 ) THEN
        prompt = TRIM(expression) // ': ' //TRIM(prompt) // ' is an illegal character'
      ELSE
        prompt = TRIM(expression) // ': Syntax error'
        result = XEQ(expression, *2) ! on error branch to label 2
        EDIT(Text=answers, ITeM=(result==24)+1, Parse=answer)
        WRITE(Text=prompt, Name) TRIM(expression)//': ', answer, result
      ENDIF
    ELSE
      WRITE(Text=prompt) TRIM(expression), ': You used ', input, ' instead ', digits
    ENDIF
  ELSE
    prompt = TRIM(expression) // ': Instead 4 digits you used ' // n
  ENDIF
  OPEN(FIle=protocol, APPend)
  WRITE(FIle=protocol, CLoSe=1) prompt
  DLG(TItle=prompt, Button='>2:Try again', B='>1:New game', B='Quit')

END</lang> <lang HicEst>4 + 8 + 7 + 5: You used 4 5 7 8 instead 4 4 7 8 4 + 8 + 7 + a: Instead 4 digits you used 3 4 + 8 + 7 + a + 4: a is an illegal character 4 + 8 + 7a + 4: a is an illegal character 4 + 8 + 7 + 4:; answer=Wrong; result=23; 4 * 7 - 8 + 4:; answer=Correct; result=24;</lang>

Icon and Unicon

This plays the game of 24 using a simplified version of the code from the Arithmetic evaluation task. <lang Icon>invocable all link strings # for csort, deletec

procedure main() help() repeat {

  every (n := "") ||:= (1 to 4, string(1+?8))
  writes("Your four digits are : ")
  every writes(!n," ") 
  write()
  
  e := trim(read()) | fail
  case e of {
     "q"|"quit": return
     "?"|"help": help()
     default: {
        e := deletec(e,' \t')         # no whitespace
        d := deletec(e,~&digits)      # just digits
        if csort(n) ~== csort(d) then # and only the 4 given digits
           write("Invalid repsonse.") & next 
        if e ? (ans := eval(E()), pos(0)) then # parse and evaluate
           if ans = 24 then write("Congratulations you win!") 
           else write("Your answer was ",ans,". Try again.")
        else write("Invalid expression.")
        }
     }
  }

end

procedure eval(X) #: return the evaluated AST

  if type(X) == "list" then {
     x := eval(get(X))
     while x := get(X)(real(x), real(eval(get(X) | stop("Malformed expression."))))
  }
  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

procedure help() return write(

  "Welcome to 24\n\n",
  "Combine the 4 given digits to make 24 using only + - * / and ( ).\n ",
  "All operations have equal precedence and are evaluated left to right.\n",
  "Combining (concatenating) digits is not allowed.\n",
  "Enter 'help', 'quit', or an expression.\n")  

end</lang>

strings.icn provides deletec and sortc

Output:

Welcome to 24

The object of the game is to combine the 4 given digits using only + - * / and ( ).
All operations have equal precedence and are evaluated left to right.
Combining (concatenating) digits is not allowed.
Enter 'help', 'quit', or an expression.

Your four digits are : 8 1 7 2
8*2+(7+1)
Congratulations you win!
Your four digits are : 4 2 7 6
7*6+(4*2)
Your answer was 50. Try again.
Your four digits are : 7 7 8 8
77-88
Invalid expression.
Your four digits are : 9 3 2 3
9+3+2+3+
Malformed expression.

J

<lang J>require'misc' deal=: 1 + ? bind 9 9 9 9 rules=: smoutput bind 'see http://en.wikipedia.org/wiki/24_Game' input=: prompt @ ('enter 24 expression using ', ":, ': '"_)

wellformed=: (' '<;._1@, ":@[) -:&(/:~) '(+-*%)' -.&;:~ ] is24=: 24 -: ". ::0:@]

respond=: (;:'no yes') {::~ wellformed * is24

game24=: (respond input)@deal@rules</lang>

Example use:

   game24 ''
see http://en.wikipedia.org/wiki/24_Game
enter 24 expression using 6 5 9 4: 6+5+9+4
yes
   game24 ''
see http://en.wikipedia.org/wiki/24_Game
enter 24 expression using 3 3 3 3: 3+3+3+3+3+3+3+3
no

JavaScript

Library: Underscore.js

This is my first Rosetta Code, and I am a JS newbie. Works, but is not the best solution. Due to the eval, it is probably not safe. <lang javascript>String.prototype.replaceAll = function(patt,repl) { var that = this;

             	                                    that     = that.replace(patt,repl);

if (that.search(patt) != -1) { that = that.replaceAll(patt,repl); } return that; };

function validChars(input) { var regInvalidChar = /[^\d\+\*\/\s-\(\)]/;

                            return input.search(regInvalidChar) == -1;
                          }

function validNums(str, nums) {

   var arr, l;
   arr = str.replaceAll(/[^\d\s]/," ").replaceAll("  "," ").trim().split(" ").sort();
   l   = arr.length;
   while(l--) { arr[l] = Number(arr[l]); }
   return _.isEqual(arr,nums.sort());

}

function validEval(input) { try { eval(input); } catch (e) { return false; }; return true; }

var input;

while(true){ var numbers = [];

            var i = 4;
            while(i--) { numbers.push(Math.floor(Math.random()*8+1));
                       }
            input = prompt("Your numbers are:\n"
                          + numbers.join(" ")
                          + "\nEnter expression. (use only + - * / and parens).\n"
                          + "'x' to exit."
                          );
            if (input === 'x') break;
   
              !validChars(input)                 ? alert("Invalid chars used, try again. Use only:\n + - * / ( )")
            : !validNums(input,numbers)          ? alert("Wrong numbers used, try again.")

 : !validEval(input)  ? alert("Could not evaluate input, try again.")

            : eval(input) != 24                  ? alert("Wrong answer:" + eval(input) + "\nTry again.")
            : alert(input + "== 24. Congrats!!")
            ;
          }

</lang>

Julia

<lang julia>function twentyfour()

	function check(input)
		d = ref(Int)
		for i in input.args
			if typeof(i) == Expr
				c = check(i)
				typeof(c) == String || append!(d,c)
			elseif contains([:*,:/,:-,:+],i)
				continue
			elseif contains([1:9],i)
				push!(d,i)
				continue
			elseif i > 9 || i < 1
				d = "Sorry, $i is not allowed, please use only numbers between 1 and 9"
			else 
				d = "Sorry, $i isn't allowed"
			end
		end
		return d
	end
	new_digits() = [rand(1:9),rand(1:9),rand(1:9),rand(1:9)]

answer = new_digits() print("The 24 Game\nYou will be given any four digits in the range 1 to 9, which may have repetitions.\n Using just the +, -, *, and / operators show how to make an answer of 24.\n Use parentheses, (), to ensure proper order of evaulation.\n Enter 'n' fDouble>()

   while( scanner.hasNext() ) {
       if( scanner.hasNextInt() ) {
           var n = scanner.nextInt()
           // Make sure they're allowed to use n
           if( n or a new set of digits, and 'q' to quit. Good luck!\n

Here's your first 4 digits\n$(answer[1]) $(answer[2]) $(answer[3]) $(answer[4])\n >") while true input = chomp(readline(STDIN)) input == "q" && break if input == "n" answer = new_digits() print("\nLet's try again, go ahead and guess\n Here's your 4 digits\n$(answer[1]) $(answer[2]) $(answer[3]) $(answer[4])\n>") continue end input = try parse(input) catch print("I couldn't calculate your answer, please try again\n>"); continue end c = check(input) cc = all([sum(i .== answer) == sum(i .== c) for i in answer])

       !cc && (print("Sorry, valid digits are \n$(answer[1]) $(answer[2]) $(answer[3]) $(answer[4])\n are allowed and all four must be used. Please try again\n>"); continue)

if eval(input) == 24 answer = new_digits() print("\nYou did it!\nLet's do another round, or enter 'q' to quit\n Here's your 4 digits\n$(answer[1]) $(answer[2]) $(answer[3]) $(answer[4])\n >") continue else print("\nSorry your answer calculates to $(eval(input))\nTry again\n>") end end end</lang>


Lasso

This solution requires web input from the user via a form of the expression.

On submit the expression is checked for valid chars, that the integers are valid and in the original array (which also takes care of non-duplicate integers), and that the integers are not in consecutive positions.

If a valid expression it is evaluated, and the result and success state shown to the user. <lang Lasso>[ if(sys_listunboundmethods !>> 'randoms') => { define randoms()::array => { local(out = array) loop(4) => { #out->insert(math_random(9,1)) } return #out } } if(sys_listunboundmethods !>> 'checkvalid') => { define checkvalid(str::string, nums::array)::boolean => { local(chk = array('*','/','+','-','(',')',' '), chknums = array, lastintpos = -1, poscounter = 0) loop(9) => { #chk->insert(loop_count) } with s in #str->values do => { #poscounter++ #chk !>> #s && #chk !>> integer(#s) ? return false integer(#s) > 0 && #lastintpos + 1 >= #poscounter ? return false integer(#s) > 0 ? #chknums->insert(integer(#s)) integer(#s) > 0 ? #lastintpos = #poscounter } #chknums->size != 4 ? return false #nums->sort #chknums->sort loop(4) => { #nums->get(loop_count) != #chknums(loop_count) ? return false } return true } } if(sys_listunboundmethods !>> 'executeexpr') => { define executeexpr(expr::string)::integer => { local(keep = string) with i in #expr->values do => { if(array('*','/','+','-','(',')') >> #i) => { #keep->append(#i) else integer(#i) > 0 ? #keep->append(decimal(#i)) } } return integer(sourcefile('['+#keep+']','24game',true,true)->invoke) } }

local(numbers = array, exprsafe = true, exprcorrect = false, exprresult = 0) if(web_request->param('nums')->asString->size) => { with n in web_request->param('nums')->asString->split(',') do => { #numbers->insert(integer(#n->trim&)) } }

  1. numbers->size != 4 ? #numbers = randoms()

if(web_request->param('nums')->asString->size) => { #exprsafe = checkvalid(web_request->param('expr')->asString,#numbers) if(#exprsafe) => { #exprresult = executeexpr(web_request->param('expr')->asString) #exprresult == 24 ? #exprcorrect = true } }

]

24 Game

Rules:
Enter an expression that evaluates to 24

  • Only multiplication, division, addition, and subtraction operators/functions are allowed.
  • Brackets are allowed.
  • Forming multiple digit numbers from the supplied digits is disallowed. (So an answer of 12+12 when given 1, 2, 2, and 1 is wrong).
  • The order of the digits when given does not have to be preserved.

Numbers

[#numbers->join(', ')] (<a href="?">Reload</a>)

[!#exprsafe ? '

Please provide a valid expression

']

<form><input type="hidden" value="[#numbers->join(',')]" name="nums"><input type="text" name="expr" value="[web_request->param('expr')->asString]"><input type="submit" name="submit" value="submit"></form> [if(#exprsafe)]

Result: [#exprresult] [#exprcorrect ? 'is CORRECT!' | 'is incorrect']

[/if]</lang>

Liberty BASIC

<lang lb>dim d(4) dim chk(4) print "The 24 Game" print print "Given four digits and using just the +, -, *, and / operators; and the" print "possible use of brackets, (), enter an expression that equates to 24."

do

   d$=""
   for i = 1 to 4
       d(i)=int(rnd(1)*9)+1    '1..9
       chk(i)=d(i)
       d$=d$;d(i)  'valid digits, to check with Instr
   next
   print
   print "These are your four digits: ";
   for i = 1 to 4
       print d(i);left$(",",i<>4);
   next
   print
   Print "Enter expression:"
   Input "24 = ";expr$
   'check expr$ for validity
   'check right digits used
   failed = 0
   for i = 1 to len(expr$)
       c$=mid$(expr$,i,1)
       if instr("123456789", c$)<>0 then 'digit
           if instr(d$, c$)=0 then failed = 1: exit for
           if i>1 and instr("123456789", mid$(expr$,i-1,1))<>0 then failed = 2: exit for
           for j =1 to 4
               if chk(j)=val(c$) then chk(j)=0: exit for
           next
       end if
   next
   if failed=1 then
       print "Wrong digit (";c$;")"
       goto [fail]
   end if
   if failed=2 then
       print "Multiple digit numbers is disallowed."
       goto [fail]
   end if
   'check all digits used
   if chk(1)+ chk(2)+ chk(3)+ chk(4)<>0 then
       print "Not all digits used"
       goto [fail]
   end if
   'check valid operations
   failed = 0
   for i = 1 to len(expr$)
       c$=mid$(expr$,i,1)
       if instr("+-*/()"+d$, c$)=0 then failed = 1: exit for
   next
   if failed then
       print "Wrong operation (";c$;")"
       goto [fail]
   end if
   'some errors (like brackets) trapped by error handler
   Err$=""
   res=evalWithErrCheck(expr$)
   if Err$<>"" then
       print "Error in expression"
       goto [fail]
   end if
   if res = 24 then
       print "Correct!"
   else
       print "Wrong! (you got ";res ;")"
   end if

[fail]

   Input "Play again (y/n)? "; ans$

loop while ans$="y" end

function evalWithErrCheck(expr$)

   on error goto [handler]
   evalWithErrCheck=eval(expr$)
   exit function

[handler] end function</lang>

Locomotive Basic

<lang locobasic>10 CLS:RANDOMIZE TIME 20 PRINT "The 24 Game" 30 PRINT "===========":PRINT 40 PRINT "Enter an arithmetic expression" 50 PRINT "that evaluates to 24," 60 PRINT "using only the provided digits" 70 PRINT "and +, -, *, /, (, )." 80 PRINT "(Just hit Return for new digits.)" 90 ' create new digits 100 FOR i=1 TO 4:a(i)=INT(RND*9)+1:NEXT 110 PRINT 120 PRINT "The digits are";a(1);a(2);a(3);a(4) 130 PRINT 140 ' user enters solution 150 INPUT "Your solution";s$ 160 IF s$="" THEN PRINT "Creating new digits...":GOTO 100 170 GOTO 300 180 ' a little hack to create something like an EVAL function 190 OPENOUT "exp.bas" 200 PRINT #9,"1000 x="s$":return" 210 CLOSEOUT 220 CHAIN MERGE "exp",240 230 ' now evaluate the expression 240 ON ERROR GOTO 530 250 GOSUB 1000 260 IF x=24 THEN PRINT "Well done!":END 270 PRINT "No, this evaluates to"x:PRINT "Please try again." 280 GOTO 150 290 ' check input for correctness 300 FOR i=1 TO LEN(s$) 310 q=ASC(MID$(s$,i,1)) 320 IF q=32 OR (q>39 AND q<44) OR q=45 OR (q>46 AND q<58) THEN NEXT 330 IF i-1=LEN(s$) THEN 370 340 PRINT "Bad character in expression:"CHR$(q) 350 PRINT "Try again":GOTO 150 360 ' new numbers in solution? 370 FOR i=1 TO LEN(s$)-1 380 q=ASC(MID$(s$,i,1)):p=ASC(MID$(s$,i+1,1)) 390 IF q>47 AND q<58 AND p>47 AND p<58 THEN PRINT "No forming of new numbers, please!":GOTO 150 400 NEXT 410 FOR i=1 TO 9:orig(i)=0:guess(i)=0:NEXT 420 FOR i=1 TO 4:orig(a(i))=orig(a(i))+1:NEXT 430 FOR i=1 TO LEN(s$) 440 v$=MID$(s$,i,1) 450 va=ASC(v$)-48 460 IF va>0 AND va<10 THEN guess(va)=guess(va)+1 470 NEXT 480 FOR i=1 TO 9 490 IF guess(i)<>orig(i) THEN PRINT "Only use all the provided digits!":GOTO 150 500 NEXT 510 GOTO 190 520 ' syntax error, e.g. non-matching parentheses 530 PRINT "Error in expression, please try again." 540 RESUME 150</lang>

Note: The program needs a writable disk in the active disk drive.

Works with: UCB_Logo version 5.5

<lang logo>; useful constants make "false 1=0 make "true 1=1 make "lf char 10 make "sp char 32

non-digits legal in expression

make "operators (lput sp [+ - * / \( \)])

display help message

to show_help :digits

 type lf
 print sentence quoted [Using only these digits:] :digits 
 print sentence quoted [and these operators:] [* / + -]
 print quoted [\(and parentheses as needed\),]
 print quoted [enter an arithmetic expression 
    which evaluates to exactly 24.]
 type lf
 print quoted [Enter \"!\" to get fresh numbers.]
 print quoted [Enter \"q\" to quit.]
 type lf

end

make "digits [] make "done false until [done] [

 if empty? digits [
   make "digits (map [(random 9) + 1] [1 2 3 4])
 ]
 (type "Solution sp "for sp digits "? sp )
 make "expression readrawline
 ifelse [expression = "?] [
   show_help digits
 ] [ifelse [expression = "q] [
   print "Bye!
   make "done true
 ] [ifelse [expression = "!] [
   make "digits []
 ] [
   make "exprchars ` expression
   make "allowed (sentence digits operators)
   ifelse (member? false (map [[c] member? c allowed] exprchars)) [
     (print quoted [Illegal character in input.])
   ] [
     catch "error [
       make "syntax_error true
       make "testval (run expression)
       make "syntax_error false
     ]
     ifelse syntax_error [
       (print quoted [Invalid expression.])
     ] [
       ifelse (testval = 24) [
         print quoted [You win!]
         make "done true
       ] [
         (print (sentence 
           quoted [Incorrect \(got ] testval quoted [instead of 24\).]))
       ]
     ]
   ]
 ]]]

] bye</lang> Sample output:

Solution for 3 8 9 5? ?

Using only these digits: 3 8 9 5
and these operators: * / + -
(and parentheses as needed),
enter an arithmetic expression which evaluates to exactly 24.

Enter "!" to get fresh numbers.
Enter "q" to quit.

Solution for 3 8 9 5? !
Solution for 9 2 8 5? 9+2+8+5
You win!

Lua

<lang lua> local function help() print [[

The 24 Game
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.
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.
]]

end

local function generate(n) result = {} for i=1,n do result[i] = math.random(1,9) end return result end

local function check(answer, digits) local adig = {} local ddig = {} local index local lastWasDigit = false for i=1,9 do adig[i] = 0 ddig[i] = 0 end allowed = {['(']=true,[')']=true,[' ']=true,['+']=true,['-']=true,['*']=true,['/']=true,['\t']=true,['1']=true,['2']=true,['3']=true,['4']=true,['5']=true,['6']=true,['7']=true,['8']=true,['9']=true} for i=1,string.len(answer) do if not allowed[string.sub(answer,i,i)] then return false end index = string.byte(answer,i)-48 if index > 0 and index < 10 then if lastWasDigit then return false end lastWasDigit = true adig[index] = adig[index] + 1 else lastWasDigit = false end end for i,digit in next,digits do ddig[digit] = ddig[digit]+1 end for i=1,9 do if adig[i] ~= ddig[i] then return false end end return loadstring('return '..answer)() end

local function game24() help() math.randomseed(os.time()) math.random() local digits = generate(4) local trial = 0 local answer = 0 local ans = false io.write 'Your four digits:' for i,digit in next,digits do io.write (' ' .. digit) end print() while ans ~= 24 do trial = trial + 1 io.write("Expression "..trial..": ") answer = io.read() if string.lower(answer) == 'q' then break end if answer == '!' then digits = generate(4) io.write ("New digits:") for i,digit in next,digits do io.write (' ' .. digit) end print() else ans = check(answer,digits) if ans == false then print ('The input '.. answer ..' was wonky!') else print (' = '.. ans) if ans == 24 then print ("Thats right!") end end end end end game24()</lang>

Alternately, using the lpeg.re module:

<lang lua>function twentyfour()

  print [[
The 24 Game

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.

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.

]]
  expr = re.compile[[   --matches properly formatted infix expressions and returns all numerals as captures
        expr <- (!.) / (<paren> / <number>) (<ws> <oper> <ws> <expr>)?
        number <- {[0-9]}
        ws <- " "*
        oper <- [-+/*]
        paren <- "(" <ws> <expr> <ws> ")"   ]]
  local val_t = {math.random(9), math.random(9), math.random(9), math.random(9)}
  table.sort(val_t)
  print("the digits are " .. table.concat(val_t, ", "))
  local ex = io.read()
  a, b, c, d, e = expr:match(ex)
  if a and b and c and d and not e then --if there is a fifth numeral the player is cheating
     local digs = {a + 0, b + 0, c + 0, d + 0}
     local flag = false -- (terrorism!)
     table.sort(digs)
     for i = 1, 4 do

flag = digs[i] ~= val_t[i] and not print"Wrong digits!" or flag

     end
     if not flag and loadstring("return " .. ex)() == 24 then
        print"You win!"
     else
        print"You lose."
     end
  else print"wat" --expression could not be interpreted as arithmetic
  end

end twentyfour()</lang>

Mathematica

Works with: Mathematica version 6

Since Mathematica hasn't historically had good custom I/O support (the command-line allowed all operations, not very good for UI-generation), I had to roll some custom GUI (with a text box), which requires Mathematica 6.

Most of the job is already done by Mathematica (the expression conversion); in fact, it is too good—it automatically converts ex. 3/4 to Times[3, Power[4, -1]], which we have to specifically test for so that real powers don't get through.

<lang Mathematica>isLegal[n_List, x_String] :=

Quiet[Check[
  With[{h = ToExpression[x, StandardForm, HoldForm]}, 
   If[Cases[Level[h, {2, \[Infinity]}, Hold, Heads -> True], 
       Except[_Integer | Plus | _Plus | Times | _Times | Power | 
         Power[_, -1]]] === {} && 
     Sort[Level[h /. Power[q_, -1] -> q, {-1}] /. 
        q_Integer -> Abs[q]] === Sort[n], ReleaseHold[h]]], Null]]

Grid[{{Button[

   "new numbers", {a, b, c, d} = Table[RandomInteger[{1, 9}], {4}]], 
  InputField[Dynamic[x], String]}, {Dynamic[{a, b, c, d}], 
  Dynamic[Switch[isLegal[{a, b, c, d}, x], Null, 
    "Sorry, that is invalid.", 24, "Congrats! That's 24!", _, 
    "Sorry, that makes " <> ToString[ToExpression@x, InputForm] <> 
     ", not 24."]]}}]</lang>

MATLAB / Octave

<lang Matlab> function twentyfour()

 N = 4;
 n = ceil(rand(1,N)*9);
 printf('Generate a equation with the numbers %i, %i, %i, %i and +, -, *, /, () operators ! \n',n);
 s = input(': ','s');
 t = s;
 for k = 1:N,
   [x,t] = strtok(t,'+-*/() \t');
    if length(x)~=1,
      error('invalid sign %s\n',x);
    end; 
    y = x-'0';
    if ~(0 < y & y < 10) 
      error('invalid sign %s\n',x);
    end;
    z(1,k) = y;  	
 end; 
 if any(sort(z)-sort(n)) 
   error('numbers do not match.\n');	
 end; 
 val =  eval(s);
 if val==24,
   fprintf('expression "%s" results in %i.\n',s,val);	
 else
   fprintf('expression "%s" does not result in 24 but %i.\n',s,val);
 end; 	</lang>

mIRC Scripting Language

<lang mirc>alias 24 {

 dialog -m 24-Game 24-Game

}

dialog 24-Game {

 title "24-Game"
 size -1 -1 100 70
 option dbu
 text "", 1, 29 7 42 8
 text "Equation", 2, 20 21 21 8
 edit "", 3, 45 20 40 10
 text "Status", 4, 10 34 80 8, center
 button "Calculate", 5, 5 45 40 20
 button "New", 6, 57 47 35 15

}

on *:DIALOG:24-Game:init:*: {

 did -o 24-Game 1 1 Numbers: $rand(1,9) $rand(1,9) $rand(1,9) $rand(1,9)

}

on *:DIALOG:24-Game:sclick:*: {

 if ($did == 5) {
   if ($regex($did(3),/^[ (]*\d *[-+*/][ (]*\d[ ()]*[-+*/][ ()]*\d[ )]*[-+*/] *\d[ )]*$/)) && ($sorttok($regsubex($did(3),/[^\d]+/g,$chr(32)),32) == $sorttok($remove($did(1),Numbers:),32)) {
     did -o 24-Game 4 1 $iif($calc($did(3)) == 24,Correct,Wrong)
   }
   else {
     did -o 24-Game 4 1 Wrong Numbers or Syntax
   }
 }
 elseif ($did == 6) {
   did -o 24-Game 1 1 Numbers: $rand(1,9) $rand(1,9) $rand(1,9) $rand(1,9)
 }

}</lang>

Modula-2

<lang modula2>MODULE TwentyFour;

FROM InOut IMPORT WriteString, WriteLn, Write, ReadString, WriteInt; FROM RandomGenerator IMPORT Random;

TYPE operator_t = (add, sub, mul, div); expr_t = RECORD operand : ARRAY[0..3] OF CARDINAL; operator : ARRAY[1..3] OF operator_t; END;(*of RECORD*) numbers_t = SET OF CHAR;

VAR expr : expr_t; numbers : numbers_t; (*******************************************************************createExpr*) (*analyse the input string *) PROCEDURE createExpr(s: ARRAY OF CHAR);

VAR index, counter : INTEGER; token : CHAR; temp_expr : expr_t; operand : CARDINAL; operator : operator_t;

(************************************nextToken*) (* returns the next CHAR that isn`t a space *) PROCEDURE nextToken(): CHAR; BEGIN INC(index); WHILE (s[index] = ' ') DO INC(index); END;(*of WHILE*) RETURN(s[index]); END nextToken; (***********************************set_operand*) (* checks if the CHAR o inerhits a valid number*) (* and sets 'operand' to its value *) PROCEDURE set_operand(o: CHAR); BEGIN CASE o OF '0'..'9': IF o IN numbers THEN operand := ORD(o)-48; numbers := numbers - numbers_t{o}; ELSE WriteString("ERROR: '"); Write( o); WriteString( "' isn`t a available number "); WriteLn; HALT; END;(*of IF*)| 0  : WriteString("ERROR: error in input "); WriteLn; HALT; ELSE WriteString("ERROR: '"); Write( o); WriteString( "' isn`t a number "); WriteLn; HALT; END;(*of CASE*) END set_operand; (**********************************set_operator*) (* checks if the CHAR o inerhits a valid *) (* operator and sets 'operator' to its value *) PROCEDURE set_operator(o: CHAR); BEGIN CASE o OF '+' : operator := add;| '-' : operator := sub;| '*' : operator := mul;| '/' : operator := div;| 0  : WriteString("ERROR: error in input "); WriteLn; HALT; ELSE WriteString("ERROR: '"); Write( o); WriteString( "' isn`t a operator "); WriteLn; HALT; END;(*of CASE*) END set_operator; (************************************************) BEGIN index := -1;

token := nextToken(); set_operand(token); expr.operand[0] := operand;

token := nextToken(); set_operator(token); expr.operator[1] := operator;


token := nextToken(); set_operand(token); expr.operand[1] := operand;

token := nextToken(); set_operator(token); expr.operator[2] := operator;

token := nextToken(); set_operand(token); expr.operand[2] := operand;

token := nextToken(); set_operator(token); expr.operator[3] := operator;

token := nextToken(); set_operand(token); expr.operand[3] := operand; END createExpr;

(*****************************************************************evaluateExpr*) (* evaluate the expresion that was createt by 'createExpr' *)

PROCEDURE evaluateExpr(VAR num: REAL);

VAR index : INTEGER; BEGIN WITH expr DO num := VAL(REAL,operand[0]); FOR index := 1 TO 3 DO CASE operator[index] OF add : num := num + VAL(REAL,operand[index]);| sub : num := num - VAL(REAL,operand[index]);| mul : num := num * VAL(REAL,operand[index]);| div : num := num / VAL(REAL,operand[index]); END;(*of CASE*) END;(*of FOR*) END;(*of WIHT*) END evaluateExpr;

(**************************************************************generateNumbers*) (* generates the 4 random numbers ond write them *) PROCEDURE generateNumbers; VAR index,ran : INTEGER; BEGIN numbers := numbers_t{}; ran := Random(0,9); FOR index := 1 TO 4 DO WHILE (CHR(ran+48) IN numbers )DO ran := Random(0,9); END;(*of While*) Write(CHR(ran+48)); WriteLn; numbers := numbers + numbers_t{CHR(ran+48)} END;(*of FOR*) END generateNumbers; (****************************************************************Main Programm*) VAR str : ARRAY[0..255] OF CHAR; sum : REAL; BEGIN WriteString("Welcome to the 24 game in MODULA-2"); WriteLn; WriteString("Here are your numbers:"); WriteLn; generateNumbers; WriteString("Enter your equation(This implementation dosn`t support brackets yet): "); WriteLn; ReadString(str); createExpr(str); evaluateExpr(sum); WriteLn; WriteString("Result:"); WriteLn; WriteInt(TRUNC(sum),0); WriteLn; CASE (TRUNC(sum) - 24) OF 0 : WriteString("Perfect!");| 1 : WriteString("Almost perfect."); ELSE WriteString("You loose!"); END;(*of CASE*) WriteLn; END TwentyFour.</lang>

OCaml

Compile with:

ocamlopt -pp camlp4o g24.ml -o g24.opt

<lang ocaml>type expression =

 | Const of float
 | Sum  of expression * expression   (* e1 + e2 *)
 | Diff of expression * expression   (* e1 - e2 *)
 | Prod of expression * expression   (* e1 * e2 *)
 | Quot of expression * expression   (* e1 / e2 *)

let rec eval = function

 | Const c -> c
 | Sum (f, g) -> eval f +. eval g
 | Diff(f, g) -> eval f -. eval g
 | Prod(f, g) -> eval f *. eval g
 | Quot(f, g) -> eval f /. eval g

let rec extract acc = function

 | Const c -> (c::acc)
 | Sum (f, g) -> (extract acc f) @ (extract [] g)
 | Diff(f, g) -> (extract acc f) @ (extract [] g)
 | Prod(f, g) -> (extract acc f) @ (extract [] g)
 | Quot(f, g) -> (extract acc f) @ (extract [] g)

open Genlex

let lexer = make_lexer ["("; ")"; "+"; "-"; "*"; "/"]

let rec parse_expr = parser

    [< e1 = parse_mult; e = parse_more_adds e1 >] -> e
and parse_more_adds e1 = parser
    [< 'Kwd "+"; e2 = parse_mult; e = parse_more_adds (Sum(e1, e2)) >] -> e
  | [< 'Kwd "-"; e2 = parse_mult; e = parse_more_adds (Diff(e1, e2)) >] -> e
  | [< >] -> e1
and parse_mult = parser
    [< e1 = parse_simple; e = parse_more_mults e1 >] -> e
and parse_more_mults e1 = parser
    [< 'Kwd "*"; e2 = parse_simple; e = parse_more_mults (Prod(e1, e2)) >] -> e
  | [< 'Kwd "/"; e2 = parse_simple; e = parse_more_mults (Quot(e1, e2)) >] -> e
  | [< >] -> e1
and parse_simple = parser
  | [< 'Int i >] -> Const(float i)
  | [< 'Float f >] -> Const f
  | [< 'Kwd "("; e = parse_expr; 'Kwd ")" >] -> e


let parse_expression = parser [< e = parse_expr; _ = Stream.empty >] -> e

let read_expression s = parse_expression(lexer(Stream.of_string s))


let () =

 Random.self_init();
 print_endline "
 The 24 Game
 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.
 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.\n";
 let sort = List.sort compare in
 let digits = ref [] in
 let digit_set () =
   let ar = Array.init 4 (fun _ -> 1 + Random.int 9) in
   digits := Array.to_list(Array.map float_of_int ar);
   print_string "The four digits: ";
   List.iter (Printf.printf " %g") !digits;
   print_newline();
 in
 digit_set();
 while true do
   print_string "Expression: ";
   let str = read_line() in
   if str = "q" then exit 0;
   if str = "!" then digit_set()
   else begin
     let expr = read_expression str in
     let res = eval expr in
     Printf.printf " = %g\n%!" res;
     if res = 24.
     && (sort !digits) = (sort (extract [] expr))
     then (print_endline "Congratulations!"; digit_set())
     else print_endline "Try again"
   end
 done</lang>

OpenEdge/Progress

The dynamic query parser is used to evaluate the expression. <lang Progress (OpenEdge ABL)>DEFINE TEMP-TABLE tt NO-UNDO FIELD ii AS INTEGER.

DEFINE VARIABLE p_deanswer AS DECIMAL NO-UNDO. DEFINE VARIABLE idigits AS INTEGER NO-UNDO EXTENT 4. DEFINE VARIABLE ii AS INTEGER NO-UNDO. DEFINE VARIABLE Digits AS CHARACTER NO-UNDO FORMAT "x(7)". DEFINE VARIABLE Answer AS CHARACTER NO-UNDO FORMAT "x(7)". DEFINE VARIABLE cexpression AS CHARACTER NO-UNDO. DEFINE VARIABLE cmessage AS CHARACTER NO-UNDO. DEFINE VARIABLE cchar AS CHARACTER NO-UNDO.

FUNCTION calculate RETURNS LOGICAL (

  i_de AS DECIMAL

):

  p_deanswer = i_de.

END FUNCTION.

/* generate problem */ DO ii = 1 TO 4:

  ASSIGN
     idigits [ii]   =  RANDOM( 1, 9 ).
     Digits         =  Digits + STRING( idigits [ii] ) + " "
     .

END.

/* ui */ DISPLAY Digits. UPDATE Answer.

/* check valid input */ DO ii = 1 TO 7:

  cchar = SUBSTRING( Answer, ii, 1 ).
  IF cchar > "" THEN DO:
     IF ii MODULO 2 = 1 THEN DO:
        IF LOOKUP( cchar, Digits, " " ) = 0 THEN
           cmessage = cmessage + SUBSTITUTE( "Invalid digit: &1.~r", cchar ).
        ELSE 
           ENTRY( LOOKUP( cchar, Digits, " " ), Digits, " " ) = "".
     END.
     ELSE DO:
        IF LOOKUP( cchar, "+,-,/,*" ) = 0 THEN
           cmessage = cmessage + SUBSTITUTE( "&1 is not a valid operator.~r", cchar ).
     END.
  END.

END. IF TRIM( Digits ) > "" THEN

  cmessage = cmessage + SUBSTITUTE( "You did not use digits: &1":U, TRIM( Digits ) ).

IF cmessage = "" THEN DO:

  /* expressions need spacing */
  DO ii = 1 TO 7:
     cexpression = cexpression + SUBSTRING( Answer, ii, 1 ) + " ".
  END.
  /* use dynamic query to parse expression */
  TEMP-TABLE tt:DEFAULT-BUFFER-HANDLE:FIND-FIRST( 
     SUBSTITUTE(
        "WHERE NOT DYNAMIC-FUNCTION( 'calculate', DECIMAL( &1 ) )",
        cexpression
     )
  ) NO-ERROR.
  IF p_deanswer <> 24 THEN
     cmessage = cmessage + SUBSTITUTE( "The expression evaluates to &1.", p_deanswer ).
  ELSE 
     cmessage = "Solved!".

END.

MESSAGE cmessage VIEW-AS ALERT-BOX. </lang>

ooRexx

While the solution shown within this page at Rexx version 2 was created for Classic Rexx it also can be used unchanged by the ooRexx interpreter and so can be considered a solution for the ooRexx language too.

Incompatibilities(*) that were originally in Rexx version 1 were meanwhile "fixed", so it also can be used unchanged by the ooRexx interpreter and so can be considered a solution for the ooRexx language too.

(*) Classic Rexx accepts assignment without an expression (x=;), ooRexx does not.

PARI/GP

This example is untested. Please check that it's correct, debug it as necessary, and remove this message.


<lang parigp>game()={

 my(v=vecsort(vector(4,i,random(8)+1)));
 print("Form 24 using */+-() and: "v);
 while(1,
   my(ans=input);
   if (!valid(s,v), next);
   trap(,
     print("Arithmetic error");
     next
   ,
     if(eval(s)==24, break, print("Bad sum"))
   )
 );
 print("You win!")

}; valid(s,v)={

 my(op=vecsort(Vec("+-*/()")),u=[]);
 s=Vec(s);
 for(i=1,#s,
   if(setsearch(op,s[i]),next);
   trap(,
     print("Invalid character "s[i]);
     return(0)
   ,
     if(setsearch(v,eval(s[i])),
       u=concat(u,eval(s[i]))
     ,
       print(s[i]" not allowed");
       return(0)
     )
   )
 );
 for(i=2,#s,
   if(!setsearch(op,s[i])&!setsearch(op,s[i-1]),
     print("Concatenating digits is not allowed!");
     return(0)
   )
 );
 if(vecsort(u)!=v,
   print("Invalid digits");
   0
 ,
   1
 )

};</lang>

Perl

<lang perl>#!/usr/bin/perl

use strict; use warnings;

print <<'EOF'; The 24 Game

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

while(1) {

   my $iteration_num = 0;
   my $numbers = make_numbers();
   
   TRY_SOLVING:
   while(1)
   {
       $iteration_num++;
       print "Expression ${iteration_num}: ";
       my $entry = <>;
       chomp($entry);
       last TRY_SOLVING if $entry eq '!';
       exit if $entry eq 'q';
       my $result = play($numbers, $entry);
       if (!defined $result)
       {
           print "That's not valid\n";
           next TRY_SOLVING;
       }
       elsif ($result != 24)
       {
           print "Sorry, that's $result\n";
           next TRY_SOLVING;
       }
       else
       { 
           print "That's right! 24!!\n";
           exit; 
       }
   }

}

sub make_numbers {

   my %numbers = ();
   print "Your four digits:";
   for(1..4)
   {
       my $i = 1 + int(rand(9));
       $numbers{$i}++;
       print "$i ";
   }
   print "\n";
   return \%numbers;

}

sub play {

   my ($numbers, $expression) = @_;
   my %running_numbers = %$numbers;
   my @chars = split //, $expression;
   my $operator = 1;
   CHARS:
   foreach (@chars)
   {
       next CHARS if $_ =~ /[()]/;
       $operator = !$operator;
       if (! $operator)
       {
           if (defined $running_numbers{$_} && $running_numbers{$_} > 0)
           {
               $running_numbers{$_}--;
               next CHARS;
           }
           else
           {
               return;
           }
       }
       else
       {
           return if $_ !~ m{[-+*/]};
       }
   }
   foreach my $remaining (values(%running_numbers))
   {
       if ($remaining > 0)
       {
           return;
       }
   }
   return eval($expression);

} </lang>

Perl 6

Works with: Rakudo version 2010.09.16

<lang perl6>grammar Exp24 {

   token TOP { ^ <exp> $ }
   token exp { <term> [ <op> <term> ]* }
   token term { '(' <exp> ')' | \d }
   token op { '+' | '-' | '*' | '/' }

}

my @digits = roll 4, 1..9; # to a gamer, that's a "4d9" roll say "Here's your digits: {@digits}";

while my $exp = prompt "\n24-Exp? " {

   unless is-valid($exp, @digits) {
       say "Sorry, your expression is not valid!";
       next;
   }
   my $value = eval $exp;
   say "$exp = $value";
   if $value == 24 {
       say "You win!";
       last;
   }
   say "Sorry, your expression doesn't evaluate to 24!";

}

sub is-valid($exp, @digits) {

   unless ?Exp24.parse($exp) {
       say "Expression doesn't match rules!";
       return False;
   }
   unless $exp.comb(/\d/).sort.join == @digits.sort.join {
       say "Expression must contain digits {@digits} only!";
       return False;
   }
   return True;

}</lang>

PicoLisp

<lang PicoLisp>(de checkExpression (Lst Exe)

  (make
     (when (diff Lst (fish num? Exe))
        (link "Not all numbers used" ) )
     (when (diff (fish num? Exe) Lst)
        (link "Using wrong number(s)") )
     (when (diff (fish sym? Exe) '(+ - * /))
        (link "Using illegal operator(s)") ) ) )

(loop

  (setq Numbers (make (do 4 (link (rand 1 9)))))
  (prinl
     "Please enter a Lisp expression using (, ), +, -, *, / and "
     (glue ", " Numbers) )
  (prin "Or a single dot '.' to stop: ")
  (T (= "." (setq Reply (catch '(NIL) (in NIL (read)))))
     (bye) )
  (cond
     ((str? Reply)
        (prinl "-- Input error: " Reply) )
     ((checkExpression Numbers Reply)
        (prinl "-- Illegal Expression")
        (for S @
           (space 3)
           (prinl S) ) )
     ((str? (setq Result (catch '(NIL) (eval Reply))))
        (prinl "-- Evaluation error: " @) )
     ((= 24 Result)
        (prinl "++ Congratulations! Correct result :-)") )
     (T (prinl "Sorry, this gives " Result)) )
  (prinl) )</lang>

Output:

Please enter a Lisp expression using (, ), +, -, *, / and 1, 3, 3, 5
Or a single dot '.' to stop: (* (+ 3 1) (+ 5 1))
++ Congratulations! Correct result :-)

Please enter a Lisp expression using (, ), +, -, *, / and 8, 4, 7, 1
Or a single dot '.' to stop: (* 8 (% 7 3) 9)
-- Illegal Expression
   Not all numbers used
   Using wrong number(s)
   Using illegal operator(s)

Please enter a Lisp expression using (, ), +, -, *, / and 4, 2, 2, 3
Or a single dot '.' to stop: (/ (+ 4 3) (- 2 2))
-- Evaluation error: Div/0

Please enter a Lisp expression using (, ), +, -, *, / and 8, 4, 5, 9
Or a single dot '.' to stop: .

PL/I

<lang pli> /* Plays the game of 24. */

TWENTYFOUR: procedure options (main); /* 14 August 2010 */

CTP: procedure (E) returns (character(50) varying);

  declare E character (*) varying;
  declare OUT character (length(E)) varying;
  declare S character (length(E)) varying controlled;
  declare c character (1);
  declare i fixed binary;

/* This procedure converts an arithmetic expression to Reverse Polish Form. */ /* A push-down pop-up stack is used for operators. */ priority: procedure (a) returns (fixed decimal (1));

  declare a character (1);
  declare ops character (10) initial ('#+-*/') varying static;
  declare pri(6) fixed decimal (1) initial (1,2,2,3,3,4) static;
  declare i fixed binary;
  i = index(ops,a);
  return (pri(i));

end priority;

  allocate S; S = '#'; out = ;
  do i = 1 to length(E);
     c = substr(E, i, 1);
     if index('+-*/', c) > 0 then
        do;
           /* Copy any higher priority operators on the stack to the output. */
           do while ( priority(c) <= priority((S)) );
              out = out || S;
              free S;
           end;
           /* Copy the input character to the stack. */
           allocate S; S = c;
        end;
     if index('123456789', c) > 0 then
        out = out || c;
  end;
  do while (allocation(S) > 1);
     out = out || s;
     free S;
  end;
  return (out);

end CTP;

/* Given a push-down pop-up stack, and an expresion in */ /* Reverse Polish notation, evaluate the expression. */ EVAL: procedure (E) returns (fixed decimal(15));

  declare E character (*) varying;
  declare S fixed decimal (15) controlled;
  declare (a, b) fixed decimal (15);
  declare c character (1);
  declare p fixed binary;
  declare (empty_stack, invalid_expression) condition;
  on condition (empty_stack) begin;
     put skip list ('Your expression is not valid.');
     stop;
  end;
  on condition (invalid_expression) begin;
     put skip list ('Your expression is not valid.');
     stop;
  end;
  do p = 1 to length(E);
     c = substr(E, p, 1);
     if index('123456789', c) > 0 then
        do; allocate S; S = c; end;
     else
        do;
           if allocation(S) = 0 then signal condition (empty_stack);
           b = S; free S;
           if allocation(S) = 0 then signal condition (empty_stack);
           a = S;
           select (c);
              when ('+') S = a + b; 
              when ('-') S = a - b;
              when ('*') S = a * b;
              when ('/') S = a / b;
              when ('^') S = a ** b;
              otherwise signal condition (invalid_expression);
           end;
        end;
  end;
  if allocation(S) ^= 1 then signal condition (invalid_expression);
  return (S);

END eval;

/* Check that the player has used every digit and no others. */ VALIDATE: procedure (E);

  declare E character (*) varying;
  declare E2 character (length(E)), (i, j) fixed binary;
  declare digits(9) character (1) static initial
     ('1', '2', '3', '4', '5', '6', '7', '8', '9');
  E2 = translate(E, '    ', '+-*/' );
  do i = 1 to 4;
     j = index(E2, digits(k(i)));
     if j > 0 then
        substr(E2, j, 1) = ' ';
     else
        do; put skip list ('You must use the digits supplied.'); stop; end;
  end;
  if E2 ^=  then
     do; put skip list ('You must use every digit supplied, and no others.'); stop; end;

end VALIDATE;

  declare E character (40) varying;
  declare k(4) fixed decimal;
  declare (time, random) builtin;
  declare V fixed decimal (15);
  k = random(TIME);
  k = 9*random() + 1;
  put skip edit ('Here are four integers:', k) (a);
  put skip list ('With these integers, make up an arithmetic expression' ||
     ' that evaluates to 24.');
  put skip list ('You can use any of the operators +, -, *, and /');
  put skip list ('E.g., Given the integers 1, 3, 7, and 6,' ||
     ' the expression 6*3+7-1 evaluates to 24.');
  put skip list ('Please type an arithmetic expression :');
  get edit (E) (L) COPY;
  CALL VALIDATE (E); /* Check that the player has used every digit and no others. */
  E = CTP(E);
  V = EVAL (E);
  if V = 24 then
     put skip list ('Congratulations: the expression evaluates to 24.');
  else
     put skip edit ('The result is ', trim(V), ' which is not correct') (a);

end TWENTYFOUR; </lang>

PowerShell

The "isNumeric" function was taken from the "Determine_if_a_string_is_numeric" task.

todo: add a validation that all given digits were used. Right now the validation is that 4 digits should be used in the expression, but not exactly the ones given. (example: if you are given the digits 2, 2, 6, 9 this program accepts the following solution: 6 * 4 * 2 / 2)

<lang powershell> CLS

Function isNumeric ($x) {

   $x2 = 0    
   $isNum = [System.Int32]::TryParse($x,[ref]$x2)

Return $isNum }

$NumberArray = @() While( $NumberArray.Count -lt 4 ){

   $NumberArray += Random -Minimum 1 -Maximum 10

}

Write-Host @" Welcome to the 24 game!

Here are your numbers: $($NumberArray -join ","). Use division, multiplication, subtraction and addition to get 24 as a result with these 4 numbers. "@

Do { $Wrong = 0 $EndResult = $null $TempChar = $null $TempChar2 = $null $Count = $null

$AllowableCharacters = $NumberArray + "+-*/()".ToCharArray()

   $Result = Read-Host
       Foreach($Char in $Result.ToCharArray())
       {
           If( $AllowableCharacters -notcontains $Char ){ $Wrong = 1 }
       }
       If($Wrong -eq 1)
       {
           Write-Warning "Wrong input! Please use only the given numbers."
       }
       Foreach($Char in $Result.ToCharArray())
       {
           If((IsNumeric $TempChar) -AND (IsNumeric $Char))
           {
               Write-Warning "Wrong input! Combining two or more numbers together is not allowed!"
           }
           $TempChar = $Char
       }
       Foreach($Char in $Result.ToCharArray())
       {
           If(IsNumeric $Char)
           {
               $Count++
           }
       }
       If($Count -eq 4)
       {
           $EndResult = Invoke-Expression $Result
               If($EndResult -eq 24)
               {
                   Write-Host "`nYou've won the game!"
               }
               Else
               {
                   Write-Host "`n$EndResult is not 24! Too bad."
               }
       }
       Else
       {
           Write-Warning "Wrong input! You did not supply four numbers."
       }

} While($EndResult -ne 24) </lang>

PHP

Translation of: Perl

<lang PHP>#!/usr/bin/env php The 24 Game

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

<?php

while (true) {

   $numbers = make_numbers();
   for ($iteration_num = 1; ; $iteration_num++) {
       echo "Expresion $iteration_num: ";
       $entry = rtrim(fgets(STDIN));
       if ($entry === '!') break;
       if ($entry === 'q') exit;
       $result = play($numbers, $entry);
       if ($result === null) {
           echo "That's not valid\n";
           continue;
       }
       elseif ($result != 24) {
           echo "Sorry, that's $result\n";
           continue;
       }
       else {
           echo "That's right! 24!!\n";
           exit;
       }
   }

}

function make_numbers() {

   $numbers = array();
   echo "Your four digits: ";
   for ($i = 0; $i < 4; $i++) {
       $number = rand(1, 9);
       // The check is needed to avoid E_NOTICE from PHP
       if (!isset($numbers[$number])) {
           $numbers[$number] = 0;
       }
       $numbers[$number]++;
       print "$number ";
   }
   print "\n";
   return $numbers;

}

function play($numbers, $expression) {

   $operator = true;
   for ($i = 0, $length = strlen($expression); $i < $length; $i++) {
       $character = $expression[$i];
       if (in_array($character, array('(', ')', ' ', "\t"))) continue;
       $operator = !$operator;
       if (!$operator) {
           if (!empty($numbers[$character])) {
               $numbers[$character]--;
               continue;
           }
           return;
       }
       elseif (!in_array($character, array('+', '-', '*', '/'))) {
           return;
       }
   }
   foreach ($numbers as $remaining) {
       if ($remaining > 0) {
           return;
       }
   }
   
   return eval("return $expression;");

} ?></lang>

ProDOS

This example uses the math module: <lang ProDOS>:a editvar /modify -random- = <10 printline These are your four digits: -random- -random- -random- -random- printline Use an algorithm to make the number 24. editvar /newvar /value=a /userinput=1 /title=Algorithm: do -a- if -a- /hasvalue 24 printline Your algorithm worked! & goto :b ( ) else printline Your algorithm did not work.

b

editvar /newvar /value=b /userinput=1 /title=Do you want to play again? if -b- /hasvalue y goto :a else exitcurrentprogram</lang>

PureBasic

<lang PureBasic>#digitCount = 4 Global Dim digits(#digitCount - 1) ;holds random digits

Procedure showDigits()

 Print(#CRLF$ + "These are your four digits: ")
 Protected i
 For i = 0 To #digitCount - 1
   Print(Str(digits(i)))
   If i < (#digitCount - 1)
     Print(", ")
   Else
     PrintN("")
   EndIf
 Next
 Print("24 = ")

EndProcedure

Procedure playAgain()

 Protected answer.s
 Repeat 
   Print("Play again (y/n)? ")
   answer = LCase(Left(Trim(Input()), 1))
   Select answer
     Case "n"
       ProcedureReturn #False
     Case "y"
       ProcedureReturn #True
     Default
       PrintN("")
       Continue
   EndSelect
 ForEver

EndProcedure

Procedure allDigitsUsed()

 Protected i
 For i = 0 To #digitCount - 1
   If digits(i) <> 0
     ProcedureReturn #False
   EndIf
 Next 
 ProcedureReturn #True 

EndProcedure

Procedure isValidDigit(d)

 For i = 0 To #digitCount - 1
   If digits(i) = d
     digits(i) = 0
     ProcedureReturn #True
   EndIf 
 Next 
 ProcedureReturn #False

EndProcedure

Procedure doOperation(List op.c(), List operand.f())

 Protected x.f, y.f, op.c
 op = op(): DeleteElement(op())
 If op = '('
   ProcedureReturn #False ;end of sub-expression
 EndIf 
 
 y = operand(): DeleteElement(operand())
 x = operand()
 Select op
   Case '+'
     x + y
   Case '-'
     x - y
   Case '*' 
     x * y
   Case '/' 
     x / y
 EndSelect
 operand() = x
 ProcedureReturn #True ;operation completed

EndProcedure

returns error if present and the expression results in *result\f

Procedure.s parseExpression(expr.s, *result.Float)

 NewList op.c()
 NewList operand.f()
 expr = ReplaceString(expr, " ", "") ;remove spaces
 
 If Len(expr) = 0: *result\f = 0: ProcedureReturn "": EndIf ;no expression, return zero
 
 Protected *ech.Character = @expr, lastWasDigit, lastWasOper, parenCheck, c.c
 While *ech\c
   c = *ech\c
   Select c
     Case '*', '/', '-', '+'
       If Not lastWasDigit: ProcedureReturn "Improper syntax, need a digit between operators.": EndIf
       If ListSize(op()) And (FindString("*/", Chr(op()), 1) Or (FindString("+-", Chr(op()), 1) And FindString("+-", Chr(c), 1)))
         doOperation(op(), operand())
       EndIf 
       AddElement(op()): op() = c
       lastWasOper = #True: lastWasDigit = #False
     Case '('
       If lastWasDigit: ProcedureReturn "Improper syntax, need an operator before left paren.": EndIf
       AddElement(op()): op() = c
       parenCheck + 1: lastWasOper = #False
     Case ')'
       parenCheck - 1: If parenCheck < 0: ProcedureReturn "Improper syntax, missing a left paren.": EndIf
       If Not lastWasDigit: ProcedureReturn "Improper syntax, missing a digit before right paren.": EndIf
       Repeat: Until Not doOperation(op(),operand())
       lastWasDigit = #True
     Case '1' To '9'
       If lastWasDigit: ProcedureReturn "Improper syntax, need an operator between digits.": EndIf
       AddElement(operand()): operand() = c - '0'
       If Not isValidDigit(operand()): ProcedureReturn "'" + Chr(c) + "' is not a valid digit.": EndIf
       lastWasDigit = #True: lastWasOper = #False
     Default
       ProcedureReturn "'" + Chr(c) + "' is not allowed in the expression."
   EndSelect
   *ech + SizeOf(Character)
 Wend 
 
 If parenCheck <> 0 Or lastWasOper: ProcedureReturn "Improper syntax, missing a right paren or digit.": EndIf
 Repeat
   If Not ListSize(op()): Break: EndIf
 Until Not doOperation(op(),operand())
 *result\f = operand()
 ProcedureReturn "" ;no error

EndProcedure

Define success, failure, result.f, error.s, i If OpenConsole()

 PrintN("The 24 Game" + #CRLF$)
 PrintN("Given four digits and using just the +, -, *, and / operators; and the")
 PrintN("possible use of brackets, (), enter an expression that equates to 24.")
 Repeat
   For i = 0 To #digitCount - 1
     digits(i) = 1 + Random(8)
   Next
   
   showDigits()
   error = parseExpression(Input(), @result)
   If error = ""
     If Not allDigitsUsed()
       PrintN( "Wrong! (you didn't use all digits)"): failure + 1
     ElseIf result = 24.0
       PrintN("Correct!"): success + 1
     Else
       Print("Wrong! (you got ")
       If result <> Int(result)
         PrintN(StrF(result, 2) + ")")
       Else
         PrintN(Str(result) + ")")
       EndIf 
       failure + 1
     EndIf 
   Else
     PrintN(error): failure + 1
   EndIf 
 Until Not playAgain()
 
 PrintN("success:" + Str(success) + " failure:" + Str(failure) + " total:" + Str(success + failure))
 
 Print(#CRLF$ + "Press ENTER to exit"): Input()
 CloseConsole()

EndIf</lang> Sample output:

The 24 Game

Given four digits and using just the +, -, *, and / operators; and the
possible use of brackets, (), enter an expression that equates to 24.

These are your four digits: 9, 2, 8, 7
24 = 9*8/2-7
Wrong! (you got 29)
Play again (y/n)? y

These are your four digits: 5, 5, 5, 6
24 = 5*5+5-6
Correct!
Play again (y/n)? n
success:1 failure:1 total:2

Python

Uses eval, the in-built expression evaluator of infix expressions. <lang python>

The 24 Game
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.
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 import random, ast, re import sys

if sys.version_info[0] < 3: input = raw_input

def choose4():

   'four random digits >0 as characters'
   return [str(random.randint(1,9)) for i in range(4)]

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 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.lower() == 'q':
           break
       if answer == '!':
           digits = choose4()
           print ("New digits:", ' '.join(digits))
           continue
       if not chk:
           print ("The input '%s' was wonky!" % answer)
       else:
           ans = eval(answer)
           print (" = ", ans)
           if ans == 24:
               print ("Thats right!")
   print ("Thank you and goodbye")   

main()</lang>

Sample Output

 The 24 Game

 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.

 Note: you cannot form multiple digit numbers from the supplied digits,
 so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed.


Your four digits: 3 2 4 6
Expression 1: (3 - 1)*(6*4)
The input '(3 - 1)*(6*4)' was wonky!
Expression 2: (3 - 2) * 6 * 4
 =  24
Thats right!
Thank you and goodbye

R

This makes use of R's metaprogramming (parse, eval, etc.). It uses parse to obtain a parse tree, which is scanned for containing only permitted elements before evaluating.

<lang r>twenty.four <- function(operators=c("+", "-", "*", "/", "("),

                       selector=function() sample(1:9, 4, replace=TRUE),
                       arguments=selector(),
                       goal=24) {
 newdigits <- function() {
   arguments <<- selector()
   cat("New digits:", paste(arguments, collapse=", "), "\n")
 } 
 help <- function() cat("Make", goal,
     "out of the numbers",paste(arguments, collapse=", "),
     "and the operators",paste(operators, collapse=", "), ".",
     "\nEnter 'q' to quit, '!' to select new digits,",
     "or '?' to repeat this message.\n")
 help()
 repeat {
   switch(input <- readline(prompt="> "),
          q={ cat("Goodbye!\n"); break },
          `?`=help(),
          `!`=newdigits(),
          tryCatch({
            expr <- parse(text=input, n=1)1
            check.call(expr, operators, arguments)
            result <- eval(expr)
            if (isTRUE(all.equal(result, goal))) {
              cat("Correct!\n")
              newdigits()
            } else {
              cat("Evaluated to", result, "( goal", goal, ")\n")
            }
          },error=function(e) cat(e$message, "\n")))
 }

}

check.call <- function(expr, operators, arguments) {

 unexpr <- function(x) {
   if (is.call(x))
     unexpr(as.list(x))
   else if (is.list(x))
     lapply(x,unexpr)
   else x
 }
 leaves <- unlist(unexpr(expr))
 if (any(disallowed <-
         !leaves %in% c(lapply(operators, as.name),
                        as.list(arguments)))) {
   stop("'", paste(sapply(leaves[disallowed], as.character),
                   collapse=", "),
        "' not allowed. ")
 }
 numbers.used <- unlist(leaves[sapply(leaves, mode) == 'numeric'])
 
 if (! isTRUE(all.equal(sort(numbers.used), sort(arguments))))
  stop("Must use each number once.")

}</lang> Example Session <lang r>> twenty.four()

Make 24 out of the numbers 1, 6, 7, 5 and the operators +, -, *, /, ( . Enter 'q' to quit, '!' to select new digits, or '?' to repeat this message. > 6*(5-1) Must use each number once. > 1 + 6*5 - 7 Correct! New digits: 7, 2, 9, 3 > (7+9)/2*3 Correct! New digits: 1, 4, 1, 7 > 4*(7-1) Must use each number once. > (7-1)*4*1 Correct! New digits: 1, 5, 2, 8 > (5-1)^2+8 '^' not allowed. > ! New digits: 2, 8, 5, 2 > 52-28 '52, 28' not allowed. > (8-2)*(5-2/2) Must use each number once. > (8+2)*2+5 Evaluated to 25 ( goal 24 ) > q Goodbye! </lang>

Racket

The functional interpreter of an expression given in the infix form. It parses the S-expression representing the user's answer and handles invalid cases.

<lang racket>

  1. lang racket

(define (interprete expr numbers)

 ;; the cashe for used numbers
 (define cashe numbers)
 ;; updating the cashe and handling invalid cases
 (define (update-cashe! x)
   (unless (member x numbers) (error "Number is not in the given set:" x))
   (unless (member x cashe)   (error "Number is used more times then it was given:" x))
   (set! cashe (remq x cashe)))
 ;; the parser
 (define parse
   (match-lambda
     ;; parsing arythmetics
     [`(,x ... + ,y ...) (+ (parse x) (parse y))]
     [`(,x ... - ,y ...) (- (parse x) (parse y))]
     [`(,x ... * ,y ...) (* (parse x) (parse y))]
     [`(,x ... / ,y ...) (/ (parse x) (parse y))]
     [`(,x ,op ,y ...)   (error "Unknown operator: " op)]
     ;; opening redundant brackets
     [`(,expr)           (parse expr)]
     ;; parsing numbers
     [(? number? x)      (update-cashe! x) x]
     ;; unknown token
     [x                  (error "Not a number: " x)]))
 ;; parse the expresion
 (define result (parse expr))
 ;; return the result if cashe is empty
 (if (empty? cashe)
     result
     (error "You didn`t use all numbers!")))

</lang>

Testing the interpreter:

> (interprete '(1 - 2 * 3 + 8) '(1 2 3 8))
3
> (interprete '(1 - 2 * (3 + 8)) '(1 2 3 8))
-21
> (interprete '((1 - 2) * (3 + 8)) '(1 2 3 8))
-11
> (interprete '((1 - 2) * 3 + 8) '(1 2 3 8))
5
> (interprete '((1 - 2) * 3 + 8) '(1 2 3 4))
 Number is not in the given set: 8
> (interprete '((1 - 2) * 3 + 2) '(1 2 3 3))
 Number is used more times then it was given: 2
> (interprete '((1 - 2) ^ 3 + 2) '(1 2 3 2))
 Unknown operator:  ^
> (interprete '((1 - 2) * 3) '(1 2 3 2))
 You didn`t use all numbers!

The program which uses the interpreter to play the game:

<lang racket>

starting the program

(define (start)

 (displayln "Combine given four numbers using operations + - * / to get 24.")
 (displayln "Input 'q' to quit or your answer like '1 - 3 * (2 + 3)'")
 (new-game))
starting a new game

(define (new-game)

 ;; create a new number set
 (define numbers (build-list 4 (λ (_) (+ 1 (random 9)))))
 (apply printf "Your numbers: ~a  ~a  ~a  ~a\n" numbers)
 (new-input numbers))
processing a new user input

(define (new-input numbers)

 ;; if an exception is raized while processing, show the exeption message
 ;; and prompt for another input, but do not stop the program.
 (with-handlers ([exn? (λ (exn)
                         (displayln (exn-message exn))
                         (new-input numbers))])
   ;; get the answer
   (define user-expr (read-the-answer))
   ;; interprete it
   (case user-expr
     [(q) (display "Good buy!")]
     [(n) (new-game)]
     [else (define ans (interprete user-expr numbers))
           (case ans
             [(24) (printf "Indeed! ~a = 24\n" user-expr)
                   (new-game)]
             [else (error "Wrong!" user-expr '= ans)])])))
reading and preparing the user's answer
"1 + 2 * (3 + 4)" --> '(1 + 2 * (3 + 4))

(define (read-the-answer)

 (read (open-input-string (format "(~a)" (read-line)))))

</lang>

REXX

version 1

<lang rexx>/*REXX program which allows a user to play the game of 24 (twenty-four).*/ /*

 ╔══════════════════════════════════════════════════════════════════╗
 ║ Argument is either of three forms:   (blank)                     ║
 ║                                      ssss                        ║
 ║                                      ssss-ffff                   ║
 ║                                                                  ║
 ║ where one or both strings must be exactly four numerals (digits) ║
 ║ comprised soley of the numerals (digits)  1 ──> 9   (no zeroes). ║
 ║                                                                  ║
 ║                                      SSSS  is the start,         ║
 ║                                      FFFF  is the start.         ║
 ║                                                                  ║
 ║ If no argument is specified, this program finds a four digit     ║
 ║ number (no zeroes)  which has at least one solution,  and shows  ║
 ║ the number to the user,  requesting that they enter a solution   ║
 ║ in the form of:    w  operator  x  operator  y  operator  z      ║
 ║ where   w  x  y  and  z   are single digit numbers  (no zeroes), ║
 ║ and    operator   can be any one of:     +    -    *    /        ║
 ║ Parentheses ()  may be used in the normal manner for grouping,   ║
 ║ as well as  brackets []  or  braces  {}.                         ║
 ╚══════════════════════════════════════════════════════════════════╝  */

parse arg orig /*get the guess from the argument. */ orig=space(orig,0) /*remove extraneous blanks from ORIG. */ parse var orig start '-' finish /*get the start and finish (maybe). */ finish=word(finish start,1) /*if no FINISH specified, use START.*/ opers='+-*/' /*define the legal arithmetic operators*/ ops=length(opers) /* ... and the count of them (length). */ groupsymbols='()[]{}' /*legal grouping symbols. */ indent=left(,30) /*used to indent display of solutions. */ Lpar='(' /*a string to make REXX code prettier. */ Rpar=')' /*ditto. */ show=1 /*flag used show solutions (0 = not). */ digs=123456789 /*numerals (digits) that can be used. */

 do j=1 for ops                 /*define a version for fast execution. */
 o.j=substr(opers,j,1)
 end   /*j*/

if orig\== then do

                 sols=solve(start,finish)
                 if sols<0 then exit 13
                 if sols==0 then sols='No'         /*un-geek SOLS.*/
                 say
                 say sols 'unique solution's(finds) "found for" orig     /*pluralize.*/
                 exit
                 end

show=0 /*stop SOLVE from blabbing solutions. */

       do forever
       rrrr=random(1111,9999)
       if pos(0,rrrr)\==0 then iterate
       if solve(rrrr)\==0 then leave
       end

show=1 /*enable SOLVE to show solutions. */ rrrr=sort(rrrr) /*sort four elements. */ rd.=0

       do j=1 for 9             /*digit count # for each digit in RRRR.*/
       _=substr(rrrr,j,1)
       rd._=countdigs(rrrr,_)
       end   /*j*/
 do guesses=1;   say
 say 'Using the digits',
      rrrr", enter an expression that equals 24 (or QUIT):"
 pull y
 y=space(y,0);    if y=='QUIT' then exit
 _v=verify(y,digs||opers||groupsymbols)
 if _v\==0 then do
                call ger 'invalid character:' substr(_v,1)
                iterate
                end
 yl=length(y)
 if y= then do
              call validate y
              iterate
              end
   do j=1 to yl-1
   _=substr(y,j,1)
   if \datatype(_,'W') then iterate
   _=substr(y,j+1,1)
   if datatype(_,'W') then do
                           call ger 'invalid use of digit abuttal'
                           iterate guesses
                           end
   end   /*j*/
 yd=countdigs(y,digs)                  /*count of digits 123456789.*/
 if yd<4 then do
              call ger 'not enough digits entered.'
              iterate guesses
              end
 if yd>4 then do
              call ger 'too many digits entered.'
              iterate guesses
              end
   do j=1 for 9;   if rd.j==0 then iterate
   _d=countdigs(y,j)
   if _d==rd.j then iterate
   if _d<rd.j then call ger 'not enough' j "digits, must be" rd.j
              else call ger 'too many' j "digits, must be" rd.j
   iterate guesses
   end   /*j*/
 y=translate(y,'()()',"[]{}")
 signal on syntax
 interpret 'ans='y
 ans=ans/1
 if ans==24 then leave guesses
 say 'incorrect,' y'='ans
 end   /*guesses*/

say say center('┌─────────────────────┐',79) say center('│ │',79) say center('│ congratulations ! │',79) say center('│ │',79) say center('└─────────────────────┘',79) exit /*───────────────────────────SOLVE subroutine───────────────────────────*/ solve: parse arg ssss,ffff /*parse the argument passed to SOLVE. */ if ffff== then ffff=ssss /*create a FFFF if necessary. */ if \validate(ssss) then return -1 if \validate(ffff) then return -1 finds=0 /*number of found solutions (so far). */ x.=0 /*a method to hold unique expressions. */

                                /*alternative:  indent=copies(' ',30)  */
 do g=ssss to ffff              /*process a (possible) range of values.*/
 if pos(0,g)\==0 then iterate   /*ignore values with zero in them.     */
     do j=1 for 4               /*define a version for fast execution. */
     g.j=substr(g,j,1)
     end   /*j*/
   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 4-1;  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 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.      */
           interpret 'x=' e
           x=x/1                /*remove trailing decimal points.      */
           if x\==24 then iterate            /*Not correct?  Try again.*/
           finds=finds+1        /*bump number of found solutions.      */
           _=translate(origE,'][',")(")       /*show  [],  not  ().*/
           if show then say indent 'a solution:' _  /*show solution*/
           end   /*n*/
         end     /*m*/
       end       /*k*/
     end         /*j*/
   end           /*i*/
 end             /*g*/

return finds /*───────────────────────────COUNTDIGS subroutine───────────────────────*/ countdigs: arg field,numerals /*count of digits NUMERALS.*/ return length(field)-length(space(translate(field,,numerals),0)) /*───────────────────────────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! *** for argument:' y; say arg(1); say; errCode=1; return 0 /*───────────────────────────S subroutine───────────────────────────────*/ s: if arg(1)==1 then return ; return 's' /*simple pluralizer.*/ /*───────────────────────────SORT subroutine────────────────────────────*/ sort: procedure; arg nnnn; L=length(nnnn)

    do i=1 for L                 /*build an array of digits from  NNNN.*/
    a.i=substr(nnnn,i,1)         /*this enables SORT to sort an array. */
    end   /*i*/
 do j=1 for L;   _=a.j
        do k=j+1 to L
        if a.k<_ then  parse value  a.j  a.k    with    a.k  a.j
        end   /*k*/
 end          /*j*/

return a.1 || a.2 || a.3 || a.4 /*───────────────────────────SYNTAX subroutin───────────────────────────*/ syntax: call ger 'illegal syntax in' y; exit /*───────────────────────────validate subroutine────────────────────────*/ validate: parse arg y; errCode=0; _v=verify(y,digs)

   select
   when y==        then call ger 'no digits entered.'
   when length(y)<4  then call ger 'not enough digits entered, must be 4'
   when length(y)>4  then call ger 'too many digits entered, must be 4'
   when pos(0,y)\==0 then call ger "can't use the digit  0 (zero)"
   when _v\==0       then call ger 'illegal character:' substr(y,_v,1)
   otherwise nop
   end    /*select*/

return \errCode</lang> Some older REXXes don't have a changestr bif, so one is included here ──► CHANGESTR.REX.

version 2

The above was created for Classic Rexx and can be used, unchanged, for Regina and other implementations of Classic Rexx. After recent changes it can also be used, unchanged, for ooRexx.

Therefore I removed the code of the 24 game's Version 2 for Rexx.

As regards TSO (German code page): I wrote me a little program that just translates \ and | to ^ and ! in the source (except for literals and comments) and version 1 (Gerard's) of the 24 game works, if translated that way and otherwise unchanged, on TSO. TSO supports the A=; For the sake of my 80 column CLIST PDS I had to split the few lines that are longer than that.

Result:

                               ISPF Command Shell                            
 Enter TSO or Workstation commands below:                                  
  ===> tso h24   
Using the digits 5559 , enter an expression that equals 24 (or QUIT):       
5+5+5+9                                                                      
                                                                           
                             +---------------------+                         
                             :                     :                         
                             :  congratulations !  :                         
                             :                     :                         
                             +---------------------+       

I just leave the complete version of changestr here although it has nothing to do with 24! <lang rexx> changestr: Procedure /* change needle to newneedle in haystack (as often as specified */ /* or all of them if count is omitted */

 Parse Arg needle,haystack,newneedle,count                             
 If count> Then Do                                                   
   If count=0 Then Do                                                  
     Say 'chstr count must be > 0'                                     
     Signal Syntax                                                     
     End                                                               
   End                                                                 
 res=""                                                                
 changes=0                                                             
 px=1                                                                  
 do Until py=0                                                         
   py=pos(needle,haystack,px)                                          
   if py>0 then Do                                                     
     res=res||substr(haystack,px,py-px)||newneedle                     
     px=py+length(needle)                                              
     changes=changes+1                                                 
     If count> Then                                                  
       If changes=count Then Leave                                     
     End                                                               
   end                                                                 
 res=res||substr(haystack,px)                                          
 Return res   

</lang>

Ruby

Ruby version 1.9+ <lang ruby>require "rational"

def play

 digits = Array.new(4){rand(1..9)}
 loop do
   guess = get_guess(digits)
   result = evaluate(guess)
   if result == 24.0
     puts "yes!"
     break
   else
     puts "nope: #{guess} = #{result}"
     puts "try again"
   end
 end

end

def get_guess(digits)

 loop do
   print "\nEnter your guess using #{digits}: "
   guess = gets.chomp

   # ensure input is safe to eval
   invalid_chars = guess.scan(%r{[^\d\s()+*/-]})
   unless invalid_chars.empty?
     puts "invalid characters in input: #{invalid_chars}"
     next
   end
   
   guess_digits = guess.scan(/\d/).map {|ch| ch.to_i}
   if guess_digits.sort != digits.sort
     puts "you didn't use the right digits"
     next
   end
   
   if guess.match(/\d\d/)
     puts "no multi-digit numbers allowed"
     next
   end
   
   return guess
 end

end

  1. convert expression to use rational numbers, evaluate, then return as float

def evaluate(guess)

 as_rat = guess.gsub(/(\d)/, 'Rational(\1,1)')
 begin
   eval "(#{as_rat}).to_f"
 rescue SyntaxError
   "[syntax error]"
 end

end

play</lang>

Scala

The solution below is much more complex than strictly needed, because it shows off Scala's Parser library, which enables easy construction of parsers from EBNF grammars.

Only problems with solution are shown to the user.

<lang scala>object TwentyFourGame {
 def main(args: Array[String]) {
   import Parser.TwentyFourParser
   
   println(welcome)
   
   var parser = new TwentyFourParser(problemsIterator.next)
   println("Your four digits: "+parser+".")
   
   var finished = false
   var expressionCount = 1
   do {
     val line = Console.readLine("Expression "+expressionCount+": ")
     line match {
       case "!" =>
         parser = new TwentyFourParser(problemsIterator.next)
         println("New digits: "+parser+".")
         
       case "q" =>
         finished = true
       
       case _ =>
         parser readExpression line match {
           case Some(24) => println("That's right!"); finished = true
           case Some(n) => println("Sorry, that's "+n+".")
           case None =>
         }
     }
     expressionCount += 1
   } while (!finished)
   
   println("Thank you and goodbye!")
 }
 
 val welcome = """|The 24 Game
                  |
                  |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.
                  |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.
                  |""".stripMargin
 
 val problemsIterator = (
   Iterator 
   continually List.fill(4)(scala.util.Random.nextInt(9) + 1 toDouble) 
   filter hasSolution
 )
 
 def hasSolution(l: List[Double]) = permute(l) flatMap computeAllOperations exists (_ == 24)
 
 def computeAllOperations(l: List[Double]): List[Double] = l match {
   case Nil => Nil
   case x :: Nil => l
   case x :: xs =>
     for {
       y <- computeAllOperations(xs)
       z <- if (y == 0) List(x*y, x+y, x-y) else List(x*y, x/y, x+y, x-y)
     } yield z
 }
 
 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)
 }
 
 object Parser {
   /*  Arithmetic expression grammar production rules in EBNF form:
    *
    * <expr> --> <term> ( '+' <term> | '-' <term> )*
    * <term> --> <factor> ( '*'  <factor> | '/'  <factor> )*
    * <factor> --> '(' <expr> ')' | <digit>
    * <digit> --> 0 | 1  | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9
    * 
    * Semantically, <digit> can only be a digit from the list of remaining digits.
    */
   
   class TwentyFourParser(digits: List[Double]) extends scala.util.parsing.combinator.RegexParsers {
     require(digits.length == 4 && digits.forall(d => 0 <= d && d <= 9))
     override val toString = digits.map(_.toInt).mkString(", ")
     
     // Grammar
     def exprConsumingAllDigits = expr ^? (remainingDigits.allDigitsConsumed, digitsRemainingError) // Guarantees all digits consumed
     def expr : Parser[Double] = term ~ rep( "+" ~ term | "-" ~ term) ^^ solveOperationChain
     def term = factor ~ rep( "*" ~ factor | "/" ~ factor) ^^ solveOperationChain
     def factor = "(" ~> expr <~ ")" | digit
     def digit = digitRegex ^? (remainingDigits.consumeDigit, digitNotAllowedError) 
     def digitRegex = "\\d".r | digitExpected
     def digitExpected: Parser[String] = ".".r <~ failure(expectedDigitError) // Produces clear error messages
   
     // Evaluate expressions
     def readExpression(input: String): Option[Double] = {
       remainingDigits = new DigitList(digits) // Initialize list of digits to be consumed
       parseAll(exprConsumingAllDigits, input) match {
         case Success(result, _) => Some(result)
         case NoSuccess(msg, next) =>
           println(ParsingErrorFormatter(msg, next))
           None
       }
     }
     
     // List of digits to be consumed
     private var remainingDigits: DigitList = _
     
     // Solve partial results from parsing
     private def solveOperationChain(partialResult: ~[Double,List[~[String,Double]]]): Double = partialResult match {
       case first ~ chain => chain.foldLeft(first)(doOperation)
     }
     private def doOperation(acc: Double, op: ~[String, Double]): Double = op match {
       case "+" ~ operand => acc + operand
       case "-" ~ operand => acc - operand
       case "*" ~ operand => acc * operand
       case "/" ~ operand => acc / operand
       case x => error("Unknown operation "+x+".") 
     }
     
     // Error messages
     private def digitNotAllowedError(d: String) = "Digit "+d+" is not allowed here. Available digits: "+remainingDigits+"."
     private def digitsRemainingError(x: Any) = "Not all digits were consumed. Digits remaining: "+remainingDigits+"."
     private def expectedDigitError = "Unexpected input. Expected a digit from the list: "+remainingDigits+"."
   }
   
   private object ParsingErrorFormatter {
     def apply[T](msg: String, next: scala.util.parsing.input.Reader[T]) =
       "%s\n%s\n%s\n" format (msg, next.source.toString.trim, " "*(next.offset - 1)+"^")
   }
   
   private class DigitList(digits: List[Double]) {
     private var remainingDigits = digits
     override def toString = remainingDigits.map(_.toInt).mkString(", ")
     
     def consumeDigit: PartialFunction[String, Double] = {
       case d if remainingDigits contains d.toDouble =>
         val n = d.toDouble
         remainingDigits = remainingDigits diff List(n)
         n
     }
     
     def allDigitsConsumed: PartialFunction[Double, Double] = {
       case n if remainingDigits.isEmpty => n
     }
   }
 }
}</lang>

Sample Output

C:\Workset>scala TwentyFourGame
The 24 Game

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.
Otherwise you are repeatedly asked for an expression until it evaluates to 24

Note: you cannot form multiple digit numbers from the supplied digits,
so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed.

Your four digits: 2, 7, 7, 2.
Expression 1: 2*7+2+7
Sorry, that's 23.0.
Expression 2: 7*7/2-2
Sorry, that's 22.5.
Expression 3: 2*7+(7-2)
Sorry, that's 19.0.
Expression 4: 2*(7+7-2)
That's right!
Thank you and goodbye!

Scheme

Works with: PLT Scheme version 4

This uses read to read in a scheme expression, and eval to evaluate it, so in that sense it's not ideal (eval is evil etc.) but any expression that is valid should be safe and terminate in a timely manner.

<lang scheme>#lang scheme (require srfi/27 srfi/1) ;; random-integer, every

(define (play)

 (let* ([numbers (build-list 4 (lambda (n)
                                 (add1 (random-integer 9))))]
        [valid?  (curryr valid? numbers)])
   (printf startup-message numbers)
   (let loop ([exp (read)])
     (with-handlers ([exn:fail? (lambda (err)
                                  (printf error-message exp (exn-message err))
                                  (loop (read)))])
      (cond [(eq? exp '!) (play)]
            
            [(or (eq? exp 'q)
                 (eof-object? exp)) (printf quit-message)]
            
            [(not (valid? exp))
             (printf bad-exp-message exp)
             (loop (read))]
           
            [(not (= (eval exp) 24))
             (printf bad-result-message exp (eval exp))
             (loop (read))]
           
            [else (printf winning-message)])))))

(define (valid? exp numbers)

 ;; must contain each number exactly once and only valid symbols
 (define (valid-symbol? sym)
   ;; only +, -, *, and / are valid
   (case sym
     [(+ - * /) #t]
     [else #f]))
 
 (let* ([ls (flatten exp)]
        [numbers* (filter number? ls)]
        [symbols  (remove number? ls)])
   (and (equal? (sort numbers <)
                (sort numbers* <))
        (every valid-symbol? symbols))))

(define startup-message " Write a lisp expression that evaluates to 24 using only (, ), +, -, *, / and these four numbers: ~a

or '!' to get a new set of numbers or 'q' to quit")

(define error-message " Your expression ~a raised an exception:

 \"~a\"

Please try again")

(define bad-exp-message "Sorry, ~a is a bad expression.") (define bad-result-message "Sorry, ~a evaluates to ~a, not 24.") (define quit-message "Thanks for playing...") (define winning-message "You win!")

(provide play) </lang>

Sample Output

> (require "24game.ss")
> (play)

Write a lisp expression that evaluates to 24
using only (, ), +, -, *, /
and these four numbers: (2 7 2 5)

or '!' to get a new set of numbers
or 'q' to quit
!

Write a lisp expression that evaluates to 24
using only (, ), +, -, *, /
and these four numbers: (9 2 7 6)

or '!' to get a new set of numbers
or 'q' to quit
(9 7 6 2)

Your expression (9 7 6 2) raised an exception:

  "procedure application: expected procedure, given: 9; arguments were: 7 6 2"

Please try again
(+ 9 7 6 2)
You win!

Tcl

Translation of: Python

This version also terminates cleanly on end-of-file. <lang tcl># Four random non-zero digits proc choose4 {} {

   set digits {}
   foreach x {1 2 3 4} {lappend digits [expr {int(1+rand()*9)}]}
   return [lsort $digits]

}

  1. Print out a welcome message

proc welcome digits {

   puts [string trim "

The 24 Game

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

   "]
   puts "\nYour four digits: $digits"

}

  1. Check whether we've got a legal answer

proc check {answer digits} {

   if {

[regexp "\[^-+*/() \t[join $digits {}]\]" $answer] || [regexp {\d\d} $answer]

   } then {

return false

   }
   set digs [lsort [regexp -inline -all {\d} $answer]]
   if {$digs ne $digits} {

return false

   }
   expr {![catch {expr $answer}]}

}

  1. The main game loop

proc main {} {

   fconfigure stdout -buffering none
   set digits [choose4]
   welcome $digits
   set trial 0
   while true {

puts -nonewline "Expression [incr trial]: " gets stdin answer

       # Check for various types of non-answer

if {[eof stdin] || $answer eq "q" || $answer eq "Q"} { break } elseif {$answer eq "!"} { set digits [choose4] puts "New digits: $digits" continue } elseif {![check $answer $digits]} { puts "The input '$answer' was wonky!"

           continue

}

       # Check to see if it is the right answer

set ans [expr [regsub {\d} $answer {&.0}]] puts " = [string trimright $ans .0]" if {$ans == 24.0} { puts "That's right!"

           break

}

   }
   puts "Thank you and goodbye"

} main</lang>

TorqueScript

Includes an equation parser to avoid using eval. To use, type startTwentyFourGame(); in the console. <lang Torque>function startTwentyFourGame() { if($numbers !$= "") { echo("Ending current 24 game..."); endTwentyFourGame(); }

echo("Welcome to the 24 game!"); echo("Generating 4 numbers..."); for(%a = 0; %a < 4; %a++) $numbers = setWord($numbers, %a, getRandom(0, 9));

echo("Numbers generated! Here are your numbers:"); echo($numbers); echo("Use try24Equation( equation ); to try and guess the equation.");

$TwentyFourGame = 1; }

function endTwentyFourGame() { if(!$TwentyFourGame) { echo("No 24 game is active!"); return false; }

echo("Ending the 24 game."); $numbers = ""; $TwentyFourGame = 0; }

function try24Equation(%equ) { if(!$TwentyFourGame) { echo("No 24 game is active!"); return false; } %numbers = "0123456789"; %operators = "+-*x/()"; %tempchars = $numbers; %other = strReplace(%tempchars, " ", "");

//Check it and make sure it has all the stuff %equ = strReplace(%equ, " ", ""); %length = strLen(%equ);

for(%a = 0; %a < %Length; %a++) { %Char = getSubStr(%equ, %a, 1); if(%a+1 != %Length) %Next = getSubStr(%equ, %a+1, 1); else %Next = " ";

if(strPos(%numbers @ %operators, %char) < 0) { echo("The equation you entered is invalid! Try again."); return false; } if(strPos(%tempchars, %char) < 0 && strPos(%operators, %char) < 0) { echo("The equation you entered uses a number you were not given! Try again."); return false; } else if(strPos(%numbers, %next) >= 0 && strPos(%numbers, %char) >= 0) { echo("No numbers above 9 please! Try again."); echo(%next SPC %char SPC %a); return false; } else if(strPos(%operators, %char) > 0) continue;

%pos = 2*strPos(%other, %char); if(%pos < 0) return "ERROROMG";

//Remove it from the allowed numbers %tempchars = removeWord(%tempchars, %pos/2); %other = getSubStr(%other, 0, %pos) @ getSubStr(%other, %pos+1, strLen(%other));

   }
   
   %result = doEquation(%equ);
   
   if(%result != 24)
   {
       echo("Your equation resulted to" SPC %result @ ", not 24! Try again.");
       return false;
   }
   
   for(%a = 0; %a < 4; %a++)
       $numbers = setWord($numbers, %a, getRandom(0, 9));
   
   echo("Great job!" SPC %equ SPC "Does result to 24! Here's another set for you:");
   echo($numbers);

}

//Evaluates an equation without using eval. function doEquation(%equ) { //Validate the input

   %equ = strReplace(%equ, " ", "");%equ = strReplace(%equ, "*", "x");
   %equ = strReplace(%equ, "+", " + ");%equ = strReplace(%equ, "x", " x ");
   %equ = strReplace(%equ, "/", " / ");%equ = strReplace(%equ, "-", " - ");
   
   //Parenthesis'
   while(strPos(%equ, "(") > -1 && strPos(%equ, ")") > 0)
   {
       %start = strPos(%equ, "(");
       %end = %start;
       %level = 1;
       while(%level != 0 && %end != strLen(%equ))
       {
           %end++;
           if(getsubStr(%equ, %end, 1) $= "(") %level++;
           if(getsubStr(%equ, %end, 1) $= ")") %level--;
       }
       if(%level != 0)
           return "ERROR";
       %inbrackets = getsubStr(%equ, %start+1, %end - strLen(getsubStr(%equ, 0, %start + 1)));
       %leftofbrackets = getsubStr(%equ, 0, %start);
       %rightofbrackets = getsubStr(%equ, %end + 1, strLen(%equ) - %end);
       %equ = %leftofbrackets @ doEquation(%inbrackets) @ %rightofbrackets;
   }
   
   if(strPos(%equ, "ERROR") >= 0)
       return "ERROR";
   
   //Multiplication/Division loop
   for(%a = 0; %a < getWordCount(%equ); %a++)
   {
       if(getWord(%equ, %a) $= "x" || getWord(%equ, %a) $= "/" && %a != 0)
       {
           %f = getWord(%equ, %a - 1);
           %l = getWord(%equ, %a + 1);
           %o = getWord(%equ, %a);
           switch$(%o)
           {
               case "x": %a--;
                   %equ = removeWord(removeWord(setWord(%equ, %a+1, %f * %l), %a+2), %a);
               case "/": %a--;
                   %equ = removeWord(removeWord(setWord(%equ, %a+1, %f / %l), %a+2), %a);
           }
       }
   }
   
   //Addition/Subraction loop
   for(%a = 0; %a < getWordCount(%equ); %a++)
   {
       if(getWord(%equ, %a) $= "+" || getWord(%equ, %a) $= "-" && %a != 0)
       {
           %f = getWord(%equ, %a - 1);
           %l = getWord(%equ, %a + 1);
           %o = getWord(%equ, %a);
           switch$(%o)
           {
               case "+": %a--;
                   %equ = removeWord(removeWord(setWord(%equ, %a+1, %f + %l), %a+2), %a);
               case "-": %a--;
                   %equ = removeWord(removeWord(setWord(%equ, %a+1, %f - %l), %a+2), %a);
           }
       }
   }
   return %equ;

}</lang>

TUSCRIPT

<lang tuscript> $$ MODE TUSCRIPT BUILD X_TABLE blanks = ":': :"

SECTION game operators="*'/'+'-'(')",numbers=""

LOOP n=1,4 number=RANDOM_NUMBERS (1,9,1) numbers=APPEND(numbers,number) ENDLOOP

SET allowed=APPEND (numbers,operators) SET allowed=MIXED_SORT (allowed) SET allowed=REDUCE (allowed) BUILD S_TABLE ALLOWED =* DATA '{allowed}'

SET checksum=DIGIT_SORT (numbers)

printnumbers=EXCHANGE (numbers,blanks) printoperat=EXCHANGE (operators,blanks)

PRINT "Your numbers ", printnumbers PRINT "Use only these operators ", printoperat PRINT "Enter an expression that equates to 24" PRINT "Enter 'l' for new numbers" PRINT "Your 4 digits: ",printnumbers

DO play ENDSECTION

SECTION check_expr

SET pos = VERIFY (expr,allowed)
IF (pos!=0) THEN
 PRINT "wrong entry on position ",pos
 DO play
 STOP
ELSE
 SET yourdigits   = STRINGS (expr,":>/:")
 SET yourchecksum = DIGIT_SORT (yourdigits)
  IF (checksum!=yourchecksum) THEN
   PRINT/ERROR "wrong digits"
   DO play
   STOP
  ELSE
   CONTINUE
  ENDIF
ENDIF

ENDSECTION

SECTION play LOOP n=1,3 ASK "Expression {n}": expr="" IF (expr=="l") THEN RELEASE S_TABLE allowed PRINT "Your new numbers" DO game ELSEIF (expr!="") THEN DO check_expr sum={expr}

IF (sum!=24) THEN
 PRINT/ERROR expr," not equates 24 but ",sum
 CYCLE
ELSE
 PRINT "BINGO ", expr," equates ", sum
 STOP
ENDIF

ELSE

CYCLE

ENDIF ENDLOOP ENDSECTION DO game </lang> Output:

Your numbers 2 8 9 9
Use only these operators * / + - ( )
Enter an expression that equates to 24
Enter 'l' for new numbers
Your 4 digits: 2 8 9 9
Expression 1 >l
Your new numbers
Your numbers 2 4 2 3
Use only these operators * / + - ( )
Enter an expression that equates to 24
Enter 'l' for new numbers
Your 4 digits: 2 4 2 3
Expression 1 >2+4+2+3
@@@@@@@@  2+4+2+3 not equates 24 but 11                                @@@@@@@@
Expression 2 >2+2+2+3
@@@@@@@@  wrong digits                                                 @@@@@@@@
Expression 1 >2+2+a+3
wrong entry on position 5
Expression 1 >(2+4+2)*3
BINGO (2+4+2)*3 equates 24