/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Closed Knight's Tour. originally written by Markus Triska (triska@metalevel.at) Nov. 2nd 2009 modified to be monotonic by byakuren (https://web.liminal.cafe/~byakuren/prolog/knights-tour-monotonic/) Scryer CLPZ version with list_comp/3 and if_/3 provided by clpz (patched). Public domain code. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- use_module(library(clpz)). :- use_module(library(lists), [append/2, length/2, maplist/2, maplist/3, same_length/2, nth1/3, keysort/2]). :- use_module(library(pairs), [pairs_keys/2, pairs_values/2]). :- op(760, yfx, #<==>). :- op(740, yfx, #\/). :- op(720, yfx, #/\). :- op(700, xfx, #>). :- op(700, xfx, #<). :- op(700, xfx, #>=). :- op(700, xfx, #=<). :- op(700, xfx, #=). :- op(700, xfx, #\=). :- op(700, xfx, in). :- op(700, xfx, ins). :- op(450, xfx, ..). :- op(150, fx, #). % Pure constraints for an N x N closed tour (no labeling). n_tour(N, Ts) :- length(Ts, N), maplist(same_length(Ts), Ts), append(Ts, Vs), successors(Vs, N, 1), circuit(Vs). % Optional symmetry breaking (can be slower). n_tour_sym(N, Ts) :- length(Ts, N), maplist(same_length(Ts), Ts), append(Ts, Vs), successors(Vs, N, 1), symmetry_break(N, Vs), circuit(Vs). successors([], _, _). successors([V|Vs], N, K0) :- next_candidates(N, K0, [Next|Nexts]), foldl(num_to_dom, Nexts, Next, Dom), V in Dom, #K1 #= #K0 + 1, successors(Vs, N, K1). num_to_dom(N, D0, D0\/N). n_x_y_k(N, X, Y, K) :- [X,Y] ins 1..N, #K #= #N*(#Y-1) + #X. xy_k(N, X, Y, K) :- #K #= #N*(#Y-1) + #X. next_candidates(N, K0, Nexts) :- % Use fixed deltas to avoid scanning all squares. n_x_y_k(N, X0, Y0, K0), moves(Moves), candidate_pairs(N, X0, Y0, Moves, Pairs), list_comp(Pairs, pair_true_t, GoodPairs), pairs_keys(GoodPairs, Nexts). pair_true_t(_-T, T). moves([d(2,1), d(2,-1), d(-2,1), d(-2,-1), d(1,2), d(1,-2), d(-1,2), d(-1,-2)]). candidate_pairs(_, _, _, [], []). candidate_pairs(N, X0, Y0, [d(Dx,Dy)|Ds], [Next-T|Rest]) :- #X #= #X0 + Dx, #Y #= #Y0 + Dy, bounds_t(N, X, Y, T), xy_k(N, X, Y, Next), candidate_pairs(N, X0, Y0, Ds, Rest). bounds_t(N, X, Y, T) :- #B1 #<==> (#X #>= 1), #B2 #<==> (#X #=< #N), #B3 #<==> (#Y #>= 1), #B4 #<==> (#Y #=< #N), #B #<==> (#B1 #/\ #B2 #/\ #B3 #/\ #B4), zo_t(B, T). symmetry_break(N, Vs) :- if_(n_geq_3_t(N), symmetry_break_3(N, Vs), true). n_geq_3_t(N, T) :- #B #<==> (#N #>= 3), zo_t(B, T). symmetry_break_3(N, Vs) :- nth1(1, Vs, V1), n_x_y_k(N, X1, Y1, V1), #X1 #=< #Y1. % Optional search heuristic: label squares in increasing degree order. labeling_by_degree(N, Vs) :- order_ks_by_degree(N, KsOrdered), maplist(nth1_var(Vs), KsOrdered, OrderedVars), labeling([], OrderedVars). nth1_var(Vs, K, V) :- nth1(K, Vs, V). order_ks_by_degree(N, KsOrdered) :- square_domain(N, Ks), maplist(degree_pair(N), Ks, Pairs), keysort(Pairs, Sorted), pairs_values(Sorted, KsOrdered). degree_pair(N, K, D-K) :- next_candidates(N, K, Nexts), length(Nexts, D). % Reified successor test: T in {true,false}. n_k_next_t(N, K, Next, T) :- n_x_y_k(N, X0, Y0, K), n_x_y_k(N, X, Y, Next), knight_move_b(X0, Y0, X, Y, B), zo_t(B, T). n_k_next(N, K, Next) :- n_k_next_t(N, K, Next, true). knight_move_b(X0, Y0, X, Y, B) :- #B1 #<==> (#X #= #X0 + 2 #/\ #Y #= #Y0 + 1), #B2 #<==> (#X #= #X0 + 2 #/\ #Y #= #Y0 - 1), #B3 #<==> (#X #= #X0 - 2 #/\ #Y #= #Y0 + 1), #B4 #<==> (#X #= #X0 - 2 #/\ #Y #= #Y0 - 1), #B5 #<==> (#X #= #X0 + 1 #/\ #Y #= #Y0 + 2), #B6 #<==> (#X #= #X0 + 1 #/\ #Y #= #Y0 - 2), #B7 #<==> (#X #= #X0 - 1 #/\ #Y #= #Y0 + 2), #B8 #<==> (#X #= #X0 - 1 #/\ #Y #= #Y0 - 2), #B #<==> (#B1 #\/ #B2 #\/ #B3 #\/ #B4 #\/ #B5 #\/ #B6 #\/ #B7 #\/ #B8). zo_t(0, false). zo_t(1, true). square_domain(N, Squares) :- #N2 #= #N * #N, square_domain_(1, N2, Squares). square_domain_(I, N2, []) :- #I #> #N2. square_domain_(I, N2, [I|Is]) :- #I #=< #N2, #I1 #= #I + 1, square_domain_(I1, N2, Is). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - foldl/4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ foldl(Goal_3, Ls, A0, A) :- foldl_(Ls, Goal_3, A0, A). foldl_([], _, A, A). foldl_([L|Ls], G_3, A0, A) :- call(G_3, L, A0, A1), foldl_(Ls, G_3, A1, A). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Text display. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ print_tour(Ts) :- print_tour(Ts, 3). print_tour(Ts, I) :- tour_enumeration(Ts, Es), phrase(format_string(Ts, I, I), Fs), maplist(format(Fs), Es). format_(Fs, Args, Xs0, Xs) :- format(codes(Xs0,Xs), Fs, Args). format_string([], _, _) --> "\n". format_string([_|Rest], N0, I) --> "~t~w~", call(format_("~w|", [N0])), { #N1 #= #N0 + #I }, format_string(Rest, N1, I). tour_enumeration(Ts, Es) :- same_length(Ts, Es), maplist(same_length(Ts), Es), append(Ts, Vs), append(Es, Ls), foldl(vs_enumeration(Vs, Ls), Vs, 1-1, _). vs_enumeration(Vs, Ls, _, V0-E0, V-E) :- #E #= #E0 + 1, nth1(V0, Ls, E0), nth1(V0, Vs, V). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Examples: ?- n_tour(N, Ts), maplist(label, Ts). %@ N = 0, %@ Ts = [] ; %@ N = 6, %@ Ts = [[9, 10, 7, 8, 16, 17], ..., , [27, 28, 20|...]] . ?- n_tour(6, Ts), maplist(label, Ts), print_tour(Ts). %@ 1 30 25 6 3 32 %@ 26 7 2 31 24 5 %@ 29 36 27 4 33 16 %@ 8 19 34 15 12 23 %@ 35 28 21 10 17 14 %@ 20 9 18 13 22 11 ?- time((n_tour(8, Ts), append(Ts, Vs), labeling([ff], Vs))). %@ % 4,191,339 inferences, 0.790 CPU in 0.807 seconds (98% CPU, 5305492 Lips) ?- n_tour(8, Ts), append(Ts, Vs), labeling([ff], Vs), print_tour(Ts). %@ 1 4 63 28 31 26 19 22 %@ 62 29 2 5 20 23 32 25 %@ 3 64 39 30 27 56 21 18 %@ 38 61 6 53 40 33 24 55 %@ 7 52 41 34 57 54 17 46 %@ 60 37 8 49 44 47 14 11 %@ 51 42 35 58 9 12 45 16 %@ 36 59 50 43 48 15 10 13 Monotonic/pure checks (Scryer): ?- ['knights_tour_monotonic.pl', 'knights_tour_monotonic_tests.pl'], run_tests. %@ true. ?- assertz(clpz:monotonic), square_domain(6, Squares), list_comp(Squares, n_k_next_t(6, 1), Nexts). %@ Nexts = [9,14]. Full tour (may take a while in monotonic mode): ?- assertz(clpz:monotonic), n_tour(6, Ts), append(Ts, Vs), labeling([ff], Vs), print_tour(Ts). %@ 1 6 11 30 27 4 %@ 10 31 2 5 12 29 %@ 7 36 9 28 3 26 %@ 32 23 34 19 16 13 %@ 35 8 21 14 25 18 %@ 22 33 24 17 20 15 Optional variants (may be slower): ?- assertz(clpz:monotonic), n_tour_sym(8, Ts), append(Ts, Vs), labeling([ff], Vs). ?- assertz(clpz:monotonic), n_tour(8, Ts), append(Ts, Vs), labeling_by_degree(8, Vs). - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */