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
- 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
<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>
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>
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>
- include <ctype.h>
- include <stdlib.h>
- include <ucontext.h>
ucontext_t ctx; 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; };
- 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; }
- define MAX_INPUT 64
char str[MAX_INPUT]; int pos;
- 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(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++
This uses the C++11 standard to simplify several parts of the code. Input is given in RPN format.
<lang cpp>#include <random>
- include <iostream>
- include <stack>
- include <set>
- include <string>
- 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
<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'
- 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
<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
Adapted from the C++0x code: <lang d>import std.stdio, std.random, std.math;
void main() {
void op(char c)() {
if (stack.length < 2)
throw new Exception("Wrong expression.");
stack[$-2] = mixin("stack[$-2]" ~ c ~ "stack[$-1]");
stack.length -= 1;
}
int[10] inDigits;
write("Make 24 with the digits: ");
foreach (i; 0 .. 4) {
int n = uniform(1, 10);
write(n, " ");
inDigits[n]++;
}
writeln();
double[] stack;
int[10] digits;
foreach (c; readln())
switch (c) {
case '1': .. case '9':
stack ~= c - '0';
digits[c - '0']++;
break;
case ' ', '\t', '\n': break;
case '+': op!'+'(); break;
case '-': op!'-'(); break;
case '*': op!'*'(); break;
case '/': op!'/'(); break;
default: throw new Exception("Wrong char: " ~ c);
}
if (digits != inDigits)
throw new Exception("Not using the given digits.");
if (stack.length != 1)
throw new Exception("Wrong expression.");
double r = stack[0];
writeln("Result: ", r);
writeln(abs(r - 24) < 0.001 ? "Good job!" : "Try again.");
}</lang> Example:
Make 24 with the digits: 4 4 6 9 9 6 - 4 4 + * Result: 24 Good job!
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>
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;
- example session
- 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" "rand" "sort" "time"
)
func main() {
rand.Seed(time.Nanoseconds())
n := make([]int, 4)
for i := range n {
n[i] = rand.Intn(9) + 1
}
fmt.Println("Your numbers:", n)
fmt.Print("Enter RPN: ")
var expr string
fmt.Scan(&expr)
if len(expr) != 7 {
fmt.Println("invalid. expression length must be 7.")
return
}
used := make([]int, 0, 4)
stack := make([]float64, 0, 4)
for i := 0; i < 7; i++ {
c := expr[i]
if c >= '1' && c <= '9' {
if len(used) == 4 {
fmt.Println("too many numbers.")
return
}
used = append(used, int(c-'0'))
stack = append(stack, float64(c-'0'))
continue
}
if len(stack) < 2 {
fmt.Println("invalid expression syntax.")
return
}
switch c {
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", c)
return
}
stack = stack[:len(stack)-1]
}
sort.Ints(n)
sort.Ints(used)
for i, u := range used {
if u != n[i] {
fmt.Println("wrong numbers used.")
return
}
}
if math.Abs(stack[0]-24) > 1e-6 {
fmt.Println("incorrect.", stack[0], "!= 24")
} else {
fmt.Println("correct.")
}
}</lang>
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
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>
Logo
<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
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>
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>
PARI/GP
<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
<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 PL/I> /* 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 }
$NumberOne = Random -Maximum 10 -Minimum 1 $NumberTwo = Random -Maximum 10 -Minimum 1 $NumberThree = Random -Maximum 10 -Minimum 1 $NumberFour = Random -Maximum 10 -Minimum 1 $NumberArray = @() $NumberArray += $NumberOne $NumberArray += $NumberTwo $NumberArray += $NumberThree $NumberArray += $NumberFour
Write-Host "Welcome to the 24 game!`n`nHere are your numbers: $NumberOne,$NumberTwo,$NumberThree and $NumberFour.`nUse division, multiplication, subtraction and addition to get 24 as a result with these 4 numbers.`n"
Do { $Wrong = 0 $EndResult = $null $TempChar = $null $TempChar2 = $null $Count = $null
$Result = Read-Host
Foreach($Char in $Result.ToCharArray())
{
Switch($Char)
{
$NumberOne
{
}
$NumberTwo
{
}
$NumberThree
{
}
$NumberFour
{
}
"+"
{
}
"-"
{
}
"*"
{
}
"/"
{
}
"("
{
}
")"
{
}
" "
{
}
Default
{
$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>
ProDOS
Note
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)
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(call, operators, arguments) {
numbers.used <- c()
recurse <- function(x) {
switch(class(x),
expression=recurse(x1),
call= all(sapply(x, recurse)),
`(`= all(sapply(x, recurse)),
name= as.character(x) %in% operators
|| stop("Function '", as.character(x), "' not allowed. "),
numeric= if (x %in% arguments)
{numbers.used <<- c(numbers.used, x);TRUE}
else stop("Number '", x, "' not allowed. "),
stop("Unknown class '",class(x),"' in expression. ")
)
}
(recurse(call)
&& 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 Function '^' not allowed. > ! New digits: 2, 8, 5, 2 > 52-28 Number '52' not allowed. > (8-2)*(5-2/2) Must use each number once. > (8+2)*2+5 Evaluated to 25 ( goal 24 ) > q Goodbye! </lang>
REXX
<lang rexx> /*REXX program to play the game of 24. */
/*------------------------------------------------------------------+
| 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: a operator b operator c operator d |
| where a b c and d are single digit numbers (no zeroes), |
| and operator can be any one of: + - * or / |
| 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 & 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
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
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
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) say exit
syntax: call ger 'illegal syntax in' y; 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
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
/*---------------------------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*/
/*---------------------------COUNTDIGS subroutine-------------------*/
countdigs: arg field,numerals /*count of digits NUMERALS.*/
return length(field)-length(space(translate(field,,numerals),0))
/*---------------------------GER subroutine-------------------------*/
ger: say; say '*** error! *** for argument:' y; say arg(1); say; errCode=1; return 0
/*---------------------------SORT subroutine------------------------*/
sort: procedure ; arg nnnn
L=length(nnnn)
do j=1 for L /*build an array of digits from NNNN.*/
a.j=substr(nnnn,j,1) /*this enables SORT to sort an array. */
end
do j=1 for L _=a.j do k=j+1 to L if a.k<_ then do; a.j=a.k; a.k=_; _=a.k; end end end
return a.1 || a.2 || a.3 || a.4
/*---------------------------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
return \errCode
/*---------------------------S subroutine---------------------------*/
s:if arg(1)=1 then return ; return 's' /*simple pluralizer.*/
/*---------------------------CHANGESTR subroutine-------------------*/
changestr: procedure; parse arg old,hay,new
r=; w=length(old); if w==0 then return new||hay
do forever
parse var hay y (old) _ +(w) hay; if _== then return r||y
r=r||y||new
end
/*Note: some older REXX interpretors don't have the */
/* CHANGESTR function, so it's included here. */
</lang>
Ruby
<lang ruby>require "rational"
def play
digits = Array.new(4) {1+rand(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.inspect}: "
guess = $stdin.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.inspect}"
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
- 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.
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
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!
(PLT Scheme has been renamed to Racket, this solution may be redundant)
<lang scheme>
- lang racket
(define (random-4)
(sort
(for/list ((i (in-range 4)))
(add1 (random 9)))
<))
(define (check-valid-chars lst-nums str)
(let ((regx (string-join (list
"^["
(string-join (map number->string lst-nums) "")
"\\(\\)\\+\\-\\/\\*\\ ]*$")
"")))
(regexp-match? regx str)))
(define (check-all-numbers lst-nums str)
(equal?
(sort
(map (lambda (x) (string->number x))
(regexp-match* "([0-9])" str)) <)
lst-nums))
(define (start-game)
(display "** 24 **\nInput \"q\" to quit or your answer in Racket notation, like (- 1 (* 3 2))\n\n") (new-question))
(define (new-question)
(let ((numbers (random-4)))
(apply printf "Your numbers: ~a - ~a - ~a - ~a\n" numbers)
(define (do-loop)
(let ((user-expr (read-line)))
(cond
((equal? user-expr "q")
(exit))
((not (check-valid-chars numbers user-expr))
(display "Your expression seems invalid, please retry:\n")
(do-loop))
((not (check-all-numbers numbers user-expr))
(display "You didn't use all the provided numbers, please retry:\n")
(do-loop))
((if (equal? 24 (eval (with-input-from-string user-expr read) (make-base-namespace)))
(display "OK!!")
(begin
(display "Incorrect\n")
(do-loop)))))
))
(do-loop)))
(start-game) </lang>
Tcl
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]
}
- 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"
}
- 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}]}
}
- 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>
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
- Programming Tasks
- Solutions by Programming Task
- ABAP
- Ada
- Argile
- AutoHotkey
- BBC BASIC
- C
- C++
- C sharp
- Clojure
- CoffeeScript
- Common Lisp
- D
- Falcon
- GAP
- Go
- Haskell
- HicEst
- Icon
- Unicon
- Icon Programming Library
- J
- Liberty BASIC
- Logo
- Lua
- Mathematica
- Modula-2
- Ulm's Modula-2 Library
- OCaml
- OpenEdge/Progress
- PARI/GP
- Examples needing attention
- Perl
- Perl 6
- PicoLisp
- PL/I
- PowerShell
- ProDOS
- PureBasic
- Python
- R
- REXX
- Ruby
- Scala
- Scheme
- Tcl
- TUSCRIPT
- GUISS/Omit