Solve a Hidato puzzle: Difference between revisions
No edit summary |
m (fix wording errors) |
||
Line 4: | Line 4: | ||
'''Extra credit:''' show that the code can be reused to solve the [[Knight's Tour]]. |
'''Extra credit:''' show that the code can be reused to solve the [[Knight's Tour]]. |
||
[[File:Hidato_Start.png|center|Sample Hidato problem, from Wikipedia]] |
|||
The above problem |
The above problem has the following solution, with path marked on it: |
||
⚫ | |||
⚫ | |||
=={{header|Mathprog}}== |
=={{header|Mathprog}}== |
||
For the Knight's Tour see: http://rosettacode.org/wiki/Knight%27s_tour#Mathprog |
For the Knight's Tour see: http://rosettacode.org/wiki/Knight%27s_tour#Mathprog |
Revision as of 15:46, 15 January 2012
The task is to write a program which solves Hidato puzzles.
Extra credit: show that the code can be reused to solve the Knight's Tour.
The above problem has the following solution, with path marked on it:
Mathprog
For the Knight's Tour see: http://rosettacode.org/wiki/Knight%27s_tour#Mathprog <lang mathprog>/*Hidato.mathprog, part of KuKu by Nigel Galloway
Find a solution to a Hidato problem
Nigel_Galloway 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 := 7; param COLS := 7; param ZBLS := 49; param Iz: 1 2 3 4 5 6 7 :=
1 . . 6 . 23 . . 2 . 40 . . 9 . . 3 . 39 . . . . 21 4 1 38 . . 12 . 19 5 36 . 30 . . 18 . 6 . 32 . . 14 . 16 7 . 33 . . . 48 49 ; end;</lang>
Produces:
GLPSOL: GLPK LP/MIP Solver, v4.47 Parameter(s) specified in the command line: --math H20110503.mprog 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 Time used: 0.0 secs Memory used: 5.9 Mb (6168823 bytes) 4 5 6 8 23 24 25 3 40 7 10 9 22 26 2 39 41 11 28 27 21 1 38 42 29 12 20 19 36 37 30 43 13 18 17 35 32 31 44 14 15 16 34 33 45 46 47 48 49 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, V1, V2, V3, V4, V5, V6, V7, V8]),
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