:- initialization(main).
board_size(20).
in_board(X*Y) :- board_size(N), between(1,N,Y), between(1,N,X).
% express jump-graph in dynamic "move"-rules
make_graph :-
findall(_, (in_board(P), assert_moves(P)), _).
% where
assert_moves(P) :-
findall(_, (can_move(P,Q), asserta(move(P,Q))), _).
can_move(X*Y,Q) :-
( one(X,X1), two(Y,Y1) ; two(X,X1), one(Y,Y1) )
, Q = X1*Y1, in_board(Q)
. % where
one(M,N) :- succ(M,N) ; succ(N,M).
two(M,N) :- N is M + 2 ; N is M - 2.
hamiltonian(P,Pn) :-
board_size(N), Size is N * N
, hamiltonian(P,Size,[],Ps), enumerate(Size,Ps,Pn)
.
% where
enumerate(_, [] , [] ).
enumerate(N, [P|Ps], [N:P|Pn]) :- succ(M,N), enumerate(M,Ps,Pn).
hamiltonian(P,N,Ps,Res) :-
N =:= 1 -> Res = [P|Ps]
; warnsdorff(Ps,P,Q), succ(M,N)
, hamiltonian(Q,M,[P|Ps],Res)
.
% where
warnsdorff(Ps,P,Q) :-
moves(Ps,P,Qs), maplist(next_moves(Ps), Qs, Xs)
, keysort(Xs,Ys), member(_-Q,Ys)
.
next_moves
(Ps
,Q
,L
-Q
) :- moves
(Ps
,Q
,Rs
), length(Rs
,L
).
moves(Ps,P,Qs) :-
findall(Q, (move(P,Q), \+ member(Q,Ps)), Qs).
show_path(Pn) :- findall(_, (in_board(P), show_cell(Pn,P)), _).
% where
show_cell(Pn,X*Y) :-
member
(N
:X
*Y,Pn
), format('%4.0d',[N
]), board_size
(X
), nl
.
% gprolog-1.3.1 compatibilily
succ(M,N) :- var(M) -> M is N - 1 ; N is M + 1.
between(M,N,X) :- X = M ; M < N -> M1 is M + 1, between(M1,N,X).
maplist(_,[],[]).
maplist(F,[X|Xs],[Y|Ys]) :- call(F,X,Y), maplist(F,Xs,Ys).
main :- make_graph, hamiltonian(5*3,Pn), show_path(Pn), halt.
Oi0gaW5pdGlhbGl6YXRpb24obWFpbikuCgoKYm9hcmRfc2l6ZSgyMCkuCmluX2JvYXJkKFgqWSkgOi0gYm9hcmRfc2l6ZShOKSwgYmV0d2VlbigxLE4sWSksIGJldHdlZW4oMSxOLFgpLgoKCiUgZXhwcmVzcyBqdW1wLWdyYXBoIGluIGR5bmFtaWMgIm1vdmUiLXJ1bGVzIAptYWtlX2dyYXBoIDotCiAgICBmaW5kYWxsKF8sIChpbl9ib2FyZChQKSwgYXNzZXJ0X21vdmVzKFApKSwgXykuCgogICAgJSB3aGVyZQogICAgYXNzZXJ0X21vdmVzKFApIDotCiAgICAgICAgZmluZGFsbChfLCAoY2FuX21vdmUoUCxRKSwgYXNzZXJ0YShtb3ZlKFAsUSkpKSwgXykuCgogICAgY2FuX21vdmUoWCpZLFEpIDotCiAgICAgICAgKCBvbmUoWCxYMSksIHR3byhZLFkxKSA7IHR3byhYLFgxKSwgb25lKFksWTEpICkKICAgICAgLCBRID0gWDEqWTEsIGluX2JvYXJkKFEpCiAgICAgIC4gJSB3aGVyZQogICAgICAgIG9uZShNLE4pIDotIHN1Y2MoTSxOKSAgOyBzdWNjKE4sTSkuCiAgICAgICAgdHdvKE0sTikgOi0gTiBpcyBNICsgMiA7IE4gaXMgTSAtIDIuCgoKCmhhbWlsdG9uaWFuKFAsUG4pIDotCiAgICBib2FyZF9zaXplKE4pLCBTaXplIGlzIE4gKiBOCiAgLCBoYW1pbHRvbmlhbihQLFNpemUsW10sUHMpLCBlbnVtZXJhdGUoU2l6ZSxQcyxQbikKICAuCiAgICAlIHdoZXJlCiAgICBlbnVtZXJhdGUoXywgW10gICAgLCBbXSAgICAgICkuCiAgICBlbnVtZXJhdGUoTiwgW1B8UHNdLCBbTjpQfFBuXSkgOi0gc3VjYyhNLE4pLCBlbnVtZXJhdGUoTSxQcyxQbikuCgoKaGFtaWx0b25pYW4oUCxOLFBzLFJlcykgOi0KICAgIE4gPTo9IDEgLT4gUmVzID0gW1B8UHNdCiAgOyB3YXJuc2RvcmZmKFBzLFAsUSksIHN1Y2MoTSxOKQogICwgaGFtaWx0b25pYW4oUSxNLFtQfFBzXSxSZXMpCiAgLiAgICAKICAgICUgd2hlcmUKICAgIHdhcm5zZG9yZmYoUHMsUCxRKSA6LQogICAgICAgIG1vdmVzKFBzLFAsUXMpLCBtYXBsaXN0KG5leHRfbW92ZXMoUHMpLCBRcywgWHMpCiAgICAgICwga2V5c29ydChYcyxZcyksIG1lbWJlcihfLVEsWXMpCiAgICAgIC4KICAgIG5leHRfbW92ZXMoUHMsUSxMLVEpIDotIG1vdmVzKFBzLFEsUnMpLCBsZW5ndGgoUnMsTCkuCgogICAgbW92ZXMoUHMsUCxRcykgOi0KICAgICAgICBmaW5kYWxsKFEsIChtb3ZlKFAsUSksIFwrIG1lbWJlcihRLFBzKSksIFFzKS4KICAgICAgICAKICAgICAgICAKCnNob3dfcGF0aChQbikgIDotIGZpbmRhbGwoXywgKGluX2JvYXJkKFApLCBzaG93X2NlbGwoUG4sUCkpLCBfKS4KICAgICUgd2hlcmUKICAgIHNob3dfY2VsbChQbixYKlkpIDotCiAgICAgICAgbWVtYmVyKE46WCpZLFBuKSwgZm9ybWF0KCclNC4wZCcsW05dKSwgYm9hcmRfc2l6ZShYKSwgbmwuCgoKJSBncHJvbG9nLTEuMy4xIGNvbXBhdGliaWxpbHkKc3VjYyhNLE4pIDotIHZhcihNKSAtPiBNIGlzIE4gLSAxIDsgTiBpcyBNICsgMS4KCmJldHdlZW4oTSxOLFgpIDotIFggPSBNIDsgTSA8IE4gLT4gTTEgaXMgTSArIDEsIGJldHdlZW4oTTEsTixYKS4KIAptYXBsaXN0KF8sW10sW10pLgptYXBsaXN0KEYsW1h8WHNdLFtZfFlzXSkgOi0gY2FsbChGLFgsWSksIG1hcGxpc3QoRixYcyxZcykuCgptYWluIDotIG1ha2VfZ3JhcGgsIGhhbWlsdG9uaWFuKDUqMyxQbiksIHNob3dfcGF0aChQbiksIGhhbHQu