And this code below solves the six by six puzzle the pure constraint programming way.
Notice how it first posts all constraints deterministically (without branching), and then the final labeling is the only thing that branches.
Runs in SWI prolog in 489 seconds (on a fast computer) and prints the correct answer.
% Six by six chessboard problem, see "http://www.perlmonks.org/?node_i +d=821272" % Finite domain constraint programming variaton :- use_module(library(clpfd)). row(R) :- length(R, 6), R ins 0 .. 1, row1(R). row1([X0, X1, X2, X3, X4, X5]) :- X0 + X1 + X2 + X3 + X4 + X5 #= 3. /* differ([X0, X1, X2, X3, X4, X5], [Y0, Y1, Y2, Y3, Y4, Y5], P) :- (X0 #\= Y0) #\/ (X1 #\= Y1) #\/ (X2 #\= Y2) #\/ ... % nah, I'll ty +po this somewhere */ vdiffer(Xs, Ys) :- zip(lambda(arg(X, Y, N), N = (X #\= Y)), Xs, Ys, Ns), foldrz(lambda(arg(M, N, Q), Q = (M #\/ N)), 0, Ns, P), P. pairwise_vdiffer([]). pairwise_vdiffer([H | T]) :- for(lambda_close(H, Hi, arg(K), vdiffer(Hi, K)), T), pairwise_vdiffer(T). boardp(B) :- length(B, 6), for(lambda(arg(R), row(R)), B), transpose(B, BT), for(lambda(arg(C), row1(C)), BT), pairwise_vdiffer(B), pairwise_vdiffer(BT). board(B) :- boardp(B), concat(B, Bfl), [R0 | _] = B, labeling([leftmost], R0), write(board_debug0([R0])), nl, labeling([leftmost], Bfl). nboard(N) :- findall(x, board(_B), L), length(L, N). main :- nboard(N), write(N), nl. /*
*/ /* Homegrown functional programming library for prolog */ :- use_module(library(lists)). % Higher order programming fcall(Fn, A) :- copy_term(Fn, lambda(A, G)), !, call(G). fcall(lambda_close(D, C, P, G), A) :- copy_term(rec(C, P, G), rec(V, Pc, Gc)), V = D, Pc = A, call(Gc). % List functions, higher order map(_, [], []). map(Fn, [Ah | At], [Bh | Bt]) :- fcall(Fn, arg(Ah, Bh)), map(Fn, At, Bt). for(Fn, A) :- map(lambda_close(Fn, Fc, arg(X, _), fcall(Fc, arg(X))), A, _). zip(Fn, A, B, C) :- map(lambda(arg(X, rec(X, _)), true), A, P), map(lambda(arg(Y, rec(_, Y)), true), B, P), map(lambda_close(Fn, Fc, arg(rec(X, Y), Z), fcall(Fc, arg(X, Y, Z) +)), P, C). any(Fn, [X | _]) :- fcall(Fn, arg(X)). any(Fn, [_ | R]) :- any(Fn, R). first(Fn, L, R) :- once(any(lambda_close(rec(Fn, Ro), rec(Fni, Ri), arg(X), (fcall(Fn +i, arg(X)), Ri = X)), L)), R = Ro. foldrs(_, U, [], U). foldrs(Fn, U, [H | T], R) :- foldrs(Fn, U, T, M), fcall(Fn, arg(H, M, R)). foldrz(_, U, [], U). foldrz(Fn, U, [H | T], R) :- fcall(Fn, arg(H, M, R)), foldrz(Fn, U, T, M). foldl(_, U, [], U). foldl(Fn, U, [H | T], R) :- fcall(Fn, arg(U, H, M)), foldl(Fn, M, T, R). filter(Fn, L, R) :- foldrz( lambda_close(Fn, Fni, arg(X, M, N), (fcall(Fni, arg(X)) -> N = + [X | M] ; N = M)), [], L, R). unfoldr(Fn, U, [H | T]) :- fcall(Fn, arg(U, H, M)), !, unfoldr(Fn, M, T). unfoldr(_, _, []). % List functions, first order concat(Ls, C) :- foldrz(lambda(arg(X,M,R), append(X,M,R)), [], Ls, C). transpose([], []). transpose(Ls, Rs) :- [L1 | _] = Ls, map(lambda(arg(_, []), true), L1, Fi), foldrz( lambda(arg(L, M, R), zip(lambda(arg(X, Y, [X | Y]), true), L, +M, R)), Fi, Ls, Rs). splitat(N, L, H, T) :- length(H, N), append(H, T, L), !. splitat(N, L, L, []) :- length(L, M), M < N. take(N, L, H) :- splitat(N, L, H, _). drop(N, L, T) :- splitat(N, L, _, T). iota(N, L) :- unfoldr(lambda(arg(H, H, F), (H < N, F is H + 1)), 0, L) +. slice(N, L, R) :- unfoldr(lambda(arg(C, H, T), (C = [_ | _], splitat(N, C, H, T))), +L, R). infixes(N, L, R) :- length(H, N), append(H, _, L) -> R = [H | R1], [_ | L1] = L, infixes(N, L1, R1) ; length(L, M), M < N, R = []. /* Examples. | ?- zip(lambda(arg(X, Y, Z), Z is X * Y), [3,1,4], [10, 100, 1000], R +). R = [30,100,4000] ? ; no | ?- map(lambda_close(E, V, arg(X, V*X), true), [A, B, A+B], R). R = [E*A,E*B,E*(A+B)] ? ; no | ?- any(lambda_close(R, Rho, arg(X), (5 < X, Rho = X)), [3,1,4,1,5,9, +2,6]). R = 9 ? ; R = 6 ? ; no | ?- foldrz(lambda(arg(H, M, x(H, M)), true), 2, [3, 8, 5], R). R = x(3,x(8,x(5,2))) ? ; no | ?- foldl(lambda(arg(M, H, x(M, H)), true), 2, [3, 8, 5], R). R = x(x(x(2,3),8),5) ? ; no | ?- foldl(lambda(arg(M, H, R), R is M + H), 2, [3, 8, 5], R). R = 18 ? ; no */ % END
In reply to Re^3: Seven by seven farming puzzle
by ambrus
in thread Seven by seven farming puzzle
by ambrus
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |