24 game/Solve: Difference between revisions

=={{header|Tcl}}==

This is a complete Tcl script, intended to be invoked from the command line.

<lang tcl>set patterns {

{((A x B) y C) z D}

{(A x (B y C)) z D}

{(A x B) y (C z D)}

{A x ((B y C) z D)}

{A x (B y (C z D))}

}

set permutations {

{A a B b C c D d}

{A a B b C d D c}

{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}

}

proc findSolution {values} {

global patterns permutations

set found 0

foreach pattern $patterns {

foreach permutation $permutations {

set p [string map [subst {

a [lindex $values 0].0

b [lindex $values 1].0

c [lindex $values 2].0

d [lindex $values 3].0

}] [string map $permutation $pattern]]

foreach x {+ - * /} {

foreach y {+ - * /} {

foreach z {+ - * /} {

set e [string map [subst {x $x y $y z $z}] $p]

catch {

if {[expr $e] == 24.0} {

puts [string map {.0 {}} $e]

incr found

}

}

}

}

}

}

}

if {!$found} {

puts "no solution possible"

} else {

puts "$found solutions total (may include duplicates)"

}

}

findSolution $argv</lang>

Demonstrating it in use:

<pre>$ tclsh8.4 24player.tcl 3 2 8 9

((9 - 3) * 8) / 2

((9 - 3) / 2) * 8

(8 * (9 - 3)) / 2

(9 - (2 * 3)) * 8

(9 - (3 * 2)) * 8

(8 / 2) * (9 - 3)

(9 - 3) * (8 / 2)

(9 - 3) / (2 / 8)

8 * ((9 - 3) / 2)

8 / (2 / (9 - 3))

8 * (9 - (3 * 2))

8 * (9 - (2 * 3))

12 solutions total (may include duplicates)</pre>