Hidato is an interesting puzzle, if not particularly difficult. Basically, you've got a grid (usually not square, possibly with holes in it, but always connected) with some blank squares and some squares filled in with cardinal numbers. What you've got to do is to provide the remaining numbers so that you can trace a path from 1 up to the number of squares (which are both always provided) and where each square is in the Moore Neighborhood of the number before it and after it in the sequence.
Here's a sample solver for these sorts of puzzles.
package require Tcl 8.5
proc init {initialConfiguration} {
global grid max filled
set max 1
set y 0
foreach row [split [string trim $initialConfiguration "\n"] "\n"] {
set x 0
set rowcontents {}
foreach cell $row {
if {![string is integer -strict $cell]} {set cell -1}
lappend rowcontents $cell
set max [expr {max($max, $cell)}]
if {$cell > 0} {
dict set filled $cell [list $y $x]
}
incr x
}
lappend grid $rowcontents
incr y
}
}
proc findseps {} {
global max filled
set result {}
for {set i 1} {$i < $max-1} {incr i} {
if {[dict exists $filled $i]} {
for {set j [expr {$i+1}]} {$j <= $max} {incr j} {
if {[dict exists $filled $j]} {
if {$j-$i > 1} {
lappend result [list $i $j [expr {$j-$i}]]
}
break
}
}
}
}
return [lsort -integer -index 2 $result]
}
proc makepaths {sep} {
global grid filled
lassign $sep from to len
lassign [dict get $filled $from] y x
set result {}
foreach {dx dy} {-1 -1 -1 0 -1 1 0 -1 0 1 1 -1 1 0 1 1} {
discover [expr {$x+$dx}] [expr {$y+$dy}] [expr {$from+1}] $to \
[list [list $from $x $y]] $grid
}
return $result
}
proc discover {x y n limit path model} {
global filled
# Check for illegal
if {[lindex $model $y $x] != 0} return
upvar 1 result result
lassign [dict get $filled $limit] ly lx
# Special case
if {$n == $limit-1} {
if {abs($x-$lx)<=1 && abs($y-$ly)<=1 && !($lx==$x && $ly==$y)} {
lappend result [lappend path [list $n $x $y] [list $limit $lx $ly]]
}
return
}
# Check for impossible
if {abs($x-$lx) > $limit-$n || abs($y-$ly) > $limit-$n} return
# Recursive search
lappend path [list $n $x $y]
lset model $y $x $n
incr n
foreach {dx dy} {-1 -1 -1 0 -1 1 0 -1 0 1 1 -1 1 0 1 1} {
discover [expr {$x+$dx}] [expr {$y+$dy}] $n $limit $path $model
}
}
proc applypath {path} {
global grid filled
puts "Found unique path for [lindex $path 0 0] -> [lindex $path end 0]"
foreach cell [lrange $path 1 end-1] {
lassign $cell n x y
lset grid $y $x $n
dict set filled $n [list $y $x]
}
}
proc printgrid {} {
global grid max
foreach row $grid {
foreach cell $row {
puts -nonewline [format " %*s" [string length $max] [expr {
$cell==-1 ? "." : $cell
}]]
}
puts ""
}
}
proc solveHidato {initialConfiguration} {
init $initialConfiguration
set limit [llength [findseps]]
while {[llength [set seps [findseps]]] && [incr limit -1]>=0} {
foreach sep $seps {
if {[llength [set paths [makepaths $sep]]] == 1} {
applypath [lindex $paths 0]
break
}
}
}
puts ""
printgrid
}A quick demonstration:
solveHidato {
0 33 35 0 0 . . .
0 0 24 22 0 . . .
0 0 0 21 0 0 . .
0 26 0 13 40 11 . .
27 0 0 0 9 0 1 .
. . 0 0 18 0 0 .
. . . . 0 7 0 0
. . . . . . 5 0
}It prints this output:
Found unique path for 5 -> 7 Found unique path for 7 -> 9 Found unique path for 9 -> 11 Found unique path for 11 -> 13 Found unique path for 33 -> 35 Found unique path for 18 -> 21 Found unique path for 1 -> 5 Found unique path for 35 -> 40 Found unique path for 22 -> 24 Found unique path for 24 -> 26 Found unique path for 27 -> 33 Found unique path for 13 -> 18 32 33 35 36 37 . . . 31 34 24 22 38 . . . 30 25 23 21 12 39 . . 29 26 20 13 40 11 . . 27 28 14 19 9 10 1 . . . 15 16 18 8 2 . . . . . 17 7 6 3 . . . . . . 5 4
This version tackles many much more complex cases
Requires Tcl 8.6.0 (or later)package require Tcl 8.6
oo::class create Hidato {
variable grid max filled
constructor {initialConfiguration} {
set max 1
set y 0
foreach row [split [string trim $initialConfiguration "\n"] "\n"] {
set x 0
set rowcontents {}
foreach cell $row {
if {![string is integer -strict $cell]} {set cell -1}
lappend rowcontents $cell
set max [expr {max($max, $cell)}]
if {$cell > 0} {
dict set filled $cell [list $y $x]
}
incr x
}
lappend grid $rowcontents
incr y
}
}
method LegalNeighbours {x y} {
set result {}
set columns [llength $grid]
set rowLen [llength [lindex $grid 0]]
foreach {dx dy} {0 1 1 1 1 0 1 -1 0 -1 -1 -1 -1 0 -1 1} {
set xx [expr {$x+$dx}]
set yy [expr {$y+$dy}]
if {$xx<0 || $xx>$rowLen || $yy<0 || $yy>$columns} continue
lappend result $xx $yy
}
return $result
}
method LegalTerminatingState {} {
foreach row $grid {
foreach cell $row {
if {$cell == 0} {return false}
}
}
return true
}
method LegalModelState {model} {
set r 0
foreach row $model {
set c 0
foreach cell $row {
if {$cell == 0} {
set neighbours [my LegalNeighbours $c $r]
set found 0
foreach {x y} $neighbours {
#my log model($y,$x)=[lindex $model $y $x]
if {[lindex $model $y $x] == 0} {
set found 1
break
}
}
if {!$found} {
set probes {}
foreach {x y} $neighbours {
set p [lindex $model $y $x]
if {$p ne ""} {
lappend probes $p
}
}
foreach probed $probes {
if {
($probed+2) in $probes &&
![dict exists $filled [expr {$probed+1}]]
} then {
set found 1
break
}
}
if {!$found} {
return false
}
}
}
incr c
}
incr r
}
return true
}
method FindSeps {} {
set result {}
for {set i 1} {$i < $max-1} {incr i} {
if {[dict exists $filled $i]} {
for {set j [expr {$i+1}]} {$j <= $max} {incr j} {
if {[dict exists $filled $j]} {
if {$j-$i > 1} {
lappend result [list $i $j [expr {$j-$i}]]
}
break
}
}
}
}
return [lsort -integer -index 2 $result]
}
method MakePaths {sep} {
lassign $sep from to len
lassign [dict get $filled $from] y x
set result {}
foreach {dx dy} {-1 -1 -1 0 -1 1 0 -1 0 1 1 -1 1 0 1 1} {
my Discover [expr {$x+$dx}] [expr {$y+$dy}] [expr {$from+1}] $to \
[list [list $from $x $y]] $grid
}
return $result
}
method Discover {x y n limit path model} {
# Check for illegal
if {[lindex $model $y $x] != 0} return
upvar 1 result result
lassign [dict get $filled $limit] ly lx
# Special case
if {$n == $limit-1} {
if {abs($x-$lx)<=1 && abs($y-$ly)<=1 && !($lx==$x && $ly==$y)} {
lappend result \
[lappend path [list $n $x $y] [list $limit $lx $ly]]
}
return
}
# Check for impossible
if {abs($x-$lx) > $limit-$n || abs($y-$ly) > $limit-$n} return
# Recursive search
lappend path [list $n $x $y]
lset model $y $x $n
if {![my LegalModelState $model]} return
incr n
foreach {x y} [my LegalNeighbours $x $y] {
my Discover $x $y $n $limit $path $model
}
}
method log msg {
puts [string repeat " " [my Indent]]$msg
}
method applyPath {path {bit "unique path"}} {
my log "Found $bit for [lindex $path 0 0] -> [lindex $path end 0]"
foreach cell $path {
lassign $cell n x y
lset grid $y $x $n
dict set filled $n [list $y $x]
}
}
method print {} {
foreach row $grid {
foreach cell $row {
puts -nonewline [format " %*s" [string length $max] [expr {
$cell==-1 ? "." : $cell
}]]
}
puts ""
}
}
method state {} {list $grid $max $filled}
method Indent {} {return 0}
method CommonPrefix paths {
set prefix [lindex $paths 0]
foreach path [lrange $paths 1 end] {
set i -1
foreach a $prefix b $path {
if {$a ne $b} {
set prefix [lrange $prefix 0 $i]
break
}
incr i
}
}
return $prefix
}
method CommonSuffix paths {
lreverse [my CommonPrefix [lmap path $paths {lreverse $path}]]
}
method ForkSolve {paths} {
my log "Choice of [llength $paths] possible paths"
foreach p $paths {
set subobj [oo::copy [self]]
oo::objdefine $subobj method Indent {} \
[list return [expr {[my Indent]+2}]]
try {
$subobj applyPath $p "path #[incr count]"
if {[$subobj solve]} {
my log "Leads to solution!"
lassign [$subobj state] grid max filled
return -code break
} else {
my log "No solution?"
}
} finally {
$subobj destroy
}
}
}
method solve {} {
set limit [llength [my FindSeps]]
while {[llength [set seps [my FindSeps]]] && [incr limit -1]>=0} {
set pshort {}
foreach sep $seps {
set paths [my MakePaths $sep]
if {[llength $paths] == 1} {
my applyPath [lindex $paths 0]
set pshort {}
break
}
set subpath [my CommonPrefix $paths]
if {[llength $subpath] > 1} {
my applyPath $subpath "common prefix"
set pshort {}
incr limit
break
}
set subpath [my CommonSuffix $paths]
if {[llength $subpath] > 1} {
my applyPath $subpath "common suffix"
set pshort {}
incr limit
break
}
if {![llength $pshort]} {
set pshort $paths
} elseif {[llength $pshort] > [llength $paths]} {
set pshort $paths
}
}
if {[llength $pshort]} {
my ForkSolve $pshort
return false
}
}
return [my LegalTerminatingState]
}
}
Hidato create sample {
0 33 35 0 0 . . .
0 0 24 22 0 . . .
0 0 0 21 0 0 . .
0 26 0 13 40 11 . .
27 0 0 0 9 0 1 .
. . 0 0 18 0 0 .
. . . . 0 7 0 0
. . . . . . 5 0
}
sample solve
sample log ""
sample print
Hidato create awkwardcase {
. 4 .
0 7 0
1 0 0
}
awkwardcase log ""
awkwardcase solve
awkwardcase log ""
awkwardcase print
Hidato create tricky {
40 41 . . 31 0 . . 59 0
0 0 0 37 0 33 0 0 60 0
0 0 0 0 35 0 0 0 64 0
. . 0 0 0 0 54 0 . .
. . 0 0 0 55 0 26 . .
. . 0 7 10 0 0 25 . .
0 3 0 13 0 11 17 0 0 0
1 0 5 0 15 0 0 19 20 21
}
tricky log ""
tricky solve
tricky log ""
tricky print
Hidato create evil {
1 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 74
. . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 .
. . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 . . 0 0 .
}
evil log ""
evil solve
evil log ""
evil print