## Introduction

This page was spun off from Solving cryptarithms, numeric puzzles in which digits have been replaced by letters. See also Brute force again

TFW (Feb, 23 2004) - Got frustrated helping my 5th grade son solve some extra credit homework.

## Program 1

We must solve the equation below, where ABCDE*4=EDCBA, nothing fancy but the brute force methods solved it before your finger leaves the keyboard.

``` #----------------------------------------------------------------------------
puts {
# Solve the problem
# ABCDE
#    X4
#------
# EDCBA
}
#----------------------------------------------------------------------------
proc ABCDE {args} {
set nums {1 2 3 4 5 6 7 8 9}
set counter 0
foreach a \$nums {
foreach b \$nums {
foreach c \$nums {
foreach d \$nums {
foreach e \$nums {
set n1 [expr {"\$a\$b\$c\$d\$e"*4}]
set n2 "\$e\$d\$c\$b\$a"
incr counter
if {\$n1==\$n2} {
puts "We solved it! \$a\$b\$c\$d\$e * 4 = \$n2 at \$counter tries"
return
}
}
}
}
}
}
puts "Not Solved"
}```

## Program 2

Here is another one, we have \$1 in coins but only one can be a nickel. So we know that 19 coins must add to 95 cents using only pennies, dimes, quarters and half-dollars. Again, the simple brute force method yields an answer before your finger leaves the keyboard

``` #----------------------------------------------------------------------------
puts {
# Solve the problem
# 20 coins = \$1.00, only one is a nickel
# so we have 19 coins = 95 cents
}
#----------------------------------------------------------------------------
proc solve2 {args} {
set nums {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19}
set counter 0
foreach penny \$nums {
foreach dime \$nums {
foreach quarter \$nums {
foreach halfdollar \$nums {
if {(\$penny+\$dime+\$quarter+\$halfdollar)==19} {
set value [expr {\$penny*1+\$dime*10+\$quarter*25+\$halfdollar*50}]
incr counter
if {\$value==95} {
puts "We solved it! penny=\$penny dime=\$dime quarter=\$quarter halfdollar=\$halfdollar at \$counter tries"
return
}
}
}
}
}
}
puts "Not Solved"
}```

## Program 3

rdt (2004.08.02) Well this is certainly brute force and it gets the job done. However, here is my take on that:

```  proc solve2a {args} {
set counter 0
for {set penny 0} {\$penny < 20} {incr penny} {
for {set dime 0} {\$dime < 10} {incr dime} {
for {set quarter 0} {\$quarter < 4} {incr quarter} {
for {set halfdollar 0} {\$halfdollar < 2} {incr halfdollar} {
if {(\$penny+\$dime+\$quarter+\$halfdollar)==19} {
incr counter
set value [expr {\$penny*1+\$dime*10+\$quarter*25+\$halfdollar*50}]
if {\$value==95} {
puts "We solved it! penny=\$penny dime=\$dime quarter=\$quarter halfdollar=\$halfdollar at counter tries"
return
}
}
}
}
}
}
puts "Not Solved"
}```

If I did not mis-transcribe it. :) This results in the correct answer in only 62 tries!

## Program 4

RS experiments with the following "General Problem Solver" (for small values of General), which, with heavy metaprogramming, builds up a nest of foreachs suiting the problem, quick kills (with continue) to force unique values for the variables, and returns the first solution found, or else an empty string:

``` proc solve {problem {domain0 {0 1 2 3 4 5 6 7 8 9}}} {
set vars [lsort -u [split [regsub -all {[^A-Z]} \$problem ""] ""]]
set map {= ==}
set outers {}
set initials [regexp -all -inline {[^A-Z]([A-Z])} /\$problem]
set pos [lsearch \$domain0 0]
set domain1 [lreplace \$domain0 \$pos \$pos]
foreach var \$vars {
append body "foreach \$var \\$domain[expr [lsearch \$initials \$var]>=0] \{\n"
lappend map \$var \$\$var
foreach outer \$outers {
append body "if {\$\$var eq \$\$outer} continue\n"
}
lappend outers \$var
append epilog \}
}
set test [string map \$map \$problem]
append body "if {\[expr \$test\]} {return \[subst \$test\]}" \$epilog
if 1 \$body
}```

``` % solve SEND+MORE=MONEY
9567+1085==10652
% solve SAVE+MORE=MONEY
9386+1076==10462
% solve YELLOW+YELLOW+RED=ORANGE
143329+143329+846==287504```

So this routine is not blindingly fast, but can process a number of problems from earlier in this page, without other configuration than specifying the problem.

## Program 5

Another kind of cryptarithm I found in Martin Gardner's Mathematical Circus:

` EVE/DID=.TALKTALKTALK...`

requires epsilon comparison with a periodic fraction... Any takers? - Took it myself, by replacing == equality with abs(delta)<epsilon:

GWM 13.10.04 the fraction .talktalk... can be expressed as the rational fraction TALK/9999. So the problem comes down to 9999*EVE = TALK*DID. Surely this is much easier, and involves only integer comparisons.

``` proc solve {problem {domain0 {0 1 2 3 4 5 6 7 8 9}}} {
set vars [lsort -u [split [regsub -all {[^A-Z]} \$problem ""] ""]]
set map {= )-( ... ""}
set outers {}
set initials [regexp -all -inline {[^A-Z]([A-Z])} /\$problem]
set pos [lsearch \$domain0 0]
set domain1 [lreplace \$domain0 \$pos \$pos]
foreach var \$vars {
append body "foreach \$var \\$domain[expr [lsearch \$initials \$var]>=0] \{\n"
lappend map \$var \$\$var
foreach outer \$outers {
append body "if {\$\$var eq \$\$outer} continue\n"
}
lappend outers \$var
append epilog \}
}
set test abs(([string map \$map \$problem]))<=.00000001
append body "if {\[expr \$test\]} {return \[subst \$test\]}" \$epilog
if 1 \$body
}```

The other tests still pass, but the output is a bit harder to read:

``` % solve EVE/DID.=.TALKTALK...
abs((212/606.)-(.34983498))<=.00000001
% solve SEND+MORE=MONEY
abs((9567+1085)-(10652))<=.00000001
% solve ABCDE*4=EDCBA
abs((21978*4)-(87912))<=.00000001
% solve 7AB*CD=EFGHJ
abs((713*59)-(42067))<=.00000001```

The last example comes wrong, because the fixed "7" in front is re-used for J in the end.

## Program 6

PWQ 25 Feb 04, Can TFW please post an example of the problem:

`   7ab * cd = efghi?`

I tried a version, but my fingers have finished typing and I am still waiting for an answer. Thanks.

TFW 25 Feb 04, OK here is one that solves 7AB*CD=EFGHI (without reusing the 7 and no duplicates)

``` proc 7AB {args} {
set nums {0 1 2 3 4 5 6 7 8 9}
foreach A \$nums {
if {[string first \$A "70"]>=0} continue
foreach B \$nums {
if {[string first \$B "70\$A"]>=0} continue
foreach C \$nums {
if {[string first \$C "70\$A\$B"]>=0} continue
foreach D \$nums {
if {[string first \$D "7\$A\$B\$C"]>=0} continue
foreach E \$nums {
if {[string first \$E "70\$A\$B\$C\$D"]>=0} continue
foreach F \$nums {
if {[string first \$F "7\$A\$B\$C\$D\$E"]>=0} continue
foreach G \$nums {
if {[string first \$G "7\$A\$B\$C\$D\$E\$F"]>=0} continue
foreach H \$nums {
if {[string first \$H "7\$A\$B\$C\$D\$E\$F\$G"]>=0} continue
foreach I \$nums {
if {[string first \$I "7\$A\$B\$C\$D\$E\$F\$G\$H"]>=0} continue
if {"7\$A\$B" * "\$C\$D"=="\$E\$F\$G\$H\$I"} {
return "7\$A\$B*\$C\$D==\$E\$F\$G\$H\$I"
}
}
}
}
}
}
}
}
}
}
}```

RS got that too (with the first solve version), after respecifying the problem in a slightly clumsy way, and 27 minutes:

``` % solve Z=7&&ZAB*CD=EFGHI
7==7&&715*46==32890```

TFW either of the GPS solvers work fine if you specify the domain as not having 7 as an option (since it is already used)

``` % solve 7AB*CD=EFGHI {0 1 2 3 4 5 6 8 9}
715*46==32890```

I get an answer back in about 5 seconds. - RS: Clever - I didn't think of that...

A nice cryptarithm given by Donald E. Knuth, was solved in 30 seconds on XP:

``` % solve VIOLIN+VIOLIN+VIOLA=TRIO+SONATA
176478+176478+17640==2576+368020
```

## Program 7

SMH 20.03.2005. I adapted Richard's solution and produced a version which runs faster (at least on my computer, running tcl 8.5 on windows 2003)

``` proc solve1 {problem {domain0 {0 1 2 3 4 5 6 7 8 9}}} {
set vars [lsort -u [split [regsub -all {[^A-Z]} \$problem ""] ""]]
set map {= ==}
set initials [regexp -all -inline {[^A-Z0-9]([A-Z])} /\$problem]

# remove 'given' digits

foreach d [regexp -all -inline {([0-9])} /\$problem] {
set l [lsearch \$domain0 \$d]
if { \$l >= 0 } {set domain0 [lreplace \$domain0 \$l \$l] }
}

set pos [lsearch \$domain0 0]
set str [join \$domain0 ""]
set l [expr [string length \$str] + 1]
set epilog ""
set ind ""  ;# used for producing indented loops
set lastVar [lindex \$vars end]
set str\$l \$str
foreach var \$vars {
set sow [expr [lsearch \$initials \$var]>=0]
set oldl \$l
incr l -1
append body "\$ind for {set i\$var 0} {\\$i\$var<\$l} {incr i\$var} \{\n"
set oldind \$ind; append ind "  "
append body "\$ind set \$var \[string range \\$str\$oldl \\$i\$var \\$i\$var]\n"
if {\$sow} { append body "\$ind if {\\$\$var == 0} continue\n"}
if { \$var ne \$lastVar} { append body "\$ind set str\$l \[string replace \\$str\$oldl \\$i\$var \\$i\$var]\n"}
lappend map \$var \$\$var
set epilog "\$oldind \}\n \$epilog"
}
set test [string map \$map \$problem]
append body "\$ind if {\[expr \$test\]} {return \[subst \$test\]}\n" \$epilog

if {1} \$body else {puts \$body}

}```

I made additional changes to allow for digits which are already given (7AB*CD=EFGHJ) and to allow 0 to be considered as a solition for A in this case.

Timings

``` solve0 SEND+MORE=MONEY 9567+1085==10652 59704109 microseconds per iteration
solve1 SEND+MORE=MONEY 9567+1085==10652 35950294 microseconds per iteration
solve0 SAVE+MORE=MONEY 9386+1076==10462 83318251 microseconds per iteration
solve1 SAVE+MORE=MONEY 9386+1076==10462 37336192 microseconds per iteration
solve0 YELLOW+YELLOW+RED=ORANGE 143329+143329+846==287504 335511905 microseconds per iteration
solve1 YELLOW+YELLOW+RED=ORANGE 143329+143329+846==287504 114768229 microseconds per iteration
solve0 ABCDE*4=EDCBA 21978*4==87912 98717 microseconds per iteration
solve1 ABCDE*4=EDCBA 21978*4==87912 54209 microseconds per iteration
solve0 7AB*CD=EFGHI 713*59==42067 6058217 microseconds per iteration
solve1 7AB*CD=EFGHI 715*46==32890 2423831 microseconds per iteration
solve0 VIOLIN+VIOLIN+VIOLA=TRIO+SONATA 176478+176478+17640==2576+368020 22872194 microseconds per iteration
solve1 VIOLIN+VIOLIN+VIOLA=TRIO+SONATA 176478+176478+17640==2576+368020 13372726 microseconds per iteration```