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:

  1. check the agenda is empty, if so give up, we have no solution
  2. 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.
  3. 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:

  1. Skip if empty, or if we have a solution do nothing
  2. Add current vertex (at the end of the branch) to explored
  3. Go through each successor branch and check if they're the solution, ignore those which have top nodes present in the explored list
  4. Add leftover branches to the agenda in the BfsContext
  5. 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!