% Six by six chessboard problem, see "http://www.perlmonks.org/?node_id=821272"
% Logical programming variant

row(R) :- length(R, 6), rowpart(6, R).
rowpart(T, R) :- rowpart(3, 3, T, R).
rowpart(X, Y, 0, _) :- 0 =< X, 0 =< Y.
rowpart(X, Y, T, [b | R]) :- succ(Xp, X), succ(Tp, T), rowpart(Xp, Y, Tp, R).
rowpart(X, Y, T, [w | R]) :- succ(Yp, Y), succ(Tp, T), rowpart(X, Yp, Tp, R).

board(B) :-
	B = [R0, R1, R2, R3, R4, R5],
	for(lambda(arg(R), length(R, 6)), B), 
	transpose(B, BT),
	row(R0),
	write(board_debug0([R0])), nl,
	row(R1),
	R0 \== R1,
	row(R2),
	for(lambda(arg(R), R \== R2), [R0, R1]),
	row(R3),
	for(lambda(arg(R), R \== R3), [R0, R1, R2]),
	for(lambda(arg(C), rowpart(5, C)), BT),
	row(R4),
	for(lambda(arg(R), R \== R4), [R0, R1, R2, R3]),
	for(lambda(arg(C), row(C)), BT),
	%row(R5), % automatically true
	for(lambda(arg(R), R \== R5), [R0, R1, R2, R3, R4]),
	iota(6, I6), 
	for(lambda(arg(M), (
		take(M, BT, CB), nth0(M, BT, C),
		for(lambda(arg(U), U \== C), CB))), 
	I6).

nboard(N) :-
	findall(x, board(_B), L),
	length(L, N).

main :-
	nboard(N), write(N), nl.	


/*
##</code><code>##

*/

/*
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(Fni, 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