<div class="notebook">
<div class="nb-cell markdown" name="md1">
# Graph Traversal for Problem Solving
_Robert Laing_
In this tutorial, I'm developing a general framework to solve puzzles and games. Though I've done quite a few online courses on game theory from both computer science and economics perspectives, I only really grasped the concepts by grinding away at the code below.
Please post any suggestions for improvements to a thread I started at <https://swi-prolog.discourse.group/t/graph-traversal-for-problem-solving-tutorial>.
The idea is to make the puzzles below, along with the games which follow, all share the same library of predicates. The basic idea comes from [Stanford University's General Game Playing](http://ggp.stanford.edu/public/notes.php) course.
I've covered the three methods of graph traversal commonly presented in textbooks: depth first, breadth first, and iterative deepening.
Here is a quick executive summary of these three graph traversal methods:
1. [Depth first](https://en.wikipedia.org/wiki/Depth-first_search) has a tendency to either return long-winded answers or hang the computer by going into endless cycles.
2. [Breadth first](https://en.wikipedia.org/wiki/Breadth-first_search) returns the most efficient answer, on the rare occasion it doesn't consume all available memory first, resulting in the dreaded _stack overflow_ error message.
3. [Iterative deepening](https://en.wikipedia.org/wiki/Iterative_deepening_depth-first_search) is left as the only practical option for large game trees, and it tends to be fairly competitive despite all the extra work -- assuming the heuristic for alpha-beta pruning is finely tuned, something I'm really battling with.
</div>
<div class="nb-cell program" data-background="true" name="p2">
%%% General Game Player library
% move(Value, Parent, Label, Child).
%% solve_dfs(-Moves) is nondet
% Returns a list of does(Player, Move) clauses in sequence to
% solve the puzzle using depth first search
solve_dfs(Moves) :-
findinit(Start),
heuristic(Start, Rewards), % Assuming start not terminal
depthfirst([move(Rewards, start, noop, Start)], [], Tree),
start_to_end(Tree, Moves), !.
depthfirst([], Tree, Tree).
depthfirst([move(Rewards, Parent, Label, Child)|Frontier], Acc, Tree) :-
new_nodes(move(Rewards, Parent, Label, Child), Acc, AccOut, Children),
append(Children, Frontier, NewFrontier),
depthfirst(NewFrontier, AccOut, Tree).
%% solve_bfs(-Moves) is nondet
% Returns a list of does(Player, Move) clauses in sequence to
% solve the puzzle using breadth first search
solve_bfs(Moves) :-
findinit(Start),
heuristic(Start, Rewards), % Assuming start not terminal
breadthfirst([move(Rewards, start, noop, Start)], [], Tree),
start_to_end(Tree, Moves), !.
breadthfirst([], Tree, Tree).
breadthfirst([move(Rewards, Parent, Label, Child)|Frontier], Acc, Tree) :-
new_nodes(move(Rewards, Parent, Label, Child), Acc, AccOut, Children),
append(Frontier, Children, NewFrontier),
breadthfirst(NewFrontier, AccOut, Tree).
%% solve_ids(-Moves) is nondet
% Uses iterative deepening to solve larger game trees
solve_ids(Moves) :-
findinit(Start),
member(step(Limit), Start),
heuristic(Start, Rewards), % Assuming start not terminal
iterative_deepening(Limit, [move(Rewards, start, noop, Start)], [], Tree),
start_to_end(Tree, Moves), !.
iterative_deepening(Limit, [move(AlphaBeta, start, noop, Start)], TreeIn, Tree) :-
% format('AlphaBeta: ~w~n', [AlphaBeta]),
( member(control(Player), Start) ; role(Player) ),
( member(goal(Player, 100), AlphaBeta)
-> Tree = TreeIn % Puzzle solved or game won
; LimitInc is Limit + 1,
depthlimited(LimitInc, [move(AlphaBeta, start, noop, Start)], TreeIn, TreeOut),
( TreeIn == TreeOut % equilibrium reached, pointless continuing
-> Tree = TreeOut
; member(move(NewAlphaBeta, start, noop, Start), TreeOut),
iterative_deepening(LimitInc, [move(NewAlphaBeta, start, noop, Start)], TreeOut, Tree)
)
).
depthlimited(_, [], Tree, Tree).
% Limit reached, no new nodes added to Frontier
depthlimited(Maxdepth, [move(Rewards, Parent, Label, Child)|Frontier], Acc, Tree) :-
member(step(Maxdepth), Child), !,
( visited(Acc, move(Rewards, Parent, Label, Child))
-> AccOut = Acc
; backward_induction([move(Rewards, Parent, Label, Child)], [move(Rewards, Parent, Label, Child)|Acc], AccOut)
),
depthlimited(Maxdepth, Frontier, AccOut, Tree).
% Either fresh child nodes need to be generated or old ones found in tree
depthlimited(Maxdepth, [move(Rewards, Parent, Label, Child)|Frontier], Acc, Tree) :-
member(step(N), Child),
N < Maxdepth,
( visited(Acc, move(Rewards, Parent, Label, Child))
-> AccOut = Acc,
include(children_filter(move(Rewards, Parent, Label, Child)), Acc, Unpruned),
( length(Unpruned, 0)
-> generate_children(Child, Unsorted),
sort_generated_children(Unsorted, Children)
; include(alpha_beta_test(Acc), Unpruned, Unsorted),
sort_old_children(Unsorted, Children)
)
; backward_induction([move(Rewards, Parent, Label, Child)], [move(Rewards, Parent, Label, Child)|Acc], AccOut),
( alpha_beta_test(AccOut, move(Rewards, Parent, Label, Child))
-> generate_children(Child, Unsorted),
sort_generated_children(Unsorted, Children)
; Children = []
)
),
append(Children, Frontier, NewFrontier),
depthlimited(Maxdepth, NewFrontier, AccOut, Tree).
%% Common predicates
%% new_nodes(+Move, +AccIn, -AccOut, -Children) is det
% clauses common to both depth first and breadth first searches.
new_nodes(move(Rewards, Parent, Label, Child), Acc, AccOut, Children) :-
( visited(Acc, move(Rewards, Parent, Label, Child))
-> ( member(move(Rewards, Parent, Label, Child), Acc) % Can be different path to existing node
-> AccOut = Acc
; backward_induction([move(Rewards, Parent, Label, Child)], [move(Rewards, Parent, Label, Child)|Acc], AccOut)
),
Children = []
; backward_induction([move(Rewards, Parent, Label, Child)], [move(Rewards, Parent, Label, Child)|Acc], AccOut),
( alpha_beta_test(AccOut, move(Rewards, Parent, Label, Child))
-> generate_children(Child, Unsorted),
sort_generated_children(Unsorted, Children)
; Children = []
)
).
update_state(State) :-
retractall(true(_)),
forall(member(Proposition, State), assertz(true(Proposition))).
findinit(Start) :-
setof(Init, init(Init), Start).
getnext(Parent, does(Player, Move), child(Parent, does(Player, Move), Child)) :-
retractall(does(_,_)),
assertz(does(Player, Move)),
setof(Next, next(Next), Child).
generate_children(Parent, Children) :-
update_state(Parent),
( \+terminal
-> ( true(control(Player)) ; role(Player) ),
( setof(does(Player, Move), legal(Player, Move), Legals)
-> maplist(getnext(Parent), Legals, Children)
; Children = []
)
; Children = []
).
sort_generated_children([], []).
sort_generated_children(ChildrenIn, ChildrenOut) :-
value_generated_children(ChildrenIn, WithZeros),
exclude(zeros, WithZeros, Unsorted), % Assume only losing terminals have zero
sort(1, >=, Unsorted, Sorted),
maplist(strip_value, Sorted, ChildrenOut).
value_generated_children([], []).
value_generated_children([child(Parent, Label, Child)|ChildrenIn], [vm(Value, move(Rewards, Parent, Label, Child))|ChildrenOut]) :-
update_state(Child),
( \+terminal
-> heuristic(Child, Rewards1),
( Rewards1 == 0 % Heuristic may not be zero, or will get pruned
-> Rewards = 1
; Rewards = Rewards1
)
; setof(goal(Role, Reward), goal(Role, Reward), Rewards)
),
( member(control(Player), Parent) ; role(Player) ),
member(goal(Player, Value), Rewards),
value_generated_children(ChildrenIn, ChildrenOut).
%% sort_old_children(ChildrenIn, ChildrenOut) is det
% Used with iterative deepening to put nodes from the tree in order before stacking on Frontier
sort_old_children([], []).
sort_old_children([move(Rewards, Parent, Label, Child)|Moves], Children) :-
( member(control(Player), Parent) ; role(Player) ),
maplist(player_value(Player), [move(Rewards, Parent, Label, Child)|Moves], Unsorted),
sort(1, >=, Unsorted, Sorted),
maplist(strip_value, Sorted, Children).
player_value(Player, move(Rewards, Parent, Label, Child), vm(Value, move(Rewards, Parent, Label, Child))) :-
member(goal(Player, Value), Rewards).
zeros(vm(0, _)).
strip_value(vm(_, Move), Move).
%% alpha_beta_test(+NewNode, +Tree) is det
% True if node is worth expanding
% Essentially only looks at zeros and hundreds since heuristic values too flakey
alpha_beta_test(Tree, move(Rewards, Parent, _Label, _Child)) :-
( member(control(Player), Parent) ; role(Player) ),
member(goal(Player, Value), Rewards),
Value > 0, % Prune 0 value losing moves ruthlessly
member(move(AlphaBeta, start, noop, _), Tree),
member(goal(Player, CurrentBest), AlphaBeta),
( CurrentBest == 100
-> Value == 100 % Only keep winning moves if one has already been found
; Fudged is Value * 1.5,
Fudged > CurrentBest
).
%% backward_induction(+NodeList, +Tree, -UpdatedTree) is det
backward_induction([], Tree, Tree).
backward_induction([move(NewRewards, Parent, Label, Child)|Parents], TreeIn, Tree) :-
( member(control(Player), Parent) ; role(Player) ),
member(goal(Player, NewValue), NewRewards),
include(parent_filter(move(NewRewards, Parent, Label, Child)), TreeIn, Grandparents),
value_siblings(Player, Grandparents, TreeIn, 0, OldValue),
( NewValue >= OldValue
-> maplist(replace_reward(NewRewards), Grandparents, Revalued),
revalue_tree(Revalued, TreeIn, TreeOut),
append(Parents, Revalued, Ancestors)
; TreeOut = TreeIn,
Ancestors = Parents
),
backward_induction(Ancestors, TreeOut, Tree).
value_siblings(_, [], _, Max, Max).
value_siblings(Player, [move(OldRewards, Grandparent, PrevLabel, Parent)|Grandparents], Tree, AccIn, Max) :-
include(children_filter(move(OldRewards, Grandparent, PrevLabel, Parent)), Tree, Children),
maplist(player_reward(Player), Children, PlayerRewards),
max_list(PlayerRewards, Best),
( Best > AccIn
-> AccOut = Best
; AccOut = AccIn
),
value_siblings(Player, Grandparents, Tree, AccOut, Max).
revalue_tree([], Tree, Tree).
revalue_tree([move(NewRewards, Parent, Label, Child)|Moves], TreeIn, Tree) :-
nth0(Idx, TreeIn, move(_OldRewards, Parent, Label, Child), Rest),
nth0(Idx, TreeOut, move(NewRewards, Parent, Label, Child), Rest),
revalue_tree(Moves, TreeOut, Tree).
% Predicats used with maplist(closure, ListIn, ListOut)
player_reward(Player, move(Rewards, _, _, _), PlayerReward) :-
member(goal(Player, PlayerReward), Rewards).
replace_reward(NewReward, move(_, Player, Label, Child), move(NewReward, Player, Label, Child)).
% Predicates used with include(filter, ListIn, ListOut)
parent_filter(move(_, Parent, _, _), move(_, _, _, Parent)).
children_filter(move(_, _, _, Child), move(_, Child, _, _)).
start_to_end(TreeIn, Path) :-
select(move(AlphaBeta, start, noop, Start), TreeIn, TreeOut),
start_to_end_(TreeOut, [move(AlphaBeta, start, noop, Start)], RevMoves),
maplist(extractmoves, RevMoves, RevPath),
reverse(RevPath, [noop|Path]).
start_to_end_(TreeIn, [move(AlphaBeta, Grandparent, Label1, Parent)|Acc], Path) :-
( select(move(AlphaBeta, Parent, Label2, Child), TreeIn, TreeOut)
-> start_to_end_(TreeOut, [move(AlphaBeta, Parent, Label2, Child), move(AlphaBeta, Grandparent, Label1, Parent)|Acc], Path)
; Path = [move(AlphaBeta, Grandparent, Label1, Parent)|Acc]
).
extractmoves(move(_, _, Move, _), Move).
%% visited(+History, +Node) is det
% removed this to simply use member(Node, History), but discovered keeping step
% caused N Queens to slow to a crawl
visited(History, move(_RewardsList, _Current, _Move, State)) :-
( memberchk(step(_), State)
-> select(step(_), State, State1)
; State1 = State
),
visited_(History, State1).
visited_([], _) :- false, !.
visited_([move(_, _, _, Next)|History], State) :-
( memberchk(step(_), Next)
-> select(step(_), Next, Next1)
; Next1 = Next
),
( State \= Next1
-> visited_(History, State)
; true
).
</div>
<div class="nb-cell markdown" name="md7">
## Cabbage, goat and wolf
I'm starting with the old farmer needing to transport a cabbage, goat and wolf across a river in a boat which can only hold one at a time puzzle, which is popular in textbooks because it doesn't create a very big state-space graph, making it solvable with the two basic search methods: depth first and breadth first.
Step 1 is to explain the rules of the game or puzzle to the computer so that it can see it as a state-space problem, which falls under the important topic of [knowledge representation](https://en.wikipedia.org/wiki/Knowledge_representation_and_reasoning).
I find [Stanford University's General Game Playing](http://ggp.stanford.edu/public/notes.php) course provided handy conventions which enable the above code to solve any number of puzzles.
Rules written in [Game Description Language](http://ggp.stanford.edu/notes/chapter_02.html) or whatever need five things:
1. A description of the initial state, the set of init(Proposition) in GDL, which is the root node in a graph diagram.
2. A way to generate a list of actions, diagramatically edges from the current node to children nodes, defined as legal(Role, Move) in GDL.
3. A way to generate the successor node that a given action leads to, defined by the set of next(Proposition) in GDL.
4. A value of each node, goal(Role, Reward). In the first example, if the farmer has all three items on the opposite side of the river, the value is 100. If he allows the wolf to eat the goat or the goat to eat the cabbage, the value of the state is 0. Otherwise the value of the state is 50.
5. Whether the state is terminal (ie game or puzzle over).
I've followed a convention in GDL of adding a step counter as a Property in a state, which has the effect of forcing the graph into a tree structure, and is a way of avoiding cycles. This also offers a way to force the search to terminate. Since this puzzle can be solved in 7 steps, the tree gets pruned there.
To provide legal/2 and next/1 with the required information, GDL describes the current state as the set of true(Proposition) (which doesn't clash with Prolog's true/0 builtin thanks to the different arity). My implementation puts what is currently true in the clause store with assertz/1 after first clearing with retractall/1. To work out the next state, the action taken described as does(Role, Move) is also put in the clause store.
Something I learnt advancing my code to [alpha-beta pruning](https://en.wikipedia.org/wiki/Alpha%E2%80%93beta_pruning) with [backward induction](https://en.wikipedia.org/wiki/Backward_induction) was heuristics are not easy to get right. For this easy puzzle, I thought I'd simply count how many items are on the right as a heuristic, and then tripped up on that the correct path breaks the required _monotonicity_ when the farmer brings the goat back. I ultimately fudged it by simply multiplying the heuristic value by 1.5 when pruning to leave a fairly large margin for error in the guestimate value.
</div>
<div class="nb-cell program" name="p1">
:- 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(X)) :-
true(left(farmer)),
true(left(X)),
X \== farmer.
legal(farmer, boat(X)) :-
true(right(farmer)),
true(right(X)),
X \== farmer.
legal(farmer, boat(empty)).
next(left(farmer)) :- true(right(farmer)).
next(right(farmer)) :- true(left(farmer)).
next(step(N)) :- true(step(M)), N is M + 1.
next(left(X)) :-
true(right(X)),
does(farmer, boat(X)).
next(right(X)) :-
true(left(X)),
does(farmer, boat(X)).
next(left(X)) :-
true(left(X)),
does(farmer, boat(Y)),
X \== Y,
X \== farmer.
next(right(X)) :-
true(right(X)),
does(farmer, boat(Y)),
X \== Y,
X \== farmer.
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, 0) :-
true(step(8)), !.
goal(farmer, 50).
terminal :- goal(farmer, 100).
terminal :- goal(farmer, 0).
%% Heuristic predicate with auxilaries which are puzzle specific
% Must always be higher than zero and monotonic (ie never decreasing)
heuristic(State, [goal(farmer, Value)]) :-
member(step(Step), State),
countrights(State, 0, Rights),
Value is Step + Rights.
countrights([], Value, Value).
countrights([right(Item)|State], Count, Value) :-
Item \== farmer, !,
CountInc is Count + 1,
countrights(State, CountInc, Value).
countrights([_|State], Count, Value) :-
countrights(State, Count, Value).
</div>
<div class="nb-cell query" name="q1">
time(solve_dfs(Path)).
</div>
<div class="nb-cell query" name="q2">
time(solve_bfs(Path)).
</div>
<div class="nb-cell query" name="q6">
time(solve_ids(Path)).
</div>
<div class="nb-cell markdown" name="md3">
## Sliding tiles
The eight tile sliding puzzle below is taken from Richard O'Keefe's _The Craft of Prolog_ (p59 in my edition).
It only takes four moves to get to the goal using the given example. Sadly, trying the version from the GGP site which takes a minimum 30 moves cannot be done within the time limit allowed on this server.
```
Start Goal
+-+-+-+ +-+-+-+
|1|2|3| |1|2|3|
+-+-+-+ +-+-+-+
|7|8|4| |8| |4|
+-+-+-+ +-+-+-+
|6|5| | |7|6|5|
+-+-+-+ +-+-+-+
```
The heuristic uses _Manhattan distance_, also known as _taxicab geometry_ to value states.
</div>
<div class="nb-cell program" name="p4">
% Converted from http://games.ggp.org/base/games/eightPuzzle/eightPuzzle.kif
:- dynamic true/1, does/2.
role(player).
init(step(0)).
init(cell(1, 1, 1)). init(cell(1, 2, 2)). init(cell(1, 3, 3)).
init(cell(2, 1, 7)). init(cell(2, 2, 8)). init(cell(2, 3, 4)).
init(cell(3, 1, 6)). init(cell(3, 2, 5)). init(cell(3, 3, b)).
legal(player, move(Row, Col)) :-
true(cell(U, Col, b)),
(succ(Row, U) ; pred(Row, U)).
legal(player, move(Row, Col)) :-
true(cell(Row, V, b)),
(succ(Col, V) ; pred(Col, V)).
next(step(X)) :-
true(step(Y)),
X is Y + 1.
next(cell(X, Y, b)) :-
does(player, move(X, Y)).
next(cell(U, Y, Z)) :-
does(player, move(X, Y)),
true(cell(U, Y, b)),
true(cell(X, Y, Z)),
Z \= b.
next(cell(X, V, Z)) :-
does(player, move(X, Y)),
true(cell(X, V, b)),
true(cell(X, Y, Z)),
Z \= b.
next(cell(U, V, Z)) :-
true(cell(U, V, Z)),
does(player, move(X, Y)),
(X \= U ; Y \= V),
true(cell(X1, Y1, b)),
(X1 \= U ; Y1 \= V).
goal(player, 100) :-
inorder.
goal(player, 0) :-
\+inorder.
terminal :- inorder.
terminal :- true(step(4)).
inorder :- true(cell(1, 1, 1)), true(cell(1, 2, 2)), true(cell(1, 3, 3)),
true(cell(2, 1, 8)), true(cell(2, 2, b)), true(cell(2, 3, 4)),
true(cell(3, 1, 7)), true(cell(3, 2, 6)), true(cell(3, 3, 5)).
succ(1, 2).
succ(2, 3).
pred(2, 1).
pred(3, 2).
%% Heuristic using Manhattan distance, also called taxicab geometry
heuristic(State, [goal(player, Value)]) :-
maplist(taxicab_dist, State, Distances),
sum_list(Distances, TotalDistances),
Value is 100 - TotalDistances.
taxicab_dist(step(_), 0).
taxicab_dist(cell(Row, Col, Tile), Distance) :-
member(cell(RowDest, ColDest, Tile),
[cell(1, 1, 1), cell(1, 2, 2), cell(1, 3, 3),
cell(2, 1, 8), cell(2, 2, b), cell(2, 3, 4),
cell(3, 1, 7), cell(3, 2, 6), cell(3, 3, 5)]),
abs(Row - RowDest, Y),
abs(Col - ColDest, X),
Distance is X + Y.
</div>
<div class="nb-cell query" name="q4">
time(solve_dfs(Path)).
</div>
<div class="nb-cell query" name="q5">
time(solve_bfs(Path)).
</div>
<div class="nb-cell query" name="q9">
time(solve_ids(Path)).
</div>
<div class="nb-cell markdown" name="md4">
## Hunter
This puzzle asks the player to clear 14 pawns off a 3x5 chess board with a knight in 14 moves.
```
K | P | P
---+---+---
P | P | P
---+---+---
P | P | P
---+---+---
P | P | P
---+---+---
P | P | P
```
It turns out this is a trick question -- aimed to catching algorithms hardwired to seek goal(Player, 100) -- because it can't be done. The best the knight can achieve in 14 moves is clearing the board of all but one pawn.
It is also a tough AI problem in that knight moves even on a reduced chess board soon overwhelm the server with combinatorial explosion.
</div>
<div class="nb-cell program" name="p5">
:- dynamic true/1, does/2.
role(robot).
init(cell(1, 1, knight)).
init(cell(1, 2, pawn)).
init(cell(1, 3, pawn)).
init(cell(2, 1, pawn)).
init(cell(2, 2, pawn)).
init(cell(2, 3, pawn)).
init(cell(3, 1, pawn)).
init(cell(3, 2, pawn)).
init(cell(3, 3, pawn)).
init(cell(4, 1, pawn)).
init(cell(4, 2, pawn)).
init(cell(4, 3, pawn)).
init(cell(5, 1, pawn)).
init(cell(5, 2, pawn)).
init(cell(5, 3, pawn)).
init(captures(0)).
init(step(1)).
legal(robot, move(M1, N1, M2, N2)) :- true(cell(M1, N1, knight)), knightmove(M1, N1, M2, N2).
next(cell(M2, N2, knight)) :- does(robot, move(_M1, _N1, M2, N2)).
next(cell(M1, N1, blank)) :- does(robot, move(M1, N1, _M2, _N2)).
next(cell(U, V, pawn)) :- true(cell(U, V, pawn)), does(robot, move(_M1, _N1, M2, _N2)), dif(U, M2).
next(cell(U, V, pawn)) :- true(cell(U, V, pawn)), does(robot, move(_M1, _N1, _M2, N2)), dif(V, N2).
next(cell(U, V, blank)) :- true(cell(U, V, blank)), does(robot, move(_M1, _N1, M2, _N2)), dif(U, M2).
next(cell(U, V, blank)) :- true(cell(U, V, blank)), does(robot, move(_M1, _N1, _M2, N2)), dif(V, N2).
next(captures(Old)) :- does(robot, move(_M1, _N1, M2, N2)), true(cell(M2, N2, blank)), true(captures(Old)).
next(captures(New)) :- does(robot, move(_M1, _N1, M2, N2)), true(cell(M2, N2, pawn)), true(captures(Old)), succ(Old, New).
next(step(New)) :- true(step(Old)), succ(Old, New).
goal(robot, Goal) :- true(captures(Count)), scoremap(Count, Goal).
terminal :- true(step(15)).
knightmove(M1, N1, M2, N2) :- add1row(M1, M2), add2col(N1, N2).
knightmove(M1, N1, M2, N2) :- add1row(M1, M2), add2col(N2, N1).
knightmove(M1, N1, M2, N2) :- add1row(M2, M1), add2col(N1, N2).
knightmove(M1, N1, M2, N2) :- add1row(M2, M1), add2col(N2, N1).
knightmove(M1, N1, M2, N2) :- add2row(M1, M2), add1col(N1, N2).
knightmove(M1, N1, M2, N2) :- add2row(M1, M2), add1col(N2, N1).
knightmove(M1, N1, M2, N2) :- add2row(M2, M1), add1col(N1, N2).
knightmove(M1, N1, M2, N2) :- add2row(M2, M1), add1col(N2, N1).
succ(0, 1).
succ(1, 2).
succ(2, 3).
succ(3, 4).
succ(4, 5).
succ(5, 6).
succ(6, 7).
succ(7, 8).
succ(8, 9).
succ(9, 10).
succ(10, 11).
succ(11, 12).
succ(12, 13).
succ(13, 14).
succ(14, 15).
add1row(1, 2).
add1row(2, 3).
add1row(3, 4).
add1row(4, 5).
add2row(1, 3).
add2row(2, 4).
add2row(3, 5).
add1col(1, 2).
add1col(2, 3).
add2col(1, 3).
scoremap(0, 0).
scoremap(1, 1).
scoremap(2, 3).
scoremap(3, 7).
scoremap(4, 11).
scoremap(5, 16).
scoremap(6, 22).
scoremap(7, 29).
scoremap(8, 37).
scoremap(9, 45).
scoremap(10, 54).
scoremap(11, 64).
scoremap(12, 75).
scoremap(13, 87).
scoremap(14, 100).
heuristic(State, [goal(robot, Value)]) :-
update_state(State),
goal(robot, Value1),
( Value1 == 0
-> Value = 1
; Value = Value1
).
</div>
<div class="nb-cell query" name="q3">
time(solve_ids(Path)).
</div>
<div class="nb-cell markdown" name="md2">
## N Queens
The next puzzle is to place eight queens on a chess board so that none attack each other. Since only one queen can be on a given row or column, the heuristic prunes the list of legal moves down to those where the row equals the current step.
On step(1) the board is blank, but instead of starting with all 64 possible placements, we only consider the eight in row one, which then cuts the maximum in step two to six and so forth.
With a bit of editing, the code below can be solved for values besides eight.
</div>
<div class="nb-cell program" name="p3">
% Addapted from rules at http://games.ggp.org/base/games/queens08lg/queens.kif
:- dynamic true/1, does/2.
role(robot).
init(cell(Row, Col, blank)) :-
num(Row), num(Col).
init(step(1)).
legal(robot, place(Row, Col)) :-
true(cell(Row, Col, blank)),
\+attacked(Row, Col).
next(cell(Row, Col, queen)) :-
does(robot, place(Row, Col)).
next(cell(Row, Col, Type)) :-
true(cell(Row, Col, Type)),
\+does(robot, place(Row, Col)).
next(step(N2)) :-
true(step(N1)),
N2 is N1 + 1,
N2 =< 9.
terminal :- true(step(9)).
goal(robot, 0) :- true(step(N)), N < 9.
goal(robot, 100) :- true(step(9)).
num(N) :- between(1, 8, N).
attacked(Row, _) :- % same row
true(cell(Row, _, queen)).
attacked(_, Col) :- % same col
true(cell(_, Col, queen)).
attacked(Row, Col) :- % SE diagonals, each Row - Col same on diagonal
true(cell(Row2, Col2, queen)),
X is Row - Col,
X is Row2 - Col2.
attacked(Row, Col) :- % NW diagonals, each Row + Col same on diagonal
true(cell(Row2, Col2, queen)),
X is Row + Col,
X is Row2 + Col2.
%% Heuristic predicate with auxilaries which are puzzle specific
heuristic(State, [goal(robot, Value)]) :-
member(step(Step), State),
Row is Step - 1, % Correct, Step is one more than Row
max_row(State, 0, Max),
% member(cell(Max, Col, queen), State),
( Max == Row
-> ( member(cell(Max, Col, queen), State)
-> Value is (Max * 10) + (10 - Col)
; Value is 1
)
; Value = 0
).
max_row([], Max, Max).
max_row([cell(Row, _Col, queen)|Propositions], AccIn, Max) :- !,
( Row > AccIn
-> AccOut = Row
; AccOut = AccIn
),
max_row(Propositions, AccOut, Max).
max_row([_|Propositions], Acc, Max) :-
max_row(Propositions, Acc, Max).
</div>
<div class="nb-cell query" name="q7">
time(solve_ids(Path)).
</div>
<div class="nb-cell html" name="htm1">
</div>
<div class="nb-cell markdown" name="md5">
I've added games, which I previously had in a separate tutorial, here because they now share the same basic code base.
### Tic-Tac-Toe 1
For the first example, here again is the tic-tac-toe example at a crucial point with X poised to lose unless he blocks O's obvious victory:
```
X | X | O
---+---+---
| O |
---+---+---
| O | X
```
If the AI player is smart enough to know it must do does(x, mark(3, 1)), then when it toggles over to play O it must see the next obvious move:
```
X | X | O
---+---+---
| O |
---+---+---
X | O | X
```
So the code needs to be smart enough to see the next step must be does(o, mark(2, 1)), leaving x only one choice which forces a draw.
</div>
<div class="nb-cell program" name="p6">
:- dynamic true/1, does/2.
role(x).
role(o).
init(cell(1, 1, x)). init(cell(1, 2, x)). init(cell(1, 3, o)).
init(cell(2, 1, b)). init(cell(2, 2, o)). init(cell(2, 3, b)).
init(cell(3, 1, b)). init(cell(3, 2, o)). init(cell(3, 3, x)).
init(control(x)).
init(step(0)).
legal(W, mark(X, Y)) :- true(cell(X, Y, b)), true(control(W)).
legal(x, noop) :- true(control(o)).
legal(o, noop) :- true(control(x)).
next(cell(M, N, x)) :- does(x, mark(M, N)), true(cell(M, N, b)).
next(cell(M, N, o)) :- does(o, mark(M, N)), true(cell(M, N, b)).
next(cell(M, N, W)) :- true(cell(M, N, W)), W \== b.
next(cell(M, N, b)) :- does(_W, mark(J, K)), true(cell(M, N, b)), ( M \== J ; N \== K ).
next(control(x)) :- true(control(o)).
next(control(o)) :- true(control(x)).
next(step(M)) :- true(step(N)), succ(N, M).
row(M, X) :- true(cell(M, 1, X)), true(cell(M, 2, X)), true(cell(M, 3, X)).
column(N, X) :- true(cell(1, N, X)), true(cell(2, N, X)), true(cell(3, N, X)).
diagonal(X) :- true(cell(1, 1, X)), true(cell(2, 2, X)), true(cell(3, 3, X)).
diagonal(X) :- true(cell(1, 3, X)), true(cell(2, 2, X)), true(cell(3, 1, X)).
line(X) :- row(_M, X).
line(X) :- column(_M, X).
line(X) :- diagonal(X).
open :- true(cell(_M, _N, b)).
goal(x, 100) :- line(x), \+line(o).
goal(x, 50) :- line(x), line(o).
goal(x, 50) :- \+line(x), \+line(o).
goal(x, 0) :- \+line(x), line(o).
goal(o, 100) :- \+line(x), line(o).
goal(o, 50) :- line(x), line(o).
goal(o, 50) :- \+line(x), \+line(o).
goal(o, 0) :- line(x), \+line(o).
terminal :- line(x).
terminal :- line(o).
terminal :- \+open.
heuristic(State, Rewards) :-
retractall(true(_)),
forall(member(Proposition, State), assertz(true(Proposition))),
setof(Role, role(Role), Roles),
setof(goal(Role, Reward), (member(Role, Roles), goal(Role, Reward)), Rewards).
</div>
<div class="nb-cell query" name="q8">
time(solve_ids(Path)).
</div>
<div class="nb-cell markdown" name="md6">
## Tic-Tac-Toe 2
The next tic-tac-toe example leads to the one above, but first playing X the AI player needs to see it must do does(x, marks(1,2)), and then as the O player does(o, marks(1,3)).
```
X | |
---+---+---
| O |
---+---+---
| O | X
```
</div>
<div class="nb-cell program" name="p7">
:- dynamic true/1, does/2.
role(x).
role(o).
init(cell(1, 1, x)). init(cell(1, 2, b)). init(cell(1, 3, b)).
init(cell(2, 1, b)). init(cell(2, 2, o)). init(cell(2, 3, b)).
init(cell(3, 1, b)). init(cell(3, 2, o)). init(cell(3, 3, x)).
init(control(x)).
init(step(0)).
legal(W, mark(X, Y)) :- true(cell(X, Y, b)), true(control(W)).
legal(x, noop) :- true(control(o)).
legal(o, noop) :- true(control(x)).
next(cell(M, N, x)) :- does(x, mark(M, N)), true(cell(M, N, b)).
next(cell(M, N, o)) :- does(o, mark(M, N)), true(cell(M, N, b)).
next(cell(M, N, W)) :- true(cell(M, N, W)), W \== b.
next(cell(M, N, b)) :- does(_W, mark(J, K)), true(cell(M, N, b)), ( M \== J ; N \== K ).
next(control(x)) :- true(control(o)).
next(control(o)) :- true(control(x)).
next(step(M)) :- true(step(N)), succ(N, M).
row(M, X) :- true(cell(M, 1, X)), true(cell(M, 2, X)), true(cell(M, 3, X)).
column(N, X) :- true(cell(1, N, X)), true(cell(2, N, X)), true(cell(3, N, X)).
diagonal(X) :- true(cell(1, 1, X)), true(cell(2, 2, X)), true(cell(3, 3, X)).
diagonal(X) :- true(cell(1, 3, X)), true(cell(2, 2, X)), true(cell(3, 1, X)).
line(X) :- row(_M, X).
line(X) :- column(_M, X).
line(X) :- diagonal(X).
open :- true(cell(_M, _N, b)).
goal(x, 100) :- line(x), \+line(o).
goal(x, 50) :- line(x), line(o).
goal(x, 50) :- \+line(x), \+line(o).
goal(x, 0) :- \+line(x), line(o).
goal(o, 100) :- \+line(x), line(o).
goal(o, 50) :- line(x), line(o).
goal(o, 50) :- \+line(x), \+line(o).
goal(o, 0) :- line(x), \+line(o).
terminal :- line(x).
terminal :- line(o).
terminal :- \+open.
heuristic(State, Rewards) :-
retractall(true(_)),
forall(member(Proposition, State), assertz(true(Proposition))),
setof(Role, role(Role), Roles),
setof(goal(Role, Reward), (member(Role, Roles), goal(Role, Reward)), Rewards).
</div>
<div class="nb-cell query" name="q10">
time(solve_ids(Path)).
</div>
<div class="nb-cell markdown" name="md8">
## Tic-Tac-Toe 3
</div>
<div class="nb-cell markdown" name="md9">
Stepping further back, here not even a human player would figure out the steps required to force a draw. It takes the AI player over six seconds.
```
X | |
---+---+---
| O |
---+---+---
| |
```
</div>
<div class="nb-cell program" name="p8">
:- dynamic true/1, does/2.
role(x).
role(o).
init(cell(1, 1, x)). init(cell(1, 2, b)). init(cell(1, 3, b)).
init(cell(2, 1, b)). init(cell(2, 2, o)). init(cell(2, 3, b)).
init(cell(3, 1, b)). init(cell(3, 2, b)). init(cell(3, 3, b)).
init(control(x)).
init(step(0)).
legal(W, mark(X, Y)) :- true(cell(X, Y, b)), true(control(W)).
legal(x, noop) :- true(control(o)).
legal(o, noop) :- true(control(x)).
next(cell(M, N, x)) :- does(x, mark(M, N)), true(cell(M, N, b)).
next(cell(M, N, o)) :- does(o, mark(M, N)), true(cell(M, N, b)).
next(cell(M, N, W)) :- true(cell(M, N, W)), W \== b.
next(cell(M, N, b)) :- does(_W, mark(J, K)), true(cell(M, N, b)), ( M \== J ; N \== K ).
next(control(x)) :- true(control(o)).
next(control(o)) :- true(control(x)).
next(step(M)) :- true(step(N)), succ(N, M).
row(M, X) :- true(cell(M, 1, X)), true(cell(M, 2, X)), true(cell(M, 3, X)).
column(N, X) :- true(cell(1, N, X)), true(cell(2, N, X)), true(cell(3, N, X)).
diagonal(X) :- true(cell(1, 1, X)), true(cell(2, 2, X)), true(cell(3, 3, X)).
diagonal(X) :- true(cell(1, 3, X)), true(cell(2, 2, X)), true(cell(3, 1, X)).
line(X) :- row(_M, X).
line(X) :- column(_M, X).
line(X) :- diagonal(X).
open :- true(cell(_M, _N, b)).
goal(x, 100) :- line(x), \+line(o).
goal(x, 50) :- line(x), line(o).
goal(x, 50) :- \+line(x), \+line(o).
goal(x, 0) :- \+line(x), line(o).
goal(o, 100) :- \+line(x), line(o).
goal(o, 50) :- line(x), line(o).
goal(o, 50) :- \+line(x), \+line(o).
goal(o, 0) :- line(x), \+line(o).
terminal :- line(x).
terminal :- line(o).
terminal :- \+open.
heuristic(State, Rewards) :-
retractall(true(_)),
forall(member(Proposition, State), assertz(true(Proposition))),
setof(Role, role(Role), Roles),
setof(goal(Role, Reward), (member(Role, Roles), goal(Role, Reward)), Rewards).
</div>
<div class="nb-cell query" name="q11">
time(solve_ids(Path)).
</div>
</div>