My Diversions

Our last algorithm gave us a result much longer than the shortest possible. We can improve that by generating first all paths of length one, then two and so on, until we find one which reaches a goal state.

Bratko describes this on pages 248 and 249.

This version arrives at the optimal solution:

[[[c, a, b], [], []],
[[a, b], [c], []],
[[b], [a], [c]],
[[], [b, c], [a]],
[[], [a, b, c], []]]

As Bratko mentions in Exercise 11.3 this algorithm will loop indefinitely if there is no solution. I will try to implement a solution to 11.3 in Mercury — the Prolog version uses a cut, so that at least will need to be changed.

The iterative deepening code is again just a minor modification:

:- module stacks3.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is cc_multi.
:- implementation.
:- import_module list.
:- import_module bool.

/*
 * In Mercury we can use types to represent the problem domain -- a situation
 * is a number of stacks of blocks.
 */
:- type block ---> a; b; c; d.
:- type stack == list(block).
:- type situation == list(stack).
:- type solution == list(situation).

:- pred s(situation, situation).
:- mode s(in,out) is nondet.

/*
 * list.delete uses a different order of arguments to the del predicate
 * used by bratko: delete(List, Element, Remainder)
 */
s(Stacks, [Stack1, [Top1 | Stack2] | OtherStacks]) :-
    delete(Stacks, [Top1 | Stack1], Stacks1),
    delete(Stacks1, Stack2, OtherStacks).

:- pred goal(situation::in) is semidet.
goal(Situation) :-
    member([a,b,c], Situation).

:- pred solve(situation::in, solution::out) is nondet.
solve(Node, Solution) :-
    path(Node,GoalNode,Solution),
    goal(GoalNode).

:- pred path(situation::in, situation::out, solution::out) is nondet.
path(Node, Node, [Node]). % single node path
path(FirstNode, LastNode, [LastNode | Path]) :-
    path(FirstNode, OneButLast, Path),
    s(OneButLast, LastNode),
    not member(LastNode, Path).

/*
 * Note that the solution returned by solve starts with the final goal node, so
 * we reverse it before printing it.
 */
main(!IO) :-
    if solve([[c,a,b],[],[]],S) then
        reverse(S,S1), print(S1,!IO)
    else
        print("Failed\n",!IO).