🚀 go-pugleaf

Oh, I am sorry.  It looks like the new page character ^L just
trunkated the Prolog code file.  I try again.

---------------------------------------------------------------------------
% A solution to the knights tour problem:
%   Start in a corner.  Make jumps as the knight do.  Visit every square
%   exactly once.
% - roland@sics.se

% Numbering of jumps from square S:
%  . 2 . 3 .
%  1 . . . 4
%  . . S . .
%  8 . . . 5
%  . 7 . 6 .

% Representation of a square.
% sq(J1,J2,J3,J4,J5,J6,J7,J8).
% X and Y is the coordinates of the square.
% Jn is a flag telling the status of the jump.
%   If possible to jump S <-> 2 Then
%     If jump not chosen Then
%       J2 of square S is bound to the same variable as
%       J6 (inverse of J2) of square 2.
%     Else
%       J2 of square S is "Jump number".
%       J6 of square 2 is "Jump number".
%   Else
%       J2 of square S is ''.
%       J6 of square 2 is ''.

% The algorithm:
% Start in a corner
% While keeping the board updated do
%  Jump to the next square that has the least number of continuations.
%  (If there exists squares with the same number of continuations then
%   chose the next square in the order J1-J8.


% ****  The program  *******************************************************

knight(Size) :- knight(Size,Solution), write_board(Solution).

knight(Size,Solution) :-
	J is Size*Size - 1,
	make_board(Size,Solution), !,		% Make an empty board.
	init_knight(Size,Solution), !,		% Make initial bindings.
	solve_knight(J,Solution,1,1,_).		% Try to find a solution


% ****  The solution searcher  ********************************************

%%%  The recursive jump by jump loop.

solve_knight(0,_,_,_,_) :- !.
solve_knight(M,Board,X,Y,End) :-
	N is M - 1,
	pos(X,Y,Board,Sq),
	collect_jumps(Sq,Board,X,Y,Jumps),
	!,
	member(_-J,Jumps),
	jump(J,X,Y,Xnew,Ynew),
	update_board(Sq,Board,X,Y,J,End,M),
	solve_knight(N,Board,Xnew,Ynew,End).

%%%  Make a list of all posible jumps.  Sorted in "best" order.

collect_jumps(Sq,Board,X,Y,Jumps) :-
	possible_jump(8,Sq,J1),
	set_value_on_jumps(J1,X,Y,Board,J2),
	sort(J2,Jumps).

possible_jump(0,_,[]) :- !.
possible_jump(M,Sq,[M|Xs]) :- arg(M,Sq,X), var(X), !,
	N is M - 1,
	possible_jump(N,Sq,Xs).
possible_jump(M,Sq,Xs) :-
	N is M - 1,
	possible_jump(N,Sq,Xs).
	
set_value_on_jumps([],_,_,_,[]).
set_value_on_jumps([J|Js],X,Y,Board,[Value-J|Js2]) :-
	jump(J,X,Y,Xto,Yto),
	pos(Xto,Yto,Board,Sq),
	get_number_off_possible(8,Sq,Value),
	set_value_on_jumps(Js,X,Y,Board,Js2).



%%%  Update the board according to chosed jump.  Check all non chosen
%%%  jumps for impossible choice.

update_board(Sq,Board,X,Y,J,End,M) :-
	arg(J,Sq,Chosen),
	Chosen = M,
	update_non_chosen(Sq,Board,X,Y,End,8).

update_non_chosen(_,_,_,_,_,0) :- !.
update_non_chosen(Sq,Board,X,Y,F,M) :- arg(M,Sq,J), var(J), !,
	J = '',
	only_one_terminal_square(Board,X,Y,F,M),
	N is M - 1,
	update_non_chosen(Sq,Board,X,Y,F,N).
update_non_chosen(Sq,Board,X,Y,F,M) :-
	N is M - 1,
	update_non_chosen(Sq,Board,X,Y,F,N).

%%%  F is bound to p(Xto,Yto) if only one jump from other square
only_one_terminal_square(_,_,_,_,1) :- !.
only_one_terminal_square(Board,X,Y,F,M) :-
	jump(M,X,Y,Xto,Yto),
	pos(Xto,Yto,Board,Sq),
	get_number_off_possible(8,Sq,Poss),
	( Poss < 2 -> F = end(Xto,Yto) ; true ).


%%%  Analyze a square

get_number_off_possible(0,_,0) :- !.
get_number_off_possible(M,Sq,Poss) :- arg(M,Sq,X), X \== '', !,
	N is M - 1,
	get_number_off_possible(N,Sq,P),
	Poss is P + 1.
get_number_off_possible(M,Sq,Poss) :-
	N is M - 1,
	get_number_off_possible(N,Sq,Poss).



% ****  Initialization  ****************************************************

%%%  Create a NxN matrix (board) containing sq(_,_,_,_,_,_,_,_) structures.

make_board(Size,Board) :-
	functor(Board,x,Size),
	make_board_x(Size,Size,Board).

make_board_x(0,_,_) :- !.
make_board_x(Xn,Size,Board) :-
	arg(Xn,Board,X),
	functor(X,y,Size),
	make_board_y(Size,Xn,X),
	Xnm is Xn-1,
	make_board_x(Xnm,Size,Board).

make_board_y(0,_,_) :- !.
make_board_y(Yn,Xn,X) :-
	arg(Yn,X,Sq),
	Sq=sq(_,_,_,_,_,_,_,_),
	Ynm is Yn-1,
	make_board_y(Ynm,Xn,X).


%%%  Traverse the NxN board to initialize it.

init_knight(Size,Board) :- init_knight_x(Size,Size,Board).

init_knight_x(0,_,_) :- !.
init_knight_x(Xn,Size,Board) :-
	init_knight_y(Size,Xn,Size,Board),
	Xnm is Xn-1,
	init_knight_x(Xnm,Size,Board).

init_knight_y(0,_,_,_) :- !.
init_knight_y(Yn,Xn,Size,Board) :-
	pos(Xn,Yn,Board,Sq),
	bind_all_jumps(8,Xn,Yn,Sq,Size,Board),
	Ynm is Yn-1,
	init_knight_y(Ynm,Xn,Size,Board).


%%%  For each position shall all impossible jumps be bound to '' and
%%%  all possible jumps be bound to the inverse jump from corresponding
%%%  square.

bind_all_jumps(0,_,_,_,_,_) :- !.
bind_all_jumps(N,Xfrom,Yfrom,Sq,Size,Board) :-
	legal_jump(N,Xfrom,Yfrom,Size,Xto,Yto), !,
	arg(N,Sq,Jump),
	pos(Xto,Yto,Board,SqTo),
	inverse(N,Ninv),
	arg(Ninv,SqTo,JumpInv),
	Jump=JumpInv,					% Bind jumps
	Nm is N - 1,
	bind_all_jumps(Nm,Xfrom,Yfrom,Sq,Size,Board).
bind_all_jumps(N,Xfrom,Yfrom,Sq,Size,Board) :-
	arg(N,Sq,Jump),
	Jump='',					% Mark as no-jump
	Nm is N - 1,
	bind_all_jumps(Nm,Xfrom,Yfrom,Sq,Size,Board).



% ****  Some simple help predicates  ***************************************

%%%  Generate jumps.  Each jump has a number.  Each number has an inverse.

j(1,-2, 1). j(2,-1, 2). j(3, 1, 2). j(4, 2, 1).
j(5, 2,-1). j(6, 1,-2). j(7,-1,-2). j(8,-2,-1).

jump(N,Xfrom,Yfrom,Xto,Yto) :- j(N,X,Y), Xto is Xfrom + X, Yto is Yfrom + Y.

legal_jump(N,Xfrom,Yfrom,Size,Xto,Yto) :-
	j(N,X,Y),
	Xto is Xfrom + X, Xto > 0, Xto =< Size,
	Yto is Yfrom + Y, Yto > 0, Yto =< Size.

inverse(1,5). inverse(2,6). inverse(3,7). inverse(4,8).
inverse(5,1). inverse(6,2). inverse(7,3). inverse(8,4).


%%%  Access a specific position in the board matrix.

pos(Xn,Yn,Board,Sq) :- arg(Xn,Board,X), arg(Yn,X,Sq).


%%%  Standar Prolog things.

member(X,[X|_]).
member(X,[_|Xs]) :- member(X,Xs).



% ****  Output  **********************************************************

write_board(Board) :- functor(Board,_,N), N > 32, !,
	format('Large board~n',[]).
write_board(Board) :-
	functor(Board,_,N),
	write_board(N,Board).

write_board(0,_) :- nl, !.
write_board(Yn,Board) :-
	arg(Yn,Board,Y),
	functor(Y,_,Xn),
	write_line(Xn,Yn,Y),
	Ynm is Yn - 1,
	write_board(Ynm,Board).

write_line(0,_,_) :- nl, !.
write_line(Xn,Yn,Y) :-
	arg(Xn,Y,Sq),
	get_max_jump(8,0,Sq,J),
	( Xn=1, Yn=1 -> Jump is J + 1 ; Jump is J ),
	write_integer(Jump),
	Xnm is Xn - 1,
	write_line(Xnm,Yn,Y).

write_integer(N) :- N > 9999, !,            write(N).
write_integer(N) :- N > 999, !, write(' '), write(N).
write_integer(N) :- N > 99, !, write('  '), write(N).
write_integer(N) :- N > 9, !, write('   '), write(N).
write_integer(N) :-          write('    '), write(N).

get_max_jump(0,Max,_,Max) :- !.
get_max_jump(M,Max,Sq,Jump) :- arg(M,Sq,X), integer(X), X > Max, !,
	N is M - 1,
	get_max_jump(N,X,Sq,Jump).
get_max_jump(M,Max,Sq,Jump) :- M > 0,
	N is M - 1,
	get_max_jump(N,Max,Sq,Jump).



% ****  Counting failures in the search  ********************************

knight_fail :- number(1,255,Size), ( knight_fail(Size) -> fail ; fail ).

knight_fail(A,B) :- number(A,B,Size), ( knight_fail(Size) -> fail ; fail ).

knight_fail(Size) :-
	assert(failures(_)),
	retractall(failures(_)),
	assert(failures(0)),
	J is Size*Size - 1,
	make_board(Size,Solution), !,		% Make an empty board.
	init_knight(Size,Solution), !,		% Make initial bindings.
	solve_knight_fail(J,Solution,1,1,_),	% Try to find a solution
	failures(N),
	write_integer(Size),
	write(' failures = '),
	write_integer(N),
	nl.

%%%  The recursive jump by jump loop.

solve_knight_fail(0,_,_,_,_) :- !.
solve_knight_fail(M,Board,X,Y,End) :-
	N is M - 1,
	pos(X,Y,Board,Sq),
	collect_jumps(Sq,Board,X,Y,Jumps),
	!,
	member(_-J,Jumps),
	jump(J,X,Y,Xnew,Ynew),
	( update_board(Sq,Board,X,Y,J,End,M) ->
	  true
	; retract(failures(Old)),
	  New is Old + 1,
	  assert(failures(New)),
	  fail
	),
	solve_knight_fail(N,Board,Xnew,Ynew,End).


% ****  Timing things (Sequential for Muse)  *****************************

sequential.
:- sequential.

timetype(walltime) :- statistics(walltime,_), !.
timetype(runtime).

number(Start,Stop,Start) :- Stop >= Start.
number(Start,Stop,Number) :- Stop >= Start,
	NewStart is Start + 1,
	number(NewStart,Stop,Number).

knight_time :- number(1,255,Size), ( knight_time(Size) -> fail ; fail ).

knight_time(A,B) :- number(A,B,Size), ( knight_time(Size) -> fail ; fail ).

% Use the ISP predicate time_out/3 to maximize the search time to 300 s.
knight_timeout(A,B) :-
	number(A,B,Size),
	time_out((knight_time(Size) -> fail ; fail), 300000, _),
	write_integer(Size),
	write(' Hmmmmmmm'),
	nl,
	fail.

knight_time(Size) :-
	timetype(Timetype),
	J is Size*Size - 1,
	statistics(Timetype,[T1,_]),
	make_board(Size,Solution), !,		% Make an empty board.
	statistics(Timetype,[T2,_]),
	init_knight(Size,Solution), !,		% Make initial bindings.
	statistics(Timetype,[T3,_]),
	solve_knight(J,Solution,1,1,_),		% Try to find a solution
	statistics(Timetype,[T4,_]),
	Tm is T2 - T1, Ti is T3 - T2, Ts is T4 - T3,
	T is Tm + Ti + Ts,
	write_integer(Size),
	write(' '),
	write_integer(T),
	format(' ms  (board = ~w  init = ~w  solve = ~w)~n',[Tm,Ti,Ts]).

knight_all(Size) :-
	timetype(Timetype),
	statistics(Timetype,[T1,_]),
	( knight(Size,_), fail ; true ),
	statistics(Timetype,[T2,_]),
	T is T2 - T1,
	format('~w ms~n',[T]).
--
Roland Karlsson
SICS, PO Box 1263, S-164 28 KISTA, SWEDEN	Internet: roland@sics.se
Tel: +46 8 752 15 40	Ttx: 812 61 54 SICS S	Fax: +46 8 751 72 30