size(4).  % Maximum content of a tube
empty(2). % Number of empty tubes

% Tubes are given as ID-contents, where the the first color is the top one.
% In the case of a color of 2 or more units, it is written multiple times.
tubes([1-[blue,orange,cyan,indigo],
       2-[red,lime,yellow,purple],
       3-[purple,wheat,wheat,grey],
       4-[pink,orange,lime,green],
       5-[grey,cyan,pink,blue],
       6-[indigo,lime,wheat,yellow],
       7-[indigo,blue,purple,green],
       8-[indigo,lime,red,cyan],
       9-[cyan,wheat,purple,red],
       10-[red,green,pink,orange],
       11-[blue,yellow,yellow,grey],
       12-[pink,green,grey,orange],
       13-[],
       14-[]]).

% Another example, where there seems to be no solution with 2 empty tubes.
% tubes([1-[blue,indigo,orange,red],
%        2-[green,green,orange,yellow],
%        3-[green,wheat,grey,cyan],
%        4-[purple,pink,wheat,yellow],
%        5-[pink,red,indigo,orange],
%        6-[cyan,blue,indigo,lime],
%        7-[pink,purple,wheat,cyan],
%        8-[grey,blue,yellow,grey],
%        9-[pink,red,orange,yellow],
%        10-[lime,purple,purple,grey],
%        11-[cyan,red,lime,blue],
%        12-[wheat,lime,green,indigo],
%        13-[],
%        14-[]]).


%%%%%%%%%%%
% Program %
%%%%%%%%%%%

% top(Xs, Y, Ys, Zs)
%   Xs is the concatenation of Ys = [Y,Y,...] and Zs
top([], _, [], []) :- !.
top([Y|Xs], Y, [Y|C], Xs1) :- !, top(Xs, Y, C, Xs1).
top([X|Xs], Y, [], [X|Xs]) :- X \= Y.

% pour(Ts, I-J, Ts1)
%   Starting from Ts, Ts1 is the state after pouring from I into J
pour(Ts, I-J, [I-Ti1,J-Tj1|Ts2]) :-
    select(I-Ti, Ts, Ts1),
    Ti = [C0|_], top(Ti, C0, C, Ti1),
    select(J-Tj, Ts1, Ts2),
    ( Tj = [] -> Ti1 = [_|_] ; Tj = [C0|_] ),
    length(Tj, L), length(C, Lc),
    size(N), L + Lc =< N,
    append(C, Tj, Tj1).

one_color([]) :- !.
one_color([_]) :- !.
one_color([X,X|Xs]) :- one_color([X|Xs]).

% A tube is finished if it is full and of one color
finished(T) :- one_color(T), size(N), length(T, N).


%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Solver w/o optimization %
%%%%%%%%%%%%%%%%%%%%%%%%%%%

% solve(Tubes, [I-J|Acc], Steps) :-
%     member(J-T, Tubes), finished(T), !,
%     select(J-T, Tubes, Tubes1),
%     empty(E),
%     ( length(Tubes1, E) -> reverse([I-J|Acc], Steps)
%     ; solve(Tubes1, [I-J|Acc], Steps)
%     ).
% solve(Tubes, Acc, Steps) :-
%     pour(Tubes, Step, Tubes1),
%     solve(Tubes1, [Step|Acc], Steps).
%
% solve(Steps) :- tubes(Tubes), solve(Tubes, [], Steps).


%%%%%%%%%%%%%%%%%%%%
% Optimized solver %
%%%%%%%%%%%%%%%%%%%%

% Idea for optimization:
% Forbid starting tubes that could have been chosen earlier but were skipped

% forbidden(Xs, Y-Z, L)
%   L contains all indices in Xs before Y, except for Z
forbidden([Y-_|_], Y-_, []) :- !.
forbidden([Z-_|Xs], Y-Z, L) :- !, forbidden(Xs, Y-Z, L).
forbidden([X-_|Xs], Y-Z, [X|L]) :- X \= Y, X \= Z, forbidden(Xs, Y-Z, L).

solve(Tubes, Forbidden, [I-J|Acc], Steps) :-
    member(J-T, Tubes), finished(T), !,
    select(J-T, Tubes, Tubes1),
    empty(E),
    ( length(Tubes1, E) -> reverse([I-J|Acc], Steps)
    ; solve(Tubes1, Forbidden, [I-J|Acc], Steps)
    ).
solve(Tubes, Forbidden, Acc, Steps) :-
    pour(Tubes, I-J, Tubes1),
    ( member(I, Forbidden) -> fail
    ; forbidden(Tubes, I-J, Forbidden1)
    ),
    solve(Tubes1, Forbidden1, [I-J|Acc], Steps).

solve(Steps) :- tubes(Tubes), solve(Tubes, [], [], Steps).