See and Believe: Visualizing with Gloss

Last week I discussed AI for the first time in a while. We learned about the Breadth-First-Search algorithm (BFS) which is so useful in a lot of simple AI applications. But of course writing abstract algorithms isn't as interesting as seeing them in action. So this week I'll re-introduce Gloss, a really neat framework I've used to make some simple games in Haskell.

This framework simplifies a lot of the graphical work one needs to do to make stuff show up on screen and it allows us to provide Haskell code to back it up and make all the logic interesting. I think Gloss also gives a nice demonstration of how we really want to structure a game and, in some sense, any kind of interactive program. We'll break down how this structure works as we make a simple display showing the BFS algorithm in practice. We'll actually have a "player" piece navigating a simple maze by itself.

To see the complete code, take a look at this GitHub repository! The Gloss code is all in the Game module.

Describing the World

In Haskell, the first order of business is usually to define our most meaningful types. Last week we did that by specifying a few simple aliases and types to use for our search function:

type Location = (Int, Int)
data Cell = Empty | Wall
  deriving (Eq)
type Grid = A.Array Location Cell

When we're making a game though, there's one type that is way more important than the rest, and this is our "World". The World describes the full state of the game at any point, including both mutable and immutable information.

In describing our simple game world, we might view three immutable elements, the fundamental constraints of the game. These are the "start" position, the "end" position, and the grid itself. However, we'll also want to describe the "current" position of our player, which can change each time it moves. This gives us a fourth field.

data World = World
  { playerLocation :: Location
  , startLocation :: Location
  , endLocation :: Location
  , worldGrid :: Grid
  }

We can then supplement this by making our "initial" elements. We'll have a base grid that just puts up a simple wall around our destination, and then make our starting World.

-- looks like:
-- S o o o
-- o x x o
-- o x F o
-- o o o o
baseGrid :: Grid
baseGrid =
  (A.listArray ((0, 0), (3, 3)) (replicate 16 Empty))
  A.//
  [((1, 1), Wall), ((1, 2), Wall), ((2, 1), Wall)]

initialWorld :: World
initialWorld = World (0, 0) (0, 0) (2, 2) baseGrid

Playing the Game

We've got our main type in place, but we still need to pull it together in a few different ways. The primary driver function of the Gloss library is play. We can see its signature here.

play :: Display -> Color -> Int
  -> world
  -> (world -> Picture)
  -> (Event -> world -> world)
  -> (Float -> world -> world)
  -> IO ()

The main pieces of this are driven by our World type. But it's worth briefly addressing the first three. The Display describes the viewport that will show up on our screen. We can give it particular dimensions and offset:

windowDisplay :: Display
windowDisplay = InWindow "Window" (200, 200) (10, 10)

The next two values just indicate the background color of the screen, and the tick rate (how many game ticks occur per second). And after those, we just have our initial world value as we made above.

main :: IO ()
main = play
  windowDisplay white 1 initialWorld
  ...

But now we have three more functions that are clearly driven by our World type. The first is a drawing function. It takes the current state of the world and create a Picture to show on screen.

The second function is an input handler, which takes a user input event as well as the current world state, and returns an updated world state, based on the event. We won't address this in this article.

The third function is an update function. This describes how the world naturally evolves without any input from tick to tick.

For now, we'll make type signatures as we prepare to implement these functions for ourselves. This allows us to complete our main function:

main :: IO ()
main = play
  windowDisplay white 20 initialWorld
  drawingFunc
  inputHandler
  updateFunc

drawingFunc :: World -> Picture

inputHandler :: Event -> World -> World

updateFunc :: Float -> World -> World

Let's move on to these different world-related functions.

Updating the World

Now let's handle updates to the world. To start, we'll make a stubbed out input-handler. This will just return the input world each tick.

inputHandler :: Event -> World -> World
inputHandler _ w = w

Now let's describe how the world will naturally evolve/update with each game tick. For this step, we'll apply our BFS algorithm. So all we really need to do is retrieve the locations and grid out of the world and run the function. If it gives us a non-empty list, we'll substitute the first square in that path for our new location. Otherwise, nothing happens!

updateFunc :: Float -> World -> World
updateFunc _ w@(World playerLoc _ endLoc grid time) =
  case path of
    (first : rest) -> w {playerLocation = first}
    _ -> w
  where
    path = bfsSearch grid playerLoc endLoc

Note that this function receives an extra "float" argument. We don't need to use this.

Drawing

Finally, we need to draw our world so we can see what is going on! To start, we need to remember the difference between the "pixel" positions on the screen, and the discrete positions in our maze. The former are floating point values up to (200.0, 200.0), while the latter are integer numbers up to (3, 3). We'll make a type to store the center and corner points of a given cell, as well as a function to generate this from a Location.

A lot of this is basic arithmetic, but it's easy to go wrong with sign errors and off-by-one errors!

data CellCoordinates = CellCoordinates
  { cellCenter :: Point
  , cellTopLeft :: Point
  , cellTopRight :: Point
  , cellBottomRight :: Point
  , cellBottomLeft :: Point
  }

-- First param: (X, Y) offset from the center of the display to center of (0, 0) cell
-- Second param: Full width of a cell
locationToCoords :: (Float, Float) -> Float -> Location -> CellCoordinates
locationToCoords (xOffset, yOffset) cellSize (x, y) = CellCoordinates
  (centerX, centerY)
  (centerX - halfCell, centerY + halfCell) -- Top Left
  (centerX + halfCell, centerY + halfCell) -- Top Right
  (centerX + halfCell, centerY - halfCell) -- Bottom Right
  (centerX - halfCell, centerY - halfCell) -- Bottom Left
  where
    (centerX, centerY) = (xOffset + (fromIntegral x) * cellSize, yOffset - (fromIntegral y) * cellSize)
    halfCell = cellSize / 2.0

Now we need to use these calculations to draw pictures based on the state of our world. First, let's write a conversion that factors in the specifics of the display, which allows us to pinpoint the center of the player marker.

drawingFunc :: World -> Picture
drawingFunc world =
  ...
  where
    conversion = locationToCoords (-75, 75) 50
    (px, py) = cellCenter (conversion (playerLocation world))

Now we can draw a circle to represent that! We start by making a Circle that is 10 pixels in diameter. Then we translate it by the coordinates. Finally, we'll color it red. We can add this to a list of Pictures we'll return.

drawingFunc :: World -> Picture
drawingFunc world = Pictures
  [ playerMarker ]
  where
    -- Player Marker
    conversion = locationToCoords (-75, 75) 50
    (px, py) = cellCenter (conversion (playerLocation world))
    playerMarker = Color red (translate px py (Circle 10))

Now we'll make Polygon elements to represent special positions on the board. Using the corner elements from CellCoordinates, we can draw a blue square for the start position and a green square for the final position.

drawingFunc :: World -> Picture
drawingFunc world = Pictures
  [startPic, endPic, playerMarker ]
  where
    -- Player Marker
    conversion = locationToCoords (-75, 75) 50
    (px, py) = cellCenter (conversion (playerLocation world))
    playerMarker = Color red (translate px py (Circle 10))

    # Start and End Pictures
    (CellCoordinates _ stl str sbr sbl) = conversion (startLocation world)
    startPic = Color blue (Polygon [stl, str, sbr, sbl])
    (CellCoordinates _ etl etr ebr ebl) = conversion (endLocation world)
    endPic = Color green (Polygon [etl, etr, ebr, ebl])

Finally, we do the same thing with our walls. First we have to filter all the elements in the grid to get the walls. Then we must make a function that will take the location and make the Polygon picture. Finally, we combine all of these into one picture by using a Pictures list, mapped over these walls. Here's the final look of our function:

drawingFunc :: World -> Picture
drawingFunc world = Pictures
  [gridPic, startPic, endPic, playerMarker ]
  where
    -- Player Marker
    conversion = locationToCoords (-75, 75) 50
    (px, py) = cellCenter (conversion (playerLocation world))
    playerMarker = Color red (translate px py (Circle 10))

    # Start and End Pictures
    (CellCoordinates _ stl str sbr sbl) = conversion (startLocation world)
    startPic = Color blue (Polygon [stl, str, sbr, sbl])
    (CellCoordinates _ etl etr ebr ebl) = conversion (endLocation world)
    endPic = Color green (Polygon [etl, etr, ebr, ebl])

    # Drawing the Pictures for the Walls
    walls = filter (\(_, w) -> w == Wall) (A.assocs $ worldGrid world)
    mapPic (loc, _) = let (CellCoordinates _ tl tr br bl) = conversion loc 
                          in Color black (Polygon [tl, tr, br, bl])
    gridPic = Pictures (map mapPic walls)

And now when we play the game, we'll see our circle navigate to the goal square!

Next time, we'll look at a more complicated version of this kind of game world!

AI Revisited: Breaking Down BFS

So we're approaching the end of the year, and of all the topics that I've tended to focus on in my writings, there's one that I haven't really written about in probably over a year, and this is AI and Machine Learning. I've still been doing some work behind the scenes, as you'll know if you keep following the blog for the next few weeks. But I figured I'd spend the last few weeks of the year with some AI related topics. This week, I'll go over an algorithm that is really useful to understand when it comes to writing simple AI programs, and this is Breadth-First-Search.

All the code for the next few weeks can be found in this GitHub repository! For this week, all the code can be found in the BFS module.

The Algorithm

To frame this problem in a more concrete way, let's imagine we have a 2-dimensional grid. Some spaces are free, other spaces are "walls". We want to use breadth first search to find a path from a start point to a destination point.

a___
_xx_
_xb_
____

So our algorithm will take two locations, and return a path from location A to Location B, or an empty list if no path can be found.

The key data structure when executing a breadth-first-search is a queue. Our basic approach is this: we will place our starting location in the queue. Then, we'll go through a loop as long as the queue is not empty. We'll pull an item off, and then add each of the empty neighbors on to the back of the queue, as long as they haven't been added yet. If we dequeue the destination, we're done! But if we reach an empty queue, then we don't have a valid path.

The last tricky part is that we to track the "parent" of each location. That is, which of its neighbors placed it on the queue? This will allow us to reconstruct the path we need to take to get from point a to point b.

So let's imagine we have a simple graph like in the ASCII art above. We start at (0,0). Our queue will operate like this.

It contains (0,0). We'll then enqueue (0, 1) and (1, 0), since those are the neighbors of (0, 0).

(0, 0) <-- Current
(0, 1)
(1, 0)

Then we're done with (0, 0). So we dequeue (0, 1). This its only neighbor is (0, 2), so that gets placed on the end of the queue.

(0, 1) <-- Current
(1, 0)
(0, 2)

And then we repeat the process with (1, 0), placing (0, 2).

(1, 0) <-- Current
(0, 2)
(2, 0)

We keep doing this until we navigate around to our destination at (2,2).

Types First

How do we translate this to Haskell? My favorite approach to problems like this is to use a top-down, type driven, compile-first method of writing the algorithm. Because before we can really get started in earnest, we have to define our data structures and our types. First, let's alias an integer tuple as a "Location":

type Location = (Int, Int)

Now, we're going to imagine we're navigating a 2D grid, and we'll represent this with an array where the indices are tuples which represent locations, and each value is either "empty" or "wall". We can move through empty spaces, but we cannot move through walls.

data Cell = Empty | Wall
  deriving (Eq)
type Grid = A.Array Location Cell

Now we're ready to define the type signature for our function. This takes the grid as an input, as well as the start and end location:

bfsSearch :: Grid -> Location -> Location -> [Location]

We'll need one more type to help frame the problem. This algorithm will use the State monad, because there's a lot of state we need to track here. First off, we need the queue itself. We represent this with the Sequence type in Haskell. Then, we need our set of visited locations. Each time we enqueue a location, we'll save it here. Last, we need our "parents" map. This will help us determine the path at the very end.

data BFSState = BFSState
  { queue :: S.Seq Location
  , visited :: Set.Set Location
  , parents :: M.Map Location Location
  }

A Stateful Skeleton

With these types, we can start framing the problem a bit more. First, we want to construct our initial state. Everything is empty except our queue has the starting location on it.

bfsSearch :: Grid -> Location -> Location -> [Location]
bfsSearch grid start finish = ...
  where
    initialState = BFSState (S.singleton start) Set.empty M.empty

Now we want to pass this function to a stateful computation that returns our list. So we'll imagine we have a helper in the State monad which returns our location. We'll call this bfsSearch'. We can then fill in our original function with evalState.

bfsSearch :: Grid -> Location -> Location -> [Location]
bfsSearch grid start finish = evalState (bfsSearch' grid finish) initialState
  where
    initialState = BFSState (S.singleton start) Set.empty M.empty

bfsSearch' :: Grid -> Location -> State BFSState [Location]
...

Base Case

Now within our stateful helper, we can recognize that this will be a recursive function. We dequeue an element, enqueue its neighbors, and then repeat the process. So let's handle the base cases first. We'll retrieve our sequence from the state and check if it's empty or not. If it's empty, we return the empty list. This means that we couldn't find a path.

bfsSearch' :: Grid -> Location -> State BFSState [Location]
bfsSearch' grid finish = do
  (BFSState q v p) <- get
  case S.viewl q of
    (top S.:< rest) -> ...
    _ -> return []

Now another base case is where the top of our queue is the destination. In this case, we're ready to "unwind" the path from that destination in our stateful map. Let's imagine we have a function to handle this unwinding process. We'll fill it in later.

bfsSearch' :: Grid -> Location -> State BFSState [Location]
bfsSearch' grid finish = do
  (BFSState q v p) <- get
  case S.viewl q of
    (top S.:< rest) -> if top == finish
      then return (unwindPath p [finish])
      else ...
    _ -> return []

unwindPath :: M.Map Location Location -> [Location] -> [Location]

The General Case

Now let's write out the steps for our general case.

1. Get the neighbors of the top element on the queue
2. Append these to the "rest" of the queue (discarding the top element).
3. Insert this top element into our "visited" set v.
4. For each new location, insert it into our "parents" map with the current top as its "parent".
5. Update our final state and recurse!

Each of these statements is 1-2 lines in our function, except we'll want to make a helper for the first line. Let's imagine we have a function that can give us the unvisited neighbors of a space in our grid. This will require passing the location, the grid, and the visited set.

let valid adjacent = getValidNeighbors top grid v
...

getValidNeighbors ::
  Location -> Grid -> Set.Set Location -> [Location]

The next lines involve data structure manipulation, with a couple tricky folds. First, appending the new elements into the queue.

let newQueue = foldr (flip (S.|>)) rest validAdjacent

Next, inserting the top into the visited set. This one's easy.

let newVisited = Set.insert top v

Now, insert each new neighbor into the parents map. The new location is the "key", and the current top is the value.

let newParentsMap = foldr (\loc -> M.insert loc top) p validAdjacent

Last of all, we replace the state and recurse!

put (BFSState newQueue newVisited newParentsMap)
bfsSearch' grid finish

Here's our complete function!

bfsSearch' :: Grid -> Location -> State BFSState [Location]
bfsSearch' grid finish = do
  (BFSState q v p) <- get
  case S.viewl q of
    (top S.:< rest) -> if top == finish
      then return (unwindPath p [finish])
      else do
        let validAdjacent = getValidNeighbors top grid v
        let newQueue = foldr (flip (S.|>)) rest validAdjacent
        let newVisited = Set.insert top v
        let newParentsMap = foldr (\loc -> M.insert loc top) p validAdjacent
        put (BFSState newQueue newVisited newParentsMap)
        bfsSearch' grid finish
    _ -> return []

Filling in Helpers

Now we just need to fill in our helper functions. Unwinding the map is a fairly straightforward tail-recursive problem. We get the parent of the current element, and keep an accumulating list of the places we've gone:

unwindPath :: M.Map Location Location -> [Location] -> [Location]
unwindPath parentsMap currentPath = case M.lookup (head currentPath) parentsMap of
  Nothing -> tail currentPath
  Just parent -> unwindPath parentsMap (parent : currentPath)

Finding the neighbors is slightly tricker. For each direction (right, down, left, and right), we have to consider if the "neighbor" cell is in bounds. Then we have to consider if it's empty. Finally, we need to know if it is still "unvisited". As long as all three of these conditions hold, we can potentially add it. Here's what this process looks like for finding the "right" neighbor.

getValidNeighbors :: Location -> Grid -> Set.Set Location -> [Location]
getValidNeighbors (r, c) grid v = ...
  where
    (rowMax, colMax) = snd . A.bounds $ grid
    right = (r, c + 1)
    right' = if c + 1 <= colMax && grid A.! right == Empty && not (Set.member right v)
      then Just right
      else Nothing

We do this in every direction, and we'll use catMaybes so we only get the correct ones in the end!

getValidNeighbors :: Location -> Grid -> Set.Set Location -> [Location]
getValidNeighbors (r, c) grid v = catMaybes [right', down', left', up']
  where
    (rowMax, colMax) = snd . A.bounds $ grid
    right = (r, c + 1)
    right' = if c + 1 <= colMax && grid A.! right == Empty && not (Set.member right v)
      then Just right
      else Nothing
    down = (r + 1, c)
    down' = if r + 1 <= rowMax && grid A.! down == Empty && not (Set.member down v)
      then Just down
      else Nothing
    left = (r, c - 1)
    left' = if c - 1 >= 0 && grid A.! left == Empty && not (Set.member left v)
      then Just left
      else Nothing
    up = (r - 1, c)
    up' = if r - 1 >= 0 && grid A.! up == Empty && not (Set.member up v)
      then Just up
      else Nothing

Conclusion

This basic structure can also be adapted to use depth-first search as well! The main difference is that you must treat the Sequence as a stack instead of a queue, appending new items to the left side of the sequence. Both of these algorithms are guaranteed to find a path if it exists. But BFS will find the shortest path in this kind of scenario, whereas DFS probably won't!

Next week, we'll continue a basic AI exploration by putting this algorithm to work in a game environment with Gloss!

Quicksort with Haskell!

Last week we referenced the ST monad and went into a little bit of depth with how it enables mutable arrays. It provides an alternative to the IO monad that gives us mutable data without side effects. This week, we're going to take a little bit of a break from adding features to our Maze game. We'll look at a specific example where mutable data can allow different algorithms.

Let's consider the quicksort algorithm. We can do this "in place", mutating an input array. But immutable data in Haskell makes it difficult to implement this approach. We'll examine one approach using normal, immutable lists. Then we'll see how we can use a more common quicksort algorithm using ST. At the end of the day, there are still difficulties with making this work the way we'd like. But it's a useful experiment to try nonetheless.

Still new to monads in Haskell? You should read our series on Monads and Functional Structures! It'll help you learn monads from the ground up, starting with simpler concepts like functors!

The ST Monad

Before we dive back into using arrays, let's take a quick second to grasp the purpose of the ST monad. My first attempt at using mutable arrays in the Maze game involved using an IOArray. This worked, but it caused generateRandomMaze to use the IO monad. You should be very wary of any action that changes your code from pure to using IO. The old version of the function couldn't have weird side effects like file system access! The new version could have any number of weird bugs present! Among other things, it makes it much harder to use and test this code.

In my specific case, there was a more pressing issue. It became impossible to run random generation from within the eventHandler. This meant I couldn't restart the game how I wanted. The handler is a pure function and can't use IO.

The ST monad provides precisely what we need. It allows us to run code that can mutate values in place without allowing arbitrary side effects, as IO does. We can use the generic runST function to convert a computation in the ST monad to it's pure result. This is similar to how we can use runState to run a State computation from a pure one.

runST :: (forall s. ST s a) -> a

The s parameter is a little bit magic. We generally don't have to specify what it is. But the parameter prevents the outside world from having extra side effects on the data. Don't worry about it too much.

There's another function runSTArray. This does the same thing, except it works with mutable arrays:

runSTArray :: (forall s. ST s (STArray s i e)) -> Array i e

This allows us to use STArray instead of IOArray as our mutable data type. Later in this article, we'll use this type to make our "in-place" quicksort algorithm. But first, let's look at a simpler version of this algorithm.

Slow Quicksort

Learn You a Haskell For Great Good presents a short take on the quicksort algorithm. It demonstrates the elegance with which we can express recursive solutions.

quicksort1 :: (Ord a) => [a] -> [a]
quicksort1 [] = []
quicksort1 (x:xs) =
  let smallerSorted = quicksort1 [a | a <- xs, a <= x]
      biggerSorted = quicksort1 [a | a <- xs, a > x]
  in  smallerSorted ++ [x] ++ biggerSorted

This looks very nice! It captures the general idea of quicksort. We take the first element as our pivot. We divide the remaining list into the elements greater than the pivot and less than the pivot. Then we recursively sort each of these sub-lists, and combine them with the pivot in the middle.

However, each new list we make takes extra memory. So we are copying part of the list at each recursive step. This means we will definitely use at least O(n) memory for this algorithm.

We can also note the way this algorithm chooses its pivot. It always selects the first element. This is quite inefficient on certain inputs (sorted or reverse sorted arrays). To get our expected performance to a good point, we want to choose the pivot index at random. But then we would need an extra argument of type StdGen, so we'll ignore it for this article.

It's possible of course, to do quicksort "in place", without making any copies of any part of the array! But this requires mutable memory. To get an idea of what this algorithm looks like, we'll implement it in Java first. Mutable data is more natural in Java, so this code will be easier to follow.

In-Place Quicksort (Java)

The quicksort algorithm is recursive, but we're going to handle the recursion in a helper. The helper will take two add extra arguments: the int values for the "start" and "end" of this quicksort section. The goal of quicksortHelper will be to ensure that we've sorted only this section. As a stylistic matter, I use "end" to mean one index past the point we're sorting to. So our main quicksort function will call the helper with 0 and arr.length.

public static void quicksort(int[] arr) {
  quicksortHelper(arr, 0, arr.length);
}

public static void quicksortHelper(int[] arr, int start, int end) {
  ...
}

Before we dive into the rest of that function though, let's design two smaller helpers. The first is very simple. It will swap two elements within the array:

public static void swap(int[] arr, int i, int j) {
  int temp = arr[i];
  arr[i] = arr[j];
  arr[j] = temp;
}

The next helper will contain the core of the algorithm. This will be our partition function. It's responsible for choosing a pivot (again, we'll use the first element for simplicity). Then it divides the array so that everything smaller than the pivot is in the first part of the array. After, we insert the pivot, and then we get the larger elements. It returns the index of partition:

public static int partition(int[] arr, int start, int end) {
  int pivotElement = arr[start];
  int pivotIndex = start + 1;
  for (int i = start + 1; i < end; ++i) {
    if (arr[i] <= pivotElement) {
      swap(arr, i, pivotIndex);
      ++pivotIndex;
    }
  }
  swap(arr, start, pivotIndex - 1);
  return pivotIndex - 1;
}

Now our quicksort helper is easy! It will partition the array, and then make recursive calls on the sub-parts! Notice as well the base case:

public static void quicksortHelper(int[] arr, int start, int end) {
  if (start + 1 >= end) {
    return;
  }
  int pivotIndex = partition(arr, start, end);
  quicksortHelper(arr, start, pivotIndex);
  quicksortHelper(arr, pivotIndex + 1, end);
}

Since we did everything in place, we didn't allocate any new arrays! So our function definitions only add O(1) extra memory for the temporary values. Since the stack depth is, on average, O(log n), that is the asymptotic memory usage for this algorithm.

In-Place Quicksort (Haskell)

Now that we're familiar with the in-place algorithm, let's see what it looks like in Haskell. We want to do this with STArray. But we'll still write a function with pure input and output. Unfortunately, this means we'll end up using O(n) memory anyway. The thaw function must copy the array to make a mutable version of it. However, the rest of our operations will work in-place on the mutable array. We'll follow the same patterns as our Java code! Let's start simple and write our swap function!

swap :: ST s Int a -> Int -> Int -> ST s ()
swap arr i j = do
  elem1 <- readArray arr i
  elem2 <- readArray arr j
  writeArray arr i elem2
  writeArray arr j elem1

Now let's write out our partition function. We're going to make it look as much like our Java version as possible. But it's a little tricky because we're don't have for-loops! Let's deal with this problem head on by first designing a function to handle the loop.

The loop produces our value for the final pivot index. But we have to keep track of its current value. This sounds like a job for the State monad! Our state function will take the pivotElement and the array itself as a parameter. Then it will take a final parameter for the i value we have in our partition loop in the Java version.

partitionLoop :: (Ord a)
  => STArray s Int a
  -> a
  -> Int
  -> StateT Int (ST s) ()
partitionLoop arr pivotElement i = do
  ...

We fill this with comparable code to Java. We read the current pivot and the element for the current i index. Then, if it's smaller, we swap them in our array, and increment the pivot:

partitionLoop :: (Ord a)
  => STArray s Int a
  -> a
  -> Int
  -> StateT Int (ST s) ()
partitionLoop arr pivotElement i = do
  pivotIndex <- get
  thisElement <- lift $ readArray arr i
  when (thisElement <= pivotElement) $ do
    lift $ swap arr i pivotIndex
    put (pivotIndex + 1)

Now we incorporate this loop into our primary partition function after getting the pivot element. We'll use mapM to sequence the state actions together and pass that to execStateT. Then we'll return the final pivot (subtracting 1). Don't forget to swap the pivot into the middle of the array though!

partition :: (Ord a)
 => STArray s Int a
 -> Int
 -> Int
 -> ST s Int
partition arr start end = do
  pivotElement <- readArray arr start
  let pivotIndex_0 = start + 1
  finalPivotIndex <- execStateT
    (mapM (partitionLoop arr pivotElement) [(start+1)..(end-1)])
    pivotIndex_0
  swap arr start (finalPivotIndex - 1)
  return $ finalPivotIndex - 1

Now it's super easy to incorporate these into our final function!

quicksort2 :: (Ord a) => Array Int a -> Array Int a
quicksort2 inputArr = runSTArray $ do
  stArr <- thaw inputArr
  let (minIndex, maxIndex) = bounds inputArr
  quicksort2Helper minIndex (maxIndex + 1) stArr
  return stArr

quicksort2Helper :: (Ord a)
  => Int 
  -> Int
  -> STArray s Int a
  -> ST s ()
quicksort2Helper start end stArr = when (start + 1 < end) $ do
  pivotIndex <- partition stArr start end
  quicksort2Helper start pivotIndex stArr
  quicksort2Helper (pivotIndex + 1) end stArr

This completes our algorithm! Notice again though, that we use thaw and freeze. This means our main quicksort2 function can have pure inputs and outputs. But it comes at the price of extra memory. It's still cool though that we can use mutable data from inside a pure function!

Conclusion

Since we have to copy the list, this particular example doesn't result in much improvement. In fact, when we benchmark these functions, we see that the first one actually performs quite a bit faster! But it's still a useful trick to understand how we can manipulate data "in-place" in Haskell. The ST monad allows us to do this in a "pure" way. If we're willing to accept impure code, the IO monad is also possible.

Next week we'll get back to game development! We'll add enemies to our game that will go around and try to destroy our player! As we add more and more features, we'll continue to see cool ways to learn about algorithms in Haskell. We'll also see new ways to architect the game code.

There are many other advanced Haskell programs you can write! Check out our Production Checklist for ideas!