Moving code around with branches
Parsing and data structures were the bulk of the work for part 1. I thought about using the hexGrid library, but decided that I wouldn't take too much advantage of it. Instead I used the same coordinate system and implemented it myself. East-west rows are constant y, and rows from south-west to north-east are constant x. Moving south-east or north-west means changing both x and y.
Tile is defined by its location, given as a
V2 two-dimensional vector, and a
Grid is a
Set of black tiles. There are six
Directions, and the function
delta converts a
Direction into a change in position. Finally, I fix how the elements of a
Tile combine to make parsing a bit easier.
data Direction = NE | E | SE | SW | W | NW deriving (Show, Eq, Enum, Bounded) type Tile = V2 Int -- x, y type Grid = S.Set Tile instance Semigroup Int where (<>) = (+) instance Monoid Int where mempty = 0 delta :: Direction -> Tile delta NE = V2 1 0 delta E = V2 0 1 delta SE = V2 -1 1 delta SW = V2 -1 0 delta W = V2 0 -1 delta NW = V2 1 -1
Parsing the input file has a couple of subtleties. One is the ordering of elements in the
choice, so that "n" and "s" characters are consumed before "e" and "w". The other is the use of the semigroup and monoid instances to allow
foldMap to combine all the steps into the position at the end of each path.
tilesP = tileP `sepBy` endOfLine tileP = foldMap delta <$> many1 stepP stepP = choice [neP, nwP, seP, swP, eP, wP] neP = "ne" *> pure NE nwP = "nw" *> pure NW seP = "se" *> pure SE swP = "sw" *> pure SW eP = "e" *> pure E wP = "w" *> pure W
All that's left is to create the grid by flipping tiles, then count how many are black.
main :: IO () main = do text <- TIO.readFile "data/advent24.txt" let walks = successfulParse text let grid0 = foldr flipTile S.empty walks print $ part1 grid0 part1 grid0 = S.size grid0 flipTile :: Tile -> Grid -> Grid flipTile tile tiles | tile `S.member` tiles = S.delete tile tiles | otherwise = S.insert tile tiles
This is very similar to day 17. As I defined the directions as both
Bounded, I can generate all the neighbours of a point by enumerating all the directions.
neighbourSpaces :: Tile -> Grid neighbourSpaces here = S.fromList $ map nbrSpace [minBound .. maxBound] -- [NE .. NW] where nbrSpace d = here ^+^ (delta d)
After that, it's all much the same as before, but with the grid updating by adding newly black tiles and removing newly white tiles.
part2 grid0 = S.size $ (iterate update grid0) !! 100 countOccupiedNeighbours :: Tile -> Grid -> Int countOccupiedNeighbours cell grid = S.size $ S.intersection grid $ neighbourSpaces cell tileBecomesWhite :: Grid -> Tile -> Bool tileBecomesWhite grid cell = black && ((nNbrs == 0) || (nNbrs > 2)) where black = cell `S.member` grid nNbrs = countOccupiedNeighbours cell grid tileBecomesBlack :: Grid -> Tile -> Bool tileBecomesBlack grid cell = white && (nNbrs == 2) where white = cell `S.notMember` grid nNbrs = countOccupiedNeighbours cell grid update :: Grid -> Grid update grid = (grid `S.union` newBlacks) `S.difference` newWhites where neighbours = (S.foldr mergeNeighbours S.empty grid) `S.difference` grid mergeNeighbours cell acc = S.union acc $ neighbourSpaces cell newWhites = S.filter (tileBecomesWhite grid) grid newBlacks = S.filter (tileBecomesBlack grid) neighbours