Frontier Software

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.

I encountered a snag in my code with connectFourSimultaneous.kif which has a comment inside a statement. I found it easier to edit the kif file, but I should modify the above script to handle those cases sometime.

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:

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

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

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.