Day 18 - Lava Surface Area — Monday Morning Haskell

After a couple brutally hard days, today was a breather.

All 2022 Problems

Problem Overview

For this problem we are estimating the exposed surface area of a series of cubes in 3D space. In part 1, we'll include the surface area of air pockets inside the structure. For part 2, we'll only consider those faces on the outside.

Solution Approach and Insights

For part 2, the key is to view it as a BFS problem. We want to explore all the space around the lava structure. Each time we try to explore a cube and find that it's part of the structure, we'll increase the count of faces.

Parsing the Input

Our input is a series of 3D coordinates. Each of these represents a 1x1x1 cube that is part of the lava structure.

2,2,2
1,2,2
3,2,2
2,1,2
2,3,2
2,2,1
2,2,3
2,2,4
2,2,6
1,2,5
3,2,5
2,1,5
2,3,5

Parsing this is a straightforward line-by-line solution.

type InputType = [Coord3]
type Coord3 = (Int, Int, Int)

parseInput :: (MonadLogger m) => ParsecT Void Text m InputType
parseInput = sepEndBy1 parseLine eol

parseLine :: (MonadLogger m) => ParsecT Void Text m Coord3
parseLine = do
  i <- parsePositiveNumber
  char ','
  j <- parsePositiveNumber
  char ','
  k <- parsePositiveNumber
  return (i, j, k)

Part 1

We'll fold through our coordinates and keep a running count of the number of faces that are exposed. We'll also track the set of cubes we've seen so far.

type FoldType = (Int, HS.HashSet Coord3)

initialFoldV :: FoldType
initialFoldV = (0, HS.empty)

foldLine :: (MonadLogger m) => FoldType -> Coord3 -> m FoldType
foldLine (prevCount, prevSet) c@(x, y, z) = ...

To start, let's get a helper to find the 6 neighboring coordinates in 3D space (diagonals don't count):

neighbors3 :: Coord3 -> [Coord3]
neighbors3 (x, y, z) =
  [ (x + 1, y, z)
  , (x - 1, y, z)
  , (x, y + 1, z)
  , (x, y - 1, z)
  , (x, y, z + 1)
  , (x, y, z - 1)
  ]

By default, adding a cube would add 6 new faces. However, for each face that borders a cube already in our set, we'll actually subtract 2! The face of the new cube will not be exposed and it will cover up the previously exposed face of the other cube. But that's pretty much all the logic we need for this part. We update the count and insert the new cube into the set:

foldLine :: (MonadLogger m) => FoldType -> Coord3 -> m FoldType
foldLine (prevCount, prevSet) c@(x, y, z) = return (prevCount + newCount, HS.insert c prevSet)
  where
    newCount = 6 - 2 * countWhere (`HS.member` prevSet) neighbors
    neighbors = neighbors3 c

And then to tie this part together:

processInputEasy :: (MonadLogger m) => InputType -> m Int
processInputEasy inputs = fst <$> foldM foldLine initialFoldV inputs

solveEasy :: FilePath -> IO (Maybe Int)
solveEasy fp = runStdoutLoggingT $ do
  input <- parseFile parseInput fp
  Just <$> processInputEasy input

Part 2

As stated above, we'll first define a sort of bounding box for our structure. We want to explore all the space around it, but we need a limit so that we terminate quickly! Here's a Dimens type to capture those bounds, as well as a predicate for whether or not a coordinate is in bounds:

data Dimens = Dimens
  { minX :: Int
  , maxX :: Int
  , minY :: Int
  , maxY :: Int
  , minZ :: Int
  , maxZ :: Int
  } deriving (Show)

inBounds :: Dimens -> Coord3 -> Bool
inBounds (Dimens mnx mxx mny mxy mnz mxz) (x, y, z)  =
  x >= mnx && x <= mxx && y >= mny && y <= mxy && z >= mnz && z <= mxz

Now we'll write a breadth-first-search function to explore the surrounding space. This will take the dimensions and the cube set structure as constant inputs. Its state will include the current count of faces, the queue of coordinates to explore, and the set of coordinates we've already enqueued at some point.

bfs :: (MonadLogger m) => Dimens -> HS.HashSet Coord3 -> (Int, Seq.Seq Coord3, HS.HashSet Coord3) -> m Int
bfs dimens cubeSet (count, queue, visited) = ...

Our base case comes when the queue is empty. We'll just return our count:

bfs :: (MonadLogger m) => Dimens -> HS.HashSet Coord3 -> (Int, Seq.Seq Coord3, HS.HashSet Coord3) -> m Int
bfs dimens cubeSet (count, queue, visited) = case Seq.viewl queue of
  Seq.EmptyL -> return count
  top Seq.:< rest -> ...

Now to explore an object, we'll take a few steps:

Find its neighbors, but filter out ones we've explored or that are out of bounds.
Determine which neighbors are in the cube set and which are not.
Enqueue the coordinates outside the structure and add them to our visited set.
Recurse, updating the count with the number of neighbors that were in the structure.

bfs :: (MonadLogger m) => Dimens -> HS.HashSet Coord3 -> (Int, Seq.Seq Coord3, HS.HashSet Coord3) -> m Int
bfs dimens cubeSet (count, queue, visited) = case Seq.viewl queue of
  Seq.EmptyL -> return count
  top Seq.:< rest -> do
    let neighbors = filter (\c -> inBounds dimens c && not (HS.member c visited)) (neighbors3 top)
        (inLava, notLava) = partition (`HS.member` cubeSet) neighbors
        newQueue = foldl (Seq.|>) rest notLava
        newVisited = foldl (flip HS.insert) visited notLava
    bfs dimens cubeSet (count + length inLava, newQueue, newVisited)

And now our processing function just creates the dimensions, and triggers the BFS using an initial state, starting from the "minimum" position in the dimensions.

processInputHard :: (MonadLogger m) => InputType -> m Int
processInputHard inputs = do
  let cubeSet = HS.fromList inputs
      (xs, ys, zs) = unzip3 inputs
      dimens = Dimens (minimum xs - 1) (maximum xs + 1) (minimum ys - 1) (maximum ys + 1) (minimum zs - 1) (maximum zs + 1)
      initialLoc = (minX dimens, minY dimens, minZ dimens)
  bfs dimens cubeSet (0, Seq.singleton initialLoc, HS.singleton initialLoc)

And our last bit of code:

solveHard :: FilePath -> IO (Maybe Int)
solveHard fp = runStdoutLoggingT $ do
  input <- parseFile parseInput fp
  Just <$> processInputHard input

Video

Video is coming soon!

But in the meantime, here's another Star Wars prequel meme, inspired by the lava in today's problem.

Day 18 - Lava Surface Area