Day 10 was definitely the day to practise your graph search algorithms. There was a fair bit to get through with this, especially with my not-very-terse style.
Representation and reading
Some definitions. A Position is a 2d vector of Int. A Pipe section is one of the enumerated type. A Grid is an Array of Pipe, indexed by Position. A Map is a combination of a Grid and the position of the start.
type Position = V2 Int -- r, c
data Pipe = Empty |
NorthWest | NorthSouth | NorthEast |
WestEast | WestSouth |
SouthEast |
Start
deriving (Show, Eq, Enum)
type Grid = Array Position Pipe
data Map = Map { getGrid :: Grid, getStart :: Position } deriving (Show)I make a map by reading the grid, finding the start, and replacing it with the Pipe section that's actually there. I read the grid by finding its bounds then reading it form the list of cells. readPipe is a list of all the characters and what they represent.
mkMap :: String -> Map
mkMap text = Map grid' start
where grid = mkGrid text
start = head $ filter (( == Start) . (grid !)) $ indices grid
grid' = grid // [(start, startIs $ Map grid start)]
mkGrid :: String -> Grid
mkGrid text = grid
where rows = lines text
r = length rows - 1
c = (length $ head rows) - 1
grid = listArray ((V2 0 0), (V2 r c)) $ fmap readPipe $ concat rows
readPipe :: Char -> Pipe
readPipe 'J' = NorthWest
readPipe '|' = NorthSouth
readPipe 'L' = NorthEast
readPipe '-' = WestEast
readPipe '7' = WestSouth
readPipe 'F' = SouthEast
readPipe 'S' = Start
readPipe _ = EmptyFinding how to replace the start position is trickier. I need to do this so that searching for the loop doesn't get distracted by other pipe sections that neighbour it. For instance, in the map below, I don't start searching from all the neighbours of the S position, and get distracted by the small loop above and miss the larger loop below.
........
...F--7.
...L--J.
..F-S-7.
..|...|.
..|...|.
..L---J.
........Essentially, I want to find the shape of the "hole" the Start node fills, then replace the Start with the pipe section that fills that hole.
Working from the bottom up, I define the steps I can take along a pipe (the deltas) and the neighbours of a position in a grid.
deltas :: Pipe -> [Position]
deltas NorthWest = [V2 (-1) 0, V2 0 (-1)]
deltas NorthSouth = [V2 (-1) 0, V2 1 0]
deltas NorthEast = [V2 (-1) 0, V2 0 1]
deltas WestEast = [V2 0 (-1), V2 0 1]
deltas WestSouth = [V2 0 (-1), V2 1 0]
deltas SouthEast = [V2 1 0, V2 0 1]
deltas Start = (deltas NorthSouth) ++ (deltas WestEast)
deltas Empty = []
neighbours :: Map -> Position -> [Position]
neighbours Map{..} p = filter (inRange $ bounds getGrid) $
fmap (^+^ p) $ deltas $ getGrid ! pThe positions that connect to the start are the neighbours of the start that have the start as their neighbours. (You'll need to read that again.) For example, in the mini-map above, the pipe to the left of the start has the start as one of its neighbours, but the pipe above the start doesn't. Therefore, the pipe to the left is one of the connectors of the start. That's what connectorsToStart finds.
With that, I can cycle through all the types of pipe and compare they connections they need with the connections I have, and that gives me the type of pipe that the big fat S is hiding.
connectorsToStart :: Map -> [Position]
connectorsToStart map@Map{..} = fmap fst connectors
where nbrs = neighbours map getStart
nbrsNbrs = fmap (\n -> (n, neighbours map n)) nbrs
connectors = filter ((getStart `elem`) . snd) nbrsNbrs
startIs :: Map -> Pipe
startIs map = head [ t | t <- [NorthWest .. SouthEast]
, (sort $ fmap (^+^ s) $ deltas t) == conns ]
where conns = sort $ connectorsToStart map
s = getStart mapPart 1
Finding the loop is a basic depth-first search, but complicated slightly by the need to find a loop rather than just a goal node. I handle this by having the initial agenda be the path from the start to its neighbours, and the goal check by being if the current node is a neighbour of the start.
search :: Map -> Maybe Path
search map = dfs map (initial map)
dfs :: Map -> [Path] -> Maybe Path
dfs _ [] = Nothing
dfs map (p:ps)
| isGoal map p = Just p
| otherwise = dfs map $ (successors map p) ++ ps
successors :: Map -> Path -> [Path]
successors map p = fmap (:p) ns'
where ns = neighbours map $ head p
ns' = filter (`notElem` p) ns
isGoal :: Map -> Path -> Bool
isGoal map p@(h:_) = ((getStart map) `elem` (neighbours map h)) && length p >= 3
initial :: Map -> [Path]
initial map = fmap (:[s]) $ neighbours map s
where s = getStart mapPart 2
The description for part 2 says you can squeeze between pipes to connect regions. My first thought was to consider half-integer points in the map, but then I thought it would be easier to just expand the map by a factor of two in each direction. When I do that, I need to also extend the pipe sections so they still join up in the expanded grid.
I represent this expanded grid as an Array Position Bool, showing whether a position is part of the region-splitting loop (a.k.a. the wall) or not. The Region I'm finding is a Set of Position.
When I create the expanded grid, all the positions are False. For each pipe in the loop, I use addWall to set that position (doubled) and its connected neighbours, according to the pipe type. That's a fold to keep updating the same grid.
type BGrid = Array Position Bool
type Region = S.Set Position
expand :: Grid -> Path -> BGrid
expand grid path = foldl' (addWall grid) bgrid path
where (b0, b1) = bounds grid
b' = (b0, (b1 ^* 2) ^+^ (V2 1 1))
bgrid = array b' [(p, False) | p <- range b']
addWall :: Grid -> BGrid -> Position -> BGrid
addWall grid bgrid p = bgrid // fmap ((, True)) adds
where wallCell = grid ! p
ds = deltas wallCell
p' = p ^* 2
adds = p' : fmap (^+^ p') dsFilling the regions is a breadth-first search to flood-fill a region, skipping positions that are on the wall or out-of-bounds.
fill :: [Position] -> Region -> BGrid -> Region
fill [] region _ = region
fill (p:ps) region bgrid
| bgrid ! p = fill ps region bgrid
| p `S.member` region = fill ps region bgrid
| otherwise = fill (ps ++ ns) region' bgrid
where ns = bNeighbours bgrid p
region' = S.insert p region
bNeighbours :: BGrid -> Position -> [Position]
bNeighbours g p = filter (inRange $ bounds g) $ unboundedNeighbours p
unboundedNeighbours :: Position -> [Position]
unboundedNeighbours p = fmap (^+^ p) [V2 (-1) 0, V2 1 0, V2 0 (-1), V2 0 1]I create many regions, one for each neighbour (including diagonals) of the start node. Yes, this is inefficient, because I generate the same region several times; but it's quick enough.
regionsFromMap :: Map -> Path -> [Region]
regionsFromMap map boundary = getRegions bgrid starts
where bgrid = expand (getGrid map) boundary
starts = filter (inRange $ bounds bgrid) $
fmap (\n -> n ^+^ (getStart map ^* 2))
[V2 dr dc | dr <- [-1, 0, 1], dc <- [-1, 0, 1]]
getRegions :: BGrid -> [Position] -> [Region]
getRegions bgrid starts = fmap (\s -> fill [s] S.empty bgrid) starts A region touches the edge if any point within it is on the edge of the grid. A point is on the edge if any of its neighbours is out of bounds. The inner regions are the regions that don't touch the edge. Yes, this is all really inefficient; but it's still quick enough.
onEdge :: BGrid -> Position -> Bool
onEdge bgrid p = any (not . inRange (bounds bgrid)) $ unboundedNeighbours p
touchesEdge :: BGrid -> Region -> Bool
touchesEdge bgrid region = any (onEdge bgrid) $ S.toList region
innerRegions :: BGrid -> [Region] -> [Region]
innerRegions bgrid regions = filter (not . touchesEdge bgrid) regionsFinally, a point in a region is a point in the underlying map if both its row and column are even.
truePoints :: Region -> Region
truePoints = S.filter (\(V2 r c) -> r `mod` 2 == 0 && c `mod` 2 == 0)I can put all that together to find the number of true points in the first inner region of the expanded grid.
part2 :: Map -> Path -> Int
part2 map loop = S.size $ truePoints $ head iRegions
where bgrid = expand (getGrid map) loop
regions = regionsFromMap map loop
iRegions = innerRegions bgrid $ filter (not . S.null) regionsCode
You can get the code from my locally-hosted Git repo, or from Gitlab.