Puzzle Solving

A fun application of GraphTraversal, specifically PathFinding, is using Prolog to solve puzzles.

A basic framework for representing games in Prolog has been provided by Stanford University's General Game Playing course. The notes for the course written by Michael Genesereth include A Brief Introduction to Basic Logic Programming. There are two dialects of Game Description Language, infix GDL which is nearly identical to Prolog, and a Lisp-like prefix GDL, called Knowledge Interchange Format , which is what the many examples provided at its public game repositories are written in.

An example of a puzzle written in kif is at Buttons and Lights and my translation into SWI-Prolog at ButtonsAndLights.

GDL uses semantics developed by Jacques Herbrand, explained by Genesereth in these notes which looks very much like Prolog. Every state in the game or puzzle is a set of true base propositions. The initial state for ButtonsAndLights looks like [off(p), off(q), off(r), step(1)], so we can find the depth from memberchk(step(Depth), Parent). We'll use the same convention for WolfGoatCabbage, TowerOfHanoi etc.

GDL

Looking at Chapter 2 of Genesereth's general game playing course, he uses the following naming convention for predicates:

Rules for puzzles and games written in GDL need to define most of the above (base(p) and input(r,a) are mainly used for Propositional Nets which we won't cover here). The above are easiest understood by looking at simple examples such as ButtonsAndLights and WolfGoatCabbage.

We'll mimic sets using sort(+List, -Sorted) after gathering what's currently true using findall(+Template, :Goal, -Bag). Sort ensures we don't get duplicate bases and the order is consistent for state equality (something that's easy in Prolog, but a real pain in languages where lists are stored as pointers).

I've written findinits(Start) like so, following a naming convention suggested by Genesereth in Chapter 4 of his notes.

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

In the case of ButtonsAndLights, that produces Start = [off(p), off(q), off(r), step(1)]

A convention followed by GDL is the base propositions in the current state are globally available to next(p), legal(r, a), goal(r, n), and terminal as true(p). To make that work, we need to declare :- dynamic true/1, does/2. at the top of our program.

To set the current state, we'll use:

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

next(p) rules typically expect the action the player selected to be globally available, so similarly we'll do this:

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

Usually, legal(r,a) rules would lookup true(p) to get its results. ButtonsAndLights is an exception in that robot can push buttons a, b, or c irrespective of what's true in the current state.

To get a list of what the controlling player can do in the current state, we'll use findlegals, again using the naming convention from Chapter 4. Since this is going to be used as a helper for generatemoves(Parent, Moves), it's assumed update_state(State) has been called before this is used.

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

In multiplayer games, Role would be obtained by a control(Player) base proposition in the current state. For puzzles, we can look up the name of the sole player from role(robot) in the case of ButtonsAndLights.

role(Player), findinits(Start), findlegals(Player, Start, Legals). produces Legals = [legal(robot, a), legal(robot, b), legal(robot, c)]

ButtonsAndLights has very many next(p) rules which illustrated the basics nicely. Looking at the first one:

next(on(p)) :- 
    does(robot, a), 
    true(off(p)).

Again following Chapter 4 conventions, we'll write a findnext(roles,move,state,game) rule, but rearranged to work with maplist:

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

The above assumes the state has already been set to true by findlegals to be used with maplist(:Goal, ?List1, ?List2) like so:

role(Player),
findinits(Start),
update_state(Start),
findlegals(Player, Legals),
maplist(findnext, Legals, Nexts)

This produces Nexts = [[off(q), off(r), on(p), step(2)], [off(p), off(q), off(r), step(2)], [off(p), off(q), off(r), step(2)]] for Legals = [legal(robot, a), legal(robot, b), legal(robot, c)].

The final rule we need for generatemoves(Parent, Moves) is to value each Next (ie child) node, which I'll call findreward to follow Genesereth's convention:

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

Tying this all to together for generatemoves(Parent, Moves):

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

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

PuzzleSolving (last edited 2021-09-22 12:27:53 by RobertLaing)