24 game: Difference between revisions
→{{header|Logo}}: Enter solution. |
|||
(378 intermediate revisions by more than 100 users not shown) | |||
Line 1:
{{task}}
[[Category:Puzzles]]
[[Category:Games]]
The [[wp:24 Game|24 Game]] tests one's mental arithmetic.
;Task
Write a program that [[task feature::Rosetta Code:randomness|randomly]] chooses and [[task feature::Rosetta Code:user output|displays]] four digits, each from 1 ──► 9 (inclusive) with repetitions allowed.
The program should prompt for the player to enter an arithmetic expression using ''just'' those, and ''all'' of those four digits, used exactly ''once'' each. The program should ''check'' then [[task feature::Rosetta Code:parsing|evaluate the expression]].
The goal is for the player to [[task feature::Rosetta Code:user input|enter]] an expression that (numerically) evaluates to '''24'''.
* Only the following operators/functions are allowed: multiplication, division, addition, subtraction
* 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.
<br>
;Notes
* The type of expression evaluator used is not mandated. An [[wp:Reverse Polish notation|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.
;Related tasks
* [[24 game/Solve]]
;Reference
* [http://www.bbc.co.uk/dna/h2g2/A933121 The 24 Game] on h2g2.
<br><br>
=={{header|11l}}==
{{trans|C++}}
<syntaxhighlight lang=11l>T Error
String message
F (message)
.message = message
T RPNParse
[Float] stk
[Int] digits
F op(f)
I .stk.len < 2
X.throw Error(‘Improperly written expression’)
V b = .stk.pop()
V a = .stk.pop()
.stk.append(f(a, b))
F parse(s)
L(c) s
I c C ‘0’..‘9’
.stk.append(Float(c))
.digits.append(Int(c))
E I c == ‘+’ {.op((a, b) -> a + b)}
E I c == ‘-’ {.op((a, b) -> a - b)}
E I c == ‘*’ {.op((a, b) -> a * b)}
E I c == ‘/’ {.op((a, b) -> a / b)}
E I c != ‘ ’
X.throw Error(‘Wrong char: ’c)
F get_result()
I .stk.len != 1
X.throw Error(‘Improperly written expression’)
R .stk.last
[Int] digits
print(‘Make 24 with the digits:’, end' ‘’)
L 4
V n = random:(1..9)
print(‘ ’n, end' ‘’)
digits.append(n)
print()
V parser = RPNParse()
X.try
parser.parse(input())
V r = parser.get_result()
I sorted(digits) != sorted(parser.digits)
print(‘Error: Not using the given digits’)
E
print(‘Result: ’r)
I r C 23.999<.<24.001
print(‘Good job!’)
E
print(‘Try again.’)
X.catch Error error
print(‘Error: ’error.message)</syntaxhighlight>
{{out}}
The same as in C++.
=={{header|8th}}==
This is a fully-worked sample of the game in 8th, showing error-detection and user-restriction techniques:
<syntaxhighlight lang=forth>
\ Generate four random digits and display to the user
\ then get an expression from the user using +, -, / and * and the digits
\ the result must equal 24
\ http://8th-dev.com/24game.html
\ Only the words in namespace 'game' are available to the player:
ns: game
: + n:+ ;
: - n:- ;
: * n:* ;
: / n:/ ;
ns: G
var random-digits
var user-input
: one-digit \ a -- a
rand n:abs 9 n:mod n:1+ a:push ;
: gen-digits \ - a
[] clone nip \ the clone nip is not needed in versions past 1.0.2...
' one-digit 4 times
' n:cmp a:sort
random-digits ! ;
: prompt-user
cr "The digits are: " . random-digits @ . cr ;
: goodbye
cr "Thanks for playing!\n" . cr 0 die ;
: get-input
70 null con:accept dup user-input !
null? if drop goodbye then ;
: compare-digits
true swap
(
\ inputed-array index
dup >r
a:@
random-digits @ r> a:@ nip
n:= not if
break
swap drop false swap
then
) 0 3 loop drop ;
/^\D*(\d)\D+(\d)\D+(\d)\D+(\d)\D*$/ var, digits-regex
: all-digits?
user-input @ digits-regex @ r:match
null? if drop false else
5 = not if
false
else
\ convert the captured digits in the regex into a sorted array:
digits-regex @
( r:@ >n swap ) 1 4 loop drop
4 a:close ' n:cmp a:sort
compare-digits
then
then ;
: does-eval?
0 user-input @ eval 24 n:=
dup not if
cr "Sorry, that expression is wrong" . cr
then ;
: check-input
reset
all-digits? if
does-eval? if
cr "Excellent! Your expression: \"" .
user-input @ .
"\" worked!" . cr
then
else
cr "You did not use the digits properly, try again." . cr
then ;
: intro quote |
Welcome to the '24 game'!
You will be shown four digits each time. Using only the + - * and / operators
and all the digits (and only the digits), produce the number '24'
Enter your result in 8th syntax, e.g.: 4 4 + 2 1 + *
To quit the game, just hit enter by itself. Enjoy!
| . ;
: start
\ don't allow anything but the desired words
ns:game only
intro
repeat
gen-digits
prompt-user
get-input
check-input
again ;
start
</syntaxhighlight>
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang=AArch64 Assembly>
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program game24_64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ NBDIGITS, 4 // digits number
.equ TOTAL, 24
.equ BUFFERSIZE, 100
.equ STACKSIZE, 10 // operator and digits number items in stacks
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessRules: .ascii "24 Game 64 bits.\n"
.ascii "The program will display four randomly-generated \n"
.ascii "single-digit numbers and will then prompt you to enter\n"
.ascii "an arithmetic expression followed by <enter> to sum \n"
.ascii "the given numbers to 24.\n"
.asciz "Exemple : 9+8+3+4 or (7+5)+(3*4) \n\n"
szMessExpr: .asciz "Enter your expression (or type (q)uit to exit or (n) for other digits): \n"
szMessDigits: .asciz "The four digits are @ @ @ @ and the score is 24. \n"
szMessNoDigit: .asciz "Error : One digit is not in digits list !! \n"
szMessSameDigit: .asciz "Error : Two digits are same !! \n"
szMessOK: .asciz "It is OK. \n"
szMessNotOK: .asciz "Error, it is not ok total = @ \n"
szMessErrOper: .asciz "Unknow Operator (+,-,$,/,(,)) \n"
szMessNoparen: .asciz "no opening parenthesis !! \n"
szMessErrParen: .asciz "Error parenthesis number !! \n"
szMessNoalldigits: .asciz "One or more digits not used !!\n"
szMessNewGame: .asciz "New game (y/n) ? \n"
szCarriageReturn: .asciz "\n"
.align 4
qGraine: .quad 123456
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
sBuffer: .skip BUFFERSIZE
iTabDigit: .skip 8 * NBDIGITS
iTabTopDigit: .skip 8 * NBDIGITS
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
ldr x0,qAdrszMessRules // display rules
bl affichageMess
1:
mov x3,#0
ldr x12,qAdriTabDigit
ldr x11,qAdriTabTopDigit
ldr x5,qAdrszMessDigits
2: // loop generate random digits
mov x0,#8
bl genereraleas
add x0,x0,#1
str x0,[x12,x3,lsl #3] // store in table
mov x1,#0
str x1,[x11,x3,lsl #3] // raz top table
ldr x1,qAdrsZoneConv
bl conversion10 // call decimal conversion
//mov x2,#0
//strb w2,[x1,x0] // reduce size display area with zéro final
mov x0,x5
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
mov x5,x0
add x3,x3,#1
cmp x3,#NBDIGITS // end ?
blt 2b // no -> loop
mov x0,x5
bl affichageMess
3: // loop human entry
ldr x0,qAdrszMessExpr
bl affichageMess
bl saisie // entry
cmp x0,#'q'
beq 100f
cmp x0,#'Q'
beq 100f
cmp x0,#'n'
beq 1b
cmp x0,#'N'
beq 1b
bl evalExpr // expression evaluation
cmp x0,#0 // ok ?
bne 3b // no - > loop
10: // display new game ?
ldr x0,qAdrszCarriageReturn
bl affichageMess
ldr x0,qAdrszMessNewGame
bl affichageMess
bl saisie
cmp x0,#'y'
beq 1b
cmp x0,#'Y'
beq 1b
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc #0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrszMessRules: .quad szMessRules
qAdrszMessDigits: .quad szMessDigits
qAdrszMessExpr: .quad szMessExpr
qAdrszMessNewGame: .quad szMessNewGame
qAdrsZoneConv: .quad sZoneConv
qAdriTabDigit: .quad iTabDigit
qAdriTabTopDigit: .quad iTabTopDigit
/******************************************************************/
/* evaluation expression */
/******************************************************************/
/* x0 return 0 if ok -1 else */
evalExpr:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
stp x10,fp,[sp,-16]! // save registres
mov x0,#0
ldr x1,qAdriTabTopDigit
mov x2,#0
1: // loop init table top digits
str x0,[x1,x2,lsl #3]
add x2,x2,#1
cmp x2,#NBDIGITS
blt 1b
sub sp,sp,#STACKSIZE * 8 // stack operator
mov fp,sp
sub sp,sp,#STACKSIZE * 8 // stack digit
mov x1,sp
ldr x10,qAdrsBuffer
mov x8,#0 // indice character in buffer
mov x7,#0 // indice digits stack
mov x2,#0 // indice operator stack
mov x9,0
1: // begin loop
ldrb w9,[x10,x8]
cmp x9,#0xA // end expression ?
beq 90f
cmp x9,#' ' // space ?
cinc x8,x8,eq // loop
beq 1b
cmp x9,#'(' // left parenthesis -> store in operator stack
bne 11f
str x9,[fp,x2,lsl 3]
add x2,x2,#1
add x8,x8,#1 // and loop
b 1b
11:
cmp x9,#')' // right parenthesis ?
bne 3f
mov x0,fp // compute operator stack until left parenthesis
sub x2,x2,#1
2:
ldr x6,[fp,x2,lsl 3]
cmp x6,#'(' // left parenthesis
cinc x8,x8,eq // end ?
beq 1b // and loop
sub x7,x7,#1 // last digit
mov x3,x7
bl compute
sub x2,x2,#1
cmp x2,#0
bge 2b
ldr x0,qAdrszMessNoparen // no left parenthesis in stack
bl affichageMess
mov x0,#-1
b 100f
3:
cmp x9,#'+' // addition
beq 4f
cmp x9,#'-' // soustraction
beq 4f
cmp x9,#'*' // multiplication
beq 4f
cmp x9,#'/' // division
beq 4f
b 5f // not operator
4: // control priority and depile stacks
mov x0,fp
mov x3,x7
mov x4,x9
bl depileOper
mov x7,x3
add x8,x8,#1
b 1b // and loop
5: // digit
sub x9,x9,#0x30
mov x0,x9
bl digitControl
cmp x0,#0 // error ?
bne 100f
str x9,[x1,x7,lsl #3] // store digit in digits stack
add x7,x7,#1
add x8,x8,#1
beq 1b
b 100f
90: // compute all stack operators
mov x0,fp
sub x7,x7,#1
91:
subs x2,x2,#1
blt 92f
mov x3,x7
bl compute
sub x7,x7,#1
b 91b
92:
ldr x0,[x1] // total = first value on digits stack
cmp x0,#TOTAL // control total
beq 93f // ok
ldr x1,qAdrsZoneConv
bl conversion10 // call decimal conversion
mov x2,#0
strb w2,[x1,x0]
ldr x0,qAdrszMessNotOK
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
bl affichageMess
mov x0,#-1
b 100f
93: // control use all digits
ldr x1,qAdriTabTopDigit
mov x2,#0
94: // begin loop
ldr x0,[x1,x2,lsl #3] // load top
cmp x0,#0
bne 95f
ldr x0,qAdrszMessNoalldigits
bl affichageMess
mov x0,#-1
b 100f
95:
add x2,x2,#1
cmp x2,#NBDIGITS
blt 94b
96: // display message OK
ldr x0,qAdrszMessOK
bl affichageMess
mov x0,#0
b 100f
100:
add sp,sp,8 * (STACKSIZE *2) // stack algnement
ldp x10,fp,[sp],16 // restaur des 2 registres
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
qAdrszMessNoparen: .quad szMessNoparen
qAdrszMessNotOK: .quad szMessNotOK
qAdrszMessOK: .quad szMessOK
qAdrszMessNoalldigits: .quad szMessNoalldigits
/******************************************************************/
/* depile operator */
/******************************************************************/
/* x0 operator stack address */
/* x1 digits stack address */
/* x2 operator indice */
/* x3 digits indice */
/* x4 operator */
/* x2 return a new operator indice */
/* x3 return a new digits indice */
depileOper:
stp x4,lr,[sp,-16]! // save registres
stp x5,x6,[sp,-16]! // save registres
stp x7,x8,[sp,-16]! // save registres
cmp x2,#0 // first operator ?
beq 60f
sub x5,x2,#1
1:
ldr x6,[x0,x5,lsl #3] // load stack operator
cmp x6,x4 // same operators
beq 50f
cmp x6,#'*' // multiplication
beq 50f
cmp x6,#'/' // division
beq 50f
cmp x6,#'-' // soustraction
beq 50f
b 60f
50: // depile operators stack and compute
sub x2,x2,#1
sub x3,x3,#1
bl compute
sub x5,x5,#1
cmp x5,#0
bge 1b
60:
str x4,[x0,x2,lsl #3] // add operator in stack
add x2,x2,#1
100:
ldp x7,x8,[sp],16 // restaur des 2 registres
ldp x5,x6,[sp],16 // restaur des 2 registres
ldp x4,lr,[sp],16 // restaur des 2 registres
ret
/******************************************************************/
/* compute */
/******************************************************************/
/* x0 operator stack address */
/* x1 digits stack address */
/* x2 operator indice */
/* x3 digits indice */
compute:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
ldr x6,[x1,x3,lsl 3] // load second digit
sub x5,x3,#1
ldr x7,[x1,x5,lsl 3] // load first digit
ldr x8,[x0,x2,lsl 3] // load operator
cmp x8,#'+'
bne 1f
add x7,x7,x6 // addition
str x7,[x1,x5,lsl 3]
b 100f
1:
cmp x8,#'-'
bne 2f
sub x7,x7,x6 // soustaction
str x7,[x1,x5,lsl 3]
b 100f
2:
cmp x8,#'*'
bne 3f // multiplication
mul x7,x6,x7
str x7,[x1,x5,lsl 3]
b 100f
3:
cmp x8,#'/'
bne 4f
udiv x7,x7,x6 // division
str x7,[x1,x5,lsl 3]
b 100f
4:
cmp x8,#'(' // left parenthesis ?
bne 5f
ldr x0,qAdrszMessErrParen // error
bl affichageMess
mov x0,#-1
b 100f
5:
ldr x0,qAdrszMessErrOper
bl affichageMess
mov x0,#-1
100:
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
qAdrszMessErrOper: .quad szMessErrOper
qAdrszMessErrParen: .quad szMessErrParen
/******************************************************************/
/* control digits */
/******************************************************************/
/* x0 return 0 if OK 1 if not digit */
digitControl:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
ldr x1,qAdriTabTopDigit
ldr x2,qAdriTabDigit
mov x3,#0
1:
ldr x4,[x2,x3,lsl #3] // load digit
cmp x0,x4 // equal ?
beq 2f // yes
add x3,x3,#1 // no -> loop
cmp x3,#NBDIGITS // end ?
blt 1b
ldr x0,qAdrszMessNoDigit // error
bl affichageMess
mov x0,#1
b 100f
2: // control prev use
ldr x4,[x1,x3,lsl #3]
cmp x4,#0
beq 3f
add x3,x3,#1
cmp x3,#NBDIGITS
blt 1b
ldr x0,qAdrszMessSameDigit
bl affichageMess
mov x0,#1
b 100f
3:
mov x4,#1
str x4,[x1,x3,lsl #3]
mov x0,#0
100:
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
qAdrszMessNoDigit: .quad szMessNoDigit
qAdrszMessSameDigit: .quad szMessSameDigit
/******************************************************************/
/* string entry */
/******************************************************************/
/* x0 return the first character of human entry */
saisie:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
mov x0,STDIN // Linux input console
ldr x1,qAdrsBuffer // buffer address
mov x2,BUFFERSIZE // buffer size
mov x8,READ // request to read datas
svc 0 // call system
ldr x1,qAdrsBuffer // buffer address
ldrb w0,[x1] // load first character
100:
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
qAdrsBuffer: .quad sBuffer
/***************************************************/
/* Generation random number */
/***************************************************/
/* x0 contains limit */
genereraleas:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
ldr x4,qAdrqGraine
ldr x2,[x4]
ldr x3,qNbDep1
mul x2,x3,x2
ldr x3,qNbDep2
add x2,x2,x3
str x2,[x4] // maj de la graine pour l appel suivant
cmp x0,#0
beq 100f
add x0,x0,#1
udiv x3,x2,x0
msub x0,x3,x0,x2 // résult = remainder
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
/*****************************************************/
qAdrqGraine: .quad qGraine
qNbDep1: .quad 0x0019660d
qNbDep2: .quad 0x3c6ef35f
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
=={{header|ABAP}}==
See [[24 game/ABAP]]
Line 23 ⟶ 707:
=={{header|Ada}}==
game24.adb:
<
with Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
procedure Game_24 is
subtype
package Random_Digit is new Ada.Numerics.Discrete_Random (Digit);
Exp_Error : exception;
Digit_Generator : Random_Digit.Generator;
Given_Digits : array (1 .. 4) of Digit;
Float_Value : constant array (Digit) of Float :=
(1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0);
function Apply_Op (L, R : Float; Op : Character) return Float is
begin
case Op is
when '+' =>
return L + R;
when '-' =>
return L - R;
when '*' =>
return L * R;
when '/' =>
return L / R;
when others =>
Ada.Text_IO.Put_Line ("Unexpected operator: " & Op);
raise Exp_Error;
end case;
end Apply_Op;
function Eval_Exp (E : String) return Float is
Flt : Float;
First : Positive := E'First;
Last : Positive;
function Match_Paren (Start : Positive) return Positive is
Pos : Positive := Start + 1;
Level : Natural := 1;
begin
loop
if Pos > E'Last then
Ada.Text_IO.Put_Line ("Unclosed parentheses.");
raise Exp_Error;
elsif E (Pos) = '(' then
Level := Level + 1;
elsif E (Pos) = ')' then
Level := Level - 1;
exit when Level = 0;
end if;
Pos := Pos + 1;
end loop;
return Pos;
end Match_Paren;
begin
if E (First) = '(' then
Last := Match_Paren (First);
Flt := Eval_Exp (E (First + 1 .. Last - 1));
elsif E (First) in Digit then
Last := First;
Flt := Float_Value (E (First));
else
Ada.Text_IO.Put_Line ("Unexpected character: " & E (First));
raise Exp_Error;
end if;
loop
if Last = E'Last then
return Flt;
elsif Last = E'Last - 1 then
Ada.Text_IO.Put_Line ("Unexpected end of expression.");
raise Exp_Error;
end if;
First := Last + 2;
if E (First) = '(' then
Last := Match_Paren (First);
Flt := Apply_Op (Flt, Eval_Exp (E (First + 1 .. Last - 1)),
Op => E (First - 1));
elsif E (First) in Digit then
Last := First;
Flt := Apply_Op (Flt, Float_Value (E (First)),
Op => E (First - 1));
else
Ada.Text_IO.Put_Line ("Unexpected character: " & E (First));
raise Exp_Error;
end if;
end loop;
end Eval_Exp;
begin
Ada.Text_IO.Put_Line ("24 Game");
Ada.Text_IO.Put_Line ("
Ada.Text_IO.Put_Line ("- Enter N for New digits");
Ada.Text_IO.Put_Line ("Note: Operators are evaluated left-to-right");
Ada.Text_IO.Put_Line (" (use parentheses to override)");
Random_Digit.Reset (Digit_Generator);
<<GEN_DIGITS>>
Ada.Text_IO.Put_Line ("Generating 4 digits...");
for I in Given_Digits'Range loop
Given_Digits (I) := Random_Digit.Random (Digit_Generator);
end loop;
<<GET_EXP>>
Ada.Text_IO.Put ("Your Digits:");
for I in Given_Digits'Range loop
end loop;
Ada.Text_IO.New_Line;
Ada.Text_IO.Put ("Enter your Expression: ");
declare
Value :
Unused_Digits : array (Given_Digits'Range) of Boolean :=
(others => True);
begin
if Response = "n" or Response = "N" then
end if;
if Response =
end
-- check input
for I in
declare
Found : Boolean;
begin
if
end if;
Given_Digits (J) = Ch
Found := True;
exit;
end if;
end loop;
if not Found then
Ada.Text_IO.Put_Line ("Illegal number used: " & Ch);
goto GET_EXP;
end if;
elsif Ch /= '(' and Ch /= ')' and Ch /= '+' and
Ch /= '-' and Ch /= '*' and Ch /= '/' then
Ada.Text_IO.Put_Line ("Illegal character used: " & Ch);
goto GET_EXP;
end if;
Prev_Ch := Ch;
end;
end loop;
-- check
for I in Given_Digits'Range loop
Ada.Text_IO.Put_Line ("Digit not used: " & Given_Digits (I));
end if;
end loop;
begin
Value := Eval_Exp
exception
when Exp_Error =>
goto GET_EXP; -- Message displayed by Eval_Exp;
end;
if abs (Value - 24.0) > 0.001 then
Ada.Text_IO.Put ("Value ");
Ada.Float_Text_IO.Put (Value, Fore => 0, Aft => 3, Exp => 0);
Ada.Text_IO.Put_Line (" is not 24!");
goto GET_EXP;
else
Ada.Text_IO.Put_Line ("You won!");
Ada.Text_IO.Put_Line ("Enter N for a new game, or try another solution.");
goto GET_EXP;
end if;
end;
end Game_24;</
{{out}}
<pre>24 Game
- Enter Q to Quit
- Enter N for New digits
Note: Operators are evaluated left-to-right
(use parentheses to override)
Generating 4 digits...
Your Digits:
Enter your Expression:
Value 21.000 is not 24!
Your Digits: 2 9 5 9
Enter your Expression: N
Generating 4 digits...
Your Digits:
Enter your Expression:
You won!
Enter N for a new game, or try another solution.</pre>
=={{header|ALGOL 68}}==
Uses infix expressions.
<syntaxhighlight lang="algol68">
BEGIN # play the 24 game - present the user with 4 digits and invite them to #
# enter an expression using the digits that evaluates to 24 #
[ 0 : 9 ]INT expression digits; # the digits entered by the user #
[ 0 : 9 ]INT puzzle digits; # the digits for the puzzle #
PROC eval = ( STRING expr )REAL: # parses and evaluates expr #
BEGIN
# syntax: expression = term ( ( "+" | "-" ) term )* #
# term = factor ( ( "*" | "/" ) factor ) * #
# factor = "0" | "1" | "2" | ... | "9" #
# | "(" expression ")" #
INT x pos := LWB expr - 1;
INT x end := UPB expr;
BOOL ok := TRUE;
PROC error = ( STRING msg )VOID:
IF ok THEN # this is the firstt error #
ok := FALSE;
print( ( msg, newline ) );
x pos := x end + 1
FI # error # ;
PROC curr ch = CHAR: IF x pos > x end THEN REPR 0 ELSE expr[ x pos ] FI;
PROC next ch = VOID: WHILE x pos +:= 1; curr ch = " " DO SKIP OD;
PROC factor = REAL:
IF curr ch >= "0" AND curr ch <= "9" THEN
INT digit = ABS curr ch - ABS "0";
REAL result = digit;
expression digits[ digit ] +:= 1;
next ch;
result
ELIF curr ch = "(" THEN
next ch;
REAL result = expression;
IF curr ch = ")" THEN
next ch
ELSE
error( """)"" expected after sub-expression" )
FI;
result
ELSE
error( "Unexpected """ + curr ch + """" );
0
FI # factor # ;
PROC term = REAL:
BEGIN
REAL result := factor;
WHILE curr ch = "*" OR curr ch = "/" DO
CHAR op = curr ch;
next ch;
IF op = "*" THEN result *:= factor ELSE result /:= factor FI
OD;
result
END # term # ;
PROC expression = REAL:
BEGIN
REAL result := term;
WHILE curr ch = "+" OR curr ch = "-" DO
CHAR op = curr ch;
next ch;
IF op = "+" THEN result +:= term ELSE result -:= term FI
OD;
result
END # expression # ;
next ch;
IF curr ch = REPR 0 THEN
error( "Missing expression" );
0
ELSE
REAL result = expression;
IF curr ch /= REPR 0 THEN
error( "Unexpected text: """ + expr[ x pos : ] + """ after expression" )
FI;
result
FI
END # eval # ;
WHILE
FOR i FROM 0 TO 9 DO # initialise the digit counts #
expression digits[ i ] := 0;
puzzle digits[ i ] := 0
OD;
print( ( "Enter an expression using these digits:" ) );
FOR i TO 4 DO # pick 4 random digits #
INT digit := 1 + ENTIER ( next random * 9 );
IF digit > 9 THEN digit := 9 FI;
puzzle digits[ digit ] +:= 1;
print( ( whole( digit, - 2 ) ) )
OD;
print( ( " that evaluates to 24: " ) );
# get and check the expression #
STRING expr;
read( ( expr, newline ) );
REAL result = eval( expr );
BOOL same := TRUE;
FOR i FROM 0 TO 9 WHILE same := puzzle digits[ i ] = expression digits[ i ] DO SKIP OD;
IF NOT same THEN
print( ( "That expression didn't contain the puzzle digits", newline ) )
ELIF result = 24 THEN
print( ( "Yes! That expression evaluates to 24", newline ) )
ELSE
print( ( "No - that expression evaluates to ", fixed( result, -8, 4 ), newline ) )
FI;
print( ( newline, "Play again [y/n]? " ) );
STRING play again;
read( ( play again, newline ) );
play again = "y" OR play again = "Y" OR play again = ""
DO SKIP OD
END
</syntaxhighlight>
{{out}}
<pre>
Enter an expression using these digits: 2 5 3 5 that evaluates to 24: (3+5)*(5-2)
Yes! That expression evaluates to 24
Play again [y/n]?
Enter an expression using these digits: 8 8 6 6 that evaluates to 24: 8+6+8/6
No - that expression evaluates to 15.3333
Play again [y/n]?
Enter an expression using these digits: 2 1 5 1 that evaluates to 24: (1+1)*(7+5)
That expression didn't contain the puzzle digits
Play again [y/n]? n
</pre>
=={{header|APL}}==
{{works with|Dyalog APL}}
<syntaxhighlight lang=APL>tfgame←{⎕IO←1
⎕←d←?⍵⍴9
i←⍞
u[⍋u←{⍎¨⍣(0≠≢⍵)⊢⍵}(i∊'1234567890')⊆i]≢d[⍋d]:'nope'
~∧/((~b←i∊'1234567890')/i)∊'+-×÷()':'nope'
24≠⍎i:'nope'
'Yeah!'
}</syntaxhighlight>
{{out}}
<pre> tfgame 4
6 9 4 5
6+9+4+5
Yeah!
tfgame 6
4 9 7 9 1 1
Ummm... I'm too tired.
nope
</pre>
=={{header|Applesoft BASIC}}==
This was taken from both the [[#Commodore_BASIC|Commodore BASIC]] and [[#ZX_Spectrum_Basic|ZX Spectrum Basic]] solutions.
<syntaxhighlight lang=ApplesoftBasic> 0 BH = PEEK (104):BL = PEEK (103)
1 GOSUB 1200: CALL - 868
10 LET N$ = ""
20 R = RND ( - ( PEEK (78) + PEEK (79) * 256)): REM RANDOMIZE
30 FOR I = 1 TO 4
40 LET N$ = N$ + STR$ ( INT ( RND (1) * 9) + 1)
50 NEXT I
60 PRINT " PRESS A KEY TO CONTINUE. ";: GET A$
65 LET I$ = "": LET F$ = "": LET P$ = ""
70 HOME
80 PRINT M$M$ SPC( 16)"24 GAME"
90 PRINT M$"ALLOWED CHARACTERS:"M$
100 LET I$ = N$ + "+-*/()"
110 HTAB 20
120 FOR I = 1 TO 10
130 PRINT MID$ (I$,I,1)" ";
140 NEXT I
150 PRINT M$ TAB( 7)"0 TO END"M$
160 INPUT "ENTER THE FORMULA: ";F$
170 IF F$ = "0" THEN END : GOTO 65
180 PRINT M$ TAB( 7)F$" = ";
190 FOR I = 1 TO LEN (F$)
200 LET C$ = MID$ (F$,I,1)
210 IF C$ = " " THEN LET F$ = MID$ (F$,1,I - 1) + MID$ (F$,I + 1): GOTO 250
220 IF C$ = "+" OR C$ = "-" OR C$ = "*" OR C$ = "/" THEN LET P$ = P$ + "O": GOTO 250
230 IF C$ = "(" OR C$ = ")" THEN LET P$ = P$ + C$: GOTO 250
240 LET P$ = P$ + "N"
250 NEXT I
260 RESTORE
270 FOR I = 1 TO 11
280 READ T$
290 IF T$ = P$ THEN LET I = 11
300 NEXT I
310 IF T$ < > P$ THEN INVERSE : PRINT "BAD CONSTRUCTION!"G$M$: NORMAL : GOTO 60
320 FOR I = 1 TO LEN (F$)
330 FOR J = 1 TO 10
340 IF ( MID$ (F$,I,1) = MID$ (I$,J,1)) AND MID$ (F$,I,1) > "0" AND MID$ (F$,I,1) < = "9" THEN LET I$ = MID$ (I$,1,J - 1) + " " + MID$ (I$,J + 1, LEN (I$))
350 NEXT J,I
370 IF MID$ (I$,1,4) < > " " THEN INVERSE : PRINT "INVALID ARGUMENTS!"G$M$: NORMAL : GOTO 60
380 GOSUB 600: REM LET R = VAL(F$)
390 PRINT R" ";
400 IF R < > 24 THEN INVERSE : PRINT "WRONG!"G$M$: NORMAL : GOTO 60
410 INVERSE : PRINT "CORRECT!"M$: NORMAL : GOTO 10
420 DATA"NONONON"
430 DATA"(NON)ONON"
440 DATA"NONO(NON)"
450 DATA"NO(NO(NON))"
460 DATA"((NON)ON)ON"
470 DATA"NO(NON)ON"
480 DATA"(NON)O(NON)"
485 DATA"NO((NON)ON)"
490 DATA"(NONON)ON"
495 DATA"(NO(NON))ON"
500 DATA"NO(NONON)"
600 REMGET BASIC TO EVALUATE OUR EXPRESSION
605 A$ = "R=" + F$: GOSUB 1440
610 FOR I = 1 TO LEN (A$)
615 REMSIMPLE TOKEN TRANSLATION
620 B = ASC ( MID$ (A$,I,1))
625 IF (B > 41 AND B < 48) OR B = 61 OR B = 94 THEN B = T(B)
630 POKE (AD + I - 1),B
635 NEXT
640 GOSUB 2000
645 REM GOSUB 1440:REM UNCOMMENT TO CLEAR EVALUATION LINE AFTER USE
650 RETURN
1200 M$ = CHR$ (13)
1210 G$ = CHR$ (7)
1220 HOME
1230 PRINT SPC( 16)"24 GAME"
1240 PRINT M$" THE GOAL OF THIS GAME IS TO FORMULATE"
1250 PRINT M$" AN ARITHMETIC EXPRESSION THAT"
1260 PRINT M$" EVALUATES TO A VALUE OF 24, HOWEVER"
1270 PRINT M$" YOU MAY USE ONLY THE FOUR NUMBERS"
1280 PRINT M$" GIVEN AT RANDOM BY THE COMPUTER AND"
1290 PRINT M$" THE STANDARD ARITHMETIC OPERATIONS OF"
1300 PRINT M$" ADD, SUBTRACT, MULTIPLY, AND DIVIDE."
1310 PRINT M$" EACH DIGIT MUST BE USED BY ITSELF. "
1320 PRINT M$" (E.G. IF GIVEN 1, 2, 3, 4, YOU CANNOT"
1330 PRINT M$" COMBINE 1 AND 2 TO MAKE 12.)"
1340 PRINT M$
1350 PRINT "INITIALIZING...";
1360 HTAB 1
1400 DIM T(94)
1401 T( ASC ("+")) = 200: REM $C8
1402 T( ASC ("-")) = 201: REM $C9
1403 T( ASC ("*")) = 202: REM $CA
1404 T( ASC ("/")) = 203: REM $CB
1405 T( ASC ("=")) = 208: REM $D0
1406 T( ASC ("^")) = 204: REM $CC
1409 REMLOCATE LINE 2005 IN RAM
1410 LH = BH:LL = BL:NH = 0:NL = 0
1415 AD = LH * 256 + LL
1420 LH = PEEK (AD + 1):LL = PEEK (AD)
1425 NL = PEEK (AD + 2):NH = PEEK (AD + 3):N = NH * 256 + NL
1430 IF N < > 2005 THEN GOTO 1415
1435 AD = AD + 4: RETURN
1440 FOR J = AD TO AD + 12: POKE J, ASC (":"): NEXT
1445 RETURN
2000 REMPUT 13 COLONS ON THE NEXT LINE
2005 :::::::::::::
2010 RETURN
</syntaxhighlight>
=={{header|Argile}}==
{{works with|Argile|1.0.0}}
<
do
Line 231 ⟶ 1,268:
error "unclosed parenthesis"
return x
</syntaxhighlight>
compile with:
arc 24_game.arg -o 24_game.c && gcc 24_game.c -o 24_game /usr/lib/libargrt.a
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang=ARM Assembly>
/* ARM assembly Raspberry PI */
/* program game24.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
.equ STDIN, 0 @ Linux input console
.equ READ, 3 @ Linux syscall
.equ NBDIGITS, 4 @ digits number
.equ TOTAL, 24
.equ BUFFERSIZE, 100
.equ STACKSIZE, 10 @ operator and digits number items in stacks
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessRules: .ascii "24 Game\n"
.ascii "The program will display four randomly-generated \n"
.ascii "single-digit numbers and will then prompt you to enter\n"
.ascii "an arithmetic expression followed by <enter> to sum \n"
.ascii "the given numbers to 24.\n"
.asciz "Exemple : 9+8+3+4 or (7+5)+(3*4) \n\n"
szMessExpr: .asciz "Enter your expression (or type (q)uit to exit or (n) for other digits): \n"
//szMessErrChoise: .asciz "invalid choice.\n "
szMessDigits: .asciz "The four digits are @ @ @ @ and the score is 24. \n"
szMessNoDigit: .asciz "Error : One digit is not in digits list !! \n"
szMessSameDigit: .asciz "Error : Two digits are same !! \n"
szMessOK: .asciz "It is OK. \n"
szMessNotOK: .asciz "Error, it is not ok total = @ \n"
szMessErrOper: .asciz "Unknow Operator (+,-,$,/,(,)) \n"
szMessNoparen: .asciz "no opening parenthesis !! \n"
szMessErrParen: .asciz "Error parenthesis number !! \n"
szMessNoalldigits: .asciz "One or more digits not used !!\n"
szMessNewGame: .asciz "New game (y/n) ? \n"
szCarriageReturn: .asciz "\n"
.align 4
iGraine: .int 123456
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
sBuffer: .skip BUFFERSIZE
iTabDigit: .skip 4 * NBDIGITS
iTabTopDigit: .skip 4 * NBDIGITS
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrszMessRules @ display rules
bl affichageMess
1:
mov r3,#0
ldr r12,iAdriTabDigit
ldr r11,iAdriTabTopDigit
ldr r5,iAdrszMessDigits
2: @ loop generate random digits
mov r0,#8
bl genereraleas
add r0,r0,#1
str r0,[r12,r3,lsl #2] @ store in table
mov r1,#0
str r1,[r11,r3,lsl #2] @ raz top table
ldr r1,iAdrsZoneConv
bl conversion10 @ call decimal conversion
mov r2,#0
strb r2,[r1,r0] @ reduce size display area with zéro final
mov r0,r5
ldr r1,iAdrsZoneConv @ insert conversion in message
bl strInsertAtCharInc
mov r5,r0
add r3,r3,#1
cmp r3,#NBDIGITS @ end ?
blt 2b @ no -> loop
mov r0,r5
bl affichageMess
3: @ loop human entry
ldr r0,iAdrszMessExpr
bl affichageMess
bl saisie @ entry
cmp r0,#'q'
beq 100f
cmp r0,#'Q'
beq 100f
cmp r0,#'n'
beq 1b
cmp r0,#'N'
beq 1b
bl evalExpr @ expression evaluation
cmp r0,#0 @ ok ?
bne 3b @ no - > loop
10: @ display new game ?
ldr r0,iAdrszCarriageReturn
bl affichageMess
ldr r0,iAdrszMessNewGame
bl affichageMess
bl saisie
cmp r0,#'y'
beq 1b
cmp r0,#'Y'
beq 1b
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrszMessRules: .int szMessRules
iAdrszMessDigits: .int szMessDigits
iAdrszMessExpr: .int szMessExpr
iAdrszMessNewGame: .int szMessNewGame
iAdrsZoneConv: .int sZoneConv
iAdriTabDigit: .int iTabDigit
iAdriTabTopDigit: .int iTabTopDigit
/******************************************************************/
/* evaluation expression */
/******************************************************************/
/* r0 return 0 if ok -1 else */
evalExpr:
push {r1-r11,lr} @ save registers
mov r0,#0
ldr r1,iAdriTabTopDigit
mov r2,#0
1: @ loop init table top digits
str r0,[r1,r2,lsl #2]
add r2,r2,#1
cmp r2,#NBDIGITS
blt 1b
sub sp,sp,#STACKSIZE * 4 @ stack operator
mov fp,sp
sub sp,sp,#STACKSIZE * 4 @ stack digit
mov r1,sp
ldr r10,iAdrsBuffer
mov r8,#0 @ indice character in buffer
mov r7,#0 @ indice digits stack
mov r2,#0 @ indice operator stack
1: @ begin loop
ldrb r9,[r10,r8]
cmp r9,#0xA @ end expression ?
beq 90f
cmp r9,#' ' @ space ?
addeq r8,r8,#1 @ loop
beq 1b
cmp r9,#'(' @ left parenthesis -> store in operator stack
streq r9,[fp,r2,lsl #2]
addeq r2,r2,#1
addeq r8,r8,#1 @ and loop
beq 1b
cmp r9,#')' @ right parenthesis ?
bne 3f
mov r0,fp @ compute operator stack until left parenthesis
sub r2,r2,#1
2:
ldr r6,[fp,r2,lsl #2]
cmp r6,#'(' @ left parenthesis
addeq r8,r8,#1 @ end ?
beq 1b @ and loop
sub r7,r7,#1 @ last digit
mov r3,r7
bl compute
sub r2,r2,#1
cmp r2,#0
bge 2b
ldr r0,iAdrszMessNoparen @ no left parenthesis in stack
bl affichageMess
mov r0,#-1
b 100f
3:
cmp r9,#'+' @ addition
beq 4f
cmp r9,#'-' @ soustraction
beq 4f
cmp r9,#'*' @ multiplication
beq 4f
cmp r9,#'/' @ division
beq 4f
b 5f @ not operator
4: @ control priority and depile stacks
mov r0,fp
mov r3,r7
mov r4,r9
bl depileOper
mov r7,r3
add r8,r8,#1
b 1b @ and loop
5: @ digit
sub r9,r9,#0x30
mov r0,r9
bl digitControl
cmp r0,#0 @ error ?
bne 100f
str r9,[r1,r7,lsl #2] @ store digit in digits stack
add r7,r7,#1
add r8,r8,#1
beq 1b
b 100f
90: @ compute all stack operators
mov r0,fp
sub r7,r7,#1
91:
subs r2,r2,#1
blt 92f
mov r3,r7
bl compute
sub r7,r7,#1
b 91b
92:
ldr r0,[r1] @ total = first value on digits stack
cmp r0,#TOTAL @ control total
beq 93f @ ok
ldr r1,iAdrsZoneConv
bl conversion10 @ call decimal conversion
mov r2,#0
strb r2,[r1,r0]
ldr r0,iAdrszMessNotOK
ldr r1,iAdrsZoneConv @ insert conversion in message
bl strInsertAtCharInc
bl affichageMess
mov r0,#-1
b 100f
93: @ control use all digits
ldr r1,iAdriTabTopDigit
mov r2,#0
94: @ begin loop
ldr r0,[r1,r2,lsl #2] @ load top
cmp r0,#0
bne 95f
ldr r0,iAdrszMessNoalldigits
bl affichageMess
mov r0,#-1
b 100f
95:
add r2,r2,#1
cmp r2,#NBDIGITS
blt 94b
96: @ display message OK
ldr r0,iAdrszMessOK
bl affichageMess
mov r0,#0
b 100f
100:
add sp,sp,#80 @ stack algnement
pop {r1-r11,lr}
bx lr @ return
iAdrszMessNoparen: .int szMessNoparen
iAdrszMessNotOK: .int szMessNotOK
iAdrszMessOK: .int szMessOK
iAdrszMessNoalldigits: .int szMessNoalldigits
/******************************************************************/
/* depile operator */
/******************************************************************/
/* r0 operator stack address */
/* r1 digits stack address */
/* r2 operator indice */
/* r3 digits indice */
/* r4 operator */
/* r2 return a new operator indice */
/* r3 return a new digits indice */
depileOper:
push {r4-r8,lr} @ save registers
cmp r2,#0 @ first operator ?
beq 60f
sub r5,r2,#1
1:
ldr r6,[r0,r5,lsl #2] @ load stack operator
cmp r6,r4 @ same operators
beq 50f
cmp r6,#'*' @ multiplication
beq 50f
cmp r6,#'/' @ division
beq 50f
cmp r6,#'-' @ soustraction
beq 50f
b 60f
50: @ depile operators stack and compute
sub r2,r2,#1
sub r3,r3,#1
bl compute
sub r5,r5,#1
cmp r5,#0
bge 1b
60:
str r4,[r0,r2,lsl #2] @ add operator in stack
add r2,r2,#1
100:
pop {r4-r8,lr}
bx lr @ return
/******************************************************************/
/* compute */
/******************************************************************/
/* r0 operator stack address */
/* r1 digits stack address */
/* r2 operator indice */
/* r3 digits indice */
compute:
push {r1-r8,lr} @ save registers
ldr r6,[r1,r3,lsl #2] @ load second digit
sub r5,r3,#1
ldr r7,[r1,r5,lsl #2] @ load first digit
ldr r8,[r0,r2,lsl #2] @ load operator
cmp r8,#'+'
bne 1f
add r7,r7,r6 @ addition
str r7,[r1,r5,lsl #2]
b 100f
1:
cmp r8,#'-'
bne 2f
sub r7,r7,r6 @ soustaction
str r7,[r1,r5,lsl #2]
b 100f
2:
cmp r8,#'*'
bne 3f @ multiplication
mul r7,r6,r7
str r7,[r1,r5,lsl #2]
b 100f
3:
cmp r8,#'/'
bne 4f
udiv r7,r7,r6 @ division
str r7,[r1,r5,lsl #2]
b 100f
4:
cmp r8,#'(' @ left parenthesis ?
bne 5f
ldr r0,iAdrszMessErrParen @ error
bl affichageMess
mov r0,#-1
b 100f
5:
ldr r0,iAdrszMessErrOper
bl affichageMess
mov r0,#-1
100:
pop {r1-r8,lr}
bx lr @ return
iAdrszMessErrOper: .int szMessErrOper
iAdrszMessErrParen: .int szMessErrParen
/******************************************************************/
/* control digits */
/******************************************************************/
/* r0 return 0 if OK 1 if not digit */
digitControl:
push {r1-r4,lr} @ save registers
ldr r1,iAdriTabTopDigit
ldr r2,iAdriTabDigit
mov r3,#0
1:
ldr r4,[r2,r3,lsl #2] @ load digit
cmp r0,r4 @ equal ?
beq 2f @ yes
add r3,r3,#1 @ no -> loop
cmp r3,#NBDIGITS @ end ?
blt 1b
ldr r0,iAdrszMessNoDigit @ error
bl affichageMess
mov r0,#1
b 100f
2: @ control prev use
ldr r4,[r1,r3,lsl #2]
cmp r4,#0
beq 3f
add r3,r3,#1
cmp r3,#NBDIGITS
blt 1b
ldr r0,iAdrszMessSameDigit
bl affichageMess
mov r0,#1
b 100f
3:
mov r4,#1
str r4,[r1,r3,lsl #2]
mov r0,#0
100:
pop {r1-r4,lr}
bx lr @ return
iAdrszMessNoDigit: .int szMessNoDigit
iAdrszMessSameDigit: .int szMessSameDigit
/******************************************************************/
/* string entry */
/******************************************************************/
/* r0 return the first character of human entry */
saisie:
push {r1-r7,lr} @ save registers
mov r0,#STDIN @ Linux input console
ldr r1,iAdrsBuffer @ buffer address
mov r2,#BUFFERSIZE @ buffer size
mov r7,#READ @ request to read datas
svc 0 @ call system
ldr r1,iAdrsBuffer @ buffer address
ldrb r0,[r1] @ load first character
100:
pop {r1-r7,lr}
bx lr @ return
iAdrsBuffer: .int sBuffer
/***************************************************/
/* Generation random number */
/***************************************************/
/* r0 contains limit */
genereraleas:
push {r1-r4,lr} @ save registers
ldr r4,iAdriGraine
ldr r2,[r4]
ldr r3,iNbDep1
mul r2,r3,r2
ldr r3,iNbDep2
add r2,r2,r3
str r2,[r4] @ maj de la graine pour l appel suivant
cmp r0,#0
beq 100f
add r1,r0,#1 @ divisor
mov r0,r2 @ dividende
bl division
mov r0,r3 @ résult = remainder
100: @ end function
pop {r1-r4,lr} @ restaur registers
bx lr @ return
/*****************************************************/
iAdriGraine: .int iGraine
iNbDep1: .int 0x343FD
iNbDep2: .int 0x269EC3
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
<pre>
24 Game
The program will display four randomly-generated
single-digit numbers and will then prompt you to enter
an arithmetic expression followed by <enter> to sum
the given numbers to 24.
Exemple : 9+8+3+4 or (7+5)+(3*4)
The four digits are 5 1 1 5 and the score is 24.
Enter your expression (or type (q)uit to exit or (n) for other digits):
n
The four digits are 8 2 5 3 and the score is 24.
Enter your expression (or type (q)uit to exit or (n) for other digits):
(8*2)+5+3
It is OK.
New game (y/n) ?
</pre>
=={{header|Arturo}}==
<syntaxhighlight lang=rebol>print "-----------------------------"
print " Welcome to 24 Game"
print "-----------------------------"
digs: map 1..4 'x -> random 1 9
print ["The numbers you can use are:" join.with:" " digs]
print ""
validExpression?: function [expr][
loop expr 'item [
if or? inline? item block? item [
if not? validExpression? item -> return false
]
if symbol? item [
if not? contains? [+ / - *] item -> return false
]
if integer? item [
if not? contains? digs item -> return false
]
]
return true
]
result: 0
while [result<>24][
got: input "Enter an expression to form 24: "
blo: to :block got
if? validExpression? blo [
result: do blo
print ["The result is:" result]
]
else [
print "Invalid expression. Please try again!"
]
print ""
]
print "Well done!"</syntaxhighlight>
{{out}}
<pre>-----------------------------
Welcome to 24 Game
-----------------------------
The numbers you can use are: 3 2 2 1
Enter an expression to form 24: 3+2+2+1\
Invalid expression. Please try again!
Enter an expression to form 24: 3+2+2+1
The result is: 8
Enter an expression to form 24: (3+3+3+3+3)+2+2+1+1
The result is: 21
Enter an expression to form 24: (3+3+3+3+3)+2+2+1+1+1
The result is: 22
Enter an expression to form 24: 3+3+3+3+3+2+2+2+2+1+1
The result is: 25
Enter an expression to form 24: 3+3+3+3+3+2+2+2+2+1
The result is: 24
Well done!</pre>
=={{header|AutoHotkey}}==
<
Title := "24 Game"
Gui, -MinimizeBox
Line 343 ⟶ 1,927:
FileDelete, %File%
Return, Result
}</
=={{header|AutoIt}}==
<syntaxhighlight lang=AutoIt>
;AutoIt Script Example
;by Daniel Barnes
;spam me at djbarnes at orcon dot net dot en zed
;13/08/2012
;Choose four random digits (1-9) with repetitions allowed:
global $digits
FOR $i = 1 TO 4
$digits &= Random(1,9,1)
NEXT
While 1
main()
WEnd
Func main()
$text = "Enter an equation (using all of, and only, the single digits "&$digits &")"&@CRLF
$text &= "which evaluates to exactly 24. Only multiplication (*) division (/)"&@CRLF
$text &= "addition (+) and subtraction (-) operations and parentheses are allowed:"
$input = InputBox ("24 Game",$text,"","",400,150)
If @error Then exit
;remove any spaces in input
$input = StringReplace($input," ","")
;check correct characters were used
For $i = 1 To StringLen($input)
$chr = StringMid($input,$i,1)
If Not StringInStr("123456789*/+-()",$chr) Then
MsgBox (0, "ERROR","Invalid character used: '"&$chr&"'")
return
endif
Next
;validate the equation uses all of the 4 characters, and nothing else
$test = $input
$test = StringReplace($test,"(","")
$test = StringReplace($test,")","")
;validate the length of the input - if its not 7 characters long then the user has done something wrong
If StringLen ($test) <> 7 Then
MsgBox (0,"ERROR","The equation "&$test&" is invalid")
return
endif
$test = StringReplace($test,"/","")
$test = StringReplace($test,"*","")
$test = StringReplace($test,"-","")
$test = StringReplace($test,"+","")
For $i = 1 To StringLen($digits)
$digit = StringMid($digits,$i,1)
For $ii = 1 To StringLen($test)
If StringMid($test,$ii,1) = $digit Then
$test = StringLeft($test,$ii-1) & StringRight($test,StringLen($test)-$ii)
ExitLoop
endif
Next
Next
If $test <> "" Then
MsgBox (0, "ERROR", "The equation didn't use all 4 characters, and nothing else!")
return
endif
$try = Execute($input)
If $try = 24 Then
MsgBox (0, "24 Game","Well done. Your equation ("&$input&") = 24!")
Exit
Else
MsgBox (0, "24 Game","Fail. Your equation ("&$input&") = "&$try&"!")
return
endif
EndFunc
</syntaxhighlight>
=={{header|BBC BASIC}}==
<syntaxhighlight 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</syntaxhighlight>
=={{header|Befunge}}==
<syntaxhighlight lang=befunge>v > > >> v
2 2 1234
4 ^1?3^4
>8*00p10p> >? ?5> 68*+00g10gpv
v9?7v6 0
8 0
> > >> ^ g
^p00 _v# `\*49:+1 <
_>"rorrE",,,,,$ >~:67*-!#v_:167*+-!#v_:95*-!#v_:295*+-!#v_:586*+\`#v_:97*2--!#v
$ $ $ $ : $
* + - / 1 :
^ < < < < 8 .
6 6
* 4
+ *
\ -
` > v_v
"
^ < _v e
^ _^#+*28:p2\*84\-*86g2:-+*441< s
o
L
> 1 |-*49"#<
| -*84gg01g00<p00*84<v <
>00g:1+00p66*`#^_ "niW">:#,_@
</syntaxhighlight>
The code functions by placing the 4 randomly generated numbers into the points labelled 1,2,3,4. In order to play, press the corresponding label to draw that number onto the stack, then press the corresponding operation (+,-,*,/) to perform it on the stack elements postfix-wise according to the rules of befunge (i.e. pop the values operate and push the answer back to the stack). When you wish to check your answer enter "=" and it will perform the checks to ensure that you haven't performed any illegal operations, that you have used all four numbers and that your final value is 24.
Unfortunately, due to the lack of floating-point arithmetic in befunge, divide will result in the answer truncated to an integer.
Example:
6566
<pre>
213/-4*=
</pre>
{{out}}
<pre>
24 Win
</pre>
=={{header|Bracmat}}==
<syntaxhighlight lang=Bracmat> ( 24-game
= m-w m-z 4numbers answer expr numbers
, seed get-random convertBinaryMinusToUnary
, convertDivisionToMultiplication isExpresssion reciprocal
. (seed=.!arg:(~0:~/#?m-w.~0:~/#?m-z))
& seed$!arg
& ( get-random
=
. 36969*mod$(!m-z.65536)+div$(!m-z.65536):?m-z
& 18000*mod$(!m-w.65536)+div$(!m-w.65536):?m-w
& mod$(!m-z*65536+!m-w.9)+1
)
& ( convertBinaryMinusToUnary
= a z
. @(!arg:%?a "-" ?z)
& str$(!a "+-1*" convertBinaryMinusToUnary$!z)
| !arg
)
& (reciprocal=.!arg^-1)
& ( convertDivisionToMultiplication
= a z
. @(!arg:?a "/" ?z)
& str$(!a "*reciprocal$" convertDivisionToMultiplication$!z)
| !arg
)
& ( isExpresssion
= A Z expr
. @( !arg
: ?A
("+"|"-"|"*"|"/")
( ?Z
& isExpresssion$!A
& isExpresssion$!Z
)
)
| !numbers:?A !arg ?Z
& !A !Z:?numbers
| ( @(!arg:"(" ?expr ")")
| @(!arg:(" "|\t) ?expr)
| @(!arg:?expr (" "|\t))
)
& isExpresssion$!expr
)
& out
$ "Enter an expression that evaluates to 24 by combining the following numbers."
& out$"You may only use the operators + - * /"
& out$"Parentheses and spaces are allowed."
& whl
' ( get-random$() get-random$() get-random$() get-random$
: ?4numbers
& out$!4numbers
& whl
' ( get'(,STR):?expr:~
& !4numbers:?numbers
& ~(isExpresssion$!expr&!numbers:)
& out
$ ( str
$ ( "["
!expr
"] is not a valid expression. Try another expression."
)
)
)
& !expr:~
& convertBinaryMinusToUnary$!expr:?expr
& convertDivisionToMultiplication$!expr:?expr
& get$(!expr,MEM):?answer
& out$(str$(!expr " = " !answer))
& !answer
: ( 24&out$Right!
| #&out$Wrong!
)
& out$"Try another one:"
)
& out$bye
)
& 24-game$(13.14)
& ;</syntaxhighlight>
<pre>Enter an expression that evaluates to 24 by combining the following numbers.
You may only use the operators + - * /
Parentheses and spaces are allowed.
4 2 2 7
4*7 - 2-2
4*7 +-1* 2+-1*2 = 24
Right!
Try another one:
4 7 9 8
((4) *(8 - (9- 7))
[((4) *(8 - (9- 7))] is not a valid expression. Try another expression.
((4) *(8 - (9- 7)))
((4) *(8 +-1* (9+-1* 7))) = 24
Right!
Try another one:
9 5 8 5
5 * 5 - (9 - 8)
5 * 5 +-1* (9 +-1* 8) = 24
Right!
Try another one:
5 9 7 8
5*8 - 9 - 7
5*8 +-1* 9 +-1* 7 = 24
Right!
Try another one:
7 8 6 2
8 * ((7 - 6) + 2)
8 * ((7 +-1* 6) + 2) = 24
Right!
Try another one:
8 6 8 1
8 * (1 + 8 - 6)
8 * (1 + 8 +-1* 6) = 24
Right!
Try another one:
8 2 2 4
8 * (2 + 4)/2
8 * (2 + 4)*reciprocal$2 = 24
Right!
Try another one:
8 4 6 7
bye</pre>
=={{header|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.
<syntaxhighlight lang=C>#include <stdio.h>
#include <ctype.h>
#include <stdlib.h>
#include <setjmp.h>
#include <time.h>
jmp_buf ctx;
const char *msg;
enum { OP_NONE = 0, OP_NUM, OP_ADD, OP_SUB, OP_MUL, OP_DIV };
typedef struct expr_t *expr, expr_t;
struct expr_t {
int op, val, used;
expr left, right;
};
#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(const char *s)
{
msg = s;
longjmp(ctx, 1);
}
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();
setjmp(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;
}</syntaxhighlight>
{{out}}
<pre>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</pre>
See [[24 game/C]]
=={{header|
See [[24 game/CSharp]]
=={{header|C++}}==
{{works with|C++11}}
This uses the C++11 standard to simplify several parts of the code. Input is given in RPN format.
<syntaxhighlight 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;
}</syntaxhighlight>
{{out}}
<pre>
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!
</pre>
=={{header|Ceylon}}==
Be sure to import ceylon.random in you ceylon.module file.
<syntaxhighlight lang=ceylon>import ceylon.random {
DefaultRandom
}
class Rational(shared Integer numerator, shared Integer denominator = 1) satisfies Numeric<Rational> {
assert (denominator != 0);
Integer gcd(Integer a, Integer b) => if (b == 0) then a else gcd(b, a % b);
shared Rational inverted => Rational(denominator, numerator);
shared Rational simplified =>
let (largestFactor = gcd(numerator, denominator))
Rational(numerator / largestFactor, denominator / largestFactor);
divided(Rational other) => (this * other.inverted).simplified;
negated => Rational(-numerator, denominator).simplified;
plus(Rational other) =>
let (top = numerator*other.denominator + other.numerator*denominator,
bottom = denominator * other.denominator)
Rational(top, bottom).simplified;
times(Rational other) =>
Rational(numerator * other.numerator, denominator * other.denominator).simplified;
shared Integer integer => numerator / denominator;
shared Float float => numerator.float / denominator.float;
string => denominator == 1 then numerator.string else "``numerator``/``denominator``";
shared actual Boolean equals(Object that) {
if (is Rational that) {
value simplifiedThis = this.simplified;
value simplifiedThat = that.simplified;
return simplifiedThis.numerator==simplifiedThat.numerator &&
simplifiedThis.denominator==simplifiedThat.denominator;
}
else {
return false;
}
}
}
interface Expression {
shared formal Rational evaluate();
}
class NumberExpression(Rational number) satisfies Expression {
evaluate() => number;
string => number.string;
}
class OperatorExpression(Expression left, Character operator, Expression right) satisfies Expression {
shared actual Rational evaluate() {
switch (operator)
case ('*') {
return left.evaluate() * right.evaluate();
}
case ('/') {
return left.evaluate() / right.evaluate();
}
case ('-') {
return left.evaluate() - right.evaluate();
}
case ('+') {
return left.evaluate() + right.evaluate();
}
else {
throw Exception("unknown operator ``operator``");
}
}
string => "(``left.string`` ``operator.string`` ``right.string``)";
}
"A simplified top down operator precedence parser. There aren't any right
binding operators so we don't have to worry about that."
class PrattParser(String input) {
value tokens = input.replace(" ", "");
variable value index = -1;
shared Expression expression(Integer precedence = 0) {
value token = advance();
variable value left = parseUnary(token);
while (precedence < getPrecedence(peek())) {
value nextToken = advance();
left = parseBinary(left, nextToken);
}
return left;
}
Integer getPrecedence(Character op) =>
switch (op)
case ('*' | '/') 2
case ('+' | '-') 1
else 0;
Character advance(Character? expected = null) {
index++;
value token = tokens[index] else ' ';
if (exists expected, token != expected) {
throw Exception("unknown character ``token``");
}
return token;
}
Character peek() => tokens[index + 1] else ' ';
Expression parseBinary(Expression left, Character operator) =>
let (right = expression(getPrecedence(operator)))
OperatorExpression(left, operator, right);
Expression parseUnary(Character token) {
if (token.digit) {
assert (is Integer int = Integer.parse(token.string));
return NumberExpression(Rational(int));
}
else if (token == '(') {
value exp = expression();
advance(')');
return exp;
}
else {
throw Exception("unknown character ``token``");
}
}
}
shared void run() {
value random = DefaultRandom();
function random4Numbers() =>
random.elements(1..9).take(4).sequence();
function isValidGuess(String input, {Integer*} allowedNumbers) {
value allowedOperators = set { *"()+-/*" };
value extractedNumbers = input
.split((Character ch) => ch in allowedOperators || ch.whitespace)
.map((String element) => Integer.parse(element))
.narrow<Integer>();
if (extractedNumbers.any((Integer element) => element > 9)) {
print("number too big!");
return false;
}
if (extractedNumbers.any((Integer element) => element < 1)) {
print("number too small!");
return false;
}
if (extractedNumbers.sort(increasing) != allowedNumbers.sort(increasing)) {
print("use all the numbers, please!");
return false;
}
if (!input.every((Character element) => element in allowedOperators || element.digit || element.whitespace)) {
print("only digits and mathematical operators, please");
return false;
}
variable value leftParens = 0;
for (c in input) {
if (c == '(') {
leftParens++;
} else if (c == ')') {
leftParens--;
if (leftParens < 0) {
break;
}
}
}
if (leftParens != 0) {
print("unbalanced brackets!");
return false;
}
return true;
}
function evaluate(String input) =>
let (parser = PrattParser(input),
exp = parser.expression())
exp.evaluate();
print("Welcome to The 24 Game.
Create a mathematical equation with four random
numbers that evaluates to 24.
You must use all the numbers once and only once,
but in any order.
Also, only + - / * and parentheses are allowed.
For example: (1 + 2 + 3) * 4
Also: enter n for new numbers and q to quit.
-----------------------------------------------");
value twentyfour = Rational(24);
while (true) {
value chosenNumbers = random4Numbers();
void pleaseTryAgain() => print("Sorry, please try again. (Your numbers are ``chosenNumbers``)");
print("Your numbers are ``chosenNumbers``. Please turn them into 24.");
while (true) {
value line = process.readLine()?.trimmed;
if (exists line) {
if (line.uppercased == "Q") { // quit
print("bye!");
return;
}
if (line.uppercased == "N") { // new game
break;
}
if (isValidGuess(line, chosenNumbers)) {
try {
value result = evaluate(line);
print("= ``result``");
if (result == twentyfour) {
print("You did it!");
break;
}
else {
pleaseTryAgain();
}
}
catch (Exception e) {
print(e.message);
pleaseTryAgain();
}
}
else {
pleaseTryAgain();
}
}
}
}
}</syntaxhighlight>
=={{header|Clojure}}==
<
(ns rosettacode.24game)
(def ^:dynamic *luser*
"You guessed wrong, or your input was not in prefix notation.")
(def ^:private start #(println
"Your numbers are: " %1 ". Your goal is " %2 ".\n"
"Use the ops [+ - * /] in prefix notation to reach" %2 ".\n"
"q[enter] to quit."))
(defn play
([] (play 24))
([goal] (play goal (repeatedly 4 #(inc (rand-int 9)))))
([goal gns]
(start gns goal)
(let [input (read-string (read-line))
flat (flatten input)]
(println
(if (and (re-find #"^\([\d\s+*/-]+\d?\)$" (pr-str flat))
(= (set gns) (set (filter integer? flat)))
(= goal (eval input)))
"You won the game!"
*luser*))
(when (not= input 'q) (recur goal gns)))))
; * checks prefix form, then checks to see that the numbers used
; and the numbers generated by the game are the same.
</syntaxhighlight>
=={{header|COBOL}}==
<syntaxhighlight lang=COBOL> >>SOURCE FORMAT FREE
*> This code is dedicated to the public domain
*> This is GNUCobol 2.0
identification division.
program-id. twentyfour.
environment division.
configuration section.
repository. function all intrinsic.
data division.
working-storage section.
01 p pic 999.
01 p1 pic 999.
01 p-max pic 999 value 38.
01 program-syntax pic x(494) value
*>statement = expression;
'001 001 000 n'
& '002 000 004 ='
& '003 005 000 n'
& '004 000 002 ;'
*>expression = term, {('+'|'-') term,};
& '005 005 000 n'
& '006 000 016 ='
& '007 017 000 n'
& '008 000 015 {'
& '009 011 013 ('
& '010 001 000 t'
& '011 013 000 |'
& '012 002 000 t'
& '013 000 009 )'
& '014 017 000 n'
& '015 000 008 }'
& '016 000 006 ;'
*>term = factor, {('*'|'/') factor,};
& '017 017 000 n'
& '018 000 028 ='
& '019 029 000 n'
& '020 000 027 {'
& '021 023 025 ('
& '022 003 000 t'
& '023 025 000 |'
& '024 004 000 t'
& '025 000 021 )'
& '026 029 000 n'
& '027 000 020 }'
& '028 000 018 ;'
*>factor = ('(' expression, ')' | digit,);
& '029 029 000 n'
& '030 000 038 ='
& '031 035 037 ('
& '032 005 000 t'
& '033 005 000 n'
& '034 006 000 t'
& '035 037 000 |'
& '036 000 000 n'
& '037 000 031 )'
& '038 000 030 ;'.
01 filler redefines program-syntax.
03 p-entry occurs 038.
05 p-address pic 999.
05 filler pic x.
05 p-definition pic 999.
05 p-alternate redefines p-definition pic 999.
05 filler pic x.
05 p-matching pic 999.
05 filler pic x.
05 p-symbol pic x.
01 t pic 999.
01 t-len pic 99 value 6.
01 terminal-symbols
pic x(210) value
'01 + '
& '01 - '
& '01 * '
& '01 / '
& '01 ( '
& '01 ) '.
01 filler redefines terminal-symbols.
03 terminal-symbol-entry occurs 6.
05 terminal-symbol-len pic 99.
05 filler pic x.
05 terminal-symbol pic x(32).
01 nt pic 999.
01 nt-lim pic 99 value 5.
01 nonterminal-statements pic x(294) value
"000 ....,....,....,....,....,....,....,....,....,"
& "001 statement = expression; "
& "005 expression = term, {('+'|'-') term,}; "
& "017 term = factor, {('*'|'/') factor,}; "
& "029 factor = ('(' expression, ')' | digit,); "
& "036 digit; ".
01 filler redefines nonterminal-statements.
03 nonterminal-statement-entry occurs 5.
05 nonterminal-statement-number pic 999.
05 filler pic x.
05 nonterminal-statement pic x(45).
01 indent pic x(64) value all '| '.
01 interpreter-stack.
03 r pic 99. *> previous top of stack
03 s pic 99. *> current top of stack
03 s-max pic 99 value 32.
03 s-entry occurs 32.
05 filler pic x(2) value 'p='.
05 s-p pic 999. *> callers return address
05 filler pic x(4) value ' sc='.
05 s-start-control pic 999. *> sequence start address
05 filler pic x(4) value ' ec='.
05 s-end-control pic 999. *> sequence end address
05 filler pic x(4) value ' al='.
05 s-alternate pic 999. *> the next alternate
05 filler pic x(3) value ' r='.
05 s-result pic x. *> S success, F failure, N no result
05 filler pic x(3) value ' c='.
05 s-count pic 99. *> successes in a sequence
05 filler pic x(3) value ' x='.
05 s-repeat pic 99. *> repeats in a {} sequence
05 filler pic x(4) value ' nt='.
05 s-nt pic 99. *> current nonterminal
01 language-area.
03 l pic 99.
03 l-lim pic 99.
03 l-len pic 99 value 1.
03 nd pic 9.
03 number-definitions.
05 n occurs 4 pic 9.
03 nu pic 9.
03 number-use.
05 u occurs 4 pic x.
03 statement.
05 c occurs 32.
07 c9 pic 9.
01 number-validation.
03 p4 pic 99.
03 p4-lim pic 99 value 24.
03 permutations-4 pic x(96) value
'1234'
& '1243'
& '1324'
& '1342'
& '1423'
& '1432'
& '2134'
& '2143'
& '2314'
& '2341'
& '2413'
& '2431'
& '3124'
& '3142'
& '3214'
& '3241'
& '3423'
& '3432'
& '4123'
& '4132'
& '4213'
& '4231'
& '4312'
& '4321'.
03 filler redefines permutations-4.
05 permutation-4 occurs 24 pic x(4).
03 current-permutation-4 pic x(4).
03 cpx pic 9.
03 od1 pic 9.
03 od2 pic 9.
03 odx pic 9.
03 od-lim pic 9 value 4.
03 operator-definitions pic x(4) value '+-*/'.
03 current-operators pic x(3).
03 co3 pic 9.
03 rpx pic 9.
03 rpx-lim pic 9 value 4.
03 valid-rpn-forms pic x(28) value
'nnonono'
& 'nnnonoo'
& 'nnnoono'
& 'nnnnooo'.
03 filler redefines valid-rpn-forms.
05 rpn-form occurs 4 pic x(7).
03 current-rpn-form pic x(7).
01 calculation-area.
03 osx pic 99.
03 operator-stack pic x(32).
03 oqx pic 99.
03 oqx1 pic 99.
03 output-queue pic x(32).
03 work-number pic s9999.
03 top-numerator pic s9999 sign leading separate.
03 top-denominator pic s9999 sign leading separate.
03 rsx pic 9.
03 result-stack occurs 8.
05 numerator pic s9999.
05 denominator pic s9999.
01 error-found pic x.
01 divide-by-zero-error pic x.
*> diagnostics
01 NL pic x value x'0A'.
01 NL-flag pic x value space.
01 display-level pic x value '0'.
01 loop-lim pic 9999 value 1500.
01 loop-count pic 9999 value 0.
01 message-area value spaces.
03 message-level pic x.
03 message-value pic x(128).
*> input and examples
01 instruction pic x(32) value spaces.
01 tsx pic 99.
01 tsx-lim pic 99 value 14.
01 test-statements.
03 filler pic x(32) value '1234;1 + 2 + 3 + 4'.
03 filler pic x(32) value '1234;1 * 2 * 3 * 4'.
03 filler pic x(32) value '1234;((1)) * (((2 * 3))) * 4'.
03 filler pic x(32) value '1234;((1)) * ((2 * 3))) * 4'.
03 filler pic x(32) value '1234;(1 + 2 + 3 + 4'.
03 filler pic x(32) value '1234;)1 + 2 + 3 + 4'.
03 filler pic x(32) value '1234;1 * * 2 * 3 * 4'.
03 filler pic x(32) value '5679;6 - (5 - 7) * 9'.
03 filler pic x(32) value '1268;((1 * (8 * 6) / 2))'.
03 filler pic x(32) value '4583;-5-3+(8*4)'.
03 filler pic x(32) value '4583;8 * 4 - 5 - 3'.
03 filler pic x(32) value '4583;8 * 4 - (5 + 3)'.
03 filler pic x(32) value '1223;1 * 3 / (2 - 2)'.
03 filler pic x(32) value '2468;(6 * 8) / 4 / 2'.
01 filler redefines test-statements.
03 filler occurs 14.
05 test-numbers pic x(4).
05 filler pic x.
05 test-statement pic x(27).
procedure division.
start-twentyfour.
display 'start twentyfour'
perform generate-numbers
display 'type h <enter> to see instructions'
accept instruction
perform until instruction = spaces or 'q'
evaluate true
when instruction = 'h'
perform display-instructions
when instruction = 'n'
perform generate-numbers
when instruction(1:1) = 'm'
move instruction(2:4) to number-definitions
perform validate-number
if divide-by-zero-error = space
and 24 * top-denominator = top-numerator
display number-definitions ' is solved by ' output-queue(1:oqx)
else
display number-definitions ' is not solvable'
end-if
when instruction = 'd0' or 'd1' or 'd2' or 'd3'
move instruction(2:1) to display-level
when instruction = 'e'
display 'examples:'
perform varying tsx from 1 by 1
until tsx > tsx-lim
move spaces to statement
move test-numbers(tsx) to number-definitions
move test-statement(tsx) to statement
perform evaluate-statement
perform show-result
end-perform
when other
move instruction to statement
perform evaluate-statement
perform show-result
end-evaluate
move spaces to instruction
display 'instruction? ' with no advancing
accept instruction
end-perform
display 'exit twentyfour'
stop run
.
generate-numbers.
perform with test after until divide-by-zero-error = space
and 24 * top-denominator = top-numerator
compute n(1) = random(seconds-past-midnight) * 10 *> seed
perform varying nd from 1 by 1 until nd > 4
compute n(nd) = random() * 10
perform until n(nd) <> 0
compute n(nd) = random() * 10
end-perform
end-perform
perform validate-number
end-perform
display NL 'numbers:' with no advancing
perform varying nd from 1 by 1 until nd > 4
display space n(nd) with no advancing
end-perform
display space
.
validate-number.
perform varying p4 from 1 by 1 until p4 > p4-lim
move permutation-4(p4) to current-permutation-4
perform varying od1 from 1 by 1 until od1 > od-lim
move operator-definitions(od1:1) to current-operators(1:1)
perform varying od2 from 1 by 1 until od2 > od-lim
move operator-definitions(od2:1) to current-operators(2:1)
perform varying odx from 1 by 1 until odx > od-lim
move operator-definitions(odx:1) to current-operators(3:1)
perform varying rpx from 1 by 1 until rpx > rpx-lim
move rpn-form(rpx) to current-rpn-form
move 0 to cpx co3
move spaces to output-queue
move 7 to oqx
perform varying oqx1 from 1 by 1 until oqx1 > oqx
if current-rpn-form(oqx1:1) = 'n'
add 1 to cpx
move current-permutation-4(cpx:1) to nd
move n(nd) to output-queue(oqx1:1)
else
add 1 to co3
move current-operators(co3:1) to output-queue(oqx1:1)
end-if
end-perform
end-perform
perform evaluate-rpn
if divide-by-zero-error = space
and 24 * top-denominator = top-numerator
exit paragraph
end-if
end-perform
end-perform
end-perform
end-perform
.
display-instructions.
display '1) Type h <enter> to repeat these instructions.'
display '2) The program will display four randomly-generated'
display ' single-digit numbers and will then prompt you to enter'
display ' an arithmetic expression followed by <enter> to sum'
display ' the given numbers to 24.'
display ' The four numbers may contain duplicates and the entered'
display ' expression must reference all the generated numbers and duplicates.'
display ' Warning: the program converts the entered infix expression'
display ' to a reverse polish notation (rpn) expression'
display ' which is then interpreted from RIGHT to LEFT.'
display ' So, for instance, 8*4 - 5 - 3 will not sum to 24.'
display '3) Type n <enter> to generate a new set of four numbers.'
display ' The program will ensure the generated numbers are solvable.'
display '4) Type m#### <enter> (e.g. m1234) to create a fixed set of numbers'
display ' for testing purposes.'
display ' The program will test the solvability of the entered numbers.'
display ' For example, m1234 is solvable and m9999 is not solvable.'
display '5) Type d0, d1, d2 or d3 followed by <enter> to display none or'
display ' increasingly detailed diagnostic information as the program evaluates'
display ' the entered expression.'
display '6) Type e <enter> to see a list of example expressions and results'
display '7) Type <enter> or q <enter> to exit the program'
.
show-result.
if error-found = 'y'
or divide-by-zero-error = 'y'
exit paragraph
end-if
display 'statement in RPN is' space output-queue
evaluate true
when top-numerator = 0
when top-denominator = 0
when 24 * top-denominator <> top-numerator
display 'result (' top-numerator '/' top-denominator ') is not 24'
when other
display 'result is 24'
end-evaluate
.
evaluate-statement.
compute l-lim = length(trim(statement))
display NL 'numbers:' space n(1) space n(2) space n(3) space n(4)
move number-definitions to number-use
display 'statement is' space statement
move 1 to l
move 0 to loop-count
move space to error-found
move 0 to osx oqx
move spaces to output-queue
move 1 to p
move 1 to nt
move 0 to s
perform increment-s
perform display-start-nonterminal
perform increment-p
*>===================================
*> interpret ebnf
*>===================================
perform until s = 0
or error-found = 'y'
evaluate true
when p-symbol(p) = 'n'
and p-definition(p) = 000 *> a variable
perform test-variable
if s-result(s) = 'S'
perform increment-l
end-if
perform increment-p
when p-symbol(p) = 'n'
and p-address(p) <> p-definition(p) *> nonterminal reference
move p to s-p(s)
move p-definition(p) to p
when p-symbol(p) = 'n'
and p-address(p) = p-definition(p) *> nonterminal definition
perform increment-s
perform display-start-nonterminal
perform increment-p
when p-symbol(p) = '=' *> nonterminal control
move p to s-start-control(s)
move p-matching(p) to s-end-control(s)
perform increment-p
when p-symbol(p) = ';' *> end nonterminal
perform display-end-control
perform display-end-nonterminal
perform decrement-s
if s > 0
evaluate true
when s-result(r) = 'S'
perform set-success
when s-result(r) = 'F'
perform set-failure
end-evaluate
move s-p(s) to p
perform increment-p
perform display-continue-nonterminal
end-if
when p-symbol(p) = '{' *> start repeat sequence
perform increment-s
perform display-start-control
move p to s-start-control(s)
move p-alternate(p) to s-alternate(s)
move p-matching(p) to s-end-control(s)
move 0 to s-count(s)
perform increment-p
when p-symbol(p) = '}' *> end repeat sequence
perform display-end-control
evaluate true
when s-result(s) = 'S' *> repeat the sequence
perform display-repeat-control
perform set-nothing
add 1 to s-repeat(s)
move s-start-control(s) to p
perform increment-p
when other
perform decrement-s
evaluate true
when s-result(r) = 'N'
and s-repeat(r) = 0 *> no result
perform increment-p
when s-result(r) = 'N'
and s-repeat(r) > 0 *> no result after success
perform set-success
perform increment-p
when other *> fail the sequence
perform increment-p
end-evaluate
end-evaluate
when p-symbol(p) = '(' *> start sequence
perform increment-s
perform display-start-control
move p to s-start-control(s)
move p-alternate(p) to s-alternate(s)
move p-matching(p) to s-end-control(s)
move 0 to s-count(s)
perform increment-p
when p-symbol(p) = ')' *> end sequence
perform display-end-control
perform decrement-s
evaluate true
when s-result(r) = 'S' *> success
perform set-success
perform increment-p
when s-result(r) = 'N' *> no result
perform set-failure
perform increment-p
when other *> fail the sequence
perform set-failure
perform increment-p
end-evaluate
when p-symbol(p) = '|' *> alternate
evaluate true
when s-result(s) = 'S' *> exit the sequence
perform display-skip-alternate
move s-end-control(s) to p
when other
perform display-take-alternate
move p-alternate(p) to s-alternate(s) *> the next alternate
perform increment-p
perform set-nothing
end-evaluate
when p-symbol(p) = 't' *> terminal
move p-definition(p) to t
move terminal-symbol-len(t) to t-len
perform display-terminal
evaluate true
when statement(l:t-len) = terminal-symbol(t)(1:t-len) *> successful match
perform set-success
perform display-recognize-terminal
perform process-token
move t-len to l-len
perform increment-l
perform increment-p
when s-alternate(s) <> 000 *> we are in an alternate sequence
move s-alternate(s) to p
when other *> fail the sequence
perform set-failure
move s-end-control(s) to p
end-evaluate
when other *> end control
perform display-control-failure *> shouldnt happen
end-evaluate
end-perform
evaluate true *> at end of evaluation
when error-found = 'y'
continue
when l <= l-lim *> not all tokens parsed
display 'error: invalid statement'
perform statement-error
when number-use <> spaces
display 'error: not all numbers were used: ' number-use
move 'y' to error-found
end-evaluate
.
increment-l.
evaluate true
when l > l-lim *> end of statement
continue
when other
add l-len to l
perform varying l from l by 1
until c(l) <> space
or l > l-lim
continue
end-perform
move 1 to l-len
if l > l-lim
perform end-tokens
end-if
end-evaluate
.
increment-p.
evaluate true
when p >= p-max
display 'at' space p ' parse overflow'
space 's=<' s space s-entry(s) '>'
move 'y' to error-found
when other
add 1 to p
perform display-statement
end-evaluate
.
increment-s.
evaluate true
when s >= s-max
display 'at' space p ' stack overflow '
space 's=<' s space s-entry(s) '>'
move 'y' to error-found
when other
move s to r
add 1 to s
initialize s-entry(s)
move 'N' to s-result(s)
move p to s-p(s)
move nt to s-nt(s)
end-evaluate
.
decrement-s.
if s > 0
move s to r
subtract 1 from s
if s > 0
move s-nt(s) to nt
end-if
end-if
.
set-failure.
move 'F' to s-result(s)
if s-count(s) > 0
display 'sequential parse failure'
perform statement-error
end-if
.
set-success.
move 'S' to s-result(s)
add 1 to s-count(s)
.
set-nothing.
move 'N' to s-result(s)
move 0 to s-count(s)
.
statement-error.
display statement
move spaces to statement
move '^ syntax error' to statement(l:)
display statement
move 'y' to error-found
.
*>=====================
*> twentyfour semantics
*>=====================
test-variable.
*> check validity
perform varying nd from 1 by 1 until nd > 4
or c(l) = n(nd)
continue
end-perform
*> check usage
perform varying nu from 1 by 1 until nu > 4
or c(l) = u(nu)
continue
end-perform
evaluate true
when l > l-lim
perform set-failure
when c9(l) not numeric
perform set-failure
when nd > 4
display 'invalid number'
perform statement-error
when nu > 4
display 'number already used'
perform statement-error
when other
move space to u(nu)
perform set-success
add 1 to oqx
move c(l) to output-queue(oqx:1)
end-evaluate
.
*> ==================================
*> Dijkstra Shunting-Yard Algorithm
*> to convert infix to rpn
*> ==================================
process-token.
evaluate true
when c(l) = '('
add 1 to osx
move c(l) to operator-stack(osx:1)
when c(l) = ')'
perform varying osx from osx by -1 until osx < 1
or operator-stack(osx:1) = '('
add 1 to oqx
move operator-stack(osx:1) to output-queue(oqx:1)
end-perform
if osx < 1
display 'parenthesis error'
perform statement-error
exit paragraph
end-if
subtract 1 from osx
when (c(l) = '+' or '-') and (operator-stack(osx:1) = '*' or '/')
*> lesser operator precedence
add 1 to oqx
move operator-stack(osx:1) to output-queue(oqx:1)
move c(l) to operator-stack(osx:1)
when other
*> greater operator precedence
add 1 to osx
move c(l) to operator-stack(osx:1)
end-evaluate
.
end-tokens.
*> 1) copy stacked operators to the output-queue
perform varying osx from osx by -1 until osx < 1
or operator-stack(osx:1) = '('
add 1 to oqx
move operator-stack(osx:1) to output-queue(oqx:1)
end-perform
if osx > 0
display 'parenthesis error'
perform statement-error
exit paragraph
end-if
*> 2) evaluate the rpn statement
perform evaluate-rpn
if divide-by-zero-error = 'y'
display 'divide by zero error'
end-if
.
evaluate-rpn.
move space to divide-by-zero-error
move 0 to rsx *> stack depth
perform varying oqx1 from 1 by 1 until oqx1 > oqx
if output-queue(oqx1:1) >= '1' and <= '9'
*> push current data onto the stack
add 1 to rsx
move top-numerator to numerator(rsx)
move top-denominator to denominator(rsx)
move output-queue(oqx1:1) to top-numerator
move 1 to top-denominator
else
*> apply the operation
evaluate true
when output-queue(oqx1:1) = '+'
compute top-numerator = top-numerator * denominator(rsx)
+ top-denominator * numerator(rsx)
compute top-denominator = top-denominator * denominator(rsx)
when output-queue(oqx1:1) = '-'
compute top-numerator = top-denominator * numerator(rsx)
- top-numerator * denominator(rsx)
compute top-denominator = top-denominator * denominator(rsx)
when output-queue(oqx1:1) = '*'
compute top-numerator = top-numerator * numerator(rsx)
compute top-denominator = top-denominator * denominator(rsx)
when output-queue(oqx1:1) = '/'
compute work-number = numerator(rsx) * top-denominator
compute top-denominator = denominator(rsx) * top-numerator
if top-denominator = 0
move 'y' to divide-by-zero-error
exit paragraph
end-if
move work-number to top-numerator
end-evaluate
*> pop the stack
subtract 1 from rsx
end-if
end-perform
.
*>====================
*> diagnostic displays
*>====================
display-start-nonterminal.
perform varying nt from nt-lim by -1 until nt < 1
or p-definition(p) = nonterminal-statement-number(nt)
continue
end-perform
if nt > 0
move '1' to NL-flag
string '1' indent(1:s + s) 'at ' s space p ' start ' trim(nonterminal-statement(nt))
into message-area perform display-message
move nt to s-nt(s)
end-if
.
display-continue-nonterminal.
move s-nt(s) to nt
string '1' indent(1:s + s) 'at ' s space p space p-symbol(p) ' continue ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
into message-area perform display-message
.
display-end-nonterminal.
move s-nt(s) to nt
move '2' to NL-flag
string '1' indent(1:s + s) 'at ' s space p ' end ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
into message-area perform display-message
.
display-start-control.
string '2' indent(1:s + s) 'at ' s space p ' start ' p-symbol(p) ' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-repeat-control.
string '2' indent(1:s + s) 'at ' s space p ' repeat ' p-symbol(p) ' in ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
into message-area perform display-message
.
display-end-control.
string '2' indent(1:s + s) 'at ' s space p ' end ' p-symbol(p) ' in ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
into message-area perform display-message
.
display-take-alternate.
string '2' indent(1:s + s) 'at ' s space p ' take alternate' ' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-skip-alternate.
string '2' indent(1:s + s) 'at ' s space p ' skip alternate' ' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-terminal.
string '1' indent(1:s + s) 'at ' s space p
' compare ' statement(l:t-len) ' to ' terminal-symbol(t)(1:t-len)
' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-recognize-terminal.
string '1' indent(1:s + s) 'at ' s space p ' recognize terminal: ' c(l) ' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-recognize-variable.
string '1' indent(1:s + s) 'at ' s space p ' recognize digit: ' c(l) ' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-statement.
compute p1 = p - s-start-control(s)
string '3' indent(1:s + s) 'at ' s space p
' statement: ' s-start-control(s) '/' p1
space p-symbol(p) space s-result(s)
' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-control-failure.
display loop-count space indent(1:s + s) 'at' space p ' control failure' ' in ' trim(nonterminal-statement(nt))
display loop-count space indent(1:s + s) ' ' 'p=<' p p-entry(p) '>'
display loop-count space indent(1:s + s) ' ' 's=<' s space s-entry(s) '>'
display loop-count space indent(1:s + s) ' ' 'l=<' l space c(l)'>'
perform statement-error
.
display-message.
if display-level = 1
move space to NL-flag
end-if
evaluate true
when loop-count > loop-lim *> loop control
display 'display count exceeds ' loop-lim
stop run
when message-level <= display-level
evaluate true
when NL-flag = '1'
display NL loop-count space trim(message-value)
when NL-flag = '2'
display loop-count space trim(message-value) NL
when other
display loop-count space trim(message-value)
end-evaluate
end-evaluate
add 1 to loop-count
move spaces to message-area
move space to NL-flag
.
end program twentyfour.
</syntaxhighlight>
=={{header|CoffeeScript}}==
{{works with|node.js}}
<syntaxhighlight 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()
</syntaxhighlight>
=={{header|Commodore BASIC}}==
This solution was taken from the ZX Spectrum example further down, however, BASIC on the Spectrum features slightly different string handling functions. Most importantly, while the <code>val()</code> function on the Spectrum is able to parse complete mathematical expressions within the string as it converts it to a number, Commodore BASIC will obtain only a single number provided that the first character is a valid numeric character and up to any non-numeric character. (Even floating-point numbers where 0 < n < 1 must begin with a leading 0 prior to the decimal point.)
To get around this, this program utilizes BASIC's ability to parse expressions containing simple math operators, and is in fact technically a self-modifying program. Line 2005 is a line padded with colons which simply allow BASIC to join multiple statements on a single line, otherwise perform no operation. This reserves sufficient space in memory for inserting the user's expression—by overwriting the first several bytes of colons—which can then be evaluated in the normal course of the program's execution. The subroutine at 1400 initializes a simple translation table for exchanging the operators into their proper BASIC tokens. Parenthesis, numerals, and variable names do not need to be translated.
After the user types in an expression, the program validates the input (same algorithms as the ZX Spectrum example), writes the expression as <code>R=''expression''</code> as tokenized BASIC into line 2005, and then executes the subroutine at 2000 to obtain the value. Upon return, the content of the variable <code>R</code> is evaluated to see if it is 24.
If the statement at line 645 is uncommented, this will allow the program to "erase" line 2005 and thus "hide" the trick. As is, if you list the program after making an attempt, you will see the last expression given to the program.
Since Commodore BASIC v2 was the initial target for this program, all other versions of Commodore BASIC are compatible as long as the base memory address for BASIC programs is adjusted. (BASIC tokens maintain compatibility across all versions.) Simply use the appropriate values for <code>bh</code> and <code>bl</code> in lines 11-15.
<syntaxhighlight lang=gwbasic>1 rem 24 game
2 rem for rosetta code
10 rem use appropriate basic base address
11 bh=08:bl=01: rem $0801 commodore 64
12 rem bh=16:bl=01: rem $1001 commodore +4
13 rem bh=18:bl=01: rem $1201 commodore vic-20 (35k ram)
14 rem bh=04:bl=01: rem $0401 commodore pet
15 rem bh=28:bl=01: rem $1c01 commodore 128 (bank 0)
35 print chr$(147);chr$(14);"Initializing...":gosub 1400
40 n$="":x=rnd(-ti):rem similar to 'randomize'
45 for i=1 to 4
50 t$=str$(int(rnd(1)*9)+1)
55 n$=n$+mid$(t$,2,1)
60 next i
65 print chr$(147)
70 print spc(16);"24 Game"
71 print:print " The goal of this game is to formulate"
72 print:print " an arithmetic expression that"
73 print:print " evaluates to a value of 24, however"
74 print:print " you may use only the four numbers"
75 print:print " given at random by the computer and"
76 print:print " the standard arithmetic operations of"
77 print:print " add, subtract, multiply, and divide."
78 print:print " Each digit must be used by itself. "
79 print:print " (e.g. if given 1, 2, 3, 4, you cannot"
80 print:print " combine 1 and 2 to make 12.)"
89 gosub 1000
90 i$="":f$="":p$=""
95 print chr$(147);"Allowed characters:"
100 i$=n$+"+-*/()"
110 print
120 for i=1 to len(i$)
130 print mid$(i$,i,1);" ";
140 next i:print
150 print:print "Spaces are ignored."
155 print "Enter 'end' to end.":print
160 input "Enter the formula";f$
170 if f$="end" then print "Program terminated.":end
180 print:print "Checking syntax... ";tab(34);
190 for i=1 to len(f$)
200 if mid$(f$,i,1)=" " then next i
210 c$=mid$(f$,i,1)
220 if c$="+" or c$="-" or c$="*" or c$="/" then p$=p$+"o":goto 250
230 if c$="(" or c$=")" then p$=p$+c$:goto 250
240 p$=p$+"n"
250 next i
260 restore
270 for i=1 to 11
280 read t$
290 if t$=p$ then i=11
300 next i
310 if t$<>p$ then gosub 1100:gosub 1000:goto 90
315 print "OK":print "Checking for illegal numbers... ";tab(34);
320 for i=1 to len(f$)
330 for j=1 to 10
335 ft$=mid$(f$,i,1)
336 il$=left$(i$,j-1):it$=mid$(i$,j,1):ir$=mid$(i$,j+1,len(i$))
340 if ft$=it$ and ft$>"0" and ft$<="9" then i$=il$+" "+ir$
350 next j
360 next i
370 if mid$(i$,1,4)<>" " then gosub 1200:gosub 1000:goto 90
375 print "OK":print "Evaluating expression...":print:print tab(10);f$;" =";
380 gosub 600:rem r=val(f$)
390 print r;" "
400 if r<>24 then gosub 1300:gosub 1000:goto 90
410 print "Correct!"
420 print:print "Would you like to go again (y/n)? ";
425 get k$:if k$<>"y" and k$<>"n" then 425
430 print k$
435 if k$="y" then goto 40
440 print:print "Very well. Have a nice day!"
450 end
500 rem pattern matching
501 data "nononon","(non)onon","nono(non)"
504 data "no(no(non))","((non)on)on","no(non)on"
507 data "(non)o(non)","no((non)on)","(nonon)on"
510 data "(no(non))on","no(nonon)"
600 rem get basic to evaluate our expression
605 a$="r="+f$:gosub 1440
610 for i=1 to len(a$)
615 rem simple token translation
620 b=asc(mid$(a$,i,1))
625 if (b>41 and b<48) or b=61 or b=94 then b=t(b)
630 poke (ad+i-1),b
635 next
640 gosub 2000
645 rem gosub 1440:rem uncomment to clear evaluation line after use
650 return
1000 rem screen pause
1005 pt$=" Press a key to continue. "
1010 print:print spc(20-int(len(pt$)/2));
1015 print chr$(18);pt$;chr$(146);
1020 get k$:if k$=""then 1020
1030 return
1100 rem syntax error
1105 print "ERROR":print
1110 print "Maybe something is out of place..."
1120 return
1200 rem invalid arguments
1205 print "ERROR":print
1210 print "?Invalid Arguments - "
1215 print "You used a number that is not allowed."
1220 return
1300 rem wrong formula
1305 print:print "Wrong answer. Try again."
1310 return
1400 dim t(94):t(43)=170:t(45)=171:t(42)=172:t(47)=173:t(61)=178:t(94)=174
1405 rem locate line 2005 in ram
1410 lh=bh:ll=bl:nh=0:nl=0
1415 ad=lh*256+ll
1420 lh=peek(ad+1):ll=peek(ad)
1425 nl=peek(ad+2):nh=peek(ad+3):n=nh*256+nl
1430 if n<>2005 then goto 1415
1435 ad=ad+4:return
1440 for j=ad to ad+73:poke j,asc(":"):next
1445 return
2000 rem put 74 colons on the next line
2005 ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
2010 return
</syntaxhighlight>
{{out}}
<pre>Initializing...
24 Game
The goal of this game is to formulate
an arithmetic expression that
evaluates to a value of 24, however
you may only use four numbers provided
at random by the computer and the
standard arithmetic operations of add,
subtract, multiply, and divide. Each
digit must be used by itself. (e.g. if
given 1, 2, 3, 4, you cannot combine
1 and 2 to make 12.)
Press a key to continue.
Allowed characters:
6 3 3 5 + - * / ( )
Spaces are ignored.
Enter 'end' to end.
Enter the formula? (6-3)*(3+5)
Checking syntax... OK
Checking for illegal numbers... OK
Evaluating expression...
(6-3)*(3+5) = 24
Correct!
Would you like to go again (y/n)? n
Very well. Have a nice day!
ready.
list 2005
2005 r=(6-3)*(3+5)::::::::::::::::::::::
:::::::::::::::::::::::::::::::::::::::
ready.
█</pre>
=={{header|Common Lisp}}==
<
(define-condition bad-equation (error) ())
Line 412 ⟶ 4,055:
(read))
(lose () (error 'bad-equation))
(choose () (setf chosen-digits (loop repeat 4 collecting (1+ (random
(check (e)
(typecase e
Line 436 ⟶ 4,079:
(if (= 24 (eval (check (prompt)))) (win) (lose))
(error () (format t "Bad equation, try again.~%"))
(choose-digits () (choose)))))))</
'''Verbose Implementation'''
{{works with|clisp|2.47}}
<
(defconstant +ops+ '(* / + -))
Line 545 ⟶ 4,188:
(emit "Sorry, the form you entered did not ~
compute.~%~%")))))
initially (prompt initial-digits)))</
Example Usage:
Line 574 ⟶ 4,217:
NIL</pre>
=={{header|D}}==
<syntaxhighlight lang=d>import std.stdio, std.random, std.math, std.algorithm, std.range,
std.typetuple;
void main() {
void op(char c)() {
if (stack.length < 2)
throw new Exception("Wrong expression.");
stack[$ - 2] = mixin("stack[$ - 2]" ~ c ~ "stack[$ - 1]");
stack.popBack();
}
const problem = iota(4).map!(_ => uniform(1, 10))().array();
writeln("Make 24 with the digits: ", problem);
double[] stack;
int[] digits;
foreach (const char c; readln())
switch (c) {
case ' ', '\t', '\n': break;
case '1': .. case '9':
stack ~= c - '0';
digits ~= c - '0';
break;
foreach (o; TypeTuple!('+', '-', '*', '/')) {
case o: op!o(); break;
}
break;
default: throw new Exception("Wrong char: " ~ c);
}
if (!digits.sort().equal(problem.dup.sort()))
throw new Exception("Not using the given digits.");
if (stack.length != 1)
throw new Exception("Wrong expression.");
writeln("Result: ", stack[0]);
writeln(abs(stack[0] - 24) < 0.001 ? "Good job!" : "Try again.");
}</syntaxhighlight>
Example:
<pre>Make 24 with the digits: [1, 8, 9, 8]
8 1 - 9 + 8 +
Result: 24
Good job!</pre>
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
Program includes full recursive descent, expression evaluator that can handle any expression the user might eneter.
<syntaxhighlight lang="Delphi">
var ErrorFlag: boolean;
var ErrorStr: string;
function EvaluateExpression(Express: string): double;
{ Recursive descent expression evaluator }
var Atom: char;
var ExpressStr: string;
var ExpressInx: integer;
const Tab_Char = #$09; SP_char = #$20;
procedure HandleError(S: string);
begin
ErrorStr:=S;
ErrorFlag:=True;
Abort;
end;
procedure GetChar;
begin
if ExpressInx > Length(ExpressStr) then
begin
Atom:= ')';
end
else begin
Atom:= ExpressStr[ExpressInx];
Inc(ExpressInx);
end;
end;
procedure SkipWhiteSpace;
{ Skip Tabs And Spaces In Expression }
begin
while (Atom=TAB_Char) or (Atom=SP_char) do GetChar;
end;
procedure SkipSpaces;
{ Get Next Character, Ignoring Any Space Characters }
begin
repeat GetChar until Atom <> SP_CHAR;
end;
function GetDecimal: integer;
{ Read In A Decimal String And Return Its Value }
var S: string;
begin
Result:=0;
S:='';
while True do
begin
if not (Atom in ['0'..'9']) then break;
S:=S+Atom;
GetChar;
end;
if S='' then HandleError('Number Expected')
else Result:=StrToInt(S);
if Result>9 then HandleError('Only Numbers 0..9 allowed')
end;
function Expression: double;
{ Returns The Value Of An Expression }
function Factor: double;
{ Returns The Value Of A Factor }
var NEG: boolean;
begin
Result:=0;
while Atom='+' do SkipSpaces; { Ignore Unary "+" }
NEG:= False;
while Atom ='-' do { Unary "-" }
begin
SkipSpaces;
NEG:= not NEG;
end;
if (Atom>='0') and (Atom<='9') then Result:= GetDecimal { Unsigned Integer }
else case Atom of
'(': begin { Subexpression }
SkipSpaces;
Result:= Expression;
if Atom<>')' then HandleError('Mismatched Parenthesis');
SkipSpaces;
end;
else HandleError('Syntax Error');
end;
{ Numbers May Terminate With A Space Or Tab }
SkipWhiteSpace;
if NEG then Result:=-Result;
end; { Factor }
function Term: double;
{ Returns Factor * Factor, Etc. }
var R: double;
begin
Result:= Factor;
while True do
case Atom of
'*': begin
SkipSpaces;
Result:= Result * Factor;
end;
'/': begin
SkipSpaces;
R:=Factor;
if R=0 then HandleError('Divide By Zero');
Result:= Result / R;
end;
else break;
end;
end;
{ Term }
function AlgebraicExpression: double;
{ Returns Term + Term, Etc. }
begin
Result:= Term;
while True do
case Atom of
'+': begin SkipSpaces; Result:= Result + Term; end;
'-': begin SkipSpaces; Result:= Result - Term; end
else break;
end;
end; { Algexp }
begin { Expression }
SkipWhiteSpace;
Result:= AlgebraicExpression;
end; { Expression }
begin { EvaluateExpression }
ErrorFlag:=False;
ErrorStr:='';
ExpressStr:=Express;
ExpressInx:=1;
try
GetChar;
Result:= Expression;
except end;
end;
function WaitForString(Memo: TMemo; Prompt: string): string;
{Wait for key stroke on TMemo component}
var MW: TMemoWaiter;
var C: char;
var Y: integer;
begin
{Use custom object to wait and capture key strokes}
MW:=TMemoWaiter.Create(Memo);
try
Memo.Lines.Add(Prompt);
Memo.SelStart:=Memo.SelStart-1;
Memo.SetFocus;
Result:=MW.WaitForLine;
finally MW.Free; end;
end;
procedure Play24Game(Memo: TMemo);
{Play the 24 game}
var R: double;
var Nums: array [0..4-1] of char;
var I: integer;
var Express,RS: string;
var RB: boolean;
procedure GenerateNumbers;
{Generate and display four random number 1..9}
var S: string;
var I: integer;
begin
{Generate random numbers}
for I:=0 to High(Nums) do
Nums[I]:=char(Random(9)+$31);
{Display them}
S:='';
for I:=0 to High(Nums) do
S:=S+' '+Nums[I];
Memo.Lines.Add('Your Digits: '+S);
end;
function TestMatchingNums: boolean;
{Make sure numbers entered by user match the target numbers}
var SL1,SL2: TStringList;
var I: integer;
begin
Result:=False;
SL1:=TStringList.Create;
SL2:=TStringList.Create;
try
{Load target numbers into string list}
for I:=0 to High(Nums) do SL1.Add(Nums[I]);
{Load users expression number int string list}
for I:=1 to Length(Express) do
if Express[I] in ['0'..'9'] then SL2.Add(Express[I]);
{There should be the same number }
if SL1.Count<>SL2.Count then exit;
{Sort them to facilitate testing}
SL1.Sort; SL2.Sort;
{Are number identical, if not exit}
for I:=0 to SL1.Count-1 do
if SL1[I]<>SL2[I] then exit;
{Users numbers passed all tests}
Result:=True;
finally
SL2.Free;
SL1.Free;
end;
end;
function TestUserExpression(var S: string): boolean;
{Test expression user entered }
begin
Result:=False;
if not TestMatchingNums then
begin
S:='Numbers Do not Match';
exit;
end;
R:=EvaluateExpression(Express);
S:='Expression Value = '+FloatToStrF(R,ffFixed,18,0)+CRLF;
if ErrorFlag then
begin
S:=S+'Expression Problem: '+ErrorStr;
exit;
end;
if R<>24 then
begin
S:=S+'Expression is incorrect value';
exit;
end;
S:=S+'!!!!!! Winner !!!!!!!';
Result:=True;
end;
begin
Randomize;
Memo.Lines.Add('=========== 24 Game ===========');
GenerateNumbers;
while true do
begin
if Application.Terminated then exit;
Express:=WaitForString(Memo,'Enter expression, Q = quit, N = New numbers: '+CRLF);
if Pos('N',UpperCase(Express))>0 then
begin
GenerateNumbers;
Continue;
end;
if Pos('Q',UpperCase(Express))>0 then exit;
RB:=TestUserExpression(RS);
Memo.Lines.Add(RS);
if not RB then continue;
RS:=WaitForString(Memo,'Play again Y=Yes, N=No'+CRLF);
if Pos('N',UpperCase(RS))>0 then exit;
GenerateNumbers;
end;
end;
</syntaxhighlight>
{{out}}
<pre>
=========== 24 Game ===========
Your Digits: 8 2 5 5
Enter expression, Q = quit, N = New numbers:
n
Your Digits: 3 1 9 3
Enter expression, Q = quit, N = New numbers:
3 * 9 -3
Numbers Do not Match
Enter expression, Q = quit, N = New numbers:
3 * 9 - 3 * 1
Expression Value = 24
!!!!!! Winner !!!!!!!
Play again Y=Yes, N=No
</pre>
=={{header|EchoLisp}}==
<syntaxhighlight lang=scheme>
(string-delimiter "")
;; check that nums are in expr, and only once
(define (is-valid? expr sorted: nums)
(when (equal? 'q expr) (error "24-game" "Thx for playing"))
(unless (and
(list? expr)
(equal? nums (list-sort < (filter number? (flatten expr)))))
(writeln "🎃 Please use" nums)
#f))
;; 4 random digits
(define (gen24)
(->> (append (range 1 10)(range 1 10)) shuffle (take 4) (list-sort < )))
(define (is-24? num)
(unless (= 24 num)
(writeln "😧 Sorry - Result = " num)
#f))
(define (check-24 expr)
(if (and
(is-valid? expr nums)
(is-24? (js-eval (string expr)))) ;; use js evaluator
"🍀 🌸 Congrats - (play24) for another one."
(input-expr check-24 (string nums))))
(define nums null)
(define (play24)
(set! nums (gen24))
(writeln "24-game - Can you combine" nums "to get 24 ❓ (q to exit)")
(input-expr check-24 (string-append (string nums) " -> 24 ❓")))
</syntaxhighlight>
{{out}}
<pre>
24-game - Can you combine (2 5 6 7) to get 24 ❓ (q to exit)
difficult game
🎃 Please use (2 5 6 7)
12 * 2
🎃 Please use (2 5 6 7)
6 * (7 - 5 + 2)
🍀 🌸 Congrats - (play24) for another one.
(play24)
24-game - Can you combine (3 5 8 9) to get 24 ❓ (q to exit)
3 + 5 + 8 * 9
😧 Sorry - Result = 80
9 * 3 - (8 - 5)
🍀 🌸 Congrats - (play24) for another one.
(play24)
24-game - Can you combine (1 8 8 9) to get 24 ❓ (q to exit)
9 + 8 + 8 - 1
🍀 🌸 Congrats - (play24) for another one.
</pre>
=={{header|Elena}}==
ELENA 6.0 :
<syntaxhighlight lang=elena>import system'routines;
import system'collections;
import system'dynamic;
import extensions;
// --- Expression ---
class ExpressionTree
{
object _tree;
constructor(s)
{
auto level := new Integer(0);
s.forEach::(ch)
{
var node := new DynamicStruct();
ch =>
$43 { node.Level := level + 1; node.Operation := mssg add } // +
$45 { node.Level := level + 1; node.Operation := mssg subtract } // -
$42 { node.Level := level + 2; node.Operation := mssg multiply } // *
$47 { node.Level := level + 2; node.Operation := mssg divide } // /
$40 { level.append(10); ^ self } // (
$41 { level.reduce(10); ^ self } // )
! {
node.Leaf := ch.toString().toReal();
node.Level := level + 3
};
if (nil == _tree)
{
_tree := node
}
else
{
if (_tree.Level >= node.Level)
{
node.Left := _tree;
node.Right := nil;
_tree := node
}
else
{
var top := _tree;
while ((nil != top.Right)&&(top.Right.Level < node.Level))
{ top := top.Right };
node.Left := top.Right;
node.Right := nil;
top.Right := node
}
}
}
}
eval(node)
{
if (node.containsProperty(mssg Leaf))
{
^ node.Leaf
}
else
{
var left := self.eval(node.Left);
var right := self.eval(node.Right);
var op := node.Operation;
^ op(left, right);
}
}
get Value()
<= eval(_tree);
readLeaves(list, node)
{
if (nil == node)
{ InvalidArgumentException.raise() };
if (node.containsProperty(mssg Leaf))
{
list.append(node.Leaf)
}
else
{
self.readLeaves(list, node.Left);
self.readLeaves(list, node.Right)
}
}
readLeaves(list)
<= readLeaves(list,_tree);
}
// --- Game ---
class TwentyFourGame
{
object theNumbers;
constructor()
{
self.newPuzzle();
}
newPuzzle()
{
theNumbers := new object[]
{
1 + randomGenerator.nextInt(9),
1 + randomGenerator.nextInt(9),
1 + randomGenerator.nextInt(9),
1 + randomGenerator.nextInt(9)
}
}
help()
{
console
.printLine("------------------------------- Instructions ------------------------------")
.printLine("Four digits will be displayed.")
.printLine("Enter an equation using all of those four digits that evaluates to 24")
.printLine("Only * / + - operators and () are allowed")
.printLine("Digits can only be used once, but in any order you need.")
.printLine("Digits cannot be combined - i.e.: 12 + 12 when given 1,2,2,1 is not allowed")
.printLine("Submit a blank line to skip the current puzzle.")
.printLine("Type 'q' to quit")
.writeLine()
.printLine("Example: given 2 3 8 2, answer should resemble 8*3-(2-2)")
.printLine("------------------------------- --------------------------------------------")
}
prompt()
{
theNumbers.forEach::(n){ console.print(n," ") };
console.print(": ")
}
resolve(expr)
{
var tree := new ExpressionTree(expr);
var leaves := new ArrayList();
tree.readLeaves(leaves);
ifnot (leaves.ascendant().sequenceEqual(theNumbers.ascendant()))
{ console.printLine("Invalid input. Enter an equation using all of those four digits. Try again."); ^ self };
var result := tree.Value;
if (result == 24)
{
console.printLine("Good work. ",expr,"=",result);
self.newPuzzle()
}
else
{
console.printLine("Incorrect. ",expr,"=",result)
}
}
}
extension gameOp
{
playRound(expr)
{
if (expr == "q")
{
^ false
}
else
{
if (expr == "")
{
console.printLine("Skipping this puzzle"); self.newPuzzle()
}
else
{
try
{
self.resolve(expr)
}
catch(Exception e)
{
console.printLine(e)
//console.printLine:"An error occurred. Check your input and try again."
}
};
^ true
}
}
}
// --- program ---
public program()
{
var game := new TwentyFourGame().help();
while (game.prompt().playRound(console.readLine())) {}
}</syntaxhighlight>
{{out}}
<pre>
------------------------------- Instructions ------------------------------
Four digits will be displayed.
Enter an equation using all of those four digits that evaluates to 24
Only * / + - operators and () are allowed
Digits can only be used once, but in any order you need.
Digits cannot be combined - i.e.: 12 + 12 when given 1,2,2,1 is not allowed
Submit a blank line to skip the current puzzle.
Type 'q' to quit
Example: given 2 3 8 2, answer should resemble 8*3-(2-2)
------------------------------- --------------------------------------------
7 6 9 6 :
Skipping this puzzle
8 6 2 6 : 6*6-8-2
Incorrect. 6*6-8-2=26.0
8 6 2 6 :
Skipping this puzzle
5 2 7 7 : 7+7+(5*2)
Good work. 7+7+(5*2)=24.0
</pre>
=={{header|Elixir}}==
{{trans|Erlang}}
<syntaxhighlight lang=elixir>defmodule Game24 do
def main do
IO.puts "24 Game"
play
end
defp play do
IO.puts "Generating 4 digits..."
digts = for _ <- 1..4, do: Enum.random(1..9)
IO.puts "Your digits\t#{inspect digts, char_lists: :as_lists}"
read_eval(digts)
play
end
defp read_eval(digits) do
exp = IO.gets("Your expression: ") |> String.strip
if exp in ["","q"], do: exit(:normal) # give up
case {correct_nums(exp, digits), eval(exp)} do
{:ok, x} when x==24 -> IO.puts "You Win!"
{:ok, x} -> IO.puts "You Lose with #{inspect x}!"
{err, _} -> IO.puts "The following numbers are wrong: #{inspect err, char_lists: :as_lists}"
end
end
defp correct_nums(exp, digits) do
nums = String.replace(exp, ~r/\D/, " ") |> String.split |> Enum.map(&String.to_integer &1)
if length(nums)==4 and (nums--digits)==[], do: :ok, else: nums
end
defp eval(exp) do
try do
Code.eval_string(exp) |> elem(0)
rescue
e -> Exception.message(e)
end
end
end
Game24.main</syntaxhighlight>
{{out}}
<pre>
24 Game
Generating 4 digits...
Your digits [9, 6, 7, 4]
Your expression: (9+7)*6/4
You Win!
Generating 4 digits...
Your digits [3, 2, 2, 4]
Your expression: 3*(2+2+4)
You Win!</pre>
=={{header|Erlang}}==
<syntaxhighlight lang=Erlang>-module(g24).
-export([main/0]).
main() ->
random:seed(now()),
io:format("24 Game~n"),
play().
play() ->
io:format("Generating 4 digits...~n"),
Digts = [random:uniform(X) || X <- [9,9,9,9]],
io:format("Your digits\t~w~n", [Digts]),
read_eval(Digts),
play().
read_eval(Digits) ->
Exp = string:strip(io:get_line(standard_io, "Your expression: "), both, $\n),
case {correct_nums(Exp, Digits), eval(Exp)} of
{ok, X} when X == 24 -> io:format("You Win!~n");
{ok, X} -> io:format("You Lose with ~p!~n",[X]);
{List, _} -> io:format("The following numbers are wrong: ~p~n", [List])
end.
correct_nums(Exp, Digits) ->
case re:run(Exp, "([0-9]+)", [global, {capture, all_but_first, list}]) of
nomatch ->
"No number entered";
{match, IntLs} ->
case [X || [X] <- IntLs, not lists:member(list_to_integer(X), Digits)] of
[] -> ok;
L -> L
end
end.
eval(Exp) ->
{X, _} = eval(re:replace(Exp, "\\s", "", [{return, list},global]),
0),
X.
eval([], Val) ->
{Val,[]};
eval([$(|Rest], Val) ->
{NewVal, Exp} = eval(Rest, Val),
eval(Exp, NewVal);
eval([$)|Rest], Val) ->
{Val, Rest};
eval([$[|Rest], Val) ->
{NewVal, Exp} = eval(Rest, Val),
eval(Exp, NewVal);
eval([$]|Rest], Val) ->
{Val, Rest};
eval([$+|Rest], Val) ->
{NewOperand, Exp} = eval(Rest, 0),
eval(Exp, Val + NewOperand);
eval([$-|Rest], Val) ->
{NewOperand, Exp} = eval(Rest, 0),
eval(Exp, Val - NewOperand);
eval([$*|Rest], Val) ->
{NewOperand, Exp} = eval(Rest, 0),
eval(Exp, Val * NewOperand);
eval([$/|Rest], Val) ->
{NewOperand, Exp} = eval(Rest, 0),
eval(Exp, Val / NewOperand);
eval([X|Rest], 0) when X >= $1, X =< $9 ->
eval(Rest, X-$0).
</syntaxhighlight>
The evaluator uses a simple infix scheme that doesn't care about operator precedence, but does support brackets and parentheses alike. Thus, <code>((9+1)*2)+2+2</code> is evaluated as:
<pre>
9 + 1 = 10
10 * 2 = 20
2 + 2 = 4
20 + 4
</pre>
Example:
<pre>1> c(g24).
{ok,g24}
2> g24:main().
24 Game
Generating 4 digits...
Your digits [7,4,6,8]
Your expression: 6*4
You Win!
Generating 4 digits...
Your digits [4,1,5,8]
Your expression: 6*4
The following numbers are wrong: ["6"]
Generating 4 digits...
Your digits [8,5,8,2]
Your expression: 2*([8/5]*2)
You Lose with 6.4!
Generating 4 digits...
Your digits [7,4,8,1]</pre>
=={{header|F_Sharp|F#}}==
<syntaxhighlight lang=fsharp>open System
open System.Text.RegularExpressions
// Some utilities
let (|Parse|_|) regex str =
let m = Regex(regex).Match(str)
if m.Success then Some ([for g in m.Groups -> g.Value]) else None
let rec gcd x y = if x = y || x = 0 then y else if x < y then gcd y x else gcd y (x-y)
let abs (x : int) = Math.Abs x
let sign (x: int) = Math.Sign x
let cint s = Int32.Parse(s)
let replace m (s : string) t = Regex.Replace(t, m, s)
// computing in Rationals
type Rat(x : int, y : int) =
let g = if y <> 0 then gcd (abs x) (abs y) else raise <| DivideByZeroException()
member this.n = sign y * x / g // store a minus sign in the numerator
member this.d =
if y <> 0 then sign y * y / g else raise <| DivideByZeroException()
static member (~-) (x : Rat) = Rat(-x.n, x.d)
static member (+) (x : Rat, y : Rat) = Rat(x.n * y.d + y.n * x.d, x.d * y.d)
static member (-) (x : Rat, y : Rat) = x + Rat(-y.n, y.d)
static member (*) (x : Rat, y : Rat) = Rat(x.n * y.n, x.d * y.d)
static member (/) (x : Rat, y : Rat) = x * Rat(y.d, y.n)
override this.ToString() = sprintf @"<%d,%d>" this.n this.d
new(x : string, y : string) = if y = "" then Rat(cint x, 1) else Rat(cint x, cint y)
// Due to the constraints imposed by the game (reduced set
// of operators, all left associativ) we can get away with a repeated reduction
// to evaluate the algebraic expression.
let rec reduce (str :string) =
let eval (x : Rat) (y : Rat) = function
| "*" -> x * y | "/" -> x / y | "+" -> x + y | "-" -> x - y | _ -> failwith "unknown op"
let subst s r = str.Replace(s, r.ToString())
let rstr =
match str with
| Parse @"\(<(-?\d+),(\d+)>([*/+-])<(-?\d+),(\d+)>\)" [matched; xn; xd; op; yn; yd] ->
subst matched <| eval (Rat(xn,xd)) (Rat(yn,yd)) op
| Parse @"<(-?\d+),(\d+)>([*/])<(-?\d+),(\d+)>" [matched; xn; xd; op; yn; yd] ->
subst matched <| eval (Rat(xn,xd)) (Rat(yn,yd)) op
| Parse @"<(-?\d+),(\d+)>([+-])<(-?\d+),(\d+)>" [matched; xn; xd; op; yn; yd] ->
subst matched <| eval (Rat(xn,xd)) (Rat(yn,yd)) op
| Parse @"\(<(-?\d+),(\d+)>\)" [matched; xn; xd] ->
subst matched <| Rat(xn,xd)
| Parse @"(?<!>)-<(-?\d+),(\d+)>" [matched; xn; xd] ->
subst matched <| -Rat(xn,xd)
| _ -> str
if str = rstr then str else reduce rstr
let gameLoop() =
let checkInput dddd input =
match input with
| "n" | "q" -> Some(input)
| Parse @"[^1-9()*/+-]" [c] ->
printfn "You used an illegal character in your expression: %s" c
None
| Parse @"^\D*(\d)\D+(\d)\D+(\d)\D+(\d)(?:\D*(\d))*\D*$" [m; d1; d2; d3; d4; d5] ->
if d5 = "" && (String.Join(" ", Array.sort [|d1;d2;d3;d4|])) = dddd then Some(input)
elif d5 = "" then
printfn "Use this 4 digits with operators in between: %s." dddd
None
else
printfn "Use only this 4 digits with operators in between: %s." dddd
None
| _ ->
printfn "Use all 4 digits with operators in between: %s." dddd
None
let rec userLoop dddd =
let tryAgain msg =
printfn "%s" msg
userLoop dddd
printf "[Expr|n|q]: "
match Console.ReadLine() |> replace @"\s" "" |> checkInput dddd with
| Some(input) ->
let data = input |> replace @"((?<!\d)-)?\d+" @"<$&,1>"
match data with
| "n" -> true | "q" -> false
| _ ->
try
match reduce data with
| Parse @"^<(-?\d+),(\d+)>$" [_; x; y] ->
let n, d = (cint x), (cint y)
if n = 24 then
printfn "Correct!"
true
elif d=1 then tryAgain <| sprintf "Wrong! Value = %d." n
else tryAgain <| sprintf "Wrong! Value = %d/%d." n d
| _ -> tryAgain "Wrong! not a well-formed expression!"
with
| :? System.DivideByZeroException ->
tryAgain "Wrong! Your expression results in a division by zero!"
| ex ->
tryAgain <| sprintf "There is an unforeseen problem with yout input: %s" ex.Message
| None -> userLoop dddd
let random = new Random(DateTime.Now.Millisecond)
let rec loop() =
let dddd = String.Join(" ", Array.init 4 (fun _ -> 1 + random.Next 9) |> Array.sort)
printfn "\nCompute 24 from the following 4 numbers: %s" dddd
printfn "Use them in any order with * / + - and parentheses; n = new numbers; q = quit"
if userLoop dddd then loop()
loop()
gameLoop()</syntaxhighlight>
{{out}}
<pre>Compute 24 from the following 4 numbers: 3 3 3 5
Use them in any order with * / + - and parentheses; n = new numbers; q = quit
[Expr|n|q]: n
Compute 24 from the following 4 numbers: 3 5 6 7
Use them in any order with * / + - and parentheses; n = new numbers; q = quit
[Expr|n|q]: (7 + 5) + 6/3
Wrong! Value = 14.
[Expr|n|q]: (7 + 5) * 6/3
Correct!
Compute 24 from the following 4 numbers: 3 3 4 5
Use them in any order with * / + - and parentheses; n = new numbers; q = quit
[Expr|n|q]: q
</pre>
=={{header|Factor}}==
<syntaxhighlight lang=factor>USING:
combinators.short-circuit
continuations
eval
formatting
fry
kernel
io
math math.ranges
prettyprint
random
sequences
sets ;
IN: 24game
: choose4 ( -- seq )
4 [ 9 [1,b] random ] replicate ;
: step ( numbers -- ? )
readln
[
parse-string
{
! Is only allowed tokens used?
[ swap { + - / * } append subset? ]
! Digit count in expression should be equal to the given numbers.
[ [ number? ] count swap length = ]
! Of course it must evaluate to 24
[ nip call( -- x ) 24 = ]
} 2&&
[ f "You got it!" ]
[ t "Expression isnt valid, or doesnt evaluate to 24." ]
if
]
[ 3drop f "Could not parse that." ]
recover print flush ;
: main ( -- )
choose4
[ "Your numbers are %[%s, %], make an expression\n" printf flush ]
[ '[ _ step ] loop ]
bi ;
</syntaxhighlight>
Sample:
<syntaxhighlight lang=factor>
IN: scratchpad main
Your numbers are { 4, 1, 8, 2 }, make an expression
8 4 + 2 * 1 /
You got it!
</syntaxhighlight>
=={{header|Falcon}}==
<
function genRandomNumbers( amount )
Line 646 ⟶ 5,269:
end
end
end</
=={{header|Fortran}}==
===Clever implementation===
Indicate operator precedence by parentheses; e.g. (3+(5*6))-9. No whitespace is admissible.
The program uses [[Insertion_sort#Fortran|Insertion_sort in Fortran]].
<syntaxhighlight lang=Fortran>program game_24
implicit none
real :: vector(4), reals(11), result, a, b, c, d
integer :: numbers(4), ascii(11), i
character(len=11) :: expression
character :: syntax(11)
! patterns:
character, parameter :: one(11) = (/ '(','(','1','x','1',')','x','1',')','x','1' /)
character, parameter :: two(11) = (/ '(','1','x','(','1','x','1',')',')','x','1' /)
character, parameter :: three(11) = (/ '1','x','(','(','1','x','1',')','x','1',')' /)
character, parameter :: four(11) = (/ '1','x','(','1','x','(','1','x','1',')',')' /)
character, parameter :: five(11) = (/ '(','1','x','1',')','x','(','1','x','1',')' /)
do
call random_number(vector)
numbers = 9 * vector + 1
write (*,*) 'Digits: ',numbers
write (*,'(a)',advance='no') 'Your expression: '
read (*,'(a11)') expression
forall (i=1:11) syntax(i) = expression(i:i)
ascii = iachar(syntax)
where (syntax >= '0' .and. syntax <= '9')
syntax = '1' ! number
elsewhere (syntax == '+' .or. syntax == '-' .or. syntax == '*' .or. syntax == '/')
syntax = 'x' ! op
elsewhere (syntax /= '(' .and. syntax /= ')')
syntax = '-' ! error
end where
reals = real(ascii-48)
if ( all(syntax == one) ) then
a = reals(3); b = reals(5); c = reals(8); d = reals(11)
call check_numbers(a,b,c,d)
result = op(op(op(a,4,b),7,c),10,d)
else if ( all(syntax == two) ) then
a = reals(2); b = reals(5); c = reals(7); d = reals(11)
call check_numbers(a,b,c,d)
result = op(op(a,3,op(b,6,c)),10,d)
else if ( all(syntax == three) ) then
a = reals(1); b = reals(5); c = reals(7); d = reals(10)
call check_numbers(a,b,c,d)
result = op(a,2,op(op(b,6,c),9,d))
else if ( all(syntax == four) ) then
a = reals(1); b = reals(4); c = reals(7); d = reals(9)
call check_numbers(a,b,c,d)
result = op(a,2,op(b,5,op(c,8,d)))
else if ( all(syntax == five) ) then
a = reals(2); b = reals(4); c = reals(8); d = reals(10)
call check_numbers(a,b,c,d)
result = op(op(a,3,b),6,op(c,9,d))
else
stop 'Input string: incorrect syntax.'
end if
if ( abs(result-24.0) < epsilon(1.0) ) then
write (*,*) 'You won!'
else
write (*,*) 'Your result (',result,') is incorrect!'
end if
write (*,'(a)',advance='no') 'Another one? [y/n] '
read (*,'(a1)') expression
if ( expression(1:1) == 'n' .or. expression(1:1) == 'N' ) then
stop
end if
end do
contains
pure real function op(x,c,y)
integer, intent(in) :: c
real, intent(in) :: x,y
select case ( char(ascii(c)) )
case ('+')
op = x+y
case ('-')
op = x-y
case ('*')
op = x*y
case ('/')
op = x/y
end select
end function op
subroutine check_numbers(a,b,c,d)
real, intent(in) :: a,b,c,d
integer :: test(4)
test = (/ nint(a),nint(b),nint(c),nint(d) /)
call Insertion_Sort(numbers)
call Insertion_Sort(test)
if ( any(test /= numbers) ) then
stop 'You cheat ;-) (Incorrect numbers)'
end if
end subroutine check_numbers
pure subroutine Insertion_Sort(a)
integer, intent(inout) :: a(:)
integer :: temp, i, j
do i=2,size(a)
j = i-1
temp = a(i)
do while ( j>=1 .and. a(j)>temp )
a(j+1) = a(j)
j = j - 1
end do
a(j+1) = temp
end do
end subroutine Insertion_Sort
end program game_24
</syntaxhighlight>
===As a more general recursive descent parser:===
Permits spaces and arbitrary parentheses.
<syntaxhighlight lang=FORTRAN>
! implement a recursive descent parser
module evaluate_algebraic_expression
integer, parameter :: size = 124
character, parameter :: statement_end = achar(0)
character(len=size) :: text_to_parse
integer :: position
data position/0/,text_to_parse/' '/
contains
character function get_token()
! return the current token
implicit none
if (position <= size) then
get_token = text_to_parse(position:position)
do while (get_token <= ' ')
call advance
if (size < position) exit
get_token = text_to_parse(position:position)
end do
end if
if (size < position) get_token = statement_end
end function get_token
subroutine advance ! consume a token. Move to the next token. consume_token would have been a better name.
position = position + 1
end subroutine advance
logical function unfinished()
unfinished = get_token() /= statement_end
end function unfinished
subroutine parse_error()
write(6,*)'"'//get_token()//'" unexpected in expression at',position
stop 1
end subroutine parse_error
function precedence3() result(a)
implicit none
real :: a
character :: token
character(len=10), parameter :: digits = '0123456789'
token = get_token()
if (verify(token,digits) /= 0) call parse_error()
a = index(digits, token) - 1
call advance()
end function precedence3
recursive function precedence2() result(a)
real :: a
character :: token
token = get_token()
if (token /= '(') then
a = precedence3()
else
call advance
a = precedence0()
token = get_token()
if (token /= ')') call parse_error()
call advance
end if
end function precedence2
recursive function precedence1() result(a)
implicit none
real :: a
real, dimension(2) :: argument
character(len=2), parameter :: tokens = '*/'
character :: token
a = 0
token = get_token()
argument(1) = precedence2()
token = get_token()
do while (verify(token,tokens) == 0)
call advance()
argument(2) = precedence2()
if (token == '/') argument(2) = 1 / argument(2)
argument(1) = product(argument)
token = get_token()
end do
a = argument(1)
end function precedence1
recursive function precedence0() result(a)
implicit none
real :: a
real, dimension(2) :: argument
character(len=2), parameter :: tokens = '+-'
character :: token
a = 0
token = get_token()
argument(1) = precedence1()
token = get_token()
do while (verify(token,tokens) == 0)
call advance()
argument(2) = precedence1()
if (token == '-') argument = argument * (/1, -1/)
argument(1) = sum(argument)
token = get_token()
end do
a = argument(1)
end function precedence0
real function statement()
implicit none
if (unfinished()) then
statement = precedence0()
else !empty okay
statement = 0
end if
if (unfinished()) call parse_error()
end function statement
real function evaluate(expression)
implicit none
character(len=*), intent(in) :: expression
text_to_parse = expression
evaluate = statement()
end function evaluate
end module evaluate_algebraic_expression
program g24
use evaluate_algebraic_expression
implicit none
integer, dimension(4) :: digits
character(len=78) :: expression
real :: result
! integer :: i
call random_seed!easily found internet examples exist to seed by /dev/urandom or time
call deal(digits)
! do i=1, 9999 ! produce the data to test digit distribution
! call deal(digits)
! write(6,*) digits
! end do
write(6,'(a13,4i2,a26)')'Using digits',digits,', and the algebraic dyadic'
write(6,*)'operators +-*/() enter an expression computing 24.'
expression = ' '
read(5,'(a78)') expression
if (invalid_digits(expression, digits)) then
write(6,*)'invalid digits'
else
result = evaluate(expression)
if (nint(result) == 24) then
write(6,*) result, ' close enough'
else
write(6,*) result, ' no good'
end if
end if
contains
logical function invalid_digits(e,d) !verify the digits
implicit none
character(len=*), intent(in) :: e
integer, dimension(4), intent(inout) :: d
integer :: i, j, k, count
logical :: unfound
count = 0
invalid_digits = .false. !validity assumed
!write(6,*)'expression:',e(1:len_trim(e))
do i=1, len_trim(e)
if (verify(e(i:i),'0123456789') == 0) then
j = index('0123456789',e(i:i))-1
unfound = .true.
do k=1, 4
if (j == d(k)) then
unfound = .false.
exit
end if
end do
if (unfound) then
invalid_digits = .true.
!return or exit is okay here
else
d(k) = -99
count = count + 1
end if
end if
end do
invalid_digits = invalid_digits .or. (count /= 4)
end function invalid_digits
subroutine deal(digits)
implicit none
integer, dimension(4), intent(out) :: digits
integer :: i
real :: harvest
call random_number(harvest)
do i=1, 4
digits(i) = int(mod(harvest*9**i, 9.0)) + 1
end do
! NB. computed with executable Iverson notation, www.jsoftware.oom
! #B NB. B are the digits from 9999 deals
! 39996
! ({.,#)/.~/:~B # show the distribution of digits
! 0 4380
! 1 4542
! 2 4348
! 3 4395
! 4 4451
! 5 4474
! 6 4467
! 7 4413
! 8 4526
! NB. this also shows that I forgot to add 1. Inserting now...
end subroutine deal
end program g24
</syntaxhighlight>
Compilation and too many examples. Which would you cut?
<pre>
$ gfortran -g -O0 -std=f2008 -Wall f.f08 -o f.exe && echo '8*(9/9+2)' | ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
24.000000 close enough
$
$
$
$ ./f.exe
$ Using digits 9 9 8 2, and the algebraic dyadic
$ operators +-*/() enter an expression computing 24.
$ 8 * ( 9 / 9 + 2 )
$ 24.000000 close enough
$
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
(((2+8+9+9)))
28.000000 no good
$
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
(((8+9-2+9)))
24.000000 close enough
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
8929
"9" unexpected in expression at 2
STOP 1
$
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
12348
invalid digits
$
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
892
invalid digits
$
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
8921
invalid digits
$
$
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
89291
invalid digits
$
$
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
9+x-2+8+9
"x" unexpected in expression at 3
STOP 1
$
$
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
(9-2)+8+(9
"^@" unexpected in expression at 125
STOP 1
$
$
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
(9-2)+8+(9)
24.000000 close enough
$
$
$
$ ./f.exe
Using digits 9 9 8 2, and the algebraic dyadic
operators +-*/() enter an expression computing 24.
(9-2)+8/(9)
7.8888888 no good
$
</pre>
=={{header|FreeBASIC}}==
Solución en '''RPN''':
<syntaxhighlight lang=freebasic>
' The 24 game en FreeBASIC
Const operaciones = "*/+-"
Declare Sub Encabezado
Declare Function escoge4() As String
Declare Function quitaEspacios(cadena As String, subcadena1 As String, subcadena2 As String) As String
Declare Function evaluaEntrada(cadena As String) As Integer
Declare Function evaluador(oper1 As Byte, oper2 As Byte, operacion As String) As Integer
Dim Shared As String serie, entrada, cadena
Dim As Integer resultado
Sub Encabezado
Cls: Color 15
Print "The 24 Game"
Print "============" + Chr(13) + Chr(10)
Print "Dados cuatro dígitos en el rango de 1 a 9, que pueden repetirse, "
Print "usando solo los operadores aritméticos suma (+), resta (-), "
Print "multiplicación (*) y división (/) intentar obtener un resultado de 24." + Chr(13) + Chr(10)
Print "Use la notación polaca inversa (primero los operandos y luego los operadores)."
Print "Por ejemplo: en lugar de 2 + 4, escriba 2 4 +" + Chr(13) + Chr(10)
End Sub
Function escoge4() As String
Dim As Byte i
Dim As String a, b
Print "Los dígitos a utilizar son: ";
For i = 1 To 4
a = Str(Int(Rnd*9)+1)
Print a;" ";
b = b + a
Next i
escoge4 = b
End Function
Function evaluaEntrada(cadena As String) As Integer
Dim As Byte oper1, oper2, n(4), i
Dim As String op
oper1 = 0: oper2 = 0: i = 0
While cadena <> ""
op = Left(cadena, 1)
entrada = Mid(cadena, 2)
If Instr(serie, op) Then
i = i + 1
n(i) = Val(op)
Elseif Instr(operaciones, op) Then
oper2 = n(i)
n(i) = 0
i = i - 1
oper1 = n(i)
n(i) = evaluador(oper1, oper2, op)
Else
Print "Signo no v lido"
End If
Wend
evaluaEntrada = n(i)
End Function
Function evaluador(oper1 As Byte, oper2 As Byte, operacion As String) As Integer
Dim As Integer t
Select Case operacion
Case "+": t = oper1 + oper2
Case "-": t = oper1 - oper2
Case "*": t = oper1 * oper2
Case "/": t = oper1 / oper2
End Select
evaluador = t
End Function
Function quitaEspacios(cadena As String, subcadena1 As String, subcadena2 As String) As String
Dim As Byte len1 = Len(subcadena1), len2 = Len(subcadena2)
Dim As Byte i
i = Instr(cadena, subcadena1)
While i
cadena = Left(cadena, i - 1) & subcadena2 & Mid(cadena, i + len1)
i = Instr(i + len2, cadena, subcadena1)
Wend
quitaEspacios = cadena
End Function
'--- Programa Principal ---
Randomize Timer
Do
Encabezado
serie = escoge4
Print: Line Input "Introduzca su fórmula en notación polaca inversa: ", entrada
entrada = quitaEspacios(entrada, " ", "")
If (Len(entrada) <> 7) Then
Print "Error en la serie introducida."
Else
resultado = evaluaEntrada(entrada)
Print "El resultado es = "; resultado
If resultado = 24 Then
Print "¡Correcto!"
Else
Print "¡Error!"
End If
End If
Print "¿Otra ronda? (Pulsa S para salir, u otra tecla para continuar)"
Loop Until (Ucase(Input(1)) = "S")
End
'--------------------------
</syntaxhighlight>
{{out}}
<pre>
The 24 Game
============
Dados cuatro dígitos en el rango de 1 a 9, que pueden repetirse,
usando solo los operadores aritmÚticos suma (+), resta (-),
multiplicación (*) y división (/) intentar obtener un resultado de 24.
Use la notación polaca inversa (primero los operandos y luego los operadores).
Por ejemplo: en lugar de 2 + 4, escriba 2 4 +
Los dígitos a utilizar son: 4 9 7 5
Introduzca su fórmula en notación polaca inversa: 49*57+-
El resultado es = 24
Correcto!
¿Otra ronda? (Pulsa S para salir, u otra tecla para continuar)
</pre>
=={{header|Frink}}==
<syntaxhighlight lang="frink">ops = ["+", "-", "*", "/"]
chosen = new array[[4], {|x| random[1,9]}]
println[chosen]
for d = chosen.lexicographicPermute[]
multifor o = [ops, ops, ops]
{
str = "((" + d@0 + o@0 + d@1 + ")" + o@1 + d@2 + ")" + o@2 + d@3
if eval[str] == 24
println[str]
str = "(" + d@0 + o@0 + d@1 + ")" + o@1 + "(" + d@2 + + o@2 + d@3 + ")"
if eval[str] == 24
println[str]
}</syntaxhighlight>
{{out}}
<pre>
[9, 8, 7, 4]
(4+8)*(9-7)
((7+8)-9)*4
((7-9)+8)*4
(8+4)*(9-7)
((8+7)-9)*4
((8-9)+7)*4
(8*9)/(7-4)
(9-7)*(4+8)
(9-7)*(8+4)
(9*8)/(7-4)
</pre>
=={{header|FutureBasic}}==
24 Game
May 17, 2024
Rich Love
Thanks to Ken and Bernie
7/7/24 Corrected examples
<syntaxhighlight lang="futurebasic">
include resources "24 Game Icon.icns"
#build CompilerOptions @"-Wno-unused-variable"
_mEdit = 2
editmenu _mEdit
begin globals
long gPosition
end globals
void local fn EraseErrorText
CGRect r
r = fn CGRectMake(10, 200, 400, 15)
rect fill r,fn ColorBlack
end fn
local fn ArcRandom( a as long, b as long ) as long
long i
cln i = (arc4random()%(b-a+1))+a;
end fn = fn floor(i)
local fn GetRandomNumbers as CFStringRef
// 96 number groups
CFArrayRef combos = @[¬
// The first 32 are easy
@"1 2 3 4", @"2 4 6 8", @"1 2 4 8", @"1 3 4 6", @"1 2 6 8",
@"2 3 4 8", @"1 3 6 9", @"1 2 7 8", @"2 3 6 8", @"1 4 6 8",
@"2 2 3 9", @"3 4 6 6", @"2 3 3 8", @"1 5 6 6", @"2 4 4 6",
@"1 3 8 8", @"2 2 6 9", @"3 3 6 9", @"1 2 5 9", @"2 4 5 5",
@"1 3 5 9", @"2 2 4 9", @"1 2 3 6", @"1 2 2 9", @"1 2 3 9",
@"1 2 4 6", @"1 2 4 4", @"1 2 2 6", @"1 3 3 6", @"1 1 4 6",
@"1 1 2 8", @"1 1 3 8",
// The middle 32 are medium
@"1 5 5 9", @"4 4 6 9", @"2 3 7 9",@"3 5 8 8", @"1 6 6 8",
@"3 3 5 6", @"1 4 5 8", @"3 3 6 7",@"2 5 5 8", @"4 4 7 9",
@"1 5 6 9", @"3 3 8 9", @"2 6 6 7",@"4 5 7 8", @"2 2 5 9",
@"2 4 6 7", @"1 5 6 8", @"3 4 7 7",@"2 5 6 6", @"3 4 5 9",
@"1 6 7 9", @"2 3 7 8", @"1 4 6 9",@"2 3 5 9", @"3 4 4 8",
@"2 5 8 9", @"1 4 8 9", @"3 3 4 9",@"2 6 7 9", @"1 3 5 7",
@"1 3 6 6", @"2 2 5 7",
// The last 32 are hard
@"1 5 7 9",@"3 4 7 9", @"2 5 7 8", @"3 4 8 9", @"3 4 5 8",
@"2 6 6 9",@"4 4 5 7", @"2 4 6 9", @"1 4 7 7", @"2 3 8 9",
@"2 3 4 7",@"3 3 4 8", @"1 3 7 9", @"2 4 5 9", @"1 3 6 8",
@"2 4 4 9",@"1 5 8 9", @"3 3 5 9", @"2 6 8 9", @"1 4 4 7",
@"2 3 6 7",@"1 3 5 8", @"2 4 7 8", @"1 3 4 7", @"2 3 5 6",
@"1 4 5 6",@"3 3 5 7", @"2 2 3 6", @"3 3 7 7", @"3 3 7 9",
@"4 4 8 9",@"2 4 8 9"]
long i = fn ArcRandom( 0, len(combos) - 1 )
gPosition = i
end fn = combos[i]
local fn EvaluateMath( equation as CFStringRef ) as CFStringRef
equation = fn StringByReplacingOccurrencesOfString( lcase(equation), @"x", @"*" )
CFStringRef result = NULL
RegularExpressionRef regex = fn RegularExpressionWithPattern( @"[0-9.]+", NSRegularExpressionCaseInsensitive, NULL )
CFArrayRef matches = fn RegularExpressionMatches( regex, equation, 0, fn CFRangeMake( 0, len(equation) ) )
NSInteger intConversions = 0
TextCheckingResultRef match
CFRange originalRange
CFRange adjustedRange
CFStringRef value
for match in matches
originalRange = fn TextCheckingResultRange( match )
adjustedRange = fn CFRangeMake( ( originalRange.location + ( intConversions * len( @".0") ) ), originalRange.length )
value = fn StringSubstringWithRange( equation, adjustedRange )
if fn StringContainsString( value, @"." )
continue
else
equation = fn StringByReplacingCharactersInRange( equation, adjustedRange, fn StringWithFormat( @"%@.0", value ) )
intConversions++
end if
next
ExceptionRef e
try
ExpressionRef expression = fn ExpressionWithFormat( equation )
CFNumberRef number = fn ExpressionValueWithObject( expression, NULL, NULL )
result = fn StringWithFormat( @"%.3f", dblval( number ) )
end try
catch (e)
result = fn StringWithFormat( @"%@", e ) : exit fn
end catch
// Test if result is an integer and, if so, return result as an integer
if( fn StringDoubleValue( result ) == fn floorf( fn StringDoubleValue( result ) ) )
result = fn ArrayFirstObject( fn StringComponentsSeparatedByString( result, @"." ) )
end if
end fn = result
local fn QuitOrPlayAlert(GameResult as CFStringRef)
alert -2,,GameResult,@"You won!",@"Quit;Play Again"
AlertButtonSetKeyEquivalent( 2, 2, @"\e" )
short result
result = alert 2
if ( result != NSAlertSecondButtonReturn ) then appterminate
end fn
local fn BuildWindow
CGRect r = fn CGRectMake( 0, 0, 580, 250)
window 1, @"24 Game", r
windowcenter(1)
WindowSetBackgroundColor(1,fn ColorBlack)
end fn
///////// Start //////////
fn BuildWindow
short d(4), i
CFStringRef CheckForDuplicates(97)
for i = 1 to 96
CheckForDuplicates(i) = @""
next i
short DuplicatesCounter
DuplicatesCounter = 0
"Main"
cls
text ,,fn colorWhite
print
print %(10,15),"Given four numbers and using just the +, -, *, and / operators; and the"
print %(10,30),"possible use of parenthesis (), enter an expression that equates to 24."
print %(10,45),"You must use all your numbers and only those numbers."
print %(10,60),"Examples: 9618 Solution 9 + 6 + 1 + 8 or 3173 Solution (3 * 7) - (1 - 4)"
print
print %(10,85),"Enter Q to quit or S to skip to the next number."
"GetFourNumbers"
CFArrayRef randomNumbers : randomNumbers= fn StringComponentsSeparatedByString( fn GetRandomNumbers, @" " )
CFStringRef RandomNumberblock : RandomNumberblock = @""
CFStringRef RandomNumberblockAdd : RandomNumberblockAdd = @""
for i = 0 to 3
// create a string from the 4 numbers
RandomNumberblockAdd = randomNumbers[i]
RandomNumberblock = fn StringByAppendingString(RandomNumberblock,RandomNumberblockAdd)
RandomNumberblock = fn StringByAppendingString(RandomNumberblock,@" ")
next i
if DuplicatesCounter = > 96
// reset counter when last number is retrieved and start from the first number block
DuplicatesCounter = 0
for i = 1 to 96
CheckForDuplicates(i) = @""
next i
end if
for i = 1 to 96
// check the current numbers with the numbers already used
if fn StringIsEqual(RandomNumberblock,CheckForDuplicates(i))
RandomNumberblock = fn StringWithString(CheckForDuplicates(DuplicatesCounter))
goto "GetFourNumbers"
end if
next i
DuplicatesCounter ++
CheckForDuplicates(DuplicatesCounter) = fn StringWithString(RandomNumberblock)
d(1) = fn StringIntegerValue( randomNumbers[0] )
d(2) = fn StringIntegerValue( randomNumbers[1] )
d(3) = fn StringIntegerValue( randomNumbers[2] )
d(4) = fn StringIntegerValue( randomNumbers[3] )
short dots = 0
//d(1) = 9:d(2) = 6:d(3) = 1:d(4) = 8 // Uncomment to test with 9618 numbers. Solution 9 + 6 + 1 + 8
//d(1) = 6:d(2) = 5:d(3) = 3:d(4) = 8 // Uncomment to test with 6538 numbers. Solution 6 / ( 5 - 3 ) * 8
//d(1) = 3:d(2) = 1:d(3) = 7:d(4) = 3 // Uncomment to test with 3773 numbers. Solution ((3 * 1) * 7) + 3
//d(1) = 4:d(2) = 2:d(3) = 7:d(4) = 1 // Uncomment to test with 4271 numbers. Solution (4 * ( 7 - 2 + 1 )
// NOTE: When using these test numbers, also uncomment dots = 0 below here to prevent misleading dot displays
if gPosition <= 32 then dots = 1
if gPosition > 32 and gPosition < 65 then dots = 2
if gPosition > 64 then dots = 3
//dots = 0 uncomment when testing the numbers above to prevent misleading dot displays
print
text ,,fn colorGreen
print %(15,110),"These are your numbers, difficulty level ";
// @"\U000026AA" is white unicode dot - Easy difficulty (One-Dot)
// @"\U0001F534" is red unicode dot - Medium difficulty (Two-Dots)
// @"\U0001F7E1" is yellow unicode dot - Hard difficulty (Three-Dots)
if dots = 1 then print @"\U000026AA Easy"
if dots = 2 then print @"\U0001F534 \U0001F534 Medium"
if dots = 3 then print @"\U0001F7E1 \U0001F7E1 \U0001F7E1 Hard"
print %(55,125)
text ,18,fn colorGreen
for i = 1 to 4
print d(i); " ";
next
print
text ,12,fn colorWhite
printf @"\n\n\n"
CFStringRef expr
bool TryAgain : TryAgain = _false
CFStringRef MessageText
CFStringRef UserInput = NULL
"InputExpression"
if TryAgain
MessageText = fn StringWithFormat( @"Enter math expression: [ '%@' was incorrect ]", expr )
UserInput = input %(10, 190), MessageText, @"123456789+-*/()qs", YES,, 0
else
UserInput = input %(10, 190), @"Enter math expression:", @"123456789+-*/()qs", YES,, 0
end if
if ( UserInput == NULL ) then "InputExpression"
expr = UserInput
if expr = @"" then "InputExpression"
if fn StringIsEqual(ucase(expr) , @"Q") then appterminate
if fn StringIsEqual(ucase(expr) , @"S") then "Main"
//check expr for validity
short j
bool GotAllNumbers : GotAllNumbers = _false
short ThisNumberPosition : ThisNumberPosition = 0
short GotaNumber : GotaNumber = 0
short TotalNumbers : TotalNumbers = 0
short ExtraNumbers:ExtraNumbers = 0
for i = 1 to len$(fn stringpascalstring(expr))
if asc(mid$(fn stringpascalstring(expr),i,1)) > 48 && asc(mid$(fn stringpascalstring(expr),i,1)) < 58
ExtraNumbers ++
end if
next i
if ExtraNumbers > 4
fn EraseErrorText
text ,,fn colorRed
TryAgain = _true
print %(10,200);"Error! Extra numbers not allowed": goto "InputExpression"
text ,,fn colorWhite
end if
for i = 1 to 4
GotaNumber = 0
for j = 0 to len(expr) -1
ThisNumberPosition = instr( j, expr, right(str( d(i)),1 ))
ThisNumberPosition ++
if ThisNumberPosition then GotaNumber = _true
next j
if GotaNumber then TotalNumbers ++
next i
if TotalNumbers => 4 then GotAllNumbers = _true
if GotAllNumbers = _false
fn EraseErrorText
text ,,fn colorRed
TryAgain = _true
print %(10,200);"ERROR! Must use all your numbers and only those numbers." : goto "InputExpression"
text ,,fn colorWhite
end if
fn EraseErrorText
if fn EvaluateMath( expr ) = _false
text ,,fn colorRed
TryAgain = _true
Print %(10,200);"Error! Incorrect math sequence."
goto "InputExpression"
text ,,fn colorWhite
end if
CFStringRef GameResult
if fn StringIntegerValue( fn EvaluateMath( expr ) ) == 24 then GameResult = @"Correct" else GameResult = @"Incorrect"
if GameResult = @"Incorrect"
TryAgain = _true
goto "InputExpression"
end if
fn QuitOrPlayAlert(GameResult)
goto "Main"
handleevents
</syntaxhighlight>
=={{header|GAP}}==
Solution in '''RPN''':
<syntaxhighlight lang=gap>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></syntaxhighlight>
=={{header|Go}}==
RPN solution.
<
import (
"fmt"
"math"
"math/rand"
"time"
)
func main() {
rand.Seed(time.
n := make([]
for i := range n {
n[i] = rune(rand.Intn(9) + '1')
}
fmt.
fmt.Print("Enter RPN: ")
var expr string
fmt.Scan(&expr)
if len(expr) != 7 {
fmt.Println("invalid.
" (4 numbers, 3 operators, no spaces)")
return
}
stack := make([]float64, 0, 4)
for
fmt.Println("too many numbers.")
return
}
i++
if i == len(n) {
fmt.Println("wrong numbers.")
return
}
}
n = append(n[:i], n[i+1:]...)
stack = append(stack, float64(r-'0'))
continue
}
Line 690 ⟶ 6,333:
return
}
switch
case '+':
stack[len(stack)-2] += stack[len(stack)-1]
Line 700 ⟶ 6,343:
stack[len(stack)-2] /= stack[len(stack)-1]
default:
fmt.Printf("%c invalid.\n",
return
}
stack = stack[:len(stack)-1]
}
if math.Abs(stack[0]-24) > 1e-6 {
fmt.Println("incorrect.", stack[0], "!= 24")
} else {
fmt.Println("correct.")
}
}</
Example game:
<pre>
Your numbers: [5 8 1 3]
Enter RPN: 83-5*1-
correct.
</pre>
=={{header|Gosu}}==
<syntaxhighlight lang=Gosu>
uses java.lang.Double
uses java.lang.Integer
uses java.util.ArrayList
uses java.util.List
uses java.util.Scanner
uses java.util.Stack
function doEval( scanner : Scanner, allowed : List<Integer> ) : double {
var stk = new Stack<Double>()
while( scanner.hasNext() ) {
if( scanner.hasNextInt() ) {
var n = scanner.nextInt()
// Make sure they're allowed to use n
if( n <= 0 || n >= 10 ) {
print( n + " isn't allowed" )
return 0
}
var idx = allowed.indexOf( n )
if( idx == -1 ) {
print( "You aren't allowed to use so many " + n + "s!" )
return 0
}
// Add the input number to the stack
stk.push( new Double( n ) )
// Mark n as used
allowed.remove( idx )
} else {
// It has to be an operator...
if( stk.size() < 2 ) {
print( "Invalid Expression: Stack underflow!" )
return 0
}
// Gets the next operator as a single character token
var s = scanner.next("[\\+-/\\*]")
// Get the operands
var r = stk.pop().doubleValue()
var l = stk.pop().doubleValue()
// Determine which operator and invoke it
if( s.equals( "+" ) ) {
stk.push( new Double( l + r ) )
} else if( s.equals( "-" ) ) {
stk.push( new Double( l - r ) )
} else if( s.equals( "*" ) ) {
stk.push( new Double( l * r ) )
} else if( s.equals( "/" ) ) {
if( r == 0.0 ) {
print( "Invalid Expression: Division by zero!" )
return 0
}
stk.push( new Double( l / r ) )
} else {
print( "Internal Error: looking for operator yielded '" + s + "'" )
return 0
}
}
}
// Did they skip any numbers?
if( allowed.size() != 0 ) {
print( "You didn't use ${allowed}" )
return 0
}
// Did they use enough operators?
if( stk.size() != 1 ) {
print( "Invalid Expression: Not enough operators!" )
return 0
}
return stk.pop().doubleValue()
}
// Pick 4 random numbers from [1..9]
var nums = new ArrayList<Integer>()
var gen = new java.util.Random( new java.util.Date().getTime() )
for( i in 0..3 ) {
nums.add( gen.nextInt(9) + 1 )
}
// Prompt the user
print( "Using addition, subtraction, multiplication and division, write an" )
print( "expression that evaluates to 24 using" )
print( "${nums.get(0)}, ${nums.get(1)}, ${nums.get(2)} and ${nums.get(3)}" )
print( "" )
print( "Please enter your expression in RPN" )
// Build a tokenizer over a line of input
var sc = new Scanner( new java.io.BufferedReader( new java.io.InputStreamReader( java.lang.System.in ) ).readLine() )
// eval the expression
var val = doEval( sc, nums )
// winner?
if( java.lang.Math.abs( val - 24.0 ) < 0.001 ) {
print( "You win!" )
} else {
print( "You lose!" )
}
</syntaxhighlight>
=={{header|Groovy}}==
{{trans|Ruby}}
This solution breaks strict adherence to the rules in only one way: any line that starts with the letter "q" causes the game to quit.
<syntaxhighlight lang=groovy>final random = new Random()
final input = new Scanner(System.in)
def evaluate = { expr ->
if (expr == 'QUIT') {
return 'QUIT'
} else {
try { Eval.me(expr.replaceAll(/(\d)/, '$1.0')) }
catch (e) { 'syntax error' }
}
}
def readGuess = { digits ->
while (true) {
print "Enter your guess using ${digits} (q to quit): "
def expr = input.nextLine()
switch (expr) {
case ~/^[qQ].*/:
return 'QUIT'
case ~/.*[^\d\s\+\*\/\(\)-].*/:
def badChars = expr.replaceAll(~/[\d\s\+\*\/\(\)-]/, '')
println "invalid characters in input: ${(badChars as List) as Set}"
break
case { (it.replaceAll(~/\D/, '') as List).sort() != ([]+digits).sort() }:
println '''you didn't use the right digits'''
break
case ~/.*\d\d.*/:
println 'no multi-digit numbers allowed'
break
default:
return expr
}
}
}
def digits = (1..4).collect { (random.nextInt(9) + 1) as String }
while (true) {
def guess = readGuess(digits)
def result = evaluate(guess)
switch (result) {
case 'QUIT':
println 'Awwww. Maybe next time?'
return
case 24:
println 'Yes! You got it.'
return
case 'syntax error':
println "A ${result} was found in ${guess}"
break
default:
println "Nope: ${guess} == ${result}, not 24"
println 'One more try, then?'
}
}</syntaxhighlight>
Sample Run:
<pre>$ groovy TwentyFour.gsh
Enter your guess using [4, 8, 3, 6] (q to quit): 4836
no multi-digit numbers allowed
Enter your guess using [4, 8, 3, 6] (q to quit): 4 ++ ++ 8/ 3-6
A syntax error was found in 4 ++ ++ 8/ 3-6
Enter your guess using [4, 8, 3, 6] (q to quit): btsjsb
invalid characters in input: [t, s, b, j]
Enter your guess using [4, 8, 3, 6] (q to quit): 1+3+2+2
you didn't use the right digits
Enter your guess using [4, 8, 3, 6] (q to quit): q
Awwww. Maybe next time?
$ groovy TwentyFour.gsh
Enter your guess using [6, 3, 2, 6] (q to quit): 6+6+3+2
Nope: 6+6+3+2 == 17.0, not 24
One more try, then?
Enter your guess using [6, 3, 2, 6] (q to quit): (6*3 - 6) * 2
Yes! You got it.</pre>
=={{header|Haskell}}==
<
import
import Data.
import
import System.Random (randomRs, getStdGen)
import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))
main = do
putStrLn
[ "THE 24 GAME\n"
, "Use the +, -,
, "To show how to make an answer of 24.\n"
]
digits <- fmap (sort . take 4 . randomRs (1, 9)) getStdGen :: IO [Int]
putStrLn ("Your digits: " ++ unwords (fmap show digits))
where
putStr "Your expression: " >> fmap (processGuess digits . words) getLine >>=
either (\m -> putStrLn m >> guessLoop digits) putStrLn
processGuess _
processGuess digits xs
|
where
matches = digits == (sort . fmap read $ filter (all isDigit) xs)
processGuess digits xs = calc xs >>= check
where
check x = Left (show (fromRational (x :: Rational)) ++ " is wrong")
-- A Reverse Polish Notation calculator with full error handling
calc xs =
foldM
\ns ->
(case ns of
[n] -> Right n
_ -> Left "Too few operators")
simplify (a:b:ns) s
simplify _ s
simplify ns s
| all isDigit s = Right (fromIntegral (read s) : ns)
simplify _ s = Left ("Unrecognized symbol: " ++ s)
isOp v = elem v $
ops = [("+", (+)), ("-", (-)), ("*", (*)), ("/", (/))]</
=={{header|HicEst}}==
<
CHARACTER expression*100, prompt*100, answers='Wrong,Correct,', protocol='24 game.txt'
Line 801 ⟶ 6,651:
DLG(TItle=prompt, Button='>2:Try again', B='>1:New game', B='Quit')
END</
<
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;</
=={{header|Huginn}}==
<syntaxhighlight lang=huginn>#! /bin/sh
exec huginn --no-argv -E "${0}"
#! huginn
import Algorithms as algo;
import Mathematics as math;
import RegularExpressions as re;
make_game( rndGen_ ) {
board = "";
for ( i : algo.range( 4 ) ) {
board += ( " " + string( character( rndGen_.next() + integer( '1' ) ) ) );
}
return ( board.strip() );
}
main() {
rndGen = math.randomizer( 9 );
no = 0;
dd = re.compile( "\\d\\d" );
while ( true ) {
no += 1;
board = make_game( rndGen );
print( "Your four digits: {}\nExpression {}: ".format( board, no ) );
line = input();
if ( line == none ) {
print( "\n" );
break;
}
line = line.strip();
try {
if ( line == "q" ) {
break;
}
if ( ( pos = line.find_other_than( "{}+-*/() ".format( board ) ) ) >= 0 ) {
print( "Invalid input found at: {}, `{}`\n".format( pos, line ) );
continue;
}
if ( dd.match( line ).matched() ) {
print( "Digit concatenation is forbidden.\n" );
continue;
}
res = real( line );
if ( res == 24.0 ) {
print( "Thats right!\n" );
} else {
print( "Bad answer!\n" );
}
} catch ( Exception e ) {
print( "Not an expression: {}\n".format( e.what() ) );
}
}
return ( 0 );
}</syntaxhighlight>
=={{header|Icon}} and {{header|Unicon}}==
This plays the game of 24 using a simplified version of the code from the [[Arithmetic_evaluation#Icon_and_Unicon|Arithmetic evaluation]] task.
<
link strings # for csort, deletec
Line 868 ⟶ 6,774:
"Combining (concatenating) digits is not allowed.\n",
"Enter 'help', 'quit', or an expression.\n")
end</
{{libheader|Icon Programming Library}}
[http://www.cs.arizona.edu/icon/library/src/procs/strings.icn strings.icn provides deletec and sortc]
{{out}}
<pre>Welcome to 24
The object of the game is to combine the 4 given digits using only + - * / and ( ).
Line 895 ⟶ 6,802:
=={{header|J}}==
<
deal=: 1 + ? bind 9 9 9 9
rules=: smoutput bind 'see http://en.wikipedia.org/wiki/24_Game'
Line 905 ⟶ 6,812:
respond=: (;:'no yes') {::~ wellformed * is24
game24=: (respond input)@deal@rules</
Example use:
Line 917 ⟶ 6,824:
enter 24 expression using 3 3 3 3: '''3+3+3+3+3+3+3+3'''
no
=={{header|Java}}==
{{works with|Java|7}}
<syntaxhighlight lang=java>import java.util.*;
public class Game24 {
static Random r = new Random();
public static void main(String[] args) {
int[] digits = randomDigits();
Scanner in = new Scanner(System.in);
System.out.print("Make 24 using these digits: ");
System.out.println(Arrays.toString(digits));
System.out.print("> ");
Stack<Float> s = new Stack<>();
long total = 0;
for (char c : in.nextLine().toCharArray()) {
if ('0' <= c && c <= '9') {
int d = c - '0';
total += (1 << (d * 5));
s.push((float) d);
} else if ("+/-*".indexOf(c) != -1) {
s.push(applyOperator(s.pop(), s.pop(), c));
}
}
if (tallyDigits(digits) != total)
System.out.print("Not the same digits. ");
else if (Math.abs(24 - s.peek()) < 0.001F)
System.out.println("Correct!");
else
System.out.print("Not correct.");
}
static float applyOperator(float a, float b, char c) {
switch (c) {
case '+':
return a + b;
case '-':
return b - a;
case '*':
return a * b;
case '/':
return b / a;
default:
return Float.NaN;
}
}
static long tallyDigits(int[] a) {
long total = 0;
for (int i = 0; i < 4; i++)
total += (1 << (a[i] * 5));
return total;
}
static int[] randomDigits() {
int[] result = new int[4];
for (int i = 0; i < 4; i++)
result[i] = r.nextInt(9) + 1;
return result;
}
}</syntaxhighlight>
{{out}}
<pre>Make 24 using these digits: [1, 2, 4, 8]
> 12*48+*
Correct!</pre>
=={{header|JavaScript}}==
<syntaxhighlight lang=javascript>
function twentyfour(numbers, input) {
var invalidChars = /[^\d\+\*\/\s-\(\)]/;
var validNums = function(str) {
// Create a duplicate of our input numbers, so that
// both lists will be sorted.
var mnums = numbers.slice();
mnums.sort();
// Sort after mapping to numbers, to make comparisons valid.
return str.replace(/[^\d\s]/g, " ")
.trim()
.split(/\s+/)
.map(function(n) { return parseInt(n, 10); })
.sort()
.every(function(v, i) { return v === mnums[i]; });
};
var validEval = function(input) {
try {
return eval(input);
} catch (e) {
return {error: e.toString()};
}
};
if (input.trim() === "") return "You must enter a value.";
if (input.match(invalidChars)) return "Invalid chars used, try again. Use only:\n + - * / ( )";
if (!validNums(input)) return "Wrong numbers used, try again.";
var calc = validEval(input);
if (typeof calc !== 'number') return "That is not a valid input; please try again.";
if (calc !== 24) return "Wrong answer: " + String(calc) + "; please try again.";
return input + " == 24. Congratulations!";
};
// I/O below.
while (true) {
var numbers = [1, 2, 3, 4].map(function() {
return Math.floor(Math.random() * 8 + 1);
});
var input = prompt(
"Your numbers are:\n" + numbers.join(" ") +
"\nEnter expression. (use only + - * / and parens).\n", +"'x' to exit.", "");
if (input === 'x') {
break;
}
alert(twentyfour(numbers, input));
}
</syntaxhighlight>
=={{header|jq}}==
'''Works with jq, the C implementation of jq'''
'''Works with gojq, the Go implementation of jq'''
Note that the RPN evaluator used here allows expressions such as "1 2 3 + +".
Note also that in RPN expressions:
* If a and b are numeric, then "a b -" is evaluated to the arithmetic expression `a - b`.
* If a and b are numeric, then "a b /" is evaluated as a/b, which need not be an integer.
For the "24 Game":
* Spaces may be omitted in RPN input.
* When comparing a result to 24, `round` is used.
The [[:Category:Jq/MRG32k3a.jq | MRG32k3a]] module is used for generating pseudo-random numbers.
<syntaxhighlight lang="jq">
### The MRG32k3a combined recursive PRNG - see above
import "MRG32k3a" as MRG {search: "."};
### Generic utilities
def sum(stream): reduce stream as $x (0; .+$x);
# like while/2 but emit the final term rather than the first one
def whilst(cond; update):
def _whilst:
if cond then update | (., _whilst) else empty end;
_whilst;
### Reverse Polish Notation
# An array of the allowed operators
def operators: "+-*/" | split("");
# If $a and $b are numbers and $c an operator, then "$a $b $c" is evaluated as an RPN expression.
# Output: {emit, result} with .emit == null if there is a valid result.
def applyOperator($a; $b; $c):
if ([$a,$b] | map(type) | unique) == ["number"]
then
if $c == "+" then {result: ($a + $b)}
elif $c == "-" then {result: ($a - $b)}
elif $c == "*" then {result: ($a * $b)}
elif ($c == "/") then {result: ($b / $a)}
else {emit: "unrecognized operator: \($c)"}
end
else {emit: "invalid number"}
end;
# Input: an array representing an RPN expression.
# Output: {emit, result} as per applyOperator/3
# Example: [1,2,3,"+","+"] | evaluate #=> 6
def evaluate:
if length == 1
then if .[0]|type == "number" then {result: .[0]}
else {emit: "invalid RPN expression"}
end
elif length < 3 then {emit: "invalid RPN expression: \(. | join(" "))"}
else . as $in
| (first( range(0; length) as $i | select(any( operators[]; . == $in[$i]) ) | $i) // null) as $ix
| if $ix == null then {emit: "invalid RPN expression"}
else applyOperator(.[$ix-2]; .[$ix-1]; .[$ix]) as $result
| if $result.result then .[:$ix-2] + [$result.result] + .[$ix+1:] | evaluate
else $result
end
end
end;
### The "24 Game"
# . is the putative RPN string to be checked.
# $four is the string of the four expected digits, in order.
# Output: {emit, result} with .emit set to "Correct!" if .result == 24
def check($four):
if (gsub("[^1-9]";"") | explode | sort | implode) != $four
then {emit: "You must use each of the four digits \($four | split("") | join(" ")) exactly once:"}
else . as $in
| {s: [], emit: null}
| [$in | split("")[] | select(. != " ")
| . as $in | explode[0] | if . >= 48 and . <= 57 then . - 48 else $in end]
| evaluate
| if .result
then if .result|round == 24 then .emit = "Correct!"
else .emit = "Value \(.result) is not 24."
end
else .emit += "\nTry again, or enter . to start again, or q to quit."
end
end ;
def run:
# Populate .digits with four non-negative digits selected at random, with replacement:
{digits: (9 | MRG::prn(4) | map(. + 1))}
| (.digits | sort | join("")) as $four
| "At the prompt, enter an RPN string (e.g. 64*1+1-), or . for a new set of four digits, or q to quit.",
"Make 24 using these digits, once each, in any order: \(.digits):",
( whilst( .stop | not;
.emit = null
| . as $state
| try input catch halt
| if IN( "q", "quit") then halt
elif . == "." then $state | .stop = true
else check($four)
| if .result then .stop = true end
end )
| select(.emit).emit ),
# rerun
run;
run
</syntaxhighlight>
{{output}}
The following is an illustrative transcript.
<pre>
$ jq -nRr -f 24-game.jq
At the prompt, enter an RPN string (e.g. 64*1+1-), or . for a new set of four digits, or q to quit.
Make 24 using these digits, once each, in any order: [7,7,6,8]:
7768+++
Value 28 is not 24.
At the prompt, enter an RPN string (e.g. 64*1+1-), or . for a new set of four digits, or q to quit.
Make 24 using these digits, once each, in any order: [7,8,6,8]:
.
At the prompt, enter an RPN string (e.g. 64*1+1-), or . for a new set of four digits, or q to quit.
Make 24 using these digits, once each, in any order: [7,2,1,8]:
82*71++
Correct!
At the prompt, enter an RPN string (e.g. 64*1+1-), or . for a new set of four digits, or q to quit.
Make 24 using these digits, once each, in any order: [6,4,2,6]:
q
$
</pre>
=={{header|Julia}}==
This implementation, because it is based on the Julia parser and evaluator, allows the user to enter arbitrary infix expressions, including parentheses. (These expressions are checked to ensure that they only include the allowed operations on integer literals.)
<syntaxhighlight lang=julia>validexpr(ex::Expr) = ex.head == :call && ex.args[1] in [:*,:/,:+,:-] && all(validexpr, ex.args[2:end])
validexpr(ex::Int) = true
validexpr(ex::Any) = false
findnumbers(ex::Number) = Int[ex]
findnumbers(ex::Expr) = vcat(map(findnumbers, ex.args)...)
findnumbers(ex::Any) = Int[]
function twentyfour()
digits = sort!(rand(1:9, 4))
while true
print("enter expression using $digits => ")
ex = parse(readline())
try
validexpr(ex) || error("only *, /, +, - of integers is allowed")
nums = sort!(findnumbers(ex))
nums == digits || error("expression $ex used numbers $nums != $digits")
val = eval(ex)
val == 24 || error("expression $ex evaluated to $val, not 24")
println("you won!")
return
catch e
if isa(e, ErrorException)
println("incorrect: ", e.msg)
else
rethrow()
end
end
end
end</syntaxhighlight>
{{out}}
<pre>
julia> twentyfour()
enter expression using [2,5,8,9] => 5 * 2 - 8 + 9
incorrect: expression (5 * 2 - 8) + 9 evaluated to 11, not 24
enter expression using [2,5,8,9] => 5 * 5 + 2 + 8 - 9
incorrect: expression (5 * 5 + 2 + 8) - 9 used numbers [2,5,5,8,9] != [2,5,8,9]
enter expression using [2,5,8,9] => 8*2*2
incorrect: expression 8 * 2 * 2 used numbers [2,2,8] != [2,5,8,9]
enter expression using [2,5,8,9] => (8 + 9) + (5 + 2)
you won!</pre>
=={{header|Koka}}==
<syntaxhighlight lang=koka>
import std/num/random
import std/os/readline
type expr
Num(i: int)
Add(e1: expr, e2: expr)
Sub(e1: expr, e2: expr)
Mul(e1: expr, e2: expr)
Div(e1: expr, e2: expr)
fun genNum()
random-int() % 9 + 1
fun parseFact(s: string): <div,exn> (expr, string)
match s.head
"(" ->
val (e, rest) = s.tail.parseExpr()
match rest.head
")" -> (e, rest.tail)
_ -> throw("expected ')'")
x | x.head-char.default('_').is-digit -> (Num(x.parse-int.unjust), s.tail)
_ -> throw("No factor")
fun parseTerm(s): <div,exn> (expr, string)
val (e', n) = s.parseFact()
match n.head
"*" ->
val (e'', n') = n.tail.parseTerm()
(Mul(e', e''), n')
"/" ->
val (e'', n') = n.tail.parseTerm()
(Div(e', e''), n')
_ -> (e', n)
fun parseExpr(s): <div,exn> (expr, string)
val (e', n) = s.parseTerm()
match n.head
"+" ->
val (e'', n') = n.tail.parseExpr()
(Add(e', e''), n')
"-" ->
val (e'', n') = n.tail.parseExpr()
(Sub(e', e''), n')
_ -> (e', n)
fun numbers(e: expr): div list<int>
match e
Num(i) -> [i]
Add(e1, e2) -> numbers(e1) ++ numbers(e2)
Sub(e1, e2) -> numbers(e1) ++ numbers(e2)
Mul(e1, e2) -> numbers(e1) ++ numbers(e2)
Div(e1, e2) -> numbers(e1) ++ numbers(e2)
fun check(e: expr, l: list<int>): <div,exn> ()
val ns = numbers(e)
if (ns.length == 4) then
if l.all(fn(n) ns.any(fn(x) x == n)) then
()
else
throw("wrong numbers")
else
throw("wrong number of numbers")
fun evaluate(e: expr): float64
match e
Num(i) -> i.float64
Add(e1, e2) -> evaluate(e1) + evaluate(e2)
Sub(e1, e2) -> evaluate(e1) - evaluate(e2)
Mul(e1, e2) -> evaluate(e1) * evaluate(e2)
Div(e1, e2) -> evaluate(e1) / evaluate(e2)
fun main()
println("\nGoal: ")
println("- Create an expression that evaluates to 24")
println("- Using the four given numbers each number once")
println("- Using the operators (+-/*) with no spaces")
println("Example 2 3 4 1: (2+3)*4*1\n")
println("Here are your numbers!")
var l: list<int> := Nil
repeat(4) fn()
val n = genNum()
l := Cons(n, l)
(n.show ++ " ").print
println("")
var found := False
while { !found } fn()
val (expr, r) = readline().parseExpr()
if r.count > 0 then
println("Expected EOF but got: " ++ r ++ " please try again")
return ()
expr.check(l)
val result = expr.evaluate()
if result == 24.0 then
println("You got it!")
found := True
else
println("Try again, your expression evaluated to: " ++ result.show)
</syntaxhighlight>
=={{header|Kotlin}}==
<syntaxhighlight lang=scala>import java.util.Random
import java.util.Scanner
import java.util.Stack
internal object Game24 {
fun run() {
val r = Random()
val digits = IntArray(4).map { r.nextInt(9) + 1 }
println("Make 24 using these digits: $digits")
print("> ")
val s = Stack<Float>()
var total = 0L
val cin = Scanner(System.`in`)
for (c in cin.nextLine()) {
when (c) {
in '0'..'9' -> {
val d = c - '0'
total += (1 shl (d * 5)).toLong()
s += d.toFloat()
}
else ->
if ("+/-*".indexOf(c) != -1) {
s += c.applyOperator(s.pop(), s.pop())
}
}
}
when {
tally(digits) != total ->
print("Not the same digits. ")
s.peek().compareTo(target) == 0 ->
println("Correct!")
else ->
print("Not correct.")
}
}
private fun Char.applyOperator(a: Float, b: Float) = when (this) {
'+' -> a + b
'-' -> b - a
'*' -> a * b
'/' -> b / a
else -> Float.NaN
}
private fun tally(a: List<Int>): Long = a.reduce({ t, i -> t + (1 shl (i * 5)) }).toLong()
private val target = 24
}
fun main(args: Array<String>) = Game24.run()</syntaxhighlight>
=={{header|Lasso}}==
This solution requires web input from the user via a form of the expression.
On submit the expression is checked for valid chars, that the integers are valid and in the original array (which also takes care of non-duplicate integers), and that the integers are not in consecutive positions.
If a valid expression it is evaluated, and the result and success state shown to the user.
<syntaxhighlight lang=Lasso>[
if(sys_listunboundmethods !>> 'randoms') => {
define randoms()::array => {
local(out = array)
loop(4) => { #out->insert(math_random(9,1)) }
return #out
}
}
if(sys_listunboundmethods !>> 'checkvalid') => {
define checkvalid(str::string, nums::array)::boolean => {
local(chk = array('*','/','+','-','(',')',' '), chknums = array, lastintpos = -1, poscounter = 0)
loop(9) => { #chk->insert(loop_count) }
with s in #str->values do => {
#poscounter++
#chk !>> #s && #chk !>> integer(#s) ? return false
integer(#s) > 0 && #lastintpos + 1 >= #poscounter ? return false
integer(#s) > 0 ? #chknums->insert(integer(#s))
integer(#s) > 0 ? #lastintpos = #poscounter
}
#chknums->size != 4 ? return false
#nums->sort
#chknums->sort
loop(4) => { #nums->get(loop_count) != #chknums(loop_count) ? return false }
return true
}
}
if(sys_listunboundmethods !>> 'executeexpr') => {
define executeexpr(expr::string)::integer => {
local(keep = string)
with i in #expr->values do => {
if(array('*','/','+','-','(',')') >> #i) => {
#keep->append(#i)
else
integer(#i) > 0 ? #keep->append(decimal(#i))
}
}
return integer(sourcefile('['+#keep+']','24game',true,true)->invoke)
}
}
local(numbers = array, exprsafe = true, exprcorrect = false, exprresult = 0)
if(web_request->param('nums')->asString->size) => {
with n in web_request->param('nums')->asString->split(',') do => { #numbers->insert(integer(#n->trim&)) }
}
#numbers->size != 4 ? #numbers = randoms()
if(web_request->param('nums')->asString->size) => {
#exprsafe = checkvalid(web_request->param('expr')->asString,#numbers)
if(#exprsafe) => {
#exprresult = executeexpr(web_request->param('expr')->asString)
#exprresult == 24 ? #exprcorrect = true
}
}
]<h1>24 Game</h1>
<p><b>Rules:</b><br>
Enter an expression that evaluates to 24</p>
<ul>
<li>Only multiplication, division, addition, and subtraction operators/functions are allowed.</li>
<li>Brackets are allowed.</li>
<li>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).</li>
<li>The order of the digits when given does not have to be preserved.</li>
</ul>
<h2>Numbers</h2>
<p>[#numbers->join(', ')] (<a href="?">Reload</a>)</p>
[!#exprsafe ? '<p>Please provide a valid expression</p>']
<form><input type="hidden" value="[#numbers->join(',')]" name="nums"><input type="text" name="expr" value="[web_request->param('expr')->asString]"><input type="submit" name="submit" value="submit"></form>
[if(#exprsafe)]
<p>Result: <b>[#exprresult]</b> [#exprcorrect ? 'is CORRECT!' | 'is incorrect']</p>
[/if]</syntaxhighlight>
=={{header|Liberty BASIC}}==
<
dim chk(4)
print "The 24 Game"
Line 1,005 ⟶ 7,442:
exit function
[handler]
end function</
=={{header|LiveCode}}==
GUI version
1. Open livecode and create a new mainstack
2. Create 3 fields and 1 button
3. label fields "YourNumbersField", "EvalField" and "AnswerField"
4. label button "StartButton"
5. Add the following to the code of "StartButton"<syntaxhighlight lang=livecode>on mouseUp
put empty into fld "EvalField"
put empty into fld "AnswerField"
put random(9) & comma & random(9) & comma & random(9) & comma & random(9) into fld "YourNumbersField"
end mouseUp</syntaxhighlight>
6. Add the following to the code of field "EvalField"<syntaxhighlight lang=livecode>
on keyDown k
local ops, nums, allowedKeys, numsCopy, expr
put "+,-,/,*,(,)" into ops
put the text of fld "YourNumbersField" into nums
put the text of fld "EvalField" into expr
if matchText(expr & k,"\d\d") then
answer "You can't enter 2 digits together"
exit keyDown
end if
repeat with n = 1 to the number of chars of expr
if offset(char n of expr, nums) > 0 then
delete char offset(char n of expr, nums) of nums
end if
end repeat
put ops & comma & nums into allowedKeys
if k is among the items of allowedKeys then
put k after expr
delete char offset(k, nums) of nums
replace comma with empty in nums
try
put the value of merge("[[expr]]") into fld "AnswerField"
if the value of fld "AnswerField" is 24 and nums is empty then
answer "You win!"
end if
end try
pass keyDown
else
exit keyDown
end if
end keyDown</syntaxhighlight>
=={{header|Locomotive Basic}}==
<syntaxhighlight lang=locobasic>10 CLS:RANDOMIZE TIME
20 PRINT "The 24 Game"
30 PRINT "===========":PRINT
40 PRINT "Enter an arithmetic expression"
50 PRINT "that evaluates to 24,"
60 PRINT "using only the provided digits"
70 PRINT "and +, -, *, /, (, )."
80 PRINT "(Just hit Return for new digits.)"
90 ' create new digits
100 FOR i=1 TO 4:a(i)=INT(RND*9)+1:NEXT
110 PRINT
120 PRINT "The digits are";a(1);a(2);a(3);a(4)
130 PRINT
140 ' user enters solution
150 INPUT "Your solution";s$
160 IF s$="" THEN PRINT "Creating new digits...":GOTO 100
170 GOTO 300
180 ' a little hack to create something like an EVAL function
190 OPENOUT "exp.bas"
200 PRINT #9,"1000 x="s$":return"
210 CLOSEOUT
220 CHAIN MERGE "exp",240
230 ' now evaluate the expression
240 ON ERROR GOTO 530
250 GOSUB 1000
260 IF x=24 THEN PRINT "Well done!":END
270 PRINT "No, this evaluates to"x:PRINT "Please try again."
280 GOTO 150
290 ' check input for correctness
300 FOR i=1 TO LEN(s$)
310 q=ASC(MID$(s$,i,1))
320 IF q=32 OR (q>39 AND q<44) OR q=45 OR (q>46 AND q<58) THEN NEXT
330 IF i-1=LEN(s$) THEN 370
340 PRINT "Bad character in expression:"CHR$(q)
350 PRINT "Try again":GOTO 150
360 ' new numbers in solution?
370 FOR i=1 TO LEN(s$)-1
380 q=ASC(MID$(s$,i,1)):p=ASC(MID$(s$,i+1,1))
390 IF q>47 AND q<58 AND p>47 AND p<58 THEN PRINT "No forming of new numbers, please!":GOTO 150
400 NEXT
410 FOR i=1 TO 9:orig(i)=0:guess(i)=0:NEXT
420 FOR i=1 TO 4:orig(a(i))=orig(a(i))+1:NEXT
430 FOR i=1 TO LEN(s$)
440 v$=MID$(s$,i,1)
450 va=ASC(v$)-48
460 IF va>0 AND va<10 THEN guess(va)=guess(va)+1
470 NEXT
480 FOR i=1 TO 9
490 IF guess(i)<>orig(i) THEN PRINT "Only use all the provided digits!":GOTO 150
500 NEXT
510 GOTO 190
520 ' syntax error, e.g. non-matching parentheses
530 PRINT "Error in expression, please try again."
540 RESUME 150</syntaxhighlight>
Note: The program needs a writable disk in the active disk drive.
=={{header|Logo}}==
{{works with|UCB_Logo|5.5}}
<syntaxhighlight lang=logo>; useful constants
make "false 1=0
make "true 1=1
Line 1,081 ⟶ 7,626:
]]]
]
bye</syntaxhighlight>
{{out}}
<pre>
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!
</pre>
=={{header|Lua}}==
<
local function help()
print [[
Line 1,186 ⟶ 7,744:
end
end
game24()</
Alternately, using the <code>lpeg.re</code> module:
<
print [[
The 24 Game
Line 1,231 ⟶ 7,789:
end
end
twentyfour()</
=={{header|
Click [http://maplecloud.maplesoft.com/application.jsp?appId=5764927761416192 here] to try this game online.
<syntaxhighlight lang=maple>play24 := module()
export ModuleApply;
local cheating;
cheating := proc(input, digits)
local i, j, stringDigits;
use StringTools in
stringDigits := Implode([seq(convert(i, string), i in digits)]);
for i in digits do
for j in digits do
if Search(cat(convert(i, string), j), input) > 0 then
return true, ": Please don't combine digits to form another number."
end if;
end do;
end do;
for i in digits do
if CountCharacterOccurrences(input, convert(i, string)) < CountCharacterOccurrences(stringDigits, convert(i, string)) then
return true, ": Please use all digits.";
end if;
end do;
for i in digits do
if CountCharacterOccurrences(input, convert(i, string)) > CountCharacterOccurrences(stringDigits, convert(i, string)) then
return true, ": Please only use a digit once.";
end if;
end do;
for i in input do
try
if type(parse(i), numeric) and not member(parse(i), digits) then
return true, ": Please only use the digits you were given.";
end if;
catch:
end try;
end do;
return false, "";
end use;
end proc:
ModuleApply := proc()
local replay, digits, err, message, answer;
randomize():
replay := "":
while not replay = "END" do
if not replay = "YES" then
digits := [seq(rand(1..9)(), i = 1..4)]:
end if;
err := true:
while err do
message := "";
printf("Please make 24 from the digits: %a. Press enter for a new set of numbers or type END to quit\n", digits);
answer := StringTools[UpperCase](readline());
if not answer = "" and not answer = "END" then
try
if not type(parse(answer), numeric) then
error;
elif cheating(answer, digits)[1] then
message := cheating(answer, digits)[2];
error;
end if;
err := false;
catch:
printf("Invalid Input%s\n\n", message);
end try;
else
err := false;
end if;
end do:
if not answer = "" and not answer = "END" then
if parse(answer) = 24 then
printf("You win! Do you wish to play another game? (Press enter for a new set of numbers or END to quit.)\n");
replay := StringTools[UpperCase](readline());
else
printf("Your expression evaluated to %a. Try again!\n", parse(answer));
replay := "YES";
end if;
else
replay := answer;
end if;
printf("\n");
end do:
printf("GAME OVER\n");
end proc:
end module:
play24();</syntaxhighlight>
{{out}}
<pre>
Please make 24 from the digits: [4, 7, 6, 8]. Press enter for a new set of numbers or type END to quit
You win! Do you wish to play another game? (Press enter for a new set of numbers or END to quit.)
Please make 24 from the digits: [3, 7, 4, 7]. Press enter for a new set of numbers or type END to quit
Your expression evaluated to 21. Try again!
Please make 24 from the digits: [3, 7, 4, 7]. Press enter for a new set of numbers or type END to quit
GAME OVER
</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
{{works with|Mathematica|6}}
Line 1,240 ⟶ 7,897:
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.
<
Quiet[Check[
With[{h = ToExpression[x, StandardForm, HoldForm]},
Line 1,254 ⟶ 7,911:
"Sorry, that is invalid.", 24, "Congrats! That's 24!", _,
"Sorry, that makes " <> ToString[ToExpression@x, InputForm] <>
", not 24."]]}}]</
=={{header|MATLAB}} / {{header|Octave}}==
<syntaxhighlight lang=Matlab> function twentyfour()
N = 4;
n = ceil(rand(1,N)*9);
printf('Generate a equation with the numbers %i, %i, %i, %i and +, -, *, /, () operators ! \n',n);
s = input(': ','s');
t = s;
for k = 1:N,
[x,t] = strtok(t,'+-*/() \t');
if length(x)~=1,
error('invalid sign %s\n',x);
end;
y = x-'0';
if ~(0 < y & y < 10)
error('invalid sign %s\n',x);
end;
z(1,k) = y;
end;
if any(sort(z)-sort(n))
error('numbers do not match.\n');
end;
val = eval(s);
if val==24,
fprintf('expression "%s" results in %i.\n',s,val);
else
fprintf('expression "%s" does not result in 24 but %i.\n',s,val);
end; </syntaxhighlight>
=={{header|MiniScript}}==
We use a simple recursive descent parser, with a bit of extra code to make sure that only available digits are used, and all of them are used.
<syntaxhighlight lang=MiniScript>evalAddSub = function()
result = evalMultDiv
while true
if not tokens then return result
op = tokens[0]
if op != "+" and op != "-" then return result
tokens.pull // (discard operator)
rhs = evalMultDiv
if result == null or rhs == null then return null
if op == "+" then result = result + rhs
if op == "-" then result = result - rhs
end while
end function
evalMultDiv = function()
result = evalAtom
while true
if not tokens then return result
op = tokens[0]
if op != "*" and op != "/" then return result
tokens.pull // (discard operator)
rhs = evalAtom
if result == null or rhs == null then return null
if op == "*" then result = result * rhs
if op == "/" then result = result / rhs
end while
end function
evalAtom = function()
if tokens[0] == "(" then
tokens.pull
result = evalAddSub
if not tokens or tokens.pull != ")" then
print "Unbalanced parantheses"
return null
end if
return result
end if
num = val(tokens.pull)
idx = availableDigits.indexOf(num)
if idx == null then
print str(num) + " is not available"
return null
else
availableDigits.remove idx
end if
return num
end function
choices = []
for i in range(1, 4)
choices.push ceil(rnd*9)
end for
result = null
while result != 24
availableDigits = choices[:] // (clones the list)
print "Using only the digits " + availableDigits + ","
tokens = input("enter an expression that comes to 24: ").replace(" ","").values
result = evalAddSub
if availableDigits then
print "You forgot to use: " + availableDigits
result = null
end if
if result != null then print "That equals " + result + "."
end while
print "Great job!"</syntaxhighlight>
{{out}}
<pre>Using only the digits [5, 5, 2, 7],
enter an expression that comes to 24:
(7+5)*2
You forgot to use: [5]
Using only the digits [5, 5, 2, 7],
enter an expression that comes to 24:
5*7-5*2
That equals 25.
Using only the digits [5, 5, 2, 7],
enter an expression that comes to 24:
5+5+7*2
That equals 24.
Great job!</pre>
=={{header|mIRC Scripting Language}}==
<syntaxhighlight lang=mirc>alias 24 {
dialog -m 24-Game 24-Game
}
dialog 24-Game {
title "24-Game"
size -1 -1 100 70
option dbu
text "", 1, 29 7 42 8
text "Equation", 2, 20 21 21 8
edit "", 3, 45 20 40 10
text "Status", 4, 10 34 80 8, center
button "Calculate", 5, 5 45 40 20
button "New", 6, 57 47 35 15
}
on *:DIALOG:24-Game:init:*: {
did -o 24-Game 1 1 Numbers: $rand(1,9) $rand(1,9) $rand(1,9) $rand(1,9)
}
on *:DIALOG:24-Game:sclick:*: {
if ($did == 5) {
if ($regex($did(3),/^[ (]*\d *[-+*/][ (]*\d[ ()]*[-+*/][ ()]*\d[ )]*[-+*/] *\d[ )]*$/)) && ($sorttok($regsubex($did(3),/[^\d]+/g,$chr(32)),32) == $sorttok($remove($did(1),Numbers:),32)) {
did -o 24-Game 4 1 $iif($calc($did(3)) == 24,Correct,Wrong)
}
else {
did -o 24-Game 4 1 Wrong Numbers or Syntax
}
}
elseif ($did == 6) {
did -o 24-Game 1 1 Numbers: $rand(1,9) $rand(1,9) $rand(1,9) $rand(1,9)
}
}</syntaxhighlight>
=={{header|Modula-2}}==
{{libheader|Ulm's Modula-2 Library}}
<syntaxhighlight 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 WITH*)
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.</syntaxhighlight>
=={{header|MUMPS}}==
<syntaxhighlight lang=mumps>24Game
k number, operator, bracket
; generate 4 random numbers each between 1 & 9
; duplicates allowed!
s n1=$r(9)+1, n2=$r(9)+1, n3=$r(9)+1, n4=$r(9)+1
; save a copy of them so that we can keep restarting
; if the user gets it wrong
s s1=n1,s2=n2,s3=n3,s4=n4
Question
s (numcount,opcount,lbrackcount,rbrackcount)=0
; restart with the random numbers already found
s n1=s1,n2=s2,n3=s3,n4=s4
w !,"Enter an arithmetic expression that evaluates to 24 using (",
n1," ",n2," ",n3," ",n4,"): "
r !,expr
q:expr=""
; validate numbers and operators
s error=""
f n=1:1:$l(expr) {
s char=$e(expr,n)
if char?1n {
s number($i(numcount))=char
w !
zw char
}
elseif char?1(1"*",1"/",1"+",1"-") {
s operator($i(opcount))=char
}
elseif char?1"(" {
s bracket($i(lbrackcount))=char
}
elseif char?1")" {
s bracket($i(rbrackcount))=char
}
else {
s error="That ain't no character I wanted to see"
q
}
}
if error'="" w error g Question
if numcount'=4 {
w "Does not have 4 numbers, do it again."
g Question
}
s error=""
f n=1:1:4 {
if number(n)=n1 {
s n1="dont use again" continue
}
if number(n)=n2 {
s n2="dont use again" continue
}
if number(n)=n3 {
s n3="dont use again" continue
}
if number(n)=n4 {
s n4="dont use again" continue
}
s error="Numbers entered do not match all of the randomly generated numbers."
q
}
if error'="" {
w error
g Question
}
if opcount'=3 {
w "Does not have 3 operators."
g Question
}
if lbrackcount'=rbrackcount {
w "brackets must be in pairs."
g Question
}
x "s x="_expr
if x'=24 {
w !,"Answer does not = 24"
g Question
}
w x
q
</syntaxhighlight>
=={{header|Nanoquery}}==
<syntaxhighlight lang=Nanoquery>import Nanoquery.Lang
import Nanoquery.Util
// a function to get the digits from an arithmetic expression
def extract_digits(input)
input = str(input)
digits = {}
loc = 0
digit = ""
while (loc < len(input))
if input[loc] in "0123456789"
digit += input[loc]
else
if len(digit) > 0
digits.append(int(digit))
digit = ""
end
end
loc += 1
end
// check if there's a final digit
if len(digit) > 0
digits.append(int(digit))
end
return digits
end
// a function to duplicate a digit list
def dup(list)
nlist = {}
for n in list
nlist.append(new(Integer, n))
end
return nlist
end
// generate four random digits and output them
random = new(Random)
randDigits = {}
for i in range(1, 4)
randDigits.append(random.getInt(8) + 1)
end
println "Your digits are: " + randDigits + "\n"
// get expressions from the user until a valid one is found
won = false
while !won
print "> "
expr = input()
tempDigits = dup(randDigits)
// check for invalid digits in the expression
invalid = false
digits = extract_digits(expr)
for (i = 0) (!invalid and (i < len(digits))) (i += 1)
if not digits[i] in tempDigits
invalid = true
println "Invalid digit " + digits[i]
else
tempDigits.remove(tempDigits)
end
end
// if there were no invalid digits, check if the expression
// evaluates to 24
if !invalid
a = null
try
exec("a = " + expr)
catch
println "Invalid expression " + expr
end
println a
if a = 24
println "Success!"
won = true
end
end
end</syntaxhighlight>
{{out}}
<pre>Your digits are: [2, 5, 4, 6]
> 2*5+(4*6)
34
> 2*4+5*6
38
> 5*6-(2*4)
22
> 5*6-(2+4)
24
Success!</pre>
=={{header|Nim}}==
{{trans|D}}
{{works with|Nim Compiler|1.0.0}}
<syntaxhighlight lang=nim>from random import randomize, rand
from strutils import Whitespace
from algorithm import sort
from sequtils import newSeqWith
randomize()
var
problem = newSeqWith(4, rand(1..9))
stack: seq[float]
digits: seq[int]
echo "Make 24 with the digits: ", problem
template op(c: untyped) =
let a = stack.pop
stack.add c(stack.pop, a)
for c in stdin.readLine:
case c
of '1'..'9':
digits.add c.ord - '0'.ord
stack.add float(c.ord - '0'.ord)
of '+': op `+`
of '*': op `*`
of '-': op `-`
of '/': op `/`
of Whitespace: discard
else: raise newException(ValueError, "Wrong char: " & c)
sort digits
sort problem
if digits != problem:
raise newException(ValueError, "Not using the given digits.")
if stack.len != 1:
raise newException(ValueError, "Wrong expression.")
echo "Result: ", stack[0]
echo if abs(stack[0] - 24) < 0.001: "Good job!" else: "Try again."</syntaxhighlight>
Example game:
<pre>Make 24 with the digits: @[8, 1, 3, 1]
8 3 * 1 + 1 -
Result: 24.0
Good job!</pre>
=={{header|Nit}}==
Source: [https://github.com/nitlang/nit/blob/master/examples/rosettacode/24_game.nit the Nit’s official repository]
<syntaxhighlight lang=nit>redef class Char
fun is_op: Bool do return "-+/*".has(self)
end
# Get `numbers` and `operands` from string `operation` collect with `gets` in `main` function
# Fill `numbers` and `operands` array with previous extraction
fun exportation(operation: String, numbers: Array[Int], operands: Array[Char]) do
var previous_char: nullable Char = null
var number: nullable Int = null
var negative = false
for i in operation.length.times do
var current_char = operation[i]
var current_int = current_char.to_i
if (previous_char == null or previous_char.is_op) and current_char == '-' then
negative = true
continue
end
if current_char.is_digit then
if number == null then
number = current_int
else
number = number * 10 + current_int
end
end
if negative and (current_char.is_op or i == operation.length - 1) then
number = number - number * 2
negative = false
end
if (current_char.is_op or i == operation.length - 1) and number != null then
numbers.add(number)
number = null
end
if not negative and current_char.is_op then
operands.add(current_char)
end
previous_char = current_char
end
# Update `numbers` and `operands` array in main function with pointer
end
# Create random numbers between 1 to 9
fun random: Array[Int] do
return [for i in 4.times do 1 + 9.rand]
end
# Make mathematical operation with `numbers` and `operands` and add the operation result into `random_numbers`
fun calculation(random_numbers, numbers: Array[Int], operands: Array[Char]) do
var number = 0
var temp_numbers = numbers.clone
while temp_numbers.length > 1 do
var operand = operands.shift
var a = temp_numbers.shift
var b = temp_numbers.shift
if operand == '+' then number = a + b
if operand == '-' then number = a - b
if operand == '*' then number = a * b
if operand == '/' then number = a / b
temp_numbers.unshift(number)
end
if number != 0 then random_numbers.add(number)
end
# Check if used `numbers` exist in the `random_numbers` created
fun numbers_exists(random_numbers, numbers: Array[Int]): Bool do
for number in numbers do
if not random_numbers.count(number) >= numbers.count(number) then return false
end
return true
end
# Remove `numbers` when they are used
fun remove_numbers(random_numbers, numbers: Array[Int]) do
for number in numbers do random_numbers.remove(number)
end
# Check if the mathematical `operation` is valid
fun check(operation: String): Bool do
var previous_char: nullable Char = null
var next_char: nullable Char = null
var next_1_char: nullable Char = null
for i in operation.length.times do
var current_char = operation[i]
if i + 1 < operation.length then
next_char = operation[i + 1]
if i + 2 < operation.length then
next_1_char = operation[i + 2]
else
next_1_char = null
end
else
next_char = null
end
if not current_char.is_op and not current_char.is_digit then return false
if next_char == null and current_char.is_op then return false
if previous_char == null then
if next_char == null or next_1_char == null then return false
if current_char == '-' and not next_char.is_digit then return false
if current_char != '-' and not current_char.is_digit then return false
else
if next_char != null then
if previous_char.is_digit and current_char.is_op and
not (next_char == '-' and next_1_char != null and
next_1_char.is_digit or next_char.is_digit) then
return false
end
end
end
previous_char = current_char
end
return true
end
var random_numbers = new Array[Int]
var operation = ""
random_numbers = random
while not random_numbers.has(24) and random_numbers.length > 1 do
var numbers = new Array[Int]
var operands = new Array[Char]
print "numbers: " + random_numbers.join(", ")
operation = gets
if check(operation) then
exportation(operation, numbers, operands)
if numbers_exists(random_numbers, numbers) then
calculation(random_numbers, numbers, operands)
remove_numbers(random_numbers, numbers)
else
print "NUMBERS ERROR!"
end
else
print "STRING ERROR!"
end
end
if random_numbers.has(24) then print "CONGRATULATIONS" else print "YOU LOSE"</syntaxhighlight>
=={{header|Objeck}}==
{{trans|C++}}
<syntaxhighlight lang=objeck>use Collection.Generic;
use System.Matrix;
class RPNParser {
@stk : Stack<IntHolder>;
@digits : List<IntHolder>;
function : Main(args : String[]) ~ Nil {
digits := List->New()<IntHolder>;
"Make 24 with the digits: "->Print();
for(i := 0; i < 4; i += 1;) {
n : Int := Int->Random(1, 9);
" {$n}"->Print();
digits->AddBack(n);
};
'\n'->Print();
parser := RPNParser->New();
if(parser->Parse(System.IO.Console->ReadString(), digits)) {
result := parser->GetResult();
if(result = 24) {
"Good job!"->PrintLine();
}
else {
"{$result}, Try again."->PrintLine();
};
}
else {
"Invalid sequence"->PrintLine();
};
}
New() {
@stk := Stack->New()<IntHolder>;
@digits := List->New()<IntHolder>;
}
method : Op(f : \Func->Calc) ~ Nil {
if(@stk->Size() < 2) { "Improperly written expression"->ErrorLine(); Runtime->Exit(1); };
b := @stk->Pop();
a := @stk->Pop();
@stk->Push(f(a, b));
}
method : Parse(c : Char) ~ Nil {
if(c >= '0' & c <= '9') {
value : Int := c - '0';
@stk->Push(value);
@digits->AddBack(value);
}
else if(c = '+') {
Op(\Func->Calc : (a, b) => a + b);
}
else if(c = '-') {
Op(\Func->Calc : (a, b) => a - b);
}
else if(c = '*') {
Op(\Func->Calc : (a, b) => a * b);
}
else if(c = '/') {
Op(\Func->Calc : (a, b) => { if(b <> 0) { return a / b; } else { return 0; }; });
};
}
method : GetResult() ~ Int {
if(@stk->Size() = 1) {
return @stk->Top();
};
return 0;
}
method : Parse(s : String, digits : List<IntHolder>) ~ Bool {
each(i : s) {
Parse(s->Get(i));
};
@digits->Rewind();
while(@digits->More()) {
left := @digits->Get()->Get();
digits->Rewind();
found := false;
while(digits->More() & found = false) {
right := digits->Get()->Get();
if(left = right) {
digits->Remove(); found := true;
}
else {
digits->Next();
};
};
@digits->Next();
};
return digits->IsEmpty();
}
}
alias Func {
Calc : (IntHolder, IntHolder) ~ IntHolder
}</syntaxhighlight>
=={{header|OCaml}}==
Line 1,261 ⟶ 8,736:
ocamlopt -pp camlp4o g24.ml -o g24.opt
<
| Const of float
| Sum of expression * expression (* e1 + e2 *)
Line 1,268 ⟶ 8,743:
| Quot of expression * expression (* e1 / e2 *)
let rec eval
| Const c -> c
| Sum (f, g) -> eval f +. eval g
Line 1,276 ⟶ 8,750:
| Quot(f, g) -> eval f /. eval g
let rec extract acc
| Const c -> (c::acc)
| Sum (f, g) -> (extract acc f) @ (extract [] g)
Line 1,352 ⟶ 8,825:
else print_endline "Try again"
end
done</
=={{header|
<syntaxhighlight lang=Oforth>import: mapping
: game
| l expr w n i |
4 #[ 9 rand ] Array init ->l
System.Out "Digits : " << l << " --> RPN Expression for 24 : " << drop
System.Console accept ->expr
expr words forEach: w [
w "+" == ifTrue: [ + continue ]
w "-" == ifTrue: [ - continue ]
w "*" == ifTrue: [ * continue ]
w "/" == ifTrue: [ >float / continue ]
w >integer dup ->n ifNull: [ System.Out "Word " << w << " not allowed " << cr break ]
n l indexOf dup ->i ifNull: [ System.Out "Integer " << n << " is wrong " << cr break ]
n l put(i, null)
]
#null? l conform? ifFalse: [ "Sorry, all numbers must be used..." . return ]
24 if=: [ "You won !" ] else: [ "You loose..." ] .
;</syntaxhighlight>
=={{header|ooRexx}}==
While the solution shown within this page at [[#rexx_version2|Rexx version 2]] was created for Classic Rexx it also can be used unchanged by the ooRexx interpreter and so can be considered a solution for the ooRexx language too.
Incompatibilities(*) that were originally in [[#rexx_version1|Rexx version 1]] were meanwhile "fixed", so it also can be used unchanged by the ooRexx interpreter and so can be considered a solution for the ooRexx language too.
(*) Classic Rexx accepts assignment without an expression (x=;), ooRexx does not.
=={{header|OpenEdge/Progress}}==
The dynamic query parser is used to evaluate the expression.
<syntaxhighlight 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.
</syntaxhighlight>
=={{header|PARI/GP}}==
{{untested}}
<syntaxhighlight 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
)
};</syntaxhighlight>
=={{header|Perl}}==
<syntaxhighlight lang=perl>#!/usr/bin/env perl
use warnings;
use strict;
use feature 'say';
print <<'EOF';
Line 1,365 ⟶ 8,989:
Given any four digits in the range 1 to 9, which may have repetitions,
Using just the +, -, *, and / operators; and the possible use of
An answer of "q" or EOF will quit the game.
A blank answer 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
my $try = 1;
while (1) {
my @digits = map { 1+int(rand(9)) } 1..4;
say "\nYour four digits: ", join(" ", @digits);
print "Expression (try ", $try++, "): ";
my $entry = <>;
if (!defined $entry || $entry eq 'q')
{ say "Goodbye. Sorry you couldn't win."; last; }
$entry =~ s/\s+//g; # remove all white space
next if $entry eq '';
my $given_digits = join "", sort @digits;
my $entry_digits = join "", sort grep { /\d/ } split(//, $entry);
if ($given_digits ne $entry_digits || # not correct digits
$entry =~ /\d\d/ || # combined digits
$entry =~ m|[-+*/]{2}| || # combined operators
$entry =~ tr|-0-9()+*/||c) # Invalid characters
{ say "That's not valid"; next; }
my $n = eval $entry;
if (!defined $n) { say "Invalid expression"; }
elsif ($n == 24) { say "You win!"; last; }
else { say "Sorry, your expression is $n, not 24"; }
}</syntaxhighlight>
=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">-->
<span style="color: #000080;font-style:italic;">-- Note this uses simple/strict left association, so for example:
-- 1+2*1*8 is ((1+2)*1)*8 not 1+((2*1)*8) [or 1+(2*(1*8))], and
-- 7-(2*2)*8 is (7-(2*2))*8 not 7-((2*2)*8)
-- Does not allow unary minus on the first digit.
-- Uses solve24() from the next task, when it can.
-- (you may want to comment out the last 2 lines/uncomment the if 0, in that file)
--
--include 24_game_solve.exw
--with trace</span>
<span style="color: #008080;">forward</span> <span style="color: #008080;">function</span> <span style="color: #000000;">eval</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- (the above definition is entirely optional, but good coding style)</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">errorcodes</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"digit expected"</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- 1</span>
<span style="color: #008000;">"')' expected"</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- 2</span>
<span style="color: #008000;">"digit already used"</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- 3</span>
<span style="color: #008000;">"digit not offered"</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- 4</span>
<span style="color: #008000;">"operand expected"</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- 5</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">card</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (for error handling)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #008000;">"1st"</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #008000;">"2nd"</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000080;font-style:italic;">-- (assumes expression is less than 21 characters)</span>
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%dth"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">errorchar</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">></span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #008000;">""</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"(%s)"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">rset</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">new_rset</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">rset</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">rset</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">rand</span><span style="color: #0000FF;">(</span><span style="color: #000000;">9</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">get_operand</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">unused</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">error</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span> <span style="color: #000080;font-style:italic;">-- "digit expected"</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;"><=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">=</span><span style="color: #008000;">'('</span> <span style="color: #008080;">then</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">error</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">eval</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">error</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span>
<span style="color: #008080;">and</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;"><=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">=</span><span style="color: #008000;">')'</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">error</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">error</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">2</span> <span style="color: #000080;font-style:italic;">-- "')' expected"</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">>=</span><span style="color: #008000;">'0'</span> <span style="color: #008080;">and</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;"><=</span><span style="color: #008000;">'9'</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">-</span><span style="color: #008000;">'0'</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">unused</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">..</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">rset</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">error</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">3</span> <span style="color: #000080;font-style:italic;">-- "digit already used"</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">error</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">4</span> <span style="color: #000080;font-style:italic;">-- "digit not offered"</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">error</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">get_operator</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">error</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">5</span> <span style="color: #000080;font-style:italic;">-- "operand expected"</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;"><=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"+-/*"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">error</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">eval</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">lhs</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">rhs</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">error</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">error</span><span style="color: #0000FF;">,</span><span style="color: #000000;">lhs</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">get_operand</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">error</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">error</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">get_operator</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">error</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">error</span><span style="color: #0000FF;">,</span><span style="color: #000000;">rhs</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">get_operand</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">error</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">=</span><span style="color: #008000;">'+'</span> <span style="color: #008080;">then</span> <span style="color: #000000;">lhs</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">rhs</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">=</span><span style="color: #008000;">'-'</span> <span style="color: #008080;">then</span> <span style="color: #000000;">lhs</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">rhs</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">=</span><span style="color: #008000;">'/'</span> <span style="color: #008080;">then</span> <span style="color: #000000;">lhs</span> <span style="color: #0000FF;">/=</span> <span style="color: #000000;">rhs</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">=</span><span style="color: #008000;">'*'</span> <span style="color: #008080;">then</span> <span style="color: #000000;">lhs</span> <span style="color: #0000FF;">*=</span> <span style="color: #000000;">rhs</span>
<span style="color: #008080;">else</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #000080;font-style:italic;">-- (should not happen)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">></span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">lhs</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">=</span><span style="color: #008000;">')'</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">lhs</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">error</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">strip</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">to</span> <span style="color: #000000;">1</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #008000;">" \t\r\n"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">equation</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">..</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">""</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">equation</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">strip0</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (for error handling)</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%f"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">to</span> <span style="color: #000000;">2</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">=</span><span style="color: #008000;">'.'</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">!=</span><span style="color: #008000;">'0'</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">play</span><span style="color: #0000FF;">()</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">unused</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">equation</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">error</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">res</span>
<span style="color: #000000;">new_rset</span><span style="color: #0000FF;">()</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Enter an expression which evaluates to exactly 24\n"</span><span style="color: #0000FF;">&</span>
<span style="color: #008000;">"Use all of, and only, the digits %d, %d, %d, and %d\n"</span><span style="color: #0000FF;">&</span>
<span style="color: #008000;">"You may only use the operators + - * /\n"</span><span style="color: #0000FF;">&</span>
<span style="color: #008000;">"Parentheses and spaces are allowed\n"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">rset</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">equation</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">strip</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">gets</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">upper</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">)=</span><span style="color: #008000;">"Q"</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">equation</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"?"</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">r_solve24</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">routine_id</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"solve24"</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- see below</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">r_solve24</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #000080;font-style:italic;">-- (someone copied just this code out?)</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"no solve24 routine\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span>
<span style="color: #7060A8;">call_proc</span><span style="color: #0000FF;">(</span><span style="color: #000000;">r_solve24</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">rset</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">else</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">error</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">eval</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">rset</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">error</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" %s on the %s character%s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">errorcodes</span><span style="color: #0000FF;">[</span><span style="color: #000000;">error</span><span style="color: #0000FF;">],</span><span style="color: #000000;">card</span><span style="color: #0000FF;">(</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">),</span><span style="color: #000000;">errorchar</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;"><=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\neval() returned only having processed %d of %d characters\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">equation</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">elsif</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">unused</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" not all the digits were used\n"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">error</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">24</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\nresult is %s, not 24\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">strip0</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">else</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" correct! Press any key to quit\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">wait_key</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"enter Q to give up and quit\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">play</span><span style="color: #0000FF;">()</span>
<!--</syntaxhighlight>-->
=={{header|PHP}}==
{{trans|Perl}}
<syntaxhighlight lang=PHP>#!/usr/bin/env php
The 24 Game
Given any four digits in the range 1 to 9, which may have repetitions,
Using just the +, -, *, and / operators; and the possible use of
brackets, (), show how to make an answer of 24.
An answer of "q" will quit the game.
An answer of "!" will generate a new set of four digits.
Otherwise you are repeatedly asked for an expression until it evaluates to 24
Note: you cannot form multiple digit numbers from the supplied digits,
so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed.
<?php
while (true) {
$numbers = make_numbers();
for ($iteration_num = 1; ; $iteration_num++) {
if ($entry === 'q') exit;
if (
}
echo "Sorry, that's $result\n";
}
else {
}
}
}
$numbers = array();
for (
$number = rand(1, 9);
if (!isset($numbers
}
$numbers[$number]++;
print "$number ";
}
print "\n";
return
}
function play($numbers, $expression) {
$operator = true;
$character = $expression[$i];
if (in_array($character, array('(', ')', ' ', "\t"))) continue;
$operator = !$operator;
if (!
if (!empty($numbers[$character])) {
}
return;
}
elseif (!in_array($character, array('+', '-', '*', '/'))) {
}
}
foreach
if ($remaining > 0) {
return;
}
}
return eval("return $expression;");
}
?></syntaxhighlight>
=={{header|
<syntaxhighlight lang=Picat>import util.
main =>
play.
play =>
nl,
Digits = [random() mod 9 + 1 : _ in 1..4].sort(),
println("Enter \"q\" to quit"),
println("Enter \"!\" to request a new set of four digits."),
printf("Or enter expression using %w => ", Digits),
Exp = read_line().strip(),
evaluate(Digits,Exp).
evaluate(_Digits,"q") => halt.
evaluate(_Digits,"!") => play.
evaluate(Digits,Exp) =>
Operands = [to_int(D) : D in Exp, digit(D)].sort(),
(Digits !== Operands ->
println("You must use the given digits:" ++ to_string(Digits))
;
catch(Term = parse_term(Exp), Exception, println(Exception)),
Res is Term,
(Res =:= 24 ->
println("Good work!")
;
println("Wong expression")
)
),
play.
</syntaxhighlight>
=={{header|PicoLisp}}==
<syntaxhighlight lang=PicoLisp>
(load "@lib/frac.l")
(de random4digits ()
(setq Numbers (make (do 4 (link (rand 1 9)))))
Numbers )
(de prompt ()
(prinl
"^JPlease enter a 'Lisp' expression (integer or fractional math) that equals 24,^J"
"using (, ), frac, + or f+, - or f-, * or f*, / or f/, and " Numbers "^J"
"(use each number only once). Enter . to quit." ) )
(de getinput ()
(setq Expression (catch ’NIL (in NIL (read))))
Expression )
(de checkexpression (Numbers Expression)
(make
(when (diff
(link "Not all numbers used."
(when (diff (fish num?
(link "Using wrong number(s).")
(
(
(link "Illegal operator(s). If fractional expression, must use frac, f+, f-, f*, f/ only.") )
(when (diff (fish sym? Expression) '(+ - * /))
(link "Using illegal operator(s).") ) ) ) )
(de instructions ()
(
(prinl
"
"(f- (f* (frac 3 1)(frac 9 1)) (f+ (frac 1 1)(frac 2 1)))" )
(prinl
"Use a fractional expression 'just for fun (as above)' OR if your solution^J"
"would lose remainder value(s) otherwise (through integer division)." ) )
(de loopuntilquit ()
(instructions)
(loop
(set 'Numbers (random4digits))
(set 'Expression (getinput))
(if (= Expression ".") (prog (prinl "bye!") (bye)))
(set 'Check (checkexpression Numbers Expression))
(if (car Check)
(mapcar prinl Check)
(prog
(set 'Evaluated (eval Expression))
(if (or (= Evaluated 24) (= Evaluated (24 . 1)))
(prinl "Congratulations!")
(prinl "That evaluated to " Evaluated " Try again!") ) ) ) ) )
(loopuntilquit)
</syntaxhighlight>
{{out}}
<pre>
pil 24game.l +
Example 'Lisp' expression: (+ (* 4 5) (- 1 2))
Example 'Lisp' fractional expression: (f+ (f* (frac 4 1)(frac 5 1)) (f- (frac 1 1)(frac 2 1)))
Use a fractional expression if your solution would lose remainder value(s) otherwise.
Please enter a 'Lisp' expression (regular or fractional math style) that equals 24,
using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 1329.
Enter . to quit.
(f- (f* (frac 3 1)(frac 9 1)) (f+ (frac 1 1)(frac 2 1)))
Congratulations!
Please enter a 'Lisp' expression (regular or fractional math style) that equals 24,
using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 3758.
Enter . to quit.
(+ (* (- 8 5) 7) 3)
Congratulations!
Please enter a 'Lisp' expression (regular or fractional math style) that equals 24,
using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 3758.
Enter . to quit.
(f- (f* (frac 3 1)(frac 7 1)) (+ (frac 5 1)(frac 8 1)))
Using wrong number(s).
Illegal operator(s). If fractional expression, must use frac, f+, f-, f*, f/ only.
Please enter a 'Lisp' expression (regular or fractional math style) that equals 24,
using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 2713.
Enter . to quit.
(^ 2 7 1 3)
Using illegal operator(s).
Please enter a 'Lisp' expression (regular or fractional math style) that equals 24,
using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 8367.
Enter . to quit.
(+ 8 3 6)
Not all numbers used.
Please enter a 'Lisp' expression (regular or fractional math style) that equals 24,
using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 1635.
Enter . to quit.
.
bye!
</pre>
=={{header|PL/I}}==
<syntaxhighlight lang=pli>
/* Plays the game of 24. */
Line 1,710 ⟶ 9,577:
end TWENTYFOUR;
</syntaxhighlight>
=={{header|Potion}}==
<syntaxhighlight lang=Potion>is_num = (s):
x = s ord(0)
if (x >= "0"ord && x <= "9"ord): true.
else: false.
.
nums = (s):
res = ()
0 to (s length, (b):
c = s(b)
if (is_num(c)):
res push(c).
.)
res.
try = 1
while (true):
r = rand string
digits = (r(0),r(1),r(2),r(3))
"\nMy next four digits: " print
digits join(" ") say
digit_s = digits ins_sort string
("Your expression to create 24 (try ", try, "): ") print
entry = read slice(0,-1)
expr = entry eval
parse = nums(entry)
parse_s = parse clone ins_sort string
try++
if (parse length != 4):
("Wrong number of digits:", parse) say.
elsif (parse_s != digit_s):
("Wrong digits:", parse) say.
elsif (expr == 24):
"You won!" say
entry print, " => 24" say
return().
else:
(entry, " => ", expr string, " != 24") join("") say.
.</syntaxhighlight>
=={{header|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)
<syntaxhighlight lang=powershell>
CLS
Line 1,725 ⟶ 9,636:
}
$NumberArray = @()
While( $NumberArray.Count
$NumberArray +=
}
Write-Host @"
Welcome to the 24 game!
Here are your numbers: $($NumberArray -join ",").
Use division, multiplication, subtraction and addition to get 24 as a result with these 4 numbers.
"@
Do
Line 1,744 ⟶ 9,655:
$TempChar2 = $null
$Count = $null
$AllowableCharacters = $NumberArray + "+-*/()".ToCharArray()
$Result = Read-Host
Foreach($Char in $Result.ToCharArray())
{
}
If($Wrong -eq 1)
{
Line 1,825 ⟶ 9,700:
}
While($EndResult -ne 24)
</syntaxhighlight>
=={{header|ProDOS}}==
This example uses the math module:
<syntaxhighlight 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</syntaxhighlight>
=={{header|Prolog}}==
{{Works with|GNU Prolog}}
<syntaxhighlight lang=prolog>:- initialization(main).
answer(24).
play :- round, play ; true.
round :-
prompt(Ns), get_line(Input), Input \= "stop"
, ( phrase(parse(Ns,[]), Input) -> Result = 'correct'
; Result = 'wrong'
), write(Result), nl, nl
. % where
prompt(Ns) :- length(Ns,4), maplist(random(1,10), Ns)
, write('Digits: '), write(Ns), nl
.
parse([],[X]) --> { answer(X) }.
parse(Ns,[Y,X|S]) --> "+", { Z is X + Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "-", { Z is X - Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "*", { Z is X * Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "/", { Z is X div Y }, parse(Ns,[Z|S]).
parse(Ns,Stack) --> " ", parse(Ns,Stack).
parse(Ns,Stack) --> { select(N,Ns,Ns1), number_codes(N,[Code]) }
, [Code], parse(Ns1,[N|Stack])
.
get_line(Xs) :- get_code(X)
, ( X == 10 -> Xs = [] ; Xs = [X|Ys], get_line(Ys) )
.
main :- randomize, play, halt.</syntaxhighlight>
Example "session":
<pre>Digits: [9,4,6,9]
46*9-9+
correct
Digits: [7,4,7,8]
8 4 7 7 / - *
correct
Digits: [7,2,8,2]
7282---
wrong
Digits: [2,6,7,1]
4611***
wrong
Digits: [3,6,5,8]
+
wrong
Digits: [2,1,7,7]
stop</pre>
=={{header|PureBasic}}==
<
Global Dim digits(#digitCount - 1) ;holds random digits
Line 1,987 ⟶ 9,932:
Print(#CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</
{{out}}
<pre>The 24 Game
Line 2,006 ⟶ 9,951:
=={{header|Python}}==
===Python: Original, with output===
Uses eval, the built-in expression evaluator of infix expressions.
<syntaxhighlight lang=python>'''
The 24 Game
Line 2,073 ⟶ 10,019:
print ("Thats right!")
print ("Thank you and goodbye")
if __name__ == '__main__': main() </syntaxhighlight>
{{out}}
<pre>
The 24 Game
Line 2,095 ⟶ 10,042:
Expression 2: (3 - 2) * 6 * 4
= 24
Thank you and goodbye.</pre>
===Python: Alternative===
<syntaxhighlight lang=python>import random, re
chars = ["(",")","/","+","-","*"]
while True:
charsandints, ints = [], []
for x in range(4):
ints.append(str(random.randrange(1,10)))
charsandints = chars + ints
print "Numbers are:", ints
guess = raw_input("Enter your guess:")
if guess.lower() == "q":
break
elif guess.lower() == "|":
pass
else:
flag = True
for a in guess:
if a not in charsandints or guess.count(a) > charsandints.count(a):
flag = False
if re.search("\d\d", guess):
print "You cannot combine digits."
break
if flag:
print "Your result is: ", eval(guess)
if eval(guess) == 24:
print "You won"
break
else:
print "You lost"
break
else:
print "You cannot use anthing other than", charsandints
break
print "Thanks for playing"</syntaxhighlight>
=={{header|Quackery}}==
<code>switch</code>, <code>case</code>, and <code>otherwise</code> are defined at [[Metaprogramming#Quackery]].
<syntaxhighlight lang=Quackery> [ stack ] is operators ( --> s )
0 $ "*/+-" witheach [ bit | ]
operators put
[ stack ] is numbers ( --> s )
[ 0 swap
witheach [ bit | ]
numbers put ] is putnumbers ( $ --> )
[ $ "123456789" shuffle 4 split drop sort ] is choosenumbers ( --> $ )
[ say "Using any of the operators * / + -" cr
say "and each of the numbers "
witheach [ emit sp ] say "once," cr
say "enter an RPN expression equal to 24." cr
$ "Spaces between characters are optional: "
input ] is getexpression ( $ --> $ )
[ $ "" swap witheach
[ dup space = iff drop else join ] ] is stripspaces ( $ --> $ )
[ stack ] is opcount ( --> s )
[ stack ] is numcount ( --> s )
[ stack ] is numsused ( --> s )
[ true swap
0 opcount put
0 numcount put
0 numsused put
witheach
[ bit dup numbers share & iff
[ 1 numcount tally
numsused take | numsused put ]
else
[ operators share & if
[ 1 opcount tally ] ]
opcount share numcount share < not if
[ drop false conclude ] ]
numsused take
numbers share != if [ drop false ]
numcount take 4 != if [ drop false ]
opcount take 3 != if [ drop false ] ] is checkexpression ( $ --> b )
[ $ "" swap
witheach
[ dup char 0 char 9 1+ within iff
[ join $ " n->v " join ] done
[ switch
char * case [ $ "v* " join ]
char / case [ $ "v/ " join ]
char + case [ $ "v+ " join ]
char - case [ $ "v- " join ]
otherwise [ $ "Error!" fail ] ] ] ] is quackerise ( $ --> [ )
[ choosenumbers
dup putnumbers
[ dup getexpression
stripspaces
dup checkexpression not while
cr
say "Badly formed expression. Try again."
cr cr
drop again ]
nip
quackerise
quackery
cr
say "Your expression is equal to "
2dup 10 point$ echo$
24 n->v v- v0= iff
[ say ". :-)" ] else [ say ". :-(" ]
numbers release ] is game ( --> )</syntaxhighlight>
{{out}}
As a dialogue in the Quackery shell.
<pre>O> game
...
Using any of the operators * / + -
and each of the numbers 2 3 8 9 once,
enter an RPN expression equal to 24.
Spaces between characters are optional: 5 7 6 2 * + +
Your expression is equal to 24. :-)
Stack empty.
/O> game
...
Using any of the operators * / + -
and each of the numbers 2 3 8 9 once,
enter an RPN expression equal to 24.
Spaces between characters are optional: 2 + 5 + 8 + 9
Badly formed expression. Try again.
Using any of the operators * / + -
and each of the numbers 2 5 8 9 once,
enter an RPN expression equal to 24.
Spaces between characters are optional: 25+8+9+
Your expression is equal to 24. :-)
Stack empty.
/O> game
...
Using any of the operators * / + -
and each of the numbers 1 3 4 7 once,
enter an RPN expression equal to 24.
Spaces between characters are optional: 1 3 * 4 / 7 +
Your expression is equal to 7.75. :-(
Stack empty.
</pre>
=={{header|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.
<
selector=function() sample(1:9, 4, replace=TRUE),
arguments=selector(),
Line 2,112 ⟶ 10,215:
"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 {
Line 2,120 ⟶ 10,224:
`!`=newdigits(),
tryCatch({
expr <- parse(text=input, n=1)[[1]]
check.call(expr, operators, arguments)
result <- eval(expr)
Line 2,133 ⟶ 10,237:
}
check.call <- function(
else if
else x
}
leaves <- unlist(unexpr(expr))
if (any(disallowed <-
!leaves %in% c(lapply(operators, as.name),
as.list(arguments)))) {
stop("'", paste(sapply(leaves[disallowed], as.character),
collapse=", "),
"' not allowed. ")
}
numbers.used <- unlist(leaves[sapply(leaves, mode) == 'numeric'])
if (! isTRUE(all.equal(sort(numbers.used), sort(arguments))))
stop("Must use each number once.")
}</syntaxhighlight>
Example Session
<
Make 24 out of the numbers 1, 6, 7, 5 and the operators +, -, *, /, ( .
Line 2,172 ⟶ 10,277:
New digits: 1, 5, 2, 8
> (5-1)^2+8
> !
New digits: 2, 8, 5, 2
> 52-28
> (8-2)*(5-2/2)
Must use each number once.
Line 2,183 ⟶ 10,288:
> q
Goodbye!
</syntaxhighlight>
=={{header|
The functional interpreter of an expression given in the infix form.
It parses the S-expression representing the user's answer and handles
invalid cases.
<syntaxhighlight lang=racket>
#lang racket
(define (interprete expr numbers)
;; the cashe for used numbers
(define cashe numbers)
;; updating the cashe and handling invalid cases
(define (update-cashe! x)
(unless (member x numbers) (error "Number is not in the given set:" x))
(unless (member x cashe) (error "Number is used more
(set! cashe (remq x
;; the parser
(define parse
(match-lambda
;; parsing arythmetics
[`(,x ... + ,y ...) (+ (parse x) (parse y))]
[`(,x ... - ,y ...) (- (parse x) (parse y))]
[`(,x ... * ,y ...) (* (parse x) (parse y))]
[`(,x ... / ,y ...) (/ (parse x) (parse y))]
[`(,x ,op ,y ...) (error "Unknown operator: " op)]
;; opening redundant brackets
[`(,expr) (parse expr)]
;; parsing numbers
[(? number? x) (update-cashe! x) x]
;; unknown token
[x (error "Not a number: " x)]))
;; parse the expresion
(define result (parse expr))
;; return the result if cashe is empty
(if (empty? cashe)
result
(error "You didn`t use all numbers!")))
</syntaxhighlight>
Testing the interpreter:
<pre>
> (interprete '(1 - 2 * 3 + 8) '(1 2 3 8))
3
> (interprete '(1 - 2 * (3 + 8)) '(1 2 3 8))
-21
> (interprete '((1 - 2) * (3 + 8)) '(1 2 3 8))
-11
> (interprete '((1 - 2) * 3 + 8) '(1 2 3 8))
5
> (interprete '((1 - 2) * 3 + 8) '(1 2 3 4))
Number is not in the given set: 8
> (interprete '((1 - 2) * 3 + 2) '(1 2 3 3))
Number is used more times then it was given: 2
> (interprete '((1 - 2) ^ 3 + 2) '(1 2 3 2))
Unknown operator: ^
> (interprete '((1 - 2) * 3) '(1 2 3 2))
You didn`t use all numbers!
</pre>
The program which uses the interpreter to play the game:
<syntaxhighlight lang=racket>
;; starting the program
(define (start)
(displayln "Combine given four numbers using operations + - * / to get 24.")
(displayln "Input 'q' to quit or your answer like '1 - 3 * (2 + 3)'")
(new-game))
;; starting a new game
(define (new-game)
;; create a new number set
(define numbers (build-list 4 (λ (_) (+ 1 (random 9)))))
(apply printf "Your numbers: ~a ~a ~a ~a\n" numbers)
(new-input numbers))
;; processing a new user input
(define (new-input numbers)
;; if an exception is raized while processing, show the exeption message
;; and prompt for another input, but do not stop the program.
(with-handlers ([exn? (λ (exn)
(displayln (exn-message
(new-input
;; get the answer
(define user-expr (read-the-answer))
;; interprete it
(case user-expr
[(q) (display "Good buy!")]
[(n) (new-game)]
[else (define ans (interprete user-expr numbers))
(case ans
[(24) (printf "Indeed! ~a = 24\n" user-expr)
(new-game)]
[else (error "Wrong!" user-expr '= ans)])])))
;; reading and preparing the user's answer
;; "1 + 2 * (3 + 4)" --> '(1 + 2 * (3 + 4))
(define (read-the-answer)
(read (open-input-string (format "(~a)" (read-line)))))
</syntaxhighlight>
=={{header|Raku}}==
(formerly Perl 6)
{{works with|Rakudo|2015.12}}
<syntaxhighlight lang="raku" line>use MONKEY-SEE-NO-EVAL;
say "Here are your digits: ",
constant @digits = (1..9).roll(4)».Str;
grammar Exp24 {
rule exp { <term>+ % <op> }
rule term { '(' <exp> ')' | <@digits> }
token op { < + - * / > }
}
while my $exp = prompt "\n24? " {
if try Exp24.parse: $exp {
say "You win :)";
last;
} else {
say (
'Sorry. Try again.' xx 20,
'Try harder.' xx 5,
'Nope. Not even close.' xx 2,
'Are you five or something?',
'Come on, you can do better than that.'
).flat.pick
}
}
</syntaxhighlight>
The <code>MONKEY-SEE-NO-EVAL</code> pragma enables the dangerous <code>EVAL</code> function, which will compile and execute even user input. In this example, the grammar used to parse the input should ensure that only safe expressions are evaluated.
=={{header|Red}}==
<syntaxhighlight lang=Red>
Red []
print "Evaluation from left to right with no precedence, unless you use parenthesis." print ""
a: "123456789"
guess: ""
valid: ""
sucess: false
random/seed now/time
loop 4 [append valid last random a]
print ["The numbers are: " valid/1 ", " valid/2 ", " valid/3 " and " valid/4]
sort valid
insert valid " "
expr: [term ["+" | "-"] expr | term]
term: [primary ["*" | "/"] term | primary]
primary: [some digit | "(" expr ")"]
digit: charset valid
while [not sucess] [
guess: ask "Enter your expression: "
if guess = "q" [halt]
numbers: copy guess
sort numbers
numbers: take/last/part numbers 4
insert numbers " "
either (parse guess expr) and (valid = numbers) [
repeat i length? guess [insert at guess (i * 2) " "]
result: do guess
print ["The result of your expression is: " result]
if (result = 24) [sucess: true]
][
print "Something is wrong with the expression, try again."
]
]
print "You got it right!"
</syntaxhighlight>
Output:
<pre>
Evaluation from left to right with no precedence, unless you use parenthesis.
The numbers are: 7 , 1 , 9 and 3
Enter your expression: 7+1+9
Something is wrong with the expression, try again.
Enter your expression: 7+1+8+3
Something is wrong with the expression, try again.
Enter your expression: 1+7*(9/3)
The result of your expression is: 24
You got it right!
>>
</pre>
===Red: Alternative===
<syntaxhighlight lang=Red>
Red [
Title: "24 Game"
Author: "gltewalt"
]
op: charset "*/+-"
term: [opt "(" num opt ")"]
valid-expression: [term op term op term op term]
explode: func [val][
extract/into val 1 c: copy []
]
check-expression: does [
if "q" = e: ask "Enter expression: " [halt]
either parse trim/all e valid-expression [
either 24 = m: math to-block form explode e [
print ["You got it!" m]
][
print ["Not quite correct. That's" m]]
][
print "Invalid expression."
]
]
main: does [
numbers: collect [loop 4 [keep random 9]]
num: charset form numbers
print [newline "Using the following numbers, enter an expression that equals 24: (pmdas)" numbers]
if none? attempt [check-expression][print "Invalid expression."]
]
forever [main]
</syntaxhighlight>
=={{header|REXX}}==
A large part of this program deals with validating the user input (and issuing appropriate and meaningful error
<br>messages), and also that the digits presented to the user, do in fact, have a possible solution.
This REXX version uses an in─line documentation (for help).
<syntaxhighlight lang=rexx>/*REXX program helps the user find solutions to the game of 24.
╔═════════════════════════════════════════════════════════════════════════════╗
║ Argument is either of these forms: (blank) ║⌂
║ ssss ║⌂
║ ssss,total,limit ║⌂
║ ssss-ffff ║⌂
║ ssss-ffff,total,limit ║⌂
║ -ssss ║⌂
║ +ssss ║⌂
║ ║⌂
║ where SSSS and/or FFFF must be exactly four numerals (decimal digits) ║⌂
║ comprised soley of the numerals (digits) 1 ──► 9 (no zeroes). ║⌂
║ ║⌂
║ SSSS is the start, and FFFF is the end (inclusive). ║⌂
║ ║⌂
║ If ssss has a leading plus (+) sign, it's used as the digits, and ║⌂
║ the user is prompted to enter a solution (using those decimal digits). ║⌂
║ ║⌂
║ If ssss has a leading minus (-) sign, a solution is searched for and ║⌂
║ the user is told there is a solution (or not), but no solutions are shown).║⌂
║ ║⌂
║ If no argument is specified, this program generates four digits (no zeros) ║⌂
║ which has at least one solution, and shows the sorted digits to the user, ║⌂
║ requesting that they enter a solution (the digits used may be in any order).║⌂
║ ║⌂
║ If TOTAL is entered, it's the desired answer. The default is 24. ║⌂
║ If LIMIT is entered, it limits the number of solutions shown. ║⌂
║ ║⌂
║ A solution to be entered can be in the form of: ║
║ ║
║ digit1 operator digit2 operator digit3 operator digit4 ║
║ ║
║ where DIGITn is one of the digits shown (in any order), and ║
║ OPERATOR can be any one of: + - * / ║
║ ║
║ Parentheses () may be used in the normal manner for grouping, as well as ║
║ brackets [] or braces {}. Blanks can be used anywhere. ║
║ ║
║ I.E.: for the digits 3448 the following could be entered: 3*8 + (4-4) ║
╚═════════════════════════════════════════════════════════════════════════════╝ */
numeric digits 30 /*where rational arithmetic is needed. */
parse arg orig; uargs= orig /*get the guess from the command line*/
orig= space(orig, 0) /*remove all the blanks from ORIG. */
negatory= left(orig, 1)=='-' /*=1, suppresses showing. */
pository= left(orig, 1)=='+' /*=1, force pgm to use specific number.*/
if pository | negatory then orig=substr(orig,2) /*now, just use the absolute vaue. */
parse var orig orig ',' $ "," limit /*get optional total ($) and/or limit*/
parse var orig start '-' finish /*get start and finish (maybe). */
opers= '*' || "/+-" /*arithmetic opers; order is important.*/
ops= length(opers) /*the number of arithmetic operators. */
groupsym= space(' ( ) [ ] { } « » ', 0) /*the allowable grouping symbols. */
indent= left('', 30) /*indents the display of solutions. */
show= 1 /*=1, shows solutions (a semifore). */
digs= 123456789 /*numerals (digits) that can be used.*/
if $=='' then $= 24 /*the name (goal) of the game: (24) */
if limit=='' then limit= 1 /*=1, shows only one solution. */
__= copies('─', 8) /*used for output messages to the user.*/
abuttals = 0 /*=1, allows digit abuttal: 12+12 */
do j=1 for ops; o.j= substr(opers, j, 1) /*these are used for fast execution. */
end /*j*/
if \datatype(limit, 'N') then do; call ger limit "isn't numeric"; exit 13; end
limit= limit / 1 /*normalize the number for limit. */
if \datatype($, 'N') then do; call ger $ "isn't numeric"; exit 13; end
$= $ / 1 /*normalize the number for total. */
if start\=='' & \pository then do; call ranger start,finish; exit 1; end
show= 0 /*stop blabbing solutions in SOLVE. */
do forever while \negatory /*keep truckin' until a solution. */
x.= 0 /*way to hold unique expressions. */
rrrr= random(1111, 9999) /*get a random set of digits. */
if pos(0, rrrr)\==0 then iterate /*but don't the use of zeroes. */
if solve(rrrr)\==0 then leave /*try to solve for these digits. */
end /*forever*/
show= 1 /*enable SOLVE to show solutions. */
if pository then rrrr= start /*use what's specified. */
rrrr= sortc(rrrr) /*sort four elements. */
rd.= x.
do j=1 for 9; _= substr(rrrr, j, 1); rd._= #chrs(rrrr, _)
end /*j*/ /* [↑] count for each digit in RRRR. */
do guesses=1; say
say __ "Using the numerals (digits) " rrrr", enter an expression that equals " $
say right('(or ? or Quit):', 79)
pull y; uargs= y; y= space(y, 0) /*obtain user's response (expression). */
if abbrev('QUIT', y, 1) then exit 0 /*does the user want to quit this game?*/
if y=='?' then do j=2 for sourceline()-1; _= sourceline(j) /*get a line of pgm. */
if right(_, 1)=='⌂' then iterate /*ignore this doc part*/
say ' ' strip( left(_, 79), 'T') /*show " " " doc. */
if left(_, 1)=='╚' then iterate guesses
end /*j*/ /* [↑] use an in─line way to show help*/
_v= verify(y, digs || opers || groupsym) /*any illegal characters? */
if _v\==0 then do; call ger 'invalid character:' substr(y, _v, 1); iterate; end
if y='' then do; call validate y; iterate; end
do j=1 for length(y)-1 while \abuttals /*check for two adjacent decimal digits*/
if datatype( substr(y, j, 1), 'W') & datatype( substr(y, j+1, 1), 'W') then ,
do; call ger 'invalid use of digit abuttal:' substr(y, j, 2)
iterate guesses
end
end /*j*/
yy= translate(y, ')))', "]}»")
do j=1 for 9 while \abuttals /*check for a dig following a group sym*/
_= pos(')'j, yy) /*is there a string with: )DIGIT ? */
if _>0 then do; call ger 'invalid use of digit abuttal' substr(y, _, 2)
iterate guesses
end
end /*j*/
yd= #chrs(y, digs) /*count of legal digits 123456789 */
if yd<4 then do; call ger 'not enough numerals were entered.'; iterate guesses; end
if yd>4 then do; call ger 'too many numerals were entered.' ; iterate guesses; end
do j=1 for length(groupsym) by 2
if #chrs(y, substr(groupsym, j , 1))\==,
#chrs(y, substr(groupsym, j+1, 1)) then do; call ger 'mismatched' ,
substr(groupsym, j, 2)
iterate guesses
end
end /*j*/
do k=1 for 2 /*check for ** and // */
_= copies( substr( opers, k, 1), 2) /*only examine the first two operators.*/
end /*k*/
do j=1 for 9; if rd.j==0 then iterate; _d= #chrs(y, j)
if _d==rd.j then iterate
if _d<rd.j then call ger 'not enough' j "numerals were entered, must be" rd.j
else call ger 'too many' j "numerals were entered, must be" rd.j
iterate guesses
end /*j*/
y= translate(y, '()()', "[]{}") /*change extended grouping symbols──►()*/
interpret 'ans=(' y ") / 1" /*evalualte a normalized expression. */
oldDigs= digits() /*save current decimal digit setting. */
numeric digits digits()%2 /*normalize expresssion to less digits.*/
if ans/1=$ then leave guesses /*the expression calculates to 24. */
say __ "incorrect, " y"="ans /*issue an error message (incorrect). */
numeric digits oldDigs /*re─instate the decimal digs precision*/
end /*guesses*/
say; say center('┌─────────────────────┐', 79)
say center('│ │', 79)
say center('│ congratulations ! │', 79)
say center('│ │', 79)
say center('└─────────────────────┘', 79); say
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
#chrs:procedure; parse arg x,c; return length(x) - length( space( translate(x, , c), 0) )
div: procedure; parse arg q; if q=0 then q=1e9; return q /*tests if dividing by zero.*/
ger: say __ '***error*** for argument: ' uargs; say __ arg(1); errCode= 1; return 0
s: if arg(1)==1 then return arg(3); return word( arg(2) 's', 1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
ranger: parse arg ssss,ffff /*parse args passed to this sub. */
ffff= word(ffff ssss, 1) /*create a FFFF if necessary. */
do g=ssss to ffff /*process possible range of values. */
if pos(0, g)\==0 then iterate /*ignore any G number with zeroes. */
sols= solve(g); wols= sols
if sols==0 then wols= 'No' /*un─geek number of solutions (if any).*/
if negatory & sols\==0 then wols= 'A' /*found only the first solution? */
if sols==1 & limit==1 then wols= 'A'
say; say wols 'solution's(sols) "found for" g
if $\==24 then say 'for answers that equal' $
end /*g*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
solve: parse arg qqqq; finds= 0; x.=0; nq.= x. /*parse args passed to this function. */
if \validate(qqqq) then return -1
parse value '( (( )) )' with L LL RR R /*assign some static variables (fastly)*/
do jq=1 for 4; _= substr(qqqq,jq,1) /*count the number of each digit. */
nq._= nq._ + 1
end /*jq*/
gLO= 1111; gHI= 9999
if $==24 then do; gLO= 1118; gHI= 9993; end /*24: lowest poss.# that has solutions*/
do gggg=gLO to gHI; if pos(0, gggg)\==0 then iterate /*ignore values with zeroes.*/
if verify(gggg, qqqq)\==0 then iterate
if verify(qqqq, gggg)\==0 then iterate
ng.= 0
do jg=1 for 4; _= substr(gggg, jg, 1); g.jg= _; ng._= ng._ + 1
end /*jg*/ /* [↑] count the number of each digit.*/
do kg=1 for 9; if nq.kg\==ng.kg then iterate gggg
end /*kg*/ /* [↑] verify number has same # digits*/
do i=1 for ops /*insert operator after 1st numeral. */
do j=1 for ops /* " " " 2nd " */
do k=1 for ops /* " " " 3rd " */
do m=0 for 10; !.= /*nullify all grouping symbols (parens)*/
select /*used to generate grouped expressions.*/
when m==1 then do; !.1=L; !.3=R; end
when m==2 then do; !.1=L; !.5=R; end
when m==3 then do; !.1=L; !.3=R; !.4=L; !.6=R; end
when m==4 then do; !.2=L; !.5=R; end
when m==5 then do; !.2=L; !.6=R; end
when m==6 then do; !.1=LL; !.5=R; !.6=R; end
when m==7 then do; !.2=LL; !.5=R; !.6=R; end
when m==8 then do; !.1=L; !.2=L; !.6=RR; end
when m==9 then do; !.2=L; !.4=L; !.6=RR; end
otherwise nop
end /*select*/
e= space(!.1 g.1 o.i !.2 g.2 !.3 o.j !.4 g.3 !.5 o.k g.4 !.6, 0)
if x.e then iterate /*was the expression already used? */
x.e= 1 /*mark this expression as being used. */
origE= e /*keep original version for the display*/
pd= pos('/(', e) /*find pos of /( in E. */
if pd\==0 then do /*Found? Might have possible ÷ by zero*/
eo= e
lr= lastpos(')', e) /*find the last right parenthesis. */
lm= pos('-', e, pd+1) /*find a minus sign (-) after ( */
if lm>pd & lm<lr then e= changestr('/(',e,"/div(") /*change*/
if eo\==e then if x.e then iterate /*expression already used?*/
x.e= 1 /*mark this expression as being used. */
end
interpret 'x=(' e ") / 1" /*have REXX do the heavy lifting here. */
if x\==$ then do /*Not correct? Then try again. */
numeric digits 9; x= x / 1 /*re─do evaluation.*/
numeric digits 12 /*re─instate digits*/
if x\==$ then iterate /*Not correct? Then try again. */
end
finds= finds + 1 /*bump number of found solutions. */
if \show | negatory then return finds
_= translate(origE, '][', ")(") /*display [], not (). */
if show then say indent 'a solution for' gggg':' $"=" _ /*show solution.*/
if limit==1 & finds==limit then leave gggg /*leave big loop*/
end /*m*/
end /*k*/
end /*j*/
end /*i*/
end /*gggg*/
return finds
/*──────────────────────────────────────────────────────────────────────────────────────*/
sortc: procedure; arg nnnn; @.= /*sorts the digits of NNNN */
do i=1 for length(nnnn); _= substr(nnnn, i, 1); @._= @._||_; end /*i*/
return @.0 || @.1 || @.2 || @.3 || @.4 || @.5 || @.6 || @.7 || @.8 || @.9
/*──────────────────────────────────────────────────────────────────────────────────────*/
validate: parse arg y; errCode= 0; _v= verify(y, digs)
select
when y=='' then call ger 'no digits were entered.'
when length(y)<4 then call ger 'not enough digits entered, must be 4'
when length(y)>4 then call ger 'too many digits entered, must be 4'
when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)"
when _v\==0 then call ger 'illegal character:' substr(y, _v, 1)
otherwise nop
end /*select*/</syntaxhighlight>
Some older REXXes don't have a '''changestr''' BIF, so one is included here ──► [[CHANGESTR.REX]].
{{out|output|text= of a sample execution:}}
<pre>
──────── Using the numerals (digits) 1689, enter an expression that equals 24
(or ? or Quit):
8 * {9-6} / 1 ◄■■■■■■■■■■■■■■ this is the user input.
┌─────────────────────┐
│ │
│ congratulations ! │
│ │
└─────────────────────┘
</pre>
=={{header|Ring}}==
<syntaxhighlight lang=ring>
# Project : 24 game
load "stdlib.ring"
digits = list(4)
check = list(4)
for choice = 1 to 4
digits[choice] = random(9)
next
see "enter an equation (using all of, and only, the single digits " + nl
for index = 1 to 4
see digits[index]
if index != 4
see " "
ok
next
see ")"
see " which evaluates to exactly 24. only multiplication (*), division (/)," + nl
see "addition (+) & subtraction (-) operations and parentheses are allowed:" + nl
see "24 = "
give equation
see "equation = " + equation + nl
while true
for char = 1 to len(equation)
digit = substr("0123456789", equation[char]) - 1
if digit >= 0
for index = 1 to 4
if digit = digits[index]
if not check[index]
check[index] = 1
exit
ok
ok
next
if index > 4
see "sorry, you used the illegal digit " + digit + nl
exit 2
ok
ok
next
for index = 1 to 4
if check[index] = 0
see "sorry, you failed to use the digit " + digits[index] + nl
exit 2
ok
next
for pair = 11 to 99
if substr(equation, string(pair))
see "sorry, you may not use a pair of digits " + pair + nl
ok
next
eval("result = " + equation)
if result = 24
see "congratulations, you succeeded in the task!" + nl
exit
else
see "sorry, your equation evaluated to " + result + " rather than 24!" + nl
ok
end
</syntaxhighlight>
Output:
<pre>
enter an equation (using all of, and only, the single digits
3 1 4 5) which evaluates to exactly 24. only multiplication (*), division (/),
addition (+) & subtraction (-) operations and parentheses are allowed:
24 = 4*5+3+1
equation = 4*5+3+1
congratulations, you succeeded in the task!
enter an equation (using all of, and only, the single digits
5 7 2 5) which evaluates to exactly 24. only multiplication (*), division (/),
addition (+) & subtraction (-) operations and parentheses are allowed:
24 = 98+72
equation = 98+72
sorry, you used the illegal digit 9
</pre>
=={{header|RPL}}==
{{works with|RPL|HP49-C #2.15}}
« '''IF''' DUP TYPE 9. ≠ '''THEN''' { } + <span style="color:grey">@ ''stack contains a number''</span>
'''ELSE'''
'''CASE''' OBJ→ SWAP 2. ≠ '''THEN''' DROP 0 '''END''' <span style="color:grey">@ ''stack contains a monadic operator''</span>
"+-*/" SWAP →STR POS NOT '''THEN''' DROP 0 '''END''' <span style="color:grey">@ ''stack contains a forbidden dyadic operator''</span>
'''END'''
<span style="color:blue">GET4</span> SWAP <span style="color:blue">GET4</span> +
'''END'''
» '<span style="color:blue">GET4</span>' STO <span style="color:grey">@ ''( 'expression' → { numbers } )''</span>
« 1 CF
« RAND 9 * CEIL R→I » 'x' 1 4 1 SEQ SORT <span style="color:grey">@ generate 4 numbers</span>
'''WHILE''' 1 FC? '''REPEAT'''
"Make 24 with" OVER →STR 2 OVER SIZE 2 - SUB +
{ "'" ALG V } INPUT <span style="color:grey">@ asks for an evaluable string</span>
CLLCD DUP TAIL 1 DISP
STR→ DUP <span style="color:blue">GET4</span>
'''CASE''' DUP 0 POS '''THEN''' DROP2 "Forbidden operator" '''END'''
SORT 3 PICK ≠ '''THEN''' DROP "Bad number" '''END'''
EVAL DUP →NUM 3 DISP 24 == '''THEN''' 1 SF "You won!" '''END'''
"Failed to get 24"
'''END'''
2 DISP 2 WAIT
'''END''' DROP
» '<span style="color:blue">GAM24</span>' STO
=={{header|Ruby}}==
<syntaxhighlight lang=ruby>class Guess < String
def self.play
nums = Array.new(4){rand(1..9)}
loop do
result = get(nums).evaluate!
break if result == 24.0
puts "Try again! That gives #{result}!"
end
puts "You win!"
end
def self.get(nums)
loop do
print "\nEnter a guess using #{nums}: "
input = gets.chomp
return new(input) if validate(input, nums)
end
end
def self.validate(guess, nums)
name, error =
{
invalid_character: ->(str){ !str.scan(%r{[^\d\s()+*/-]}).empty? },
wrong_number: ->(str){ str.scan(/\d/).map(&:to_i).sort != nums.sort },
multi_digit_number: ->(str){ str.match(/\d\d/) }
}
.find {|name, validator| validator[guess] }
error ? puts("Invalid input of a(n) #{name.to_s.tr('_',' ')}!") : true
end
def evaluate!
as_rat = gsub(/(\d)/, '\1r') # r : Rational suffix
eval "(#{as_rat}).to_f"
rescue SyntaxError
Line 2,498 ⟶ 10,936:
end
Guess.play</
=={{header|Rust}}==
The solution below converts the infix notation to RPN and then calculates the result.
I am still new to Rust so i am certain it could be written in a shorter way.
So if there is someone better than me please feel free to improve.
{{libheader|rand}}
<syntaxhighlight lang=rust>use std::io::{self,BufRead};
extern crate rand;
use rand::Rng;
fn op_type(x: char) -> i32{
match x {
'-' | '+' => return 1,
'/' | '*' => return 2,
'(' | ')' => return -1,
_ => return 0,
}
}
fn to_rpn(input: &mut String){
let mut rpn_string : String = String::new();
let mut rpn_stack : String = String::new();
let mut last_token = '#';
for token in input.chars(){
if token.is_digit(10) {
rpn_string.push(token);
}
else if op_type(token) == 0 {
continue;
}
else if op_type(token) > op_type(last_token) || token == '(' {
rpn_stack.push(token);
last_token=token;
}
else {
while let Some(top) = rpn_stack.pop() {
if top=='(' {
break;
}
rpn_string.push(top);
}
if token != ')'{
rpn_stack.push(token);
}
}
}
while let Some(top) = rpn_stack.pop() {
rpn_string.push(top);
}
println!("you formula results in {}", rpn_string);
*input=rpn_string;
}
fn calculate(input: &String, list : &mut [u32;4]) -> f32{
let mut stack : Vec<f32> = Vec::new();
let mut accumulator : f32 = 0.0;
for token in input.chars(){
if token.is_digit(10) {
let test = token.to_digit(10).unwrap() as u32;
match list.iter().position(|&x| x == test){
Some(idx) => list[idx]=10 ,
_ => println!(" invalid digit: {} ",test),
}
stack.push(accumulator);
accumulator = test as f32;
}else{
let a = stack.pop().unwrap();
accumulator = match token {
'-' => a-accumulator,
'+' => a+accumulator,
'/' => a/accumulator,
'*' => a*accumulator,
_ => {accumulator},//NOP
};
}
}
println!("you formula results in {}",accumulator);
accumulator
}
fn main() {
let mut rng = rand::thread_rng();
let mut list :[u32;4]=[rng.gen::<u32>()%10,rng.gen::<u32>()%10,rng.gen::<u32>()%10,rng.gen::<u32>()%10];
println!("form 24 with using + - / * {:?}",list);
//get user input
let mut input = String::new();
io::stdin().read_line(&mut input).unwrap();
//convert to rpn
to_rpn(&mut input);
let result = calculate(&input, &mut list);
if list.iter().any(|&list| list !=10){
println!("and you used all numbers");
match result {
24.0 => println!("you won"),
_ => println!("but your formulla doesn't result in 24"),
}
}else{
println!("you didn't use all the numbers");
}
}</syntaxhighlight>
=={{header|Scala}}==
Line 2,506 ⟶ 11,053:
Only problems with solution are shown to the user.
<div style='width: full; overflow: scroll'><
def main(args: Array[String]) {
import Parser.TwentyFourParser
Line 2,659 ⟶ 11,206:
}
}
}</
{{out}}
<pre>
C:\Workset>scala TwentyFourGame
Line 2,695 ⟶ 11,242:
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.
<
(require srfi/27 srfi/1) ;; random-integer, every
Line 2,758 ⟶ 11,305:
(provide play)
</syntaxhighlight>
{{out}}
<pre>
> (require "24game.ss")
Line 2,789 ⟶ 11,336:
You win!
</pre>
=={{header|Sidef}}==
<syntaxhighlight lang=ruby>const digits = (1..9 -> pick(4))
const grammar = Regex(
'^ (?&exp) \z
(?(DEFINE)
(?<exp> ( (?&term) (?&op) (?&term) )+ )
(?<term> \( (?&exp) \) | [' + digits.join + '])
(?<op> [\-+*/] )
)', 'x'
)
say "Here are your digits: #{digits.join(' ')}"
loop {
var input = read("Expression: ", String)
var expr = input
expr -= /\s+/g # remove all whitespace
if (input == 'q') {
say "Goodbye. Sorry you couldn't win."
break
}
var given_digits = digits.map{.to_s}.sort.join
var entry_digits = input.scan(/\d/).sort.join
if ((given_digits != entry_digits) || (expr !~ grammar)) {
say "That's not valid"
next
}
given(var n = eval(input)) {
when (24) { say "You win!"; break }
default { say "Sorry, your expression is #{n}, not 24" }
}
}</syntaxhighlight>
{{out}}
<pre>
Here are your digits: 8 2 3 4
Expression: 8 * (2 - (3 + 4))
Sorry, your expression is -40, not 24
Expression: 8 * (2 - (3 -
That's not valid
Expression: 8 * (2 - (3 - 4))
You win!
</pre>
=={{header|Simula}}==
<syntaxhighlight lang=simula>BEGIN
CLASS EXPR;
BEGIN
REAL PROCEDURE POP;
BEGIN
IF STACKPOS > 0 THEN
BEGIN STACKPOS := STACKPOS - 1; POP := STACK(STACKPOS); END;
END POP;
PROCEDURE PUSH(NEWTOP); REAL NEWTOP;
BEGIN
STACK(STACKPOS) := NEWTOP;
STACKPOS := STACKPOS + 1;
END PUSH;
REAL PROCEDURE CALC(OPERATOR, ERR); CHARACTER OPERATOR; LABEL ERR;
BEGIN
REAL X, Y; X := POP; Y := POP;
IF OPERATOR = '+' THEN PUSH(Y + X)
ELSE IF OPERATOR = '-' THEN PUSH(Y - X)
ELSE IF OPERATOR = '*' THEN PUSH(Y * X)
ELSE IF OPERATOR = '/' THEN BEGIN
IF X = 0 THEN
BEGIN
EVALUATEDERR :- "DIV BY ZERO";
GOTO ERR;
END;
PUSH(Y / X);
END
ELSE
BEGIN
EVALUATEDERR :- "UNKNOWN OPERATOR";
GOTO ERR;
END
END CALC;
PROCEDURE READCHAR(CH); NAME CH; CHARACTER CH;
BEGIN
IF T.MORE THEN CH := T.GETCHAR ELSE CH := EOT;
END READCHAR;
PROCEDURE SKIPWHITESPACE(CH); NAME CH; CHARACTER CH;
BEGIN
WHILE (CH = SPACE) OR (CH = TAB) OR (CH = CR) OR (CH = LF) DO
READCHAR(CH);
END SKIPWHITESPACE;
PROCEDURE BUSYBOX(OP, ERR); INTEGER OP; LABEL ERR;
BEGIN
CHARACTER OPERATOR;
REAL NUMBR;
BOOLEAN NEGATIVE;
SKIPWHITESPACE(CH);
IF OP = EXPRESSION THEN
BEGIN
NEGATIVE := FALSE;
WHILE (CH = '+') OR (CH = '-') DO
BEGIN
IF CH = '-' THEN NEGATIVE := NOT NEGATIVE;
READCHAR(CH);
END;
BUSYBOX(TERM, ERR);
IF NEGATIVE THEN
BEGIN
NUMBR := POP; PUSH(0 - NUMBR);
END;
WHILE (CH = '+') OR (CH = '-') DO
BEGIN
OPERATOR := CH; READCHAR(CH);
BUSYBOX(TERM, ERR); CALC(OPERATOR, ERR);
END;
END
ELSE IF OP = TERM THEN
BEGIN
BUSYBOX(FACTOR, ERR);
WHILE (CH = '*') OR (CH = '/') DO
BEGIN
OPERATOR := CH; READCHAR(CH);
BUSYBOX(FACTOR, ERR); CALC(OPERATOR, ERR)
END
END
ELSE IF OP = FACTOR THEN
BEGIN
IF (CH = '+') OR (CH = '-') THEN
BUSYBOX(EXPRESSION, ERR)
ELSE IF (CH >= '0') AND (CH <= '9') THEN
BUSYBOX(NUMBER, ERR)
ELSE IF CH = '(' THEN
BEGIN
READCHAR(CH);
BUSYBOX(EXPRESSION, ERR);
IF CH = ')' THEN READCHAR(CH) ELSE GOTO ERR;
END
ELSE GOTO ERR;
END
ELSE IF OP = NUMBER THEN
BEGIN
NUMBR := 0;
WHILE (CH >= '0') AND (CH <= '9') DO
BEGIN
NUMBR := 10 * NUMBR + RANK(CH) - RANK('0'); READCHAR(CH);
END;
IF CH = '.' THEN
BEGIN
REAL FAKTOR;
READCHAR(CH);
FAKTOR := 10;
WHILE (CH >= '0') AND (CH <= '9') DO
BEGIN
NUMBR := NUMBR + (RANK(CH) - RANK('0')) / FAKTOR;
FAKTOR := 10 * FAKTOR;
READCHAR(CH);
END;
END;
PUSH(NUMBR);
END;
SKIPWHITESPACE(CH);
END BUSYBOX;
BOOLEAN PROCEDURE EVAL(INP); TEXT INP;
BEGIN
EVALUATEDERR :- NOTEXT;
STACKPOS := 0;
T :- COPY(INP.STRIP);
READCHAR(CH);
BUSYBOX(EXPRESSION, ERRORLABEL);
! OUTTEXT("T = '");
! OUTTEXT(T);
! OUTTEXT("'");
! OUTTEXT(", T.POS = ");
! OUTINT(T.POS, 0);
! OUTTEXT(", STACKPOS = ");
! OUTINT(STACKPOS, 0);
! OUTTEXT(", T.MORE = ");
! OUTCHAR(IF T.MORE THEN 'T' ELSE 'F');
! OUTTEXT(", CH = ");
! OUTCHAR(CH);
! OUTIMAGE;
IF NOT T.MORE AND STACKPOS = 1 AND CH = EOT THEN
BEGIN
EVALUATED := POP;
EVAL := TRUE;
GOTO NOERRORLABEL;
END;
ERRORLABEL:
EVAL := FALSE;
IF EVALUATEDERR = NOTEXT THEN
EVALUATEDERR :- "INVALID EXPRESSION: " & INP;
NOERRORLABEL:
END EVAL;
REAL PROCEDURE RESULT;
RESULT := EVALUATED;
TEXT PROCEDURE ERR;
ERR :- EVALUATEDERR;
TEXT T;
INTEGER EXPRESSION;
INTEGER TERM;
INTEGER FACTOR;
INTEGER NUMBER;
CHARACTER TAB;
CHARACTER LF;
CHARACTER CR;
CHARACTER SPACE;
CHARACTER EOT;
CHARACTER CH;
REAL ARRAY STACK(0:31);
INTEGER STACKPOS;
REAL EVALUATED;
TEXT EVALUATEDERR;
EXPRESSION := 1;
TERM := 2;
FACTOR := 3;
NUMBER := 4;
TAB := CHAR(9);
LF := CHAR(10);
CR := CHAR(13);
SPACE := CHAR(32);
EOT := CHAR(0);
END EXPR;
INTEGER ARRAY DIGITS(1:4);
INTEGER SEED, I;
REF(EXPR) E;
E :- NEW EXPR;
OUTTEXT("ENTER RANDOM SEED: ");
OUTIMAGE;
SEED := ININT;
FOR I := 1 STEP 1 UNTIL 4 DO DIGITS(I) := RANDINT(0, 9, SEED);
L: BEGIN
INTEGER ARRAY DIGITSUSED(0:9);
INTEGER ARRAY DIGITSTAKEN(0:9);
CHARACTER C, LASTC;
TEXT INP;
LASTC := CHAR(0);
OUTTEXT("MAKE 24 USING THESE DIGITS: ");
FOR I := 1 STEP 1 UNTIL 4 DO
BEGIN
OUTINT(DIGITS(I), 2);
DIGITSUSED( DIGITS(I) ) := DIGITSUSED( DIGITS(I) ) + 1;
END;
OUTIMAGE;
INIMAGE;
INP :- COPY(SYSIN.IMAGE.STRIP);
OUTIMAGE;
WHILE INP.MORE DO
BEGIN
C := INP.GETCHAR;
IF (C >= '0') AND (C <= '9') THEN
BEGIN
INTEGER D;
IF (LASTC >= '0') AND (LASTC <= '9') THEN
BEGIN
OUTTEXT("NUMBER HAS TOO MANY DIGITS: ");
OUTCHAR(LASTC);
OUTCHAR(C);
OUTIMAGE;
GOTO L;
END;
D := RANK(C) - RANK('0');
DIGITSTAKEN(D) := DIGITSTAKEN(D) + 1;
END
ELSE IF NOT ((C = '+') OR (C = '-') OR (C = '/') OR (C = '*') OR
(C = ' ') OR (C = '(') OR (C = ')')) THEN
BEGIN
OUTTEXT("ILLEGAL INPUT CHARACTER: ");
OUTCHAR(C);
OUTIMAGE;
GOTO L;
END;
LASTC := C;
END;
FOR I := 0 STEP 1 UNTIL 9 DO
BEGIN
IF DIGITSUSED(I) <> DIGITSTAKEN(I) THEN
BEGIN
OUTTEXT("NOT THE SAME DIGITS.");
OUTIMAGE;
GOTO L;
END;
END;
IF E.EVAL(INP) THEN
BEGIN
OUTTEXT("RESULT IS ");
OUTFIX(E.RESULT, 4, 10);
OUTIMAGE;
OUTTEXT(IF ABS(E.RESULT - 24) < 0.001
THEN "YOU WIN"
ELSE "YOU LOOSE");
OUTIMAGE;
END
ELSE
BEGIN
OUTTEXT(E.ERR);
OUTIMAGE;
END;
END;
END.
</syntaxhighlight>
{{out}}
<pre>
ENTER RANDOM SEED:
</pre>
{{in}}
<pre>
787
</pre>
{{out}}
<pre>
MAKE 24 USING THESE DIGITS: 6 7 3 9
</pre>
{{in}}
<pre>
(9 - 7 + 6) * 3
</pre>
{{out}}
<pre>
RESULT IS 24.0000
YOU WIN
</pre>
=={{header|Swift}}==
<syntaxhighlight lang=swift>import Darwin
import Foundation
println("24 Game")
println("Generating 4 digits...")
func randomDigits() -> Int[] {
var result = Int[]();
for var i = 0; i < 4; i++ {
result.append(Int(arc4random_uniform(9)+1))
}
return result;
}
// Choose 4 digits
let digits = randomDigits()
print("Make 24 using these digits : ")
for digit in digits {
print("\(digit) ")
}
println()
// get input from operator
var input = NSString(data:NSFileHandle.fileHandleWithStandardInput().availableData, encoding:NSUTF8StringEncoding)
var enteredDigits = Int[]()
var enteredOperations = Character[]()
let inputString = input as String
// store input in the appropriate table
for character in inputString {
switch character {
case "1", "2", "3", "4", "5", "6", "7", "8", "9":
let digit = String(character)
enteredDigits.append(digit.toInt()!)
case "+", "-", "*", "/":
enteredOperations.append(character)
case "\n":
println()
default:
println("Invalid expression")
}
}
// check value of expression provided by the operator
var value = Int()
if enteredDigits.count == 4 && enteredOperations.count == 3 {
value = enteredDigits[0]
for (i, operation) in enumerate(enteredOperations) {
switch operation {
case "+":
value = value + enteredDigits[i+1]
case "-":
value = value - enteredDigits[i+1]
case "*":
value = value * enteredDigits[i+1]
case "/":
value = value / enteredDigits[i+1]
default:
println("This message should never happen!")
}
}
}
if value != 24 {
println("The value of the provided expression is \(value) instead of 24!")
} else {
println("Congratulations, you found a solution!")
}
</syntaxhighlight>
=={{header|Tcl}}==
{{trans|Python}}
This version also terminates cleanly on end-of-file.
<
proc choose4 {} {
set digits {}
Line 2,867 ⟶ 11,859:
puts "Thank you and goodbye"
}
main</
=={{header|TorqueScript}}==
Includes an equation parser to avoid using eval.
To use, type startTwentyFourGame(); in the console.
<syntaxhighlight lang=Torque>function startTwentyFourGame()
{
if($numbers !$= "")
{
echo("Ending current 24 game...");
endTwentyFourGame();
}
echo("Welcome to the 24 game!");
echo("Generating 4 numbers...");
for(%a = 0; %a < 4; %a++)
$numbers = setWord($numbers, %a, getRandom(0, 9));
echo("Numbers generated! Here are your numbers:");
echo($numbers);
echo("Use try24Equation( equation ); to try and guess the equation.");
$TwentyFourGame = 1;
}
function endTwentyFourGame()
{
if(!$TwentyFourGame)
{
echo("No 24 game is active!");
return false;
}
echo("Ending the 24 game.");
$numbers = "";
$TwentyFourGame = 0;
}
function try24Equation(%equ)
{
if(!$TwentyFourGame)
{
echo("No 24 game is active!");
return false;
}
%numbers = "0123456789";
%operators = "+-*x/()";
%tempchars = $numbers;
%other = strReplace(%tempchars, " ", "");
//Check it and make sure it has all the stuff
%equ = strReplace(%equ, " ", "");
%length = strLen(%equ);
for(%a = 0; %a < %Length; %a++)
{
%Char = getSubStr(%equ, %a, 1);
if(%a+1 != %Length)
%Next = getSubStr(%equ, %a+1, 1);
else
%Next = " ";
if(strPos(%numbers @ %operators, %char) < 0)
{
echo("The equation you entered is invalid! Try again.");
return false;
}
if(strPos(%tempchars, %char) < 0 && strPos(%operators, %char) < 0)
{
echo("The equation you entered uses a number you were not given! Try again.");
return false;
}
else if(strPos(%numbers, %next) >= 0 && strPos(%numbers, %char) >= 0)
{
echo("No numbers above 9 please! Try again.");
echo(%next SPC %char SPC %a);
return false;
}
else if(strPos(%operators, %char) > 0)
continue;
%pos = 2*strPos(%other, %char);
if(%pos < 0)
return "ERROROMG";
//Remove it from the allowed numbers
%tempchars = removeWord(%tempchars, %pos/2);
%other = getSubStr(%other, 0, %pos) @ getSubStr(%other, %pos+1, strLen(%other));
}
%result = doEquation(%equ);
if(%result != 24)
{
echo("Your equation resulted to" SPC %result @ ", not 24! Try again.");
return false;
}
for(%a = 0; %a < 4; %a++)
$numbers = setWord($numbers, %a, getRandom(0, 9));
echo("Great job!" SPC %equ SPC "Does result to 24! Here's another set for you:");
echo($numbers);
}
//Evaluates an equation without using eval.
function doEquation(%equ)
{ //Validate the input
%equ = strReplace(%equ, " ", "");%equ = strReplace(%equ, "*", "x");
%equ = strReplace(%equ, "+", " + ");%equ = strReplace(%equ, "x", " x ");
%equ = strReplace(%equ, "/", " / ");%equ = strReplace(%equ, "-", " - ");
//Parenthesis'
while(strPos(%equ, "(") > -1 && strPos(%equ, ")") > 0)
{
%start = strPos(%equ, "(");
%end = %start;
%level = 1;
while(%level != 0 && %end != strLen(%equ))
{
%end++;
if(getsubStr(%equ, %end, 1) $= "(") %level++;
if(getsubStr(%equ, %end, 1) $= ")") %level--;
}
if(%level != 0)
return "ERROR";
%inbrackets = getsubStr(%equ, %start+1, %end - strLen(getsubStr(%equ, 0, %start + 1)));
%leftofbrackets = getsubStr(%equ, 0, %start);
%rightofbrackets = getsubStr(%equ, %end + 1, strLen(%equ) - %end);
%equ = %leftofbrackets @ doEquation(%inbrackets) @ %rightofbrackets;
}
if(strPos(%equ, "ERROR") >= 0)
return "ERROR";
//Multiplication/Division loop
for(%a = 0; %a < getWordCount(%equ); %a++)
{
if(getWord(%equ, %a) $= "x" || getWord(%equ, %a) $= "/" && %a != 0)
{
%f = getWord(%equ, %a - 1);
%l = getWord(%equ, %a + 1);
%o = getWord(%equ, %a);
switch$(%o)
{
case "x": %a--;
%equ = removeWord(removeWord(setWord(%equ, %a+1, %f * %l), %a+2), %a);
case "/": %a--;
%equ = removeWord(removeWord(setWord(%equ, %a+1, %f / %l), %a+2), %a);
}
}
}
//Addition/Subraction loop
for(%a = 0; %a < getWordCount(%equ); %a++)
{
if(getWord(%equ, %a) $= "+" || getWord(%equ, %a) $= "-" && %a != 0)
{
%f = getWord(%equ, %a - 1);
%l = getWord(%equ, %a + 1);
%o = getWord(%equ, %a);
switch$(%o)
{
case "+": %a--;
%equ = removeWord(removeWord(setWord(%equ, %a+1, %f + %l), %a+2), %a);
case "-": %a--;
%equ = removeWord(removeWord(setWord(%equ, %a+1, %f - %l), %a+2), %a);
}
}
}
return %equ;
}</syntaxhighlight>
=={{header|TUSCRIPT}}==
<
$$ MODE TUSCRIPT
BUILD X_TABLE blanks = ":': :"
Line 2,943 ⟶ 12,107:
ENDSECTION
DO game
</syntaxhighlight>
{{out}}
<pre style='height:30ex;overflow:scroll'>
Your numbers 2 8 9 9
Line 2,967 ⟶ 12,131:
BINGO (2+4+2)*3 equates 24
</pre>
{{omit from|GUISS}}
{{omit from|ML/I}}
=={{header|UNIX Shell}}==
Tried to be POSIX. Not sure about corner-cases.
<syntaxhighlight lang=bash>gen_digits() {
awk 'BEGIN { srand()
for(i = 1; i <= 4; i++) print 1 + int(9 * rand())
}' | sort
}
same_digits() {
[ "$(tr -dc 0-9 | sed 's/./&\n/g' | grep . | sort)" = "$*" ]
}
guessed() {
[ "$(echo "$1" | tr -dc '\n0-9()*/+-' | bc 2>/dev/null)" = 24 ]
}
while :
do
digits=$(gen_digits)
echo
echo Digits: $digits
read -r expr
echo " $expr" | same_digits "$digits" || \
{ echo digits should be: $digits; continue; }
guessed "$expr" && message=correct \
|| message=wrong
echo $message
done</syntaxhighlight>
=={{header|VBA}}==
<syntaxhighlight lang=vb>
Sub Rosetta_24game()
Dim Digit(4) As Integer, i As Integer, iDigitCount As Integer
Dim stUserExpression As String
Dim stFailMessage As String, stFailDigits As String
Dim bValidExpression As Boolean, bValidDigits As Boolean, bValidChars As Boolean
Dim vResult As Variant, vTryAgain As Variant, vSameDigits As Variant
' Generate 4 random digits
GenerateNewDigits:
For i = 1 To 4
Digit(i) = [randbetween(1,9)]
Next i
' Get user expression
GetUserExpression:
bValidExpression = True
stFailMessage = ""
stFailDigits = ""
stUserExpression = InputBox("Enter a mathematical expression which results in 24, using the following digits: " & _
Digit(1) & ", " & Digit(2) & ", " & Digit(3) & " and " & Digit(4), "Rosetta Code | 24 Game")
' Check each digit is included in user expression
bValidDigits = True
stFailDigits = ""
For i = 1 To 4
If InStr(stUserExpression, Digit(i)) = 0 Then
bValidDigits = False
stFailDigits = stFailDigits & " " & Digit(i)
End If
Next i
If bValidDigits = False Then
bValidExpression = False
stFailMessage = "Your expression excluded the following required digits: " & stFailDigits & vbCr & vbCr
End If
' Check each character of user expression is a valid character type
bValidDigits = True
stFailDigits = ""
For i = 1 To Len(stUserExpression)
If InStr("0123456789+-*/()", Mid(stUserExpression, i, 1)) = 0 Then
bValidDigits = False
stFailDigits = stFailDigits & " " & Mid(stUserExpression, i, 1)
End If
Next i
If bValidDigits = False Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained invalid characters:" & stFailDigits & vbCr & vbCr
End If
' Check no disallowed integers entered
bValidDigits = True
stFailDigits = ""
iDigitCount = 0
For i = 1 To Len(stUserExpression)
If Not InStr("0123456789", Mid(stUserExpression, i, 1)) = 0 Then
iDigitCount = iDigitCount + 1
If IsError(Application.Match(--(Mid(stUserExpression, i, 1)), Digit, False)) Then
bValidDigits = False
stFailDigits = stFailDigits & " " & Mid(stUserExpression, i, 1)
End If
End If
Next i
If iDigitCount > 4 Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained more than 4 digits" & vbCr & vbCr
End If
If iDigitCount < 4 Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained less than 4 digits" & vbCr & vbCr
End If
If bValidDigits = False Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained invalid digits:" & stFailDigits & vbCr & vbCr
End If
' Check no double digit numbers entered
bValidDigits = True
stFailDigits = ""
For i = 11 To 99
If Not InStr(stUserExpression, i) = 0 Then
bValidDigits = False
stFailDigits = stFailDigits & " " & i
End If
Next i
If bValidDigits = False Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained invalid numbers:" & stFailDigits & vbCr & vbCr
End If
' Check result of user expression
On Error GoTo EvalFail
vResult = Evaluate(stUserExpression)
If Not vResult = 24 Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression did not result in 24. It returned: " & vResult
End If
' Return results
If bValidExpression = False Then
vTryAgain = MsgBox(stFailMessage & vbCr & vbCr & "Would you like to try again?", vbCritical + vbRetryCancel, "Rosetta Code | 24 Game | FAILED")
If vTryAgain = vbRetry Then
vSameDigits = MsgBox("Do you want to use the same numbers?", vbQuestion + vbYesNo, "Rosetta Code | 24 Game | RETRY")
If vSameDigits = vbYes Then
GoTo GetUserExpression
Else
GoTo GenerateNewDigits
End If
End If
Else
vTryAgain = MsgBox("You entered: " & stUserExpression & vbCr & vbCr & "which resulted in: " & vResult, _
vbInformation + vbRetryCancel, "Rosetta Code | 24 Game | SUCCESS")
If vTryAgain = vbRetry Then
GoTo GenerateNewDigits
End If
End If
Exit Sub
EvalFail:
bValidExpression = False
vResult = Err.Description
Resume
End Sub
</syntaxhighlight>
=={{header|V (Vlang)}}==
{{trans|Go}}
<syntaxhighlight lang="v">import os
import rand
import rand.seed
import math
fn main() {
rand.seed(seed.time_seed_array(2))
mut n := []int{len: 4}
for i in 0.. n.len {
n[i] = rand.intn(9) or {0}
}
println("Your numbers: $n")
expr := os.input("Enter RPN: ")
if expr.len != 7 {
println("invalid. expression length must be 7." +
" (4 numbers, 3 operators, no spaces)")
return
}
mut stack := []f64{len: 0, cap:4}
for r in expr.split('') {
if r >= '0' && r <= '9' {
if n.len == 0 {
println("too many numbers.")
return
}
mut i := 0
for n[i] != r.int() {
i++
if i == n.len {
println("wrong numbers.")
return
}
}
n.delete(n.index(r.int()))
stack << f64(r[0]-'0'[0])
continue
}
if stack.len < 2 {
println("invalid expression syntax.")
return
}
match r {
'+' {
stack[stack.len-2] += stack[stack.len-1]
}
'-' {
stack[stack.len-2] -= stack[stack.len-1]
}
'*' {
stack[stack.len-2] *= stack[stack.len-1]
}
'/' {
stack[stack.len-2] /= stack[stack.len-1]
}
else {
println("$r invalid.")
return
}
}
stack = stack[..stack.len-1]
}
if math.abs(stack[0]-24) > 1e-6 {
println("incorrect. ${stack[0]} != 24")
} else {
println("correct.")
}
}</syntaxhighlight>
{{out}}
Sample game:
<pre>
Make 24 using these digits: [2, 3, 5, 1]
> 23*51-*
Correct!
</pre>
=={{header|Wren}}==
{{trans|Java}}
{{libheader|Wren-ioutil}}
{{libheader|Wren-seq}}
<syntaxhighlight lang="wren">import "random" for Random
import "./ioutil" for Input
import "./seq" for Stack
var R = Random.new()
class Game24 {
static run() {
var digits = List.filled(4, 0)
for (i in 0..3) digits[i] = R.int(1, 10)
System.print("Make 24 using these digits: %(digits)")
var cin = Input.text("> ")
var s = Stack.new()
var total = 0
for (c in cin) {
var d = c.bytes[0]
if (d >= 48 && d <= 57) {
d = d - 48
total = total + (1 << (d*5))
s.push(d)
} else if ("+-*/".indexOf(c) != -1) s.push(applyOperator_(s.pop(), s.pop(), c))
}
if (tallyDigits_(digits) != total) {
System.write("Not the same digits.")
} else if ((24 - s.peek()).abs < 0.001) {
System.print("Correct!")
} else {
System.write("Not correct.")
}
}
static applyOperator_(a, b, c) {
if (c == "+") return a + b
if (c == "-") return b - a
if (c == "*") return a * b
if (c == "/") return b / a
return 0/0
}
static tallyDigits_(a) {
var total = 0
for (i in 0...a.count) total = total + (1 << (a[i]*5))
return total
}
}
Game24.run()</syntaxhighlight>
{{out}}
Sample game:
<pre>
Make 24 using these digits: [2, 3, 5, 1]
> 23*51-*
Correct!
</pre>
=={{header|XPL0}}==
<syntaxhighlight lang "XPL0">real Stack(10), A, B;
int SP, I, Char, Digit, Digits(10);
proc Push(X);
real X;
[Stack(SP):= X; SP:= SP+1];
func real Pop;
[SP:= SP-1; return Stack(SP)];
[SP:= 0;
for I:= 0 to 9 do Digits(I):= 0;
Text(0, "Enter an RPN expression that equals 24 using all these digits:");
for I:= 0 to 3 do
[Digit:= Ran(9)+1;
ChOut(0, ^ ); ChOut(0, Digit+^0);
Digits(Digit):= Digits(Digit)+1;
];
Text(0, "^m^j> ");
loop [Char:= ChIn(1);
ChOut(0, Char);
if Char >= ^1 and Char <=^9 then
[Digit:= Char - ^0;
Push(float(Digit));
Digits(Digit):= Digits(Digit) - 1;
]
else [if SP >= 2 then [A:= Pop; B:= Pop] else quit;
case Char of
^+: Push(B+A);
^-: Push(B-A);
^*: Push(B*A);
^/: Push(B/A)
other quit;
];
];
CrLf(0);
for I:= 0 to 9 do
if Digits(I) # 0 then
[Text(0, "Must use each of the given digits.^m^j"); exit];
Text(0, if abs(Pop-24.0) < 0.001 then "Correct!" else "Wrong.");
CrLf(0);
]</syntaxhighlight>
{{out}}
<pre>
Enter an RPN expression that equals 24 using all these digits: 1 4 4 9
> 44*9+1-
Correct!
</pre>
=={{header|Yabasic}}==
With reverse polish notation
<syntaxhighlight lang=Yabasic>operadores$ = "*/+-"
espacios$ = " "
clear screen
print "24 Game"
print "============\n"
print "The player is provided with 4 numbers with which to perform operations"
print "of addition (+), subtraction (-), multiplication (*) or division (/) to attempt"
print "to get 24 as result."
print "Use reverse Polish notation (first the operands and then the operators)."
print "For example: instead of 2 + 4, type 2 4 +\n\n"
repeat
print at(0,9) espacios$, espacios$, espacios$, espacios$, espacios$, espacios$
print at(0,9);
serie$ = ordenaCadena$(genSerie$())
validos$ = serie$+operadores$
line input "Enter your formula in reverse Polish notation: " entrada$
entrada$ = quitaEspacios$(entrada$)
entradaOrd$ = ordenaCadena$(entrada$)
if (right$(entradaOrd$,4) <> serie$) or (len(entradaOrd$)<>7) then
print "Error in the entered series"
else
resultado = evaluaEntrada(entrada$)
print "The result is = ",resultado," "
if resultado = 24 then
print "Correct!"
else
print "Error!"
end if
end if
print "Want to try again? (press N to exit, or another key to continue)"
until(upper$(left$(inkey$(),1)) = "N")
sub genSerie$()
local i, c$, s$
print "The numbers to be used are: ";
i = ran()
for i = 1 to 4
c$ = str$(int(ran(9))+1)
print c$," ";
s$ = s$ + c$
next i
print
return s$
end sub
sub evaluaEntrada(entr$)
local d1, d2, c$, n(4), i
while(entr$<>"")
c$ = left$(entr$,1)
entr$ = mid$(entr$,2)
if instr(serie$,c$) then
i = i + 1
n(i) = val(c$)
elseif instr(operadores$,c$) then
d2 = n(i)
n(i) = 0
i = i - 1
d1 = n(i)
n(i) = evaluador(d1, d2, c$)
else
print "Invalid sign"
return
end if
wend
return n(i)
end sub
sub evaluador(d1, d2, op$)
local t
switch op$
case "+": t = d1 + d2 : break
case "-": t = d1 - d2 : break
case "*": t = d1 * d2 : break
case "/": t = d1 / d2 : break
end switch
return t
end sub
sub quitaEspacios$(entr$)
local n, i, s$, t$(1)
n = token(entr$,t$()," ")
for i=1 to n
s$ = s$ + t$(i)
next i
return s$
end sub
sub ordenaCadena$(cadena$)
local testigo, n, fin, c$
fin = len(cadena$)-1
repeat
testigo = false
for n = 1 to fin
if mid$(cadena$,n,1) > mid$(cadena$,n+1,1) then
testigo = true
c$ = mid$(cadena$,n,1)
mid$(cadena$,n,1) = mid$(cadena$,n+1,1)
mid$(cadena$,n+1,1) = c$
end if
next n
until(testigo = false)
return cadena$
end sub</syntaxhighlight>
{{trans|ZX Spectrum Basic}}
<syntaxhighlight lang=Yabasic>do
clear screen
n$=""
for i=1 to 4
n$=n$+str$(int(ran(9)+1))
next i
print at(35,0) "24 GAME\n"
print "Combine numbers and operators for obtain 24."
print "Allowed characters: ";
i$=n$+"+-*/()"
for i=1 to 10
print mid$(i$,i,1)," ";
next i
print "[nothing to end program]\n"
label accept
p$=""
i$=n$+"+-*/()"
print at(0,4);:input "Enter the formula: " f$
if f$="" end
for i=1 to len(f$)
c$=mid$(f$,i,1)
switch c$
case " ": f$=left$(f$,i-1)+right$(f$,len(f$)-i): break
case "+":case "-":case "*":case "/": p$=p$+"o": break
case "(":case ")": p$=p$+c$: break
case mid$(i$,1,1): p$=p$+"n": mid$(i$,1,1)=" ": break
case mid$(i$,2,1): p$=p$+"n": mid$(i$,2,1)=" ": break
case mid$(i$,3,1): p$=p$+"n": mid$(i$,3,1)=" ": break
case mid$(i$,4,1): p$=p$+"n": mid$(i$,4,1)=" ": break
default: message(" = Invalid argument! "): break
end switch
if f$="" goto accept
next i
restore
for i=1 to 11
read t$
if t$=p$ break
next i
if t$<>p$ then
message(" = Bad construction! ")
goto accept
end if
let r=eval(f$)
print "\n",f$," = ",r," ";
if r<>24 then
message(" = Wrong! ")
goto accept
else
message(" = Correct! ")
pause 5
end if
loop
DATA "nononon"
DATA "(non)onon"
DATA "nono(non)"
DATA "no(no(non))"
DATA "((non)on)on"
DATA "no(non)on"
DATA "(non)o(non)"
DATA "no((non)on)"
DATA "(nonon)on"
DATA "(no(non))on"
DATA "no(nonon)"
sub message(m$)
print at(0,7) f$,m$
beep: beep: beep
pause 1
print at(19,4) " "
f$=""
end sub
sub eval(c$)
static linea
linea=linea+1
c$="sub s"+str$(linea+1000000,"#######")+"():return "+c$+":end sub"
compile c$
return execute(mid$(c$,5,8))
end sub
</syntaxhighlight>
=={{header|zkl}}==
<syntaxhighlight lang=zkl>while(1){
digits := [1..4].pump(String,(0).random.fpM("11-",1,9));
exp := ask("Enter an expression using the digits ",digits,
" that evals to 24: ") - " \n";
expf:=exp.apply(fcn(c){if ("1"<=c<="9") "(%s).toFloat()".fmt(c) else c});
reg r;
try { Compiler.Compiler.compileText(expf).__constructor(); r=vm.regX }
catch { println("bad expression"); continue; }
else{
extra := (exp - "+-/*()" - digits);
if (extra) { println("Extra goodies in expression: ",extra); continue; }
(digits.split("").sort() != (exp - "+-/*()").split("").sort()) :
if(_) { println("You can only use the digits ",digits," once each"); continue; };
if (exp.matches("*[1-9][1-9]*"))
{ println("no repeated digits"); continue; }
if (r.closeTo(24,0.001)) "nice!".println();
else println("That evaled to ",r,", not 24");
}
}</syntaxhighlight>
{{out}}
<pre>
Enter an expression using the digits 8833 that evals to 24: (8/(3-(8/3)))
nice!
Enter an expression using the digits 8833 that evals to 24: (8/(3-(8/9)))
Extra goodies in expression: 9
Enter an expression using the digits 8833 that evals to 24: (8/(3-(8/8)))
You can only use the digits 8833 once each
Enter an expression using the digits 7155 that evals to 24: 7+1+5+5
That evaled to 18, not 24
Enter an expression using the digits 8332 that evals to 24: 8*3*(3-2)
nice!
</pre>
=={{header|ZX Spectrum Basic}}==
<syntaxhighlight lang=zxbasic>10 LET n$=""
20 RANDOMIZE
30 FOR i=1 TO 4
40 LET n$=n$+STR$ (INT (RND*9)+1)
50 NEXT i
60 LET i$="": LET f$="": LET p$=""
70 CLS
80 PRINT "24 game"
90 PRINT "Allowed characters:"
100 LET i$=n$+"+-*/()"
110 PRINT AT 4,0;
120 FOR i=1 TO 10
130 PRINT i$(i);" ";
140 NEXT i
150 PRINT "(0 to end)"
160 INPUT "Enter the formula";f$
170 IF f$="0" THEN STOP
180 PRINT AT 6,0;f$;" = ";
190 FOR i=1 TO LEN f$
200 LET c$=f$(i)
210 IF c$=" " THEN LET f$(i)="": GO TO 250
220 IF c$="+" OR c$="-" OR c$="*" OR c$="/" THEN LET p$=p$+"o": GO TO 250
230 IF c$="(" OR c$=")" THEN LET p$=p$+c$: GO TO 250
240 LET p$=p$+"n"
250 NEXT i
260 RESTORE
270 FOR i=1 TO 11
280 READ t$
290 IF t$=p$ THEN LET i=11
300 NEXT i
310 IF t$<>p$ THEN PRINT INVERSE 1;"Bad construction!": BEEP 1,.1: PAUSE 0: GO TO 60
320 FOR i=1 TO LEN f$
330 FOR j=1 TO 10
340 IF (f$(i)=i$(j)) AND f$(i)>"0" AND f$(i)<="9" THEN LET i$(j)=" "
350 NEXT j
360 NEXT i
370 IF i$( TO 4)<>" " THEN PRINT FLASH 1;"Invalid arguments!": BEEP 1,.01: PAUSE 0: GO TO 60
380 LET r=VAL f$
390 PRINT r;" ";
400 IF r<>24 THEN PRINT FLASH 1;"Wrong!": BEEP 1,1: PAUSE 0: GO TO 60
410 PRINT FLASH 1;"Correct!": PAUSE 0: GO TO 10
420 DATA "nononon"
430 DATA "(non)onon"
440 DATA "nono(non)"
450 DATA "no(no(non))"
460 DATA "((non)on)on"
470 DATA "no(non)on"
480 DATA "(non)o(non)"
485 DATA "no((non)on)"
490 DATA "(nonon)on"
495 DATA "(no(non))on"
500 DATA "no(nonon)"</syntaxhighlight>
|
Latest revision as of 18:09, 7 July 2024
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
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.
- Task
Write a program that randomly chooses and displays four digits, each from 1 ──► 9 (inclusive) with repetitions allowed.
The program should prompt for the player to enter an arithmetic expression using just those, and all of those four digits, used exactly once each. The program should check then evaluate the expression.
The goal is for the player to enter an expression that (numerically) evaluates to 24.
- Only the following operators/functions are allowed: multiplication, division, addition, subtraction
- 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.
- Notes
- 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.
- Related tasks
- Reference
- The 24 Game on h2g2.
11l
T Error
String message
F (message)
.message = message
T RPNParse
[Float] stk
[Int] digits
F op(f)
I .stk.len < 2
X.throw Error(‘Improperly written expression’)
V b = .stk.pop()
V a = .stk.pop()
.stk.append(f(a, b))
F parse(s)
L(c) s
I c C ‘0’..‘9’
.stk.append(Float(c))
.digits.append(Int(c))
E I c == ‘+’ {.op((a, b) -> a + b)}
E I c == ‘-’ {.op((a, b) -> a - b)}
E I c == ‘*’ {.op((a, b) -> a * b)}
E I c == ‘/’ {.op((a, b) -> a / b)}
E I c != ‘ ’
X.throw Error(‘Wrong char: ’c)
F get_result()
I .stk.len != 1
X.throw Error(‘Improperly written expression’)
R .stk.last
[Int] digits
print(‘Make 24 with the digits:’, end' ‘’)
L 4
V n = random:(1..9)
print(‘ ’n, end' ‘’)
digits.append(n)
print()
V parser = RPNParse()
X.try
parser.parse(input())
V r = parser.get_result()
I sorted(digits) != sorted(parser.digits)
print(‘Error: Not using the given digits’)
E
print(‘Result: ’r)
I r C 23.999<.<24.001
print(‘Good job!’)
E
print(‘Try again.’)
X.catch Error error
print(‘Error: ’error.message)
- Output:
The same as in C++.
8th
This is a fully-worked sample of the game in 8th, showing error-detection and user-restriction techniques:
\ Generate four random digits and display to the user
\ then get an expression from the user using +, -, / and * and the digits
\ the result must equal 24
\ http://8th-dev.com/24game.html
\ Only the words in namespace 'game' are available to the player:
ns: game
: + n:+ ;
: - n:- ;
: * n:* ;
: / n:/ ;
ns: G
var random-digits
var user-input
: one-digit \ a -- a
rand n:abs 9 n:mod n:1+ a:push ;
: gen-digits \ - a
[] clone nip \ the clone nip is not needed in versions past 1.0.2...
' one-digit 4 times
' n:cmp a:sort
random-digits ! ;
: prompt-user
cr "The digits are: " . random-digits @ . cr ;
: goodbye
cr "Thanks for playing!\n" . cr 0 die ;
: get-input
70 null con:accept dup user-input !
null? if drop goodbye then ;
: compare-digits
true swap
(
\ inputed-array index
dup >r
a:@
random-digits @ r> a:@ nip
n:= not if
break
swap drop false swap
then
) 0 3 loop drop ;
/^\D*(\d)\D+(\d)\D+(\d)\D+(\d)\D*$/ var, digits-regex
: all-digits?
user-input @ digits-regex @ r:match
null? if drop false else
5 = not if
false
else
\ convert the captured digits in the regex into a sorted array:
digits-regex @
( r:@ >n swap ) 1 4 loop drop
4 a:close ' n:cmp a:sort
compare-digits
then
then ;
: does-eval?
0 user-input @ eval 24 n:=
dup not if
cr "Sorry, that expression is wrong" . cr
then ;
: check-input
reset
all-digits? if
does-eval? if
cr "Excellent! Your expression: \"" .
user-input @ .
"\" worked!" . cr
then
else
cr "You did not use the digits properly, try again." . cr
then ;
: intro quote |
Welcome to the '24 game'!
You will be shown four digits each time. Using only the + - * and / operators
and all the digits (and only the digits), produce the number '24'
Enter your result in 8th syntax, e.g.: 4 4 + 2 1 + *
To quit the game, just hit enter by itself. Enjoy!
| . ;
: start
\ don't allow anything but the desired words
ns:game only
intro
repeat
gen-digits
prompt-user
get-input
check-input
again ;
start
AArch64 Assembly
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program game24_64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ NBDIGITS, 4 // digits number
.equ TOTAL, 24
.equ BUFFERSIZE, 100
.equ STACKSIZE, 10 // operator and digits number items in stacks
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessRules: .ascii "24 Game 64 bits.\n"
.ascii "The program will display four randomly-generated \n"
.ascii "single-digit numbers and will then prompt you to enter\n"
.ascii "an arithmetic expression followed by <enter> to sum \n"
.ascii "the given numbers to 24.\n"
.asciz "Exemple : 9+8+3+4 or (7+5)+(3*4) \n\n"
szMessExpr: .asciz "Enter your expression (or type (q)uit to exit or (n) for other digits): \n"
szMessDigits: .asciz "The four digits are @ @ @ @ and the score is 24. \n"
szMessNoDigit: .asciz "Error : One digit is not in digits list !! \n"
szMessSameDigit: .asciz "Error : Two digits are same !! \n"
szMessOK: .asciz "It is OK. \n"
szMessNotOK: .asciz "Error, it is not ok total = @ \n"
szMessErrOper: .asciz "Unknow Operator (+,-,$,/,(,)) \n"
szMessNoparen: .asciz "no opening parenthesis !! \n"
szMessErrParen: .asciz "Error parenthesis number !! \n"
szMessNoalldigits: .asciz "One or more digits not used !!\n"
szMessNewGame: .asciz "New game (y/n) ? \n"
szCarriageReturn: .asciz "\n"
.align 4
qGraine: .quad 123456
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
sBuffer: .skip BUFFERSIZE
iTabDigit: .skip 8 * NBDIGITS
iTabTopDigit: .skip 8 * NBDIGITS
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
ldr x0,qAdrszMessRules // display rules
bl affichageMess
1:
mov x3,#0
ldr x12,qAdriTabDigit
ldr x11,qAdriTabTopDigit
ldr x5,qAdrszMessDigits
2: // loop generate random digits
mov x0,#8
bl genereraleas
add x0,x0,#1
str x0,[x12,x3,lsl #3] // store in table
mov x1,#0
str x1,[x11,x3,lsl #3] // raz top table
ldr x1,qAdrsZoneConv
bl conversion10 // call decimal conversion
//mov x2,#0
//strb w2,[x1,x0] // reduce size display area with zéro final
mov x0,x5
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
mov x5,x0
add x3,x3,#1
cmp x3,#NBDIGITS // end ?
blt 2b // no -> loop
mov x0,x5
bl affichageMess
3: // loop human entry
ldr x0,qAdrszMessExpr
bl affichageMess
bl saisie // entry
cmp x0,#'q'
beq 100f
cmp x0,#'Q'
beq 100f
cmp x0,#'n'
beq 1b
cmp x0,#'N'
beq 1b
bl evalExpr // expression evaluation
cmp x0,#0 // ok ?
bne 3b // no - > loop
10: // display new game ?
ldr x0,qAdrszCarriageReturn
bl affichageMess
ldr x0,qAdrszMessNewGame
bl affichageMess
bl saisie
cmp x0,#'y'
beq 1b
cmp x0,#'Y'
beq 1b
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc #0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrszMessRules: .quad szMessRules
qAdrszMessDigits: .quad szMessDigits
qAdrszMessExpr: .quad szMessExpr
qAdrszMessNewGame: .quad szMessNewGame
qAdrsZoneConv: .quad sZoneConv
qAdriTabDigit: .quad iTabDigit
qAdriTabTopDigit: .quad iTabTopDigit
/******************************************************************/
/* evaluation expression */
/******************************************************************/
/* x0 return 0 if ok -1 else */
evalExpr:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
stp x10,fp,[sp,-16]! // save registres
mov x0,#0
ldr x1,qAdriTabTopDigit
mov x2,#0
1: // loop init table top digits
str x0,[x1,x2,lsl #3]
add x2,x2,#1
cmp x2,#NBDIGITS
blt 1b
sub sp,sp,#STACKSIZE * 8 // stack operator
mov fp,sp
sub sp,sp,#STACKSIZE * 8 // stack digit
mov x1,sp
ldr x10,qAdrsBuffer
mov x8,#0 // indice character in buffer
mov x7,#0 // indice digits stack
mov x2,#0 // indice operator stack
mov x9,0
1: // begin loop
ldrb w9,[x10,x8]
cmp x9,#0xA // end expression ?
beq 90f
cmp x9,#' ' // space ?
cinc x8,x8,eq // loop
beq 1b
cmp x9,#'(' // left parenthesis -> store in operator stack
bne 11f
str x9,[fp,x2,lsl 3]
add x2,x2,#1
add x8,x8,#1 // and loop
b 1b
11:
cmp x9,#')' // right parenthesis ?
bne 3f
mov x0,fp // compute operator stack until left parenthesis
sub x2,x2,#1
2:
ldr x6,[fp,x2,lsl 3]
cmp x6,#'(' // left parenthesis
cinc x8,x8,eq // end ?
beq 1b // and loop
sub x7,x7,#1 // last digit
mov x3,x7
bl compute
sub x2,x2,#1
cmp x2,#0
bge 2b
ldr x0,qAdrszMessNoparen // no left parenthesis in stack
bl affichageMess
mov x0,#-1
b 100f
3:
cmp x9,#'+' // addition
beq 4f
cmp x9,#'-' // soustraction
beq 4f
cmp x9,#'*' // multiplication
beq 4f
cmp x9,#'/' // division
beq 4f
b 5f // not operator
4: // control priority and depile stacks
mov x0,fp
mov x3,x7
mov x4,x9
bl depileOper
mov x7,x3
add x8,x8,#1
b 1b // and loop
5: // digit
sub x9,x9,#0x30
mov x0,x9
bl digitControl
cmp x0,#0 // error ?
bne 100f
str x9,[x1,x7,lsl #3] // store digit in digits stack
add x7,x7,#1
add x8,x8,#1
beq 1b
b 100f
90: // compute all stack operators
mov x0,fp
sub x7,x7,#1
91:
subs x2,x2,#1
blt 92f
mov x3,x7
bl compute
sub x7,x7,#1
b 91b
92:
ldr x0,[x1] // total = first value on digits stack
cmp x0,#TOTAL // control total
beq 93f // ok
ldr x1,qAdrsZoneConv
bl conversion10 // call decimal conversion
mov x2,#0
strb w2,[x1,x0]
ldr x0,qAdrszMessNotOK
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
bl affichageMess
mov x0,#-1
b 100f
93: // control use all digits
ldr x1,qAdriTabTopDigit
mov x2,#0
94: // begin loop
ldr x0,[x1,x2,lsl #3] // load top
cmp x0,#0
bne 95f
ldr x0,qAdrszMessNoalldigits
bl affichageMess
mov x0,#-1
b 100f
95:
add x2,x2,#1
cmp x2,#NBDIGITS
blt 94b
96: // display message OK
ldr x0,qAdrszMessOK
bl affichageMess
mov x0,#0
b 100f
100:
add sp,sp,8 * (STACKSIZE *2) // stack algnement
ldp x10,fp,[sp],16 // restaur des 2 registres
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
qAdrszMessNoparen: .quad szMessNoparen
qAdrszMessNotOK: .quad szMessNotOK
qAdrszMessOK: .quad szMessOK
qAdrszMessNoalldigits: .quad szMessNoalldigits
/******************************************************************/
/* depile operator */
/******************************************************************/
/* x0 operator stack address */
/* x1 digits stack address */
/* x2 operator indice */
/* x3 digits indice */
/* x4 operator */
/* x2 return a new operator indice */
/* x3 return a new digits indice */
depileOper:
stp x4,lr,[sp,-16]! // save registres
stp x5,x6,[sp,-16]! // save registres
stp x7,x8,[sp,-16]! // save registres
cmp x2,#0 // first operator ?
beq 60f
sub x5,x2,#1
1:
ldr x6,[x0,x5,lsl #3] // load stack operator
cmp x6,x4 // same operators
beq 50f
cmp x6,#'*' // multiplication
beq 50f
cmp x6,#'/' // division
beq 50f
cmp x6,#'-' // soustraction
beq 50f
b 60f
50: // depile operators stack and compute
sub x2,x2,#1
sub x3,x3,#1
bl compute
sub x5,x5,#1
cmp x5,#0
bge 1b
60:
str x4,[x0,x2,lsl #3] // add operator in stack
add x2,x2,#1
100:
ldp x7,x8,[sp],16 // restaur des 2 registres
ldp x5,x6,[sp],16 // restaur des 2 registres
ldp x4,lr,[sp],16 // restaur des 2 registres
ret
/******************************************************************/
/* compute */
/******************************************************************/
/* x0 operator stack address */
/* x1 digits stack address */
/* x2 operator indice */
/* x3 digits indice */
compute:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
ldr x6,[x1,x3,lsl 3] // load second digit
sub x5,x3,#1
ldr x7,[x1,x5,lsl 3] // load first digit
ldr x8,[x0,x2,lsl 3] // load operator
cmp x8,#'+'
bne 1f
add x7,x7,x6 // addition
str x7,[x1,x5,lsl 3]
b 100f
1:
cmp x8,#'-'
bne 2f
sub x7,x7,x6 // soustaction
str x7,[x1,x5,lsl 3]
b 100f
2:
cmp x8,#'*'
bne 3f // multiplication
mul x7,x6,x7
str x7,[x1,x5,lsl 3]
b 100f
3:
cmp x8,#'/'
bne 4f
udiv x7,x7,x6 // division
str x7,[x1,x5,lsl 3]
b 100f
4:
cmp x8,#'(' // left parenthesis ?
bne 5f
ldr x0,qAdrszMessErrParen // error
bl affichageMess
mov x0,#-1
b 100f
5:
ldr x0,qAdrszMessErrOper
bl affichageMess
mov x0,#-1
100:
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
qAdrszMessErrOper: .quad szMessErrOper
qAdrszMessErrParen: .quad szMessErrParen
/******************************************************************/
/* control digits */
/******************************************************************/
/* x0 return 0 if OK 1 if not digit */
digitControl:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
ldr x1,qAdriTabTopDigit
ldr x2,qAdriTabDigit
mov x3,#0
1:
ldr x4,[x2,x3,lsl #3] // load digit
cmp x0,x4 // equal ?
beq 2f // yes
add x3,x3,#1 // no -> loop
cmp x3,#NBDIGITS // end ?
blt 1b
ldr x0,qAdrszMessNoDigit // error
bl affichageMess
mov x0,#1
b 100f
2: // control prev use
ldr x4,[x1,x3,lsl #3]
cmp x4,#0
beq 3f
add x3,x3,#1
cmp x3,#NBDIGITS
blt 1b
ldr x0,qAdrszMessSameDigit
bl affichageMess
mov x0,#1
b 100f
3:
mov x4,#1
str x4,[x1,x3,lsl #3]
mov x0,#0
100:
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
qAdrszMessNoDigit: .quad szMessNoDigit
qAdrszMessSameDigit: .quad szMessSameDigit
/******************************************************************/
/* string entry */
/******************************************************************/
/* x0 return the first character of human entry */
saisie:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
mov x0,STDIN // Linux input console
ldr x1,qAdrsBuffer // buffer address
mov x2,BUFFERSIZE // buffer size
mov x8,READ // request to read datas
svc 0 // call system
ldr x1,qAdrsBuffer // buffer address
ldrb w0,[x1] // load first character
100:
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
qAdrsBuffer: .quad sBuffer
/***************************************************/
/* Generation random number */
/***************************************************/
/* x0 contains limit */
genereraleas:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
ldr x4,qAdrqGraine
ldr x2,[x4]
ldr x3,qNbDep1
mul x2,x3,x2
ldr x3,qNbDep2
add x2,x2,x3
str x2,[x4] // maj de la graine pour l appel suivant
cmp x0,#0
beq 100f
add x0,x0,#1
udiv x3,x2,x0
msub x0,x3,x0,x2 // résult = remainder
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
/*****************************************************/
qAdrqGraine: .quad qGraine
qNbDep1: .quad 0x0019660d
qNbDep2: .quad 0x3c6ef35f
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
ABAP
See 24 game/ABAP
Ada
game24.adb:
with Ada.Float_Text_IO;
with Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
procedure Game_24 is
subtype Digit is Character range '1' .. '9';
package Random_Digit is new Ada.Numerics.Discrete_Random (Digit);
Exp_Error : exception;
Digit_Generator : Random_Digit.Generator;
Given_Digits : array (1 .. 4) of Digit;
Float_Value : constant array (Digit) of Float :=
(1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0);
function Apply_Op (L, R : Float; Op : Character) return Float is
begin
case Op is
when '+' =>
return L + R;
when '-' =>
return L - R;
when '*' =>
return L * R;
when '/' =>
return L / R;
when others =>
Ada.Text_IO.Put_Line ("Unexpected operator: " & Op);
raise Exp_Error;
end case;
end Apply_Op;
function Eval_Exp (E : String) return Float is
Flt : Float;
First : Positive := E'First;
Last : Positive;
function Match_Paren (Start : Positive) return Positive is
Pos : Positive := Start + 1;
Level : Natural := 1;
begin
loop
if Pos > E'Last then
Ada.Text_IO.Put_Line ("Unclosed parentheses.");
raise Exp_Error;
elsif E (Pos) = '(' then
Level := Level + 1;
elsif E (Pos) = ')' then
Level := Level - 1;
exit when Level = 0;
end if;
Pos := Pos + 1;
end loop;
return Pos;
end Match_Paren;
begin
if E (First) = '(' then
Last := Match_Paren (First);
Flt := Eval_Exp (E (First + 1 .. Last - 1));
elsif E (First) in Digit then
Last := First;
Flt := Float_Value (E (First));
else
Ada.Text_IO.Put_Line ("Unexpected character: " & E (First));
raise Exp_Error;
end if;
loop
if Last = E'Last then
return Flt;
elsif Last = E'Last - 1 then
Ada.Text_IO.Put_Line ("Unexpected end of expression.");
raise Exp_Error;
end if;
First := Last + 2;
if E (First) = '(' then
Last := Match_Paren (First);
Flt := Apply_Op (Flt, Eval_Exp (E (First + 1 .. Last - 1)),
Op => E (First - 1));
elsif E (First) in Digit then
Last := First;
Flt := Apply_Op (Flt, Float_Value (E (First)),
Op => E (First - 1));
else
Ada.Text_IO.Put_Line ("Unexpected character: " & E (First));
raise Exp_Error;
end if;
end loop;
end Eval_Exp;
begin
Ada.Text_IO.Put_Line ("24 Game");
Ada.Text_IO.Put_Line ("- Enter Q to Quit");
Ada.Text_IO.Put_Line ("- Enter N for New digits");
Ada.Text_IO.Put_Line ("Note: Operators are evaluated left-to-right");
Ada.Text_IO.Put_Line (" (use parentheses to override)");
Random_Digit.Reset (Digit_Generator);
<<GEN_DIGITS>>
Ada.Text_IO.Put_Line ("Generating 4 digits...");
for I in Given_Digits'Range loop
Given_Digits (I) := Random_Digit.Random (Digit_Generator);
end loop;
<<GET_EXP>>
Ada.Text_IO.Put ("Your Digits:");
for I in Given_Digits'Range loop
Ada.Text_IO.Put (" " & Given_Digits (I));
end loop;
Ada.Text_IO.New_Line;
Ada.Text_IO.Put ("Enter your Expression: ");
declare
Value : Float;
Response : constant String := Ada.Text_IO.Get_Line;
Prev_Ch : Character := ' ';
Unused_Digits : array (Given_Digits'Range) of Boolean :=
(others => True);
begin
if Response = "n" or Response = "N" then
goto GEN_DIGITS;
end if;
if Response = "q" or Response = "Q" then
return;
end if;
-- check input
for I in Response'Range loop
declare
Ch : constant Character := Response (I);
Found : Boolean;
begin
if Ch in Digit then
if Prev_Ch in Digit then
Ada.Text_IO.Put_Line ("Illegal multi-digit number used.");
goto GET_EXP;
end if;
Found := False;
for J in Given_Digits'Range loop
if Unused_Digits (J) and then
Given_Digits (J) = Ch then
Unused_Digits (J) := False;
Found := True;
exit;
end if;
end loop;
if not Found then
Ada.Text_IO.Put_Line ("Illegal number used: " & Ch);
goto GET_EXP;
end if;
elsif Ch /= '(' and Ch /= ')' and Ch /= '+' and
Ch /= '-' and Ch /= '*' and Ch /= '/' then
Ada.Text_IO.Put_Line ("Illegal character used: " & Ch);
goto GET_EXP;
end if;
Prev_Ch := Ch;
end;
end loop;
-- check all digits used
for I in Given_Digits'Range loop
if Unused_Digits (I) then
Ada.Text_IO.Put_Line ("Digit not used: " & Given_Digits (I));
goto GET_EXP;
end if;
end loop;
-- check value
begin
Value := Eval_Exp (Response);
exception
when Exp_Error =>
goto GET_EXP; -- Message displayed by Eval_Exp;
end;
if abs (Value - 24.0) > 0.001 then
Ada.Text_IO.Put ("Value ");
Ada.Float_Text_IO.Put (Value, Fore => 0, Aft => 3, Exp => 0);
Ada.Text_IO.Put_Line (" is not 24!");
goto GET_EXP;
else
Ada.Text_IO.Put_Line ("You won!");
Ada.Text_IO.Put_Line ("Enter N for a new game, or try another solution.");
goto GET_EXP;
end if;
end;
end Game_24;
- Output:
24 Game - Enter Q to Quit - Enter N for New digits Note: Operators are evaluated left-to-right (use parentheses to override) Generating 4 digits... Your Digits: 2 9 5 9 Enter your Expression: 9+9+5-2 Value 21.000 is not 24! Your Digits: 2 9 5 9 Enter your Expression: N Generating 4 digits... Your Digits: 7 7 1 3 Enter your Expression: (7-1)*(7-3) You won! Enter N for a new game, or try another solution.
ALGOL 68
Uses infix expressions.
BEGIN # play the 24 game - present the user with 4 digits and invite them to #
# enter an expression using the digits that evaluates to 24 #
[ 0 : 9 ]INT expression digits; # the digits entered by the user #
[ 0 : 9 ]INT puzzle digits; # the digits for the puzzle #
PROC eval = ( STRING expr )REAL: # parses and evaluates expr #
BEGIN
# syntax: expression = term ( ( "+" | "-" ) term )* #
# term = factor ( ( "*" | "/" ) factor ) * #
# factor = "0" | "1" | "2" | ... | "9" #
# | "(" expression ")" #
INT x pos := LWB expr - 1;
INT x end := UPB expr;
BOOL ok := TRUE;
PROC error = ( STRING msg )VOID:
IF ok THEN # this is the firstt error #
ok := FALSE;
print( ( msg, newline ) );
x pos := x end + 1
FI # error # ;
PROC curr ch = CHAR: IF x pos > x end THEN REPR 0 ELSE expr[ x pos ] FI;
PROC next ch = VOID: WHILE x pos +:= 1; curr ch = " " DO SKIP OD;
PROC factor = REAL:
IF curr ch >= "0" AND curr ch <= "9" THEN
INT digit = ABS curr ch - ABS "0";
REAL result = digit;
expression digits[ digit ] +:= 1;
next ch;
result
ELIF curr ch = "(" THEN
next ch;
REAL result = expression;
IF curr ch = ")" THEN
next ch
ELSE
error( """)"" expected after sub-expression" )
FI;
result
ELSE
error( "Unexpected """ + curr ch + """" );
0
FI # factor # ;
PROC term = REAL:
BEGIN
REAL result := factor;
WHILE curr ch = "*" OR curr ch = "/" DO
CHAR op = curr ch;
next ch;
IF op = "*" THEN result *:= factor ELSE result /:= factor FI
OD;
result
END # term # ;
PROC expression = REAL:
BEGIN
REAL result := term;
WHILE curr ch = "+" OR curr ch = "-" DO
CHAR op = curr ch;
next ch;
IF op = "+" THEN result +:= term ELSE result -:= term FI
OD;
result
END # expression # ;
next ch;
IF curr ch = REPR 0 THEN
error( "Missing expression" );
0
ELSE
REAL result = expression;
IF curr ch /= REPR 0 THEN
error( "Unexpected text: """ + expr[ x pos : ] + """ after expression" )
FI;
result
FI
END # eval # ;
WHILE
FOR i FROM 0 TO 9 DO # initialise the digit counts #
expression digits[ i ] := 0;
puzzle digits[ i ] := 0
OD;
print( ( "Enter an expression using these digits:" ) );
FOR i TO 4 DO # pick 4 random digits #
INT digit := 1 + ENTIER ( next random * 9 );
IF digit > 9 THEN digit := 9 FI;
puzzle digits[ digit ] +:= 1;
print( ( whole( digit, - 2 ) ) )
OD;
print( ( " that evaluates to 24: " ) );
# get and check the expression #
STRING expr;
read( ( expr, newline ) );
REAL result = eval( expr );
BOOL same := TRUE;
FOR i FROM 0 TO 9 WHILE same := puzzle digits[ i ] = expression digits[ i ] DO SKIP OD;
IF NOT same THEN
print( ( "That expression didn't contain the puzzle digits", newline ) )
ELIF result = 24 THEN
print( ( "Yes! That expression evaluates to 24", newline ) )
ELSE
print( ( "No - that expression evaluates to ", fixed( result, -8, 4 ), newline ) )
FI;
print( ( newline, "Play again [y/n]? " ) );
STRING play again;
read( ( play again, newline ) );
play again = "y" OR play again = "Y" OR play again = ""
DO SKIP OD
END
- Output:
Enter an expression using these digits: 2 5 3 5 that evaluates to 24: (3+5)*(5-2) Yes! That expression evaluates to 24 Play again [y/n]? Enter an expression using these digits: 8 8 6 6 that evaluates to 24: 8+6+8/6 No - that expression evaluates to 15.3333 Play again [y/n]? Enter an expression using these digits: 2 1 5 1 that evaluates to 24: (1+1)*(7+5) That expression didn't contain the puzzle digits Play again [y/n]? n
APL
tfgame←{⎕IO←1
⎕←d←?⍵⍴9
i←⍞
u[⍋u←{⍎¨⍣(0≠≢⍵)⊢⍵}(i∊'1234567890')⊆i]≢d[⍋d]:'nope'
~∧/((~b←i∊'1234567890')/i)∊'+-×÷()':'nope'
24≠⍎i:'nope'
'Yeah!'
}
- Output:
tfgame 4 6 9 4 5 6+9+4+5 Yeah! tfgame 6 4 9 7 9 1 1 Ummm... I'm too tired. nope
Applesoft BASIC
This was taken from both the Commodore BASIC and ZX Spectrum Basic solutions.
0 BH = PEEK (104):BL = PEEK (103)
1 GOSUB 1200: CALL - 868
10 LET N$ = ""
20 R = RND ( - ( PEEK (78) + PEEK (79) * 256)): REM RANDOMIZE
30 FOR I = 1 TO 4
40 LET N$ = N$ + STR$ ( INT ( RND (1) * 9) + 1)
50 NEXT I
60 PRINT " PRESS A KEY TO CONTINUE. ";: GET A$
65 LET I$ = "": LET F$ = "": LET P$ = ""
70 HOME
80 PRINT M$M$ SPC( 16)"24 GAME"
90 PRINT M$"ALLOWED CHARACTERS:"M$
100 LET I$ = N$ + "+-*/()"
110 HTAB 20
120 FOR I = 1 TO 10
130 PRINT MID$ (I$,I,1)" ";
140 NEXT I
150 PRINT M$ TAB( 7)"0 TO END"M$
160 INPUT "ENTER THE FORMULA: ";F$
170 IF F$ = "0" THEN END : GOTO 65
180 PRINT M$ TAB( 7)F$" = ";
190 FOR I = 1 TO LEN (F$)
200 LET C$ = MID$ (F$,I,1)
210 IF C$ = " " THEN LET F$ = MID$ (F$,1,I - 1) + MID$ (F$,I + 1): GOTO 250
220 IF C$ = "+" OR C$ = "-" OR C$ = "*" OR C$ = "/" THEN LET P$ = P$ + "O": GOTO 250
230 IF C$ = "(" OR C$ = ")" THEN LET P$ = P$ + C$: GOTO 250
240 LET P$ = P$ + "N"
250 NEXT I
260 RESTORE
270 FOR I = 1 TO 11
280 READ T$
290 IF T$ = P$ THEN LET I = 11
300 NEXT I
310 IF T$ < > P$ THEN INVERSE : PRINT "BAD CONSTRUCTION!"G$M$: NORMAL : GOTO 60
320 FOR I = 1 TO LEN (F$)
330 FOR J = 1 TO 10
340 IF ( MID$ (F$,I,1) = MID$ (I$,J,1)) AND MID$ (F$,I,1) > "0" AND MID$ (F$,I,1) < = "9" THEN LET I$ = MID$ (I$,1,J - 1) + " " + MID$ (I$,J + 1, LEN (I$))
350 NEXT J,I
370 IF MID$ (I$,1,4) < > " " THEN INVERSE : PRINT "INVALID ARGUMENTS!"G$M$: NORMAL : GOTO 60
380 GOSUB 600: REM LET R = VAL(F$)
390 PRINT R" ";
400 IF R < > 24 THEN INVERSE : PRINT "WRONG!"G$M$: NORMAL : GOTO 60
410 INVERSE : PRINT "CORRECT!"M$: NORMAL : GOTO 10
420 DATA"NONONON"
430 DATA"(NON)ONON"
440 DATA"NONO(NON)"
450 DATA"NO(NO(NON))"
460 DATA"((NON)ON)ON"
470 DATA"NO(NON)ON"
480 DATA"(NON)O(NON)"
485 DATA"NO((NON)ON)"
490 DATA"(NONON)ON"
495 DATA"(NO(NON))ON"
500 DATA"NO(NONON)"
600 REMGET BASIC TO EVALUATE OUR EXPRESSION
605 A$ = "R=" + F$: GOSUB 1440
610 FOR I = 1 TO LEN (A$)
615 REMSIMPLE TOKEN TRANSLATION
620 B = ASC ( MID$ (A$,I,1))
625 IF (B > 41 AND B < 48) OR B = 61 OR B = 94 THEN B = T(B)
630 POKE (AD + I - 1),B
635 NEXT
640 GOSUB 2000
645 REM GOSUB 1440:REM UNCOMMENT TO CLEAR EVALUATION LINE AFTER USE
650 RETURN
1200 M$ = CHR$ (13)
1210 G$ = CHR$ (7)
1220 HOME
1230 PRINT SPC( 16)"24 GAME"
1240 PRINT M$" THE GOAL OF THIS GAME IS TO FORMULATE"
1250 PRINT M$" AN ARITHMETIC EXPRESSION THAT"
1260 PRINT M$" EVALUATES TO A VALUE OF 24, HOWEVER"
1270 PRINT M$" YOU MAY USE ONLY THE FOUR NUMBERS"
1280 PRINT M$" GIVEN AT RANDOM BY THE COMPUTER AND"
1290 PRINT M$" THE STANDARD ARITHMETIC OPERATIONS OF"
1300 PRINT M$" ADD, SUBTRACT, MULTIPLY, AND DIVIDE."
1310 PRINT M$" EACH DIGIT MUST BE USED BY ITSELF. "
1320 PRINT M$" (E.G. IF GIVEN 1, 2, 3, 4, YOU CANNOT"
1330 PRINT M$" COMBINE 1 AND 2 TO MAKE 12.)"
1340 PRINT M$
1350 PRINT "INITIALIZING...";
1360 HTAB 1
1400 DIM T(94)
1401 T( ASC ("+")) = 200: REM $C8
1402 T( ASC ("-")) = 201: REM $C9
1403 T( ASC ("*")) = 202: REM $CA
1404 T( ASC ("/")) = 203: REM $CB
1405 T( ASC ("=")) = 208: REM $D0
1406 T( ASC ("^")) = 204: REM $CC
1409 REMLOCATE LINE 2005 IN RAM
1410 LH = BH:LL = BL:NH = 0:NL = 0
1415 AD = LH * 256 + LL
1420 LH = PEEK (AD + 1):LL = PEEK (AD)
1425 NL = PEEK (AD + 2):NH = PEEK (AD + 3):N = NH * 256 + NL
1430 IF N < > 2005 THEN GOTO 1415
1435 AD = AD + 4: RETURN
1440 FOR J = AD TO AD + 12: POKE J, ASC (":"): NEXT
1445 RETURN
2000 REMPUT 13 COLONS ON THE NEXT LINE
2005 :::::::::::::
2010 RETURN
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
compile with: arc 24_game.arg -o 24_game.c && gcc 24_game.c -o 24_game /usr/lib/libargrt.a
ARM Assembly
/* ARM assembly Raspberry PI */
/* program game24.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
.equ STDIN, 0 @ Linux input console
.equ READ, 3 @ Linux syscall
.equ NBDIGITS, 4 @ digits number
.equ TOTAL, 24
.equ BUFFERSIZE, 100
.equ STACKSIZE, 10 @ operator and digits number items in stacks
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessRules: .ascii "24 Game\n"
.ascii "The program will display four randomly-generated \n"
.ascii "single-digit numbers and will then prompt you to enter\n"
.ascii "an arithmetic expression followed by <enter> to sum \n"
.ascii "the given numbers to 24.\n"
.asciz "Exemple : 9+8+3+4 or (7+5)+(3*4) \n\n"
szMessExpr: .asciz "Enter your expression (or type (q)uit to exit or (n) for other digits): \n"
//szMessErrChoise: .asciz "invalid choice.\n "
szMessDigits: .asciz "The four digits are @ @ @ @ and the score is 24. \n"
szMessNoDigit: .asciz "Error : One digit is not in digits list !! \n"
szMessSameDigit: .asciz "Error : Two digits are same !! \n"
szMessOK: .asciz "It is OK. \n"
szMessNotOK: .asciz "Error, it is not ok total = @ \n"
szMessErrOper: .asciz "Unknow Operator (+,-,$,/,(,)) \n"
szMessNoparen: .asciz "no opening parenthesis !! \n"
szMessErrParen: .asciz "Error parenthesis number !! \n"
szMessNoalldigits: .asciz "One or more digits not used !!\n"
szMessNewGame: .asciz "New game (y/n) ? \n"
szCarriageReturn: .asciz "\n"
.align 4
iGraine: .int 123456
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
sBuffer: .skip BUFFERSIZE
iTabDigit: .skip 4 * NBDIGITS
iTabTopDigit: .skip 4 * NBDIGITS
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrszMessRules @ display rules
bl affichageMess
1:
mov r3,#0
ldr r12,iAdriTabDigit
ldr r11,iAdriTabTopDigit
ldr r5,iAdrszMessDigits
2: @ loop generate random digits
mov r0,#8
bl genereraleas
add r0,r0,#1
str r0,[r12,r3,lsl #2] @ store in table
mov r1,#0
str r1,[r11,r3,lsl #2] @ raz top table
ldr r1,iAdrsZoneConv
bl conversion10 @ call decimal conversion
mov r2,#0
strb r2,[r1,r0] @ reduce size display area with zéro final
mov r0,r5
ldr r1,iAdrsZoneConv @ insert conversion in message
bl strInsertAtCharInc
mov r5,r0
add r3,r3,#1
cmp r3,#NBDIGITS @ end ?
blt 2b @ no -> loop
mov r0,r5
bl affichageMess
3: @ loop human entry
ldr r0,iAdrszMessExpr
bl affichageMess
bl saisie @ entry
cmp r0,#'q'
beq 100f
cmp r0,#'Q'
beq 100f
cmp r0,#'n'
beq 1b
cmp r0,#'N'
beq 1b
bl evalExpr @ expression evaluation
cmp r0,#0 @ ok ?
bne 3b @ no - > loop
10: @ display new game ?
ldr r0,iAdrszCarriageReturn
bl affichageMess
ldr r0,iAdrszMessNewGame
bl affichageMess
bl saisie
cmp r0,#'y'
beq 1b
cmp r0,#'Y'
beq 1b
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrszMessRules: .int szMessRules
iAdrszMessDigits: .int szMessDigits
iAdrszMessExpr: .int szMessExpr
iAdrszMessNewGame: .int szMessNewGame
iAdrsZoneConv: .int sZoneConv
iAdriTabDigit: .int iTabDigit
iAdriTabTopDigit: .int iTabTopDigit
/******************************************************************/
/* evaluation expression */
/******************************************************************/
/* r0 return 0 if ok -1 else */
evalExpr:
push {r1-r11,lr} @ save registers
mov r0,#0
ldr r1,iAdriTabTopDigit
mov r2,#0
1: @ loop init table top digits
str r0,[r1,r2,lsl #2]
add r2,r2,#1
cmp r2,#NBDIGITS
blt 1b
sub sp,sp,#STACKSIZE * 4 @ stack operator
mov fp,sp
sub sp,sp,#STACKSIZE * 4 @ stack digit
mov r1,sp
ldr r10,iAdrsBuffer
mov r8,#0 @ indice character in buffer
mov r7,#0 @ indice digits stack
mov r2,#0 @ indice operator stack
1: @ begin loop
ldrb r9,[r10,r8]
cmp r9,#0xA @ end expression ?
beq 90f
cmp r9,#' ' @ space ?
addeq r8,r8,#1 @ loop
beq 1b
cmp r9,#'(' @ left parenthesis -> store in operator stack
streq r9,[fp,r2,lsl #2]
addeq r2,r2,#1
addeq r8,r8,#1 @ and loop
beq 1b
cmp r9,#')' @ right parenthesis ?
bne 3f
mov r0,fp @ compute operator stack until left parenthesis
sub r2,r2,#1
2:
ldr r6,[fp,r2,lsl #2]
cmp r6,#'(' @ left parenthesis
addeq r8,r8,#1 @ end ?
beq 1b @ and loop
sub r7,r7,#1 @ last digit
mov r3,r7
bl compute
sub r2,r2,#1
cmp r2,#0
bge 2b
ldr r0,iAdrszMessNoparen @ no left parenthesis in stack
bl affichageMess
mov r0,#-1
b 100f
3:
cmp r9,#'+' @ addition
beq 4f
cmp r9,#'-' @ soustraction
beq 4f
cmp r9,#'*' @ multiplication
beq 4f
cmp r9,#'/' @ division
beq 4f
b 5f @ not operator
4: @ control priority and depile stacks
mov r0,fp
mov r3,r7
mov r4,r9
bl depileOper
mov r7,r3
add r8,r8,#1
b 1b @ and loop
5: @ digit
sub r9,r9,#0x30
mov r0,r9
bl digitControl
cmp r0,#0 @ error ?
bne 100f
str r9,[r1,r7,lsl #2] @ store digit in digits stack
add r7,r7,#1
add r8,r8,#1
beq 1b
b 100f
90: @ compute all stack operators
mov r0,fp
sub r7,r7,#1
91:
subs r2,r2,#1
blt 92f
mov r3,r7
bl compute
sub r7,r7,#1
b 91b
92:
ldr r0,[r1] @ total = first value on digits stack
cmp r0,#TOTAL @ control total
beq 93f @ ok
ldr r1,iAdrsZoneConv
bl conversion10 @ call decimal conversion
mov r2,#0
strb r2,[r1,r0]
ldr r0,iAdrszMessNotOK
ldr r1,iAdrsZoneConv @ insert conversion in message
bl strInsertAtCharInc
bl affichageMess
mov r0,#-1
b 100f
93: @ control use all digits
ldr r1,iAdriTabTopDigit
mov r2,#0
94: @ begin loop
ldr r0,[r1,r2,lsl #2] @ load top
cmp r0,#0
bne 95f
ldr r0,iAdrszMessNoalldigits
bl affichageMess
mov r0,#-1
b 100f
95:
add r2,r2,#1
cmp r2,#NBDIGITS
blt 94b
96: @ display message OK
ldr r0,iAdrszMessOK
bl affichageMess
mov r0,#0
b 100f
100:
add sp,sp,#80 @ stack algnement
pop {r1-r11,lr}
bx lr @ return
iAdrszMessNoparen: .int szMessNoparen
iAdrszMessNotOK: .int szMessNotOK
iAdrszMessOK: .int szMessOK
iAdrszMessNoalldigits: .int szMessNoalldigits
/******************************************************************/
/* depile operator */
/******************************************************************/
/* r0 operator stack address */
/* r1 digits stack address */
/* r2 operator indice */
/* r3 digits indice */
/* r4 operator */
/* r2 return a new operator indice */
/* r3 return a new digits indice */
depileOper:
push {r4-r8,lr} @ save registers
cmp r2,#0 @ first operator ?
beq 60f
sub r5,r2,#1
1:
ldr r6,[r0,r5,lsl #2] @ load stack operator
cmp r6,r4 @ same operators
beq 50f
cmp r6,#'*' @ multiplication
beq 50f
cmp r6,#'/' @ division
beq 50f
cmp r6,#'-' @ soustraction
beq 50f
b 60f
50: @ depile operators stack and compute
sub r2,r2,#1
sub r3,r3,#1
bl compute
sub r5,r5,#1
cmp r5,#0
bge 1b
60:
str r4,[r0,r2,lsl #2] @ add operator in stack
add r2,r2,#1
100:
pop {r4-r8,lr}
bx lr @ return
/******************************************************************/
/* compute */
/******************************************************************/
/* r0 operator stack address */
/* r1 digits stack address */
/* r2 operator indice */
/* r3 digits indice */
compute:
push {r1-r8,lr} @ save registers
ldr r6,[r1,r3,lsl #2] @ load second digit
sub r5,r3,#1
ldr r7,[r1,r5,lsl #2] @ load first digit
ldr r8,[r0,r2,lsl #2] @ load operator
cmp r8,#'+'
bne 1f
add r7,r7,r6 @ addition
str r7,[r1,r5,lsl #2]
b 100f
1:
cmp r8,#'-'
bne 2f
sub r7,r7,r6 @ soustaction
str r7,[r1,r5,lsl #2]
b 100f
2:
cmp r8,#'*'
bne 3f @ multiplication
mul r7,r6,r7
str r7,[r1,r5,lsl #2]
b 100f
3:
cmp r8,#'/'
bne 4f
udiv r7,r7,r6 @ division
str r7,[r1,r5,lsl #2]
b 100f
4:
cmp r8,#'(' @ left parenthesis ?
bne 5f
ldr r0,iAdrszMessErrParen @ error
bl affichageMess
mov r0,#-1
b 100f
5:
ldr r0,iAdrszMessErrOper
bl affichageMess
mov r0,#-1
100:
pop {r1-r8,lr}
bx lr @ return
iAdrszMessErrOper: .int szMessErrOper
iAdrszMessErrParen: .int szMessErrParen
/******************************************************************/
/* control digits */
/******************************************************************/
/* r0 return 0 if OK 1 if not digit */
digitControl:
push {r1-r4,lr} @ save registers
ldr r1,iAdriTabTopDigit
ldr r2,iAdriTabDigit
mov r3,#0
1:
ldr r4,[r2,r3,lsl #2] @ load digit
cmp r0,r4 @ equal ?
beq 2f @ yes
add r3,r3,#1 @ no -> loop
cmp r3,#NBDIGITS @ end ?
blt 1b
ldr r0,iAdrszMessNoDigit @ error
bl affichageMess
mov r0,#1
b 100f
2: @ control prev use
ldr r4,[r1,r3,lsl #2]
cmp r4,#0
beq 3f
add r3,r3,#1
cmp r3,#NBDIGITS
blt 1b
ldr r0,iAdrszMessSameDigit
bl affichageMess
mov r0,#1
b 100f
3:
mov r4,#1
str r4,[r1,r3,lsl #2]
mov r0,#0
100:
pop {r1-r4,lr}
bx lr @ return
iAdrszMessNoDigit: .int szMessNoDigit
iAdrszMessSameDigit: .int szMessSameDigit
/******************************************************************/
/* string entry */
/******************************************************************/
/* r0 return the first character of human entry */
saisie:
push {r1-r7,lr} @ save registers
mov r0,#STDIN @ Linux input console
ldr r1,iAdrsBuffer @ buffer address
mov r2,#BUFFERSIZE @ buffer size
mov r7,#READ @ request to read datas
svc 0 @ call system
ldr r1,iAdrsBuffer @ buffer address
ldrb r0,[r1] @ load first character
100:
pop {r1-r7,lr}
bx lr @ return
iAdrsBuffer: .int sBuffer
/***************************************************/
/* Generation random number */
/***************************************************/
/* r0 contains limit */
genereraleas:
push {r1-r4,lr} @ save registers
ldr r4,iAdriGraine
ldr r2,[r4]
ldr r3,iNbDep1
mul r2,r3,r2
ldr r3,iNbDep2
add r2,r2,r3
str r2,[r4] @ maj de la graine pour l appel suivant
cmp r0,#0
beq 100f
add r1,r0,#1 @ divisor
mov r0,r2 @ dividende
bl division
mov r0,r3 @ résult = remainder
100: @ end function
pop {r1-r4,lr} @ restaur registers
bx lr @ return
/*****************************************************/
iAdriGraine: .int iGraine
iNbDep1: .int 0x343FD
iNbDep2: .int 0x269EC3
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"
24 Game The program will display four randomly-generated single-digit numbers and will then prompt you to enter an arithmetic expression followed by <enter> to sum the given numbers to 24. Exemple : 9+8+3+4 or (7+5)+(3*4) The four digits are 5 1 1 5 and the score is 24. Enter your expression (or type (q)uit to exit or (n) for other digits): n The four digits are 8 2 5 3 and the score is 24. Enter your expression (or type (q)uit to exit or (n) for other digits): (8*2)+5+3 It is OK. New game (y/n) ?
Arturo
print "-----------------------------"
print " Welcome to 24 Game"
print "-----------------------------"
digs: map 1..4 'x -> random 1 9
print ["The numbers you can use are:" join.with:" " digs]
print ""
validExpression?: function [expr][
loop expr 'item [
if or? inline? item block? item [
if not? validExpression? item -> return false
]
if symbol? item [
if not? contains? [+ / - *] item -> return false
]
if integer? item [
if not? contains? digs item -> return false
]
]
return true
]
result: 0
while [result<>24][
got: input "Enter an expression to form 24: "
blo: to :block got
if? validExpression? blo [
result: do blo
print ["The result is:" result]
]
else [
print "Invalid expression. Please try again!"
]
print ""
]
print "Well done!"
- Output:
----------------------------- Welcome to 24 Game ----------------------------- The numbers you can use are: 3 2 2 1 Enter an expression to form 24: 3+2+2+1\ Invalid expression. Please try again! Enter an expression to form 24: 3+2+2+1 The result is: 8 Enter an expression to form 24: (3+3+3+3+3)+2+2+1+1 The result is: 21 Enter an expression to form 24: (3+3+3+3+3)+2+2+1+1+1 The result is: 22 Enter an expression to form 24: 3+3+3+3+3+2+2+2+2+1+1 The result is: 25 Enter an expression to form 24: 3+3+3+3+3+2+2+2+2+1 The result is: 24 Well done!
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
}
AutoIt
;AutoIt Script Example
;by Daniel Barnes
;spam me at djbarnes at orcon dot net dot en zed
;13/08/2012
;Choose four random digits (1-9) with repetitions allowed:
global $digits
FOR $i = 1 TO 4
$digits &= Random(1,9,1)
NEXT
While 1
main()
WEnd
Func main()
$text = "Enter an equation (using all of, and only, the single digits "&$digits &")"&@CRLF
$text &= "which evaluates to exactly 24. Only multiplication (*) division (/)"&@CRLF
$text &= "addition (+) and subtraction (-) operations and parentheses are allowed:"
$input = InputBox ("24 Game",$text,"","",400,150)
If @error Then exit
;remove any spaces in input
$input = StringReplace($input," ","")
;check correct characters were used
For $i = 1 To StringLen($input)
$chr = StringMid($input,$i,1)
If Not StringInStr("123456789*/+-()",$chr) Then
MsgBox (0, "ERROR","Invalid character used: '"&$chr&"'")
return
endif
Next
;validate the equation uses all of the 4 characters, and nothing else
$test = $input
$test = StringReplace($test,"(","")
$test = StringReplace($test,")","")
;validate the length of the input - if its not 7 characters long then the user has done something wrong
If StringLen ($test) <> 7 Then
MsgBox (0,"ERROR","The equation "&$test&" is invalid")
return
endif
$test = StringReplace($test,"/","")
$test = StringReplace($test,"*","")
$test = StringReplace($test,"-","")
$test = StringReplace($test,"+","")
For $i = 1 To StringLen($digits)
$digit = StringMid($digits,$i,1)
For $ii = 1 To StringLen($test)
If StringMid($test,$ii,1) = $digit Then
$test = StringLeft($test,$ii-1) & StringRight($test,StringLen($test)-$ii)
ExitLoop
endif
Next
Next
If $test <> "" Then
MsgBox (0, "ERROR", "The equation didn't use all 4 characters, and nothing else!")
return
endif
$try = Execute($input)
If $try = 24 Then
MsgBox (0, "24 Game","Well done. Your equation ("&$input&") = 24!")
Exit
Else
MsgBox (0, "24 Game","Fail. Your equation ("&$input&") = "&$try&"!")
return
endif
EndFunc
BBC BASIC
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
Befunge
v > > >> v
2 2 1234
4 ^1?3^4
>8*00p10p> >? ?5> 68*+00g10gpv
v9?7v6 0
8 0
> > >> ^ g
^p00 _v# `\*49:+1 <
_>"rorrE",,,,,$ >~:67*-!#v_:167*+-!#v_:95*-!#v_:295*+-!#v_:586*+\`#v_:97*2--!#v
$ $ $ $ : $
* + - / 1 :
^ < < < < 8 .
6 6
* 4
+ *
\ -
` > v_v
"
^ < _v e
^ _^#+*28:p2\*84\-*86g2:-+*441< s
o
L
> 1 |-*49"#<
| -*84gg01g00<p00*84<v <
>00g:1+00p66*`#^_ "niW">:#,_@
The code functions by placing the 4 randomly generated numbers into the points labelled 1,2,3,4. In order to play, press the corresponding label to draw that number onto the stack, then press the corresponding operation (+,-,*,/) to perform it on the stack elements postfix-wise according to the rules of befunge (i.e. pop the values operate and push the answer back to the stack). When you wish to check your answer enter "=" and it will perform the checks to ensure that you haven't performed any illegal operations, that you have used all four numbers and that your final value is 24.
Unfortunately, due to the lack of floating-point arithmetic in befunge, divide will result in the answer truncated to an integer.
Example: 6566
213/-4*=
- Output:
24 Win
Bracmat
( 24-game
= m-w m-z 4numbers answer expr numbers
, seed get-random convertBinaryMinusToUnary
, convertDivisionToMultiplication isExpresssion reciprocal
. (seed=.!arg:(~0:~/#?m-w.~0:~/#?m-z))
& seed$!arg
& ( get-random
=
. 36969*mod$(!m-z.65536)+div$(!m-z.65536):?m-z
& 18000*mod$(!m-w.65536)+div$(!m-w.65536):?m-w
& mod$(!m-z*65536+!m-w.9)+1
)
& ( convertBinaryMinusToUnary
= a z
. @(!arg:%?a "-" ?z)
& str$(!a "+-1*" convertBinaryMinusToUnary$!z)
| !arg
)
& (reciprocal=.!arg^-1)
& ( convertDivisionToMultiplication
= a z
. @(!arg:?a "/" ?z)
& str$(!a "*reciprocal$" convertDivisionToMultiplication$!z)
| !arg
)
& ( isExpresssion
= A Z expr
. @( !arg
: ?A
("+"|"-"|"*"|"/")
( ?Z
& isExpresssion$!A
& isExpresssion$!Z
)
)
| !numbers:?A !arg ?Z
& !A !Z:?numbers
| ( @(!arg:"(" ?expr ")")
| @(!arg:(" "|\t) ?expr)
| @(!arg:?expr (" "|\t))
)
& isExpresssion$!expr
)
& out
$ "Enter an expression that evaluates to 24 by combining the following numbers."
& out$"You may only use the operators + - * /"
& out$"Parentheses and spaces are allowed."
& whl
' ( get-random$() get-random$() get-random$() get-random$
: ?4numbers
& out$!4numbers
& whl
' ( get'(,STR):?expr:~
& !4numbers:?numbers
& ~(isExpresssion$!expr&!numbers:)
& out
$ ( str
$ ( "["
!expr
"] is not a valid expression. Try another expression."
)
)
)
& !expr:~
& convertBinaryMinusToUnary$!expr:?expr
& convertDivisionToMultiplication$!expr:?expr
& get$(!expr,MEM):?answer
& out$(str$(!expr " = " !answer))
& !answer
: ( 24&out$Right!
| #&out$Wrong!
)
& out$"Try another one:"
)
& out$bye
)
& 24-game$(13.14)
& ;
Enter an expression that evaluates to 24 by combining the following numbers. You may only use the operators + - * / Parentheses and spaces are allowed. 4 2 2 7 4*7 - 2-2 4*7 +-1* 2+-1*2 = 24 Right! Try another one: 4 7 9 8 ((4) *(8 - (9- 7)) [((4) *(8 - (9- 7))] is not a valid expression. Try another expression. ((4) *(8 - (9- 7))) ((4) *(8 +-1* (9+-1* 7))) = 24 Right! Try another one: 9 5 8 5 5 * 5 - (9 - 8) 5 * 5 +-1* (9 +-1* 8) = 24 Right! Try another one: 5 9 7 8 5*8 - 9 - 7 5*8 +-1* 9 +-1* 7 = 24 Right! Try another one: 7 8 6 2 8 * ((7 - 6) + 2) 8 * ((7 +-1* 6) + 2) = 24 Right! Try another one: 8 6 8 1 8 * (1 + 8 - 6) 8 * (1 + 8 +-1* 6) = 24 Right! Try another one: 8 2 2 4 8 * (2 + 4)/2 8 * (2 + 4)*reciprocal$2 = 24 Right! Try another one: 8 4 6 7 bye
C
Simple recursive descent parser. It doesn't have a real lexer, because all tokens are single character (digits, operators and parens). Code is a little too long.
#include <stdio.h>
#include <ctype.h>
#include <stdlib.h>
#include <setjmp.h>
#include <time.h>
jmp_buf ctx;
const char *msg;
enum { OP_NONE = 0, OP_NUM, OP_ADD, OP_SUB, OP_MUL, OP_DIV };
typedef struct expr_t *expr, expr_t;
struct expr_t {
int op, val, used;
expr left, right;
};
#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(const char *s)
{
msg = s;
longjmp(ctx, 1);
}
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();
setjmp(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;
}
- 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#
See 24 game/CSharp
C++
This uses the C++11 standard to simplify several parts of the code. Input is given in RPN format.
#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;
}
- 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!
Ceylon
Be sure to import ceylon.random in you ceylon.module file.
import ceylon.random {
DefaultRandom
}
class Rational(shared Integer numerator, shared Integer denominator = 1) satisfies Numeric<Rational> {
assert (denominator != 0);
Integer gcd(Integer a, Integer b) => if (b == 0) then a else gcd(b, a % b);
shared Rational inverted => Rational(denominator, numerator);
shared Rational simplified =>
let (largestFactor = gcd(numerator, denominator))
Rational(numerator / largestFactor, denominator / largestFactor);
divided(Rational other) => (this * other.inverted).simplified;
negated => Rational(-numerator, denominator).simplified;
plus(Rational other) =>
let (top = numerator*other.denominator + other.numerator*denominator,
bottom = denominator * other.denominator)
Rational(top, bottom).simplified;
times(Rational other) =>
Rational(numerator * other.numerator, denominator * other.denominator).simplified;
shared Integer integer => numerator / denominator;
shared Float float => numerator.float / denominator.float;
string => denominator == 1 then numerator.string else "``numerator``/``denominator``";
shared actual Boolean equals(Object that) {
if (is Rational that) {
value simplifiedThis = this.simplified;
value simplifiedThat = that.simplified;
return simplifiedThis.numerator==simplifiedThat.numerator &&
simplifiedThis.denominator==simplifiedThat.denominator;
}
else {
return false;
}
}
}
interface Expression {
shared formal Rational evaluate();
}
class NumberExpression(Rational number) satisfies Expression {
evaluate() => number;
string => number.string;
}
class OperatorExpression(Expression left, Character operator, Expression right) satisfies Expression {
shared actual Rational evaluate() {
switch (operator)
case ('*') {
return left.evaluate() * right.evaluate();
}
case ('/') {
return left.evaluate() / right.evaluate();
}
case ('-') {
return left.evaluate() - right.evaluate();
}
case ('+') {
return left.evaluate() + right.evaluate();
}
else {
throw Exception("unknown operator ``operator``");
}
}
string => "(``left.string`` ``operator.string`` ``right.string``)";
}
"A simplified top down operator precedence parser. There aren't any right
binding operators so we don't have to worry about that."
class PrattParser(String input) {
value tokens = input.replace(" ", "");
variable value index = -1;
shared Expression expression(Integer precedence = 0) {
value token = advance();
variable value left = parseUnary(token);
while (precedence < getPrecedence(peek())) {
value nextToken = advance();
left = parseBinary(left, nextToken);
}
return left;
}
Integer getPrecedence(Character op) =>
switch (op)
case ('*' | '/') 2
case ('+' | '-') 1
else 0;
Character advance(Character? expected = null) {
index++;
value token = tokens[index] else ' ';
if (exists expected, token != expected) {
throw Exception("unknown character ``token``");
}
return token;
}
Character peek() => tokens[index + 1] else ' ';
Expression parseBinary(Expression left, Character operator) =>
let (right = expression(getPrecedence(operator)))
OperatorExpression(left, operator, right);
Expression parseUnary(Character token) {
if (token.digit) {
assert (is Integer int = Integer.parse(token.string));
return NumberExpression(Rational(int));
}
else if (token == '(') {
value exp = expression();
advance(')');
return exp;
}
else {
throw Exception("unknown character ``token``");
}
}
}
shared void run() {
value random = DefaultRandom();
function random4Numbers() =>
random.elements(1..9).take(4).sequence();
function isValidGuess(String input, {Integer*} allowedNumbers) {
value allowedOperators = set { *"()+-/*" };
value extractedNumbers = input
.split((Character ch) => ch in allowedOperators || ch.whitespace)
.map((String element) => Integer.parse(element))
.narrow<Integer>();
if (extractedNumbers.any((Integer element) => element > 9)) {
print("number too big!");
return false;
}
if (extractedNumbers.any((Integer element) => element < 1)) {
print("number too small!");
return false;
}
if (extractedNumbers.sort(increasing) != allowedNumbers.sort(increasing)) {
print("use all the numbers, please!");
return false;
}
if (!input.every((Character element) => element in allowedOperators || element.digit || element.whitespace)) {
print("only digits and mathematical operators, please");
return false;
}
variable value leftParens = 0;
for (c in input) {
if (c == '(') {
leftParens++;
} else if (c == ')') {
leftParens--;
if (leftParens < 0) {
break;
}
}
}
if (leftParens != 0) {
print("unbalanced brackets!");
return false;
}
return true;
}
function evaluate(String input) =>
let (parser = PrattParser(input),
exp = parser.expression())
exp.evaluate();
print("Welcome to The 24 Game.
Create a mathematical equation with four random
numbers that evaluates to 24.
You must use all the numbers once and only once,
but in any order.
Also, only + - / * and parentheses are allowed.
For example: (1 + 2 + 3) * 4
Also: enter n for new numbers and q to quit.
-----------------------------------------------");
value twentyfour = Rational(24);
while (true) {
value chosenNumbers = random4Numbers();
void pleaseTryAgain() => print("Sorry, please try again. (Your numbers are ``chosenNumbers``)");
print("Your numbers are ``chosenNumbers``. Please turn them into 24.");
while (true) {
value line = process.readLine()?.trimmed;
if (exists line) {
if (line.uppercased == "Q") { // quit
print("bye!");
return;
}
if (line.uppercased == "N") { // new game
break;
}
if (isValidGuess(line, chosenNumbers)) {
try {
value result = evaluate(line);
print("= ``result``");
if (result == twentyfour) {
print("You did it!");
break;
}
else {
pleaseTryAgain();
}
}
catch (Exception e) {
print(e.message);
pleaseTryAgain();
}
}
else {
pleaseTryAgain();
}
}
}
}
}
Clojure
(ns rosettacode.24game)
(def ^:dynamic *luser*
"You guessed wrong, or your input was not in prefix notation.")
(def ^:private start #(println
"Your numbers are: " %1 ". Your goal is " %2 ".\n"
"Use the ops [+ - * /] in prefix notation to reach" %2 ".\n"
"q[enter] to quit."))
(defn play
([] (play 24))
([goal] (play goal (repeatedly 4 #(inc (rand-int 9)))))
([goal gns]
(start gns goal)
(let [input (read-string (read-line))
flat (flatten input)]
(println
(if (and (re-find #"^\([\d\s+*/-]+\d?\)$" (pr-str flat))
(= (set gns) (set (filter integer? flat)))
(= goal (eval input)))
"You won the game!"
*luser*))
(when (not= input 'q) (recur goal gns)))))
; * checks prefix form, then checks to see that the numbers used
; and the numbers generated by the game are the same.
COBOL
>>SOURCE FORMAT FREE
*> This code is dedicated to the public domain
*> This is GNUCobol 2.0
identification division.
program-id. twentyfour.
environment division.
configuration section.
repository. function all intrinsic.
data division.
working-storage section.
01 p pic 999.
01 p1 pic 999.
01 p-max pic 999 value 38.
01 program-syntax pic x(494) value
*>statement = expression;
'001 001 000 n'
& '002 000 004 ='
& '003 005 000 n'
& '004 000 002 ;'
*>expression = term, {('+'|'-') term,};
& '005 005 000 n'
& '006 000 016 ='
& '007 017 000 n'
& '008 000 015 {'
& '009 011 013 ('
& '010 001 000 t'
& '011 013 000 |'
& '012 002 000 t'
& '013 000 009 )'
& '014 017 000 n'
& '015 000 008 }'
& '016 000 006 ;'
*>term = factor, {('*'|'/') factor,};
& '017 017 000 n'
& '018 000 028 ='
& '019 029 000 n'
& '020 000 027 {'
& '021 023 025 ('
& '022 003 000 t'
& '023 025 000 |'
& '024 004 000 t'
& '025 000 021 )'
& '026 029 000 n'
& '027 000 020 }'
& '028 000 018 ;'
*>factor = ('(' expression, ')' | digit,);
& '029 029 000 n'
& '030 000 038 ='
& '031 035 037 ('
& '032 005 000 t'
& '033 005 000 n'
& '034 006 000 t'
& '035 037 000 |'
& '036 000 000 n'
& '037 000 031 )'
& '038 000 030 ;'.
01 filler redefines program-syntax.
03 p-entry occurs 038.
05 p-address pic 999.
05 filler pic x.
05 p-definition pic 999.
05 p-alternate redefines p-definition pic 999.
05 filler pic x.
05 p-matching pic 999.
05 filler pic x.
05 p-symbol pic x.
01 t pic 999.
01 t-len pic 99 value 6.
01 terminal-symbols
pic x(210) value
'01 + '
& '01 - '
& '01 * '
& '01 / '
& '01 ( '
& '01 ) '.
01 filler redefines terminal-symbols.
03 terminal-symbol-entry occurs 6.
05 terminal-symbol-len pic 99.
05 filler pic x.
05 terminal-symbol pic x(32).
01 nt pic 999.
01 nt-lim pic 99 value 5.
01 nonterminal-statements pic x(294) value
"000 ....,....,....,....,....,....,....,....,....,"
& "001 statement = expression; "
& "005 expression = term, {('+'|'-') term,}; "
& "017 term = factor, {('*'|'/') factor,}; "
& "029 factor = ('(' expression, ')' | digit,); "
& "036 digit; ".
01 filler redefines nonterminal-statements.
03 nonterminal-statement-entry occurs 5.
05 nonterminal-statement-number pic 999.
05 filler pic x.
05 nonterminal-statement pic x(45).
01 indent pic x(64) value all '| '.
01 interpreter-stack.
03 r pic 99. *> previous top of stack
03 s pic 99. *> current top of stack
03 s-max pic 99 value 32.
03 s-entry occurs 32.
05 filler pic x(2) value 'p='.
05 s-p pic 999. *> callers return address
05 filler pic x(4) value ' sc='.
05 s-start-control pic 999. *> sequence start address
05 filler pic x(4) value ' ec='.
05 s-end-control pic 999. *> sequence end address
05 filler pic x(4) value ' al='.
05 s-alternate pic 999. *> the next alternate
05 filler pic x(3) value ' r='.
05 s-result pic x. *> S success, F failure, N no result
05 filler pic x(3) value ' c='.
05 s-count pic 99. *> successes in a sequence
05 filler pic x(3) value ' x='.
05 s-repeat pic 99. *> repeats in a {} sequence
05 filler pic x(4) value ' nt='.
05 s-nt pic 99. *> current nonterminal
01 language-area.
03 l pic 99.
03 l-lim pic 99.
03 l-len pic 99 value 1.
03 nd pic 9.
03 number-definitions.
05 n occurs 4 pic 9.
03 nu pic 9.
03 number-use.
05 u occurs 4 pic x.
03 statement.
05 c occurs 32.
07 c9 pic 9.
01 number-validation.
03 p4 pic 99.
03 p4-lim pic 99 value 24.
03 permutations-4 pic x(96) value
'1234'
& '1243'
& '1324'
& '1342'
& '1423'
& '1432'
& '2134'
& '2143'
& '2314'
& '2341'
& '2413'
& '2431'
& '3124'
& '3142'
& '3214'
& '3241'
& '3423'
& '3432'
& '4123'
& '4132'
& '4213'
& '4231'
& '4312'
& '4321'.
03 filler redefines permutations-4.
05 permutation-4 occurs 24 pic x(4).
03 current-permutation-4 pic x(4).
03 cpx pic 9.
03 od1 pic 9.
03 od2 pic 9.
03 odx pic 9.
03 od-lim pic 9 value 4.
03 operator-definitions pic x(4) value '+-*/'.
03 current-operators pic x(3).
03 co3 pic 9.
03 rpx pic 9.
03 rpx-lim pic 9 value 4.
03 valid-rpn-forms pic x(28) value
'nnonono'
& 'nnnonoo'
& 'nnnoono'
& 'nnnnooo'.
03 filler redefines valid-rpn-forms.
05 rpn-form occurs 4 pic x(7).
03 current-rpn-form pic x(7).
01 calculation-area.
03 osx pic 99.
03 operator-stack pic x(32).
03 oqx pic 99.
03 oqx1 pic 99.
03 output-queue pic x(32).
03 work-number pic s9999.
03 top-numerator pic s9999 sign leading separate.
03 top-denominator pic s9999 sign leading separate.
03 rsx pic 9.
03 result-stack occurs 8.
05 numerator pic s9999.
05 denominator pic s9999.
01 error-found pic x.
01 divide-by-zero-error pic x.
*> diagnostics
01 NL pic x value x'0A'.
01 NL-flag pic x value space.
01 display-level pic x value '0'.
01 loop-lim pic 9999 value 1500.
01 loop-count pic 9999 value 0.
01 message-area value spaces.
03 message-level pic x.
03 message-value pic x(128).
*> input and examples
01 instruction pic x(32) value spaces.
01 tsx pic 99.
01 tsx-lim pic 99 value 14.
01 test-statements.
03 filler pic x(32) value '1234;1 + 2 + 3 + 4'.
03 filler pic x(32) value '1234;1 * 2 * 3 * 4'.
03 filler pic x(32) value '1234;((1)) * (((2 * 3))) * 4'.
03 filler pic x(32) value '1234;((1)) * ((2 * 3))) * 4'.
03 filler pic x(32) value '1234;(1 + 2 + 3 + 4'.
03 filler pic x(32) value '1234;)1 + 2 + 3 + 4'.
03 filler pic x(32) value '1234;1 * * 2 * 3 * 4'.
03 filler pic x(32) value '5679;6 - (5 - 7) * 9'.
03 filler pic x(32) value '1268;((1 * (8 * 6) / 2))'.
03 filler pic x(32) value '4583;-5-3+(8*4)'.
03 filler pic x(32) value '4583;8 * 4 - 5 - 3'.
03 filler pic x(32) value '4583;8 * 4 - (5 + 3)'.
03 filler pic x(32) value '1223;1 * 3 / (2 - 2)'.
03 filler pic x(32) value '2468;(6 * 8) / 4 / 2'.
01 filler redefines test-statements.
03 filler occurs 14.
05 test-numbers pic x(4).
05 filler pic x.
05 test-statement pic x(27).
procedure division.
start-twentyfour.
display 'start twentyfour'
perform generate-numbers
display 'type h <enter> to see instructions'
accept instruction
perform until instruction = spaces or 'q'
evaluate true
when instruction = 'h'
perform display-instructions
when instruction = 'n'
perform generate-numbers
when instruction(1:1) = 'm'
move instruction(2:4) to number-definitions
perform validate-number
if divide-by-zero-error = space
and 24 * top-denominator = top-numerator
display number-definitions ' is solved by ' output-queue(1:oqx)
else
display number-definitions ' is not solvable'
end-if
when instruction = 'd0' or 'd1' or 'd2' or 'd3'
move instruction(2:1) to display-level
when instruction = 'e'
display 'examples:'
perform varying tsx from 1 by 1
until tsx > tsx-lim
move spaces to statement
move test-numbers(tsx) to number-definitions
move test-statement(tsx) to statement
perform evaluate-statement
perform show-result
end-perform
when other
move instruction to statement
perform evaluate-statement
perform show-result
end-evaluate
move spaces to instruction
display 'instruction? ' with no advancing
accept instruction
end-perform
display 'exit twentyfour'
stop run
.
generate-numbers.
perform with test after until divide-by-zero-error = space
and 24 * top-denominator = top-numerator
compute n(1) = random(seconds-past-midnight) * 10 *> seed
perform varying nd from 1 by 1 until nd > 4
compute n(nd) = random() * 10
perform until n(nd) <> 0
compute n(nd) = random() * 10
end-perform
end-perform
perform validate-number
end-perform
display NL 'numbers:' with no advancing
perform varying nd from 1 by 1 until nd > 4
display space n(nd) with no advancing
end-perform
display space
.
validate-number.
perform varying p4 from 1 by 1 until p4 > p4-lim
move permutation-4(p4) to current-permutation-4
perform varying od1 from 1 by 1 until od1 > od-lim
move operator-definitions(od1:1) to current-operators(1:1)
perform varying od2 from 1 by 1 until od2 > od-lim
move operator-definitions(od2:1) to current-operators(2:1)
perform varying odx from 1 by 1 until odx > od-lim
move operator-definitions(odx:1) to current-operators(3:1)
perform varying rpx from 1 by 1 until rpx > rpx-lim
move rpn-form(rpx) to current-rpn-form
move 0 to cpx co3
move spaces to output-queue
move 7 to oqx
perform varying oqx1 from 1 by 1 until oqx1 > oqx
if current-rpn-form(oqx1:1) = 'n'
add 1 to cpx
move current-permutation-4(cpx:1) to nd
move n(nd) to output-queue(oqx1:1)
else
add 1 to co3
move current-operators(co3:1) to output-queue(oqx1:1)
end-if
end-perform
end-perform
perform evaluate-rpn
if divide-by-zero-error = space
and 24 * top-denominator = top-numerator
exit paragraph
end-if
end-perform
end-perform
end-perform
end-perform
.
display-instructions.
display '1) Type h <enter> to repeat these instructions.'
display '2) The program will display four randomly-generated'
display ' single-digit numbers and will then prompt you to enter'
display ' an arithmetic expression followed by <enter> to sum'
display ' the given numbers to 24.'
display ' The four numbers may contain duplicates and the entered'
display ' expression must reference all the generated numbers and duplicates.'
display ' Warning: the program converts the entered infix expression'
display ' to a reverse polish notation (rpn) expression'
display ' which is then interpreted from RIGHT to LEFT.'
display ' So, for instance, 8*4 - 5 - 3 will not sum to 24.'
display '3) Type n <enter> to generate a new set of four numbers.'
display ' The program will ensure the generated numbers are solvable.'
display '4) Type m#### <enter> (e.g. m1234) to create a fixed set of numbers'
display ' for testing purposes.'
display ' The program will test the solvability of the entered numbers.'
display ' For example, m1234 is solvable and m9999 is not solvable.'
display '5) Type d0, d1, d2 or d3 followed by <enter> to display none or'
display ' increasingly detailed diagnostic information as the program evaluates'
display ' the entered expression.'
display '6) Type e <enter> to see a list of example expressions and results'
display '7) Type <enter> or q <enter> to exit the program'
.
show-result.
if error-found = 'y'
or divide-by-zero-error = 'y'
exit paragraph
end-if
display 'statement in RPN is' space output-queue
evaluate true
when top-numerator = 0
when top-denominator = 0
when 24 * top-denominator <> top-numerator
display 'result (' top-numerator '/' top-denominator ') is not 24'
when other
display 'result is 24'
end-evaluate
.
evaluate-statement.
compute l-lim = length(trim(statement))
display NL 'numbers:' space n(1) space n(2) space n(3) space n(4)
move number-definitions to number-use
display 'statement is' space statement
move 1 to l
move 0 to loop-count
move space to error-found
move 0 to osx oqx
move spaces to output-queue
move 1 to p
move 1 to nt
move 0 to s
perform increment-s
perform display-start-nonterminal
perform increment-p
*>===================================
*> interpret ebnf
*>===================================
perform until s = 0
or error-found = 'y'
evaluate true
when p-symbol(p) = 'n'
and p-definition(p) = 000 *> a variable
perform test-variable
if s-result(s) = 'S'
perform increment-l
end-if
perform increment-p
when p-symbol(p) = 'n'
and p-address(p) <> p-definition(p) *> nonterminal reference
move p to s-p(s)
move p-definition(p) to p
when p-symbol(p) = 'n'
and p-address(p) = p-definition(p) *> nonterminal definition
perform increment-s
perform display-start-nonterminal
perform increment-p
when p-symbol(p) = '=' *> nonterminal control
move p to s-start-control(s)
move p-matching(p) to s-end-control(s)
perform increment-p
when p-symbol(p) = ';' *> end nonterminal
perform display-end-control
perform display-end-nonterminal
perform decrement-s
if s > 0
evaluate true
when s-result(r) = 'S'
perform set-success
when s-result(r) = 'F'
perform set-failure
end-evaluate
move s-p(s) to p
perform increment-p
perform display-continue-nonterminal
end-if
when p-symbol(p) = '{' *> start repeat sequence
perform increment-s
perform display-start-control
move p to s-start-control(s)
move p-alternate(p) to s-alternate(s)
move p-matching(p) to s-end-control(s)
move 0 to s-count(s)
perform increment-p
when p-symbol(p) = '}' *> end repeat sequence
perform display-end-control
evaluate true
when s-result(s) = 'S' *> repeat the sequence
perform display-repeat-control
perform set-nothing
add 1 to s-repeat(s)
move s-start-control(s) to p
perform increment-p
when other
perform decrement-s
evaluate true
when s-result(r) = 'N'
and s-repeat(r) = 0 *> no result
perform increment-p
when s-result(r) = 'N'
and s-repeat(r) > 0 *> no result after success
perform set-success
perform increment-p
when other *> fail the sequence
perform increment-p
end-evaluate
end-evaluate
when p-symbol(p) = '(' *> start sequence
perform increment-s
perform display-start-control
move p to s-start-control(s)
move p-alternate(p) to s-alternate(s)
move p-matching(p) to s-end-control(s)
move 0 to s-count(s)
perform increment-p
when p-symbol(p) = ')' *> end sequence
perform display-end-control
perform decrement-s
evaluate true
when s-result(r) = 'S' *> success
perform set-success
perform increment-p
when s-result(r) = 'N' *> no result
perform set-failure
perform increment-p
when other *> fail the sequence
perform set-failure
perform increment-p
end-evaluate
when p-symbol(p) = '|' *> alternate
evaluate true
when s-result(s) = 'S' *> exit the sequence
perform display-skip-alternate
move s-end-control(s) to p
when other
perform display-take-alternate
move p-alternate(p) to s-alternate(s) *> the next alternate
perform increment-p
perform set-nothing
end-evaluate
when p-symbol(p) = 't' *> terminal
move p-definition(p) to t
move terminal-symbol-len(t) to t-len
perform display-terminal
evaluate true
when statement(l:t-len) = terminal-symbol(t)(1:t-len) *> successful match
perform set-success
perform display-recognize-terminal
perform process-token
move t-len to l-len
perform increment-l
perform increment-p
when s-alternate(s) <> 000 *> we are in an alternate sequence
move s-alternate(s) to p
when other *> fail the sequence
perform set-failure
move s-end-control(s) to p
end-evaluate
when other *> end control
perform display-control-failure *> shouldnt happen
end-evaluate
end-perform
evaluate true *> at end of evaluation
when error-found = 'y'
continue
when l <= l-lim *> not all tokens parsed
display 'error: invalid statement'
perform statement-error
when number-use <> spaces
display 'error: not all numbers were used: ' number-use
move 'y' to error-found
end-evaluate
.
increment-l.
evaluate true
when l > l-lim *> end of statement
continue
when other
add l-len to l
perform varying l from l by 1
until c(l) <> space
or l > l-lim
continue
end-perform
move 1 to l-len
if l > l-lim
perform end-tokens
end-if
end-evaluate
.
increment-p.
evaluate true
when p >= p-max
display 'at' space p ' parse overflow'
space 's=<' s space s-entry(s) '>'
move 'y' to error-found
when other
add 1 to p
perform display-statement
end-evaluate
.
increment-s.
evaluate true
when s >= s-max
display 'at' space p ' stack overflow '
space 's=<' s space s-entry(s) '>'
move 'y' to error-found
when other
move s to r
add 1 to s
initialize s-entry(s)
move 'N' to s-result(s)
move p to s-p(s)
move nt to s-nt(s)
end-evaluate
.
decrement-s.
if s > 0
move s to r
subtract 1 from s
if s > 0
move s-nt(s) to nt
end-if
end-if
.
set-failure.
move 'F' to s-result(s)
if s-count(s) > 0
display 'sequential parse failure'
perform statement-error
end-if
.
set-success.
move 'S' to s-result(s)
add 1 to s-count(s)
.
set-nothing.
move 'N' to s-result(s)
move 0 to s-count(s)
.
statement-error.
display statement
move spaces to statement
move '^ syntax error' to statement(l:)
display statement
move 'y' to error-found
.
*>=====================
*> twentyfour semantics
*>=====================
test-variable.
*> check validity
perform varying nd from 1 by 1 until nd > 4
or c(l) = n(nd)
continue
end-perform
*> check usage
perform varying nu from 1 by 1 until nu > 4
or c(l) = u(nu)
continue
end-perform
evaluate true
when l > l-lim
perform set-failure
when c9(l) not numeric
perform set-failure
when nd > 4
display 'invalid number'
perform statement-error
when nu > 4
display 'number already used'
perform statement-error
when other
move space to u(nu)
perform set-success
add 1 to oqx
move c(l) to output-queue(oqx:1)
end-evaluate
.
*> ==================================
*> Dijkstra Shunting-Yard Algorithm
*> to convert infix to rpn
*> ==================================
process-token.
evaluate true
when c(l) = '('
add 1 to osx
move c(l) to operator-stack(osx:1)
when c(l) = ')'
perform varying osx from osx by -1 until osx < 1
or operator-stack(osx:1) = '('
add 1 to oqx
move operator-stack(osx:1) to output-queue(oqx:1)
end-perform
if osx < 1
display 'parenthesis error'
perform statement-error
exit paragraph
end-if
subtract 1 from osx
when (c(l) = '+' or '-') and (operator-stack(osx:1) = '*' or '/')
*> lesser operator precedence
add 1 to oqx
move operator-stack(osx:1) to output-queue(oqx:1)
move c(l) to operator-stack(osx:1)
when other
*> greater operator precedence
add 1 to osx
move c(l) to operator-stack(osx:1)
end-evaluate
.
end-tokens.
*> 1) copy stacked operators to the output-queue
perform varying osx from osx by -1 until osx < 1
or operator-stack(osx:1) = '('
add 1 to oqx
move operator-stack(osx:1) to output-queue(oqx:1)
end-perform
if osx > 0
display 'parenthesis error'
perform statement-error
exit paragraph
end-if
*> 2) evaluate the rpn statement
perform evaluate-rpn
if divide-by-zero-error = 'y'
display 'divide by zero error'
end-if
.
evaluate-rpn.
move space to divide-by-zero-error
move 0 to rsx *> stack depth
perform varying oqx1 from 1 by 1 until oqx1 > oqx
if output-queue(oqx1:1) >= '1' and <= '9'
*> push current data onto the stack
add 1 to rsx
move top-numerator to numerator(rsx)
move top-denominator to denominator(rsx)
move output-queue(oqx1:1) to top-numerator
move 1 to top-denominator
else
*> apply the operation
evaluate true
when output-queue(oqx1:1) = '+'
compute top-numerator = top-numerator * denominator(rsx)
+ top-denominator * numerator(rsx)
compute top-denominator = top-denominator * denominator(rsx)
when output-queue(oqx1:1) = '-'
compute top-numerator = top-denominator * numerator(rsx)
- top-numerator * denominator(rsx)
compute top-denominator = top-denominator * denominator(rsx)
when output-queue(oqx1:1) = '*'
compute top-numerator = top-numerator * numerator(rsx)
compute top-denominator = top-denominator * denominator(rsx)
when output-queue(oqx1:1) = '/'
compute work-number = numerator(rsx) * top-denominator
compute top-denominator = denominator(rsx) * top-numerator
if top-denominator = 0
move 'y' to divide-by-zero-error
exit paragraph
end-if
move work-number to top-numerator
end-evaluate
*> pop the stack
subtract 1 from rsx
end-if
end-perform
.
*>====================
*> diagnostic displays
*>====================
display-start-nonterminal.
perform varying nt from nt-lim by -1 until nt < 1
or p-definition(p) = nonterminal-statement-number(nt)
continue
end-perform
if nt > 0
move '1' to NL-flag
string '1' indent(1:s + s) 'at ' s space p ' start ' trim(nonterminal-statement(nt))
into message-area perform display-message
move nt to s-nt(s)
end-if
.
display-continue-nonterminal.
move s-nt(s) to nt
string '1' indent(1:s + s) 'at ' s space p space p-symbol(p) ' continue ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
into message-area perform display-message
.
display-end-nonterminal.
move s-nt(s) to nt
move '2' to NL-flag
string '1' indent(1:s + s) 'at ' s space p ' end ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
into message-area perform display-message
.
display-start-control.
string '2' indent(1:s + s) 'at ' s space p ' start ' p-symbol(p) ' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-repeat-control.
string '2' indent(1:s + s) 'at ' s space p ' repeat ' p-symbol(p) ' in ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
into message-area perform display-message
.
display-end-control.
string '2' indent(1:s + s) 'at ' s space p ' end ' p-symbol(p) ' in ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
into message-area perform display-message
.
display-take-alternate.
string '2' indent(1:s + s) 'at ' s space p ' take alternate' ' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-skip-alternate.
string '2' indent(1:s + s) 'at ' s space p ' skip alternate' ' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-terminal.
string '1' indent(1:s + s) 'at ' s space p
' compare ' statement(l:t-len) ' to ' terminal-symbol(t)(1:t-len)
' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-recognize-terminal.
string '1' indent(1:s + s) 'at ' s space p ' recognize terminal: ' c(l) ' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-recognize-variable.
string '1' indent(1:s + s) 'at ' s space p ' recognize digit: ' c(l) ' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-statement.
compute p1 = p - s-start-control(s)
string '3' indent(1:s + s) 'at ' s space p
' statement: ' s-start-control(s) '/' p1
space p-symbol(p) space s-result(s)
' in ' trim(nonterminal-statement(nt))
into message-area perform display-message
.
display-control-failure.
display loop-count space indent(1:s + s) 'at' space p ' control failure' ' in ' trim(nonterminal-statement(nt))
display loop-count space indent(1:s + s) ' ' 'p=<' p p-entry(p) '>'
display loop-count space indent(1:s + s) ' ' 's=<' s space s-entry(s) '>'
display loop-count space indent(1:s + s) ' ' 'l=<' l space c(l)'>'
perform statement-error
.
display-message.
if display-level = 1
move space to NL-flag
end-if
evaluate true
when loop-count > loop-lim *> loop control
display 'display count exceeds ' loop-lim
stop run
when message-level <= display-level
evaluate true
when NL-flag = '1'
display NL loop-count space trim(message-value)
when NL-flag = '2'
display loop-count space trim(message-value) NL
when other
display loop-count space trim(message-value)
end-evaluate
end-evaluate
add 1 to loop-count
move spaces to message-area
move space to NL-flag
.
end program twentyfour.
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()
Commodore BASIC
This solution was taken from the ZX Spectrum example further down, however, BASIC on the Spectrum features slightly different string handling functions. Most importantly, while the val()
function on the Spectrum is able to parse complete mathematical expressions within the string as it converts it to a number, Commodore BASIC will obtain only a single number provided that the first character is a valid numeric character and up to any non-numeric character. (Even floating-point numbers where 0 < n < 1 must begin with a leading 0 prior to the decimal point.)
To get around this, this program utilizes BASIC's ability to parse expressions containing simple math operators, and is in fact technically a self-modifying program. Line 2005 is a line padded with colons which simply allow BASIC to join multiple statements on a single line, otherwise perform no operation. This reserves sufficient space in memory for inserting the user's expression—by overwriting the first several bytes of colons—which can then be evaluated in the normal course of the program's execution. The subroutine at 1400 initializes a simple translation table for exchanging the operators into their proper BASIC tokens. Parenthesis, numerals, and variable names do not need to be translated.
After the user types in an expression, the program validates the input (same algorithms as the ZX Spectrum example), writes the expression as R=expression
as tokenized BASIC into line 2005, and then executes the subroutine at 2000 to obtain the value. Upon return, the content of the variable R
is evaluated to see if it is 24.
If the statement at line 645 is uncommented, this will allow the program to "erase" line 2005 and thus "hide" the trick. As is, if you list the program after making an attempt, you will see the last expression given to the program.
Since Commodore BASIC v2 was the initial target for this program, all other versions of Commodore BASIC are compatible as long as the base memory address for BASIC programs is adjusted. (BASIC tokens maintain compatibility across all versions.) Simply use the appropriate values for bh
and bl
in lines 11-15.
1 rem 24 game
2 rem for rosetta code
10 rem use appropriate basic base address
11 bh=08:bl=01: rem $0801 commodore 64
12 rem bh=16:bl=01: rem $1001 commodore +4
13 rem bh=18:bl=01: rem $1201 commodore vic-20 (35k ram)
14 rem bh=04:bl=01: rem $0401 commodore pet
15 rem bh=28:bl=01: rem $1c01 commodore 128 (bank 0)
35 print chr$(147);chr$(14);"Initializing...":gosub 1400
40 n$="":x=rnd(-ti):rem similar to 'randomize'
45 for i=1 to 4
50 t$=str$(int(rnd(1)*9)+1)
55 n$=n$+mid$(t$,2,1)
60 next i
65 print chr$(147)
70 print spc(16);"24 Game"
71 print:print " The goal of this game is to formulate"
72 print:print " an arithmetic expression that"
73 print:print " evaluates to a value of 24, however"
74 print:print " you may use only the four numbers"
75 print:print " given at random by the computer and"
76 print:print " the standard arithmetic operations of"
77 print:print " add, subtract, multiply, and divide."
78 print:print " Each digit must be used by itself. "
79 print:print " (e.g. if given 1, 2, 3, 4, you cannot"
80 print:print " combine 1 and 2 to make 12.)"
89 gosub 1000
90 i$="":f$="":p$=""
95 print chr$(147);"Allowed characters:"
100 i$=n$+"+-*/()"
110 print
120 for i=1 to len(i$)
130 print mid$(i$,i,1);" ";
140 next i:print
150 print:print "Spaces are ignored."
155 print "Enter 'end' to end.":print
160 input "Enter the formula";f$
170 if f$="end" then print "Program terminated.":end
180 print:print "Checking syntax... ";tab(34);
190 for i=1 to len(f$)
200 if mid$(f$,i,1)=" " then next i
210 c$=mid$(f$,i,1)
220 if c$="+" or c$="-" or c$="*" or c$="/" then p$=p$+"o":goto 250
230 if c$="(" or c$=")" then p$=p$+c$:goto 250
240 p$=p$+"n"
250 next i
260 restore
270 for i=1 to 11
280 read t$
290 if t$=p$ then i=11
300 next i
310 if t$<>p$ then gosub 1100:gosub 1000:goto 90
315 print "OK":print "Checking for illegal numbers... ";tab(34);
320 for i=1 to len(f$)
330 for j=1 to 10
335 ft$=mid$(f$,i,1)
336 il$=left$(i$,j-1):it$=mid$(i$,j,1):ir$=mid$(i$,j+1,len(i$))
340 if ft$=it$ and ft$>"0" and ft$<="9" then i$=il$+" "+ir$
350 next j
360 next i
370 if mid$(i$,1,4)<>" " then gosub 1200:gosub 1000:goto 90
375 print "OK":print "Evaluating expression...":print:print tab(10);f$;" =";
380 gosub 600:rem r=val(f$)
390 print r;" "
400 if r<>24 then gosub 1300:gosub 1000:goto 90
410 print "Correct!"
420 print:print "Would you like to go again (y/n)? ";
425 get k$:if k$<>"y" and k$<>"n" then 425
430 print k$
435 if k$="y" then goto 40
440 print:print "Very well. Have a nice day!"
450 end
500 rem pattern matching
501 data "nononon","(non)onon","nono(non)"
504 data "no(no(non))","((non)on)on","no(non)on"
507 data "(non)o(non)","no((non)on)","(nonon)on"
510 data "(no(non))on","no(nonon)"
600 rem get basic to evaluate our expression
605 a$="r="+f$:gosub 1440
610 for i=1 to len(a$)
615 rem simple token translation
620 b=asc(mid$(a$,i,1))
625 if (b>41 and b<48) or b=61 or b=94 then b=t(b)
630 poke (ad+i-1),b
635 next
640 gosub 2000
645 rem gosub 1440:rem uncomment to clear evaluation line after use
650 return
1000 rem screen pause
1005 pt$=" Press a key to continue. "
1010 print:print spc(20-int(len(pt$)/2));
1015 print chr$(18);pt$;chr$(146);
1020 get k$:if k$=""then 1020
1030 return
1100 rem syntax error
1105 print "ERROR":print
1110 print "Maybe something is out of place..."
1120 return
1200 rem invalid arguments
1205 print "ERROR":print
1210 print "?Invalid Arguments - "
1215 print "You used a number that is not allowed."
1220 return
1300 rem wrong formula
1305 print:print "Wrong answer. Try again."
1310 return
1400 dim t(94):t(43)=170:t(45)=171:t(42)=172:t(47)=173:t(61)=178:t(94)=174
1405 rem locate line 2005 in ram
1410 lh=bh:ll=bl:nh=0:nl=0
1415 ad=lh*256+ll
1420 lh=peek(ad+1):ll=peek(ad)
1425 nl=peek(ad+2):nh=peek(ad+3):n=nh*256+nl
1430 if n<>2005 then goto 1415
1435 ad=ad+4:return
1440 for j=ad to ad+73:poke j,asc(":"):next
1445 return
2000 rem put 74 colons on the next line
2005 ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
2010 return
- Output:
Initializing... 24 Game The goal of this game is to formulate an arithmetic expression that evaluates to a value of 24, however you may only use four numbers provided at random by the computer and the standard arithmetic operations of add, subtract, multiply, and divide. Each digit must be used by itself. (e.g. if given 1, 2, 3, 4, you cannot combine 1 and 2 to make 12.) Press a key to continue. Allowed characters: 6 3 3 5 + - * / ( ) Spaces are ignored. Enter 'end' to end. Enter the formula? (6-3)*(3+5) Checking syntax... OK Checking for illegal numbers... OK Evaluating expression... (6-3)*(3+5) = 24 Correct! Would you like to go again (y/n)? n Very well. Have a nice day! ready. list 2005 2005 r=(6-3)*(3+5):::::::::::::::::::::: ::::::::::::::::::::::::::::::::::::::: ready. █
Common 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 (1+ (random 9)))))
(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)))))))
Verbose Implementation
(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)))
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
import std.stdio, std.random, std.math, std.algorithm, std.range,
std.typetuple;
void main() {
void op(char c)() {
if (stack.length < 2)
throw new Exception("Wrong expression.");
stack[$ - 2] = mixin("stack[$ - 2]" ~ c ~ "stack[$ - 1]");
stack.popBack();
}
const problem = iota(4).map!(_ => uniform(1, 10))().array();
writeln("Make 24 with the digits: ", problem);
double[] stack;
int[] digits;
foreach (const char c; readln())
switch (c) {
case ' ', '\t', '\n': break;
case '1': .. case '9':
stack ~= c - '0';
digits ~= c - '0';
break;
foreach (o; TypeTuple!('+', '-', '*', '/')) {
case o: op!o(); break;
}
break;
default: throw new Exception("Wrong char: " ~ c);
}
if (!digits.sort().equal(problem.dup.sort()))
throw new Exception("Not using the given digits.");
if (stack.length != 1)
throw new Exception("Wrong expression.");
writeln("Result: ", stack[0]);
writeln(abs(stack[0] - 24) < 0.001 ? "Good job!" : "Try again.");
}
Example:
Make 24 with the digits: [1, 8, 9, 8] 8 1 - 9 + 8 + Result: 24 Good job!
Delphi
Program includes full recursive descent, expression evaluator that can handle any expression the user might eneter.
var ErrorFlag: boolean;
var ErrorStr: string;
function EvaluateExpression(Express: string): double;
{ Recursive descent expression evaluator }
var Atom: char;
var ExpressStr: string;
var ExpressInx: integer;
const Tab_Char = #$09; SP_char = #$20;
procedure HandleError(S: string);
begin
ErrorStr:=S;
ErrorFlag:=True;
Abort;
end;
procedure GetChar;
begin
if ExpressInx > Length(ExpressStr) then
begin
Atom:= ')';
end
else begin
Atom:= ExpressStr[ExpressInx];
Inc(ExpressInx);
end;
end;
procedure SkipWhiteSpace;
{ Skip Tabs And Spaces In Expression }
begin
while (Atom=TAB_Char) or (Atom=SP_char) do GetChar;
end;
procedure SkipSpaces;
{ Get Next Character, Ignoring Any Space Characters }
begin
repeat GetChar until Atom <> SP_CHAR;
end;
function GetDecimal: integer;
{ Read In A Decimal String And Return Its Value }
var S: string;
begin
Result:=0;
S:='';
while True do
begin
if not (Atom in ['0'..'9']) then break;
S:=S+Atom;
GetChar;
end;
if S='' then HandleError('Number Expected')
else Result:=StrToInt(S);
if Result>9 then HandleError('Only Numbers 0..9 allowed')
end;
function Expression: double;
{ Returns The Value Of An Expression }
function Factor: double;
{ Returns The Value Of A Factor }
var NEG: boolean;
begin
Result:=0;
while Atom='+' do SkipSpaces; { Ignore Unary "+" }
NEG:= False;
while Atom ='-' do { Unary "-" }
begin
SkipSpaces;
NEG:= not NEG;
end;
if (Atom>='0') and (Atom<='9') then Result:= GetDecimal { Unsigned Integer }
else case Atom of
'(': begin { Subexpression }
SkipSpaces;
Result:= Expression;
if Atom<>')' then HandleError('Mismatched Parenthesis');
SkipSpaces;
end;
else HandleError('Syntax Error');
end;
{ Numbers May Terminate With A Space Or Tab }
SkipWhiteSpace;
if NEG then Result:=-Result;
end; { Factor }
function Term: double;
{ Returns Factor * Factor, Etc. }
var R: double;
begin
Result:= Factor;
while True do
case Atom of
'*': begin
SkipSpaces;
Result:= Result * Factor;
end;
'/': begin
SkipSpaces;
R:=Factor;
if R=0 then HandleError('Divide By Zero');
Result:= Result / R;
end;
else break;
end;
end;
{ Term }
function AlgebraicExpression: double;
{ Returns Term + Term, Etc. }
begin
Result:= Term;
while True do
case Atom of
'+': begin SkipSpaces; Result:= Result + Term; end;
'-': begin SkipSpaces; Result:= Result - Term; end
else break;
end;
end; { Algexp }
begin { Expression }
SkipWhiteSpace;
Result:= AlgebraicExpression;
end; { Expression }
begin { EvaluateExpression }
ErrorFlag:=False;
ErrorStr:='';
ExpressStr:=Express;
ExpressInx:=1;
try
GetChar;
Result:= Expression;
except end;
end;
function WaitForString(Memo: TMemo; Prompt: string): string;
{Wait for key stroke on TMemo component}
var MW: TMemoWaiter;
var C: char;
var Y: integer;
begin
{Use custom object to wait and capture key strokes}
MW:=TMemoWaiter.Create(Memo);
try
Memo.Lines.Add(Prompt);
Memo.SelStart:=Memo.SelStart-1;
Memo.SetFocus;
Result:=MW.WaitForLine;
finally MW.Free; end;
end;
procedure Play24Game(Memo: TMemo);
{Play the 24 game}
var R: double;
var Nums: array [0..4-1] of char;
var I: integer;
var Express,RS: string;
var RB: boolean;
procedure GenerateNumbers;
{Generate and display four random number 1..9}
var S: string;
var I: integer;
begin
{Generate random numbers}
for I:=0 to High(Nums) do
Nums[I]:=char(Random(9)+$31);
{Display them}
S:='';
for I:=0 to High(Nums) do
S:=S+' '+Nums[I];
Memo.Lines.Add('Your Digits: '+S);
end;
function TestMatchingNums: boolean;
{Make sure numbers entered by user match the target numbers}
var SL1,SL2: TStringList;
var I: integer;
begin
Result:=False;
SL1:=TStringList.Create;
SL2:=TStringList.Create;
try
{Load target numbers into string list}
for I:=0 to High(Nums) do SL1.Add(Nums[I]);
{Load users expression number int string list}
for I:=1 to Length(Express) do
if Express[I] in ['0'..'9'] then SL2.Add(Express[I]);
{There should be the same number }
if SL1.Count<>SL2.Count then exit;
{Sort them to facilitate testing}
SL1.Sort; SL2.Sort;
{Are number identical, if not exit}
for I:=0 to SL1.Count-1 do
if SL1[I]<>SL2[I] then exit;
{Users numbers passed all tests}
Result:=True;
finally
SL2.Free;
SL1.Free;
end;
end;
function TestUserExpression(var S: string): boolean;
{Test expression user entered }
begin
Result:=False;
if not TestMatchingNums then
begin
S:='Numbers Do not Match';
exit;
end;
R:=EvaluateExpression(Express);
S:='Expression Value = '+FloatToStrF(R,ffFixed,18,0)+CRLF;
if ErrorFlag then
begin
S:=S+'Expression Problem: '+ErrorStr;
exit;
end;
if R<>24 then
begin
S:=S+'Expression is incorrect value';
exit;
end;
S:=S+'!!!!!! Winner !!!!!!!';
Result:=True;
end;
begin
Randomize;
Memo.Lines.Add('=========== 24 Game ===========');
GenerateNumbers;
while true do
begin
if Application.Terminated then exit;
Express:=WaitForString(Memo,'Enter expression, Q = quit, N = New numbers: '+CRLF);
if Pos('N',UpperCase(Express))>0 then
begin
GenerateNumbers;
Continue;
end;
if Pos('Q',UpperCase(Express))>0 then exit;
RB:=TestUserExpression(RS);
Memo.Lines.Add(RS);
if not RB then continue;
RS:=WaitForString(Memo,'Play again Y=Yes, N=No'+CRLF);
if Pos('N',UpperCase(RS))>0 then exit;
GenerateNumbers;
end;
end;
- Output:
=========== 24 Game =========== Your Digits: 8 2 5 5 Enter expression, Q = quit, N = New numbers: n Your Digits: 3 1 9 3 Enter expression, Q = quit, N = New numbers: 3 * 9 -3 Numbers Do not Match Enter expression, Q = quit, N = New numbers: 3 * 9 - 3 * 1 Expression Value = 24 !!!!!! Winner !!!!!!! Play again Y=Yes, N=No
EchoLisp
(string-delimiter "")
;; check that nums are in expr, and only once
(define (is-valid? expr sorted: nums)
(when (equal? 'q expr) (error "24-game" "Thx for playing"))
(unless (and
(list? expr)
(equal? nums (list-sort < (filter number? (flatten expr)))))
(writeln "🎃 Please use" nums)
#f))
;; 4 random digits
(define (gen24)
(->> (append (range 1 10)(range 1 10)) shuffle (take 4) (list-sort < )))
(define (is-24? num)
(unless (= 24 num)
(writeln "😧 Sorry - Result = " num)
#f))
(define (check-24 expr)
(if (and
(is-valid? expr nums)
(is-24? (js-eval (string expr)))) ;; use js evaluator
"🍀 🌸 Congrats - (play24) for another one."
(input-expr check-24 (string nums))))
(define nums null)
(define (play24)
(set! nums (gen24))
(writeln "24-game - Can you combine" nums "to get 24 ❓ (q to exit)")
(input-expr check-24 (string-append (string nums) " -> 24 ❓")))
- Output:
24-game - Can you combine (2 5 6 7) to get 24 ❓ (q to exit) difficult game 🎃 Please use (2 5 6 7) 12 * 2 🎃 Please use (2 5 6 7) 6 * (7 - 5 + 2) 🍀 🌸 Congrats - (play24) for another one. (play24) 24-game - Can you combine (3 5 8 9) to get 24 ❓ (q to exit) 3 + 5 + 8 * 9 😧 Sorry - Result = 80 9 * 3 - (8 - 5) 🍀 🌸 Congrats - (play24) for another one. (play24) 24-game - Can you combine (1 8 8 9) to get 24 ❓ (q to exit) 9 + 8 + 8 - 1 🍀 🌸 Congrats - (play24) for another one.
Elena
ELENA 6.0 :
import system'routines;
import system'collections;
import system'dynamic;
import extensions;
// --- Expression ---
class ExpressionTree
{
object _tree;
constructor(s)
{
auto level := new Integer(0);
s.forEach::(ch)
{
var node := new DynamicStruct();
ch =>
$43 { node.Level := level + 1; node.Operation := mssg add } // +
$45 { node.Level := level + 1; node.Operation := mssg subtract } // -
$42 { node.Level := level + 2; node.Operation := mssg multiply } // *
$47 { node.Level := level + 2; node.Operation := mssg divide } // /
$40 { level.append(10); ^ self } // (
$41 { level.reduce(10); ^ self } // )
! {
node.Leaf := ch.toString().toReal();
node.Level := level + 3
};
if (nil == _tree)
{
_tree := node
}
else
{
if (_tree.Level >= node.Level)
{
node.Left := _tree;
node.Right := nil;
_tree := node
}
else
{
var top := _tree;
while ((nil != top.Right)&&(top.Right.Level < node.Level))
{ top := top.Right };
node.Left := top.Right;
node.Right := nil;
top.Right := node
}
}
}
}
eval(node)
{
if (node.containsProperty(mssg Leaf))
{
^ node.Leaf
}
else
{
var left := self.eval(node.Left);
var right := self.eval(node.Right);
var op := node.Operation;
^ op(left, right);
}
}
get Value()
<= eval(_tree);
readLeaves(list, node)
{
if (nil == node)
{ InvalidArgumentException.raise() };
if (node.containsProperty(mssg Leaf))
{
list.append(node.Leaf)
}
else
{
self.readLeaves(list, node.Left);
self.readLeaves(list, node.Right)
}
}
readLeaves(list)
<= readLeaves(list,_tree);
}
// --- Game ---
class TwentyFourGame
{
object theNumbers;
constructor()
{
self.newPuzzle();
}
newPuzzle()
{
theNumbers := new object[]
{
1 + randomGenerator.nextInt(9),
1 + randomGenerator.nextInt(9),
1 + randomGenerator.nextInt(9),
1 + randomGenerator.nextInt(9)
}
}
help()
{
console
.printLine("------------------------------- Instructions ------------------------------")
.printLine("Four digits will be displayed.")
.printLine("Enter an equation using all of those four digits that evaluates to 24")
.printLine("Only * / + - operators and () are allowed")
.printLine("Digits can only be used once, but in any order you need.")
.printLine("Digits cannot be combined - i.e.: 12 + 12 when given 1,2,2,1 is not allowed")
.printLine("Submit a blank line to skip the current puzzle.")
.printLine("Type 'q' to quit")
.writeLine()
.printLine("Example: given 2 3 8 2, answer should resemble 8*3-(2-2)")
.printLine("------------------------------- --------------------------------------------")
}
prompt()
{
theNumbers.forEach::(n){ console.print(n," ") };
console.print(": ")
}
resolve(expr)
{
var tree := new ExpressionTree(expr);
var leaves := new ArrayList();
tree.readLeaves(leaves);
ifnot (leaves.ascendant().sequenceEqual(theNumbers.ascendant()))
{ console.printLine("Invalid input. Enter an equation using all of those four digits. Try again."); ^ self };
var result := tree.Value;
if (result == 24)
{
console.printLine("Good work. ",expr,"=",result);
self.newPuzzle()
}
else
{
console.printLine("Incorrect. ",expr,"=",result)
}
}
}
extension gameOp
{
playRound(expr)
{
if (expr == "q")
{
^ false
}
else
{
if (expr == "")
{
console.printLine("Skipping this puzzle"); self.newPuzzle()
}
else
{
try
{
self.resolve(expr)
}
catch(Exception e)
{
console.printLine(e)
//console.printLine:"An error occurred. Check your input and try again."
}
};
^ true
}
}
}
// --- program ---
public program()
{
var game := new TwentyFourGame().help();
while (game.prompt().playRound(console.readLine())) {}
}
- Output:
------------------------------- Instructions ------------------------------ Four digits will be displayed. Enter an equation using all of those four digits that evaluates to 24 Only * / + - operators and () are allowed Digits can only be used once, but in any order you need. Digits cannot be combined - i.e.: 12 + 12 when given 1,2,2,1 is not allowed Submit a blank line to skip the current puzzle. Type 'q' to quit Example: given 2 3 8 2, answer should resemble 8*3-(2-2) ------------------------------- -------------------------------------------- 7 6 9 6 : Skipping this puzzle 8 6 2 6 : 6*6-8-2 Incorrect. 6*6-8-2=26.0 8 6 2 6 : Skipping this puzzle 5 2 7 7 : 7+7+(5*2) Good work. 7+7+(5*2)=24.0
Elixir
defmodule Game24 do
def main do
IO.puts "24 Game"
play
end
defp play do
IO.puts "Generating 4 digits..."
digts = for _ <- 1..4, do: Enum.random(1..9)
IO.puts "Your digits\t#{inspect digts, char_lists: :as_lists}"
read_eval(digts)
play
end
defp read_eval(digits) do
exp = IO.gets("Your expression: ") |> String.strip
if exp in ["","q"], do: exit(:normal) # give up
case {correct_nums(exp, digits), eval(exp)} do
{:ok, x} when x==24 -> IO.puts "You Win!"
{:ok, x} -> IO.puts "You Lose with #{inspect x}!"
{err, _} -> IO.puts "The following numbers are wrong: #{inspect err, char_lists: :as_lists}"
end
end
defp correct_nums(exp, digits) do
nums = String.replace(exp, ~r/\D/, " ") |> String.split |> Enum.map(&String.to_integer &1)
if length(nums)==4 and (nums--digits)==[], do: :ok, else: nums
end
defp eval(exp) do
try do
Code.eval_string(exp) |> elem(0)
rescue
e -> Exception.message(e)
end
end
end
Game24.main
- Output:
24 Game Generating 4 digits... Your digits [9, 6, 7, 4] Your expression: (9+7)*6/4 You Win! Generating 4 digits... Your digits [3, 2, 2, 4] Your expression: 3*(2+2+4) You Win!
Erlang
-module(g24).
-export([main/0]).
main() ->
random:seed(now()),
io:format("24 Game~n"),
play().
play() ->
io:format("Generating 4 digits...~n"),
Digts = [random:uniform(X) || X <- [9,9,9,9]],
io:format("Your digits\t~w~n", [Digts]),
read_eval(Digts),
play().
read_eval(Digits) ->
Exp = string:strip(io:get_line(standard_io, "Your expression: "), both, $\n),
case {correct_nums(Exp, Digits), eval(Exp)} of
{ok, X} when X == 24 -> io:format("You Win!~n");
{ok, X} -> io:format("You Lose with ~p!~n",[X]);
{List, _} -> io:format("The following numbers are wrong: ~p~n", [List])
end.
correct_nums(Exp, Digits) ->
case re:run(Exp, "([0-9]+)", [global, {capture, all_but_first, list}]) of
nomatch ->
"No number entered";
{match, IntLs} ->
case [X || [X] <- IntLs, not lists:member(list_to_integer(X), Digits)] of
[] -> ok;
L -> L
end
end.
eval(Exp) ->
{X, _} = eval(re:replace(Exp, "\\s", "", [{return, list},global]),
0),
X.
eval([], Val) ->
{Val,[]};
eval([$(|Rest], Val) ->
{NewVal, Exp} = eval(Rest, Val),
eval(Exp, NewVal);
eval([$)|Rest], Val) ->
{Val, Rest};
eval([$[|Rest], Val) ->
{NewVal, Exp} = eval(Rest, Val),
eval(Exp, NewVal);
eval([$]|Rest], Val) ->
{Val, Rest};
eval([$+|Rest], Val) ->
{NewOperand, Exp} = eval(Rest, 0),
eval(Exp, Val + NewOperand);
eval([$-|Rest], Val) ->
{NewOperand, Exp} = eval(Rest, 0),
eval(Exp, Val - NewOperand);
eval([$*|Rest], Val) ->
{NewOperand, Exp} = eval(Rest, 0),
eval(Exp, Val * NewOperand);
eval([$/|Rest], Val) ->
{NewOperand, Exp} = eval(Rest, 0),
eval(Exp, Val / NewOperand);
eval([X|Rest], 0) when X >= $1, X =< $9 ->
eval(Rest, X-$0).
The evaluator uses a simple infix scheme that doesn't care about operator precedence, but does support brackets and parentheses alike. Thus, ((9+1)*2)+2+2
is evaluated as:
9 + 1 = 10 10 * 2 = 20 2 + 2 = 4 20 + 4
Example:
1> c(g24). {ok,g24} 2> g24:main(). 24 Game Generating 4 digits... Your digits [7,4,6,8] Your expression: 6*4 You Win! Generating 4 digits... Your digits [4,1,5,8] Your expression: 6*4 The following numbers are wrong: ["6"] Generating 4 digits... Your digits [8,5,8,2] Your expression: 2*([8/5]*2) You Lose with 6.4! Generating 4 digits... Your digits [7,4,8,1]
F#
open System
open System.Text.RegularExpressions
// Some utilities
let (|Parse|_|) regex str =
let m = Regex(regex).Match(str)
if m.Success then Some ([for g in m.Groups -> g.Value]) else None
let rec gcd x y = if x = y || x = 0 then y else if x < y then gcd y x else gcd y (x-y)
let abs (x : int) = Math.Abs x
let sign (x: int) = Math.Sign x
let cint s = Int32.Parse(s)
let replace m (s : string) t = Regex.Replace(t, m, s)
// computing in Rationals
type Rat(x : int, y : int) =
let g = if y <> 0 then gcd (abs x) (abs y) else raise <| DivideByZeroException()
member this.n = sign y * x / g // store a minus sign in the numerator
member this.d =
if y <> 0 then sign y * y / g else raise <| DivideByZeroException()
static member (~-) (x : Rat) = Rat(-x.n, x.d)
static member (+) (x : Rat, y : Rat) = Rat(x.n * y.d + y.n * x.d, x.d * y.d)
static member (-) (x : Rat, y : Rat) = x + Rat(-y.n, y.d)
static member (*) (x : Rat, y : Rat) = Rat(x.n * y.n, x.d * y.d)
static member (/) (x : Rat, y : Rat) = x * Rat(y.d, y.n)
override this.ToString() = sprintf @"<%d,%d>" this.n this.d
new(x : string, y : string) = if y = "" then Rat(cint x, 1) else Rat(cint x, cint y)
// Due to the constraints imposed by the game (reduced set
// of operators, all left associativ) we can get away with a repeated reduction
// to evaluate the algebraic expression.
let rec reduce (str :string) =
let eval (x : Rat) (y : Rat) = function
| "*" -> x * y | "/" -> x / y | "+" -> x + y | "-" -> x - y | _ -> failwith "unknown op"
let subst s r = str.Replace(s, r.ToString())
let rstr =
match str with
| Parse @"\(<(-?\d+),(\d+)>([*/+-])<(-?\d+),(\d+)>\)" [matched; xn; xd; op; yn; yd] ->
subst matched <| eval (Rat(xn,xd)) (Rat(yn,yd)) op
| Parse @"<(-?\d+),(\d+)>([*/])<(-?\d+),(\d+)>" [matched; xn; xd; op; yn; yd] ->
subst matched <| eval (Rat(xn,xd)) (Rat(yn,yd)) op
| Parse @"<(-?\d+),(\d+)>([+-])<(-?\d+),(\d+)>" [matched; xn; xd; op; yn; yd] ->
subst matched <| eval (Rat(xn,xd)) (Rat(yn,yd)) op
| Parse @"\(<(-?\d+),(\d+)>\)" [matched; xn; xd] ->
subst matched <| Rat(xn,xd)
| Parse @"(?<!>)-<(-?\d+),(\d+)>" [matched; xn; xd] ->
subst matched <| -Rat(xn,xd)
| _ -> str
if str = rstr then str else reduce rstr
let gameLoop() =
let checkInput dddd input =
match input with
| "n" | "q" -> Some(input)
| Parse @"[^1-9()*/+-]" [c] ->
printfn "You used an illegal character in your expression: %s" c
None
| Parse @"^\D*(\d)\D+(\d)\D+(\d)\D+(\d)(?:\D*(\d))*\D*$" [m; d1; d2; d3; d4; d5] ->
if d5 = "" && (String.Join(" ", Array.sort [|d1;d2;d3;d4|])) = dddd then Some(input)
elif d5 = "" then
printfn "Use this 4 digits with operators in between: %s." dddd
None
else
printfn "Use only this 4 digits with operators in between: %s." dddd
None
| _ ->
printfn "Use all 4 digits with operators in between: %s." dddd
None
let rec userLoop dddd =
let tryAgain msg =
printfn "%s" msg
userLoop dddd
printf "[Expr|n|q]: "
match Console.ReadLine() |> replace @"\s" "" |> checkInput dddd with
| Some(input) ->
let data = input |> replace @"((?<!\d)-)?\d+" @"<$&,1>"
match data with
| "n" -> true | "q" -> false
| _ ->
try
match reduce data with
| Parse @"^<(-?\d+),(\d+)>$" [_; x; y] ->
let n, d = (cint x), (cint y)
if n = 24 then
printfn "Correct!"
true
elif d=1 then tryAgain <| sprintf "Wrong! Value = %d." n
else tryAgain <| sprintf "Wrong! Value = %d/%d." n d
| _ -> tryAgain "Wrong! not a well-formed expression!"
with
| :? System.DivideByZeroException ->
tryAgain "Wrong! Your expression results in a division by zero!"
| ex ->
tryAgain <| sprintf "There is an unforeseen problem with yout input: %s" ex.Message
| None -> userLoop dddd
let random = new Random(DateTime.Now.Millisecond)
let rec loop() =
let dddd = String.Join(" ", Array.init 4 (fun _ -> 1 + random.Next 9) |> Array.sort)
printfn "\nCompute 24 from the following 4 numbers: %s" dddd
printfn "Use them in any order with * / + - and parentheses; n = new numbers; q = quit"
if userLoop dddd then loop()
loop()
gameLoop()
- Output:
Compute 24 from the following 4 numbers: 3 3 3 5 Use them in any order with * / + - and parentheses; n = new numbers; q = quit [Expr|n|q]: n Compute 24 from the following 4 numbers: 3 5 6 7 Use them in any order with * / + - and parentheses; n = new numbers; q = quit [Expr|n|q]: (7 + 5) + 6/3 Wrong! Value = 14. [Expr|n|q]: (7 + 5) * 6/3 Correct! Compute 24 from the following 4 numbers: 3 3 4 5 Use them in any order with * / + - and parentheses; n = new numbers; q = quit [Expr|n|q]: q
Factor
USING:
combinators.short-circuit
continuations
eval
formatting
fry
kernel
io
math math.ranges
prettyprint
random
sequences
sets ;
IN: 24game
: choose4 ( -- seq )
4 [ 9 [1,b] random ] replicate ;
: step ( numbers -- ? )
readln
[
parse-string
{
! Is only allowed tokens used?
[ swap { + - / * } append subset? ]
! Digit count in expression should be equal to the given numbers.
[ [ number? ] count swap length = ]
! Of course it must evaluate to 24
[ nip call( -- x ) 24 = ]
} 2&&
[ f "You got it!" ]
[ t "Expression isnt valid, or doesnt evaluate to 24." ]
if
]
[ 3drop f "Could not parse that." ]
recover print flush ;
: main ( -- )
choose4
[ "Your numbers are %[%s, %], make an expression\n" printf flush ]
[ '[ _ step ] loop ]
bi ;
Sample:
IN: scratchpad main
Your numbers are { 4, 1, 8, 2 }, make an expression
8 4 + 2 * 1 /
You got it!
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
Fortran
Clever implementation
Indicate operator precedence by parentheses; e.g. (3+(5*6))-9. No whitespace is admissible. The program uses Insertion_sort in Fortran.
program game_24
implicit none
real :: vector(4), reals(11), result, a, b, c, d
integer :: numbers(4), ascii(11), i
character(len=11) :: expression
character :: syntax(11)
! patterns:
character, parameter :: one(11) = (/ '(','(','1','x','1',')','x','1',')','x','1' /)
character, parameter :: two(11) = (/ '(','1','x','(','1','x','1',')',')','x','1' /)
character, parameter :: three(11) = (/ '1','x','(','(','1','x','1',')','x','1',')' /)
character, parameter :: four(11) = (/ '1','x','(','1','x','(','1','x','1',')',')' /)
character, parameter :: five(11) = (/ '(','1','x','1',')','x','(','1','x','1',')' /)
do
call random_number(vector)
numbers = 9 * vector + 1
write (*,*) 'Digits: ',numbers
write (*,'(a)',advance='no') 'Your expression: '
read (*,'(a11)') expression
forall (i=1:11) syntax(i) = expression(i:i)
ascii = iachar(syntax)
where (syntax >= '0' .and. syntax <= '9')
syntax = '1' ! number
elsewhere (syntax == '+' .or. syntax == '-' .or. syntax == '*' .or. syntax == '/')
syntax = 'x' ! op
elsewhere (syntax /= '(' .and. syntax /= ')')
syntax = '-' ! error
end where
reals = real(ascii-48)
if ( all(syntax == one) ) then
a = reals(3); b = reals(5); c = reals(8); d = reals(11)
call check_numbers(a,b,c,d)
result = op(op(op(a,4,b),7,c),10,d)
else if ( all(syntax == two) ) then
a = reals(2); b = reals(5); c = reals(7); d = reals(11)
call check_numbers(a,b,c,d)
result = op(op(a,3,op(b,6,c)),10,d)
else if ( all(syntax == three) ) then
a = reals(1); b = reals(5); c = reals(7); d = reals(10)
call check_numbers(a,b,c,d)
result = op(a,2,op(op(b,6,c),9,d))
else if ( all(syntax == four) ) then
a = reals(1); b = reals(4); c = reals(7); d = reals(9)
call check_numbers(a,b,c,d)
result = op(a,2,op(b,5,op(c,8,d)))
else if ( all(syntax == five) ) then
a = reals(2); b = reals(4); c = reals(8); d = reals(10)
call check_numbers(a,b,c,d)
result = op(op(a,3,b),6,op(c,9,d))
else
stop 'Input string: incorrect syntax.'
end if
if ( abs(result-24.0) < epsilon(1.0) ) then
write (*,*) 'You won!'
else
write (*,*) 'Your result (',result,') is incorrect!'
end if
write (*,'(a)',advance='no') 'Another one? [y/n] '
read (*,'(a1)') expression
if ( expression(1:1) == 'n' .or. expression(1:1) == 'N' ) then
stop
end if
end do
contains
pure real function op(x,c,y)
integer, intent(in) :: c
real, intent(in) :: x,y
select case ( char(ascii(c)) )
case ('+')
op = x+y
case ('-')
op = x-y
case ('*')
op = x*y
case ('/')
op = x/y
end select
end function op
subroutine check_numbers(a,b,c,d)
real, intent(in) :: a,b,c,d
integer :: test(4)
test = (/ nint(a),nint(b),nint(c),nint(d) /)
call Insertion_Sort(numbers)
call Insertion_Sort(test)
if ( any(test /= numbers) ) then
stop 'You cheat ;-) (Incorrect numbers)'
end if
end subroutine check_numbers
pure subroutine Insertion_Sort(a)
integer, intent(inout) :: a(:)
integer :: temp, i, j
do i=2,size(a)
j = i-1
temp = a(i)
do while ( j>=1 .and. a(j)>temp )
a(j+1) = a(j)
j = j - 1
end do
a(j+1) = temp
end do
end subroutine Insertion_Sort
end program game_24
As a more general recursive descent parser:
Permits spaces and arbitrary parentheses.
! implement a recursive descent parser
module evaluate_algebraic_expression
integer, parameter :: size = 124
character, parameter :: statement_end = achar(0)
character(len=size) :: text_to_parse
integer :: position
data position/0/,text_to_parse/' '/
contains
character function get_token()
! return the current token
implicit none
if (position <= size) then
get_token = text_to_parse(position:position)
do while (get_token <= ' ')
call advance
if (size < position) exit
get_token = text_to_parse(position:position)
end do
end if
if (size < position) get_token = statement_end
end function get_token
subroutine advance ! consume a token. Move to the next token. consume_token would have been a better name.
position = position + 1
end subroutine advance
logical function unfinished()
unfinished = get_token() /= statement_end
end function unfinished
subroutine parse_error()
write(6,*)'"'//get_token()//'" unexpected in expression at',position
stop 1
end subroutine parse_error
function precedence3() result(a)
implicit none
real :: a
character :: token
character(len=10), parameter :: digits = '0123456789'
token = get_token()
if (verify(token,digits) /= 0) call parse_error()
a = index(digits, token) - 1
call advance()
end function precedence3
recursive function precedence2() result(a)
real :: a
character :: token
token = get_token()
if (token /= '(') then
a = precedence3()
else
call advance
a = precedence0()
token = get_token()
if (token /= ')') call parse_error()
call advance
end if
end function precedence2
recursive function precedence1() result(a)
implicit none
real :: a
real, dimension(2) :: argument
character(len=2), parameter :: tokens = '*/'
character :: token
a = 0
token = get_token()
argument(1) = precedence2()
token = get_token()
do while (verify(token,tokens) == 0)
call advance()
argument(2) = precedence2()
if (token == '/') argument(2) = 1 / argument(2)
argument(1) = product(argument)
token = get_token()
end do
a = argument(1)
end function precedence1
recursive function precedence0() result(a)
implicit none
real :: a
real, dimension(2) :: argument
character(len=2), parameter :: tokens = '+-'
character :: token
a = 0
token = get_token()
argument(1) = precedence1()
token = get_token()
do while (verify(token,tokens) == 0)
call advance()
argument(2) = precedence1()
if (token == '-') argument = argument * (/1, -1/)
argument(1) = sum(argument)
token = get_token()
end do
a = argument(1)
end function precedence0
real function statement()
implicit none
if (unfinished()) then
statement = precedence0()
else !empty okay
statement = 0
end if
if (unfinished()) call parse_error()
end function statement
real function evaluate(expression)
implicit none
character(len=*), intent(in) :: expression
text_to_parse = expression
evaluate = statement()
end function evaluate
end module evaluate_algebraic_expression
program g24
use evaluate_algebraic_expression
implicit none
integer, dimension(4) :: digits
character(len=78) :: expression
real :: result
! integer :: i
call random_seed!easily found internet examples exist to seed by /dev/urandom or time
call deal(digits)
! do i=1, 9999 ! produce the data to test digit distribution
! call deal(digits)
! write(6,*) digits
! end do
write(6,'(a13,4i2,a26)')'Using digits',digits,', and the algebraic dyadic'
write(6,*)'operators +-*/() enter an expression computing 24.'
expression = ' '
read(5,'(a78)') expression
if (invalid_digits(expression, digits)) then
write(6,*)'invalid digits'
else
result = evaluate(expression)
if (nint(result) == 24) then
write(6,*) result, ' close enough'
else
write(6,*) result, ' no good'
end if
end if
contains
logical function invalid_digits(e,d) !verify the digits
implicit none
character(len=*), intent(in) :: e
integer, dimension(4), intent(inout) :: d
integer :: i, j, k, count
logical :: unfound
count = 0
invalid_digits = .false. !validity assumed
!write(6,*)'expression:',e(1:len_trim(e))
do i=1, len_trim(e)
if (verify(e(i:i),'0123456789') == 0) then
j = index('0123456789',e(i:i))-1
unfound = .true.
do k=1, 4
if (j == d(k)) then
unfound = .false.
exit
end if
end do
if (unfound) then
invalid_digits = .true.
!return or exit is okay here
else
d(k) = -99
count = count + 1
end if
end if
end do
invalid_digits = invalid_digits .or. (count /= 4)
end function invalid_digits
subroutine deal(digits)
implicit none
integer, dimension(4), intent(out) :: digits
integer :: i
real :: harvest
call random_number(harvest)
do i=1, 4
digits(i) = int(mod(harvest*9**i, 9.0)) + 1
end do
! NB. computed with executable Iverson notation, www.jsoftware.oom
! #B NB. B are the digits from 9999 deals
! 39996
! ({.,#)/.~/:~B # show the distribution of digits
! 0 4380
! 1 4542
! 2 4348
! 3 4395
! 4 4451
! 5 4474
! 6 4467
! 7 4413
! 8 4526
! NB. this also shows that I forgot to add 1. Inserting now...
end subroutine deal
end program g24
Compilation and too many examples. Which would you cut?
$ gfortran -g -O0 -std=f2008 -Wall f.f08 -o f.exe && echo '8*(9/9+2)' | ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. 24.000000 close enough $ $ $ $ ./f.exe $ Using digits 9 9 8 2, and the algebraic dyadic $ operators +-*/() enter an expression computing 24. $ 8 * ( 9 / 9 + 2 ) $ 24.000000 close enough $ $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. (((2+8+9+9))) 28.000000 no good $ $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. (((8+9-2+9))) 24.000000 close enough $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. 8929 "9" unexpected in expression at 2 STOP 1 $ $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. 12348 invalid digits $ $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. 892 invalid digits $ $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. 8921 invalid digits $ $ $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. 89291 invalid digits $ $ $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. 9+x-2+8+9 "x" unexpected in expression at 3 STOP 1 $ $ $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. (9-2)+8+(9 "^@" unexpected in expression at 125 STOP 1 $ $ $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. (9-2)+8+(9) 24.000000 close enough $ $ $ $ ./f.exe Using digits 9 9 8 2, and the algebraic dyadic operators +-*/() enter an expression computing 24. (9-2)+8/(9) 7.8888888 no good $
FreeBASIC
Solución en RPN:
' The 24 game en FreeBASIC
Const operaciones = "*/+-"
Declare Sub Encabezado
Declare Function escoge4() As String
Declare Function quitaEspacios(cadena As String, subcadena1 As String, subcadena2 As String) As String
Declare Function evaluaEntrada(cadena As String) As Integer
Declare Function evaluador(oper1 As Byte, oper2 As Byte, operacion As String) As Integer
Dim Shared As String serie, entrada, cadena
Dim As Integer resultado
Sub Encabezado
Cls: Color 15
Print "The 24 Game"
Print "============" + Chr(13) + Chr(10)
Print "Dados cuatro dígitos en el rango de 1 a 9, que pueden repetirse, "
Print "usando solo los operadores aritméticos suma (+), resta (-), "
Print "multiplicación (*) y división (/) intentar obtener un resultado de 24." + Chr(13) + Chr(10)
Print "Use la notación polaca inversa (primero los operandos y luego los operadores)."
Print "Por ejemplo: en lugar de 2 + 4, escriba 2 4 +" + Chr(13) + Chr(10)
End Sub
Function escoge4() As String
Dim As Byte i
Dim As String a, b
Print "Los dígitos a utilizar son: ";
For i = 1 To 4
a = Str(Int(Rnd*9)+1)
Print a;" ";
b = b + a
Next i
escoge4 = b
End Function
Function evaluaEntrada(cadena As String) As Integer
Dim As Byte oper1, oper2, n(4), i
Dim As String op
oper1 = 0: oper2 = 0: i = 0
While cadena <> ""
op = Left(cadena, 1)
entrada = Mid(cadena, 2)
If Instr(serie, op) Then
i = i + 1
n(i) = Val(op)
Elseif Instr(operaciones, op) Then
oper2 = n(i)
n(i) = 0
i = i - 1
oper1 = n(i)
n(i) = evaluador(oper1, oper2, op)
Else
Print "Signo no v lido"
End If
Wend
evaluaEntrada = n(i)
End Function
Function evaluador(oper1 As Byte, oper2 As Byte, operacion As String) As Integer
Dim As Integer t
Select Case operacion
Case "+": t = oper1 + oper2
Case "-": t = oper1 - oper2
Case "*": t = oper1 * oper2
Case "/": t = oper1 / oper2
End Select
evaluador = t
End Function
Function quitaEspacios(cadena As String, subcadena1 As String, subcadena2 As String) As String
Dim As Byte len1 = Len(subcadena1), len2 = Len(subcadena2)
Dim As Byte i
i = Instr(cadena, subcadena1)
While i
cadena = Left(cadena, i - 1) & subcadena2 & Mid(cadena, i + len1)
i = Instr(i + len2, cadena, subcadena1)
Wend
quitaEspacios = cadena
End Function
'--- Programa Principal ---
Randomize Timer
Do
Encabezado
serie = escoge4
Print: Line Input "Introduzca su fórmula en notación polaca inversa: ", entrada
entrada = quitaEspacios(entrada, " ", "")
If (Len(entrada) <> 7) Then
Print "Error en la serie introducida."
Else
resultado = evaluaEntrada(entrada)
Print "El resultado es = "; resultado
If resultado = 24 Then
Print "¡Correcto!"
Else
Print "¡Error!"
End If
End If
Print "¿Otra ronda? (Pulsa S para salir, u otra tecla para continuar)"
Loop Until (Ucase(Input(1)) = "S")
End
'--------------------------
- Output:
The 24 Game ============ Dados cuatro dígitos en el rango de 1 a 9, que pueden repetirse, usando solo los operadores aritmÚticos suma (+), resta (-), multiplicación (*) y división (/) intentar obtener un resultado de 24. Use la notación polaca inversa (primero los operandos y luego los operadores). Por ejemplo: en lugar de 2 + 4, escriba 2 4 + Los dígitos a utilizar son: 4 9 7 5 Introduzca su fórmula en notación polaca inversa: 49*57+- El resultado es = 24 Correcto! ¿Otra ronda? (Pulsa S para salir, u otra tecla para continuar)
Frink
ops = ["+", "-", "*", "/"]
chosen = new array[[4], {|x| random[1,9]}]
println[chosen]
for d = chosen.lexicographicPermute[]
multifor o = [ops, ops, ops]
{
str = "((" + d@0 + o@0 + d@1 + ")" + o@1 + d@2 + ")" + o@2 + d@3
if eval[str] == 24
println[str]
str = "(" + d@0 + o@0 + d@1 + ")" + o@1 + "(" + d@2 + + o@2 + d@3 + ")"
if eval[str] == 24
println[str]
}
- Output:
[9, 8, 7, 4] (4+8)*(9-7) ((7+8)-9)*4 ((7-9)+8)*4 (8+4)*(9-7) ((8+7)-9)*4 ((8-9)+7)*4 (8*9)/(7-4) (9-7)*(4+8) (9-7)*(8+4) (9*8)/(7-4)
FutureBasic
24 Game May 17, 2024 Rich Love Thanks to Ken and Bernie
7/7/24 Corrected examples
include resources "24 Game Icon.icns"
#build CompilerOptions @"-Wno-unused-variable"
_mEdit = 2
editmenu _mEdit
begin globals
long gPosition
end globals
void local fn EraseErrorText
CGRect r
r = fn CGRectMake(10, 200, 400, 15)
rect fill r,fn ColorBlack
end fn
local fn ArcRandom( a as long, b as long ) as long
long i
cln i = (arc4random()%(b-a+1))+a;
end fn = fn floor(i)
local fn GetRandomNumbers as CFStringRef
// 96 number groups
CFArrayRef combos = @[¬
// The first 32 are easy
@"1 2 3 4", @"2 4 6 8", @"1 2 4 8", @"1 3 4 6", @"1 2 6 8",
@"2 3 4 8", @"1 3 6 9", @"1 2 7 8", @"2 3 6 8", @"1 4 6 8",
@"2 2 3 9", @"3 4 6 6", @"2 3 3 8", @"1 5 6 6", @"2 4 4 6",
@"1 3 8 8", @"2 2 6 9", @"3 3 6 9", @"1 2 5 9", @"2 4 5 5",
@"1 3 5 9", @"2 2 4 9", @"1 2 3 6", @"1 2 2 9", @"1 2 3 9",
@"1 2 4 6", @"1 2 4 4", @"1 2 2 6", @"1 3 3 6", @"1 1 4 6",
@"1 1 2 8", @"1 1 3 8",
// The middle 32 are medium
@"1 5 5 9", @"4 4 6 9", @"2 3 7 9",@"3 5 8 8", @"1 6 6 8",
@"3 3 5 6", @"1 4 5 8", @"3 3 6 7",@"2 5 5 8", @"4 4 7 9",
@"1 5 6 9", @"3 3 8 9", @"2 6 6 7",@"4 5 7 8", @"2 2 5 9",
@"2 4 6 7", @"1 5 6 8", @"3 4 7 7",@"2 5 6 6", @"3 4 5 9",
@"1 6 7 9", @"2 3 7 8", @"1 4 6 9",@"2 3 5 9", @"3 4 4 8",
@"2 5 8 9", @"1 4 8 9", @"3 3 4 9",@"2 6 7 9", @"1 3 5 7",
@"1 3 6 6", @"2 2 5 7",
// The last 32 are hard
@"1 5 7 9",@"3 4 7 9", @"2 5 7 8", @"3 4 8 9", @"3 4 5 8",
@"2 6 6 9",@"4 4 5 7", @"2 4 6 9", @"1 4 7 7", @"2 3 8 9",
@"2 3 4 7",@"3 3 4 8", @"1 3 7 9", @"2 4 5 9", @"1 3 6 8",
@"2 4 4 9",@"1 5 8 9", @"3 3 5 9", @"2 6 8 9", @"1 4 4 7",
@"2 3 6 7",@"1 3 5 8", @"2 4 7 8", @"1 3 4 7", @"2 3 5 6",
@"1 4 5 6",@"3 3 5 7", @"2 2 3 6", @"3 3 7 7", @"3 3 7 9",
@"4 4 8 9",@"2 4 8 9"]
long i = fn ArcRandom( 0, len(combos) - 1 )
gPosition = i
end fn = combos[i]
local fn EvaluateMath( equation as CFStringRef ) as CFStringRef
equation = fn StringByReplacingOccurrencesOfString( lcase(equation), @"x", @"*" )
CFStringRef result = NULL
RegularExpressionRef regex = fn RegularExpressionWithPattern( @"[0-9.]+", NSRegularExpressionCaseInsensitive, NULL )
CFArrayRef matches = fn RegularExpressionMatches( regex, equation, 0, fn CFRangeMake( 0, len(equation) ) )
NSInteger intConversions = 0
TextCheckingResultRef match
CFRange originalRange
CFRange adjustedRange
CFStringRef value
for match in matches
originalRange = fn TextCheckingResultRange( match )
adjustedRange = fn CFRangeMake( ( originalRange.location + ( intConversions * len( @".0") ) ), originalRange.length )
value = fn StringSubstringWithRange( equation, adjustedRange )
if fn StringContainsString( value, @"." )
continue
else
equation = fn StringByReplacingCharactersInRange( equation, adjustedRange, fn StringWithFormat( @"%@.0", value ) )
intConversions++
end if
next
ExceptionRef e
try
ExpressionRef expression = fn ExpressionWithFormat( equation )
CFNumberRef number = fn ExpressionValueWithObject( expression, NULL, NULL )
result = fn StringWithFormat( @"%.3f", dblval( number ) )
end try
catch (e)
result = fn StringWithFormat( @"%@", e ) : exit fn
end catch
// Test if result is an integer and, if so, return result as an integer
if( fn StringDoubleValue( result ) == fn floorf( fn StringDoubleValue( result ) ) )
result = fn ArrayFirstObject( fn StringComponentsSeparatedByString( result, @"." ) )
end if
end fn = result
local fn QuitOrPlayAlert(GameResult as CFStringRef)
alert -2,,GameResult,@"You won!",@"Quit;Play Again"
AlertButtonSetKeyEquivalent( 2, 2, @"\e" )
short result
result = alert 2
if ( result != NSAlertSecondButtonReturn ) then appterminate
end fn
local fn BuildWindow
CGRect r = fn CGRectMake( 0, 0, 580, 250)
window 1, @"24 Game", r
windowcenter(1)
WindowSetBackgroundColor(1,fn ColorBlack)
end fn
///////// Start //////////
fn BuildWindow
short d(4), i
CFStringRef CheckForDuplicates(97)
for i = 1 to 96
CheckForDuplicates(i) = @""
next i
short DuplicatesCounter
DuplicatesCounter = 0
"Main"
cls
text ,,fn colorWhite
print
print %(10,15),"Given four numbers and using just the +, -, *, and / operators; and the"
print %(10,30),"possible use of parenthesis (), enter an expression that equates to 24."
print %(10,45),"You must use all your numbers and only those numbers."
print %(10,60),"Examples: 9618 Solution 9 + 6 + 1 + 8 or 3173 Solution (3 * 7) - (1 - 4)"
print
print %(10,85),"Enter Q to quit or S to skip to the next number."
"GetFourNumbers"
CFArrayRef randomNumbers : randomNumbers= fn StringComponentsSeparatedByString( fn GetRandomNumbers, @" " )
CFStringRef RandomNumberblock : RandomNumberblock = @""
CFStringRef RandomNumberblockAdd : RandomNumberblockAdd = @""
for i = 0 to 3
// create a string from the 4 numbers
RandomNumberblockAdd = randomNumbers[i]
RandomNumberblock = fn StringByAppendingString(RandomNumberblock,RandomNumberblockAdd)
RandomNumberblock = fn StringByAppendingString(RandomNumberblock,@" ")
next i
if DuplicatesCounter = > 96
// reset counter when last number is retrieved and start from the first number block
DuplicatesCounter = 0
for i = 1 to 96
CheckForDuplicates(i) = @""
next i
end if
for i = 1 to 96
// check the current numbers with the numbers already used
if fn StringIsEqual(RandomNumberblock,CheckForDuplicates(i))
RandomNumberblock = fn StringWithString(CheckForDuplicates(DuplicatesCounter))
goto "GetFourNumbers"
end if
next i
DuplicatesCounter ++
CheckForDuplicates(DuplicatesCounter) = fn StringWithString(RandomNumberblock)
d(1) = fn StringIntegerValue( randomNumbers[0] )
d(2) = fn StringIntegerValue( randomNumbers[1] )
d(3) = fn StringIntegerValue( randomNumbers[2] )
d(4) = fn StringIntegerValue( randomNumbers[3] )
short dots = 0
//d(1) = 9:d(2) = 6:d(3) = 1:d(4) = 8 // Uncomment to test with 9618 numbers. Solution 9 + 6 + 1 + 8
//d(1) = 6:d(2) = 5:d(3) = 3:d(4) = 8 // Uncomment to test with 6538 numbers. Solution 6 / ( 5 - 3 ) * 8
//d(1) = 3:d(2) = 1:d(3) = 7:d(4) = 3 // Uncomment to test with 3773 numbers. Solution ((3 * 1) * 7) + 3
//d(1) = 4:d(2) = 2:d(3) = 7:d(4) = 1 // Uncomment to test with 4271 numbers. Solution (4 * ( 7 - 2 + 1 )
// NOTE: When using these test numbers, also uncomment dots = 0 below here to prevent misleading dot displays
if gPosition <= 32 then dots = 1
if gPosition > 32 and gPosition < 65 then dots = 2
if gPosition > 64 then dots = 3
//dots = 0 uncomment when testing the numbers above to prevent misleading dot displays
print
text ,,fn colorGreen
print %(15,110),"These are your numbers, difficulty level ";
// @"\U000026AA" is white unicode dot - Easy difficulty (One-Dot)
// @"\U0001F534" is red unicode dot - Medium difficulty (Two-Dots)
// @"\U0001F7E1" is yellow unicode dot - Hard difficulty (Three-Dots)
if dots = 1 then print @"\U000026AA Easy"
if dots = 2 then print @"\U0001F534 \U0001F534 Medium"
if dots = 3 then print @"\U0001F7E1 \U0001F7E1 \U0001F7E1 Hard"
print %(55,125)
text ,18,fn colorGreen
for i = 1 to 4
print d(i); " ";
next
print
text ,12,fn colorWhite
printf @"\n\n\n"
CFStringRef expr
bool TryAgain : TryAgain = _false
CFStringRef MessageText
CFStringRef UserInput = NULL
"InputExpression"
if TryAgain
MessageText = fn StringWithFormat( @"Enter math expression: [ '%@' was incorrect ]", expr )
UserInput = input %(10, 190), MessageText, @"123456789+-*/()qs", YES,, 0
else
UserInput = input %(10, 190), @"Enter math expression:", @"123456789+-*/()qs", YES,, 0
end if
if ( UserInput == NULL ) then "InputExpression"
expr = UserInput
if expr = @"" then "InputExpression"
if fn StringIsEqual(ucase(expr) , @"Q") then appterminate
if fn StringIsEqual(ucase(expr) , @"S") then "Main"
//check expr for validity
short j
bool GotAllNumbers : GotAllNumbers = _false
short ThisNumberPosition : ThisNumberPosition = 0
short GotaNumber : GotaNumber = 0
short TotalNumbers : TotalNumbers = 0
short ExtraNumbers:ExtraNumbers = 0
for i = 1 to len$(fn stringpascalstring(expr))
if asc(mid$(fn stringpascalstring(expr),i,1)) > 48 && asc(mid$(fn stringpascalstring(expr),i,1)) < 58
ExtraNumbers ++
end if
next i
if ExtraNumbers > 4
fn EraseErrorText
text ,,fn colorRed
TryAgain = _true
print %(10,200);"Error! Extra numbers not allowed": goto "InputExpression"
text ,,fn colorWhite
end if
for i = 1 to 4
GotaNumber = 0
for j = 0 to len(expr) -1
ThisNumberPosition = instr( j, expr, right(str( d(i)),1 ))
ThisNumberPosition ++
if ThisNumberPosition then GotaNumber = _true
next j
if GotaNumber then TotalNumbers ++
next i
if TotalNumbers => 4 then GotAllNumbers = _true
if GotAllNumbers = _false
fn EraseErrorText
text ,,fn colorRed
TryAgain = _true
print %(10,200);"ERROR! Must use all your numbers and only those numbers." : goto "InputExpression"
text ,,fn colorWhite
end if
fn EraseErrorText
if fn EvaluateMath( expr ) = _false
text ,,fn colorRed
TryAgain = _true
Print %(10,200);"Error! Incorrect math sequence."
goto "InputExpression"
text ,,fn colorWhite
end if
CFStringRef GameResult
if fn StringIntegerValue( fn EvaluateMath( expr ) ) == 24 then GameResult = @"Correct" else GameResult = @"Incorrect"
if GameResult = @"Incorrect"
TryAgain = _true
goto "InputExpression"
end if
fn QuitOrPlayAlert(GameResult)
goto "Main"
handleevents
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>
Go
RPN solution.
package main
import (
"fmt"
"math"
"math/rand"
"time"
)
func main() {
rand.Seed(time.Now().Unix())
n := make([]rune, 4)
for i := range n {
n[i] = rune(rand.Intn(9) + '1')
}
fmt.Printf("Your numbers: %c\n", n)
fmt.Print("Enter RPN: ")
var expr string
fmt.Scan(&expr)
if len(expr) != 7 {
fmt.Println("invalid. expression length must be 7." +
" (4 numbers, 3 operators, no spaces)")
return
}
stack := make([]float64, 0, 4)
for _, r := range expr {
if r >= '0' && r <= '9' {
if len(n) == 0 {
fmt.Println("too many numbers.")
return
}
i := 0
for n[i] != r {
i++
if i == len(n) {
fmt.Println("wrong numbers.")
return
}
}
n = append(n[:i], n[i+1:]...)
stack = append(stack, float64(r-'0'))
continue
}
if len(stack) < 2 {
fmt.Println("invalid expression syntax.")
return
}
switch r {
case '+':
stack[len(stack)-2] += stack[len(stack)-1]
case '-':
stack[len(stack)-2] -= stack[len(stack)-1]
case '*':
stack[len(stack)-2] *= stack[len(stack)-1]
case '/':
stack[len(stack)-2] /= stack[len(stack)-1]
default:
fmt.Printf("%c invalid.\n", r)
return
}
stack = stack[:len(stack)-1]
}
if math.Abs(stack[0]-24) > 1e-6 {
fmt.Println("incorrect.", stack[0], "!= 24")
} else {
fmt.Println("correct.")
}
}
Example game:
Your numbers: [5 8 1 3] Enter RPN: 83-5*1- correct.
Gosu
uses java.lang.Double
uses java.lang.Integer
uses java.util.ArrayList
uses java.util.List
uses java.util.Scanner
uses java.util.Stack
function doEval( scanner : Scanner, allowed : List<Integer> ) : double {
var stk = new Stack<Double>()
while( scanner.hasNext() ) {
if( scanner.hasNextInt() ) {
var n = scanner.nextInt()
// Make sure they're allowed to use n
if( n <= 0 || n >= 10 ) {
print( n + " isn't allowed" )
return 0
}
var idx = allowed.indexOf( n )
if( idx == -1 ) {
print( "You aren't allowed to use so many " + n + "s!" )
return 0
}
// Add the input number to the stack
stk.push( new Double( n ) )
// Mark n as used
allowed.remove( idx )
} else {
// It has to be an operator...
if( stk.size() < 2 ) {
print( "Invalid Expression: Stack underflow!" )
return 0
}
// Gets the next operator as a single character token
var s = scanner.next("[\\+-/\\*]")
// Get the operands
var r = stk.pop().doubleValue()
var l = stk.pop().doubleValue()
// Determine which operator and invoke it
if( s.equals( "+" ) ) {
stk.push( new Double( l + r ) )
} else if( s.equals( "-" ) ) {
stk.push( new Double( l - r ) )
} else if( s.equals( "*" ) ) {
stk.push( new Double( l * r ) )
} else if( s.equals( "/" ) ) {
if( r == 0.0 ) {
print( "Invalid Expression: Division by zero!" )
return 0
}
stk.push( new Double( l / r ) )
} else {
print( "Internal Error: looking for operator yielded '" + s + "'" )
return 0
}
}
}
// Did they skip any numbers?
if( allowed.size() != 0 ) {
print( "You didn't use ${allowed}" )
return 0
}
// Did they use enough operators?
if( stk.size() != 1 ) {
print( "Invalid Expression: Not enough operators!" )
return 0
}
return stk.pop().doubleValue()
}
// Pick 4 random numbers from [1..9]
var nums = new ArrayList<Integer>()
var gen = new java.util.Random( new java.util.Date().getTime() )
for( i in 0..3 ) {
nums.add( gen.nextInt(9) + 1 )
}
// Prompt the user
print( "Using addition, subtraction, multiplication and division, write an" )
print( "expression that evaluates to 24 using" )
print( "${nums.get(0)}, ${nums.get(1)}, ${nums.get(2)} and ${nums.get(3)}" )
print( "" )
print( "Please enter your expression in RPN" )
// Build a tokenizer over a line of input
var sc = new Scanner( new java.io.BufferedReader( new java.io.InputStreamReader( java.lang.System.in ) ).readLine() )
// eval the expression
var val = doEval( sc, nums )
// winner?
if( java.lang.Math.abs( val - 24.0 ) < 0.001 ) {
print( "You win!" )
} else {
print( "You lose!" )
}
Groovy
This solution breaks strict adherence to the rules in only one way: any line that starts with the letter "q" causes the game to quit.
final random = new Random()
final input = new Scanner(System.in)
def evaluate = { expr ->
if (expr == 'QUIT') {
return 'QUIT'
} else {
try { Eval.me(expr.replaceAll(/(\d)/, '$1.0')) }
catch (e) { 'syntax error' }
}
}
def readGuess = { digits ->
while (true) {
print "Enter your guess using ${digits} (q to quit): "
def expr = input.nextLine()
switch (expr) {
case ~/^[qQ].*/:
return 'QUIT'
case ~/.*[^\d\s\+\*\/\(\)-].*/:
def badChars = expr.replaceAll(~/[\d\s\+\*\/\(\)-]/, '')
println "invalid characters in input: ${(badChars as List) as Set}"
break
case { (it.replaceAll(~/\D/, '') as List).sort() != ([]+digits).sort() }:
println '''you didn't use the right digits'''
break
case ~/.*\d\d.*/:
println 'no multi-digit numbers allowed'
break
default:
return expr
}
}
}
def digits = (1..4).collect { (random.nextInt(9) + 1) as String }
while (true) {
def guess = readGuess(digits)
def result = evaluate(guess)
switch (result) {
case 'QUIT':
println 'Awwww. Maybe next time?'
return
case 24:
println 'Yes! You got it.'
return
case 'syntax error':
println "A ${result} was found in ${guess}"
break
default:
println "Nope: ${guess} == ${result}, not 24"
println 'One more try, then?'
}
}
Sample Run:
$ groovy TwentyFour.gsh Enter your guess using [4, 8, 3, 6] (q to quit): 4836 no multi-digit numbers allowed Enter your guess using [4, 8, 3, 6] (q to quit): 4 ++ ++ 8/ 3-6 A syntax error was found in 4 ++ ++ 8/ 3-6 Enter your guess using [4, 8, 3, 6] (q to quit): btsjsb invalid characters in input: [t, s, b, j] Enter your guess using [4, 8, 3, 6] (q to quit): 1+3+2+2 you didn't use the right digits Enter your guess using [4, 8, 3, 6] (q to quit): q Awwww. Maybe next time? $ groovy TwentyFour.gsh Enter your guess using [6, 3, 2, 6] (q to quit): 6+6+3+2 Nope: 6+6+3+2 == 17.0, not 24 One more try, then? Enter your guess using [6, 3, 2, 6] (q to quit): (6*3 - 6) * 2 Yes! You got it.
Haskell
import Data.List (sort)
import Data.Char (isDigit)
import Data.Maybe (fromJust)
import Control.Monad (foldM)
import System.Random (randomRs, getStdGen)
import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))
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 <- fmap (sort . take 4 . randomRs (1, 9)) getStdGen :: IO [Int]
putStrLn ("Your digits: " ++ unwords (fmap show digits))
guessLoop digits
where
guessLoop digits =
putStr "Your expression: " >> fmap (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 . fmap 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 xs =
foldM simplify [] xs >>=
\ns ->
(case ns of
[n] -> Right n
_ -> Left "Too few operators")
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 $ fmap fst ops
ops = [("+", (+)), ("-", (-)), ("*", (*)), ("/", (/))]
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
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;
Huginn
#! /bin/sh
exec huginn --no-argv -E "${0}"
#! huginn
import Algorithms as algo;
import Mathematics as math;
import RegularExpressions as re;
make_game( rndGen_ ) {
board = "";
for ( i : algo.range( 4 ) ) {
board += ( " " + string( character( rndGen_.next() + integer( '1' ) ) ) );
}
return ( board.strip() );
}
main() {
rndGen = math.randomizer( 9 );
no = 0;
dd = re.compile( "\\d\\d" );
while ( true ) {
no += 1;
board = make_game( rndGen );
print( "Your four digits: {}\nExpression {}: ".format( board, no ) );
line = input();
if ( line == none ) {
print( "\n" );
break;
}
line = line.strip();
try {
if ( line == "q" ) {
break;
}
if ( ( pos = line.find_other_than( "{}+-*/() ".format( board ) ) ) >= 0 ) {
print( "Invalid input found at: {}, `{}`\n".format( pos, line ) );
continue;
}
if ( dd.match( line ).matched() ) {
print( "Digit concatenation is forbidden.\n" );
continue;
}
res = real( line );
if ( res == 24.0 ) {
print( "Thats right!\n" );
} else {
print( "Bad answer!\n" );
}
} catch ( Exception e ) {
print( "Not an expression: {}\n".format( e.what() ) );
}
}
return ( 0 );
}
Icon and Unicon
This plays the game of 24 using a simplified version of the code from the Arithmetic evaluation task.
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
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
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
Java
import java.util.*;
public class Game24 {
static Random r = new Random();
public static void main(String[] args) {
int[] digits = randomDigits();
Scanner in = new Scanner(System.in);
System.out.print("Make 24 using these digits: ");
System.out.println(Arrays.toString(digits));
System.out.print("> ");
Stack<Float> s = new Stack<>();
long total = 0;
for (char c : in.nextLine().toCharArray()) {
if ('0' <= c && c <= '9') {
int d = c - '0';
total += (1 << (d * 5));
s.push((float) d);
} else if ("+/-*".indexOf(c) != -1) {
s.push(applyOperator(s.pop(), s.pop(), c));
}
}
if (tallyDigits(digits) != total)
System.out.print("Not the same digits. ");
else if (Math.abs(24 - s.peek()) < 0.001F)
System.out.println("Correct!");
else
System.out.print("Not correct.");
}
static float applyOperator(float a, float b, char c) {
switch (c) {
case '+':
return a + b;
case '-':
return b - a;
case '*':
return a * b;
case '/':
return b / a;
default:
return Float.NaN;
}
}
static long tallyDigits(int[] a) {
long total = 0;
for (int i = 0; i < 4; i++)
total += (1 << (a[i] * 5));
return total;
}
static int[] randomDigits() {
int[] result = new int[4];
for (int i = 0; i < 4; i++)
result[i] = r.nextInt(9) + 1;
return result;
}
}
- Output:
Make 24 using these digits: [1, 2, 4, 8] > 12*48+* Correct!
JavaScript
function twentyfour(numbers, input) {
var invalidChars = /[^\d\+\*\/\s-\(\)]/;
var validNums = function(str) {
// Create a duplicate of our input numbers, so that
// both lists will be sorted.
var mnums = numbers.slice();
mnums.sort();
// Sort after mapping to numbers, to make comparisons valid.
return str.replace(/[^\d\s]/g, " ")
.trim()
.split(/\s+/)
.map(function(n) { return parseInt(n, 10); })
.sort()
.every(function(v, i) { return v === mnums[i]; });
};
var validEval = function(input) {
try {
return eval(input);
} catch (e) {
return {error: e.toString()};
}
};
if (input.trim() === "") return "You must enter a value.";
if (input.match(invalidChars)) return "Invalid chars used, try again. Use only:\n + - * / ( )";
if (!validNums(input)) return "Wrong numbers used, try again.";
var calc = validEval(input);
if (typeof calc !== 'number') return "That is not a valid input; please try again.";
if (calc !== 24) return "Wrong answer: " + String(calc) + "; please try again.";
return input + " == 24. Congratulations!";
};
// I/O below.
while (true) {
var numbers = [1, 2, 3, 4].map(function() {
return Math.floor(Math.random() * 8 + 1);
});
var input = prompt(
"Your numbers are:\n" + numbers.join(" ") +
"\nEnter expression. (use only + - * / and parens).\n", +"'x' to exit.", "");
if (input === 'x') {
break;
}
alert(twentyfour(numbers, input));
}
jq
Works with jq, the C implementation of jq
Works with gojq, the Go implementation of jq
Note that the RPN evaluator used here allows expressions such as "1 2 3 + +".
Note also that in RPN expressions:
- If a and b are numeric, then "a b -" is evaluated to the arithmetic expression `a - b`.
- If a and b are numeric, then "a b /" is evaluated as a/b, which need not be an integer.
For the "24 Game":
- Spaces may be omitted in RPN input.
- When comparing a result to 24, `round` is used.
The MRG32k3a module is used for generating pseudo-random numbers.
### The MRG32k3a combined recursive PRNG - see above
import "MRG32k3a" as MRG {search: "."};
### Generic utilities
def sum(stream): reduce stream as $x (0; .+$x);
# like while/2 but emit the final term rather than the first one
def whilst(cond; update):
def _whilst:
if cond then update | (., _whilst) else empty end;
_whilst;
### Reverse Polish Notation
# An array of the allowed operators
def operators: "+-*/" | split("");
# If $a and $b are numbers and $c an operator, then "$a $b $c" is evaluated as an RPN expression.
# Output: {emit, result} with .emit == null if there is a valid result.
def applyOperator($a; $b; $c):
if ([$a,$b] | map(type) | unique) == ["number"]
then
if $c == "+" then {result: ($a + $b)}
elif $c == "-" then {result: ($a - $b)}
elif $c == "*" then {result: ($a * $b)}
elif ($c == "/") then {result: ($b / $a)}
else {emit: "unrecognized operator: \($c)"}
end
else {emit: "invalid number"}
end;
# Input: an array representing an RPN expression.
# Output: {emit, result} as per applyOperator/3
# Example: [1,2,3,"+","+"] | evaluate #=> 6
def evaluate:
if length == 1
then if .[0]|type == "number" then {result: .[0]}
else {emit: "invalid RPN expression"}
end
elif length < 3 then {emit: "invalid RPN expression: \(. | join(" "))"}
else . as $in
| (first( range(0; length) as $i | select(any( operators[]; . == $in[$i]) ) | $i) // null) as $ix
| if $ix == null then {emit: "invalid RPN expression"}
else applyOperator(.[$ix-2]; .[$ix-1]; .[$ix]) as $result
| if $result.result then .[:$ix-2] + [$result.result] + .[$ix+1:] | evaluate
else $result
end
end
end;
### The "24 Game"
# . is the putative RPN string to be checked.
# $four is the string of the four expected digits, in order.
# Output: {emit, result} with .emit set to "Correct!" if .result == 24
def check($four):
if (gsub("[^1-9]";"") | explode | sort | implode) != $four
then {emit: "You must use each of the four digits \($four | split("") | join(" ")) exactly once:"}
else . as $in
| {s: [], emit: null}
| [$in | split("")[] | select(. != " ")
| . as $in | explode[0] | if . >= 48 and . <= 57 then . - 48 else $in end]
| evaluate
| if .result
then if .result|round == 24 then .emit = "Correct!"
else .emit = "Value \(.result) is not 24."
end
else .emit += "\nTry again, or enter . to start again, or q to quit."
end
end ;
def run:
# Populate .digits with four non-negative digits selected at random, with replacement:
{digits: (9 | MRG::prn(4) | map(. + 1))}
| (.digits | sort | join("")) as $four
| "At the prompt, enter an RPN string (e.g. 64*1+1-), or . for a new set of four digits, or q to quit.",
"Make 24 using these digits, once each, in any order: \(.digits):",
( whilst( .stop | not;
.emit = null
| . as $state
| try input catch halt
| if IN( "q", "quit") then halt
elif . == "." then $state | .stop = true
else check($four)
| if .result then .stop = true end
end )
| select(.emit).emit ),
# rerun
run;
run
- Output:
The following is an illustrative transcript.
$ jq -nRr -f 24-game.jq At the prompt, enter an RPN string (e.g. 64*1+1-), or . for a new set of four digits, or q to quit. Make 24 using these digits, once each, in any order: [7,7,6,8]: 7768+++ Value 28 is not 24. At the prompt, enter an RPN string (e.g. 64*1+1-), or . for a new set of four digits, or q to quit. Make 24 using these digits, once each, in any order: [7,8,6,8]: . At the prompt, enter an RPN string (e.g. 64*1+1-), or . for a new set of four digits, or q to quit. Make 24 using these digits, once each, in any order: [7,2,1,8]: 82*71++ Correct! At the prompt, enter an RPN string (e.g. 64*1+1-), or . for a new set of four digits, or q to quit. Make 24 using these digits, once each, in any order: [6,4,2,6]: q $
Julia
This implementation, because it is based on the Julia parser and evaluator, allows the user to enter arbitrary infix expressions, including parentheses. (These expressions are checked to ensure that they only include the allowed operations on integer literals.)
validexpr(ex::Expr) = ex.head == :call && ex.args[1] in [:*,:/,:+,:-] && all(validexpr, ex.args[2:end])
validexpr(ex::Int) = true
validexpr(ex::Any) = false
findnumbers(ex::Number) = Int[ex]
findnumbers(ex::Expr) = vcat(map(findnumbers, ex.args)...)
findnumbers(ex::Any) = Int[]
function twentyfour()
digits = sort!(rand(1:9, 4))
while true
print("enter expression using $digits => ")
ex = parse(readline())
try
validexpr(ex) || error("only *, /, +, - of integers is allowed")
nums = sort!(findnumbers(ex))
nums == digits || error("expression $ex used numbers $nums != $digits")
val = eval(ex)
val == 24 || error("expression $ex evaluated to $val, not 24")
println("you won!")
return
catch e
if isa(e, ErrorException)
println("incorrect: ", e.msg)
else
rethrow()
end
end
end
end
- Output:
julia> twentyfour() enter expression using [2,5,8,9] => 5 * 2 - 8 + 9 incorrect: expression (5 * 2 - 8) + 9 evaluated to 11, not 24 enter expression using [2,5,8,9] => 5 * 5 + 2 + 8 - 9 incorrect: expression (5 * 5 + 2 + 8) - 9 used numbers [2,5,5,8,9] != [2,5,8,9] enter expression using [2,5,8,9] => 8*2*2 incorrect: expression 8 * 2 * 2 used numbers [2,2,8] != [2,5,8,9] enter expression using [2,5,8,9] => (8 + 9) + (5 + 2) you won!
Koka
import std/num/random
import std/os/readline
type expr
Num(i: int)
Add(e1: expr, e2: expr)
Sub(e1: expr, e2: expr)
Mul(e1: expr, e2: expr)
Div(e1: expr, e2: expr)
fun genNum()
random-int() % 9 + 1
fun parseFact(s: string): <div,exn> (expr, string)
match s.head
"(" ->
val (e, rest) = s.tail.parseExpr()
match rest.head
")" -> (e, rest.tail)
_ -> throw("expected ')'")
x | x.head-char.default('_').is-digit -> (Num(x.parse-int.unjust), s.tail)
_ -> throw("No factor")
fun parseTerm(s): <div,exn> (expr, string)
val (e', n) = s.parseFact()
match n.head
"*" ->
val (e'', n') = n.tail.parseTerm()
(Mul(e', e''), n')
"/" ->
val (e'', n') = n.tail.parseTerm()
(Div(e', e''), n')
_ -> (e', n)
fun parseExpr(s): <div,exn> (expr, string)
val (e', n) = s.parseTerm()
match n.head
"+" ->
val (e'', n') = n.tail.parseExpr()
(Add(e', e''), n')
"-" ->
val (e'', n') = n.tail.parseExpr()
(Sub(e', e''), n')
_ -> (e', n)
fun numbers(e: expr): div list<int>
match e
Num(i) -> [i]
Add(e1, e2) -> numbers(e1) ++ numbers(e2)
Sub(e1, e2) -> numbers(e1) ++ numbers(e2)
Mul(e1, e2) -> numbers(e1) ++ numbers(e2)
Div(e1, e2) -> numbers(e1) ++ numbers(e2)
fun check(e: expr, l: list<int>): <div,exn> ()
val ns = numbers(e)
if (ns.length == 4) then
if l.all(fn(n) ns.any(fn(x) x == n)) then
()
else
throw("wrong numbers")
else
throw("wrong number of numbers")
fun evaluate(e: expr): float64
match e
Num(i) -> i.float64
Add(e1, e2) -> evaluate(e1) + evaluate(e2)
Sub(e1, e2) -> evaluate(e1) - evaluate(e2)
Mul(e1, e2) -> evaluate(e1) * evaluate(e2)
Div(e1, e2) -> evaluate(e1) / evaluate(e2)
fun main()
println("\nGoal: ")
println("- Create an expression that evaluates to 24")
println("- Using the four given numbers each number once")
println("- Using the operators (+-/*) with no spaces")
println("Example 2 3 4 1: (2+3)*4*1\n")
println("Here are your numbers!")
var l: list<int> := Nil
repeat(4) fn()
val n = genNum()
l := Cons(n, l)
(n.show ++ " ").print
println("")
var found := False
while { !found } fn()
val (expr, r) = readline().parseExpr()
if r.count > 0 then
println("Expected EOF but got: " ++ r ++ " please try again")
return ()
expr.check(l)
val result = expr.evaluate()
if result == 24.0 then
println("You got it!")
found := True
else
println("Try again, your expression evaluated to: " ++ result.show)
Kotlin
import java.util.Random
import java.util.Scanner
import java.util.Stack
internal object Game24 {
fun run() {
val r = Random()
val digits = IntArray(4).map { r.nextInt(9) + 1 }
println("Make 24 using these digits: $digits")
print("> ")
val s = Stack<Float>()
var total = 0L
val cin = Scanner(System.`in`)
for (c in cin.nextLine()) {
when (c) {
in '0'..'9' -> {
val d = c - '0'
total += (1 shl (d * 5)).toLong()
s += d.toFloat()
}
else ->
if ("+/-*".indexOf(c) != -1) {
s += c.applyOperator(s.pop(), s.pop())
}
}
}
when {
tally(digits) != total ->
print("Not the same digits. ")
s.peek().compareTo(target) == 0 ->
println("Correct!")
else ->
print("Not correct.")
}
}
private fun Char.applyOperator(a: Float, b: Float) = when (this) {
'+' -> a + b
'-' -> b - a
'*' -> a * b
'/' -> b / a
else -> Float.NaN
}
private fun tally(a: List<Int>): Long = a.reduce({ t, i -> t + (1 shl (i * 5)) }).toLong()
private val target = 24
}
fun main(args: Array<String>) = Game24.run()
Lasso
This solution requires web input from the user via a form of the expression.
On submit the expression is checked for valid chars, that the integers are valid and in the original array (which also takes care of non-duplicate integers), and that the integers are not in consecutive positions.
If a valid expression it is evaluated, and the result and success state shown to the user.
[
if(sys_listunboundmethods !>> 'randoms') => {
define randoms()::array => {
local(out = array)
loop(4) => { #out->insert(math_random(9,1)) }
return #out
}
}
if(sys_listunboundmethods !>> 'checkvalid') => {
define checkvalid(str::string, nums::array)::boolean => {
local(chk = array('*','/','+','-','(',')',' '), chknums = array, lastintpos = -1, poscounter = 0)
loop(9) => { #chk->insert(loop_count) }
with s in #str->values do => {
#poscounter++
#chk !>> #s && #chk !>> integer(#s) ? return false
integer(#s) > 0 && #lastintpos + 1 >= #poscounter ? return false
integer(#s) > 0 ? #chknums->insert(integer(#s))
integer(#s) > 0 ? #lastintpos = #poscounter
}
#chknums->size != 4 ? return false
#nums->sort
#chknums->sort
loop(4) => { #nums->get(loop_count) != #chknums(loop_count) ? return false }
return true
}
}
if(sys_listunboundmethods !>> 'executeexpr') => {
define executeexpr(expr::string)::integer => {
local(keep = string)
with i in #expr->values do => {
if(array('*','/','+','-','(',')') >> #i) => {
#keep->append(#i)
else
integer(#i) > 0 ? #keep->append(decimal(#i))
}
}
return integer(sourcefile('['+#keep+']','24game',true,true)->invoke)
}
}
local(numbers = array, exprsafe = true, exprcorrect = false, exprresult = 0)
if(web_request->param('nums')->asString->size) => {
with n in web_request->param('nums')->asString->split(',') do => { #numbers->insert(integer(#n->trim&)) }
}
#numbers->size != 4 ? #numbers = randoms()
if(web_request->param('nums')->asString->size) => {
#exprsafe = checkvalid(web_request->param('expr')->asString,#numbers)
if(#exprsafe) => {
#exprresult = executeexpr(web_request->param('expr')->asString)
#exprresult == 24 ? #exprcorrect = true
}
}
]<h1>24 Game</h1>
<p><b>Rules:</b><br>
Enter an expression that evaluates to 24</p>
<ul>
<li>Only multiplication, division, addition, and subtraction operators/functions are allowed.</li>
<li>Brackets are allowed.</li>
<li>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).</li>
<li>The order of the digits when given does not have to be preserved.</li>
</ul>
<h2>Numbers</h2>
<p>[#numbers->join(', ')] (<a href="?">Reload</a>)</p>
[!#exprsafe ? '<p>Please provide a valid expression</p>']
<form><input type="hidden" value="[#numbers->join(',')]" name="nums"><input type="text" name="expr" value="[web_request->param('expr')->asString]"><input type="submit" name="submit" value="submit"></form>
[if(#exprsafe)]
<p>Result: <b>[#exprresult]</b> [#exprcorrect ? 'is CORRECT!' | 'is incorrect']</p>
[/if]
Liberty BASIC
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
LiveCode
GUI version
1. Open livecode and create a new mainstack
2. Create 3 fields and 1 button
3. label fields "YourNumbersField", "EvalField" and "AnswerField"
4. label button "StartButton"
5. Add the following to the code of "StartButton"
on mouseUp
put empty into fld "EvalField"
put empty into fld "AnswerField"
put random(9) & comma & random(9) & comma & random(9) & comma & random(9) into fld "YourNumbersField"
end mouseUp
6. Add the following to the code of field "EvalField"
on keyDown k
local ops, nums, allowedKeys, numsCopy, expr
put "+,-,/,*,(,)" into ops
put the text of fld "YourNumbersField" into nums
put the text of fld "EvalField" into expr
if matchText(expr & k,"\d\d") then
answer "You can't enter 2 digits together"
exit keyDown
end if
repeat with n = 1 to the number of chars of expr
if offset(char n of expr, nums) > 0 then
delete char offset(char n of expr, nums) of nums
end if
end repeat
put ops & comma & nums into allowedKeys
if k is among the items of allowedKeys then
put k after expr
delete char offset(k, nums) of nums
replace comma with empty in nums
try
put the value of merge("[[expr]]") into fld "AnswerField"
if the value of fld "AnswerField" is 24 and nums is empty then
answer "You win!"
end if
end try
pass keyDown
else
exit keyDown
end if
end keyDown
Locomotive Basic
10 CLS:RANDOMIZE TIME
20 PRINT "The 24 Game"
30 PRINT "===========":PRINT
40 PRINT "Enter an arithmetic expression"
50 PRINT "that evaluates to 24,"
60 PRINT "using only the provided digits"
70 PRINT "and +, -, *, /, (, )."
80 PRINT "(Just hit Return for new digits.)"
90 ' create new digits
100 FOR i=1 TO 4:a(i)=INT(RND*9)+1:NEXT
110 PRINT
120 PRINT "The digits are";a(1);a(2);a(3);a(4)
130 PRINT
140 ' user enters solution
150 INPUT "Your solution";s$
160 IF s$="" THEN PRINT "Creating new digits...":GOTO 100
170 GOTO 300
180 ' a little hack to create something like an EVAL function
190 OPENOUT "exp.bas"
200 PRINT #9,"1000 x="s$":return"
210 CLOSEOUT
220 CHAIN MERGE "exp",240
230 ' now evaluate the expression
240 ON ERROR GOTO 530
250 GOSUB 1000
260 IF x=24 THEN PRINT "Well done!":END
270 PRINT "No, this evaluates to"x:PRINT "Please try again."
280 GOTO 150
290 ' check input for correctness
300 FOR i=1 TO LEN(s$)
310 q=ASC(MID$(s$,i,1))
320 IF q=32 OR (q>39 AND q<44) OR q=45 OR (q>46 AND q<58) THEN NEXT
330 IF i-1=LEN(s$) THEN 370
340 PRINT "Bad character in expression:"CHR$(q)
350 PRINT "Try again":GOTO 150
360 ' new numbers in solution?
370 FOR i=1 TO LEN(s$)-1
380 q=ASC(MID$(s$,i,1)):p=ASC(MID$(s$,i+1,1))
390 IF q>47 AND q<58 AND p>47 AND p<58 THEN PRINT "No forming of new numbers, please!":GOTO 150
400 NEXT
410 FOR i=1 TO 9:orig(i)=0:guess(i)=0:NEXT
420 FOR i=1 TO 4:orig(a(i))=orig(a(i))+1:NEXT
430 FOR i=1 TO LEN(s$)
440 v$=MID$(s$,i,1)
450 va=ASC(v$)-48
460 IF va>0 AND va<10 THEN guess(va)=guess(va)+1
470 NEXT
480 FOR i=1 TO 9
490 IF guess(i)<>orig(i) THEN PRINT "Only use all the provided digits!":GOTO 150
500 NEXT
510 GOTO 190
520 ' syntax error, e.g. non-matching parentheses
530 PRINT "Error in expression, please try again."
540 RESUME 150
Note: The program needs a writable disk in the active disk drive.
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
- 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
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()
Alternately, using the lpeg.re
module:
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()
Maple
Click here to try this game online.
play24 := module()
export ModuleApply;
local cheating;
cheating := proc(input, digits)
local i, j, stringDigits;
use StringTools in
stringDigits := Implode([seq(convert(i, string), i in digits)]);
for i in digits do
for j in digits do
if Search(cat(convert(i, string), j), input) > 0 then
return true, ": Please don't combine digits to form another number."
end if;
end do;
end do;
for i in digits do
if CountCharacterOccurrences(input, convert(i, string)) < CountCharacterOccurrences(stringDigits, convert(i, string)) then
return true, ": Please use all digits.";
end if;
end do;
for i in digits do
if CountCharacterOccurrences(input, convert(i, string)) > CountCharacterOccurrences(stringDigits, convert(i, string)) then
return true, ": Please only use a digit once.";
end if;
end do;
for i in input do
try
if type(parse(i), numeric) and not member(parse(i), digits) then
return true, ": Please only use the digits you were given.";
end if;
catch:
end try;
end do;
return false, "";
end use;
end proc:
ModuleApply := proc()
local replay, digits, err, message, answer;
randomize():
replay := "":
while not replay = "END" do
if not replay = "YES" then
digits := [seq(rand(1..9)(), i = 1..4)]:
end if;
err := true:
while err do
message := "";
printf("Please make 24 from the digits: %a. Press enter for a new set of numbers or type END to quit\n", digits);
answer := StringTools[UpperCase](readline());
if not answer = "" and not answer = "END" then
try
if not type(parse(answer), numeric) then
error;
elif cheating(answer, digits)[1] then
message := cheating(answer, digits)[2];
error;
end if;
err := false;
catch:
printf("Invalid Input%s\n\n", message);
end try;
else
err := false;
end if;
end do:
if not answer = "" and not answer = "END" then
if parse(answer) = 24 then
printf("You win! Do you wish to play another game? (Press enter for a new set of numbers or END to quit.)\n");
replay := StringTools[UpperCase](readline());
else
printf("Your expression evaluated to %a. Try again!\n", parse(answer));
replay := "YES";
end if;
else
replay := answer;
end if;
printf("\n");
end do:
printf("GAME OVER\n");
end proc:
end module:
play24();
- Output:
Please make 24 from the digits: [4, 7, 6, 8]. Press enter for a new set of numbers or type END to quit You win! Do you wish to play another game? (Press enter for a new set of numbers or END to quit.) Please make 24 from the digits: [3, 7, 4, 7]. Press enter for a new set of numbers or type END to quit Your expression evaluated to 21. Try again! Please make 24 from the digits: [3, 7, 4, 7]. Press enter for a new set of numbers or type END to quit GAME OVER
Mathematica /Wolfram Language
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.
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."]]}}]
MATLAB / Octave
function twentyfour()
N = 4;
n = ceil(rand(1,N)*9);
printf('Generate a equation with the numbers %i, %i, %i, %i and +, -, *, /, () operators ! \n',n);
s = input(': ','s');
t = s;
for k = 1:N,
[x,t] = strtok(t,'+-*/() \t');
if length(x)~=1,
error('invalid sign %s\n',x);
end;
y = x-'0';
if ~(0 < y & y < 10)
error('invalid sign %s\n',x);
end;
z(1,k) = y;
end;
if any(sort(z)-sort(n))
error('numbers do not match.\n');
end;
val = eval(s);
if val==24,
fprintf('expression "%s" results in %i.\n',s,val);
else
fprintf('expression "%s" does not result in 24 but %i.\n',s,val);
end;
MiniScript
We use a simple recursive descent parser, with a bit of extra code to make sure that only available digits are used, and all of them are used.
evalAddSub = function()
result = evalMultDiv
while true
if not tokens then return result
op = tokens[0]
if op != "+" and op != "-" then return result
tokens.pull // (discard operator)
rhs = evalMultDiv
if result == null or rhs == null then return null
if op == "+" then result = result + rhs
if op == "-" then result = result - rhs
end while
end function
evalMultDiv = function()
result = evalAtom
while true
if not tokens then return result
op = tokens[0]
if op != "*" and op != "/" then return result
tokens.pull // (discard operator)
rhs = evalAtom
if result == null or rhs == null then return null
if op == "*" then result = result * rhs
if op == "/" then result = result / rhs
end while
end function
evalAtom = function()
if tokens[0] == "(" then
tokens.pull
result = evalAddSub
if not tokens or tokens.pull != ")" then
print "Unbalanced parantheses"
return null
end if
return result
end if
num = val(tokens.pull)
idx = availableDigits.indexOf(num)
if idx == null then
print str(num) + " is not available"
return null
else
availableDigits.remove idx
end if
return num
end function
choices = []
for i in range(1, 4)
choices.push ceil(rnd*9)
end for
result = null
while result != 24
availableDigits = choices[:] // (clones the list)
print "Using only the digits " + availableDigits + ","
tokens = input("enter an expression that comes to 24: ").replace(" ","").values
result = evalAddSub
if availableDigits then
print "You forgot to use: " + availableDigits
result = null
end if
if result != null then print "That equals " + result + "."
end while
print "Great job!"
- Output:
Using only the digits [5, 5, 2, 7], enter an expression that comes to 24: (7+5)*2 You forgot to use: [5] Using only the digits [5, 5, 2, 7], enter an expression that comes to 24: 5*7-5*2 That equals 25. Using only the digits [5, 5, 2, 7], enter an expression that comes to 24: 5+5+7*2 That equals 24. Great job!
mIRC Scripting Language
alias 24 {
dialog -m 24-Game 24-Game
}
dialog 24-Game {
title "24-Game"
size -1 -1 100 70
option dbu
text "", 1, 29 7 42 8
text "Equation", 2, 20 21 21 8
edit "", 3, 45 20 40 10
text "Status", 4, 10 34 80 8, center
button "Calculate", 5, 5 45 40 20
button "New", 6, 57 47 35 15
}
on *:DIALOG:24-Game:init:*: {
did -o 24-Game 1 1 Numbers: $rand(1,9) $rand(1,9) $rand(1,9) $rand(1,9)
}
on *:DIALOG:24-Game:sclick:*: {
if ($did == 5) {
if ($regex($did(3),/^[ (]*\d *[-+*/][ (]*\d[ ()]*[-+*/][ ()]*\d[ )]*[-+*/] *\d[ )]*$/)) && ($sorttok($regsubex($did(3),/[^\d]+/g,$chr(32)),32) == $sorttok($remove($did(1),Numbers:),32)) {
did -o 24-Game 4 1 $iif($calc($did(3)) == 24,Correct,Wrong)
}
else {
did -o 24-Game 4 1 Wrong Numbers or Syntax
}
}
elseif ($did == 6) {
did -o 24-Game 1 1 Numbers: $rand(1,9) $rand(1,9) $rand(1,9) $rand(1,9)
}
}
Modula-2
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 WITH*)
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.
MUMPS
24Game
k number, operator, bracket
; generate 4 random numbers each between 1 & 9
; duplicates allowed!
s n1=$r(9)+1, n2=$r(9)+1, n3=$r(9)+1, n4=$r(9)+1
; save a copy of them so that we can keep restarting
; if the user gets it wrong
s s1=n1,s2=n2,s3=n3,s4=n4
Question
s (numcount,opcount,lbrackcount,rbrackcount)=0
; restart with the random numbers already found
s n1=s1,n2=s2,n3=s3,n4=s4
w !,"Enter an arithmetic expression that evaluates to 24 using (",
n1," ",n2," ",n3," ",n4,"): "
r !,expr
q:expr=""
; validate numbers and operators
s error=""
f n=1:1:$l(expr) {
s char=$e(expr,n)
if char?1n {
s number($i(numcount))=char
w !
zw char
}
elseif char?1(1"*",1"/",1"+",1"-") {
s operator($i(opcount))=char
}
elseif char?1"(" {
s bracket($i(lbrackcount))=char
}
elseif char?1")" {
s bracket($i(rbrackcount))=char
}
else {
s error="That ain't no character I wanted to see"
q
}
}
if error'="" w error g Question
if numcount'=4 {
w "Does not have 4 numbers, do it again."
g Question
}
s error=""
f n=1:1:4 {
if number(n)=n1 {
s n1="dont use again" continue
}
if number(n)=n2 {
s n2="dont use again" continue
}
if number(n)=n3 {
s n3="dont use again" continue
}
if number(n)=n4 {
s n4="dont use again" continue
}
s error="Numbers entered do not match all of the randomly generated numbers."
q
}
if error'="" {
w error
g Question
}
if opcount'=3 {
w "Does not have 3 operators."
g Question
}
if lbrackcount'=rbrackcount {
w "brackets must be in pairs."
g Question
}
x "s x="_expr
if x'=24 {
w !,"Answer does not = 24"
g Question
}
w x
q
Nanoquery
import Nanoquery.Lang
import Nanoquery.Util
// a function to get the digits from an arithmetic expression
def extract_digits(input)
input = str(input)
digits = {}
loc = 0
digit = ""
while (loc < len(input))
if input[loc] in "0123456789"
digit += input[loc]
else
if len(digit) > 0
digits.append(int(digit))
digit = ""
end
end
loc += 1
end
// check if there's a final digit
if len(digit) > 0
digits.append(int(digit))
end
return digits
end
// a function to duplicate a digit list
def dup(list)
nlist = {}
for n in list
nlist.append(new(Integer, n))
end
return nlist
end
// generate four random digits and output them
random = new(Random)
randDigits = {}
for i in range(1, 4)
randDigits.append(random.getInt(8) + 1)
end
println "Your digits are: " + randDigits + "\n"
// get expressions from the user until a valid one is found
won = false
while !won
print "> "
expr = input()
tempDigits = dup(randDigits)
// check for invalid digits in the expression
invalid = false
digits = extract_digits(expr)
for (i = 0) (!invalid and (i < len(digits))) (i += 1)
if not digits[i] in tempDigits
invalid = true
println "Invalid digit " + digits[i]
else
tempDigits.remove(tempDigits)
end
end
// if there were no invalid digits, check if the expression
// evaluates to 24
if !invalid
a = null
try
exec("a = " + expr)
catch
println "Invalid expression " + expr
end
println a
if a = 24
println "Success!"
won = true
end
end
end
- Output:
Your digits are: [2, 5, 4, 6] > 2*5+(4*6) 34 > 2*4+5*6 38 > 5*6-(2*4) 22 > 5*6-(2+4) 24 Success!
Nim
from random import randomize, rand
from strutils import Whitespace
from algorithm import sort
from sequtils import newSeqWith
randomize()
var
problem = newSeqWith(4, rand(1..9))
stack: seq[float]
digits: seq[int]
echo "Make 24 with the digits: ", problem
template op(c: untyped) =
let a = stack.pop
stack.add c(stack.pop, a)
for c in stdin.readLine:
case c
of '1'..'9':
digits.add c.ord - '0'.ord
stack.add float(c.ord - '0'.ord)
of '+': op `+`
of '*': op `*`
of '-': op `-`
of '/': op `/`
of Whitespace: discard
else: raise newException(ValueError, "Wrong char: " & c)
sort digits
sort problem
if digits != problem:
raise newException(ValueError, "Not using the given digits.")
if stack.len != 1:
raise newException(ValueError, "Wrong expression.")
echo "Result: ", stack[0]
echo if abs(stack[0] - 24) < 0.001: "Good job!" else: "Try again."
Example game:
Make 24 with the digits: @[8, 1, 3, 1] 8 3 * 1 + 1 - Result: 24.0 Good job!
Nit
Source: the Nit’s official repository
redef class Char
fun is_op: Bool do return "-+/*".has(self)
end
# Get `numbers` and `operands` from string `operation` collect with `gets` in `main` function
# Fill `numbers` and `operands` array with previous extraction
fun exportation(operation: String, numbers: Array[Int], operands: Array[Char]) do
var previous_char: nullable Char = null
var number: nullable Int = null
var negative = false
for i in operation.length.times do
var current_char = operation[i]
var current_int = current_char.to_i
if (previous_char == null or previous_char.is_op) and current_char == '-' then
negative = true
continue
end
if current_char.is_digit then
if number == null then
number = current_int
else
number = number * 10 + current_int
end
end
if negative and (current_char.is_op or i == operation.length - 1) then
number = number - number * 2
negative = false
end
if (current_char.is_op or i == operation.length - 1) and number != null then
numbers.add(number)
number = null
end
if not negative and current_char.is_op then
operands.add(current_char)
end
previous_char = current_char
end
# Update `numbers` and `operands` array in main function with pointer
end
# Create random numbers between 1 to 9
fun random: Array[Int] do
return [for i in 4.times do 1 + 9.rand]
end
# Make mathematical operation with `numbers` and `operands` and add the operation result into `random_numbers`
fun calculation(random_numbers, numbers: Array[Int], operands: Array[Char]) do
var number = 0
var temp_numbers = numbers.clone
while temp_numbers.length > 1 do
var operand = operands.shift
var a = temp_numbers.shift
var b = temp_numbers.shift
if operand == '+' then number = a + b
if operand == '-' then number = a - b
if operand == '*' then number = a * b
if operand == '/' then number = a / b
temp_numbers.unshift(number)
end
if number != 0 then random_numbers.add(number)
end
# Check if used `numbers` exist in the `random_numbers` created
fun numbers_exists(random_numbers, numbers: Array[Int]): Bool do
for number in numbers do
if not random_numbers.count(number) >= numbers.count(number) then return false
end
return true
end
# Remove `numbers` when they are used
fun remove_numbers(random_numbers, numbers: Array[Int]) do
for number in numbers do random_numbers.remove(number)
end
# Check if the mathematical `operation` is valid
fun check(operation: String): Bool do
var previous_char: nullable Char = null
var next_char: nullable Char = null
var next_1_char: nullable Char = null
for i in operation.length.times do
var current_char = operation[i]
if i + 1 < operation.length then
next_char = operation[i + 1]
if i + 2 < operation.length then
next_1_char = operation[i + 2]
else
next_1_char = null
end
else
next_char = null
end
if not current_char.is_op and not current_char.is_digit then return false
if next_char == null and current_char.is_op then return false
if previous_char == null then
if next_char == null or next_1_char == null then return false
if current_char == '-' and not next_char.is_digit then return false
if current_char != '-' and not current_char.is_digit then return false
else
if next_char != null then
if previous_char.is_digit and current_char.is_op and
not (next_char == '-' and next_1_char != null and
next_1_char.is_digit or next_char.is_digit) then
return false
end
end
end
previous_char = current_char
end
return true
end
var random_numbers = new Array[Int]
var operation = ""
random_numbers = random
while not random_numbers.has(24) and random_numbers.length > 1 do
var numbers = new Array[Int]
var operands = new Array[Char]
print "numbers: " + random_numbers.join(", ")
operation = gets
if check(operation) then
exportation(operation, numbers, operands)
if numbers_exists(random_numbers, numbers) then
calculation(random_numbers, numbers, operands)
remove_numbers(random_numbers, numbers)
else
print "NUMBERS ERROR!"
end
else
print "STRING ERROR!"
end
end
if random_numbers.has(24) then print "CONGRATULATIONS" else print "YOU LOSE"
Objeck
use Collection.Generic;
use System.Matrix;
class RPNParser {
@stk : Stack<IntHolder>;
@digits : List<IntHolder>;
function : Main(args : String[]) ~ Nil {
digits := List->New()<IntHolder>;
"Make 24 with the digits: "->Print();
for(i := 0; i < 4; i += 1;) {
n : Int := Int->Random(1, 9);
" {$n}"->Print();
digits->AddBack(n);
};
'\n'->Print();
parser := RPNParser->New();
if(parser->Parse(System.IO.Console->ReadString(), digits)) {
result := parser->GetResult();
if(result = 24) {
"Good job!"->PrintLine();
}
else {
"{$result}, Try again."->PrintLine();
};
}
else {
"Invalid sequence"->PrintLine();
};
}
New() {
@stk := Stack->New()<IntHolder>;
@digits := List->New()<IntHolder>;
}
method : Op(f : \Func->Calc) ~ Nil {
if(@stk->Size() < 2) { "Improperly written expression"->ErrorLine(); Runtime->Exit(1); };
b := @stk->Pop();
a := @stk->Pop();
@stk->Push(f(a, b));
}
method : Parse(c : Char) ~ Nil {
if(c >= '0' & c <= '9') {
value : Int := c - '0';
@stk->Push(value);
@digits->AddBack(value);
}
else if(c = '+') {
Op(\Func->Calc : (a, b) => a + b);
}
else if(c = '-') {
Op(\Func->Calc : (a, b) => a - b);
}
else if(c = '*') {
Op(\Func->Calc : (a, b) => a * b);
}
else if(c = '/') {
Op(\Func->Calc : (a, b) => { if(b <> 0) { return a / b; } else { return 0; }; });
};
}
method : GetResult() ~ Int {
if(@stk->Size() = 1) {
return @stk->Top();
};
return 0;
}
method : Parse(s : String, digits : List<IntHolder>) ~ Bool {
each(i : s) {
Parse(s->Get(i));
};
@digits->Rewind();
while(@digits->More()) {
left := @digits->Get()->Get();
digits->Rewind();
found := false;
while(digits->More() & found = false) {
right := digits->Get()->Get();
if(left = right) {
digits->Remove(); found := true;
}
else {
digits->Next();
};
};
@digits->Next();
};
return digits->IsEmpty();
}
}
alias Func {
Calc : (IntHolder, IntHolder) ~ IntHolder
}
OCaml
Compile with:
ocamlopt -pp camlp4o g24.ml -o g24.opt
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
Oforth
import: mapping
: game
| l expr w n i |
4 #[ 9 rand ] Array init ->l
System.Out "Digits : " << l << " --> RPN Expression for 24 : " << drop
System.Console accept ->expr
expr words forEach: w [
w "+" == ifTrue: [ + continue ]
w "-" == ifTrue: [ - continue ]
w "*" == ifTrue: [ * continue ]
w "/" == ifTrue: [ >float / continue ]
w >integer dup ->n ifNull: [ System.Out "Word " << w << " not allowed " << cr break ]
n l indexOf dup ->i ifNull: [ System.Out "Integer " << n << " is wrong " << cr break ]
n l put(i, null)
]
#null? l conform? ifFalse: [ "Sorry, all numbers must be used..." . return ]
24 if=: [ "You won !" ] else: [ "You loose..." ] .
;
ooRexx
While the solution shown within this page at Rexx version 2 was created for Classic Rexx it also can be used unchanged by the ooRexx interpreter and so can be considered a solution for the ooRexx language too.
Incompatibilities(*) that were originally in Rexx version 1 were meanwhile "fixed", so it also can be used unchanged by the ooRexx interpreter and so can be considered a solution for the ooRexx language too.
(*) Classic Rexx accepts assignment without an expression (x=;), ooRexx does not.
OpenEdge/Progress
The dynamic query parser is used to evaluate the expression.
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.
PARI/GP
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
)
};
Perl
#!/usr/bin/env perl
use warnings;
use strict;
use feature 'say';
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
parentheses, (), show how to make an answer of 24.
An answer of "q" or EOF will quit the game.
A blank answer 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
my $try = 1;
while (1) {
my @digits = map { 1+int(rand(9)) } 1..4;
say "\nYour four digits: ", join(" ", @digits);
print "Expression (try ", $try++, "): ";
my $entry = <>;
if (!defined $entry || $entry eq 'q')
{ say "Goodbye. Sorry you couldn't win."; last; }
$entry =~ s/\s+//g; # remove all white space
next if $entry eq '';
my $given_digits = join "", sort @digits;
my $entry_digits = join "", sort grep { /\d/ } split(//, $entry);
if ($given_digits ne $entry_digits || # not correct digits
$entry =~ /\d\d/ || # combined digits
$entry =~ m|[-+*/]{2}| || # combined operators
$entry =~ tr|-0-9()+*/||c) # Invalid characters
{ say "That's not valid"; next; }
my $n = eval $entry;
if (!defined $n) { say "Invalid expression"; }
elsif ($n == 24) { say "You win!"; last; }
else { say "Sorry, your expression is $n, not 24"; }
}
Phix
-- Note this uses simple/strict left association, so for example: -- 1+2*1*8 is ((1+2)*1)*8 not 1+((2*1)*8) [or 1+(2*(1*8))], and -- 7-(2*2)*8 is (7-(2*2))*8 not 7-((2*2)*8) -- Does not allow unary minus on the first digit. -- Uses solve24() from the next task, when it can. -- (you may want to comment out the last 2 lines/uncomment the if 0, in that file) -- --include 24_game_solve.exw --with trace forward function eval(string equation, sequence unused, integer idx=1) -- (the above definition is entirely optional, but good coding style) constant errorcodes = {"digit expected", -- 1 "')' expected", -- 2 "digit already used", -- 3 "digit not offered", -- 4 "operand expected"} -- 5 function card(integer idx) -- (for error handling) if idx=1 then return "1st" end if if idx=2 then return "2nd" end if -- (assumes expression is less than 21 characters) return sprintf("%dth",idx) end function function errorchar(sequence equation, integer idx) if idx>length(equation) then return "" end if return sprintf("(%s)",equation[idx]) end function sequence rset = repeat(0,4) procedure new_rset() for i=1 to length(rset) do rset[i] = rand(9) end for end procedure function get_operand(string equation, integer idx, sequence unused) integer error = 1 -- "digit expected" atom res if idx<=length(equation) then integer ch = equation[idx] if ch='(' then {error,res,unused,idx} = eval(equation,unused,idx+1) if error=0 and idx<=length(equation) then ch = equation[idx] if ch=')' then return {0,res,unused,idx+1} end if end if if error=0 then error = 2 -- "')' expected" end if elsif ch>='0' and ch<='9' then res = ch-'0' integer k = find(res,unused) if k!=0 then unused[k..k] = {} return {0,res,unused,idx+1} end if if find(res,rset) then error = 3 -- "digit already used" else error = 4 -- "digit not offered" end if end if end if return {error,0,unused,idx} end function function get_operator(string equation, integer idx) integer error = 5 -- "operand expected" if idx<=length(equation) then integer ch = equation[idx] if find(ch,"+-/*") then return {0,ch,idx+1} end if end if return {error,0,idx} end function function eval(string equation, sequence unused, integer idx=1) atom lhs, rhs integer ch, error {error,lhs,unused,idx} = get_operand(equation,idx,unused) if error=0 then while 1 do {error,ch,idx} = get_operator(equation,idx) if error!=0 then exit end if {error,rhs,unused,idx} = get_operand(equation,idx,unused) if error!=0 then exit end if if ch='+' then lhs += rhs elsif ch='-' then lhs -= rhs elsif ch='/' then lhs /= rhs elsif ch='*' then lhs *= rhs else ?9/0 -- (should not happen) end if if idx>length(equation) then return {0,lhs,unused,idx} end if ch = equation[idx] if ch=')' then return {0,lhs,unused,idx} end if end while end if return {error,0,unused,idx} end function function strip(string equation) for i=length(equation) to 1 by -1 do if find(equation[i]," \t\r\n") then equation[i..i] = "" end if end for return equation end function function strip0(atom a) -- (for error handling) string res = sprintf("%f",a) for i=length(res) to 2 by -1 do integer ch = res[i] if ch='.' then return res[1..i-1] end if if ch!='0' then return res[1..i] end if end for return res end function procedure play() sequence unused string equation integer error,idx atom res new_rset() printf(1,"Enter an expression which evaluates to exactly 24\n"& "Use all of, and only, the digits %d, %d, %d, and %d\n"& "You may only use the operators + - * /\n"& "Parentheses and spaces are allowed\n",rset) while 1 do equation = strip(gets(0)) if upper(equation)="Q" then exit end if if equation="?" then puts(1,"\n") integer r_solve24 = routine_id("solve24") -- see below if r_solve24=-1 then -- (someone copied just this code out?) puts(1,"no solve24 routine\n") else call_proc(r_solve24,{rset}) end if else {error,res,unused,idx} = eval(equation, rset) if error!=0 then printf(1," %s on the %s character%s\n",{errorcodes[error],card(idx),errorchar(equation,idx)}) elsif idx<=length(equation) then printf(1,"\neval() returned only having processed %d of %d characters\n",{idx,length(equation)}) elsif length(unused) then printf(1," not all the digits were used\n",error) elsif res!=24 then printf(1,"\nresult is %s, not 24\n",{strip0(res)}) else puts(1," correct! Press any key to quit\n") {} = wait_key() exit end if end if puts(1,"enter Q to give up and quit\n") end while end procedure play()
PHP
#!/usr/bin/env php
The 24 Game
Given any four digits in the range 1 to 9, which may have repetitions,
Using just the +, -, *, and / operators; and the possible use of
brackets, (), show how to make an answer of 24.
An answer of "q" will quit the game.
An answer of "!" will generate a new set of four digits.
Otherwise you are repeatedly asked for an expression until it evaluates to 24
Note: you cannot form multiple digit numbers from the supplied digits,
so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed.
<?php
while (true) {
$numbers = make_numbers();
for ($iteration_num = 1; ; $iteration_num++) {
echo "Expresion $iteration_num: ";
$entry = rtrim(fgets(STDIN));
if ($entry === '!') break;
if ($entry === 'q') exit;
$result = play($numbers, $entry);
if ($result === null) {
echo "That's not valid\n";
continue;
}
elseif ($result != 24) {
echo "Sorry, that's $result\n";
continue;
}
else {
echo "That's right! 24!!\n";
exit;
}
}
}
function make_numbers() {
$numbers = array();
echo "Your four digits: ";
for ($i = 0; $i < 4; $i++) {
$number = rand(1, 9);
// The check is needed to avoid E_NOTICE from PHP
if (!isset($numbers[$number])) {
$numbers[$number] = 0;
}
$numbers[$number]++;
print "$number ";
}
print "\n";
return $numbers;
}
function play($numbers, $expression) {
$operator = true;
for ($i = 0, $length = strlen($expression); $i < $length; $i++) {
$character = $expression[$i];
if (in_array($character, array('(', ')', ' ', "\t"))) continue;
$operator = !$operator;
if (!$operator) {
if (!empty($numbers[$character])) {
$numbers[$character]--;
continue;
}
return;
}
elseif (!in_array($character, array('+', '-', '*', '/'))) {
return;
}
}
foreach ($numbers as $remaining) {
if ($remaining > 0) {
return;
}
}
return eval("return $expression;");
}
?>
Picat
import util.
main =>
play.
play =>
nl,
Digits = [random() mod 9 + 1 : _ in 1..4].sort(),
println("Enter \"q\" to quit"),
println("Enter \"!\" to request a new set of four digits."),
printf("Or enter expression using %w => ", Digits),
Exp = read_line().strip(),
evaluate(Digits,Exp).
evaluate(_Digits,"q") => halt.
evaluate(_Digits,"!") => play.
evaluate(Digits,Exp) =>
Operands = [to_int(D) : D in Exp, digit(D)].sort(),
(Digits !== Operands ->
println("You must use the given digits:" ++ to_string(Digits))
;
catch(Term = parse_term(Exp), Exception, println(Exception)),
Res is Term,
(Res =:= 24 ->
println("Good work!")
;
println("Wong expression")
)
),
play.
PicoLisp
(load "@lib/frac.l")
(de random4digits ()
(setq Numbers (make (do 4 (link (rand 1 9)))))
Numbers )
(de prompt ()
(prinl
"^JPlease enter a 'Lisp' expression (integer or fractional math) that equals 24,^J"
"using (, ), frac, + or f+, - or f-, * or f*, / or f/, and " Numbers "^J"
"(use each number only once). Enter . to quit." ) )
(de getinput ()
(setq Expression (catch ’NIL (in NIL (read))))
Expression )
(de checkexpression (Numbers Expression)
(make
(when (diff Numbers (fish num? Expression))
(link "Not all numbers used.") )
(when (diff (fish num? Expression) Numbers)
(link "Using wrong number(s)."))
(if (sub? "f" (pack Expression))
(when (diff (fish sym? Expression) '(frac f+ f- f* f/))
(link "Illegal operator(s). If fractional expression, must use frac, f+, f-, f*, f/ only.") )
(when (diff (fish sym? Expression) '(+ - * /))
(link "Using illegal operator(s).") ) ) ) )
(de instructions ()
(prinl "Example 'Lisp' expression: (- (* 3 9) (+ 1 2))")
(prinl
"Example 'Lisp' fractional expression:^J"
"(f- (f* (frac 3 1)(frac 9 1)) (f+ (frac 1 1)(frac 2 1)))" )
(prinl
"Use a fractional expression 'just for fun (as above)' OR if your solution^J"
"would lose remainder value(s) otherwise (through integer division)." ) )
(de loopuntilquit ()
(instructions)
(loop
(set 'Numbers (random4digits))
(prompt)
(set 'Expression (getinput))
(if (= Expression ".") (prog (prinl "bye!") (bye)))
(set 'Check (checkexpression Numbers Expression))
(if (car Check)
(mapcar prinl Check)
(prog
(set 'Evaluated (eval Expression))
(if (or (= Evaluated 24) (= Evaluated (24 . 1)))
(prinl "Congratulations!")
(prinl "That evaluated to " Evaluated " Try again!") ) ) ) ) )
(loopuntilquit)
- Output:
pil 24game.l + Example 'Lisp' expression: (+ (* 4 5) (- 1 2)) Example 'Lisp' fractional expression: (f+ (f* (frac 4 1)(frac 5 1)) (f- (frac 1 1)(frac 2 1))) Use a fractional expression if your solution would lose remainder value(s) otherwise. Please enter a 'Lisp' expression (regular or fractional math style) that equals 24, using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 1329. Enter . to quit. (f- (f* (frac 3 1)(frac 9 1)) (f+ (frac 1 1)(frac 2 1))) Congratulations! Please enter a 'Lisp' expression (regular or fractional math style) that equals 24, using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 3758. Enter . to quit. (+ (* (- 8 5) 7) 3) Congratulations! Please enter a 'Lisp' expression (regular or fractional math style) that equals 24, using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 3758. Enter . to quit. (f- (f* (frac 3 1)(frac 7 1)) (+ (frac 5 1)(frac 8 1))) Using wrong number(s). Illegal operator(s). If fractional expression, must use frac, f+, f-, f*, f/ only. Please enter a 'Lisp' expression (regular or fractional math style) that equals 24, using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 2713. Enter . to quit. (^ 2 7 1 3) Using illegal operator(s). Please enter a 'Lisp' expression (regular or fractional math style) that equals 24, using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 8367. Enter . to quit. (+ 8 3 6) Not all numbers used. Please enter a 'Lisp' expression (regular or fractional math style) that equals 24, using (, ), frac, + or f+, - or f-, * or f*, / or f/, and 1635. Enter . to quit. . bye!
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;
Potion
is_num = (s):
x = s ord(0)
if (x >= "0"ord && x <= "9"ord): true.
else: false.
.
nums = (s):
res = ()
0 to (s length, (b):
c = s(b)
if (is_num(c)):
res push(c).
.)
res.
try = 1
while (true):
r = rand string
digits = (r(0),r(1),r(2),r(3))
"\nMy next four digits: " print
digits join(" ") say
digit_s = digits ins_sort string
("Your expression to create 24 (try ", try, "): ") print
entry = read slice(0,-1)
expr = entry eval
parse = nums(entry)
parse_s = parse clone ins_sort string
try++
if (parse length != 4):
("Wrong number of digits:", parse) say.
elsif (parse_s != digit_s):
("Wrong digits:", parse) say.
elsif (expr == 24):
"You won!" say
entry print, " => 24" say
return().
else:
(entry, " => ", expr string, " != 24") join("") say.
.
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)
CLS
Function isNumeric ($x)
{
$x2 = 0
$isNum = [System.Int32]::TryParse($x,[ref]$x2)
Return $isNum
}
$NumberArray = @()
While( $NumberArray.Count -lt 4 ){
$NumberArray += Random -Minimum 1 -Maximum 10
}
Write-Host @"
Welcome to the 24 game!
Here are your numbers: $($NumberArray -join ",").
Use division, multiplication, subtraction and addition to get 24 as a result with these 4 numbers.
"@
Do
{
$Wrong = 0
$EndResult = $null
$TempChar = $null
$TempChar2 = $null
$Count = $null
$AllowableCharacters = $NumberArray + "+-*/()".ToCharArray()
$Result = Read-Host
Foreach($Char in $Result.ToCharArray())
{
If( $AllowableCharacters -notcontains $Char ){ $Wrong = 1 }
}
If($Wrong -eq 1)
{
Write-Warning "Wrong input! Please use only the given numbers."
}
Foreach($Char in $Result.ToCharArray())
{
If((IsNumeric $TempChar) -AND (IsNumeric $Char))
{
Write-Warning "Wrong input! Combining two or more numbers together is not allowed!"
}
$TempChar = $Char
}
Foreach($Char in $Result.ToCharArray())
{
If(IsNumeric $Char)
{
$Count++
}
}
If($Count -eq 4)
{
$EndResult = Invoke-Expression $Result
If($EndResult -eq 24)
{
Write-Host "`nYou've won the game!"
}
Else
{
Write-Host "`n$EndResult is not 24! Too bad."
}
}
Else
{
Write-Warning "Wrong input! You did not supply four numbers."
}
}
While($EndResult -ne 24)
ProDOS
This example uses the math module:
: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
Prolog
:- initialization(main).
answer(24).
play :- round, play ; true.
round :-
prompt(Ns), get_line(Input), Input \= "stop"
, ( phrase(parse(Ns,[]), Input) -> Result = 'correct'
; Result = 'wrong'
), write(Result), nl, nl
. % where
prompt(Ns) :- length(Ns,4), maplist(random(1,10), Ns)
, write('Digits: '), write(Ns), nl
.
parse([],[X]) --> { answer(X) }.
parse(Ns,[Y,X|S]) --> "+", { Z is X + Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "-", { Z is X - Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "*", { Z is X * Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "/", { Z is X div Y }, parse(Ns,[Z|S]).
parse(Ns,Stack) --> " ", parse(Ns,Stack).
parse(Ns,Stack) --> { select(N,Ns,Ns1), number_codes(N,[Code]) }
, [Code], parse(Ns1,[N|Stack])
.
get_line(Xs) :- get_code(X)
, ( X == 10 -> Xs = [] ; Xs = [X|Ys], get_line(Ys) )
.
main :- randomize, play, halt.
Example "session":
Digits: [9,4,6,9] 46*9-9+ correct Digits: [7,4,7,8] 8 4 7 7 / - * correct Digits: [7,2,8,2] 7282--- wrong Digits: [2,6,7,1] 4611*** wrong Digits: [3,6,5,8] + wrong Digits: [2,1,7,7] stop
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
- 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
Python: Original, with output
Uses eval, the built-in expression evaluator of infix expressions.
'''
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")
if __name__ == '__main__': main()
- 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 That's right! Thank you and goodbye.
Python: Alternative
import random, re
chars = ["(",")","/","+","-","*"]
while True:
charsandints, ints = [], []
for x in range(4):
ints.append(str(random.randrange(1,10)))
charsandints = chars + ints
print "Numbers are:", ints
guess = raw_input("Enter your guess:")
if guess.lower() == "q":
break
elif guess.lower() == "|":
pass
else:
flag = True
for a in guess:
if a not in charsandints or guess.count(a) > charsandints.count(a):
flag = False
if re.search("\d\d", guess):
print "You cannot combine digits."
break
if flag:
print "Your result is: ", eval(guess)
if eval(guess) == 24:
print "You won"
break
else:
print "You lost"
break
else:
print "You cannot use anthing other than", charsandints
break
print "Thanks for playing"
Quackery
switch
, case
, and otherwise
are defined at Metaprogramming#Quackery.
[ stack ] is operators ( --> s )
0 $ "*/+-" witheach [ bit | ]
operators put
[ stack ] is numbers ( --> s )
[ 0 swap
witheach [ bit | ]
numbers put ] is putnumbers ( $ --> )
[ $ "123456789" shuffle 4 split drop sort ] is choosenumbers ( --> $ )
[ say "Using any of the operators * / + -" cr
say "and each of the numbers "
witheach [ emit sp ] say "once," cr
say "enter an RPN expression equal to 24." cr
$ "Spaces between characters are optional: "
input ] is getexpression ( $ --> $ )
[ $ "" swap witheach
[ dup space = iff drop else join ] ] is stripspaces ( $ --> $ )
[ stack ] is opcount ( --> s )
[ stack ] is numcount ( --> s )
[ stack ] is numsused ( --> s )
[ true swap
0 opcount put
0 numcount put
0 numsused put
witheach
[ bit dup numbers share & iff
[ 1 numcount tally
numsused take | numsused put ]
else
[ operators share & if
[ 1 opcount tally ] ]
opcount share numcount share < not if
[ drop false conclude ] ]
numsused take
numbers share != if [ drop false ]
numcount take 4 != if [ drop false ]
opcount take 3 != if [ drop false ] ] is checkexpression ( $ --> b )
[ $ "" swap
witheach
[ dup char 0 char 9 1+ within iff
[ join $ " n->v " join ] done
[ switch
char * case [ $ "v* " join ]
char / case [ $ "v/ " join ]
char + case [ $ "v+ " join ]
char - case [ $ "v- " join ]
otherwise [ $ "Error!" fail ] ] ] ] is quackerise ( $ --> [ )
[ choosenumbers
dup putnumbers
[ dup getexpression
stripspaces
dup checkexpression not while
cr
say "Badly formed expression. Try again."
cr cr
drop again ]
nip
quackerise
quackery
cr
say "Your expression is equal to "
2dup 10 point$ echo$
24 n->v v- v0= iff
[ say ". :-)" ] else [ say ". :-(" ]
numbers release ] is game ( --> )
- Output:
As a dialogue in the Quackery shell.
O> game ... Using any of the operators * / + - and each of the numbers 2 3 8 9 once, enter an RPN expression equal to 24. Spaces between characters are optional: 5 7 6 2 * + + Your expression is equal to 24. :-) Stack empty. /O> game ... Using any of the operators * / + - and each of the numbers 2 3 8 9 once, enter an RPN expression equal to 24. Spaces between characters are optional: 2 + 5 + 8 + 9 Badly formed expression. Try again. Using any of the operators * / + - and each of the numbers 2 5 8 9 once, enter an RPN expression equal to 24. Spaces between characters are optional: 25+8+9+ Your expression is equal to 24. :-) Stack empty. /O> game ... Using any of the operators * / + - and each of the numbers 1 3 4 7 once, enter an RPN expression equal to 24. Spaces between characters are optional: 1 3 * 4 / 7 + Your expression is equal to 7.75. :-( Stack empty.
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.
twenty.four <- function(operators=c("+", "-", "*", "/", "("),
selector=function() sample(1:9, 4, replace=TRUE),
arguments=selector(),
goal=24) {
newdigits <- function() {
arguments <<- selector()
cat("New digits:", paste(arguments, collapse=", "), "\n")
}
help <- function() cat("Make", goal,
"out of the numbers",paste(arguments, collapse=", "),
"and the operators",paste(operators, collapse=", "), ".",
"\nEnter 'q' to quit, '!' to select new digits,",
"or '?' to repeat this message.\n")
help()
repeat {
switch(input <- readline(prompt="> "),
q={ cat("Goodbye!\n"); break },
`?`=help(),
`!`=newdigits(),
tryCatch({
expr <- parse(text=input, n=1)[[1]]
check.call(expr, operators, arguments)
result <- eval(expr)
if (isTRUE(all.equal(result, goal))) {
cat("Correct!\n")
newdigits()
} else {
cat("Evaluated to", result, "( goal", goal, ")\n")
}
},error=function(e) cat(e$message, "\n")))
}
}
check.call <- function(expr, operators, arguments) {
unexpr <- function(x) {
if (is.call(x))
unexpr(as.list(x))
else if (is.list(x))
lapply(x,unexpr)
else x
}
leaves <- unlist(unexpr(expr))
if (any(disallowed <-
!leaves %in% c(lapply(operators, as.name),
as.list(arguments)))) {
stop("'", paste(sapply(leaves[disallowed], as.character),
collapse=", "),
"' not allowed. ")
}
numbers.used <- unlist(leaves[sapply(leaves, mode) == 'numeric'])
if (! isTRUE(all.equal(sort(numbers.used), sort(arguments))))
stop("Must use each number once.")
}
Example Session
> twenty.four()
Make 24 out of the numbers 1, 6, 7, 5 and the operators +, -, *, /, ( .
Enter 'q' to quit, '!' to select new digits, or '?' to repeat this message.
> 6*(5-1)
Must use each number once.
> 1 + 6*5 - 7
Correct!
New digits: 7, 2, 9, 3
> (7+9)/2*3
Correct!
New digits: 1, 4, 1, 7
> 4*(7-1)
Must use each number once.
> (7-1)*4*1
Correct!
New digits: 1, 5, 2, 8
> (5-1)^2+8
'^' not allowed.
> !
New digits: 2, 8, 5, 2
> 52-28
'52, 28' not allowed.
> (8-2)*(5-2/2)
Must use each number once.
> (8+2)*2+5
Evaluated to 25 ( goal 24 )
> q
Goodbye!
Racket
The functional interpreter of an expression given in the infix form. It parses the S-expression representing the user's answer and handles invalid cases.
#lang racket
(define (interprete expr numbers)
;; the cashe for used numbers
(define cashe numbers)
;; updating the cashe and handling invalid cases
(define (update-cashe! x)
(unless (member x numbers) (error "Number is not in the given set:" x))
(unless (member x cashe) (error "Number is used more times then it was given:" x))
(set! cashe (remq x cashe)))
;; the parser
(define parse
(match-lambda
;; parsing arythmetics
[`(,x ... + ,y ...) (+ (parse x) (parse y))]
[`(,x ... - ,y ...) (- (parse x) (parse y))]
[`(,x ... * ,y ...) (* (parse x) (parse y))]
[`(,x ... / ,y ...) (/ (parse x) (parse y))]
[`(,x ,op ,y ...) (error "Unknown operator: " op)]
;; opening redundant brackets
[`(,expr) (parse expr)]
;; parsing numbers
[(? number? x) (update-cashe! x) x]
;; unknown token
[x (error "Not a number: " x)]))
;; parse the expresion
(define result (parse expr))
;; return the result if cashe is empty
(if (empty? cashe)
result
(error "You didn`t use all numbers!")))
Testing the interpreter:
> (interprete '(1 - 2 * 3 + 8) '(1 2 3 8)) 3 > (interprete '(1 - 2 * (3 + 8)) '(1 2 3 8)) -21 > (interprete '((1 - 2) * (3 + 8)) '(1 2 3 8)) -11 > (interprete '((1 - 2) * 3 + 8) '(1 2 3 8)) 5 > (interprete '((1 - 2) * 3 + 8) '(1 2 3 4)) Number is not in the given set: 8 > (interprete '((1 - 2) * 3 + 2) '(1 2 3 3)) Number is used more times then it was given: 2 > (interprete '((1 - 2) ^ 3 + 2) '(1 2 3 2)) Unknown operator: ^ > (interprete '((1 - 2) * 3) '(1 2 3 2)) You didn`t use all numbers!
The program which uses the interpreter to play the game:
;; starting the program
(define (start)
(displayln "Combine given four numbers using operations + - * / to get 24.")
(displayln "Input 'q' to quit or your answer like '1 - 3 * (2 + 3)'")
(new-game))
;; starting a new game
(define (new-game)
;; create a new number set
(define numbers (build-list 4 (λ (_) (+ 1 (random 9)))))
(apply printf "Your numbers: ~a ~a ~a ~a\n" numbers)
(new-input numbers))
;; processing a new user input
(define (new-input numbers)
;; if an exception is raized while processing, show the exeption message
;; and prompt for another input, but do not stop the program.
(with-handlers ([exn? (λ (exn)
(displayln (exn-message exn))
(new-input numbers))])
;; get the answer
(define user-expr (read-the-answer))
;; interprete it
(case user-expr
[(q) (display "Good buy!")]
[(n) (new-game)]
[else (define ans (interprete user-expr numbers))
(case ans
[(24) (printf "Indeed! ~a = 24\n" user-expr)
(new-game)]
[else (error "Wrong!" user-expr '= ans)])])))
;; reading and preparing the user's answer
;; "1 + 2 * (3 + 4)" --> '(1 + 2 * (3 + 4))
(define (read-the-answer)
(read (open-input-string (format "(~a)" (read-line)))))
Raku
(formerly Perl 6)
use MONKEY-SEE-NO-EVAL;
say "Here are your digits: ",
constant @digits = (1..9).roll(4)».Str;
grammar Exp24 {
token TOP { ^ <exp> $ { fail unless EVAL($/) == 24 } }
rule exp { <term>+ % <op> }
rule term { '(' <exp> ')' | <@digits> }
token op { < + - * / > }
}
while my $exp = prompt "\n24? " {
if try Exp24.parse: $exp {
say "You win :)";
last;
} else {
say (
'Sorry. Try again.' xx 20,
'Try harder.' xx 5,
'Nope. Not even close.' xx 2,
'Are you five or something?',
'Come on, you can do better than that.'
).flat.pick
}
}
The MONKEY-SEE-NO-EVAL
pragma enables the dangerous EVAL
function, which will compile and execute even user input. In this example, the grammar used to parse the input should ensure that only safe expressions are evaluated.
Red
Red []
print "Evaluation from left to right with no precedence, unless you use parenthesis." print ""
a: "123456789"
guess: ""
valid: ""
sucess: false
random/seed now/time
loop 4 [append valid last random a]
print ["The numbers are: " valid/1 ", " valid/2 ", " valid/3 " and " valid/4]
sort valid
insert valid " "
expr: [term ["+" | "-"] expr | term]
term: [primary ["*" | "/"] term | primary]
primary: [some digit | "(" expr ")"]
digit: charset valid
while [not sucess] [
guess: ask "Enter your expression: "
if guess = "q" [halt]
numbers: copy guess
sort numbers
numbers: take/last/part numbers 4
insert numbers " "
either (parse guess expr) and (valid = numbers) [
repeat i length? guess [insert at guess (i * 2) " "]
result: do guess
print ["The result of your expression is: " result]
if (result = 24) [sucess: true]
][
print "Something is wrong with the expression, try again."
]
]
print "You got it right!"
Output:
Evaluation from left to right with no precedence, unless you use parenthesis. The numbers are: 7 , 1 , 9 and 3 Enter your expression: 7+1+9 Something is wrong with the expression, try again. Enter your expression: 7+1+8+3 Something is wrong with the expression, try again. Enter your expression: 1+7*(9/3) The result of your expression is: 24 You got it right! >>
Red: Alternative
Red [
Title: "24 Game"
Author: "gltewalt"
]
op: charset "*/+-"
term: [opt "(" num opt ")"]
valid-expression: [term op term op term op term]
explode: func [val][
extract/into val 1 c: copy []
]
check-expression: does [
if "q" = e: ask "Enter expression: " [halt]
either parse trim/all e valid-expression [
either 24 = m: math to-block form explode e [
print ["You got it!" m]
][
print ["Not quite correct. That's" m]]
][
print "Invalid expression."
]
]
main: does [
numbers: collect [loop 4 [keep random 9]]
num: charset form numbers
print [newline "Using the following numbers, enter an expression that equals 24: (pmdas)" numbers]
if none? attempt [check-expression][print "Invalid expression."]
]
forever [main]
REXX
A large part of this program deals with validating the user input (and issuing appropriate and meaningful error
messages), and also that the digits presented to the user, do in fact, have a possible solution.
This REXX version uses an in─line documentation (for help).
/*REXX program helps the user find solutions to the game of 24.
╔═════════════════════════════════════════════════════════════════════════════╗
║ Argument is either of these forms: (blank) ║⌂
║ ssss ║⌂
║ ssss,total,limit ║⌂
║ ssss-ffff ║⌂
║ ssss-ffff,total,limit ║⌂
║ -ssss ║⌂
║ +ssss ║⌂
║ ║⌂
║ where SSSS and/or FFFF must be exactly four numerals (decimal digits) ║⌂
║ comprised soley of the numerals (digits) 1 ──► 9 (no zeroes). ║⌂
║ ║⌂
║ SSSS is the start, and FFFF is the end (inclusive). ║⌂
║ ║⌂
║ If ssss has a leading plus (+) sign, it's used as the digits, and ║⌂
║ the user is prompted to enter a solution (using those decimal digits). ║⌂
║ ║⌂
║ If ssss has a leading minus (-) sign, a solution is searched for and ║⌂
║ the user is told there is a solution (or not), but no solutions are shown).║⌂
║ ║⌂
║ If no argument is specified, this program generates four digits (no zeros) ║⌂
║ which has at least one solution, and shows the sorted digits to the user, ║⌂
║ requesting that they enter a solution (the digits used may be in any order).║⌂
║ ║⌂
║ If TOTAL is entered, it's the desired answer. The default is 24. ║⌂
║ If LIMIT is entered, it limits the number of solutions shown. ║⌂
║ ║⌂
║ A solution to be entered can be in the form of: ║
║ ║
║ digit1 operator digit2 operator digit3 operator digit4 ║
║ ║
║ where DIGITn is one of the digits shown (in any order), and ║
║ OPERATOR can be any one of: + - * / ║
║ ║
║ Parentheses () may be used in the normal manner for grouping, as well as ║
║ brackets [] or braces {}. Blanks can be used anywhere. ║
║ ║
║ I.E.: for the digits 3448 the following could be entered: 3*8 + (4-4) ║
╚═════════════════════════════════════════════════════════════════════════════╝ */
numeric digits 30 /*where rational arithmetic is needed. */
parse arg orig; uargs= orig /*get the guess from the command line*/
orig= space(orig, 0) /*remove all the blanks from ORIG. */
negatory= left(orig, 1)=='-' /*=1, suppresses showing. */
pository= left(orig, 1)=='+' /*=1, force pgm to use specific number.*/
if pository | negatory then orig=substr(orig,2) /*now, just use the absolute vaue. */
parse var orig orig ',' $ "," limit /*get optional total ($) and/or limit*/
parse var orig start '-' finish /*get start and finish (maybe). */
opers= '*' || "/+-" /*arithmetic opers; order is important.*/
ops= length(opers) /*the number of arithmetic operators. */
groupsym= space(' ( ) [ ] { } « » ', 0) /*the allowable grouping symbols. */
indent= left('', 30) /*indents the display of solutions. */
show= 1 /*=1, shows solutions (a semifore). */
digs= 123456789 /*numerals (digits) that can be used.*/
if $=='' then $= 24 /*the name (goal) of the game: (24) */
if limit=='' then limit= 1 /*=1, shows only one solution. */
__= copies('─', 8) /*used for output messages to the user.*/
abuttals = 0 /*=1, allows digit abuttal: 12+12 */
do j=1 for ops; o.j= substr(opers, j, 1) /*these are used for fast execution. */
end /*j*/
if \datatype(limit, 'N') then do; call ger limit "isn't numeric"; exit 13; end
limit= limit / 1 /*normalize the number for limit. */
if \datatype($, 'N') then do; call ger $ "isn't numeric"; exit 13; end
$= $ / 1 /*normalize the number for total. */
if start\=='' & \pository then do; call ranger start,finish; exit 1; end
show= 0 /*stop blabbing solutions in SOLVE. */
do forever while \negatory /*keep truckin' until a solution. */
x.= 0 /*way to hold unique expressions. */
rrrr= random(1111, 9999) /*get a random set of digits. */
if pos(0, rrrr)\==0 then iterate /*but don't the use of zeroes. */
if solve(rrrr)\==0 then leave /*try to solve for these digits. */
end /*forever*/
show= 1 /*enable SOLVE to show solutions. */
if pository then rrrr= start /*use what's specified. */
rrrr= sortc(rrrr) /*sort four elements. */
rd.= x.
do j=1 for 9; _= substr(rrrr, j, 1); rd._= #chrs(rrrr, _)
end /*j*/ /* [↑] count for each digit in RRRR. */
do guesses=1; say
say __ "Using the numerals (digits) " rrrr", enter an expression that equals " $
say right('(or ? or Quit):', 79)
pull y; uargs= y; y= space(y, 0) /*obtain user's response (expression). */
if abbrev('QUIT', y, 1) then exit 0 /*does the user want to quit this game?*/
if y=='?' then do j=2 for sourceline()-1; _= sourceline(j) /*get a line of pgm. */
if right(_, 1)=='⌂' then iterate /*ignore this doc part*/
say ' ' strip( left(_, 79), 'T') /*show " " " doc. */
if left(_, 1)=='╚' then iterate guesses
end /*j*/ /* [↑] use an in─line way to show help*/
_v= verify(y, digs || opers || groupsym) /*any illegal characters? */
if _v\==0 then do; call ger 'invalid character:' substr(y, _v, 1); iterate; end
if y='' then do; call validate y; iterate; end
do j=1 for length(y)-1 while \abuttals /*check for two adjacent decimal digits*/
if datatype( substr(y, j, 1), 'W') & datatype( substr(y, j+1, 1), 'W') then ,
do; call ger 'invalid use of digit abuttal:' substr(y, j, 2)
iterate guesses
end
end /*j*/
yy= translate(y, ')))', "]}»") /*use a simlier form for the expression*/
do j=1 for 9 while \abuttals /*check for a dig following a group sym*/
_= pos(')'j, yy) /*is there a string with: )DIGIT ? */
if _>0 then do; call ger 'invalid use of digit abuttal' substr(y, _, 2)
iterate guesses
end
end /*j*/
yd= #chrs(y, digs) /*count of legal digits 123456789 */
if yd<4 then do; call ger 'not enough numerals were entered.'; iterate guesses; end
if yd>4 then do; call ger 'too many numerals were entered.' ; iterate guesses; end
do j=1 for length(groupsym) by 2
if #chrs(y, substr(groupsym, j , 1))\==,
#chrs(y, substr(groupsym, j+1, 1)) then do; call ger 'mismatched' ,
substr(groupsym, j, 2)
iterate guesses
end
end /*j*/
do k=1 for 2 /*check for ** and // */
_= copies( substr( opers, k, 1), 2) /*only examine the first two operators.*/
if pos(_, y)\==0 then do; call ger 'illegal operator:' _; iterate guesses; end
end /*k*/
do j=1 for 9; if rd.j==0 then iterate; _d= #chrs(y, j)
if _d==rd.j then iterate
if _d<rd.j then call ger 'not enough' j "numerals were entered, must be" rd.j
else call ger 'too many' j "numerals were entered, must be" rd.j
iterate guesses
end /*j*/
y= translate(y, '()()', "[]{}") /*change extended grouping symbols──►()*/
interpret 'ans=(' y ") / 1" /*evalualte a normalized expression. */
oldDigs= digits() /*save current decimal digit setting. */
numeric digits digits()%2 /*normalize expresssion to less digits.*/
if ans/1=$ then leave guesses /*the expression calculates to 24. */
say __ "incorrect, " y"="ans /*issue an error message (incorrect). */
numeric digits oldDigs /*re─instate the decimal digs precision*/
end /*guesses*/
say; say center('┌─────────────────────┐', 79)
say center('│ │', 79)
say center('│ congratulations ! │', 79)
say center('│ │', 79)
say center('└─────────────────────┘', 79); say
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
#chrs:procedure; parse arg x,c; return length(x) - length( space( translate(x, , c), 0) )
div: procedure; parse arg q; if q=0 then q=1e9; return q /*tests if dividing by zero.*/
ger: say __ '***error*** for argument: ' uargs; say __ arg(1); errCode= 1; return 0
s: if arg(1)==1 then return arg(3); return word( arg(2) 's', 1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
ranger: parse arg ssss,ffff /*parse args passed to this sub. */
ffff= word(ffff ssss, 1) /*create a FFFF if necessary. */
do g=ssss to ffff /*process possible range of values. */
if pos(0, g)\==0 then iterate /*ignore any G number with zeroes. */
sols= solve(g); wols= sols
if sols==0 then wols= 'No' /*un─geek number of solutions (if any).*/
if negatory & sols\==0 then wols= 'A' /*found only the first solution? */
if sols==1 & limit==1 then wols= 'A'
say; say wols 'solution's(sols) "found for" g
if $\==24 then say 'for answers that equal' $
end /*g*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
solve: parse arg qqqq; finds= 0; x.=0; nq.= x. /*parse args passed to this function. */
if \validate(qqqq) then return -1
parse value '( (( )) )' with L LL RR R /*assign some static variables (fastly)*/
do jq=1 for 4; _= substr(qqqq,jq,1) /*count the number of each digit. */
nq._= nq._ + 1
end /*jq*/
gLO= 1111; gHI= 9999
if $==24 then do; gLO= 1118; gHI= 9993; end /*24: lowest poss.# that has solutions*/
do gggg=gLO to gHI; if pos(0, gggg)\==0 then iterate /*ignore values with zeroes.*/
if verify(gggg, qqqq)\==0 then iterate
if verify(qqqq, gggg)\==0 then iterate
ng.= 0
do jg=1 for 4; _= substr(gggg, jg, 1); g.jg= _; ng._= ng._ + 1
end /*jg*/ /* [↑] count the number of each digit.*/
do kg=1 for 9; if nq.kg\==ng.kg then iterate gggg
end /*kg*/ /* [↑] verify number has same # digits*/
do i=1 for ops /*insert operator after 1st numeral. */
do j=1 for ops /* " " " 2nd " */
do k=1 for ops /* " " " 3rd " */
do m=0 for 10; !.= /*nullify all grouping symbols (parens)*/
select /*used to generate grouped expressions.*/
when m==1 then do; !.1=L; !.3=R; end
when m==2 then do; !.1=L; !.5=R; end
when m==3 then do; !.1=L; !.3=R; !.4=L; !.6=R; end
when m==4 then do; !.2=L; !.5=R; end
when m==5 then do; !.2=L; !.6=R; end
when m==6 then do; !.1=LL; !.5=R; !.6=R; end
when m==7 then do; !.2=LL; !.5=R; !.6=R; end
when m==8 then do; !.1=L; !.2=L; !.6=RR; end
when m==9 then do; !.2=L; !.4=L; !.6=RR; end
otherwise nop
end /*select*/
e= space(!.1 g.1 o.i !.2 g.2 !.3 o.j !.4 g.3 !.5 o.k g.4 !.6, 0)
if x.e then iterate /*was the expression already used? */
x.e= 1 /*mark this expression as being used. */
origE= e /*keep original version for the display*/
pd= pos('/(', e) /*find pos of /( in E. */
if pd\==0 then do /*Found? Might have possible ÷ by zero*/
eo= e
lr= lastpos(')', e) /*find the last right parenthesis. */
lm= pos('-', e, pd+1) /*find a minus sign (-) after ( */
if lm>pd & lm<lr then e= changestr('/(',e,"/div(") /*change*/
if eo\==e then if x.e then iterate /*expression already used?*/
x.e= 1 /*mark this expression as being used. */
end
interpret 'x=(' e ") / 1" /*have REXX do the heavy lifting here. */
if x\==$ then do /*Not correct? Then try again. */
numeric digits 9; x= x / 1 /*re─do evaluation.*/
numeric digits 12 /*re─instate digits*/
if x\==$ then iterate /*Not correct? Then try again. */
end
finds= finds + 1 /*bump number of found solutions. */
if \show | negatory then return finds
_= translate(origE, '][', ")(") /*display [], not (). */
if show then say indent 'a solution for' gggg':' $"=" _ /*show solution.*/
if limit==1 & finds==limit then leave gggg /*leave big loop*/
end /*m*/
end /*k*/
end /*j*/
end /*i*/
end /*gggg*/
return finds
/*──────────────────────────────────────────────────────────────────────────────────────*/
sortc: procedure; arg nnnn; @.= /*sorts the digits of NNNN */
do i=1 for length(nnnn); _= substr(nnnn, i, 1); @._= @._||_; end /*i*/
return @.0 || @.1 || @.2 || @.3 || @.4 || @.5 || @.6 || @.7 || @.8 || @.9
/*──────────────────────────────────────────────────────────────────────────────────────*/
validate: parse arg y; errCode= 0; _v= verify(y, digs)
select
when y=='' then call ger 'no digits were entered.'
when length(y)<4 then call ger 'not enough digits entered, must be 4'
when length(y)>4 then call ger 'too many digits entered, must be 4'
when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)"
when _v\==0 then call ger 'illegal character:' substr(y, _v, 1)
otherwise nop
end /*select*/
Some older REXXes don't have a changestr BIF, so one is included here ──► CHANGESTR.REX.
- output of a sample execution:
──────── Using the numerals (digits) 1689, enter an expression that equals 24 (or ? or Quit): 8 * {9-6} / 1 ◄■■■■■■■■■■■■■■ this is the user input. ┌─────────────────────┐ │ │ │ congratulations ! │ │ │ └─────────────────────┘
Ring
# Project : 24 game
load "stdlib.ring"
digits = list(4)
check = list(4)
for choice = 1 to 4
digits[choice] = random(9)
next
see "enter an equation (using all of, and only, the single digits " + nl
for index = 1 to 4
see digits[index]
if index != 4
see " "
ok
next
see ")"
see " which evaluates to exactly 24. only multiplication (*), division (/)," + nl
see "addition (+) & subtraction (-) operations and parentheses are allowed:" + nl
see "24 = "
give equation
see "equation = " + equation + nl
while true
for char = 1 to len(equation)
digit = substr("0123456789", equation[char]) - 1
if digit >= 0
for index = 1 to 4
if digit = digits[index]
if not check[index]
check[index] = 1
exit
ok
ok
next
if index > 4
see "sorry, you used the illegal digit " + digit + nl
exit 2
ok
ok
next
for index = 1 to 4
if check[index] = 0
see "sorry, you failed to use the digit " + digits[index] + nl
exit 2
ok
next
for pair = 11 to 99
if substr(equation, string(pair))
see "sorry, you may not use a pair of digits " + pair + nl
ok
next
eval("result = " + equation)
if result = 24
see "congratulations, you succeeded in the task!" + nl
exit
else
see "sorry, your equation evaluated to " + result + " rather than 24!" + nl
ok
end
Output:
enter an equation (using all of, and only, the single digits 3 1 4 5) which evaluates to exactly 24. only multiplication (*), division (/), addition (+) & subtraction (-) operations and parentheses are allowed: 24 = 4*5+3+1 equation = 4*5+3+1 congratulations, you succeeded in the task! enter an equation (using all of, and only, the single digits 5 7 2 5) which evaluates to exactly 24. only multiplication (*), division (/), addition (+) & subtraction (-) operations and parentheses are allowed: 24 = 98+72 equation = 98+72 sorry, you used the illegal digit 9
RPL
« IF DUP TYPE 9. ≠ THEN { } + @ stack contains a number ELSE CASE OBJ→ SWAP 2. ≠ THEN DROP 0 END @ stack contains a monadic operator "+-*/" SWAP →STR POS NOT THEN DROP 0 END @ stack contains a forbidden dyadic operator END GET4 SWAP GET4 + END » 'GET4' STO @ ( 'expression' → { numbers } ) « 1 CF « RAND 9 * CEIL R→I » 'x' 1 4 1 SEQ SORT @ generate 4 numbers WHILE 1 FC? REPEAT "Make 24 with" OVER →STR 2 OVER SIZE 2 - SUB + { "'" ALG V } INPUT @ asks for an evaluable string CLLCD DUP TAIL 1 DISP STR→ DUP GET4 CASE DUP 0 POS THEN DROP2 "Forbidden operator" END SORT 3 PICK ≠ THEN DROP "Bad number" END EVAL DUP →NUM 3 DISP 24 == THEN 1 SF "You won!" END "Failed to get 24" END 2 DISP 2 WAIT END DROP » 'GAM24' STO
Ruby
class Guess < String
def self.play
nums = Array.new(4){rand(1..9)}
loop do
result = get(nums).evaluate!
break if result == 24.0
puts "Try again! That gives #{result}!"
end
puts "You win!"
end
def self.get(nums)
loop do
print "\nEnter a guess using #{nums}: "
input = gets.chomp
return new(input) if validate(input, nums)
end
end
def self.validate(guess, nums)
name, error =
{
invalid_character: ->(str){ !str.scan(%r{[^\d\s()+*/-]}).empty? },
wrong_number: ->(str){ str.scan(/\d/).map(&:to_i).sort != nums.sort },
multi_digit_number: ->(str){ str.match(/\d\d/) }
}
.find {|name, validator| validator[guess] }
error ? puts("Invalid input of a(n) #{name.to_s.tr('_',' ')}!") : true
end
def evaluate!
as_rat = gsub(/(\d)/, '\1r') # r : Rational suffix
eval "(#{as_rat}).to_f"
rescue SyntaxError
"[syntax error]"
end
end
Guess.play
Rust
The solution below converts the infix notation to RPN and then calculates the result.
I am still new to Rust so i am certain it could be written in a shorter way. So if there is someone better than me please feel free to improve.
use std::io::{self,BufRead};
extern crate rand;
use rand::Rng;
fn op_type(x: char) -> i32{
match x {
'-' | '+' => return 1,
'/' | '*' => return 2,
'(' | ')' => return -1,
_ => return 0,
}
}
fn to_rpn(input: &mut String){
let mut rpn_string : String = String::new();
let mut rpn_stack : String = String::new();
let mut last_token = '#';
for token in input.chars(){
if token.is_digit(10) {
rpn_string.push(token);
}
else if op_type(token) == 0 {
continue;
}
else if op_type(token) > op_type(last_token) || token == '(' {
rpn_stack.push(token);
last_token=token;
}
else {
while let Some(top) = rpn_stack.pop() {
if top=='(' {
break;
}
rpn_string.push(top);
}
if token != ')'{
rpn_stack.push(token);
}
}
}
while let Some(top) = rpn_stack.pop() {
rpn_string.push(top);
}
println!("you formula results in {}", rpn_string);
*input=rpn_string;
}
fn calculate(input: &String, list : &mut [u32;4]) -> f32{
let mut stack : Vec<f32> = Vec::new();
let mut accumulator : f32 = 0.0;
for token in input.chars(){
if token.is_digit(10) {
let test = token.to_digit(10).unwrap() as u32;
match list.iter().position(|&x| x == test){
Some(idx) => list[idx]=10 ,
_ => println!(" invalid digit: {} ",test),
}
stack.push(accumulator);
accumulator = test as f32;
}else{
let a = stack.pop().unwrap();
accumulator = match token {
'-' => a-accumulator,
'+' => a+accumulator,
'/' => a/accumulator,
'*' => a*accumulator,
_ => {accumulator},//NOP
};
}
}
println!("you formula results in {}",accumulator);
accumulator
}
fn main() {
let mut rng = rand::thread_rng();
let mut list :[u32;4]=[rng.gen::<u32>()%10,rng.gen::<u32>()%10,rng.gen::<u32>()%10,rng.gen::<u32>()%10];
println!("form 24 with using + - / * {:?}",list);
//get user input
let mut input = String::new();
io::stdin().read_line(&mut input).unwrap();
//convert to rpn
to_rpn(&mut input);
let result = calculate(&input, &mut list);
if list.iter().any(|&list| list !=10){
println!("and you used all numbers");
match result {
24.0 => println!("you won"),
_ => println!("but your formulla doesn't result in 24"),
}
}else{
println!("you didn't use all the numbers");
}
}
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.
object TwentyFourGame {
def main(args: Array[String]) {
import Parser.TwentyFourParser
println(welcome)
var parser = new TwentyFourParser(problemsIterator.next)
println("Your four digits: "+parser+".")
var finished = false
var expressionCount = 1
do {
val line = Console.readLine("Expression "+expressionCount+": ")
line match {
case "!" =>
parser = new TwentyFourParser(problemsIterator.next)
println("New digits: "+parser+".")
case "q" =>
finished = true
case _ =>
parser readExpression line match {
case Some(24) => println("That's right!"); finished = true
case Some(n) => println("Sorry, that's "+n+".")
case None =>
}
}
expressionCount += 1
} while (!finished)
println("Thank you and goodbye!")
}
val welcome = """|The 24 Game
|
|Given any four digits in the range 1 to 9, which may have repetitions,
|Using just the +, -, *, and / operators; and the possible use of
|brackets, (), show how to make an answer of 24.
|
|An answer of "q" will quit the game.
|An answer of "!" will generate a new set of four digits.
|Otherwise you are repeatedly asked for an expression until it evaluates to 24
|
|Note: you cannot form multiple digit numbers from the supplied digits,
|so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed.
|""".stripMargin
val problemsIterator = (
Iterator
continually List.fill(4)(scala.util.Random.nextInt(9) + 1 toDouble)
filter hasSolution
)
def hasSolution(l: List[Double]) = permute(l) flatMap computeAllOperations exists (_ == 24)
def computeAllOperations(l: List[Double]): List[Double] = l match {
case Nil => Nil
case x :: Nil => l
case x :: xs =>
for {
y <- computeAllOperations(xs)
z <- if (y == 0) List(x*y, x+y, x-y) else List(x*y, x/y, x+y, x-y)
} yield z
}
def permute(l: List[Double]): List[List[Double]] = l match {
case Nil => List(Nil)
case x :: xs =>
for {
ys <- permute(xs)
position <- 0 to ys.length
(left, right) = ys splitAt position
} yield left ::: (x :: right)
}
object Parser {
/* Arithmetic expression grammar production rules in EBNF form:
*
* <expr> --> <term> ( '+' <term> | '-' <term> )*
* <term> --> <factor> ( '*' <factor> | '/' <factor> )*
* <factor> --> '(' <expr> ')' | <digit>
* <digit> --> 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9
*
* Semantically, <digit> can only be a digit from the list of remaining digits.
*/
class TwentyFourParser(digits: List[Double]) extends scala.util.parsing.combinator.RegexParsers {
require(digits.length == 4 && digits.forall(d => 0 <= d && d <= 9))
override val toString = digits.map(_.toInt).mkString(", ")
// Grammar
def exprConsumingAllDigits = expr ^? (remainingDigits.allDigitsConsumed, digitsRemainingError) // Guarantees all digits consumed
def expr : Parser[Double] = term ~ rep( "+" ~ term | "-" ~ term) ^^ solveOperationChain
def term = factor ~ rep( "*" ~ factor | "/" ~ factor) ^^ solveOperationChain
def factor = "(" ~> expr <~ ")" | digit
def digit = digitRegex ^? (remainingDigits.consumeDigit, digitNotAllowedError)
def digitRegex = "\\d".r | digitExpected
def digitExpected: Parser[String] = ".".r <~ failure(expectedDigitError) // Produces clear error messages
// Evaluate expressions
def readExpression(input: String): Option[Double] = {
remainingDigits = new DigitList(digits) // Initialize list of digits to be consumed
parseAll(exprConsumingAllDigits, input) match {
case Success(result, _) => Some(result)
case NoSuccess(msg, next) =>
println(ParsingErrorFormatter(msg, next))
None
}
}
// List of digits to be consumed
private var remainingDigits: DigitList = _
// Solve partial results from parsing
private def solveOperationChain(partialResult: ~[Double,List[~[String,Double]]]): Double = partialResult match {
case first ~ chain => chain.foldLeft(first)(doOperation)
}
private def doOperation(acc: Double, op: ~[String, Double]): Double = op match {
case "+" ~ operand => acc + operand
case "-" ~ operand => acc - operand
case "*" ~ operand => acc * operand
case "/" ~ operand => acc / operand
case x => error("Unknown operation "+x+".")
}
// Error messages
private def digitNotAllowedError(d: String) = "Digit "+d+" is not allowed here. Available digits: "+remainingDigits+"."
private def digitsRemainingError(x: Any) = "Not all digits were consumed. Digits remaining: "+remainingDigits+"."
private def expectedDigitError = "Unexpected input. Expected a digit from the list: "+remainingDigits+"."
}
private object ParsingErrorFormatter {
def apply[T](msg: String, next: scala.util.parsing.input.Reader[T]) =
"%s\n%s\n%s\n" format (msg, next.source.toString.trim, " "*(next.offset - 1)+"^")
}
private class DigitList(digits: List[Double]) {
private var remainingDigits = digits
override def toString = remainingDigits.map(_.toInt).mkString(", ")
def consumeDigit: PartialFunction[String, Double] = {
case d if remainingDigits contains d.toDouble =>
val n = d.toDouble
remainingDigits = remainingDigits diff List(n)
n
}
def allDigitsConsumed: PartialFunction[Double, Double] = {
case n if remainingDigits.isEmpty => n
}
}
}
}
- 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
(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)
- 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!
Sidef
const digits = (1..9 -> pick(4))
const grammar = Regex(
'^ (?&exp) \z
(?(DEFINE)
(?<exp> ( (?&term) (?&op) (?&term) )+ )
(?<term> \( (?&exp) \) | [' + digits.join + '])
(?<op> [\-+*/] )
)', 'x'
)
say "Here are your digits: #{digits.join(' ')}"
loop {
var input = read("Expression: ", String)
var expr = input
expr -= /\s+/g # remove all whitespace
if (input == 'q') {
say "Goodbye. Sorry you couldn't win."
break
}
var given_digits = digits.map{.to_s}.sort.join
var entry_digits = input.scan(/\d/).sort.join
if ((given_digits != entry_digits) || (expr !~ grammar)) {
say "That's not valid"
next
}
given(var n = eval(input)) {
when (24) { say "You win!"; break }
default { say "Sorry, your expression is #{n}, not 24" }
}
}
- Output:
Here are your digits: 8 2 3 4 Expression: 8 * (2 - (3 + 4)) Sorry, your expression is -40, not 24 Expression: 8 * (2 - (3 - That's not valid Expression: 8 * (2 - (3 - 4)) You win!
Simula
BEGIN
CLASS EXPR;
BEGIN
REAL PROCEDURE POP;
BEGIN
IF STACKPOS > 0 THEN
BEGIN STACKPOS := STACKPOS - 1; POP := STACK(STACKPOS); END;
END POP;
PROCEDURE PUSH(NEWTOP); REAL NEWTOP;
BEGIN
STACK(STACKPOS) := NEWTOP;
STACKPOS := STACKPOS + 1;
END PUSH;
REAL PROCEDURE CALC(OPERATOR, ERR); CHARACTER OPERATOR; LABEL ERR;
BEGIN
REAL X, Y; X := POP; Y := POP;
IF OPERATOR = '+' THEN PUSH(Y + X)
ELSE IF OPERATOR = '-' THEN PUSH(Y - X)
ELSE IF OPERATOR = '*' THEN PUSH(Y * X)
ELSE IF OPERATOR = '/' THEN BEGIN
IF X = 0 THEN
BEGIN
EVALUATEDERR :- "DIV BY ZERO";
GOTO ERR;
END;
PUSH(Y / X);
END
ELSE
BEGIN
EVALUATEDERR :- "UNKNOWN OPERATOR";
GOTO ERR;
END
END CALC;
PROCEDURE READCHAR(CH); NAME CH; CHARACTER CH;
BEGIN
IF T.MORE THEN CH := T.GETCHAR ELSE CH := EOT;
END READCHAR;
PROCEDURE SKIPWHITESPACE(CH); NAME CH; CHARACTER CH;
BEGIN
WHILE (CH = SPACE) OR (CH = TAB) OR (CH = CR) OR (CH = LF) DO
READCHAR(CH);
END SKIPWHITESPACE;
PROCEDURE BUSYBOX(OP, ERR); INTEGER OP; LABEL ERR;
BEGIN
CHARACTER OPERATOR;
REAL NUMBR;
BOOLEAN NEGATIVE;
SKIPWHITESPACE(CH);
IF OP = EXPRESSION THEN
BEGIN
NEGATIVE := FALSE;
WHILE (CH = '+') OR (CH = '-') DO
BEGIN
IF CH = '-' THEN NEGATIVE := NOT NEGATIVE;
READCHAR(CH);
END;
BUSYBOX(TERM, ERR);
IF NEGATIVE THEN
BEGIN
NUMBR := POP; PUSH(0 - NUMBR);
END;
WHILE (CH = '+') OR (CH = '-') DO
BEGIN
OPERATOR := CH; READCHAR(CH);
BUSYBOX(TERM, ERR); CALC(OPERATOR, ERR);
END;
END
ELSE IF OP = TERM THEN
BEGIN
BUSYBOX(FACTOR, ERR);
WHILE (CH = '*') OR (CH = '/') DO
BEGIN
OPERATOR := CH; READCHAR(CH);
BUSYBOX(FACTOR, ERR); CALC(OPERATOR, ERR)
END
END
ELSE IF OP = FACTOR THEN
BEGIN
IF (CH = '+') OR (CH = '-') THEN
BUSYBOX(EXPRESSION, ERR)
ELSE IF (CH >= '0') AND (CH <= '9') THEN
BUSYBOX(NUMBER, ERR)
ELSE IF CH = '(' THEN
BEGIN
READCHAR(CH);
BUSYBOX(EXPRESSION, ERR);
IF CH = ')' THEN READCHAR(CH) ELSE GOTO ERR;
END
ELSE GOTO ERR;
END
ELSE IF OP = NUMBER THEN
BEGIN
NUMBR := 0;
WHILE (CH >= '0') AND (CH <= '9') DO
BEGIN
NUMBR := 10 * NUMBR + RANK(CH) - RANK('0'); READCHAR(CH);
END;
IF CH = '.' THEN
BEGIN
REAL FAKTOR;
READCHAR(CH);
FAKTOR := 10;
WHILE (CH >= '0') AND (CH <= '9') DO
BEGIN
NUMBR := NUMBR + (RANK(CH) - RANK('0')) / FAKTOR;
FAKTOR := 10 * FAKTOR;
READCHAR(CH);
END;
END;
PUSH(NUMBR);
END;
SKIPWHITESPACE(CH);
END BUSYBOX;
BOOLEAN PROCEDURE EVAL(INP); TEXT INP;
BEGIN
EVALUATEDERR :- NOTEXT;
STACKPOS := 0;
T :- COPY(INP.STRIP);
READCHAR(CH);
BUSYBOX(EXPRESSION, ERRORLABEL);
! OUTTEXT("T = '");
! OUTTEXT(T);
! OUTTEXT("'");
! OUTTEXT(", T.POS = ");
! OUTINT(T.POS, 0);
! OUTTEXT(", STACKPOS = ");
! OUTINT(STACKPOS, 0);
! OUTTEXT(", T.MORE = ");
! OUTCHAR(IF T.MORE THEN 'T' ELSE 'F');
! OUTTEXT(", CH = ");
! OUTCHAR(CH);
! OUTIMAGE;
IF NOT T.MORE AND STACKPOS = 1 AND CH = EOT THEN
BEGIN
EVALUATED := POP;
EVAL := TRUE;
GOTO NOERRORLABEL;
END;
ERRORLABEL:
EVAL := FALSE;
IF EVALUATEDERR = NOTEXT THEN
EVALUATEDERR :- "INVALID EXPRESSION: " & INP;
NOERRORLABEL:
END EVAL;
REAL PROCEDURE RESULT;
RESULT := EVALUATED;
TEXT PROCEDURE ERR;
ERR :- EVALUATEDERR;
TEXT T;
INTEGER EXPRESSION;
INTEGER TERM;
INTEGER FACTOR;
INTEGER NUMBER;
CHARACTER TAB;
CHARACTER LF;
CHARACTER CR;
CHARACTER SPACE;
CHARACTER EOT;
CHARACTER CH;
REAL ARRAY STACK(0:31);
INTEGER STACKPOS;
REAL EVALUATED;
TEXT EVALUATEDERR;
EXPRESSION := 1;
TERM := 2;
FACTOR := 3;
NUMBER := 4;
TAB := CHAR(9);
LF := CHAR(10);
CR := CHAR(13);
SPACE := CHAR(32);
EOT := CHAR(0);
END EXPR;
INTEGER ARRAY DIGITS(1:4);
INTEGER SEED, I;
REF(EXPR) E;
E :- NEW EXPR;
OUTTEXT("ENTER RANDOM SEED: ");
OUTIMAGE;
SEED := ININT;
FOR I := 1 STEP 1 UNTIL 4 DO DIGITS(I) := RANDINT(0, 9, SEED);
L: BEGIN
INTEGER ARRAY DIGITSUSED(0:9);
INTEGER ARRAY DIGITSTAKEN(0:9);
CHARACTER C, LASTC;
TEXT INP;
LASTC := CHAR(0);
OUTTEXT("MAKE 24 USING THESE DIGITS: ");
FOR I := 1 STEP 1 UNTIL 4 DO
BEGIN
OUTINT(DIGITS(I), 2);
DIGITSUSED( DIGITS(I) ) := DIGITSUSED( DIGITS(I) ) + 1;
END;
OUTIMAGE;
INIMAGE;
INP :- COPY(SYSIN.IMAGE.STRIP);
OUTIMAGE;
WHILE INP.MORE DO
BEGIN
C := INP.GETCHAR;
IF (C >= '0') AND (C <= '9') THEN
BEGIN
INTEGER D;
IF (LASTC >= '0') AND (LASTC <= '9') THEN
BEGIN
OUTTEXT("NUMBER HAS TOO MANY DIGITS: ");
OUTCHAR(LASTC);
OUTCHAR(C);
OUTIMAGE;
GOTO L;
END;
D := RANK(C) - RANK('0');
DIGITSTAKEN(D) := DIGITSTAKEN(D) + 1;
END
ELSE IF NOT ((C = '+') OR (C = '-') OR (C = '/') OR (C = '*') OR
(C = ' ') OR (C = '(') OR (C = ')')) THEN
BEGIN
OUTTEXT("ILLEGAL INPUT CHARACTER: ");
OUTCHAR(C);
OUTIMAGE;
GOTO L;
END;
LASTC := C;
END;
FOR I := 0 STEP 1 UNTIL 9 DO
BEGIN
IF DIGITSUSED(I) <> DIGITSTAKEN(I) THEN
BEGIN
OUTTEXT("NOT THE SAME DIGITS.");
OUTIMAGE;
GOTO L;
END;
END;
IF E.EVAL(INP) THEN
BEGIN
OUTTEXT("RESULT IS ");
OUTFIX(E.RESULT, 4, 10);
OUTIMAGE;
OUTTEXT(IF ABS(E.RESULT - 24) < 0.001
THEN "YOU WIN"
ELSE "YOU LOOSE");
OUTIMAGE;
END
ELSE
BEGIN
OUTTEXT(E.ERR);
OUTIMAGE;
END;
END;
END.
- Output:
ENTER RANDOM SEED:
- Input:
787
- Output:
MAKE 24 USING THESE DIGITS: 6 7 3 9
- Input:
(9 - 7 + 6) * 3
- Output:
RESULT IS 24.0000 YOU WIN
Swift
import Darwin
import Foundation
println("24 Game")
println("Generating 4 digits...")
func randomDigits() -> Int[] {
var result = Int[]();
for var i = 0; i < 4; i++ {
result.append(Int(arc4random_uniform(9)+1))
}
return result;
}
// Choose 4 digits
let digits = randomDigits()
print("Make 24 using these digits : ")
for digit in digits {
print("\(digit) ")
}
println()
// get input from operator
var input = NSString(data:NSFileHandle.fileHandleWithStandardInput().availableData, encoding:NSUTF8StringEncoding)
var enteredDigits = Int[]()
var enteredOperations = Character[]()
let inputString = input as String
// store input in the appropriate table
for character in inputString {
switch character {
case "1", "2", "3", "4", "5", "6", "7", "8", "9":
let digit = String(character)
enteredDigits.append(digit.toInt()!)
case "+", "-", "*", "/":
enteredOperations.append(character)
case "\n":
println()
default:
println("Invalid expression")
}
}
// check value of expression provided by the operator
var value = Int()
if enteredDigits.count == 4 && enteredOperations.count == 3 {
value = enteredDigits[0]
for (i, operation) in enumerate(enteredOperations) {
switch operation {
case "+":
value = value + enteredDigits[i+1]
case "-":
value = value - enteredDigits[i+1]
case "*":
value = value * enteredDigits[i+1]
case "/":
value = value / enteredDigits[i+1]
default:
println("This message should never happen!")
}
}
}
if value != 24 {
println("The value of the provided expression is \(value) instead of 24!")
} else {
println("Congratulations, you found a solution!")
}
Tcl
This version also terminates cleanly on end-of-file.
# 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
TorqueScript
Includes an equation parser to avoid using eval. To use, type startTwentyFourGame(); in the console.
function startTwentyFourGame()
{
if($numbers !$= "")
{
echo("Ending current 24 game...");
endTwentyFourGame();
}
echo("Welcome to the 24 game!");
echo("Generating 4 numbers...");
for(%a = 0; %a < 4; %a++)
$numbers = setWord($numbers, %a, getRandom(0, 9));
echo("Numbers generated! Here are your numbers:");
echo($numbers);
echo("Use try24Equation( equation ); to try and guess the equation.");
$TwentyFourGame = 1;
}
function endTwentyFourGame()
{
if(!$TwentyFourGame)
{
echo("No 24 game is active!");
return false;
}
echo("Ending the 24 game.");
$numbers = "";
$TwentyFourGame = 0;
}
function try24Equation(%equ)
{
if(!$TwentyFourGame)
{
echo("No 24 game is active!");
return false;
}
%numbers = "0123456789";
%operators = "+-*x/()";
%tempchars = $numbers;
%other = strReplace(%tempchars, " ", "");
//Check it and make sure it has all the stuff
%equ = strReplace(%equ, " ", "");
%length = strLen(%equ);
for(%a = 0; %a < %Length; %a++)
{
%Char = getSubStr(%equ, %a, 1);
if(%a+1 != %Length)
%Next = getSubStr(%equ, %a+1, 1);
else
%Next = " ";
if(strPos(%numbers @ %operators, %char) < 0)
{
echo("The equation you entered is invalid! Try again.");
return false;
}
if(strPos(%tempchars, %char) < 0 && strPos(%operators, %char) < 0)
{
echo("The equation you entered uses a number you were not given! Try again.");
return false;
}
else if(strPos(%numbers, %next) >= 0 && strPos(%numbers, %char) >= 0)
{
echo("No numbers above 9 please! Try again.");
echo(%next SPC %char SPC %a);
return false;
}
else if(strPos(%operators, %char) > 0)
continue;
%pos = 2*strPos(%other, %char);
if(%pos < 0)
return "ERROROMG";
//Remove it from the allowed numbers
%tempchars = removeWord(%tempchars, %pos/2);
%other = getSubStr(%other, 0, %pos) @ getSubStr(%other, %pos+1, strLen(%other));
}
%result = doEquation(%equ);
if(%result != 24)
{
echo("Your equation resulted to" SPC %result @ ", not 24! Try again.");
return false;
}
for(%a = 0; %a < 4; %a++)
$numbers = setWord($numbers, %a, getRandom(0, 9));
echo("Great job!" SPC %equ SPC "Does result to 24! Here's another set for you:");
echo($numbers);
}
//Evaluates an equation without using eval.
function doEquation(%equ)
{ //Validate the input
%equ = strReplace(%equ, " ", "");%equ = strReplace(%equ, "*", "x");
%equ = strReplace(%equ, "+", " + ");%equ = strReplace(%equ, "x", " x ");
%equ = strReplace(%equ, "/", " / ");%equ = strReplace(%equ, "-", " - ");
//Parenthesis'
while(strPos(%equ, "(") > -1 && strPos(%equ, ")") > 0)
{
%start = strPos(%equ, "(");
%end = %start;
%level = 1;
while(%level != 0 && %end != strLen(%equ))
{
%end++;
if(getsubStr(%equ, %end, 1) $= "(") %level++;
if(getsubStr(%equ, %end, 1) $= ")") %level--;
}
if(%level != 0)
return "ERROR";
%inbrackets = getsubStr(%equ, %start+1, %end - strLen(getsubStr(%equ, 0, %start + 1)));
%leftofbrackets = getsubStr(%equ, 0, %start);
%rightofbrackets = getsubStr(%equ, %end + 1, strLen(%equ) - %end);
%equ = %leftofbrackets @ doEquation(%inbrackets) @ %rightofbrackets;
}
if(strPos(%equ, "ERROR") >= 0)
return "ERROR";
//Multiplication/Division loop
for(%a = 0; %a < getWordCount(%equ); %a++)
{
if(getWord(%equ, %a) $= "x" || getWord(%equ, %a) $= "/" && %a != 0)
{
%f = getWord(%equ, %a - 1);
%l = getWord(%equ, %a + 1);
%o = getWord(%equ, %a);
switch$(%o)
{
case "x": %a--;
%equ = removeWord(removeWord(setWord(%equ, %a+1, %f * %l), %a+2), %a);
case "/": %a--;
%equ = removeWord(removeWord(setWord(%equ, %a+1, %f / %l), %a+2), %a);
}
}
}
//Addition/Subraction loop
for(%a = 0; %a < getWordCount(%equ); %a++)
{
if(getWord(%equ, %a) $= "+" || getWord(%equ, %a) $= "-" && %a != 0)
{
%f = getWord(%equ, %a - 1);
%l = getWord(%equ, %a + 1);
%o = getWord(%equ, %a);
switch$(%o)
{
case "+": %a--;
%equ = removeWord(removeWord(setWord(%equ, %a+1, %f + %l), %a+2), %a);
case "-": %a--;
%equ = removeWord(removeWord(setWord(%equ, %a+1, %f - %l), %a+2), %a);
}
}
}
return %equ;
}
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
- 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
UNIX Shell
Tried to be POSIX. Not sure about corner-cases.
gen_digits() {
awk 'BEGIN { srand()
for(i = 1; i <= 4; i++) print 1 + int(9 * rand())
}' | sort
}
same_digits() {
[ "$(tr -dc 0-9 | sed 's/./&\n/g' | grep . | sort)" = "$*" ]
}
guessed() {
[ "$(echo "$1" | tr -dc '\n0-9()*/+-' | bc 2>/dev/null)" = 24 ]
}
while :
do
digits=$(gen_digits)
echo
echo Digits: $digits
read -r expr
echo " $expr" | same_digits "$digits" || \
{ echo digits should be: $digits; continue; }
guessed "$expr" && message=correct \
|| message=wrong
echo $message
done
VBA
Sub Rosetta_24game()
Dim Digit(4) As Integer, i As Integer, iDigitCount As Integer
Dim stUserExpression As String
Dim stFailMessage As String, stFailDigits As String
Dim bValidExpression As Boolean, bValidDigits As Boolean, bValidChars As Boolean
Dim vResult As Variant, vTryAgain As Variant, vSameDigits As Variant
' Generate 4 random digits
GenerateNewDigits:
For i = 1 To 4
Digit(i) = [randbetween(1,9)]
Next i
' Get user expression
GetUserExpression:
bValidExpression = True
stFailMessage = ""
stFailDigits = ""
stUserExpression = InputBox("Enter a mathematical expression which results in 24, using the following digits: " & _
Digit(1) & ", " & Digit(2) & ", " & Digit(3) & " and " & Digit(4), "Rosetta Code | 24 Game")
' Check each digit is included in user expression
bValidDigits = True
stFailDigits = ""
For i = 1 To 4
If InStr(stUserExpression, Digit(i)) = 0 Then
bValidDigits = False
stFailDigits = stFailDigits & " " & Digit(i)
End If
Next i
If bValidDigits = False Then
bValidExpression = False
stFailMessage = "Your expression excluded the following required digits: " & stFailDigits & vbCr & vbCr
End If
' Check each character of user expression is a valid character type
bValidDigits = True
stFailDigits = ""
For i = 1 To Len(stUserExpression)
If InStr("0123456789+-*/()", Mid(stUserExpression, i, 1)) = 0 Then
bValidDigits = False
stFailDigits = stFailDigits & " " & Mid(stUserExpression, i, 1)
End If
Next i
If bValidDigits = False Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained invalid characters:" & stFailDigits & vbCr & vbCr
End If
' Check no disallowed integers entered
bValidDigits = True
stFailDigits = ""
iDigitCount = 0
For i = 1 To Len(stUserExpression)
If Not InStr("0123456789", Mid(stUserExpression, i, 1)) = 0 Then
iDigitCount = iDigitCount + 1
If IsError(Application.Match(--(Mid(stUserExpression, i, 1)), Digit, False)) Then
bValidDigits = False
stFailDigits = stFailDigits & " " & Mid(stUserExpression, i, 1)
End If
End If
Next i
If iDigitCount > 4 Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained more than 4 digits" & vbCr & vbCr
End If
If iDigitCount < 4 Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained less than 4 digits" & vbCr & vbCr
End If
If bValidDigits = False Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained invalid digits:" & stFailDigits & vbCr & vbCr
End If
' Check no double digit numbers entered
bValidDigits = True
stFailDigits = ""
For i = 11 To 99
If Not InStr(stUserExpression, i) = 0 Then
bValidDigits = False
stFailDigits = stFailDigits & " " & i
End If
Next i
If bValidDigits = False Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression contained invalid numbers:" & stFailDigits & vbCr & vbCr
End If
' Check result of user expression
On Error GoTo EvalFail
vResult = Evaluate(stUserExpression)
If Not vResult = 24 Then
bValidExpression = False
stFailMessage = stFailMessage & "Your expression did not result in 24. It returned: " & vResult
End If
' Return results
If bValidExpression = False Then
vTryAgain = MsgBox(stFailMessage & vbCr & vbCr & "Would you like to try again?", vbCritical + vbRetryCancel, "Rosetta Code | 24 Game | FAILED")
If vTryAgain = vbRetry Then
vSameDigits = MsgBox("Do you want to use the same numbers?", vbQuestion + vbYesNo, "Rosetta Code | 24 Game | RETRY")
If vSameDigits = vbYes Then
GoTo GetUserExpression
Else
GoTo GenerateNewDigits
End If
End If
Else
vTryAgain = MsgBox("You entered: " & stUserExpression & vbCr & vbCr & "which resulted in: " & vResult, _
vbInformation + vbRetryCancel, "Rosetta Code | 24 Game | SUCCESS")
If vTryAgain = vbRetry Then
GoTo GenerateNewDigits
End If
End If
Exit Sub
EvalFail:
bValidExpression = False
vResult = Err.Description
Resume
End Sub
V (Vlang)
import os
import rand
import rand.seed
import math
fn main() {
rand.seed(seed.time_seed_array(2))
mut n := []int{len: 4}
for i in 0.. n.len {
n[i] = rand.intn(9) or {0}
}
println("Your numbers: $n")
expr := os.input("Enter RPN: ")
if expr.len != 7 {
println("invalid. expression length must be 7." +
" (4 numbers, 3 operators, no spaces)")
return
}
mut stack := []f64{len: 0, cap:4}
for r in expr.split('') {
if r >= '0' && r <= '9' {
if n.len == 0 {
println("too many numbers.")
return
}
mut i := 0
for n[i] != r.int() {
i++
if i == n.len {
println("wrong numbers.")
return
}
}
n.delete(n.index(r.int()))
stack << f64(r[0]-'0'[0])
continue
}
if stack.len < 2 {
println("invalid expression syntax.")
return
}
match r {
'+' {
stack[stack.len-2] += stack[stack.len-1]
}
'-' {
stack[stack.len-2] -= stack[stack.len-1]
}
'*' {
stack[stack.len-2] *= stack[stack.len-1]
}
'/' {
stack[stack.len-2] /= stack[stack.len-1]
}
else {
println("$r invalid.")
return
}
}
stack = stack[..stack.len-1]
}
if math.abs(stack[0]-24) > 1e-6 {
println("incorrect. ${stack[0]} != 24")
} else {
println("correct.")
}
}
- Output:
Sample game:
Make 24 using these digits: [2, 3, 5, 1] > 23*51-* Correct!
Wren
import "random" for Random
import "./ioutil" for Input
import "./seq" for Stack
var R = Random.new()
class Game24 {
static run() {
var digits = List.filled(4, 0)
for (i in 0..3) digits[i] = R.int(1, 10)
System.print("Make 24 using these digits: %(digits)")
var cin = Input.text("> ")
var s = Stack.new()
var total = 0
for (c in cin) {
var d = c.bytes[0]
if (d >= 48 && d <= 57) {
d = d - 48
total = total + (1 << (d*5))
s.push(d)
} else if ("+-*/".indexOf(c) != -1) s.push(applyOperator_(s.pop(), s.pop(), c))
}
if (tallyDigits_(digits) != total) {
System.write("Not the same digits.")
} else if ((24 - s.peek()).abs < 0.001) {
System.print("Correct!")
} else {
System.write("Not correct.")
}
}
static applyOperator_(a, b, c) {
if (c == "+") return a + b
if (c == "-") return b - a
if (c == "*") return a * b
if (c == "/") return b / a
return 0/0
}
static tallyDigits_(a) {
var total = 0
for (i in 0...a.count) total = total + (1 << (a[i]*5))
return total
}
}
Game24.run()
- Output:
Sample game:
Make 24 using these digits: [2, 3, 5, 1] > 23*51-* Correct!
XPL0
real Stack(10), A, B;
int SP, I, Char, Digit, Digits(10);
proc Push(X);
real X;
[Stack(SP):= X; SP:= SP+1];
func real Pop;
[SP:= SP-1; return Stack(SP)];
[SP:= 0;
for I:= 0 to 9 do Digits(I):= 0;
Text(0, "Enter an RPN expression that equals 24 using all these digits:");
for I:= 0 to 3 do
[Digit:= Ran(9)+1;
ChOut(0, ^ ); ChOut(0, Digit+^0);
Digits(Digit):= Digits(Digit)+1;
];
Text(0, "^m^j> ");
loop [Char:= ChIn(1);
ChOut(0, Char);
if Char >= ^1 and Char <=^9 then
[Digit:= Char - ^0;
Push(float(Digit));
Digits(Digit):= Digits(Digit) - 1;
]
else [if SP >= 2 then [A:= Pop; B:= Pop] else quit;
case Char of
^+: Push(B+A);
^-: Push(B-A);
^*: Push(B*A);
^/: Push(B/A)
other quit;
];
];
CrLf(0);
for I:= 0 to 9 do
if Digits(I) # 0 then
[Text(0, "Must use each of the given digits.^m^j"); exit];
Text(0, if abs(Pop-24.0) < 0.001 then "Correct!" else "Wrong.");
CrLf(0);
]
- Output:
Enter an RPN expression that equals 24 using all these digits: 1 4 4 9 > 44*9+1- Correct!
Yabasic
With reverse polish notation
operadores$ = "*/+-"
espacios$ = " "
clear screen
print "24 Game"
print "============\n"
print "The player is provided with 4 numbers with which to perform operations"
print "of addition (+), subtraction (-), multiplication (*) or division (/) to attempt"
print "to get 24 as result."
print "Use reverse Polish notation (first the operands and then the operators)."
print "For example: instead of 2 + 4, type 2 4 +\n\n"
repeat
print at(0,9) espacios$, espacios$, espacios$, espacios$, espacios$, espacios$
print at(0,9);
serie$ = ordenaCadena$(genSerie$())
validos$ = serie$+operadores$
line input "Enter your formula in reverse Polish notation: " entrada$
entrada$ = quitaEspacios$(entrada$)
entradaOrd$ = ordenaCadena$(entrada$)
if (right$(entradaOrd$,4) <> serie$) or (len(entradaOrd$)<>7) then
print "Error in the entered series"
else
resultado = evaluaEntrada(entrada$)
print "The result is = ",resultado," "
if resultado = 24 then
print "Correct!"
else
print "Error!"
end if
end if
print "Want to try again? (press N to exit, or another key to continue)"
until(upper$(left$(inkey$(),1)) = "N")
sub genSerie$()
local i, c$, s$
print "The numbers to be used are: ";
i = ran()
for i = 1 to 4
c$ = str$(int(ran(9))+1)
print c$," ";
s$ = s$ + c$
next i
print
return s$
end sub
sub evaluaEntrada(entr$)
local d1, d2, c$, n(4), i
while(entr$<>"")
c$ = left$(entr$,1)
entr$ = mid$(entr$,2)
if instr(serie$,c$) then
i = i + 1
n(i) = val(c$)
elseif instr(operadores$,c$) then
d2 = n(i)
n(i) = 0
i = i - 1
d1 = n(i)
n(i) = evaluador(d1, d2, c$)
else
print "Invalid sign"
return
end if
wend
return n(i)
end sub
sub evaluador(d1, d2, op$)
local t
switch op$
case "+": t = d1 + d2 : break
case "-": t = d1 - d2 : break
case "*": t = d1 * d2 : break
case "/": t = d1 / d2 : break
end switch
return t
end sub
sub quitaEspacios$(entr$)
local n, i, s$, t$(1)
n = token(entr$,t$()," ")
for i=1 to n
s$ = s$ + t$(i)
next i
return s$
end sub
sub ordenaCadena$(cadena$)
local testigo, n, fin, c$
fin = len(cadena$)-1
repeat
testigo = false
for n = 1 to fin
if mid$(cadena$,n,1) > mid$(cadena$,n+1,1) then
testigo = true
c$ = mid$(cadena$,n,1)
mid$(cadena$,n,1) = mid$(cadena$,n+1,1)
mid$(cadena$,n+1,1) = c$
end if
next n
until(testigo = false)
return cadena$
end sub
do
clear screen
n$=""
for i=1 to 4
n$=n$+str$(int(ran(9)+1))
next i
print at(35,0) "24 GAME\n"
print "Combine numbers and operators for obtain 24."
print "Allowed characters: ";
i$=n$+"+-*/()"
for i=1 to 10
print mid$(i$,i,1)," ";
next i
print "[nothing to end program]\n"
label accept
p$=""
i$=n$+"+-*/()"
print at(0,4);:input "Enter the formula: " f$
if f$="" end
for i=1 to len(f$)
c$=mid$(f$,i,1)
switch c$
case " ": f$=left$(f$,i-1)+right$(f$,len(f$)-i): break
case "+":case "-":case "*":case "/": p$=p$+"o": break
case "(":case ")": p$=p$+c$: break
case mid$(i$,1,1): p$=p$+"n": mid$(i$,1,1)=" ": break
case mid$(i$,2,1): p$=p$+"n": mid$(i$,2,1)=" ": break
case mid$(i$,3,1): p$=p$+"n": mid$(i$,3,1)=" ": break
case mid$(i$,4,1): p$=p$+"n": mid$(i$,4,1)=" ": break
default: message(" = Invalid argument! "): break
end switch
if f$="" goto accept
next i
restore
for i=1 to 11
read t$
if t$=p$ break
next i
if t$<>p$ then
message(" = Bad construction! ")
goto accept
end if
let r=eval(f$)
print "\n",f$," = ",r," ";
if r<>24 then
message(" = Wrong! ")
goto accept
else
message(" = Correct! ")
pause 5
end if
loop
DATA "nononon"
DATA "(non)onon"
DATA "nono(non)"
DATA "no(no(non))"
DATA "((non)on)on"
DATA "no(non)on"
DATA "(non)o(non)"
DATA "no((non)on)"
DATA "(nonon)on"
DATA "(no(non))on"
DATA "no(nonon)"
sub message(m$)
print at(0,7) f$,m$
beep: beep: beep
pause 1
print at(19,4) " "
f$=""
end sub
sub eval(c$)
static linea
linea=linea+1
c$="sub s"+str$(linea+1000000,"#######")+"():return "+c$+":end sub"
compile c$
return execute(mid$(c$,5,8))
end sub
zkl
while(1){
digits := [1..4].pump(String,(0).random.fpM("11-",1,9));
exp := ask("Enter an expression using the digits ",digits,
" that evals to 24: ") - " \n";
expf:=exp.apply(fcn(c){if ("1"<=c<="9") "(%s).toFloat()".fmt(c) else c});
reg r;
try { Compiler.Compiler.compileText(expf).__constructor(); r=vm.regX }
catch { println("bad expression"); continue; }
else{
extra := (exp - "+-/*()" - digits);
if (extra) { println("Extra goodies in expression: ",extra); continue; }
(digits.split("").sort() != (exp - "+-/*()").split("").sort()) :
if(_) { println("You can only use the digits ",digits," once each"); continue; };
if (exp.matches("*[1-9][1-9]*"))
{ println("no repeated digits"); continue; }
if (r.closeTo(24,0.001)) "nice!".println();
else println("That evaled to ",r,", not 24");
}
}
- Output:
Enter an expression using the digits 8833 that evals to 24: (8/(3-(8/3))) nice! Enter an expression using the digits 8833 that evals to 24: (8/(3-(8/9))) Extra goodies in expression: 9 Enter an expression using the digits 8833 that evals to 24: (8/(3-(8/8))) You can only use the digits 8833 once each Enter an expression using the digits 7155 that evals to 24: 7+1+5+5 That evaled to 18, not 24 Enter an expression using the digits 8332 that evals to 24: 8*3*(3-2) nice!
ZX Spectrum Basic
10 LET n$=""
20 RANDOMIZE
30 FOR i=1 TO 4
40 LET n$=n$+STR$ (INT (RND*9)+1)
50 NEXT i
60 LET i$="": LET f$="": LET p$=""
70 CLS
80 PRINT "24 game"
90 PRINT "Allowed characters:"
100 LET i$=n$+"+-*/()"
110 PRINT AT 4,0;
120 FOR i=1 TO 10
130 PRINT i$(i);" ";
140 NEXT i
150 PRINT "(0 to end)"
160 INPUT "Enter the formula";f$
170 IF f$="0" THEN STOP
180 PRINT AT 6,0;f$;" = ";
190 FOR i=1 TO LEN f$
200 LET c$=f$(i)
210 IF c$=" " THEN LET f$(i)="": GO TO 250
220 IF c$="+" OR c$="-" OR c$="*" OR c$="/" THEN LET p$=p$+"o": GO TO 250
230 IF c$="(" OR c$=")" THEN LET p$=p$+c$: GO TO 250
240 LET p$=p$+"n"
250 NEXT i
260 RESTORE
270 FOR i=1 TO 11
280 READ t$
290 IF t$=p$ THEN LET i=11
300 NEXT i
310 IF t$<>p$ THEN PRINT INVERSE 1;"Bad construction!": BEEP 1,.1: PAUSE 0: GO TO 60
320 FOR i=1 TO LEN f$
330 FOR j=1 TO 10
340 IF (f$(i)=i$(j)) AND f$(i)>"0" AND f$(i)<="9" THEN LET i$(j)=" "
350 NEXT j
360 NEXT i
370 IF i$( TO 4)<>" " THEN PRINT FLASH 1;"Invalid arguments!": BEEP 1,.01: PAUSE 0: GO TO 60
380 LET r=VAL f$
390 PRINT r;" ";
400 IF r<>24 THEN PRINT FLASH 1;"Wrong!": BEEP 1,1: PAUSE 0: GO TO 60
410 PRINT FLASH 1;"Correct!": PAUSE 0: GO TO 10
420 DATA "nononon"
430 DATA "(non)onon"
440 DATA "nono(non)"
450 DATA "no(no(non))"
460 DATA "((non)on)on"
470 DATA "no(non)on"
480 DATA "(non)o(non)"
485 DATA "no((non)on)"
490 DATA "(nonon)on"
495 DATA "(no(non))on"
500 DATA "no(nonon)"
- Programming Tasks
- Solutions by Programming Task
- Puzzles
- Games
- 11l
- 8th
- AArch64 Assembly
- ABAP
- Ada
- ALGOL 68
- APL
- Applesoft BASIC
- Argile
- ARM Assembly
- Arturo
- AutoHotkey
- AutoIt
- BBC BASIC
- Befunge
- Bracmat
- C
- C sharp
- C++
- Ceylon
- Clojure
- COBOL
- CoffeeScript
- Commodore BASIC
- Common Lisp
- D
- Delphi
- SysUtils,StdCtrls
- EchoLisp
- Elena
- Elixir
- Erlang
- F Sharp
- Factor
- Falcon
- Fortran
- FreeBASIC
- Frink
- FutureBasic
- GAP
- Go
- Gosu
- Groovy
- Haskell
- HicEst
- Huginn
- Icon
- Unicon
- Icon Programming Library
- J
- Java
- JavaScript
- Jq
- Julia
- Koka
- Kotlin
- Lasso
- Liberty BASIC
- LiveCode
- Locomotive Basic
- Logo
- Lua
- Maple
- Mathematica
- Wolfram Language
- MATLAB
- Octave
- MiniScript
- MIRC Scripting Language
- Modula-2
- Ulm's Modula-2 Library
- MUMPS
- Nanoquery
- Nim
- Nit
- Objeck
- OCaml
- Oforth
- OoRexx
- OpenEdge/Progress
- PARI/GP
- Examples needing attention
- Perl
- Phix
- PHP
- Picat
- PicoLisp
- PL/I
- Potion
- PowerShell
- ProDOS
- Prolog
- PureBasic
- Python
- Quackery
- R
- Racket
- Raku
- Red
- REXX
- Ring
- RPL
- Ruby
- Rust
- Rand
- Scala
- Scheme
- Sidef
- Simula
- Swift
- Tcl
- TorqueScript
- TUSCRIPT
- GUISS/Omit
- ML/I/Omit
- UNIX Shell
- VBA
- V (Vlang)
- Wren
- Wren-ioutil
- Wren-seq
- XPL0
- Yabasic
- Zkl
- ZX Spectrum Basic