ballsort.m

:- module ballsort.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module list, string, solutions, int.


/* Ball sort puzzle. */

:- type colors ---> green; gray; lightblue; turquoise; red; orange; blue; darkblue; purple; pink; yellow.
:- type jar ---> jar(int, list(colors)).
:- type move ---> move(string, list(jar)).


/* A solved jar contains four of a particular colour or are empty. */
:- pred correct(jar::in) is semidet.
correct(jar(_, [])).
correct(jar(_, [A,A,A,A])).

:- pred swap(jar::in, jar::in, jar::out, jar::out, string::out) is semidet.
/* Move a ball X from unsolved jar to an empty jar. */
swap(jar(N, [X|Y]), jar(M, []), jar(N, Y), jar(M, [X]), T) :-
    not(correct(jar(N, [X|Y]))),
    format("Move %s from jar %d to empty jar %d", [s(string(X)), i(N), i(M)], T).
    T = "Move " ++ string(X) ++ " from jar " ++ string(N) ++ " to empty jar " ++ string(M). */
swap(jar(N, [X|Y]), jar(M, [X|Z]), jar(N, Y), jar(M, [X, X|Z]), T) :-
    not(correct(jar(N, [X|Y]))),
    length(Z, Num),
    Num =< 2,
    format("Move %s from jar %d to jar %d", [s(string(X)), i(N), i(M)], T).


:- pred one_move(list(jar)::in, list(jar)::out, string::out) is nondet.
/* Move the game from state P to state S. */
one_move(P, S, Move) :-
    delete(P, J1, Q),
    delete(Q, J2, R),
    swap(J1, J2, N1, N2, Move),
    sort([N1,N2|R], S).


:- pred solution(list(jar)::in) is semidet.
solution([]).
solution([J|S]) :- correct(J), solution(S).


:- pred find_solution(list(jar)::in, list(jar)::out, list(list(jar))::in, list(string)::out) is nondet.
find_solution(A, A, _, _) :- solution(A).
find_solution(A, C, Visited, Moves) :-
	one_move(A, B, Move),
	not member(B, Visited),
	find_solution(B, C, [B|Visited], [Move|Moves]).


main(!IO) :-
    /* Start = [jar(1, [blue,red,blue,yellow]),
         jar(2, [red,red,yellow,blue]),
         jar(3, [yellow,yellow,blue,red]),
         jar(4, []),
         jar(5, [])
    ], */
    Start = [
        jar(1, [blue, blue, blue]),
        jar(2, [red, blue]),
        jar(3, [red, red, red]),
        jar(4, [])
    ],
    End = [
        jar(1, [blue, blue, blue, blue]),
        jar(2, []),
        jar(3, [red, red, red, red]),
        jar(4, [])
    ],
    /* find_solution(Start, _, [], Moves),
    write_string("Solution: ", !IO),
    write(Moves, !IO). */
    solutions(
        (pred(PP::out) is nondet :-
        /* one_move(A, PP, _) */
            find_solution(Start, _, [], PP)
        ),
        PPs
    ),
    (
        PPs = [],
        write_string("No solution\n", !IO)
        ;
        PPs = [_ | _],
        write_string("Solution is: ", !IO),
        write(PPs, !IO),
        nl(!IO)
    ).