advent24/src/advent24.hs

   1 -- import Debug.Trace
   2
   3 import Data.Text (Text)
   4 -- import qualified Data.Text as T
   5 import qualified Data.Text.IO as TIO
   6
   7 import Data.Attoparsec.Text hiding (take)
   8 -- import Data.Attoparsec.Combinator
   9 -- import Control.Applicative
  10 -- import Control.Applicative.Combinators
  11
  12 import qualified Data.Set as S
  13 import Linear (V2(..), (^+^))
  14 -- import Data.Semigroup
  15 -- import Data.Monoid
  16
  17
  18 data Direction = NE | E | SE | SW | W | NW
  19   deriving (Show, Eq, Enum, Bounded)
  20
  21 type Tile = V2 Int -- x, y
  22 type Grid = S.Set Tile
  23
  24 instance Semigroup Int where
  25   (<>) = (+)
  26
  27 instance Monoid Int where
  28   mempty = 0
  29
  30 main :: IO ()
  31 main =
  32     do text <- TIO.readFile "data/advent24.txt"
  33        let walks = successfulParse text
  34        let grid0 = foldr flipTile S.empty walks
  35        print $ part1 grid0
  36        print $ part2 grid0
  37
  38 part1 grid0 = S.size grid0
  39 part2 grid0 = S.size $ (iterate update  grid0) !! 100
  40
  41 delta :: Direction -> Tile
  42 delta NE = V2  1  0
  43 delta E  = V2  0  1
  44 delta SE = V2 -1  1
  45 delta SW = V2 -1  0
  46 delta W  = V2  0 -1
  47 delta NW = V2  1 -1
  48
  49
  50 flipTile :: Tile -> Grid -> Grid
  51 flipTile tile tiles
  52   | tile `S.member` tiles = S.delete tile tiles
  53   | otherwise = S.insert tile tiles
  54
  55
  56 neighbourSpaces :: Tile -> Grid
  57 neighbourSpaces here = S.fromList $ map nbrSpace [minBound .. maxBound] -- [NE .. NW]
  58   where nbrSpace d = here ^+^ (delta d)
  59
  60 countOccupiedNeighbours :: Tile -> Grid -> Int
  61 countOccupiedNeighbours cell grid =
  62   S.size $ S.intersection grid $ neighbourSpaces cell
  63
  64 tileBecomesWhite :: Grid -> Tile -> Bool
  65 tileBecomesWhite grid cell = black && ((nNbrs == 0) || (nNbrs > 2))
  66   where black = cell `S.member` grid
  67         nNbrs = countOccupiedNeighbours cell grid
  68
  69 tileBecomesBlack :: Grid -> Tile -> Bool
  70 tileBecomesBlack grid cell = white && (nNbrs == 2)
  71   where white = cell `S.notMember` grid
  72         nNbrs = countOccupiedNeighbours cell grid
  73
  74 update :: Grid -> Grid
  75 update grid = (grid `S.union` newBlacks) `S.difference` newWhites
  76   where neighbours = (S.foldr mergeNeighbours S.empty grid) `S.difference` grid
  77         mergeNeighbours cell acc = S.union acc $ neighbourSpaces cell
  78         newWhites = S.filter (tileBecomesWhite grid) grid
  79         newBlacks = S.filter (tileBecomesBlack grid) neighbours
  80
  81
  82 -- Parse the input file
  83
  84 tilesP = tileP `sepBy` endOfLine
  85 tileP = foldMap delta <$> many1 stepP
  86
  87 stepP = choice [neP, nwP, seP, swP, eP, wP]
  88
  89 neP = "ne" *> pure NE
  90 nwP = "nw" *> pure NW
  91 seP = "se" *> pure SE
  92 swP = "sw" *> pure SW
  93 eP  = "e"  *> pure E
  94 wP  = "w"  *> pure W
  95
  96 -- successfulParse :: Text -> [Tile]
  97 successfulParse input =
  98   case parseOnly tilesP input of
  99     Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 100     Right tiles -> tiles