% ThinkFun Solitaire Chess
% 4x4 chessboard, 10 pieces (one color, only 2 pawns)

% Rules:
% - some pieces are on the board by setup
% - each move must take a piece
% - pawns do not change in the last row
% - there is no check
% - each problem has exactly 1 solution ... or so I thought.

% But e.g. Problem #52 has multiple solutions:

% B . . R 
% . P P . 
% . N B . 
% N . . . 


% Solver

% The problem is given in the form:
%   [p(1-1,bishop),p(1-3,rook),p(2-2,knight),p(4-3,knight)]

solve([_], []).
solve(Pieces, [A-B|Moves]) :-
    Pieces \= [_],
    select(A, Pieces, Pieces1),
    select(B, Pieces1, Pieces2),
    takes(A, B, Pieces2),        % empty_* is easier if this uses Pieces2
    p(Pos,_) = B, p(_,Type) = A,
    solve([p(Pos,Type)|Pieces2], Moves).

takes(p(F-R,pawn), p(F1-R1,_), _) :-
    abs(F1 - F) =:= 1, R1 =:= R + 1.
takes(p(F-R,rook), p(F-R1,_), Pieces) :-
    empty_v(F, R, R1, Pieces).
takes(p(F-R,rook), p(F1-R,_), Pieces) :-
    empty_h(R, F, F1, Pieces).
takes(p(F-R,knight), p(F1-R1,_), _) :-
    abs(F1 - F) =:= 2, abs(R1 - R) =:= 1.
takes(p(F-R,knight), p(F1-R1,_), _) :-
    abs(F1 - F) =:= 1, abs(R1 - R) =:= 2.
takes(p(F-R,bishop), p(F1-R1,_), Pieces) :-
    abs(F1 - F) =:= abs(R1 - R),
    empty_d(F-R, F1-R1, Pieces).
takes(p(Pos,queen), Piece, Pieces) :-
    takes(p(Pos,rook), Piece, Pieces).
takes(p(Pos,queen), Piece, Pieces) :-
    takes(p(Pos,bishop), Piece, Pieces).
takes(p(F-R,king), p(F1-R1,_), _) :-
    abs(F1 - F) =< 1, abs(R1 - R) =< 1.

empty_v(_, R, R, _) :- !.
empty_v(F, R, R1, Pieces) :- R > R1, empty_v(F, R1, R, Pieces).
empty_v(F, R, R1, Pieces) :-
    R < R1, R2 is R + 1,
    \+ member(p(F-R,_), Pieces),
    empty_v(F, R2, R1, Pieces).

empty_h(_, F, F, _) :- !.
empty_h(R, F, F1, Pieces) :- F > F1, empty_h(R, F1, F, Pieces).
empty_h(R, F, F1, Pieces) :-
    F < F1, F2 is F + 1,
    \+ member(p(F-R,_), Pieces),
    empty_h(R, F2, F1, Pieces).

empty_d(F-R, F-R, _) :- !.
empty_d(F-R, F1-R1, Pieces) :- F > F1, empty_d(F1-R1, F-R, Pieces).
empty_d(F-R, F1-R1, Pieces) :-
    F < F1, F2 is F + 1,
    \+ member(p(F-R,_), Pieces),
    ( R < R1 -> R2 is R + 1 ; R2 is R - 1 ),
    empty_d(F2-R2, F1-R1, Pieces).


% Visualization

show_board(Pieces) :- show_board(1-4, Pieces).
show_board(5-R, Pieces) :- nl, R1 is R - 1, show_board(1-R1, Pieces).
show_board(1-0, _) :- !.
show_board(F-R, Pieces) :-
    ( member(p(F-R,Type), Pieces) -> abbrev(Type, C), write(C), write(' ')
    ; write('. ')
    ),
    F1 is F + 1,
    show_board(F1-R, Pieces), !.

abbrev(pawn, 'P').
abbrev(rook, 'R').
abbrev(knight, 'N').
abbrev(bishop, 'B').
abbrev(queen, 'Q').
abbrev(king, 'K').

show_moves([]).
show_moves([p(F-R,Type)-p(F1-R1,_)|Moves]) :-
    abbrev(Type, C), write(C), write(' '),
    file(F, FC), write(FC), write(R),
    write(' x '),
    file(F1, F1C), write(F1C), write(R1),
    nl,
    show_moves(Moves).

file(1, a).
file(2, b).
file(3, c).
file(4, d).

% Test

test(Pieces) :-
    show_board(Pieces), nl,
    solve(Pieces, Moves),
    show_moves(Moves).

% ?- test([p(1-1,bishop),p(1-3,rook),p(2-2,knight),p(4-3,knight)]).


% Creating puzzles

% According to the booklet:
% - Beginner / Intermediate / Advanced / Expert puzzles
%   have 4-5 / 5-6 / 6-7 / 7-8 pieces in play, respectively
% - Problems are constructed s.t. the king is never taken
% Problems where one piece takes all the others are not interesting;
% let us look for problems where at least K pieces are active.
% Problems where there are no dummies (pieces that cannot take any other)
% should be much more interesting.
% Also, there should be no shifted (or symmetric?) puzzles.

% - does not check symmetry
% - puzzles with multiple pieces of the same type appear multiple times
% - many puzzles are basically the same, just some pieces are changed to other types
puzzle(N, K, Puzzle, Solution) :-
    choose(N, [pawn,pawn,rook,rook,knight,knight,bishop,bishop,queen,king], Types),
    place(Types, [], Puzzle),
    % No shifting:
    member(p(1-_,_), Puzzle),
    member(p(_-1,_), Puzzle),
    % No dummies:
    forall(member(P, Puzzle),
           ( select(P, Puzzle, Puzzle1),
             select(Q, Puzzle1, Puzzle2),
             takes(P, Q, Puzzle2)
           )),
    % One solution:
    findall(Moves, solve(Puzzle, Moves), [Solution]),
    % Solvable:
    solve(Puzzle, Solution),
    % King is not taken:
    \+ member(_-p(_,king), Solution),
    % At least K different pieces are moved in every solution:
    \+ ( solve(Puzzle, Solution1),
         attackers(Solution1, Attackers),
         sort(Attackers, Different),
         length(Different, D),
         D < K ).

choose(0, _, []).
choose(N, [X|Xs], [X|Ys]) :- N > 0, N1 is N - 1, choose(N1, Xs, Ys).
choose(N, [_|Xs], Ys) :- N > 0, choose(N, Xs, Ys).

place([], Board, Board).
place([Type|Types], Board, X) :-
    between(1, 4, F), between(1, 4, R),
    \+ member(p(F-R,_), Board),
    place(Types, [p(F-R,Type)|Board], X).

attackers([], []).
attackers([p(_,T)-_|Xs], [T|Ys]) :- attackers(Xs, Ys).

% Test

% First with only 1 solution:

% ?- puzzle(4, 2, P, S), show_board(P), nl, show_moves(S).

% . . . . 
% R . . . 
% . P R . 
% P . . . 

% R c2 x b2
% P a1 x b2
% P b2 x a3

% ?- puzzle(5, 2, P, S), show_board(P), nl, show_moves(S).

% R . . . 
% . . R N 
% . P . . 
% P . . . 

% P a1 x b2
% N d3 x b2
% N b2 x a4
% N a4 x c3

% ... or:

% . . B . 
% R . . Q 
% . N . . 
% P . . . 

% N b2 x c4
% N c4 x a3
% Q d3 x a3
% Q a3 x a1

% ?- puzzle(6, 3, P, S), show_board(P), nl, show_moves(S).

% . . N N 
% . R . P 
% . R . . 
% P . . . 

% P a1 x b2
% N c4 x b2
% N b2 x d3
% R b3 x d3
% R d3 x d4

% ... or:

% . R N . 
% R . . P 
% . . . B 
% . . P . 

% P d3 x c4
% R b4 x c4
% R c4 x c1
% B d2 x c1
% B c1 x a3

% The one solution constraint seems too strict for 7 or more pieces.

% Now without the 1 solution constraint, and the no dummy constraint:

% ?- puzzle(7, 3, P, S), show_board(P), nl, show_moves(S), nl, fail.

% R . . B 
% R . . . 
% P . N . 
% P N . . 

% R a3 x a2
% R a4 x a2
% N c2 x a1
% B d4 x a1
% R a2 x a1
% R a1 x b1

% ... or:

% N . . . 
% R . B B 
% P N . . 
% P . . . 

% P a1 x b2
% R a3 x a2
% B c3 x b2
% R a2 x b2
% N a4 x b2
% N b2 x d3