Advanced Search with Drilling!


In last week's article we explored how we can make an AI for our main player character. This meant we could play the game without input from a user. The game can now "play itself", and churn out a lot of iterations and results. This, in turn, will let us test combinations of parameters so we can make levels that are challenging.

Our AI is still a little too simplistic. The version we made last week doesn't incorporate the drill feature at all. So this week, let's see if we can devise a way to use that. We'll start with some of the search algorithm ideas we're already using for BFS, and expand from there.

For this article, you'll want to look at the player-ai-drill branch on our Github Repository. It has the full implementation, and you can check the newest commits to see what has changed.

This article will depend a lot on our knowledge of monads, particularly the state monad. If you're newer to Haskell development, you should check out our series on Functional Data Structures. It'll help you understand this tricky concept better.

Updating Our Types

Once again, there are a few quick updates we'll want to make before we start writing our AI. Last week we wrote our main function using this type:

data MoveChoice =
  MoveUp |
  MoveRight |
  MoveDown |
  MoveLeft |

data PlayerMove = PlayerMove
  { playerMoveChoice :: MoveChoice
  , activateStun :: Bool

makePlayerMove :: World -> PlayerMove

First we'll change the original type to be MoveDirection. Then to account for the drill powerup, we'll add another field using this type:

data MoveDirection =
  DirectionUp |
  DirectionRight |
  DirectionDown |
  DirectionLeft |

data PlayerMove = PlayerMove
  { playerMoveDirection :: MoveDirection
  , activateStun :: Bool
  , drillDirection :: MoveDirection

So we can start out by using DirectionNone for the drill every time, and ensure our game works.

Modifying the World

With the new potential to use the drill to change our world, we'll want another modifier function. This will reuse a lot of old code from our player input section.

modifyWorldForDrill :: World -> MoveDirection -> World

To start, we'll refactor our drillLocation function to be a top level function. Nothing much has to change with its implementation. Let's recall its type signature:

  :: (CellBoundaries -> BoundaryType)
  -> (CellBoundaries -> CellBoundaries)
  -> (CellBoundaries -> CellBoundaries)
  -> World
  -> World

Now our player modifier is pretty straightforward. We'll do a case analysis of the desired direction, as we do with the input keys. This gives us all the necessary inputs to drillLocation:

modifyWorldForPlayerDrill :: World -> MoveDirection -> World
modifyWorldForPlayerDrill w drillDirection = case drillDirection of
  DirectionUp ->
      drillLocation upBoundary breakUpWall breakDownWall w
  DirectionRight ->
      drillLocation rightBoundary breakRightWall breakLeftWall w
  DirectionDown ->
      drillLocation downBoundary breakDownWall breakUpWall w
  DirectionLeft ->
      drillLocation leftBoundary breakLeftWall breakRightWall w
  DirectionNone -> w

And now working this into our update function is easy. It's just another function we have to compose with the other options. We'll apply the drill as the first step, even before the stun:

updateWorldForPlayerMove :: World -> World
updateWorldForPlayerMove w = if shouldMovePlayer
  then worldAfterMove
  else w
    move = makePlayerMove w

    worldAfterDrill =
        modifyWorldForPlayerDrill w (drillDirection move)

    worldAfterStun = if activateStun move
      then modifyWorldForStun worldAfterDrill
      else worldAfterDrill

    … -- Apply move

Changing the AI

Now let's get cracking on a better algorithm! The good news is that we can still stick to breadth first search. But what needs to change is the items in our search queue. There's a certain amount of state involved in each path we take. Before, we know that if a path backtracks onto a previous location, it will be slower. But now, we can have a faster path coming over a previous square IF we do so with more drills. But each time we take a drill, we need to remove it from the map (from the point of view of this path). Otherwise we could keep picking up the same drill! Thus a "search item", as we'll call it, must also contain the number of drills we have as well as the set of drill power-ups existing on the map. This item has all the important world state for our player moving around the map.

type DrillSearchItem = (Location, Word, Set.Set Location)

Then the other obvious change is that we can go to more adjacent squares. As long as the drill count is at least one, we can go to any adjacent tile. We'll see how this factors into our algorithm below.

Re-Doing BFS

We're going to mimic our original BFS algorithm for the most part when it comes to the drilling version. First, let's reconsider our notion of "adjacent" cells. Remember this function from BFS?

getAdjacentLocations :: Maze -> Location -> [Location]

We now want to re-write it using our DrillSearchItem alias.

getDrillAdjacentItems :: Maze -> DrillSearchItem -> [DrillSearchItem]

In the previous version, we had a section dedicated to checking the bounds around the given location. Then we could see which locations are adjacent. We'll want a similar section for drilling, but we want to use walls as well, as long as we have at least one drill. So let's pattern match on our current item, and gather the locations we can use. We'll also use a boolean to denote if we used a drill to get to that location.

getDrillAdjacentItems :: Maze -> DrillSearchItem -> [DrillSearchItem]
getDrillAdjacentItems maze (location, drillsRemaining, drillLocs) =
    canDrill = drillsRemaining > 0

    maybeUpLoc = case upBoundary bounds of
      (AdjacentCell loc) -> Just (loc, False)
      (Wall loc) -> if canDrill then Just (loc, True) else Nothing
      _ -> Nothing
    maybeRightLoc = case rightBoundary bounds of
      (AdjacentCell loc) -> Just (loc, False)
      (Wall loc) -> if canDrill then Just (loc, True) else Nothing
      _ -> Nothing
    maybeDownLoc = case downBoundary bounds of
      (AdjacentCell loc) -> Just (loc, False)
      (Wall loc) -> if canDrill then Just (loc, True) else Nothing
      _ -> Nothing
    maybeLeftLoc = case leftBoundary bounds of
      (AdjacentCell loc) -> Just (loc, False)
      (Wall loc) -> if canDrill then Just (loc, True) else Nothing
      _ -> Nothing

Now we want a helper function to convert each of these results into a new DrillSearchItem. If we applied the drill, we'll want to subtract one from the remaining drills count. But then if we go over a drill powerup, we'll increment the count and remove this location from our set:

getDrillAdjacentItems :: Maze -> DrillSearchItem -> [DrillSearchItem]
getDrillAdjacentItems maze (location, drillsRemaining, drillLocs) =
    mkItemFromResult :: (Location, Bool) -> DrillSearchItem
    mkItemFromResult (loc, usedDrill) =
      let drillsAfterMove =
        if usedDrill
          then drillsRemaining - 1
          else drillsRemaining

      let (drillsAfterPickup, newDrillLocs) =
        if Set.member loc drillLocs
          then (drillsAfterMove + 1, Set.delete loc drillLocs)
          else (drillsAfterMove, drillLocs)
      in  (loc, drillsAfterPickup, newDrillLocs)

And then finally we apply this function over every Just result in our adjacent items!

getDrillAdjacentItems :: Maze -> DrillSearchItem -> [DrillSearchItem]
getDrillAdjacentItems maze (location, drillsRemaining, drillLocs) =
  mkItemFromResult <$>
   (catMaybes [maybeUpLoc, maybeRightLoc, maybeDownLoc, maybeLeftLoc])

When we rewrite the other BFS functions, the changes are quite trivial. We'll write a new function for the BFS search, since it will apply the different helper, along with other surface level tweaks. The state stays the same except for using DrillSearchItems:

data DrillBFSState = DrillBFSState
  (Seq.Seq DrillSearchItem)
  (Set.Set DrillSearchItem)
  (Map.Map DrillSearchItem DrillSearchItem)

drillBFS :: Maze -> Location -> State DrillBFSState [Location]

Note that we're still only returning a list of locations. We'll let other functions handle the logic of determining if we used the drill or not. So our final call to this function is pretty clean. It just takes a couple extra arguments for our initial state:

  :: Maze
  -> Word
  -> Set.Set Location
  -> Location
  -> Location
  -> [Location]
  maze numDrills drillLocs initialLocation targetLocation = 
          (drillBFS maze targetLocation)
          (Seq.singleton initialItem)
          (Set.singleton initialItem)
    initialItem =
      (initialLocation, numDrills, drillLocs)

Last Touches

Once we've changed our algorithm, we have to make one more change to the makePlayerMove function. We'll examine the shortestPathMoveDirection. This will tell us the location we're supposed to go to next. If this is behind a wall, we know we also have to apply the drill in that direction. If it's an AdjacentCell, the drill is not necessary, so use DirectionNone.

makePlayerMove :: World -> PlayerMove
makePlayerMove w =
  PlayerMove finalMoveDirection useStun drillDirection
    shortestPath = getShortestPathWithDrills
      (playerDrillsRemaining currentPlayer)
      (Set.fromList $ worldDrillPowerUpLocations w)
      (endLocation w)
    shortestPathMoveLocation = if null shortestPath
      then playerLoc
      else (head shortestPath)
    shortestPathMoveDirection =
      getMoveDirection playerLoc shortestPathMoveLocation

    locationBounds = maze Array.! playerLoc

    -- Apply the drill if there's a wall!
    drillDirection = case shortestPathMoveDirection of
      DirectionUp -> case upBoundary locationBounds of
        Wall _ -> DirectionUp
        _ -> DirectionNone
      DirectionRight -> case rightBoundary locationBounds of
        Wall _ -> DirectionRight
        _ -> DirectionNone
      DirectionDown -> case downBoundary locationBounds of
        Wall _ -> DirectionDown
        _ -> DirectionNone
      DirectionLeft -> case leftBoundary locationBounds of
        Wall _ -> DirectionLeft
        _ -> DirectionNone
      DirectionNone -> DirectionNone


Note that we don't need to perform any checks on whether drilling is viable here. If, for some reason, our AI tells us to use the drill and it's invalid, drillLocation will stop this. Then our function for getting the next location will keep the player stationary.

Now we can go ahead and play the game with the AI enabled. We can see that it uses the drill effectively and makes intelligent choices about where and when to do so. It will sometimes go out of its way to pick up an extra drill if this allows it to make a strategic hole. It's not 100% optimal. For instance, we won't use a drill to break a wall to pick up three hidden drills. But it covers most of the important cases for us.

There is a drawback with our algorithm. The game can actually appear a little choppy, especially at the start of the maze. Because we modified the search state to contain a lot more information, the search space is many times bigger. So it is slower to arrive at solutions, especially when we're far from the end.

There are ways we can make this basic algorithm more efficient. Caching is a good place to start. We recompute a lot of information about distances within the maze every time. But there are also other search approaches we can make that will generally be faster. In the coming weeks, we'll explore some of these options.


But first, we'll take a look next week at how we can now run the game separately from the UI. This will allow us to perform many iterations. We'll measure the AI's success rate under different parameters. We'll see how the size of the maze, the number of enemies, and the number of drills affects that rate. This will give us information we can use to make a better use experience for players.

If you want to learn more about Haskell, you should subscribe to our mailing list! You'll get our monthly newsletter, as well as access to our subscriber resouces! This includes, for instance, our Beginners Checklist, to help you get started!

And last, don't forget to take a look at our Github Repository to see all the code in its final state! For this article, look for the player-ai-drill branch!