24 game
From Rosetta Code
You are encouraged to solve this task according to the task description, using any language you may know.
The 24 Game tests one's mental arithmetic.
Write a program that randomly chooses and displays four digits, each from one to nine, with repetitions allowed. The program should prompt for the player to enter an equation using just those, and all of those four digits. The program should check then evaluate the expression. The goal is for the player to enter an expression that evaluates to 24.
- Only multiplication, division, addition, and subtraction operators/functions are allowed.
- Division should use floating point or rational arithmetic, etc, to preserve remainders.
- If using an infix expression evaluator then brackets are allowed.
- Forming multiple digit numbers from the supplied digits is disallowed. (So an answer of 12+12 when given 1, 2, 2, and 1 is wrong).
- The order of the digits when given does not have to be preserved.
Note:
- The type of expression evaluator used is not mandated. An RPN evaluator is equally acceptable for example.
- The task is not for the program to generate the expression, or test whether an expression is even possible.
C.f: 24 game Player
Reference
- The 24 Game on h2g2.
Contents |
[edit] Argile
Works with: Argile version 1.0.0
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
[edit] 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
}
[edit] C
See 24 game/C
[edit] C#
See 24 game/CSharp
[edit] Clojure
(ns game
(:use clojure.contrib.fcase))
(def op-map {\+ + \- - \* * \/ /})
; Returns nil iff x is not an operator char
(defn- op? [x] (get op-map x))
; Sneaky... but works because of op?'s implementation
(def get-op op?)
(def ws-set #{\space \tab \newline})
(defn- ws? [x] (contains? ws-set x))
; Returns the numeric value of an ASCII digit character.
; Returns -1 if the character is not a digit.
(defn- atoi [ch] (Character/getNumericValue ch))
(defn- digit? [x] (Character/isDigit x))
(defn- fail [& msg-parts]
(throw (RuntimeException. (apply str msg-parts))))
; Returns a seq of n random ints from 1 to 9 inclusive
(defn- pick-nums [n]
(for [i (range n)] (inc (rand-int 9))))
; Returns a (lazy) seq of numbers and operators
; as seen in s.
(defn- lex [s]
(filter #(not (nil? %)) ; Skip whitespace
(for [ch s]
(cond
(ws? ch) nil
(pos? (atoi ch)) (atoi ch)
(op? ch) (get-op ch)
true (fail "Invalid input character: " ch)))))
; Returns the value for 'a0 op a1'
(defn- dispatch [op a0 a1]
(if-not (and (op? op) (number? a0) (number? a1))
(fail "Doesn't parse!")
(op a0 a1)))
; Evaluates an rpn expression prefix
; Returns [the-rest-of-the-input, the-value-computed]
(defn- do-eval [in]
(let [hd (first in) tl (rest in)]
(cond
(number? hd) [tl hd]
(op? hd)
(let [[rst a0] (do-eval tl) [rst a1] (do-eval rst)]
[rst (dispatch hd a0 a1)])
true (fail "Tried to eval '" hd "' but needed op or num."))))
; Returns coll without the first ocurrence of x.
; If coll didn't contain x, returns nil.
(defn- without [coll x]
(let [[a b] (split-with #(not= x %) coll)]
(if (empty? b)
nil
(concat a (rest b)))))
; Returns true iff 'in' contains exactly one
; ocurrence of each number in 'expect'
(defn- check [expect in]
(if (empty? expect)
(or (empty? in)
(and (not (number? (first in)))
(recur expect (rest in))))
(if (empty? in)
nil ; Didn't use all numbers
(let [hd (first in) tl (rest in)]
(if-not (number? hd)
(recur expect tl)
(when-let [ok (without expect hd)]
(recur ok tl)))))))
; Returns true iff input evaluates to 'result' and
; consists of each number from nums combined
; via +, -, * and /
(defn- decide
([nums input] (decide nums input 24))
([nums input result]
(let [tokens (lex input)] ; Scan the input for meaningful tokens
(when-not (check nums tokens) (fail "Didn't use the right numbers."))
(let [[leftovers answer] (do-eval tokens)]
(when-not (empty? leftovers) (fail "Doesn't parse!"))
(when-not (= result answer) (fail "That equals " answer))
nil)))) ; WIN!
; Asks the user if they would like to play again.
(defn- new-game? []
(println "Would you like to play again? (y/n)")
(let [input (read-line)]
(case input
"y" true
"n" nil
(recur))))
; Plays a game of 24
(defn play-game []
(let [nums (pick-nums 4)]
; Prompt the user
(print "Use these numbers to make 24:")
(doseq [n nums] (print (str " " n)))
(newline)
(flush)
; Get some input
(let [input (read-line)]
(try
(decide nums input)
(println "You win!")
(catch RuntimeException e
(println (. e getMessage) "You lose.")))
(if (new-game?)
(recur)
(println "Goodbye!")))))
[edit] 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 (random 10))))
(check (e)
(typecase e
((eql bye) (return-from 24-game))
((eql !) (signal 'choose-digits))
(atom (lose))
(cons (check-sub (car e) (check-sub (cdr e) chosen-digits)) e)))
(check-sub (sub allowed-digits)
(typecase sub
((member nil + - * /) allowed-digits)
(integer
(if (member sub allowed-digits)
(remove sub allowed-digits :count 1)
(lose)))
(cons (check-sub (car sub) (check-sub (cdr sub) allowed-digits)))
(t (lose))))
(win ()
(format t "You win.~%")
(return-from 24-game)))
(choose)
(loop
(handler-case
(if (= 24 (eval (check (prompt)))) (win) (lose))
(error () (format t "Bad equation, try again.~%"))
(choose-digits () (choose)))))))
Verbose Implementation
Works with: clisp version 2.47
(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
[edit] 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
[edit] Haskell
import Char
import Control.Monad.Error
import Data.List
import IO
import Maybe
import Random
main = do
hSetBuffering stdout NoBuffering
mapM_ putStrLn
[ "THE 24 GAME\n"
, "Given four digits in the range 1 to 9"
, "Use the +, -, *, and / operators in reverse polish notation"
, "To show how to make an answer of 24.\n"
]
digits <- liftM (sort . take 4 . randomRs (1,9)) getStdGen :: IO [Int]
putStrLn ("Your digits: " ++ intercalate " " (map show digits))
guessLoop digits
where guessLoop digits =
putStr "Your expression: " >>
liftM (processGuess digits . words) getLine >>=
either (\m -> putStrLn m >> guessLoop digits) putStrLn
processGuess _ [] = Right ""
processGuess digits xs | not $ matches = Left "Wrong digits used"
where matches = digits == (sort . map read $ filter (all isDigit) xs)
processGuess digits xs = calc xs >>= check
where check 24 = Right "Correct"
check x = Left (show (fromRational (x :: Rational)) ++ " is wrong")
-- A Reverse Polish Notation calculator with full error handling
calc = result []
where result [n] [] = Right n
result _ [] = Left "Too few operators"
result ns (x:xs) = simplify ns x >>= flip result xs
simplify (a:b:ns) s | isOp s = Right ((fromJust $ lookup s ops) b a : ns)
simplify _ s | isOp s = Left ("Too few values before " ++ s)
simplify ns s | all isDigit s = Right (fromIntegral (read s) : ns)
simplify _ s = Left ("Unrecognized symbol: " ++ s)
isOp v = elem v $ map fst ops
ops = [("+",(+)), ("-",(-)), ("*",(*)), ("/",(/))]
[edit] 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;
[edit] 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
[edit] 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()
[edit] Mathematica
Works with: Mathematica version 6
Since Mathematica hasn't historically had good custom I/O support (the command-line allowed all operations, not very good for UI-generation), I had to roll some custom GUI (with a text box), which requires Mathematica 6.
Most of the job is already done by Mathematica (the expression conversion); in fact, it is too good—it automatically converts ex. 3/4 to Times[3, Power[4, -1]], which we have to specifically test for so that real powers don't get through.
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."]]}}]
[edit] 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 expr =
match expr with
| 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 expr =
match expr with
| 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
[edit] Perl
qq(
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.
);
while(1)
{
$it = 0;
&mkNumbers;
while(1)
{
$it++;
print "Expression $it: ";
chomp($ent = <>);
last if $ent eq '!';
exit if $ent eq 'q';
my $r = &play;
if(!defined $r)
{
print "That's not valid\n";
next;
}elsif($r != 24)
{
print "Sorry, that's $r\n";
next;
}else{ print "That's right! 24!!\n";exit; }
}
}
sub mkNumbers
{
%numbers = ();
print "Your four digits:";
for(1..4)
{
$i = 1 + int(rand(9));
$numbers{$i}++;
print "$i ";
}
print "\n";
}
sub play
{
%bak_numbers = %numbers;
@itens = split //,$ent;
$operator = 1;
for(@itens)
{
next if $_ =~ /[()]/;
$operator = !$operator;
if(!$operator)
{
if( defined $numbers{$_} && $numbers{$_} > 0)
{
$numbers{$_}--;
next;
}else{ return undef; }
}else{
return undef if $_ !~ m{[-+*/]};
}
}
%numbers = %bak_numbers;
return eval($ent);
}
[edit] PicoLisp
(de checkExpression (Lst Exe)
(make
(when (diff Lst (fish num? Exe))
(link "Not all numbers used" ) )
(when (diff (fish num? Exe) Lst)
(link "Using wrong number(s)") )
(when (diff (fish sym? Exe) '(+ - * /))
(link "Using illegal operator(s)") ) ) )
(loop
(setq Numbers (make (do 4 (link (rand 1 9)))))
(prinl
"Please enter a Lisp expression using (, ), +, -, *, / and "
(glue ", " Numbers) )
(prin "Or a single dot '.' to stop: ")
(T (= "." (setq Reply (catch '(NIL) (in NIL (read)))))
(bye) )
(cond
((str? Reply)
(prinl "-- Input error: " Reply) )
((checkExpression Numbers Reply)
(prinl "-- Illegal Expression")
(for S @
(space 3)
(prinl S) ) )
((str? (setq Result (catch '(NIL) (eval Reply))))
(prinl "-- Evaluation error: " @) )
((= 24 Result)
(prinl "++ Congratulations! Correct result :-)") )
(T (prinl "Sorry, this gives " Result)) )
(prinl) )
Output:
Please enter a Lisp expression using (, ), +, -, *, / and 1, 3, 3, 5 Or a single dot '.' to stop: (* (+ 3 1) (+ 5 1)) ++ Congratulations! Correct result :-) Please enter a Lisp expression using (, ), +, -, *, / and 8, 4, 7, 1 Or a single dot '.' to stop: (* 8 (% 7 3) 9) -- Illegal Expression Not all numbers used Using wrong number(s) Using illegal operator(s) Please enter a Lisp expression using (, ), +, -, *, / and 4, 2, 2, 3 Or a single dot '.' to stop: (/ (+ 4 3) (- 2 2)) -- Evaluation error: Div/0 Please enter a Lisp expression using (, ), +, -, *, / and 8, 4, 5, 9 Or a single dot '.' to stop: .
[edit] 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;
[edit] Python
Uses eval, the in-built 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")
main()
Sample Output
The 24 Game Given any four digits in the range 1 to 9, which may have repetitions, Using just the +, -, *, and / operators; and the possible use of brackets, (), show how to make an answer of 24. An answer of "q" will quit the game. An answer of "!" will generate a new set of four digits. Note: you cannot form multiple digit numbers from the supplied digits, so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed. Your four digits: 3 2 4 6 Expression 1: (3 - 1)*(6*4) The input '(3 - 1)*(6*4)' was wonky! Expression 2: (3 - 2) * 6 * 4 = 24 Thats right! Thank you and goodbye
[edit] R
A loose Translation of: Python
Helper functions:
welcomemessage <- function()
{
cat(
'The 24 Game\n
Given any four digits in the range 1 to 9, which may have repetitions,
Using just the +, -, *, and / operators; and the possible use of\nbrackets, (), show how to make an answer of 24.\n
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.\n
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.
')
}
generatenumbers <- function()
{
sample(1:9, 4, replace=TRUE)
}
printnumbers <- function(num)
{
cat("Your four digits: ", paste(num, collapse=", "), ".\n", sep="")
}
checkinput <- function(input, num)
{
# First check: are all the characters arithmetic operators or brackets or spaces or the input numbers?
allowedchars <- paste("^[-+*/()[:space:]", paste(unique(num), collapse=""), "]*$", sep="")
if(regexpr(allowedchars, input) < 0) return(FALSE)
# Second check: are all the numbers single digits?
if(regexpr("[1-9]{2,}", input) > 0) return(FALSE)
# Third check: do the digits in the input exactly match the generated set?
digits <- as.numeric(strsplit(input, "")[[1]])
digits <- digits[!is.na(digits)]
if(!isTRUE(all.equal(sort(digits), sort(num)))) return(FALSE)
# Fourth check: is the input valid R code?
parsed <- try(parse(text=input))
if(class(parsed) == "try-error") return(FALSE)
# Fifth check: is the answer 24?
ans <- suppressWarnings(eval(parsed))
ans == 24
}
wonkymessage <- function(input)
{
cat("The input", input, "was wonky!\n")
}
Main game function
twentyfour <- function()
{
welcomemessage()
gennew <- TRUE
repeat
{
if(gennew)
{
num <- generatenumbers()
printnumbers(num)
}
input <- readline(prompt="Enter your solution >>")
if(tolower(input) =="q") # Quit
{
break
}
if(input == "!") # New game
{
gennew <- TRUE
next
}
if(!checkinput(input, num))
{
wonkymessage(input)
gennew <- FALSE
next
} else
{
cat ("Thats right!\n")
break
}
}
cat("Thank you and goodbye\n")
}
Example Usage
twentyfour()
[edit] Ruby
require "rational"
def play
digits = Array.new(4) {1+rand(9)}
loop do
guess = get_guess(digits)
result = evaluate(guess)
if result == 24.0
puts "yes!"
break
else
puts "nope: #{guess} = #{result}"
puts "try again"
end
end
end
def get_guess(digits)
loop do
print "\nEnter your guess using #{digits.inspect}: "
guess = $stdin.gets.chomp
# ensure input is safe to eval
invalid_chars = guess.scan(%r{[^\d\s()+*/-]})
unless invalid_chars.empty?
puts "invalid characters in input: #{invalid_chars.inspect}"
next
end
guess_digits = guess.scan(/\d/).map {|ch| ch.to_i}
if guess_digits.sort != digits.sort
puts "you didn't use the right digits"
next
end
if guess.match(/\d\d/)
puts "no multi-digit numbers allowed"
next
end
return guess
end
end
# convert expression to use rational numbers, evaluate, then return as float
def evaluate(guess)
as_rat = guess.gsub(/(\d)/, 'Rational(\1,1)')
begin
eval "(#{as_rat}).to_f"
rescue SyntaxError
"[syntax error]"
end
end
play
[edit] 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
}
}
}
}
Sample Output
C:\Workset>scala TwentyFourGame The 24 Game Given any four digits in the range 1 to 9, which may have repetitions, Using just the +, -, *, and / operators; and the possible use of brackets, (), show how to make an answer of 24. An answer of "q" will quit the game. An answer of "!" will generate a new set of four digits. Otherwise you are repeatedly asked for an expression until it evaluates to 24 Note: you cannot form multiple digit numbers from the supplied digits, so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed. Your four digits: 2, 7, 7, 2. Expression 1: 2*7+2+7 Sorry, that's 23.0. Expression 2: 7*7/2-2 Sorry, that's 22.5. Expression 3: 2*7+(7-2) Sorry, that's 19.0. Expression 4: 2*(7+7-2) That's right! Thank you and goodbye!
[edit] Scheme
Works with: PLT Scheme version 4
This uses read to read in a scheme expression, and eval to evaluate it, so in that sense it's not ideal (eval is evil etc.) but any expression that is valid should be safe and terminate in a timely manner.
#lang scheme
(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)
Sample Output
> (require "24game.ss") > (play) Write a lisp expression that evaluates to 24 using only (, ), +, -, *, / and these four numbers: (2 7 2 5) or '!' to get a new set of numbers or 'q' to quit ! Write a lisp expression that evaluates to 24 using only (, ), +, -, *, / and these four numbers: (9 2 7 6) or '!' to get a new set of numbers or 'q' to quit (9 7 6 2) Your expression (9 7 6 2) raised an exception: "procedure application: expected procedure, given: 9; arguments were: 7 6 2" Please try again (+ 9 7 6 2) You win!
[edit] Tcl
Translation of: Python
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
Categories: Programming Tasks | Solutions by Programming Task | Argile | AutoHotkey | C | C sharp | Clojure | Common Lisp | Falcon | Haskell | HicEst | J | Lua | Mathematica | OCaml | Perl | PicoLisp | PL/I | Python | R | Ruby | Scala | Scheme | Tcl
