Links & Resources
Git: link
Handout: Reasoning&Agents-CW1-handout.pdf
My Report: Reasoning&Agents-CW1-answers.pdf
Overview
The coursework was evenly split between text and coding tasks. All the textual answers are in the report linked above, and the code is included in the Github repository linked at the top.
Utilities
At first I will show you some global utilities which I will be referencing later:
-- The Node type defines the position of the robot on the grid.
-- The Branch type synonym defines the branch of search through the grid.
type Node = Int
type Branch = [Node]
type Graph= [Node]
numNodes::Int
numNodes = 4
-- The next function should return all the possible continuations of input search branch through the grid.
-- Remember that the robot can only move up, down, left and right, and can't move outside the grid.
-- The current location of the robot is the head of the input branch.
-- Your function should return an empty list if the input search branch is empty.
-- This implementation of next function does not backtrace branches.
-- since this function is used a in all functions later on, I will focus on the speed, and even though i could do it in 3 lines, recursion will be the fastest approach here, I am afraid :C
-- NOTE: i know you asked for the auxilary functions to be put at the bottom of the file, however, 95% of mine use less arguments than the originals
-- and so I have to keep them in the main bodies of the calling functions, I used let statements to make the functions read naturally
next::Branch -> Graph -> [Branch]
next [] _ = []
next _ [] = []
next branch@(currNode:xs) graph =
let
-- Finds the successor nodes in reverse-lexicographic order (due to tail-recursion)
readSuccessorNodes :: Graph -> Int -> [Node] -> [Node]
readSuccessorNodes [] _ list = list
readSuccessorNodes graph@(val:xs) col list
| col >= numNodes = list
| otherwise = case val of
0 -> readSuccessorNodes xs (col+1) (list)
_ -> readSuccessorNodes xs (col+1) (col:list)
-- Tail-recursively appends each of given succesors to the branch, and in doing so we get
-- a list of successor branches in lexicographic order, and there is no need to call reverse! *stonks*
getSuccessorBranches :: [Node] -> [Branch] -> [Branch]
getSuccessorBranches [] list = list
getSuccessorBranches (succNode:xs) list = (getSuccessorBranches xs ((succNode:branch):list))
-- A subgraph of graph, starting at the row corresponding to currNode
subGraph = drop (numNodes * currNode) graph
in getSuccessorBranches (readSuccessorNodes subGraph 0 []) []
-- |The checkArrival function should return true if the current location of the robot is the destination, and false otherwise.
checkArrival::Node -> Node -> Bool
checkArrival destination curNode = destination == curNode
explored::Node-> [Node] ->Bool
explored point exploredList = elem point exploredList
-- Utilities --
-- given a list, will iterate through it and return the first Just value it finds, or a nothing if it doesn'tvalidBranches
-- when used on a map which maps depth first search to each branch, will cause the deepest branch to be evaluated first
firstJustOrNothing:: [Maybe a] -> Maybe a
firstJustOrNothing = (fromMaybe Nothing).(find (\result -> not $ isNothing result))
-- will take the first element satisfying the condition, or the last element if none do (last wont be checked)
takeFirstWithOrLastElem:: (a-> Bool) -> [a] -> a
takeFirstWithOrLastElem cond [x] = x
takeFirstWithOrLastElem cond (x:xs) = if cond x then x else takeFirstWithOrLastElem cond xs
-- returns list of branches without any invalid branches (i.e. paths which are not allowed)
validBranches:: [Branch] -> Graph -> [Branch]
validBranches branches graph = filter (validBranch) branches
where
first:: [a] -> Maybe a
first [] = Nothing
first (x:xs) = Just x
getsFromTo:: Node -> Node -> Bool
getsFromTo node1 node2 = any (\b -> first b == Just node1) (next [node2] graph)
validBranch branch = all (uncurry getsFromTo) (zip branch (tail branch))
-- checks if a branches' head is a goal node
isSolution [] _ = False
isSolution (x:xs) goal = checkArrival goal x
A branch represents a path from the initial state, it is a list of indices representing vertices on the graph. Think of the branches as the nodes (In the code node represents the nodes of the physical graph, here by nodes I mean nodes of the abstract search graph) in the search graphs, they only contain the state of the search, i.e. the vertices traversed and their order. We do not store the path cost or the parent node nor the action taken from the parent node to reach the child simply because we can derive all this data from the state stored in each branch.
The Graph is simply a flattened adjacency matrix (row-wise).
The next function is our transition function mapping one game state to the set of forward reachable states, it accepts the current search branch and the graph and outputs the list of reachable branches.
BFS
The first uninformed search method I was tasked to implement was BFS - Breadth First Search. This method is great for searches where there may be more than one target node or where there may be infinite depth branches. In completing this coursework I went through a couple approaches to solving BFS, in the end I decided to stick as close as I could to the pseudo-code we were tasked to follow (Artificial Intelligence: A Modern Approach ) and so my code ended up being a bit bloated - what can you do, I was implementing imperative pseudo code in a functional language ¯\_(ツ)_/¯ :
-- type to represent the context of a bfs search
type BfsContext = ([Branch],[Node],Maybe Branch)
-- BIG ASSUMPTION: I am assuming that the initial call to BFS will have at most one branch in the list, to avoid clutter!!
breadthFirstSearch::Graph -> Node->(Branch ->Graph -> [Branch])->[Branch]->[Node]->Maybe Branch
breadthFirstSearch [] _ _ _ _ = Nothing
breadthFirstSearch _ _ _ [] _ = Nothing
breadthFirstSearch g goal next ([]:xs) exploredList = breadthFirstSearch g goal next xs exploredList -- ignore empty branches, to be robust
breadthFirstSearch g goal next [startBranch] exploredList
| isSolution startBranch goal = Just startBranch
| otherwise = bfs' [startBranch] exploredList -- we launch search as normal, with the assumption that the agenda is already generated but not explored yet
where
-- the underlying auxilary function
-- I am representing the side effects of changing the agenda and explored list in the for loop with a tuple,
-- so that i can scan the agenda from the left and cause those 'intended side effects' for further items
bfs'::BfsContext
bfs' [] _ = Nothing -- if the agenda is empty, give up, no solution
bfs' agenda exploredList =
let
-- generates the given branch with given BFS context (agenda,exploredlist,current solution)
-- will return a new context after the node is generated
-- we check if a branch is a solution when it's generated
generateNode :: BfsContext -> Branch -> BfsContext
generateNode (a,el,ms) [] = (a,el,ms) -- an empty branch doesnt affect the context
generateNode (a,el,Just sol) _ = (a,el,Just sol) -- if a solution is already found, do nothing more
generateNode (agenda,exploredList,currSol) branch@(currNode:xs)
| elem currNode exploredList = (agenda,exploredList,currSol) -- if node is in explored (or in frontier, so also in explored), ignore it
| checkArrival goal currNode = (agenda,exploredList,Just branch)
| otherwise = (agenda++[branch],exploredList,currSol) -- when generating a node we add it to the end of the agenda if its not explored or a solution
-- expands the given branch with given context
-- will retutn a new context after the node is expanded
expandNode :: BfsContext -> Branch -> BfsContext
expandNode (([]:xs),el,ms) _ = (xs,el,ms) -- skip empty branches in agenda
expandNode (a,el,Just x) branch = (a,el,Just x) -- if we already found a solution, no need to expand this node
expandNode ((shallowestBranch:bs),exploredList,currSol) branch@(currNode:xs) =
foldl (generateNode) (bs,currNode:exploredList,currSol) (next branch g) -- when we expand a branch, we generate its successors, and update the frontier and explored list
-- we expand the nodes and change the context as we go, capturing the side effects, return the first context with solution or last context
(newAgenda,newExploredList,newSolution) = foldl expandNode (agenda,exploredList,Nothing) agenda
in
-- if we didn't find the solution we start the search on the next level, i.e. the new agenda
case newSolution of
Nothing -> bfs' newAgenda newExploredList
Just sol -> Just so
I use a "mini-state" to represent the state of the search, which makes things much clearer. Basically what I am doing is starting off the search in the outer function where I do some initial error checking and filtering the input for empty branches, as well as check if we're at the solution already, if not I launch the "real" function: bfs .
That function takes in the BfsContextwhich is simply:
- the list of branches (the current search agenda)
- a list of already explored vertices
- and the Maybe Branch representing whether or not we've pinned down the solution or not.
We then carry out these steps in order:
- check the agenda is empty, if so give up, we have no solution
- apply expandNode as a left fold over the agenda - what this does is start on the current BfsContext, take out the first branch then call expandNode with that context and the branch, this returns a new BfsContext which is then carried over and used in the next expandNode call with the next branch in the list and so on, notice how the BfsContext serves as the "state" of our expansion.
- check if after the fold (which will halt early at a solution due to how folds work!) we found a solution, if not we repeat this process on the new agenda and explored list from the returned context. Otherwise we return the solution
notice how node expansion refers to the act of discovering the children of a node, while node generation is the actual act of processing the said children. In BFS we perform the goal check after we discover a child, and before we generate it, this is to avoid having to traverse through the entire agenda if we find a solution at its beginning.
expandNode itself does nothing if the context contains a solution, and it skips empty branches, when it encounters a valid unsolved context it calls generateNode on each of the branches which in turn checks if each of them are a solution and if not amends the BfsContext to contain the new branches (skipping ones which we've already explored beforehand).
In the end our method performs these steps on each branch:
- Skip if empty, or if we have a solution do nothing
- Add current vertex (at the end of the branch) to explored
- Go through each successor branch and check if they're the solution, ignore those which have top nodes present in the explored list
- Add leftover branches to the agenda in the BfsContext
- If found a solution, set it in the BfsContext.
Due to the nature of FoldL and its laziness, Haskell will halt early once it finds a solution meaning that this algorithm is equivalent to the normal imperative version using loops.
DFS (and DLS)
The next algorithm was the Depth First Search, implemented with a depth limit, technically making it a Depth Limited Search:
-- I am assuming that the agenda will always have one branch the first time
depthLimitedSearch::Graph ->Node->(Branch ->Graph-> [Branch])->[Branch]-> Int->[Node]-> Maybe Branch
depthLimitedSearch [] _ _ _ _ _ = Nothing
depthLimitedSearch _ _ _ [] _ _ = Nothing
depthLimitedSearch g goal next [startBranch] d exploredList = dls' startBranch d exploredList
where
-- performs depth limited search with less arguments
dls'::Branch -> Int -> [Node]-> Maybe Branch
dls' [] _ _ = Nothing
dls' branch@(currNode:xs) d exploredList -- on depth limit, forget about successors
| d == 0 = if checkArrival goal currNode then Just branch else Nothing
| checkArrival goal currNode = Just branch
| explored currNode exploredList = Nothing
| otherwise =
msum $
map (\succBranch -> dls' succBranch (d-1) (currNode:exploredList)) $
(next branch g)
This is very simple, much better than the BFS implementation when it comes to looks. purely because DFS lends itself to recursion beautifully!
Here I simply do some error checking first, ignoring empty graphs and failing with an empty agenda at the start. After that I launch the actual search function bfs which accepts the current branch, the depth, and a explored list, returning the solution if found.
We cutoff the search whenever d == 0 meaning that we count the root node as the 0th "layer" and effectively the depth becomes the "maximum amount of direct transitions from the root" i.e. steps.
We check a node is the goal node before we generate it just as in BFS, and check if we have already explored it before recursing further down its children.
At each recursion we pass the amended explored list and decrease d by 1, meaning that each "arm" of the search keeps its own local state on the call stack.
A*
Besides giving me an excuse to use the function name ass. This task did not have anything much more exciting in store than DFS. A* is pretty much just guided DFS:
-- | The cost function calculates the current cost of a trace. The cost for a single transition is given in the adjacency matrix.
-- The cost of a whole trace is the sum of all relevant transition costs.
cost :: Graph ->Branch -> Int
cost [] _ = 0
cost _ [] = 0
cost _ [initialNode] = 0
cost graph (curNode:prevNode:ns) =
let
-- the address in the graph for the cost between prev and curr node
indexOfCost = ((prevNode * numNodes) + curNode)
-- the cost between prev and curr node
prevToCurrent = graph !! indexOfCost
in
case prevToCurrent of
0 -> 9999 -- invalid branches, get astronomical costs, because why not
_ -> prevToCurrent + cost graph (prevNode:ns)
-- | The getHr function reads the heuristic for a node from a given heuristic table.
-- The heuristic table gives the heuristic (in this case straight line distance) and has one entry per node. It is ordered by node (e.g. the heuristic for node 0 can be found at index 0 ..)
getHr:: [Int]->Node->Int
getHr hrTable node = hrTable !! node
aStarSearch::Graph->Node->(Branch->Graph -> [Branch])->([Int]->Node->Int)->[Int]->(Graph->Branch->Int)->[Branch]-> [Node]-> Maybe Branch
aStarSearch [] _ _ _ _ _ _ _ = Nothing
aStarSearch g goal next getHr hrTable cost agenda exploredList = ass' agenda exploredList
where
-- auxilary function with less arguments, assumes valid input, goal can be in input
ass':: [Branch] -> [Node] -> Maybe Branch
ass' [] _ = Nothing -- empty agenda = no solution
ass' ([]:bs) exploredList = ass' bs exploredList -- we skip empty branches
ass' (bestBranch@( currNode:ns ):bs) exploredList
| checkArrival goal currNode = Just bestBranch
| explored currNode exploredList = ass' bs exploredList -- to avoid loops, we don't cover identical nodes twice (consistent heuristic means no repetition guaranteed)
| otherwise =
let
evaulationFunction b = (getHr hrTable $ head b) + cost g b
newAgenda = (next bestBranch g) ++ bs -- we expand the bestBranch and add its children to the agenda
sortedBranches = sortOn evaulationFunction newAgenda -- next bestBranch is now at head of sortedBranches
in
ass' sortedBranches (currNode:exploredList) -- repeat the process
As you can see, with some sorting and prioritising of branches our DFS becomes an A* search!
MinMax
we didn't actually have to implement the pure min max algorithm - only the alpha beta version - but I decided to do both, since min max actually is extremely simple and works beautifully with Haskell:
minimax:: Role -> Game -> Int
minimax player game
| maxPlayer == player = maxMin game
| otherwise = minMax game
where
minMax game
| terminal game = eval game
| otherwise =
let
successors = movesAndTurns game compPlayer
in
minimum (map maxMin successors)
maxMin game
| terminal game = eval game
| otherwise =
let
successors = movesAndTurns game humanPlayer
in
maximum (map minMax successors)
And the Alpha Beta version:
alphabeta:: Role -> Game -> Int
alphabeta _ [] = 0 -- just in case
alphabeta player game
| maxPlayer == player = maxValue game (-2) 2 -- human player is max
| minPlayer == player = minValue game (-2) 2 -- comp player is min
where
-- finds the minimax value of a given game on max players turn
maxValue:: Game -> Int -> Int -> Int
maxValue game a b
| terminal game = eval game
| otherwise =
let
-- we find the successor/child games in reverse order (turns first)
nextGames:: [Game]
nextGames = reverse $ movesAndTurns game maxPlayer
-- given the best minimax value so far and the current alpha value and some game we can reach,
-- explore the given game and return the new best minimax value and alpha value after we explore that game
getMinimaxAndAlpha :: (Int,Int) -> Game -> (Int,Int)
getMinimaxAndAlpha (bestMinimaxVal,a) game =
let newMinimax = max (bestMinimaxVal) (minValue game a b)
in (newMinimax,max a newMinimax)
-- we keep updating v,a with each child game of the given game, if we find any with minimax value that is greater than the current beta (min has a better play)
-- we stop looking and pick the last minimax value we accumulated (the maximum minimax value so far)
(bestMinimax,newAlpha) =
takeFirstWithOrLastElem (\(v,a)-> v >= b) $
scanl getMinimaxAndAlpha (-2,a) nextGames
in bestMinimax
-- finds the minimax value of a given game on min players turn
minValue:: Game -> Int -> Int -> Int
minValue game a b
| terminal game = eval game
| otherwise =
let
-- we parse the successor states, in reverse order (turns first)
nextGames:: [Game]
nextGames = reverse $ movesAndTurns game minPlayer
-- given the best minimax value so far and the current beta value and some game we can reach,
-- explore the given game and return the new best minimax value and alpha value after we explore that game
getMinimaxAndBeta:: (Int,Int) -> Game -> (Int,Int)
getMinimaxAndBeta (bestMinimaxVal,b) game =
let newMinimax = min (bestMinimaxVal) (maxValue game a b)
in (newMinimax,min b newMinimax)
-- we keep updating v,b with each child game of the given game, if we find any with minimax value that is lesser than the current alpha (max has a better play)
-- we stop looking and pick the last minimax value we accumulated (the maximum minimax value so far)
(bestMinimax,newBeta) =
takeFirstWithOrLastElem (\(v,b)-> v <= a) $
scanl getMinimaxAndBeta (2,b) nextGames
in bestMinimax
As you can see, including pruning complicates the hell out of this algorithm, but overall it doesn't look to bad at all. The idea is pretty simple, we get rid of the branches of the decision tree which the rational opponent would simply never pick since he's already found a better scoring path which he is guaranteed to be able to take. We decide when that happens using the variables : alpha and beta which represent the best current scores for the min and max players, and we update those as we traverse the decision tree in DFS order - honestly it's not very complicated but the subtleties of when you update what can make this very hard to debug!
Results
The coursework received the Best Coursework Award ( There was a competition involved ) with a score of 98.5%! This won me a set of Quadrio, one of the games discussed in the questions of this coursework :)
Overall, This was one of the best pieces of coursework I've had the opportunity to work on, I honestly had tons of fun!