Katamino Solver

% Katamino Solver

% Interface

% Type = small_slam, Row = a..g,                              Col = 3..8
% Type = slam,       Row = a..z, spade, heart, diamond, club, Col = 5..9 (a..n), 6..8 (o..club)
% Type = grand_slam, Row = a..l,                              Col = 4..11
% Type = super_slam, Row = a..l,                              Col = 5..11
% Type = super_nine, Row = a..l,                              Col = 9
% Type = challenge,  Row = 1..40,                             Col = 7..10
katamino(Type, Row, Col) :-
    problem(Type, Row, All),
    take(Col, All, Shapes),
    solve(Shapes, Solution),
    pretty(Col, Solution).

% Example:
%
% ?- katamino(small_slam, c, 5).
% l l v v v 
% l p p s v 
% l p p s v 
% l y p s s 
% y y y y s 
% true

% See also test_all/0 and split_set/1 below.


% Solver

solve(Ss, X) :- length(Ss, N), solve(Ss, N, [], X).

solve([], _, B, B).
solve(Ss, N, B, X) :-
    first_hole(N, B, P),   % find the first hole on the board in a lexical ordering
    select(S, Ss, Ss1),    % select a shape from the available ones
    place(S, P, N, B, B1), % place the shape to cover the first hole
    solvable(N, B1),       % check if the board is still solvable
    solve(Ss1, N, B1, X).  % recurse

first_hole(N, B, X-Y) :- between(1, N, X), between(1, 5, Y), \+ member(s(X-Y,_), B), !.

place(S, X-Y, N, B, B1) :-
    shape(S, [_-Dy|Ds]),                     % choose a rotation/flip
    Y1 is Y - Dy, Y1 > 0,                   % apply correction to cover X-Y
    place(S, X-Y1, Ds, N, [s(X-Y,S)|B], B1). % call the main function (with X-Y already covered)

place(_, _, [], _, B, B).
place(S, X-Y, [Dx-Dy|Ds], N, B, B1) :-
    X1 is X + Dx, between(1, N, X1),
    Y1 is Y + Dy, between(1, 5, Y1),
    \+ member(s(X1-Y1,_), B),
    place(S, X-Y, Ds, N, [s(X1-Y1,S)|B], B1).

% This should check if there are holes with a size not divisible by 5,
% but the program is fast enough as it is.
solvable(_, _).

% Pretty printer

pretty(N, B) :- pretty(N, 1, 1, B).

pretty(_, 6, _, _).
pretty(N, I, J, B) :- I =< 5, J > N, I1 is I + 1, nl, pretty(N, I1, 1, B).
pretty(N, I, J, B) :-
    I =< 5, J =< N,
    member(s(J-I,S), B),
    write(S), write(' '),
    J1 is J + 1,
    pretty(N, I, J1, B).

% Utilities

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

selectN(0, Xs, [], Xs).
selectN(N, Xs, [Y|Ys], Zs) :-
    N > 0, N1 is N - 1,
    select(Y, Xs, Xs1),
    selectN(N1, Xs1, Ys, Zs).

% Testing all problems

problem_set(small_slam, L, 3, 8) :- string_chars('abcdefg', L).
problem_set(slam, L, 5, 9) :- string_chars('abcdefghijklmn', L).
problem_set(slam, L, 6, 8) :-
    string_chars('opqrstuvwxyz', L1),
    append(L1, [spade, heart, diamond, club], L).
problem_set(grand_slam, L, 4, 11) :- string_chars('abcdefghijkl', L).
problem_set(super_slam, L, 5, 11) :- string_chars('abcdefghijkl', L).
problem_set(super_nine, L, 9, 9) :- string_chars('abcdefghijkl', L).
problem_set(challenge, L, 7, 10) :- bagof(X, between(1, 40, X), L).
problem_set(full, [set], 12, 12).

run_once(Type, Row, Col) :- katamino(Type, Row, Col), !.
run_once(_, _, _) :- write('FAILED'), nl.

test_all :-
    problem_set(Type, Rows, Min, Max),
    member(Row, Rows),
    between(Min, Max, Col),
    format('~n~a ~a/~a:~n', [Type, Row, Col]),
    run_once(Type, Row, Col),
    false.


% Find split sets

split_set(N) :-
    N1 is 12 - N,
    problem(full, set, L),
    selectN(N, L, L1, L2),
    solve(L1, N, [], X1),
    solve(L2, N1, [], X2),
    pretty(N, X1), print('and'), nl, pretty(N1, X2).

% Shapes
% (relative coordinates are given in lexical order)

%                    x    x  x
%       xx  xx  x    x    x  x  xx   x    xx    x   xxx
%   xx  xx  x   xx   x   xx  x   xx  x     x   xxx   x
% xxx   x   xx   xx  xx   x  x   x   xxx   xx   x    x
%
%   s   p   c    w    l   y  i   r    v    z    +    t

shape(s, [0-0,0-1,0-2,1-2,1-3]).
shape(s, [0-0,0-1,1-1,1-2,1-3]).
shape(s, [0-0,1-0,1-1,2-1,3-1]).
shape(s, [0-0,1-0,2-0,2-1,3-1]).
shape(s, [0-1,0-2,0-3,1-0,1-1]).
shape(s, [0-1,1-0,1-1,2-0,3-0]).
shape(s, [0-1,1-1,2-0,2-1,3-0]).
shape(s, [0-2,0-3,1-0,1-1,1-2]).

shape(p, [0-0,0-1,0-2,1-0,1-1]).
shape(p, [0-0,0-1,0-2,1-1,1-2]).
shape(p, [0-0,0-1,1-0,1-1,1-2]).
shape(p, [0-0,0-1,1-0,1-1,2-0]).
shape(p, [0-0,0-1,1-0,1-1,2-1]).
shape(p, [0-0,1-0,1-1,2-0,2-1]).
shape(p, [0-1,0-2,1-0,1-1,1-2]).
shape(p, [0-1,1-0,1-1,2-0,2-1]).

shape(c, [0-0,0-1,0-2,1-0,1-2]).
shape(c, [0-0,0-1,1-0,2-0,2-1]).
shape(c, [0-0,0-1,1-1,2-0,2-1]).
shape(c, [0-0,0-2,1-0,1-1,1-2]).

shape(w, [0-0,0-1,1-1,1-2,2-2]).
shape(w, [0-0,1-0,1-1,2-1,2-2]).
shape(w, [0-1,0-2,1-0,1-1,2-0]).
shape(w, [0-2,1-1,1-2,2-0,2-1]).

shape(l, [0-0,0-1,0-2,0-3,1-0]).
shape(l, [0-0,0-1,0-2,0-3,1-3]).
shape(l, [0-0,0-1,1-0,2-0,3-0]).
shape(l, [0-0,0-1,1-1,2-1,3-1]).
shape(l, [0-0,1-0,1-1,1-2,1-3]).
shape(l, [0-0,1-0,2-0,3-0,3-1]).
shape(l, [0-1,1-1,2-1,3-0,3-1]).
shape(l, [0-3,1-0,1-1,1-2,1-3]).

shape(y, [0-0,0-1,0-2,0-3,1-1]).
shape(y, [0-0,0-1,0-2,0-3,1-2]).
shape(y, [0-0,1-0,1-1,2-0,3-0]).
shape(y, [0-0,1-0,2-0,2-1,3-0]).
shape(y, [0-1,1-0,1-1,1-2,1-3]).
shape(y, [0-1,1-0,1-1,2-1,3-1]).
shape(y, [0-1,1-1,2-0,2-1,3-1]).
shape(y, [0-2,1-0,1-1,1-2,1-3]).

shape(i, [0-0,0-1,0-2,0-3,0-4]).
shape(i, [0-0,1-0,2-0,3-0,4-0]).

shape(r, [0-0,0-1,1-1,1-2,2-1]).
shape(r, [0-0,1-0,1-1,1-2,2-1]).
shape(r, [0-1,0-2,1-0,1-1,2-1]).
shape(r, [0-1,1-0,1-1,1-2,2-0]).
shape(r, [0-1,1-0,1-1,1-2,2-2]).
shape(r, [0-1,1-0,1-1,2-1,2-2]).
shape(r, [0-1,1-1,1-2,2-0,2-1]).
shape(r, [0-2,1-0,1-1,1-2,2-1]).

shape(v, [0-0,0-1,0-2,1-0,2-0]).
shape(v, [0-0,0-1,0-2,1-2,2-2]).
shape(v, [0-0,1-0,2-0,2-1,2-2]).
shape(v, [0-2,1-2,2-0,2-1,2-2]).

shape(z, [0-0,0-1,1-1,2-1,2-2]).
shape(z, [0-0,1-0,1-1,1-2,2-2]).
shape(z, [0-1,0-2,1-1,2-0,2-1]).
shape(z, [0-2,1-0,1-1,1-2,2-0]).

shape(+, [0-1,1-0,1-1,1-2,2-1]).

shape(t, [0-0,0-1,0-2,1-1,2-1]).
shape(t, [0-0,1-0,1-1,1-2,2-0]).
shape(t, [0-1,1-1,2-0,2-1,2-2]).
shape(t, [0-2,1-0,1-1,1-2,2-2]).


% Problems

problem(small_slam, a, [l,y,t,p,w,z,v,s]).
problem(small_slam, b, [s,p,c,l,z,y,t,w]).
problem(small_slam, c, [l,v,p,y,s,c,z,r]).
problem(small_slam, d, [y,p,c,s,v,r,w,t]).
problem(small_slam, e, [l,s,v,z,c,t,y,w]).
problem(small_slam, f, [p,c,r,y,t,s,l,w]).
problem(small_slam, g, [l,v,p,z,y,w,s,r]).

problem(slam, a, [l,p,c,r,w,y,z,s,v]).
problem(slam, b, [y,s,p,c,z,v,t,l,r]).
problem(slam, c, [l,y,v,t,w,z,r,c,p]).
problem(slam, d, [s,v,p,c,r,w,l,z,t]).
problem(slam, e, [l,y,s,p,w,t,v,r,c]).
problem(slam, f, [l,p,c,z,t,r,s,w,y]).
problem(slam, g, [l,v,p,c,w,s,y,t,z]).
problem(slam, h, [l,s,p,t,w,z,y,r,v]).
problem(slam, i, [l,y,v,c,z,r,w,s,t]).
problem(slam, j, [l,v,p,r,w,y,c,t,s]).
problem(slam, k, [l,y,s,c,w,r,p,v,z]).
problem(slam, l, [y,v,p,z,w,s,r,t,c]).
problem(slam, m, [l,y,v,p,r,c,t,z,w]).
problem(slam, n, [l,y,p,z,w,s,c,v,t]).
problem(slam, o, [l,y,s,c,r,t,z,p]).
problem(slam, p, [l,s,v,p,z,r,t,y]).
problem(slam, q, [l,y,p,z,r,w,v,c]).
problem(slam, r, [l,s,v,p,c,t,w,r]).
problem(slam, s, [y,v,p,c,t,w,l,z]).
problem(slam, t, [l,y,v,z,r,t,p,w]).
problem(slam, u, [l,s,v,p,c,r,z,t]).
problem(slam, v, [s,v,p,c,z,t,r,y]).
problem(slam, w, [s,v,p,c,z,r,y,w]).
problem(slam, x, [y,s,v,p,t,w,z,c]).
problem(slam, y, [l,s,c,z,r,t,v,y]).
problem(slam, z, [l,y,p,r,t,w,c,z]).
problem(slam, spade, [y,s,p,c,z,t,r,w]).
problem(slam, heart, [l,s,v,c,r,w,y,t]).
problem(slam, diamond, [l,s,v,p,r,t,w,z]).
problem(slam, club, [l,v,p,c,r,t,s,y]).

problem(grand_slam, a, [l,s,v,z,c,t,p,+,r,i,w]).
problem(grand_slam, b, [l,y,c,r,z,v,+,p,i,s,t]).
problem(grand_slam, c, [l,y,v,p,r,w,s,c,z,t,i]).
problem(grand_slam, d, [y,p,c,r,t,+,l,v,w,z,s]).
problem(grand_slam, e, [l,y,p,z,w,s,t,r,i,c,+]).
problem(grand_slam, f, [l,p,c,r,+,y,i,s,t,w,v]).
problem(grand_slam, g, [l,y,p,w,s,c,v,z,+,i,r]).
problem(grand_slam, h, [y,s,v,t,r,i,z,w,l,+,c]).
problem(grand_slam, i, [l,v,p,z,y,r,w,i,s,t,+]).
problem(grand_slam, j, [l,y,p,t,w,s,i,v,c,+,z]).
problem(grand_slam, k, [y,s,p,c,v,z,+,i,w,r,t]).
problem(grand_slam, l, [l,y,v,c,z,i,r,t,+,p,w]).

problem(super_slam, a, [l,s,p,t,w,z,v,i,c,y,r]).
problem(super_slam, b, [l,y,s,v,p,t,w,+,r,i,z]).
problem(super_slam, c, [l,p,c,r,w,i,z,s,v,t,+]).
problem(super_slam, d, [y,s,p,c,z,l,+,v,t,w,i]).
problem(super_slam, e, [y,v,p,z,w,s,t,i,+,c,r]).
problem(super_slam, f, [s,v,p,c,r,+,y,l,i,t,w]).
problem(super_slam, g, [l,p,c,t,+,r,s,z,y,v,i]).
problem(super_slam, h, [l,v,p,r,w,i,c,t,+,z,y]).
problem(super_slam, i, [l,p,c,z,t,y,i,+,s,r,w]).
problem(super_slam, j, [l,y,v,t,w,z,r,i,c,+,s]).
problem(super_slam, k, [l,s,p,c,z,+,i,y,w,r,v]).
problem(super_slam, l, [l,v,p,c,w,y,+,r,z,s,t]).

problem(super_nine, a, [i,l,y,s,v,p,c,z,r]).
problem(super_nine, b, [y,v,p,c,z,r,t,w,+]).
problem(super_nine, c, [i,l,s,v,p,z,r,t,+]).
problem(super_nine, d, [i,l,y,p,c,r,t,w,+]).
problem(super_nine, e, [i,s,v,p,c,z,r,t,w]).
problem(super_nine, f, [i,l,y,s,v,p,c,w,+]).
problem(super_nine, g, [i,y,s,p,c,z,r,t,+]).
problem(super_nine, h, [i,l,y,s,v,r,t,w,+]).
problem(super_nine, i, [l,y,s,v,c,z,r,t,+]).
problem(super_nine, j, [i,l,y,s,v,p,z,t,w]).
problem(super_nine, k, [i,l,v,p,c,z,t,w,+]).
problem(super_nine, l, [i,l,y,s,c,z,r,w,+]).

problem(challenge, 1, [i,l,y,p,c,w,+,t,v,r]).
problem(challenge, 2, [l,y,p,z,r,t,w,+,s,c]).
problem(challenge, 3, [i,l,s,v,c,z,t,y,r,p]).
problem(challenge, 4, [l,y,p,r,t,w,+,i,z,v]).
problem(challenge, 5, [i,y,s,v,c,r,w,l,p,+]).
problem(challenge, 6, [l,v,p,r,t,w,+,z,c,s]).
problem(challenge, 7, [y,s,p,c,z,r,t,v,+,i]).
problem(challenge, 8, [i,l,s,p,c,t,+,w,z,y]).
problem(challenge, 9, [i,v,p,c,z,r,w,s,y,l]).
problem(challenge, 10, [i,y,s,v,c,t,+,r,w,z]).
problem(challenge, 11, [i,l,s,p,z,t,w,r,+,c]).
problem(challenge, 12, [i,y,s,v,c,z,r,t,w,l]).
problem(challenge, 13, [l,y,v,c,z,r,w,+,i,s]).
problem(challenge, 14, [s,v,p,c,r,t,+,y,l,w]).
problem(challenge, 15, [i,l,y,v,c,r,w,p,z,+]).
problem(challenge, 16, [l,y,v,p,z,w,+,t,c,i]).
problem(challenge, 17, [i,y,p,c,z,t,w,s,v,r]).
problem(challenge, 18, [i,s,v,p,c,r,+,w,t,z]).
problem(challenge, 19, [l,s,p,z,r,t,w,v,+,y]).
problem(challenge, 20, [i,l,s,p,z,r,t,+,y,v]).
problem(challenge, 21, [i,s,v,p,c,z,t,+,l,w]).
problem(challenge, 22, [i,l,y,c,r,t,w,z,s,+]).
problem(challenge, 23, [y,s,v,p,z,r,t,w,+,c]).
problem(challenge, 24, [i,l,y,s,c,t,+,v,z,p]).
problem(challenge, 25, [i,y,s,v,p,r,w,+,t,z]).
problem(challenge, 26, [l,y,v,c,r,t,+,s,w,i]).
problem(challenge, 27, [i,l,y,p,c,z,w,+,r,t]).
problem(challenge, 28, [l,s,v,p,r,t,w,c,i,y]).
problem(challenge, 29, [i,l,v,p,c,z,+,r,w,s]).
problem(challenge, 30, [i,y,v,c,z,t,w,p,+,r]).
problem(challenge, 31, [l,y,s,p,r,t,w,+,i,z]).
problem(challenge, 32, [i,y,p,c,z,r,t,s,w,+]).
problem(challenge, 33, [l,y,s,v,p,z,w,+,r,i]).
problem(challenge, 34, [i,l,y,c,r,t,+,z,s,v]).
problem(challenge, 35, [i,y,s,v,c,t,w,p,+,r]).
problem(challenge, 36, [l,s,v,c,t,w,+,i,r,p]).
problem(challenge, 37, [i,l,p,c,r,t,w,z,v,y]).
problem(challenge, 38, [i,l,s,c,z,r,t,v,+,w]).
problem(challenge, 39, [l,y,s,v,c,r,+,w,z,t]).
problem(challenge, 40, [i,l,v,p,z,t,w,+,y,s]).

problem(full, set, [s,p,c,w,l,y,i,r,v,z,+,t]).


% Statistics

% Interface : ~ 15 LoC
% Solver    : ~ 20 LoC
% Tests     : ~ 30 LoC
% Shape data: ~ 70 LoC
% Problems  : ~110 LoC