24 game/Solve: Difference between revisions

Content added Content deleted
(Mathematica (this was fun to write!))
(→‎{{header|Tcl}}: An improved version that produces fewer poor results)
Line 459: Line 459:
=={{header|Tcl}}==
=={{header|Tcl}}==
This is a complete Tcl script, intended to be invoked from the command line.
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
⚫
# Encoding the various expression trees that are possible
set patterns {
set patterns {
{((A x B) y C) z D}
{((A x B) y C) z D}
Line 468: Line 471:
}
}
# Encoding the various permutations of digits
# Encoding the various permutations of digits
set permutations {
set permutations [struct::list map [struct::list permutations {a b c d}] \
{A a B b C c D 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}
{A a B c C b D d}
set operations {+ - * /}
{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
# Given a list of four integers (precondition not checked!) return a list of
# solutions to the 24 game using those four integers.
# solutions to the 24 game using those four integers.
proc find24GameSolutions {values} {
proc find24GameSolutions {values} {
global patterns permutations
global operations patterns permutations
set found {}
set found {}
# For each possible structure with numbers at the leaves...
# For each possible structure with numbers at the leaves...
Line 511: Line 492:


# For each possible structure with operators at the branches...
# For each possible structure with operators at the branches...
foreach x {+ - * /} {
foreach x $operations {
foreach y {+ - * /} {
foreach y $operations {
foreach z {+ - * /} {
foreach z $operations {
set e [string map [subst {x $x y $y z $z}] $p]
set e [string map [subst {x $x y $y z $z}] $p]


# Try to evaluate (div-zero is an issue!) and print if it is 24
# Try to evaluate (div-zero is an issue!) and add it to
# the result if it is 24
catch {
catch {
if {[expr $e] == 24.0} {
if {[expr $e] == 24.0} {
Line 532: Line 514:
# Wrap the solution finder into a player
# Wrap the solution finder into a player
proc print24GameSolutionFor {values} {
proc print24GameSolutionFor {values} {
set found [find24GameSolutions $values]
set found [lsort -unique [find24GameSolutions $values]]
if {![llength $found]} {
if {![llength $found]} {
puts "No solution possible"
puts "No solution possible"
} else {
} else {
puts "Total [llength $found] solutions (may include duplicates)"
puts "Total [llength $found] solutions (may include logical duplicates)"
puts "First solution: [lindex $found 0]"
puts "First solution: [lindex $found 0]"
}
}
Line 543: Line 525:
Demonstrating it in use:
Demonstrating it in use:
<span style="color:silver">''bash$''</span> <span style="color:brown">tclsh8.4 24player.tcl 3 2 8 9</span>
<span style="color:silver">''bash$''</span> <span style="color:brown">tclsh8.4 24player.tcl 3 2 8 9</span>
'''12 solutions total (may include duplicates)'''
'''Total 12 solutions (may include logical duplicates)'''
'''First solution: ((9 - 3) * 8) / 2'''
'''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>
<span style="color:silver">''bash$''</span> <span style="color:brown">tclsh8.4 24player.tcl 1 1 2 7</span>
'''16 solutions total (may include duplicates)'''
'''Total 8 solutions (may include logical duplicates)'''
'''First solution: (1 + 2) * (1 + 7)'''
'''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>
<span style="color:silver">''bash$''</span> <span style="color:brown">tclsh8.4 24player.tcl 1 1 1 1</span>
Retrieved from "https://rosettacode.org/wiki/24_game/Solve"