advent25/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2022/04/24/advent-of-code-2021-day-25/
   2
   3 import qualified Data.Map as M
   4 import Data.Map.Strict ((!), (\\), (!?))
   5 import Linear (V2(..), (^+^))
   6 import Data.List (unfoldr)
   7
   8 type Coord = V2 Int -- r, c
   9 data Grid = Grid (Coord, Coord) (M.Map Coord Cucumber)
  10   deriving (Eq, Show)
  11
  12 data Cucumber = Eastwards | Southwards
  13   deriving (Eq)
  14
  15 instance Show Cucumber where
  16   show Eastwards = ">"
  17   show Southwards = "v"
  18
  19 main :: IO ()
  20 main =
  21   do  text <- readFile "data/advent25.txt"
  22       let grid = mkGrid text
  23       print $ (1 +) $ length $ simulate grid
  24
  25 mkGrid :: String -> Grid
  26 mkGrid text = Grid (V2 0 0, V2 maxR maxC)
  27     ( M.fromList
  28       [ (V2 r c, mkCucubmer r c)
  29       | r <- [0..maxR], c <- [0..maxC]
  30       , isCucumber r c
  31       ]
  32     )
  33   where rows = lines text
  34         maxR = length rows - 1
  35         maxC = (length $ head rows) - 1
  36         isCucumber r c = ((rows !! r) !! c) `elem` (">v" :: String)
  37         mkCucubmer r c = if (rows !! r) !! c == '>' then Eastwards else Southwards
  38
  39 delta :: Cucumber -> Coord
  40 delta Eastwards = V2 0 1
  41 delta Southwards = V2 1 0
  42
  43 wrap :: (Coord, Coord) -> Coord -> Coord
  44 wrap bounds@(V2 r0 c0, V2 r1 c1) (V2 r c)
  45   | r > r1 = wrap bounds $ V2 r0 c
  46   | r < r0 = wrap bounds $ V2 r1 c
  47   | c > c1 = wrap bounds $ V2 r c0
  48   | c < c0 = wrap bounds $ V2 r c1
  49   | otherwise = V2 r c
  50
  51 ahead :: Grid -> Coord -> Coord
  52 ahead (Grid bounds cucumbers) here = wrap bounds (here ^+^ (delta c))
  53   where c = cucumbers ! here
  54
  55 vacant :: Grid -> Coord -> Bool
  56 vacant (Grid _ cucumbers) here = M.notMember here cucumbers
  57
  58 canMove :: Grid -> Grid
  59 canMove grid@(Grid bounds cucumbers) = Grid bounds $ M.filterWithKey openAhead cucumbers
  60   where openAhead here _ = vacant grid $ ahead grid here
  61
  62 blocked :: Grid -> Bool
  63 blocked grid = M.null cucumbers
  64   where Grid _ cucumbers = canMove grid
  65
  66 eastFacing, southFacing :: Grid -> Grid
  67 eastFacing (Grid bounds cucumbers) = Grid bounds $ M.filter (== Eastwards) cucumbers
  68 southFacing (Grid bounds cucumbers) = Grid bounds $ M.filter (== Southwards) cucumbers
  69
  70 advanceEastwards, advanceSouthwards :: Grid -> Grid
  71 advanceEastwards = advance eastFacing
  72 advanceSouthwards = advance southFacing
  73
  74 advance :: (Grid -> Grid) -> Grid -> Grid
  75 advance facing grid@(Grid bounds cucumbers) = Grid bounds $ M.union cannotMove advanced
  76   where Grid _ advancing = facing $ canMove grid
  77         cannotMove = cucumbers \\ advancing
  78         advanced = M.fromList $ map advanceOne $ M.toAscList advancing
  79         advanceOne (here, c) = (ahead grid here, c)
  80
  81 step :: Grid -> Grid
  82 step = advanceSouthwards . advanceEastwards
  83
  84 maybeStep :: Grid -> Maybe (Grid, Grid)
  85 maybeStep grid
  86   | blocked grid = Nothing
  87   | otherwise = Just (grid', grid')
  88   where grid' = step grid
  89
  90 simulate :: Grid -> [Grid]
  91 simulate grid = unfoldr maybeStep grid
  92
  93 showGrid :: Grid -> String
  94 showGrid (Grid (V2 minR minC, V2 maxR maxC) cucumbers) =
  95   unlines $ [ concat [showCucumber (V2 r c) | c <- [minC..maxC] ] | r <- [minR..maxR] ]
  96   where showCucumber here = maybe "." show $ cucumbers !? here