Puzzle Solving

A fun application of graph traversal, specifically route finding, is using Prolog to solve puzzles.

An example of a puzzle written in kif is at Buttons and Lights.

For the start state in ButtonsAndLights generatemoves(Start, Children) produces

[ move([off(p), off(q), off(r), step(1)], does(robot, a), [on(p), off(q), off(r), step(2)], goal(robot, 0)),
  move([off(p), off(q), off(r), step(1)], does(robot, b), [off(p), off(q), off(r), step(2)], goal(robot, 0)),
  move([off(p), off(q), off(r), step(1)], does(robot, c), [off(p), off(q), off(r), step(2)], goal(robot, 0))
]

A thing to note above is actions b and c cycle back to the start state, only the step counter changing. To keep the problem space as skinny as possible, we need to rewrite our nocycle filter to strip steps out of states to make this clearer.

The basic template to solve puzzles is created by refactoring the code at PrunedIterativeDeepening. One of the differences is that instead of a graph of arc{Parent, Child) which was stored in lists as arc(Depth, Parent, Child), we’ll be using a 4 arity compound term move(Parent, Action, Child, Goal).

getchildren/2

This only gets called by depth_limit for unexpanded nodes, and it no longer needs to set the depth, so no longer needs that argument. The code is only slightly modified from that in HistoryFiltering.

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

== depthfirst/4 ==

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/3

The only change needed from the code in PrunedIterativeDeepening is an End is no longer provided, but defined by a state containing goal(Player, 100).

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

route/1

We no longer need to provide the start, since GDL figures that out from its init(Base) clauses, or an end since that’s one or more states valued goal(Player, 100).

Furthermore, instead of a list of nodes traversed from start to end, we want the string of actions (labels between the nodes).

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

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

route(Actions) :-
    findinits(Start),
    getchildren(Start, G1),
    removecycles(2, G1, G2),
    prune(2, G2, G3),
    iterative_deepening(2, G3, G4),
    member(move(_, _, End, goal(_, 100)), G4),
    getactions(Start, G4, [End], [], Actions).

Combining this all together, the final refactoring of the template PrunedIterativeDeepening looks like so:

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

remove_culdesacs([], Graph, Graph).
remove_culdesacs([move(Parent, _, _, _)|DeadEnds], GraphIn, Acc) :-
    findall(move(Grandparent, Action, Parent, Goal),
            (   member(move(Grandparent, Action, Parent, Goal), GraphIn),
                \+memberchk(move(Parent, _, _, _), GraphIn)
            ), Ps),
    subtract(GraphIn, Ps, GraphOut),
    append(Ps, DeadEnds, Unsorted),
    sort(Unsorted, NewDeadEnds),
    remove_culdesacs(NewDeadEnds, GraphOut, Acc).

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

childless(M, Graph, move(Parent, _, Child, _)) :-
    succ(N, M),
    member(step(N), Parent),
    \+memberchk(move(Child, _, _, _), Graph).

prune(Limit, Unpruned, Pruned) :-
    maplist(removestep, Unpruned, NoSteps),
    exclude(cycle(Limit, NoSteps), Unpruned, G1),
    exclude(deadleaf(Limit), G1, G2),
    partition(childless(Limit, G2), G2, Childless, G3),
    remove_culdesacs(Childless, G3, 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),
    member(move(_, _, End, goal(_, 100)), G3),
    getactions(Start, G3, [End], [], Actions).

wolf-goat-cabbage

This was my first attempt at illustrating graph traversal using an animated pgn. Instructions on how I did this below.

The animation is made out of 8 png files generated by graphviz’s dot as in dot -T png -o frame7.png frame7.dot. These then were combined into an animated png file using apngasm.

apngasm frame0.png frame1.png frame2.png frame3.png frame4.png frame5.png frame6.png frame7.png -d 1000 -o cgw.png

My main lesson from creating this diagram was utility values have direction, ie the utility of a node needs to be stored in the graph table with the parent and move, not just with the node itself. This is because the graph is full of cycles, and to avoid the automaton going back, the utility of going back to a node needs to be less than going forward.

buttons-and-lights

This is a simple example puzzle translated from a kif file into SWI Prolog. The full code is on Swish where the query route(Actions) gives two answers

Actions = [does(robot, a), does(robot, b), does(robot, c), does(robot, a), does(robot, b), does(robot, a)]
Actions = [does(robot, a), does(robot, b), does(robot, a), does(robot, c), does(robot, b), does(robot, a)]

The puzzle consists of three lights labeled p, q, and r, each of which can be on or off, giving us 8 possible states (provided we ignore the state’s step counter). The player moves from state to state by pressing one of three buttons, labelled a, b, or c and the object is to get to the final state with 6 button presses.