diff --git a/advent-of-code-2023.cabal b/advent-of-code-2023.cabal index 65c8fb1..4568ae4 100644 --- a/advent-of-code-2023.cabal +++ b/advent-of-code-2023.cabal @@ -1,14 +1,12 @@ cabal-version: 2.4 name: adventofcode2023 version: 0.1.0.0 - author: RhiobeT maintainer: rhiobet@gmail.com executable day01 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0 hs-source-dirs: day01 default-language: Haskell2010 @@ -16,7 +14,6 @@ executable day01 executable day02 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, MissingH hs-source-dirs: day02 default-language: Haskell2010 @@ -24,7 +21,6 @@ executable day02 executable day03 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0 hs-source-dirs: day03 default-language: Haskell2010 @@ -32,7 +28,6 @@ executable day03 executable day04 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, MissingH hs-source-dirs: day04 default-language: Haskell2010 @@ -40,7 +35,6 @@ executable day04 executable day05 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, MissingH hs-source-dirs: day05 default-language: Haskell2010 @@ -48,7 +42,6 @@ executable day05 executable day06 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, MissingH hs-source-dirs: day06 default-language: Haskell2010 @@ -56,7 +49,6 @@ executable day06 executable day07 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, MissingH hs-source-dirs: day07 default-language: Haskell2010 @@ -64,7 +56,6 @@ executable day07 executable day08 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, hashable, unordered-containers hs-source-dirs: day08 default-language: Haskell2010 @@ -72,7 +63,6 @@ executable day08 executable day09 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, MissingH hs-source-dirs: day09 default-language: Haskell2010 @@ -80,7 +70,6 @@ executable day09 executable day10 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, array hs-source-dirs: day10 default-language: Haskell2010 @@ -88,7 +77,6 @@ executable day10 executable day11 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, array, Unique hs-source-dirs: day11 default-language: Haskell2010 @@ -96,7 +84,6 @@ executable day11 executable day12 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, MissingH hs-source-dirs: day12 default-language: Haskell2010 @@ -104,7 +91,6 @@ executable day12 executable day13 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, array hs-source-dirs: day13 default-language: Haskell2010 @@ -112,7 +98,6 @@ executable day13 executable day14 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, array hs-source-dirs: day14 default-language: Haskell2010 @@ -120,7 +105,13 @@ executable day14 executable day15 main-is: Main.hs other-modules: Commons Part1 Part2 - build-depends: base ^>=4.15.1.0, MissingH, array hs-source-dirs: day15 default-language: Haskell2010 + +executable day16 + main-is: Main.hs + other-modules: Commons Part1 Part2 + build-depends: base ^>=4.15.1.0, array, containers + hs-source-dirs: day16 + default-language: Haskell2010 diff --git a/day16/Commons.hs b/day16/Commons.hs new file mode 100644 index 0000000..3ca5f73 --- /dev/null +++ b/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 diff --git a/day16/Main.hs b/day16/Main.hs new file mode 100644 index 0000000..e2a47b4 --- /dev/null +++ b/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 diff --git a/day16/Part1.hs b/day16/Part1.hs new file mode 100644 index 0000000..071d69e --- /dev/null +++ b/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 diff --git a/day16/Part2.hs b/day16/Part2.hs new file mode 100644 index 0000000..14076ec --- /dev/null +++ b/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)