My Diversions » Mercury

Escape from Zurg

Tom Davies — Sun, 02 Sep 2007 10:05:55 +0000

This Lambda the Ultimate post links to a paper which compares writing a search algorithm in Prolog and Haskell, and notes that Haskell’s strong typing makes the task easier. While the paper mentions several embeddings of logic programming into functional languages it doesn’t mention Mercury.

I was able to easily create successor and goal predicates for this problem which work with the breadth first searching predicate I wrote earlier. Note that there is one significant shortcoming in my implementation — because I use lists where I should be using sets in the representation of nodes in my search space, nodes which should be equal are not, so the search takes far longer than it should. But it makes the point that Mercury’s discriminated unions and type system give a Prolog-like language the same benefit which Haskell’s type system gives a functional one.

The code for the solve client follows:

:- module escape.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is cc_multi.
:- implementation.
:- import_module solve.
:- import_module list.
:- import_module int.

:- type actor ---> buzz; woody; rex; hamm.
:- type torchPos ---> left; right.
:- type escapeState ---> escapeState(inZurg :: list(actor), crossed :: list(actor), batteryCharge :: int, torch :: torchPos).
:- pred s `with_type` succ_pred(escapeState) `with_inst` succ_pred.
s(escapeState(In1, Out1, Charge1, left), escapeState(In2, [C1, C2 | Out1],Charge2, right)) :-
    delete(In1, C1, In1WithoutC1),
    delete(In1WithoutC1, C2, In2),
    cost(C1,C1Cost),
    cost(C2,C2Cost),
    Cost = int.max(C1Cost,C2Cost),
    Charge2 = int.minus(Charge1,Cost),
    Charge2 >= 0.

s(escapeState(In1, Out1, Charge1, right), escapeState([C1 | In1], Out2,Charge2,left)) :-
        delete(Out1, C1, Out2),
        cost(C1,Cost),
        Charge2 = int.minus(Charge1,Cost),
        Charge2 >= 0.

:- pred cost(actor::in, int::out) is det.
cost(buzz, 5).
cost(woody, 10).
cost(rex, 20).
cost(hamm, 25).


:- pred goal `with_type` goal_pred(escapeState) `with_inst` goal_pred.
goal(escapeState([],_,_,right)).

main(!IO) :-
    if solve(s,goal,escapeState([buzz,woody,rex,hamm],[],60,left),S) then
        reverse(S,S1), print(S1,!IO)
    else
        print("Failed\n",!IO).

A Generic ’solve’ Predicate

Tom Davies — Tue, 28 Aug 2007 10:22:45 +0000

The examples of state space searching described previously have all been tailored to a particular problem — the algorithms have been general, but the implementation has included type signatures specific to the problem, e.g.:

:- type block ---> a; b; c.
:- type stack == list(block).
:- type situation == list(stack).
:- type solution == list(situation).
:- pred solve(situation::in, solution::out) is nondet.

It would be convenient if we could write a ’solve’ predicate which would work with any problem, stated correctly.

To do this we will parameterise ’solve’ by the type of the nodes in the state space (i.e. block in the example above), and make the predicates which define our goal and produce our successors into parameters passed to ’solve’.

This gives us the Mercury interface:

:- interface.
:- import_module list.

    /* the type of the successor predicate to be used by the solve predicate */
:- type succ_pred(T) == pred(T, T).
:- inst succ_pred == (pred(in,out) is nondet).
:- mode succ_pred_in == in(succ_pred).
    /* the type of the goal predicate to be used by the solve predicate */
:- type goal_pred(T) == pred(T).
:- inst goal_pred == (pred(in) is semidet).
:- mode goal_pred_in == in(goal_pred).

:- pred solve(succ_pred(T)::succ_pred_in, goal_pred(T)::goal_pred_in, T::in, list(T)::out) is nondet.

And our predicates for searching for a path in a directed graph are defined like this:

:- type node ---> a; b; c; d; e; f; g.
:- pred s `with_type` succ_pred(node) `with_inst` succ_pred.
s(a,b).
...
s(e,g).

:- pred goal `with_type` goal_pred(node) `with_inst` goal_pred.
goal(Situation) :-
    Situation = g.

The complete source code for the two modules is below the fold.

:- module solve.
:- interface.
:- import_module list.

:- type succ_pred(T) == pred(T, T).
:- inst succ_pred == (pred(in,out) is nondet).
:- mode succ_pred_in == in(succ_pred).

:- type goal_pred(T) == pred(T).
:- inst goal_pred == (pred(in) is semidet).
:- mode goal_pred_in == in(goal_pred).

:- pred solve(succ_pred(T)::succ_pred_in, goal_pred(T)::goal_pred_in, T::in, list(T)::out) is nondet.

:- implementation.
:- import_module solutions.
:- import_module io.

solve(Succ, Goal, Start, Solution) :-
    breadthfirst(Succ, Goal, [[Start]], Solution). 

:- pred breadthfirst(succ_pred(T)::succ_pred_in, goal_pred(T)::goal_pred_in, list(list(T))::in, list(T)::out) is nondet.
breadthfirst(_, Goal, [[Node | Path] | _], [Node | Path]) :-
    call(Goal,Node).

breadthfirst(Succ, Goal, [Path | Paths], Solution) :-
    trace [io(!IO)] (io.write_list([Path | Paths], "---\n", io.print, !IO),
        io.nl(!IO)),
    extend(Succ, Path, NewPaths),
    append(Paths, NewPaths, Paths1),
    breadthfirst(Succ, Goal, Paths1, Solution).

:- pred extend(succ_pred(T)::succ_pred_in,list(T)::in,list(list(T))::out) is semidet.
extend(Succ, [Node | Path], NewPaths) :-
    solutions(
        pred(X::out) is nondet :- 
        (
            X = [NewNode, Node | Path],
            call(Succ, Node, NewNode),
            not member(NewNode, [Node | Path])
        ),
        NewPaths).

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

:- type node ---> a; b; c; d; e; f; g.
:- pred s `with_type` succ_pred(node) `with_inst` succ_pred.
s(a,b).
s(a,c).
s(b,d).
s(b,e).
s(d,f).
s(e,g).

:- pred goal `with_type` goal_pred(node) `with_inst` goal_pred.
goal(Situation) :-
    Situation = g.

main(!IO) :-
    if solve(s,goal,a,S) then
        reverse(S,S1), print(S1,!IO)
    else
        print("Failed\n",!IO).

Breadth First Search

Tom Davies — Sun, 26 Aug 2007 08:34:42 +0000

One disadvantage of the depth first search with iterative deepening is that it regenerates all the search paths from the start node every iteration. A true breadth first search, as described by Bratko on pages 250-252 doesn’t need to do that — it can start with a short search path (just the start node in fact) and then extend the current paths by one node each iteration. This trades space for time, as it needs to keep all the current candidate paths in memory.

The algorithm is applied to the same block domain as in our previous examples. Note that we use the Mercury trace goal to print the sets of paths as they are generated:

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

/*
 * 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(Start, Solution) :-
    breadthfirst([[Start]], Solution).

:- pred breadthfirst(list(solution)::in, solution::out) is nondet.
breadthfirst([[Node | Path] | _], [Node | Path]) :-
    goal(Node).
breadthfirst([Path | Paths], Solution) :-
    trace [io(!IO)] (io.write_list([Path | Paths], "---\n", io.print, !IO),
        io.nl(!IO)),
    extend(Path, NewPaths),
    append(Paths, NewPaths, Paths1),
    breadthfirst(Paths1, Solution).

:- pred extend(solution::in,list(solution)::out) is nondet.
extend([Node | Path], NewPaths) :-
    solutions(
        pred(X::out) is nondet :- 
        (
            X = [NewNode, Node | Path],
            s(Node, NewNode),
            not member(NewNode, [Node | Path])
        ),
        NewPaths).

/*
 * 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).

Depth First Search in Mercury—with Iterative Deepening

Tom Davies — Wed, 22 Aug 2007 14:15:10 +0000

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).

Depth First Search in Mercury—with Cycle Detection

Tom Davies — Wed, 22 Aug 2007 14:06:02 +0000

The algorithm implemented in my previous post pays no attention to the nodes in the search space already visited, so if the situation [[c,a,b],[],[]] is used as the starting point an infinite recursion will result, as the successor function starts to traverse a cycle in the state space graph before it finds a goal node.

On pages 246 and 247 (figure 11.7) Bratko adds cycle detection:

We can now solve [[c,a,b],[],[]], but note that the solution is not very efficient:

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

The algorithm doesn’t recognise that the nodes [[b], [a, c], []] and [[a, c], [b], []], for example, are equivalent.

The code has only minor changes:

:- module stacks2.
:- 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.
:- 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) :-
    depthfirst([],Node,Solution).

:- pred depthfirst(solution::in, situation::in, solution::out) is nondet.
depthfirst(Path, Node, [Node | Path]) :- goal(Node).
depthfirst(Path, Node, Sol) :-
    s(Node, Node1),
    not member(Node1, Path),
    depthfirst([Node | Path], Node1, Sol).
/*
 * 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).

Depth First Search in Mercury

Tom Davies — Wed, 22 Aug 2007 13:23:50 +0000

I’m working through Bratko’s “Prolog Programming for Artificial Intelligence” rewriting the examples in Mercury.This series of posts will be my notes on the changes I needed to make to make these programs work.Page 243-244, defining successor states for stacks of blocks and performing a depth first search. Note that it’s a naive depth first search assuming no cycles.


:- module stacks.
:- 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.
:- 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(N, [N]) :- goal(N).
solve(N, [N | Sol1]) :-
    s(N, N1),
    solve(N1, Sol1).

main(!IO) :-
    if solve([[c,b,a],[],[]],S) then
        print(S,!IO)
    else
        print("Failed\n",!IO).