Advent of Code 2020 day 24

    The solution to day 24 was very similar to my solution to day 17 and most of the code for today is much the same as then.

    Part 1

    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.

    Hexagonal coordinate system

    A 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

    Part 2

    This is very similar to day 17. As I defined the directions as both Enum and 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


    You can find the code here or on GitLab.

    Neil Smith

    Read more posts by this author.