24 game/Solve: Difference between revisions

→‎{{header|Tcl}}: An improved version that produces fewer poor results
(Mathematica (this was fun to write!))
(→‎{{header|Tcl}}: An improved version that produces fewer poor results)
Line 459:
=={{header|Tcl}}==
This is a complete Tcl script, intended to be invoked from the command line.
<br>
<lang tcl># Encoding the various expression trees that are possible
{{libheader|tcllib}}
<lang tcl>package require struct::list
<lang tcl># Encoding the various expression trees that are possible
set patterns {
{((A x B) y C) z D}
Line 468 ⟶ 471:
}
# Encoding the various permutations of digits
set permutations [struct::list map [struct::list permutations {a b c d}] \
{apply {v {lassign $v a b c d; list A $a B $b C $c D $d}}}]
# The permitted operations
{A a B b C d D c}
set operations {A a B c C+ b- D* d/}
{A a B c C d D b}
{A a B d C c D b}
{A a B d C b D c}
{A b B a C c D d}
{A b B a C d D c}
{A b B c C a D d}
{A b B c C d D a}
{A b B d C c D a}
{A b B d C a D c}
{A c B b C a D d}
{A c B b C d D a}
{A c B a C b D d}
{A c B a C d D b}
{A c B d C a D b}
{A c B d C b D a}
{A d B b C c D a}
{A d B b C a D c}
{A d B c C b D a}
{A d B c C a D b}
{A d B a C c D b}
{A d B a C b D c}
}
 
# Given a list of four integers (precondition not checked!) return a list of
# solutions to the 24 game using those four integers.
proc find24GameSolutions {values} {
global operations patterns permutations
set found {}
# For each possible structure with numbers at the leaves...
Line 511 ⟶ 492:
 
# For each possible structure with operators at the branches...
foreach x {+ - * /}$operations {
foreach y {+ - * /}$operations {
foreach z {+ - * /}$operations {
set e [string map [subst {x $x y $y z $z}] $p]
 
# Try to evaluate (div-zero is an issue!) and print ifadd it is 24to
# the result if it is 24
catch {
if {[expr $e] == 24.0} {
Line 532 ⟶ 514:
# Wrap the solution finder into a player
proc print24GameSolutionFor {values} {
set found [lsort -unique [find24GameSolutions $values]]
if {![llength $found]} {
puts "No solution possible"
} else {
puts "Total [llength $found] solutions (may include logical duplicates)"
puts "First solution: [lindex $found 0]"
}
Line 543 ⟶ 525:
Demonstrating it in use:
<span style="color:silver">''bash$''</span> <span style="color:brown">tclsh8.4 24player.tcl 3 2 8 9</span>
'''Total 12 solutions total (may include logical duplicates)'''
'''First solution: ((9 - 3) * 8) / 2'''
<span style="color:silver">''bash$''</span> <span style="color:brown">tclsh8.4 24player.tcl 1 1 2 7</span>
'''16Total 8 solutions total (may include logical duplicates)'''
'''First solution: (1 + 2) * (1 + 7)'''
<span style="color:silver">''bash$''</span> <span style="color:brown">tclsh8.4 24player.tcl 1 1 1 1</span>
Anonymous user