## Summary

Richard Suchenwirth 2004-07-31 - My favourite weekly newspaper, DIE ZEIT, posed an interesting puzzle today, which I wanted to solve with Tcl and brute force (and still in velvet gloves :).

Challenge: determine a seven digit phone number, which is the concatenation of three cubes, at most three digits long, such that only the first and last digit are equal.

Solving cryptarithms
The Einstein puzzle
Brute force with velvet gloves

## Description

First to get the possible cubes - as pow(10,3)==1000>999, the maximum root can be only 9. Easily enumerated, but let's Tcl do the work:

```proc cubes'below max {
set res {}
set i 0
while 1 {
set n [expr {\$i*\$i*\$i}]
if {\$n >= \$max} {return \$res}
lappend res \$n
incr i
}
}```

Testing the set from which the solution will come:

```% cubes'below 1000
0 1 8 27 64 125 216 343 512 729```

Now to get all possible combinations of length 3. Repetitions are not ruled out, so I simply code:}

```proc triples list {
set res {}
foreach i \$list {
foreach j \$list {
foreach k \$list {
lappend res [list \$i \$j \$k]
}
}
}
set res
}```

For the 10-element list we deal with, this will produce 1000 triples. Well, Tcl can cope. We only have to filter them for

• the concatenated length being 7
• no digit is repeated except the first == last

For the latter, one can check the length of the "alphabet" (ordered set of distinct characters), which again is easily done:}

```proc alphabet string {
lsort -unique [split \$string ""]
}

# So here's the brute force test:
proc phone'puzzle {} {
foreach triple [triples [cubes'below 1000]] {
set number [join \$triple ""]
if {[string length \$number] != 7} continue
if {[llength [alphabet \$number]] != 6} continue
if {[string index \$number 0] ne [string index \$number end]} continue
lappend res \$number
}
set res
}```

... and there is indeed one single solution:

```% phone'puzzle
2764512```

 Arts and Crafts of Tcl-Tk Programming Category Puzzles