Wolf, goat and cabbage puzzle

For anyone unfamiliar with this old chestnut, it has its own Wikipedia entry, which shows it is part of a family called river crossing puzzles. Another member of this family is fox, goose, and bag of beans puzzle which is identical to wolf, goat and cabbage.

This puzzle is pretty much the same as the ButtonsAndLights, but is a little more complicated in that removing cycles alone doesn't entirely trim the problem space to the solution. Expanding prune to remove dead leaf nodes (losing terminals) as they appear helps neaten things up.

The code is at Swish.

:- dynamic true/1, does/2, move/4.

role(farmer).

init(left(cabbage)).
init(left(goat)).
init(left(wolf)).
init(left(farmer)).
init(step(1)).

legal(farmer, boat(cabbage)) :- true(left(farmer)), true(left(cabbage)).
legal(farmer, boat(cabbage)) :- true(right(farmer)), true(right(cabbage)).
legal(farmer, boat(goat))    :- true(left(farmer)), true(left(goat)).
legal(farmer, boat(goat))    :- true(right(farmer)), true(right(goat)).
legal(farmer, boat(wolf))    :- true(left(farmer)), true(left(wolf)).
legal(farmer, boat(wolf))    :- true(right(farmer)), true(right(wolf)).
legal(farmer, boat(empty)).

next(left(cabbage))  :- does(farmer, boat(cabbage)), true(right(cabbage)).
next(left(cabbage))  :- \+does(farmer, boat(cabbage)), true(left(cabbage)).
next(right(cabbage)) :- does(farmer, boat(cabbage)), true(left(cabbage)).
next(right(cabbage)) :- \+does(farmer, boat(cabbage)), true(right(cabbage)).
next(left(goat))     :- does(farmer, boat(goat)), true(right(goat)).
next(left(goat))     :- \+does(farmer, boat(goat)), true(left(goat)).
next(right(goat))    :- does(farmer, boat(goat)), true(left(goat)).
next(right(goat))    :- \+does(farmer, boat(goat)), true(right(goat)).
next(left(wolf))     :- does(farmer, boat(wolf)), true(right(wolf)).
next(left(wolf))     :- \+does(farmer, boat(wolf)), true(left(wolf)).
next(right(wolf))    :- does(farmer, boat(wolf)), true(left(wolf)).
next(right(wolf))    :- \+does(farmer, boat(wolf)), true(right(wolf)).
next(left(farmer))   :- true(right(farmer)).
next(right(farmer))  :- true(left(farmer)).
next(step(Y)) :- 
    true(step(X)), 
    succ(X, Y).

goal(farmer, 100) :- true(right(cabbage)), true(right(goat)), true(right(wolf)), true(right(farmer)), !.
goal(farmer, 0)   :- true(left(cabbage)), true(left(goat)), true(right(farmer)), !.
goal(farmer, 0)   :- true(left(wolf)), true(left(goat)), true(right(farmer)), !.
goal(farmer, 0)   :- true(right(cabbage)), true(right(goat)), true(left(farmer)), !.
goal(farmer, 0)   :- true(right(wolf)), true(right(goat)), true(left(farmer)), !.
goal(farmer, 50).

terminal :- goal(farmer, 100).
terminal :- goal(farmer, 0).

Excluding step(N) in states, the full problem space looks like so:

wgc0.svg

The above state space is similar to ButtonsAndLights in that there are lots of cycles, and perhaps the rule in Buttons And Lights that causes repeating the same action twice to cycle back to the previous state comes from an adaption of this Wolf, Goat, and Cabbage.

The graph generated after cycles are removed looks like this:

wgc1.svg

Where our generate and prune strategy can be refined is that there are lots of dead leaves here, of which there were none in Buttons and Lights. For instance, from the starting state the farmer has four choices -- cross the river with no cargo (empty), or take the wolf, goat, or cabbage. Of these, only taking the goat avoids instant defeat.

Dead Leaf Filter

To strip these terminals from the search space, we turn to exclude(:Goal, +List1, ?List2) and the filter we use to check if a freshly generated child node is a losing dead end looks like so:

removestep(move(Parent, _, _, _), NoStep) :-
    select(step(_), Parent, NoStep).

deadleaf(Limit, move(Parent, _, Child, goal(_, Value))) :-
    member(step(Limit), Parent),
    Value < 100,
    update_state(Child),
    terminal.

cycle(Limit, NoSteps, move(Parent, _, Child, _)) :-
    member(step(Limit), Parent),
    select(step(_), Child, NoStep),
    memberchk(NoStep, NoSteps).

deadstate(Limit, NoSteps, move(Parent, _, Child, goal(_, Value))) :-
    deadleaf(Limit, move(Parent, _, Child, goal(_, Value)))
    ;
    cycle(Limit, NoSteps, move(Parent, _, Child, _)).

prune(Limit, Unpruned, Pruned) :-
    maplist(removestep, Unpruned, NoSteps),
    exclude(deadstate(Limit, NoSteps), Unpruned, Pruned).

In this puzzle, pruning these doesn't leave previously generated nodes dangling childless, ripe for further pruning. We'll add that refinement in the water bucket puzzle next.

Our search space now looks like this:

wgc2.svg

This refactors the code in ButtonsAndLights to this:

:- dynamic true/1, does/2.

role(farmer).

init(left(cabbage)).
init(left(goat)).
init(left(wolf)).
init(left(farmer)).
init(step(1)).

legal(farmer, boat(cabbage)) :- true(left(farmer)), true(left(cabbage)).
legal(farmer, boat(cabbage)) :- true(right(farmer)), true(right(cabbage)).
legal(farmer, boat(goat))    :- true(left(farmer)), true(left(goat)).
legal(farmer, boat(goat))    :- true(right(farmer)), true(right(goat)).
legal(farmer, boat(wolf))    :- true(left(farmer)), true(left(wolf)).
legal(farmer, boat(wolf))    :- true(right(farmer)), true(right(wolf)).
legal(farmer, boat(empty)).

next(left(cabbage))  :- does(farmer, boat(cabbage)), true(right(cabbage)).
next(left(cabbage))  :- \+does(farmer, boat(cabbage)), true(left(cabbage)).
next(right(cabbage)) :- does(farmer, boat(cabbage)), true(left(cabbage)).
next(right(cabbage)) :- \+does(farmer, boat(cabbage)), true(right(cabbage)).
next(left(goat))     :- does(farmer, boat(goat)), true(right(goat)).
next(left(goat))     :- \+does(farmer, boat(goat)), true(left(goat)).
next(right(goat))    :- does(farmer, boat(goat)), true(left(goat)).
next(right(goat))    :- \+does(farmer, boat(goat)), true(right(goat)).
next(left(wolf))     :- does(farmer, boat(wolf)), true(right(wolf)).
next(left(wolf))     :- \+does(farmer, boat(wolf)), true(left(wolf)).
next(right(wolf))    :- does(farmer, boat(wolf)), true(left(wolf)).
next(right(wolf))    :- \+does(farmer, boat(wolf)), true(right(wolf)).
next(left(farmer))   :- true(right(farmer)).
next(right(farmer))  :- true(left(farmer)).
next(step(Y)) :- 
    true(step(X)), 
    succ(X, Y).

goal(farmer, 100) :- true(right(cabbage)), true(right(goat)), true(right(wolf)), true(right(farmer)), !.
goal(farmer, 0)   :- true(left(cabbage)), true(left(goat)), true(right(farmer)), !.
goal(farmer, 0)   :- true(left(wolf)), true(left(goat)), true(right(farmer)), !.
goal(farmer, 0)   :- true(right(cabbage)), true(right(goat)), true(left(farmer)), !.
goal(farmer, 0)   :- true(right(wolf)), true(right(goat)), true(left(farmer)), !.
goal(farmer, 50).

terminal :- goal(farmer, 100).
terminal :- goal(farmer, 0).

findinits(Start) :-
  findall(Base, init(Base), Unsorted),
  sort(Unsorted, Start).

update_state(State) :-
  retractall(true(_)), 
  forall(member(Base, State), assertz(true(Base))).

update_does(Player, Action) :-
  retractall(does(Player, _)), 
  assertz(does(Player, Action)).

findlegals(Role, Legals) :-
    findall(legal(Role, Action), legal(Role, Action), Unsorted),
    sort(Unsorted, Legals).

findnext(legal(Role, Action), Next) :-
    update_does(Role, Action),
    findall(Base, next(Base), Unsorted),
    sort(Unsorted, Next).

findreward(Role, State, goal(Role, Reward)) :-
    update_state(State),
    goal(Role, Reward).

combinelists(_, [], [], [], []).
combinelists(State, [legal(Player, Action)|Legals], [Next|Nexts], [Goal|Goals],
             [move(State, does(Player, Action), Next, Goal)|Moves]) :-
    combinelists(State, Legals, Nexts, Goals, Moves).

generatemoves_(_, []) :-
    terminal.

generatemoves_(Parent, Moves) :-
    \+terminal,
    role(Player),
    findlegals(Player, Legals),
    maplist(findnext, Legals, Nexts),
    maplist(findreward(Player), Nexts, Rewards),
    combinelists(Parent, Legals, Nexts, Rewards, Moves).

generatemoves(Parent, Moves) :-
    update_state(Parent),
    generatemoves_(Parent, Moves), !.

removestep(move(Parent, _, _, _), NoStep) :-
    select(step(_), Parent, NoStep).

deadleaf(Limit, move(Parent, _, Child, goal(_, Value))) :-
    member(step(Limit), Parent),
    Value < 100,
    update_state(Child),
    terminal.

cycle(Limit, NoSteps, move(Parent, _, Child, _)) :-
    member(step(Limit), Parent),
    select(step(_), Child, NoStep),
    memberchk(NoStep, NoSteps).

prune(Limit, Unpruned, Pruned) :-
    maplist(removestep, Unpruned, NoSteps),
    exclude(deadstate(Limit, NoSteps), Unpruned, Pruned).

getchildren(Parent, Visited, Children) :-
    generatemoves(Parent, Moves),
    findall(Move, 
            (member(Move, Moves), \+memberchk(Move, Visited)), 
            NoDuplicates),  
    sort(NoDuplicates, Children).

depthfirst(_, [], RGraph, Graph) :-
    reverse(RGraph, Graph).

depthfirst(Limit, [move(Parent, Action, Child, Goal)|Frontier], Visited, Acc) :-
    memberchk(step(Depth), Child),
    Depth \== Limit,
    depthfirst(Limit, Frontier, [move(Parent, Action, Child, Goal)|Visited], Acc).

depthfirst(Limit, [move(Parent, Action, Child, Goal)|Frontier], Visited, Acc) :-
    memberchk(step(Limit), Child),
    getchildren(Child, Visited, GrandChildren),
    append(GrandChildren, Frontier, NewFrontier),
    depthfirst(Limit, NewFrontier, 
               [move(Parent, Action, Child, Goal)|Visited], Acc).

iterative_deepening(_, Graph, Graph) :-
    memberchk(move(_, _, _, goal(_, 100)), Graph).

iterative_deepening(Depth, GraphIn, Acc) :-
    \+memberchk(move(_, _, _, goal(_, 100)), GraphIn),
    depthfirst(Depth, GraphIn, [], Unpruned),
    Unpruned \== GraphIn,
    prune(Depth, Unpruned, GraphOut),
    succ(Depth, Limit),
    iterative_deepening(Limit, GraphOut, Acc).

getactions(Start, Graph, [Node|_], Actions, [Action|Actions]) :-
    member(move(Start, Action, Node, _), Graph).

getactions(Start, Graph, [Child|Path], Actions, Acc) :-
    member(move(Parent, Action, Child, _), Graph),
    Parent \== Start,
    getactions(Start, Graph, [Parent, Child|Path], [Action|Actions], Acc).

route(Actions) :-
    findinits(Start),
    getchildren(Start, [], G1),
    prune(1, G1, G2),
    iterative_deepening(2, G2, G3),
    format("~w~n", [G3]),
    member(move(_, _, End, goal(_, 100)), G3),
    getactions(Start, G3, [End], [], Actions).

WolfGoatCabbage (last edited 2021-09-25 08:48:53 by RobertLaing)