Solve a Hidato puzzle: Difference between revisions

From Rosetta Code
Content added Content deleted
Line 134: Line 134:


hidato :-
hidato :-
init1(8, 8, Li),
init1(Li),
% skip first blank line
init2(1, 0, 8, Li),
init2(1, 1, 10, Li),
my_write(Li).
my_write(Li).




init1(Li) :-
% read the the puzzle
Li = [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
init1(Lig, Col, Li) :-
0, A, 33, 35, B, C, 0, 0, 0, 0,
Len is Lig * Col,
0, D, E, 24, 22, F, 0, 0, 0, 0,
length(Li, Len),
Li = [ A, 33, 35, B, C, 0, 0, 0,
0, G, H, I, 21, J, K, 0, 0, 0,
D, E, 24, 22, F, 0, 0, 0,
0, L, 26, M, 13, 40, 11, 0, 0, 0,
G, H, I, 21, J, K, 0, 0,
0, 27, N, O, P, 9, Q, 1, 0, 0,
L, 26, M, 13, 40, 11, 0, 0,
0, 0, 0, R, S, 18, T, U, 0, 0,
27, N, O, P, 9, Q, 1, 0,
0, 0, 0, 0, 0, V, 7, W, X, 0,
0, 0, R, S, 18, T, U, 0,
0, 0, 0, 0, 0, 0, 0, 5, Y, 0,
0, 0, 0, 0, V, 7, W, X,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
0, 0, 0, 0, 0, 0, 5, Y],


LV = [ A, 33, 35, B, C,
LV = [ A, 33, 35, B, C,
Line 166: Line 166:


% give the constraints
% give the constraints
% Stop before the last line
init2(_N, Col, Col, _L).
init2(_N, Col, Max_Col, _L) :-
Col is Max_Col - 1.


% skip zeros
init2(N, Lig, Col, L) :-
init2(N, Lig, Col, L) :-
I is N + Lig * Col,
I is N + Lig * Col,
Line 177: Line 180:




% A5 A3 A6
% skip first column
% A1 V A2
% A7 A4 A8
% Special case : first column
init2(1, Lig, Col, L) :-
init2(1, Lig, Col, L) :-
!,
!,
I is 1 + Lig * Col,
element(I, L, V),
I2 is I + 1, element(I2, L, V2),
V2 #= 0 #==> B2 #= 0,
( V2 #\= 0 #/\ (V - V2 #= 1 #\/ V2 - V #= 1)) #<==> B2,

% first line
( Lig = 0 -> B3 #= 0, B6 #= 0, V3 #= 0, V6 #= 0
; I3 is I - Col, element(I3, L, V3),
V3 #= 0 #==> B3 #= 0,
( V3 #\= 0 #/\ (V - V3 #= 1 #\/ V3 - V #= 1)) #<==> B3,
I6 is I3 + 1, element(I6, L, V6),
V6 #= 0 #==> B6 #= 0,
( V6 #\= 0 #/\ (V - V6 #= 1 #\/ V6 - V #= 1)) #<==> B6
),

% last line
( Lig is Col - 1 -> B4 #= 0, B8 #= 0, V4 #= 0, V8 #= 0
; I4 is I + Col, element(I4, L, V4),
V4 #= 0 #==> B4 #= 0,
( V4 #\= 0 #/\ (V - V4 #= 1 #\/ V4 - V #= 1)) #<==> B4,
I8 is I4 + 1, element(I8, L, V8),
V8 #= 0 #==> B8 #= 0,
( V8 #\= 0 #/\ (V - V8 #= 1 #\/ V8 - V #= 1)) #<==> B8
),

( ((V #= 1 #\/ V #= 40) #/\ B2 + B3 + B4 + B6 + B8 #= 1) #\/
( V #\= 1 #/\ V #\= 40 #/\ B2 + B3 + B4 + B6 + B8 #= 2)) #<==> B,
B #= 1,

labeling([ffc, enum], [V, V2, V3, V4, V6, V8]),

init2(2, Lig, Col, L) .
init2(2, Lig, Col, L) .


% A5 A3 A6
% skip last column
% A1 V A2
% A7 A4 A8
% Special case : last column
init2(Col, Lig, Col, L) :-
init2(Col, Lig, Col, L) :-
!,
!,

I is (Lig + 1) * Col,
element(I, L, V),
I1 is I - 1, element(I1, L, V1),
V1 #= 0 #==> B1 #= 0,
( V1 #\= 0 #/\ (V - V1 #= 1 #\/ V1 - V #= 1)) #<==> B1,

% first line
( Lig = 0 -> B3 #= 0, B5 #= 0, V3 #= 0, V5 #= 0
; I3 is I - Col , element(I3, L, V3),
V3 #= 0 #==> B3 #= 0,
( V3 #\= 0 #/\ (V - V3 #= 1 #\/ V3 - V #= 1)) #<==> B3,
I5 is I3 - 1, element(I5, L, V5),
V5 #= 0 #==> B5 #= 0,
( V5 #\= 0#/\ (V - V5 #= 1 #\/ V5 - V #= 1)) #<==> B5
),

% last line
( Lig is Col - 1 -> B4 #= 0, B7 #= 0, V4 #= 0, V7 #= 0
; I4 is I + Col, element(I4, L, V4),
V4 #= 0 #==> B4 #= 0,
( V4 #\= 0 #/\ (V - V4 #= 1 #\/ V4 - V #= 1)) #<==> B4,
I7 is I4 - 1, element(I7, L, V7),
V7 #= 0 #==> B7 #= 0,
( V7 #\= 0 #/\ (V - V7 #= 1 #\/ V7 - V #= 1)) #<==> B7

),

( ((V #= 1 #\/ V #= 40) #/\ B1 + B3 + B4 + B5 + B7 #= 1) #\/
( V #\= 1 #/\ V #\= 40 #/\ B1 + B3 + B4 + B5 + B7 #= 2)) #<==> B,
B #= 1,

labeling([ffc, enum],[V, V1, V3, V4, V5, V7]),

Lig1 is Lig+1,
Lig1 is Lig+1,
init2(1, Lig1, Col, L).
init2(1, Lig1, Col, L).


% A5 A3 A6
% V5 V3 V6
% A1 V A2
% V1 V V2
% A7 A4 A8
% V7 V4 V8
% general case
% general case
init2(N, Lig, Col, L) :-
init2(N, Lig, Col, L) :-
I is N + Lig * Col,
I is N + Lig * Col,
element(I, L, V),
element(I, L, V),

I1 is I - 1, element(I1, L, V1),
I1 is I - 1, element(I1, L, V1),
V1 #= 0 #==> B1 #= 0 ,
V1 #= 0 #==> B1 #= 0 ,
( V1 #\= 0 #/\ (V - V1 #= 1 #\/ V1 - V #= 1)) #<==> B1,
( V1 #\= 0 #/\ (V - V1 #= 1 #\/ V1 - V #= 1)) #<==> B1,

I2 is I + 1, element(I2, L, V2),
I2 is I + 1, element(I2, L, V2),
V2 #= 0 #==> B2 #= 0,
V2 #= 0 #==> B2 #= 0,
( V2 #\= 0 #/\ (V - V2 #= 1 #\/ V2 - V #= 1)) #<==> B2,
( V2 #\= 0 #/\ (V - V2 #= 1 #\/ V2 - V #= 1)) #<==> B2,


I3 is I - Col, element(I3, L, V3),
% first line
( Lig = 0 -> B3 #= 0, B5 #= 0, B6 #= 0, V3 #= 0, V5 #= 0, V6 #= 0
V3 #= 0 #==> B3 #= 0,
; I3 is I - Col, element(I3, L, V3),
( V3 #\= 0 #/\ (V - V3 #= 1 #\/ V3 - V #= 1)) #<==> B3,
V3 #= 0 #==> B3 #= 0,
( V3 #\= 0 #/\ (V - V3 #= 1 #\/ V3 - V #= 1)) #<==> B3,
I5 is I3 - 1, element(I5, L, V5),
V5 #= 0 #==> B5 #= 0,
( V5 #\= 0 #/\ (V - V5 #= 1 #\/ V5 - V #= 1)) #<==> B5,
I6 is I3 + 1, element(I6, L, V6),
V6 #= 0 #==> B6 #= 0,
( V6 #\= 0 #/\ (V - V6 #= 1 #\/ V6 - V #= 1)) #<==> B6
),


I5 is I3 - 1, element(I5, L, V5),
% last line
( Lig is Col - 1 -> B4 #= 0, B7 #= 0, B8 #= 0, V4 #= 0, V7 #= 0, V8 #= 0
V5 #= 0 #==> B5 #= 0,
( V5 #\= 0 #/\ (V - V5 #= 1 #\/ V5 - V #= 1)) #<==> B5,
; I4 is I + Col, element(I4, L, V4),

V4 #= 0 #==> B4 #= 0,
I6 is I3 + 1, element(I6, L, V6),
( V4 #\= 0 #/\ (V - V4 #= 1 #\/ V4 - V #= 1)) #<==> B4,
V6 #= 0 #==> B6 #= 0,
I7 is I4 - 1, element(I7, L, V7),
V7 #= 0 #==> B7 #= 0,
( V6 #\= 0 #/\ (V - V6 #= 1 #\/ V6 - V #= 1)) #<==> B6,

( V7 #\= 0 #/\ (V - V7 #= 1 #\/ V7 - V #= 1)) #<==> B7,
I8 is I4 + 1, element(I8, L, V8),
I4 is I + Col, element(I4, L, V4),
V8 #= 0 #==> B8 #= 0,
V4 #= 0 #==> B4 #= 0,
( V8 #\= 0 #/\ (V - V8 #= 1 #\/ V8 - V #= 1)) #<==> B8
( V4 #\= 0 #/\ (V - V4 #= 1 #\/ V4 - V #= 1)) #<==> B4,

),
I7 is I4 - 1, element(I7, L, V7),
V7 #= 0 #==> B7 #= 0,
( V7 #\= 0 #/\ (V - V7 #= 1 #\/ V7 - V #= 1)) #<==> B7,

I8 is I4 + 1, element(I8, L, V8),
V8 #= 0 #==> B8 #= 0,
( V8 #\= 0 #/\ (V - V8 #= 1 #\/ V8 - V #= 1)) #<==> B8,


( ((V #= 1 #\/ V #= 40) #/\ B1 + B2 + B3 + B4 + B5 + B6 + B7 + B8 #= 1) #\/
( ((V #= 1 #\/ V #= 40) #/\ B1 + B2 + B3 + B4 + B5 + B6 + B7 + B8 #= 1) #\/
Line 310: Line 241:
init2(N1, Lig, Col, L).
init2(N1, Lig, Col, L).



% dsiplay the result
% display the result
my_write([A, B, C, D, E, F, G, H | T]) :-
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,
maplist(my_write_1, [A, B, C, D, E, F, G, H]), nl,
my_write(T).
my_write(T).

Revision as of 18:08, 14 January 2012

Solve a Hidato puzzle is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

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.

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,   element(I1, L, V1),

V1 #= 0 #==> B1 #= 0 , ( V1 #\= 0 #/\ (V - V1 #= 1 #\/ V1 - V #= 1)) #<==> B1, 

       I2 is I + 1,   element(I2, L, V2),

V2 #= 0 #==> B2 #= 0, ( V2 #\= 0 #/\ (V - V2 #= 1 #\/ V2 - V #= 1)) #<==> B2,

I3 is I - Col, element(I3, L, V3), V3 #= 0 #==> B3 #= 0, ( V3 #\= 0 #/\ (V - V3 #= 1 #\/ V3 - V #= 1)) #<==> B3,

I5 is I3 - 1, element(I5, L, V5), V5 #= 0 #==> B5 #= 0, ( V5 #\= 0 #/\ (V - V5 #= 1 #\/ V5 - V #= 1)) #<==> B5,

I6 is I3 + 1, element(I6, L, V6), V6 #= 0 #==> B6 #= 0, ( V6 #\= 0 #/\ (V - V6 #= 1 #\/ V6 - V #= 1)) #<==> B6,

I4 is I + Col, element(I4, L, V4), V4 #= 0 #==> B4 #= 0, ( V4 #\= 0 #/\ (V - V4 #= 1 #\/ V4 - V #= 1)) #<==> B4,

I7 is I4 - 1, element(I7, L, V7), V7 #= 0 #==> B7 #= 0, ( V7 #\= 0 #/\ (V - V7 #= 1 #\/ V7 - V #= 1)) #<==> B7,

I8 is I4 + 1, element(I8, L, V8), V8 #= 0 #==> B8 #= 0, ( V8 #\= 0 #/\ (V - V8 #= 1 #\/ V8 - V #= 1)) #<==> B8,

( ((V #= 1 #\/ V #= 40) #/\ B1 + B2 + B3 + B4 + B5 + B6 + B7 + B8 #= 1) #\/ (V #\= 1 #/\ V #\= 40 #/\ B1 + B2 + B3 + B4 + B5 + B6 + B7 + B8 #= 2)) #<==> B,

B #= 1,

labeling([ffc, enum], [V, V1, V2, V3, V4, V5, V6, V7, V8]),

N1 is N+1, init2(N1, Lig, Col, L).


% 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
Retrieved from "https://rosettacode.org/wiki/Solve_a_Hidato_puzzle?oldid=211205"