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
 24 game/Solve


Reference
 The 24 Game on h2g2.


# 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