Day 16

day16/Commons.hs

@@ -0,0 +1,67 @@
+module Commons where
+
+import GHC.IO.Handle (isEOF)
+import Data.Set (Set, insert, member)
+import Data.Array (Array, listArray, bounds, (!), (//), Ix (inRange))
+
+
+data Direction = North | East | South | West deriving (Ord, Eq, Show)
+data Tile = Empty | Mirror | AntiMirror | HSplitter | VSplitter deriving (Eq, Show)
+type Cavern = Array (Int, Int) Tile
+
+
+parseLine :: String -> [Tile]
+parseLine [] = []
+parseLine ('/': t) = Mirror: parseLine t
+parseLine ('\\': t) = AntiMirror: parseLine t
+parseLine ('-': t) = HSplitter: parseLine t
+parseLine ('|': t) = VSplitter: parseLine t
+parseLine ('.': t) = Empty: parseLine t
+
+parseCavern :: IO [[Tile]]
+parseCavern = do done <- isEOF
+                 if done
+                    then return []
+                    else do line <- getLine
+                            let cavernLine = parseLine line
+                            cavern <- parseCavern
+                            return (cavernLine: cavern)
+
+parse :: IO Cavern
+parse = do cavern <- parseCavern
+           return (listArray ((1, 1), (length cavern, length $ head cavern)) $ concat cavern)
+
+
+lightBeam :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
+lightBeam (y, x) East en c
+  | member (y, x, East) en                                 = en
+  | not (inRange (bounds c) (y, x + 1))                    = insert (y, x, East) en
+  | let t = c ! (y, x + 1) in t == Empty || t == HSplitter = lightBeam (y, x + 1) East (insert (y, x, East) en) c
+  | c ! (y, x + 1) == Mirror                               = lightBeam (y, x + 1) North (insert (y, x, East) en) c
+  | c ! (y, x + 1) == AntiMirror                           = lightBeam (y, x + 1) South (insert (y, x, East) en) c
+  | c ! (y, x + 1) == VSplitter                            =
+      let en2 = lightBeam (y, x + 1) North (insert (y, x, East) en) c in lightBeam (y, x + 1) South en2 c
+lightBeam (y, x) West en c
+  | member (y, x, West) en                                 = en
+  | not (inRange (bounds c) (y, x - 1))                    = insert (y, x, West) en
+  | let t = c ! (y, x - 1) in t == Empty || t == HSplitter = lightBeam (y, x - 1) West (insert (y, x, West) en) c
+  | c ! (y, x - 1) == Mirror                               = lightBeam (y, x - 1) South (insert (y, x, West) en) c
+  | c ! (y, x - 1) == AntiMirror                           = lightBeam (y, x - 1) North (insert (y, x, West) en) c
+  | c ! (y, x - 1) == VSplitter                            =
+      let en2 = lightBeam (y, x - 1) North (insert (y, x, West) en) c in lightBeam (y, x - 1) South en2 c
+lightBeam (y, x) South en c
+  | member (y, x, South) en                                = en
+  | not (inRange (bounds c) (y + 1, x))                    = insert (y, x, South) en
+  | let t = c ! (y + 1, x) in t == Empty || t == VSplitter = lightBeam (y + 1, x) South (insert (y, x, South) en) c
+  | c ! (y + 1, x) == Mirror                               = lightBeam (y + 1, x) West (insert (y, x, South) en) c
+  | c ! (y + 1, x) == AntiMirror                           = lightBeam (y + 1, x) East (insert (y, x, South) en) c
+  | c ! (y + 1, x) == HSplitter                            =
+      let en2 = lightBeam (y + 1, x) West (insert (y, x, South) en) c in lightBeam (y + 1, x) East en2 c
+lightBeam (y, x) North en c
+  | member (y, x, North) en                                = en
+  | not (inRange (bounds c) (y - 1, x))                    = insert (y, x, North) en
+  | let t = c ! (y - 1, x) in t == Empty || t == VSplitter = lightBeam (y - 1, x) North (insert (y, x, North) en) c
+  | c ! (y - 1, x) == Mirror                               = lightBeam (y - 1, x) East (insert (y, x, North) en) c
+  | c ! (y - 1, x) == AntiMirror                           = lightBeam (y - 1, x) West (insert (y, x, North) en) c
+  | c ! (y - 1, x) == HSplitter                            =
+      let en2 = lightBeam (y - 1, x) West (insert (y, x, North) en) c in lightBeam (y - 1, x) East en2 c

day16/Main.hs

@@ -0,0 +1,12 @@
+module Main where
+
+import Commons
+import qualified Part1
+import qualified Part2
+
+
+main = do cavern <- parse
+          let part1Res = Part1.getEnergized cavern
+          print $ length part1Res
+          let part2Res = Part2.getMaxEnergized cavern
+          print part2Res

day16/Part1.hs

@@ -0,0 +1,8 @@
+module Part1 where
+
+import Commons
+import Data.Set (empty, map, toList, delete)
+
+
+getEnergized :: Cavern -> [(Int, Int)]
+getEnergized = toList . delete (1, 0) . Data.Set.map (\ (y, x, _) -> (y, x)) . lightBeam (1, 0) East empty

day16/Part2.hs

@@ -0,0 +1,18 @@
+module Part2 where
+
+import Commons
+import Data.Set (empty, map, toList, delete)
+import Data.Array (bounds)
+
+
+getEnergized :: (Int, Int, Direction) -> Cavern -> [(Int, Int)]
+getEnergized (y0, x0, d) = toList . delete (y0, x0) . Data.Set.map (\ (y, x, _) -> (y, x)) . lightBeam (y0, x0) d empty
+
+getStarts :: Cavern -> [(Int, Int, Direction)]
+getStarts c = [(y, 0, East) | y <- [1..(fst (snd $ bounds c))]]
+              ++ [(y, 1 + snd (snd $ bounds c), West) | y <- [1..(fst (snd $ bounds c))]]
+              ++ [(0, x, South) | x <- [1..(snd (snd $ bounds c))]]
+              ++ [(1 + fst (snd $ bounds c), x, North) | x <- [1..(snd (snd $ bounds c))]]
+
+getMaxEnergized :: Cavern -> Int
+getMaxEnergized c = maximum (Prelude.map (\s -> length $ getEnergized s c) $ getStarts c)