Done day 16

diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal
index 0a38ddc77900d3f7e3672081a62f6517903d585c..dbddc057e10e3d6205609ccee46a3645836228e2 100644 (file)
--- a/advent-of-code23.cabal
+++ b/advent-of-code23.cabal
@@ -191,3 +191,8 @@ executable advent15
   import: common-extensions, build-directives
   main-is: advent15/Main.hs
   build-depends: containers, text, attoparsec, 
+
+executable advent16
+  import: common-extensions, build-directives
+  main-is: advent16/Main.hs
+  build-depends: linear, array, containers

diff --git a/advent16/Main.hs b/advent16/Main.hs
new file mode 100644 (file)
index 0000000..b399bc1
--- /dev/null
+++ b/advent16/Main.hs
@@ -0,0 +1,99 @@
+-- Writeup at https://work.njae.me.uk/2023/12/19/advent-of-code-2023-day-16/
+
+-- import Debug.Trace
+
+import AoC
+import Linear (V2(..), (^+^))
+import Data.Array.IArray
+import qualified Data.Set as S
+
+data Element = 
+  Empty | SlashMirror | BackslashMirror | 
+  HorizontalSplitter | VerticalSplitter
+  deriving (Show, Eq, Enum)
+
+type Position = V2 Int -- r, c
+type Grid = Array Position Element
+
+data BeamHead = BeamHead { beamPos :: Position, beamDirection :: Position } 
+  deriving (Show, Eq, Ord)
+
+pattern U, D, L, R :: Position
+pattern U = V2 (-1) 0
+pattern D = V2 1 0
+pattern L = V2 0 (-1)
+pattern R = V2 0 1
+
+type Energised = S.Set BeamHead
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let grid = mkGrid text
+      -- print map
+      print $ part1 grid
+      print $ part2 grid
+
+part1, part2 :: Grid -> Int
+part1 grid = countEnergised grid (BeamHead (V2 0 0) R)
+part2 grid = maximum $ fmap (countEnergised grid) $ getEdges grid
+
+-- reading the map
+
+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 readElement $ concat rows
+
+readElement :: Char -> Element
+readElement '/' = SlashMirror
+readElement '\\' = BackslashMirror
+readElement '|' = VerticalSplitter
+readElement '-' = HorizontalSplitter
+readElement _ = Empty
+
+-- propagating the beam
+
+countEnergised :: Grid -> BeamHead -> Int
+countEnergised grid bh = S.size $ S.map beamPos $ propagate grid S.empty [bh]
+
+propagate :: Grid -> Energised -> [BeamHead] -> Energised
+-- propagate _ e hs | trace ("P " ++ (show hs)) False = undefined
+propagate _ energised [] = energised
+propagate grid energised (bh:bhs) 
+  | S.member bh energised = propagate grid energised bhs
+  | otherwise = propagate grid energised' (bhs ++ nexts')
+  where this = grid ! (beamPos bh)
+        nexts = propagateElem this bh
+        nexts' = filter ((inRange (bounds grid)) . beamPos) nexts
+        energised' = S.insert bh energised
+
+propagateElem :: Element -> BeamHead -> [BeamHead]
+-- propagateElem e h | trace ("PE " ++ (show e) ++ " " ++ (show h)) False = undefined
+propagateElem Empty (BeamHead pos dir) = [BeamHead (pos ^+^ dir) dir]
+propagateElem SlashMirror (BeamHead pos L) = [BeamHead (pos ^+^ D) D]
+propagateElem SlashMirror (BeamHead pos R) = [BeamHead (pos ^+^ U) U]
+propagateElem SlashMirror (BeamHead pos U) = [BeamHead (pos ^+^ R) R]
+propagateElem SlashMirror (BeamHead pos D) = [BeamHead (pos ^+^ L) L]
+propagateElem BackslashMirror (BeamHead pos L) = [BeamHead (pos ^+^ U) U]
+propagateElem BackslashMirror (BeamHead pos R) = [BeamHead (pos ^+^ D) D]
+propagateElem BackslashMirror (BeamHead pos U) = [BeamHead (pos ^+^ L) L]
+propagateElem BackslashMirror (BeamHead pos D) = [BeamHead (pos ^+^ R) R]
+propagateElem HorizontalSplitter (BeamHead pos L) = [BeamHead (pos ^+^ L) L]
+propagateElem HorizontalSplitter (BeamHead pos R) = [BeamHead (pos ^+^ R) R]
+propagateElem HorizontalSplitter (BeamHead pos _) = 
+  [BeamHead (pos ^+^ L) L, BeamHead (pos ^+^ R) R]
+propagateElem VerticalSplitter (BeamHead pos U) = [BeamHead (pos ^+^ U) U]
+propagateElem VerticalSplitter (BeamHead pos D) = [BeamHead (pos ^+^ D) D]
+propagateElem VerticalSplitter (BeamHead pos _) = 
+  [BeamHead (pos ^+^ U) U, BeamHead (pos ^+^ D) D]
+
+getEdges :: Grid -> [BeamHead]
+getEdges grid = [BeamHead (V2 0 c) D | c <- [0..maxC]] ++
+                [BeamHead (V2 r 0) R | r <- [0..maxR]] ++
+                [BeamHead (V2 r maxC) L | r <- [0..maxR]] ++
+                [BeamHead (V2 maxR c) U | c <- [0..maxC]]
+  where (V2 maxR maxC) = snd $ bounds grid