Puzzle Solving
A fun application of graph traversal, specifically route finding, 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.
I wrote the following Prolog script to automate fetching games rules written in kif and translating them to prolog:
#!/usr/bin/env swipl
:- use_module(library(http/http_open)).
:- use_module(library(dcg/basics)).
:- initialization(main, main).
main(Argv) :-
last(Argv, Url),
setup_call_cleanup(
http_open(Url, Stream, []),
phrase_from_stream(lines(_Lines), Stream),
close(Stream)
).
lines([Line|Lines]) --> line(Line), !, lines(Lines).
lines([]) --> [].
line(Comment) --> comment(Cs), { string_codes(Comment, Cs), format('~w~n', [Comment]) }, !.
line(Whitespace) --> whitespace(Cs), { string_codes(Whitespace, Cs), format('~w', [Whitespace]) }, !.
line(Sexp) --> "(", s_expression(Sexp), ")", { format('~w.', [Sexp]) }.
s_expression(Sexp) --> blanks, term(Operator), blanks, terms(Args), { sexp(Operator, Args, Sexp) }.
sexp('<=', [Head|List], Sexp) :- !,
comma_list(Body,List),
Sexp =.. [':-',Head,Body].
sexp('not', Args, Sexp) :- !,
Sexp =.. ['\\+'|Args].
sexp('or', Args, SemicolonList) :- !,
semicolon_list(SemicolonList, Args).
sexp('distinct', Args, Sexp) :- !,
Sexp =.. ['\\='|Args].
sexp(Operator, Args, Sexp) :-
Sexp =.. [Operator|Args].
terms([Term|Terms]) --> blanks, term(Term), blanks, !, terms(Terms).
terms([]) --> [].
term(Sexp) --> "(", s_expression(Sexp), ")".
term(Variable) --> variable(Cs), { string_codes(Variable, Cs) }.
term(Symbol) --> symbol(Cs), { atom_codes(Symbol, Cs) }.
variable([U|Cs]) --> [63,L], { to_upper(L, U) }, symbol_rest(Cs).
symbol([C|Cs]) --> [C], { code_type(C, graph), string_codes("?();", Codes), \+ memberchk(C, Codes) }, symbol_rest(Cs).
symbol_rest([C|Cs]) --> [C], { code_type(C, graph), string_codes("();", Codes), \+ memberchk(C, Codes) }, symbol_rest(Cs).
symbol_rest([]) --> [].
comment([37|Cs]) --> ";", comment_rest(Cs).
comment_rest([37|Cs]) --> ";", comment_rest(Cs).
comment_rest([C|Cs]) --> [C], { \+ code_type(C, end_of_line) }, comment_rest(Cs).
comment_rest([]) --> [C], { code_type(C, end_of_line) }.
whitespace([C|Cs]) --> [C], { code_type(C, space) }, whitespace_rest(Cs).
whitespace_rest([]) --> [], !.
whitespace_rest([C|Cs]) --> [C], { code_type(C, space) }, whitespace_rest(Cs).
Then running say
./kif2prolog.pl http://games.ggp.org/base/games/buttons/buttons.kif > buttons.pl
would create a working Prolog file, though not pretty printed and also needing underscores for variables that aren’t used on the right-hand-side of rules.
GDL
GDL uses semantics developed by Jacques Herbrand, explained by Genesereth in these notes which looks very much like Prolog. The alternative is Tarskian semantics which I can’t claim to have studied.
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.
Looking at Chapter 2 of Genesereth’s general game playing course, he uses the following naming convention for predicates:
role(r)means thatris a role in the game.base(p)means thatpis a base proposition in the game.input(r,a)means thatais a feasible action for roler.init(p)means that the propositionpis true in the initial state.true(p)means that the propositionpis true in the current state.does(r,a)means that rolerperforms actionain the current state.next(p)means that the propositionpis true in the next state.legal(r,a)means it is legal for rolerto play actionain the current state.goal(r,n)means that player the current state has utilitynfor playerr.terminalmeans that the current state is a terminal state.
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 [[https://www.swi-prolog.org/pldoc/doc_for?object=sort/2|sort(+List, -Sorted)]] after gathering what’s currently true using [[https://www.swi-prolog.org/pldoc/doc_for?object=findall/3|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 [[http://ggp.stanford.edu/notes/chapter_04.html|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 [[http://ggp.stanford.edu/notes/chapter_04.html|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 [[http://ggp.stanford.edu/notes/chapter_04.html|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 [[https://www.swi-prolog.org/pldoc/doc_for?object=maplist/3|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).