Solve a Hidato puzzle: Difference between revisions
m (→{{header|Tcl}}: additional explanatory text) |
No edit summary |
||
Line 1: | Line 1: | ||
{{ |
{{task}} |
||
The task is to write a program which solves [[wp:Hidato|Hidato puzzles]]. |
The task is to write a program which solves [[wp:Hidato|Hidato puzzles]]. |
||
The rules are: |
|||
'''Extra credit:''' show that the code can be reused to solve the [[Knight's Tour]]. |
|||
* You are given a grid with some numbers placed in it. The other squares in the grid will be blank. |
|||
** The grid is not necessarily rectangular. |
|||
** The grid may have holes in it. |
|||
** The grid is always connected. |
|||
** The number “1” is always present, as is another number that is equal to the number of squares in the grid. Other numbers are present so as to force the solution to be unique. |
|||
* The aim is to place a natural number in each blank square so that in the sequence of numbered squares from “1” upwards, each square is in the [[wp:Moore neighborhood]] of the squares immediately before and after it in the sequence (except for the first and last squares, of course, which only have one-sided constraints). |
|||
** Thus, if the grid was overlaid on a chessboard, a king would be able to make legal moves along the path from first to last square in numerical order. |
|||
** A square may only contain one number. |
|||
* In a proper Hidato puzzle, the solution is unique. |
|||
For example the following problem |
|||
[[File:Hidato_Start.png|center|Sample Hidato problem, from Wikipedia]] |
[[File:Hidato_Start.png|center|Sample Hidato problem, from Wikipedia]] |
||
has the following solution, with path marked on it: |
|||
[[File:HEnd.png|center|Solution to sample Hidato problem]] |
[[File:HEnd.png|center|Solution to sample Hidato problem]] |
||
=={{header|Mathprog}}== |
=={{header|Mathprog}}== |
||
For the Knight's Tour see: http://rosettacode.org/wiki/Knight%27s_tour#Mathprog |
|||
<lang mathprog> |
<lang mathprog> |
||
/*Hidato.mathprog, part of KuKu by Nigel Galloway |
|||
Find a solution to a Hidato problem |
Find a solution to a Hidato problem |
||
Nigel_Galloway |
Nigel_Galloway@operamail.com |
||
April 1st., 2011 |
April 1st., 2011 |
||
*/ |
*/ |
||
Line 60: | Line 71: | ||
data; |
data; |
||
param ROWS := |
param ROWS := 8; |
||
param COLS := |
param COLS := 8; |
||
param ZBLS := |
param ZBLS := 40; |
||
param |
param |
||
Iz: 1 2 3 4 5 6 7 := |
Iz: 1 2 3 4 5 6 7 8 := |
||
1 . |
1 . 33 35 . . -1 -1 -1 |
||
2 . |
2 . . 24 22 . -1 -1 -1 |
||
3 . |
3 . . . 21 . . -1 -1 |
||
4 |
4 . 26 . 13 40 11 -1 -1 |
||
5 |
5 27 . . . 9 . 1 -1 |
||
6 |
6 -1 -1 . . 18 . . -1 |
||
7 |
7 -1 -1 -1 -1 . 7 . . |
||
8 -1 -1 -1 -1 -1 -1 5 . |
|||
; |
; |
||
end; |
end; |
||
</lang> |
|||
Produces: |
Produces: |
||
Line 81: | Line 94: | ||
GLPSOL: GLPK LP/MIP Solver, v4.47 |
GLPSOL: GLPK LP/MIP Solver, v4.47 |
||
Parameter(s) specified in the command line: |
Parameter(s) specified in the command line: |
||
--math |
--math Hidato.mathprog |
||
Reading model section from H20110503.mathprog... |
|||
... |
|||
Reading data section from H20110503.mathprog... |
|||
64 lines were read |
|||
Generating void0... |
|||
Generating void1... |
|||
Generating void2... |
|||
Generating void3... |
|||
Generating void4... |
|||
Generating void5... |
|||
Generating void6... |
|||
Generating void7... |
|||
Generating Izfree... |
|||
Generating Iz1... |
|||
Generating rule1... |
|||
Generating rule2... |
|||
Generating rule3... |
|||
Model has been successfully generated |
|||
GLPK Integer Optimizer, v4.47 |
|||
4318 rows, 4050 columns, 30631 non-zeros |
|||
4050 integer variables, all of which are binary |
|||
Preprocessing... |
|||
38 hidden packing inequaliti(es) were detected |
|||
220 rows, 223 columns, 1099 non-zeros |
|||
223 integer variables, all of which are binary |
|||
Scaling... |
|||
A: min|aij| = 1.000e+000 max|aij| = 1.000e+000 ratio = 1.000e+000 |
|||
Problem data seem to be well scaled |
|||
Constructing initial basis... |
|||
Size of triangular part = 220 |
|||
Solving LP relaxation... |
|||
GLPK Simplex Optimizer, v4.47 |
|||
220 rows, 223 columns, 1099 non-zeros |
|||
0: obj = 0.000000000e+000 infeas = 3.100e+001 (0) |
|||
* 167: obj = 0.000000000e+000 infeas = 9.430e-015 (0) |
|||
OPTIMAL SOLUTION FOUND |
|||
Integer optimization begins... |
|||
+ 167: mip = not found yet >= -inf (1; 0) |
|||
+ 181: >>>>> 0.000000000e+000 >= 0.000000000e+000 0.0% (1; 0) |
|||
+ 181: mip = 0.000000000e+000 >= tree is empty 0.0% (0; 1) |
|||
INTEGER OPTIMAL SOLUTION FOUND |
INTEGER OPTIMAL SOLUTION FOUND |
||
Time used: 0.0 secs |
Time used: 0.0 secs |
||
Memory used: |
Memory used: 6.4 Mb (6712828 bytes) |
||
32 33 35 36 37 0 0 0 |
|||
31 34 24 22 38 0 0 0 |
|||
30 25 23 21 12 39 0 0 |
|||
29 26 20 13 40 11 0 0 |
|||
27 28 14 19 9 10 1 0 |
|||
0 0 15 16 18 8 2 0 |
|||
0 0 0 0 17 7 6 3 |
|||
34 33 45 46 47 48 49 |
|||
0 0 0 0 0 0 5 4 |
|||
Model has been successfully processed |
Model has been successfully processed |
||
</pre> |
</pre> |
||
Revision as of 16:52, 5 March 2012
You are encouraged to solve this task according to the task description, using any language you may know.
The task is to write a program which solves Hidato puzzles.
The rules are:
- You are given a grid with some numbers placed in it. The other squares in the grid will be blank.
- The grid is not necessarily rectangular.
- The grid may have holes in it.
- The grid is always connected.
- The number “1” is always present, as is another number that is equal to the number of squares in the grid. Other numbers are present so as to force the solution to be unique.
- The aim is to place a natural number in each blank square so that in the sequence of numbered squares from “1” upwards, each square is in the wp:Moore neighborhood of the squares immediately before and after it in the sequence (except for the first and last squares, of course, which only have one-sided constraints).
- Thus, if the grid was overlaid on a chessboard, a king would be able to make legal moves along the path from first to last square in numerical order.
- A square may only contain one number.
- In a proper Hidato puzzle, the solution is unique.
For example the following problem
has the following solution, with path marked on it:
Mathprog
<lang mathprog> /*Hidato.mathprog, part of KuKu by Nigel Galloway
Find a solution to a Hidato problem
Nigel_Galloway@operamail.com April 1st., 2011
- /
param ZBLS; param ROWS; param COLS; param D := 1; set ROWSR := 1..ROWS; set COLSR := 1..COLS; set ROWSV := (1-D)..(ROWS+D); set COLSV := (1-D)..(COLS+D); param Iz{ROWSR,COLSR}, integer, default 0; set ZBLSV := 1..(ZBLS+1); set ZBLSR := 1..ZBLS;
var BR{ROWSV,COLSV,ZBLSV}, binary;
void0{r in ROWSV, z in ZBLSR,c in (1-D)..0}: BR[r,c,z] = 0; void1{r in ROWSV, z in ZBLSR,c in (COLS+1)..(COLS+D)}: BR[r,c,z] = 0; void2{c in COLSV, z in ZBLSR,r in (1-D)..0}: BR[r,c,z] = 0; void3{c in COLSV, z in ZBLSR,r in (ROWS+1)..(ROWS+D)}: BR[r,c,z] = 0; void4{r in ROWSV,c in (1-D)..0}: BR[r,c,ZBLS+1] = 1; void5{r in ROWSV,c in (COLS+1)..(COLS+D)}: BR[r,c,ZBLS+1] = 1; void6{c in COLSV,r in (1-D)..0}: BR[r,c,ZBLS+1] = 1; void7{c in COLSV,r in (ROWS+1)..(ROWS+D)}: BR[r,c,ZBLS+1] = 1;
Izfree{r in ROWSR, c in COLSR, z in ZBLSR : Iz[r,c] = -1}: BR[r,c,z] = 0; Iz1{Izr in ROWSR, Izc in COLSR, r in ROWSR, c in COLSR, z in ZBLSR : Izr=r and Izc=c and Iz[Izr,Izc]=z}: BR[r,c,z] = 1;
rule1{z in ZBLSR}: sum{r in ROWSR, c in COLSR} BR[r,c,z] = 1; rule2{r in ROWSR, c in COLSR}: sum{z in ZBLSV} BR[r,c,z] = 1; rule3{r in ROWSR, c in COLSR, z in ZBLSR}: BR[0,0,z+1] + BR[r-1,c-1,z+1] + BR[r-1,c,z+1] + BR[r-1,c+1,z+1] + BR[r,c-1,z+1] + BR[r,c+1,z+1] + BR[r+1,c-1,z+1] + BR[r+1,c,z+1] + BR[r+1,c+1,z+1] - BR[r,c,z] >= 0;
solve;
for {r in ROWSR} {
for {c in COLSR} { printf " %2d", sum{z in ZBLSR} BR[r,c,z]*z; } printf "\n";
} data;
param ROWS := 8; param COLS := 8; param ZBLS := 40; param Iz: 1 2 3 4 5 6 7 8 :=
1 . 33 35 . . -1 -1 -1 2 . . 24 22 . -1 -1 -1 3 . . . 21 . . -1 -1 4 . 26 . 13 40 11 -1 -1 5 27 . . . 9 . 1 -1 6 -1 -1 . . 18 . . -1 7 -1 -1 -1 -1 . 7 . . 8 -1 -1 -1 -1 -1 -1 5 . ; end;
</lang>
Produces:
GLPSOL: GLPK LP/MIP Solver, v4.47 Parameter(s) specified in the command line: --math Hidato.mathprog ... INTEGER OPTIMAL SOLUTION FOUND Time used: 0.0 secs Memory used: 6.4 Mb (6712828 bytes) 32 33 35 36 37 0 0 0 31 34 24 22 38 0 0 0 30 25 23 21 12 39 0 0 29 26 20 13 40 11 0 0 27 28 14 19 9 10 1 0 0 0 15 16 18 8 2 0 0 0 0 0 17 7 6 3 0 0 0 0 0 0 5 4 Model has been successfully processed
Prolog
Works with SWI-Prolog and library(clpfd) written by Markus Triska.
Puzzle solved is from the Wilkipedia page : http://en.wikipedia.org/wiki/Hidato
<lang Prolog>:- use_module(library(clpfd)).
hidato :- init1(Li), % skip first blank line init2(1, 1, 10, Li), my_write(Li).
init1(Li) :-
Li = [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, A, 33, 35, B, C, 0, 0, 0, 0,
0, D, E, 24, 22, F, 0, 0, 0, 0,
0, G, H, I, 21, J, K, 0, 0, 0,
0, L, 26, M, 13, 40, 11, 0, 0, 0,
0, 27, N, O, P, 9, Q, 1, 0, 0,
0, 0, 0, R, S, 18, T, U, 0, 0,
0, 0, 0, 0, 0, V, 7, W, X, 0,
0, 0, 0, 0, 0, 0, 0, 5, Y, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
LV = [ A, 33, 35, B, C, D, E, 24, 22, F, G, H, I, 21, J, K, L, 26, M, 13, 40, 11, 27, N, O, P, 9, Q, 1, R, S, 18, T, U, V, 7, W, X, 5, Y],
LV ins 1..40,
all_distinct(LV).
% give the constraints % Stop before the last line init2(_N, Col, Max_Col, _L) :- Col is Max_Col - 1.
% skip zeros init2(N, Lig, Col, L) :- I is N + Lig * Col, element(I, L, 0), !, V is N+1, ( V > Col -> N1 = 1, Lig1 is Lig + 1; N1 = V, Lig1 = Lig), init2(N1, Lig1, Col, L).
% skip first column
init2(1, Lig, Col, L) :-
!,
init2(2, Lig, Col, L) .
% skip last column init2(Col, Lig, Col, L) :- !, Lig1 is Lig+1, init2(1, Lig1, Col, L).
% V5 V3 V6 % V1 V V2 % V7 V4 V8 % general case init2(N, Lig, Col, L) :- I is N + Lig * Col, element(I, L, V),
I1 is I - 1, I2 is I + 1, I3 is I - Col, I4 is I + Col, I5 is I3 - 1, I6 is I3 + 1, I7 is I4 - 1, I8 is I4 + 1,
maplist(compute_BI(L, V), [I1,I2,I3,I4,I5,I6,I7,I8], VI, BI),
sum(BI, #=, SBI),
( ((V #= 1 #\/ V #= 40) #/\ SBI #= 1) #\/ (V #\= 1 #/\ V #\= 40 #/\ SBI #= 2)) #<==> 1,
labeling([ffc, enum], [V | VI]),
N1 is N+1, init2(N1, Lig, Col, L).
compute_BI(L, V, I, VI, BI) :- element(I, L, VI), VI #= 0 #==> BI #= 0, ( VI #\= 0 #/\ (V - VI #= 1 #\/ VI - V #= 1)) #<==> BI.
% display the result my_write([0, A, B, C, D, E, F, G, H, 0 | T]) :- maplist(my_write_1, [A, B, C, D, E, F, G, H]), nl, my_write(T).
my_write([]).
my_write_1(0) :- write(' ').
my_write_1(X) :- writef('%3r', [X]).
</lang> Output :
?- hidato. 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 true
Tcl
<lang tcl>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
}</lang> Demonstrating (dots are “outside” the grid, and zeroes are the cells to be filled in): <lang tcl>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
"</lang> 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