<div class="notebook"> <div class="nb-cell markdown" name="md1"> # Game Trees _Robert Laing_ Continuing from a tutorial on puzzle solving <https://swish.swi-prolog.org/p/Graphs1.swinb>, which in turn followed a tutorial on list processing with Prolog <https://swish.swi-prolog.org/p/Iteration2.swinb>, I'm going to explore using Prolog for games here. Please post any suggestions and comments to a discussion I started at <https://swi-prolog.discourse.group/t/game-tree-tutorial-on-swish/921>. As with puzzles, I'm using conventions from [Stanford University's General Game Playing](http://ggp.stanford.edu/public/notes.php) course, translating rules written in [Game Description Language](http://ggp.stanford.edu/notes/chapter_02.html) into Prolog. This is an initial stab at advancing from depth first search to [iterative deepening](https://en.wikipedia.org/wiki/Iterative_deepening_depth-first_search). I've kept the historical names -- [minimax](https://en.wikipedia.org/wiki/Minimax_theorem) and [alpha-beta](https://en.wikipedia.org/wiki/Alpha%E2%80%93beta_pruning) -- though they assume two player games, when the same ideas can be applied from one player games (commonly called puzzles) to N player games. I've tried to keep the code similar to the graph traversal tutorial, but one key change I've made is instead of storing the game tree as a list of move(Parent, Label, Child) clauses, I've expanded this to move(RewardsList, Parent, Label, Child). As far as I understand the jargon term [dynamic programming](https://en.wikipedia.org/wiki/Dynamic_programming), this is an example of it in that it involves lots of updating the values of nodes, something Prolog's _assign-once variables_ make fairly laborious, I hope to gradually polish the spaghetti code I've written below do this into something more elegant. </div> <div class="nb-cell program" data-background="true" name="p1"> %% solve_ids(+MaxDepth, -Moves) is det (because of cut) % Returns a list of does(Player, Move) clauses in sequence to % solve the puzzle using iterative depth first search solve_ids(Moves) :- findinit(Start), member(step(N), Start), Limit is N + 1, iterative_deepening(Limit, [move(_AlphaBeta, start, noop, Start)], [], History), getpath(History, Moves), !. %% iterative_deepening(+Frontier, +Acc, +HistoryIn, -HistoryOut) is det % Bug is here, need to figure out final tree better iterative_deepening(Depth, Frontier, HistoryIn, HistoryOut) :- depthlimited(Depth, Frontier, HistoryIn, History), ( HistoryIn == History -> HistoryOut = History ; DepthInc is Depth + 1, iterative_deepening(DepthInc, Frontier, History, HistoryOut) ). %% depthlimited(+Limit, +Frontier, +Acc, -GameTree) is det depthlimited(_N, [], History, History). % Terminal nodes depthlimited(MaxDepth, [move(_, State, Move, End)|Frontier], AccIn, History) :- update_state(End), terminal, !, ( \+visited(AccIn, move(_, State, Move, End)) -> setof(Player, Player^role(Player), Players), maplist(rewards_, Players, RewardsList), minimax([move(RewardsList, State, Move, End)|AccIn], AccOut) ; AccOut = AccIn ), depthlimited(MaxDepth, Frontier, AccOut, History). % Reached a new level where fresh child nodes need to be generated depthlimited(MaxDepth, [move(RewardsList, Parent, Move, Child)|Frontier], AccIn, History) :- member(step(N), Child), M is MaxDepth - 1, N == M, !, generate_children(move(RewardsList, Parent, Move, Child), Children1), exclude(visited([move(RewardsList, Parent, Move, Child)|Frontier]), Children1, Children2), exclude(visited([move(RewardsList, Parent, Move, Child)|AccIn]), Children2, Children3), heuristic(AccIn, Children3, AccOut, Children4), ( ( member(move(AlphaBeta, start, noop, _), AccIn) , ground(AlphaBeta) ) -> ( member(control(Player), Child) ; role(Player) ), member(goal(Player, CurrentBest), AlphaBeta), alphabeta(CurrentBest, Children4, Children) ; sort_children(Children4, Children) ), append(Children, Frontier, NewFrontier), ( \+visited(AccOut, move(RewardsList, Parent, Move, Child)) -> depthlimited(MaxDepth, NewFrontier, [move(RewardsList, Parent, Move, Child)|AccOut], History) ; depthlimited(MaxDepth, NewFrontier, AccOut, History) ). % Retracing old level, so children will already be in tree depthlimited(MaxDepth, [move(RewardsList, Parent, Move, Child)|Frontier], Acc, History) :- member(step(N), Child), M is MaxDepth - 1, N < M, !, find_children(move(RewardsList, Parent, Move, Child), Acc, Children1), ( ( member(move(AlphaBeta, start, noop, _), Acc) , ground(AlphaBeta) ) -> ( member(control(Player), Child) ; role(Player) ), member(goal(Player, CurrentBest), AlphaBeta), alphabeta(CurrentBest, Children1, Children2) ; sort_children(Children1, Children2) ), exclude(visited([move(RewardsList, Parent, Move, Child)|Frontier]), Children2, Children), append(Children, Frontier, NewFrontier), ( \+visited(Acc, move(RewardsList, Parent, Move, Child)) -> depthlimited(MaxDepth, NewFrontier, [move(RewardsList, Parent, Move, Child)|Acc], History) ; depthlimited(MaxDepth, NewFrontier, Acc, History) ). % Limit reached, no new nodes added to Frontier depthlimited(MaxDepth, [move(RewardsList, Parent, Move, Child)|Frontier], Acc, History) :- member(step(N), Child), N == MaxDepth, ( \+visited(Acc, move(RewardsList, Parent, Move, Child)) -> depthlimited(MaxDepth, Frontier, [move(RewardsList, Parent, Move, Child)|Acc], History) ; depthlimited(MaxDepth, Frontier, Acc, History) ). %% visited(+History, +Node) is det % a filter to avoid endless cycles in graph searches % removes step(N) clauses if they are in State 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 ). %% generate_children(+Parent, -Children) is det % Adds new nodes to game tree % with auxiliary predicate getnext(+Current, +Move, +move(RewardsList, Current, Move, Next)) generate_children(move(_RewardsList, _GrandParent, _PrevMove, Parent), Children) :- update_state(Parent), ( \+terminal -> (true(control(Player)) ; role(Player)), % try for more than one player games setof(does(Player, Move), Player^Move^legal(Player, Move), Legals), maplist(getnext(Parent), Legals, Children) ; Children = [] ), !. % Need to return empty list if setof returns false generate_children(_, []). getnext(Parent, does(Player, Move), move(_RewardsList, Parent, does(Player, Move), Child)) :- retractall(does(_,_)), assertz(does(Player, Move)), setof(Next, Next^next(Next), Child). %% find_children(+Parent, +Tree, -Children) is det % Get previously generated children from game tree find_children(_, [], []). find_children(move(PrevRewardsList, GrandParent, PrevMove, Parent), [move(_, State, _, _)|Tree], Children) :- Parent \== State, !, find_children(move(PrevRewardsList, GrandParent, PrevMove, Parent), Tree, Children). find_children(move(PrevRewardsList, GrandParent, PrevMove, Parent), [move(RewardsList, Parent, Move, Child)|Tree], [move(RewardsList, Parent, Move, Child)|Children]) :- find_children(move(PrevRewardsList, GrandParent, PrevMove, Parent), Tree, Children). %% minimax(+TreeIn, -TreeOut) is det minimax([Child|TreeIn], TreeOut) :- listparents(Child, TreeIn, Parents), getancestors(Parents, TreeIn, Ancestors), revalue_tree(Ancestors, [Child|TreeIn], TreeOut). %% listparents(+Child, +Tree, -ParentNodeList) is det % Usually nodes in a game tree only have one parent, but they can have multiple parents listparents(Child, Tree, Parents) :- listparents_(Child, Tree, [], RevParents), reverse(RevParents, Parents). listparents_(_, [], Parents, Parents). listparents_(move(Rewards, Parent, Move, Child), [move(_, _, _, State)|Tree], Acc, Parents) :- Parent \== State, !, listparents_(move(Rewards, Parent, Move, Child), Tree, Acc, Parents). listparents_(move(R, Parent, Move, Child), [move(Rewards, Grandparent, PrevMove, Parent)|Tree], Acc, Parents) :- listparents_(move(R, Parent, Move, Child), Tree, [move(Rewards, Grandparent, PrevMove, Parent)|Acc], Parents). %% getancestors(+Parents, +Tree, -Ancestors) is det %% Iterate through parent nodes back to move(AlphaBeta, start, noop, Start) node getancestors([], _Tree, []). getancestors([Child|SiblingsIn], Tree, [Child|Ancestors]) :- listparents(Child, Tree, Parents), append(Parents, SiblingsIn, SiblingsOut), getancestors(SiblingsOut, Tree, Ancestors). %%% update_values(Ancestors, [Child|TreeIn], TreeOut) is det revalue_tree([], Tree, Tree). revalue_tree([move(RewardsList, Parent, Move, Child)|Ancestors], TreeIn, Tree) :- find_children(move(RewardsList, Parent, Move, Child), TreeIn, Children), maplist(extractrewards, Children, ChildrenRewards), (member(control(Player), Child) ; role(Player)), max_reward(Player, ChildrenRewards, 0, Max), % favour unexplored nodes when alternative is losing ( Max == 0 -> exclude(ground, ChildrenRewards, Unexplored), length(Unexplored, L), ( L > 0 -> random_member(NewRewardsList, Unexplored) ; getmax_reward(goal(Player, 0), ChildrenRewards, NewRewardsList) ) ; ( ground(RewardsList) -> member(goal(Player, CurrentReward), RewardsList), ( CurrentReward \== Max -> getmax_reward(goal(Player, Max), ChildrenRewards, NewRewardsList) ; true ) ; getmax_reward(goal(Player, Max), ChildrenRewards, NewRewardsList) ) ), ( RewardsList \== NewRewardsList -> nth1(Idx, TreeIn, move(RewardsList, Parent, Move, Child), Rest), nth1(Idx, TreeOut, move(NewRewardsList, Parent, Move, Child), Rest) ; TreeOut = TreeIn ), revalue_tree(Ancestors, TreeOut, Tree). getmax_reward(goal(Player, Max), [MaxRewardList|_ChildrenRewards], MaxRewardList) :- ground(MaxRewardList), memberchk(goal(Player, Max), MaxRewardList), !. getmax_reward(goal(Player, Max), [_ChildReward|ChildrenRewards], MaxRewardList) :- getmax_reward(goal(Player, Max), ChildrenRewards, MaxRewardList). getmax_reward(_, [], _). max_reward(_, [], Max, Max). % max_rewards(+Player, +ListOfRewards, Acc, Max) is det % returns unground value if ListOfRewards is all unground max_reward(Player, [ChildrenReward|ChildrenRewards], Acc, Max) :- \+ground(ChildrenReward), !, max_reward(Player, ChildrenRewards, Acc, Max). max_reward(Player, [ChildrenReward|ChildrenRewards], Acc1, Max) :- member(goal(Player, Reward), ChildrenReward), ( Reward @> Acc1 -> Acc2 = Reward ; Acc2 = Acc1 ), max_reward(Player, ChildrenRewards, Acc2, Max). rewards_(Player, goal(Player, Reward)) :- goal(Player, Reward). %% alphabeta(+BestCurrent, +ChildrenIn, -ChildrenOut) is det alphabeta(_BestCurrent, [], []) :- !. alphabeta(BestCurrent, ChildrenIn, ChildrenOut) :- valuechildren(ChildrenIn, Unsorted), sort(1, >=, Unsorted, Unpruned), ( BestCurrent == 0 -> exclude(zeros, Unpruned, VMs) % discard known losing moves ; exclude(prune(BestCurrent), Unpruned, VMs) ), maplist(stripvalues, VMs, ChildrenOut). %% sort_chidren(+ChildrenIn, -ChildrenOut) is det % used until an AlphaBeta value is known sort_children([], []) :- !. sort_children(ChildrenIn, ChildrenOut) :- valuechildren(ChildrenIn, Unsorted), sort(1, >=, Unsorted, WithZeros), exclude(zeros, WithZeros, VMs), % discard known losing moves maplist(stripvalues, VMs, ChildrenOut). zeros(vm(0, _)). prune(BestCurrent, vm(Val, _)) :- Val < BestCurrent. stripvalues(vm(_, Move), Move). valuechildren([], []). valuechildren([move(RewardsList, Parent, Move, Child)|ChildrenIn], [vm(Val, move(RewardsList, Parent, Move, Child))|VMs]) :- ( \+ground(RewardsList) -> Val = 100 % always keep unexplored moves ; (member(control(Player), Parent) ; role(Player)), member(goal(Player, Val), RewardsList) ), valuechildren(ChildrenIn, VMs). update_state(State) :- retractall(true(_)), forall(member(X, State), assertz(true(X))). findinit(Start) :- setof(Init, Init^init(Init), Start). getpath(TreeIn, Path) :- select(move(RewardsList, start, noop, Start), TreeIn, Rest), select(move(RewardsList, Start, Move, Child), Rest, TreeOut), getpath_([move(RewardsList, Start, Move, Child)], TreeOut, RevMoves), maplist(extractmoves, RevMoves, RevPath), reverse(RevPath, Path). getpath_([move(RewardsList, Parent, Move, End)|Acc], TreeIn, [move(RewardsList, Parent, Move, End)|Acc]) :- \+memberchk(move(RewardsList, End, _Move, _Child), TreeIn), !. getpath_([move(RewardsList, GrandParent, PrevMove, Parent)|Acc], TreeIn, RevPath) :- select(move(RewardsList, Parent, Move, Child), TreeIn, TreeOut), getpath_([move(RewardsList, Parent, Move, Child), move(RewardsList, GrandParent, PrevMove, Parent)|Acc], TreeOut, RevPath). extractmoves(move(_, _, Move, _), Move). extractrewards(move(Rewards, _, _, _), Rewards). </div> <div class="nb-cell markdown" name="md2"> 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="p2"> :- 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)), dif(W, b). next(cell(M, N, b)) :- does(_W, mark(J, K)), true(cell(M, N, b)), (dif(M, J) ; dif(N, K)). next(control(x)) :- true(control(o)). next(control(o)) :- true(control(x)). next(step(N)) :- true(step(M)), N is M + 1. 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(DummyTree, DummyChildren, DummyTree, DummyChildren). </div> <div class="nb-cell query" name="q1"> time(solve_ids(Moves)). </div> <div class="nb-cell markdown" name="md3"> 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="p3"> :- 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)), dif(W, b). next(cell(M, N, b)) :- does(_W, mark(J, K)), true(cell(M, N, b)), (dif(M, J) ; dif(N, K)). next(control(x)) :- true(control(o)). next(control(o)) :- true(control(x)). next(step(N)) :- true(step(M)), N is M + 1. 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(DummyTree, DummyChildren, DummyTree, DummyChildren). </div> <div class="nb-cell query" name="q2"> time(solve_ids(Moves)). </div> <div class="nb-cell markdown" name="md7"> Getting to the point where the AI player could see the required path to a draw from this position took me several hours of coding. ``` X | | ---+---+--- | O | ---+---+--- | | ``` </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, 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)), dif(W, b). next(cell(M, N, b)) :- does(_W, mark(J, K)), true(cell(M, N, b)), (dif(M, J) ; dif(N, K)). next(control(x)) :- true(control(o)). next(control(o)) :- true(control(x)). next(step(N)) :- true(step(M)), N is M + 1. 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(DummyTree, DummyChildren, DummyTree, DummyChildren). </div> <div class="nb-cell query" name="q5"> time(solve_ids(Path)). </div> <div class="nb-cell markdown" name="md4"> Getting the above to work broke solving the puzzle below, called _Hunter_ which asks the player to clear the pawns off a 3x5 chess board with a knight in 15 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 as I used in <https://swish.swi-prolog.org/p/Graphs1.swinb> 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. Thanks to _monotonicity_ -- we can write a heuristic predicate favouring turns which reduce the number of pawns each move -- the iterative deepening code above can solve this problem, though it takes over six seconds. I've changed from heuristic/2 to heuristic/4 since besides prunning child nodes, for iterative deepening to work it is handy to fill in the RewardsList with guestimate values instead of waiting to reach terminals in the game tree. </div> <div class="nb-cell program" name="p4"> :- 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(TreeIn, ChildrenIn, TreeOut, ChildrenOut) :- peekahead(TreeIn, ChildrenIn, [], RevChildren, TreeOut), reverse(RevChildren, ChildrenOut). peekahead(Tree, [], Children, Children, Tree). peekahead(TreeIn, [move(_, State, Move, Next)|ChildrenIn], Acc, ChildrenOut, TreeOut) :- update_state(Next), setof(Player, Player^role(Player), Players), maplist(rewards_, Players, RewardsList), minimax([move(RewardsList, State, Move, Next)|TreeIn], Tree), peekahead(Tree, ChildrenIn, Acc, ChildrenOut, TreeOut). </div> <div class="nb-cell query" name="q3"> time(solve_ids(Path)). </div> <div class="nb-cell markdown" name="md5"> Finally, an attempt to solve a tough eight tile sliding puzzle as opposed to the trivial efforts earlier. The starting position is ``` 8 | 7 | 6 ---+---+--- 5 | 4 | 3 ---+---+--- 2 | 1 | ``` and the goal is ``` 1 | 2 | 3 ---+---+--- 4 | 5 | 6 ---+---+--- 7 | 8 | ``` </div> <div class="nb-cell program" name="p5"> :- dynamic true/1, does/2. role(player). init(step(0)). init(cell(1, 1, 8)). init(cell(1, 2, 7)). init(cell(1, 3, 6)). init(cell(2, 1, 5)). init(cell(2, 2, 4)). init(cell(2, 3, 3)). init(cell(3, 1, 2)). init(cell(3, 2, 1)). 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, true(step(30)). % goal(player, 99) :- inorder, true(step(X)), dif(X, 30). goal(player, 0) :- \+inorder. terminal :- inorder. % terminal :- true(step(60)). terminal :- true(step(31)). inorder :- true(cell(1, 1, 1)), true(cell(1, 2, 2)), true(cell(1, 3, 3)), true(cell(2, 1, 4)), true(cell(2, 2, 5)), true(cell(2, 3, 6)), true(cell(3, 1, 7)), true(cell(3, 2, 8)), true(cell(3, 3, b)). succ(1, 2). succ(2, 3). pred(2, 1). pred(3, 2). %% Heuristic using taxicab geometry heuristic(TreeIn, ChildrenIn, TreeOut, ChildrenOut) :- peekahead(TreeIn, ChildrenIn, [], RevChildren, TreeOut), reverse(RevChildren, ChildrenOut). peekahead(Tree, [], Children, Children, Tree). peekahead(TreeIn, [move(_, State, Move, Next)|ChildrenIn], Acc, ChildrenOut, TreeOut) :- value_move(move([goal(player, _)], State, Move, Next), move([goal(player, Guess)], State, Move, Next)), minimax([move([goal(player, Guess)], State, Move, Next)|TreeIn], Tree), peekahead(Tree, ChildrenIn, [move([goal(player, Guess)], State, Move, Next)|Acc], ChildrenOut, TreeOut). value_move(move(_, Parent, Move, Child), move([goal(player, Guess)], Parent, Move, Child)) :- maplist(taxicab_dist, Child, Distances), sum_list(Distances, TotalDistances), Guess 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, 4), cell(2, 2, 5), cell(2, 3, 6), cell(3, 1, 7), cell(3, 2, 8), cell(3, 3, b)]), abs(Row - RowDest, Y), abs(Col - ColDest, X), Distance is X + Y. </div> <div class="nb-cell query" name="q4"> time(solve_ids(Path)). </div> <div class="nb-cell markdown" name="md6"> Following these steps produces ``` 8 | 7 | 6 ---+---+--- 4 | 2 | 3 ---+---+--- | 5 | 1 ``` Which is far from the solution, so I still have quite a few bugs in my code to be ironed out. </div> </div>