rhiobet/advent-of-code-2023
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Day 16

Browse Source
This commit is contained in:
RhiobeT Chan
2023-12-16 14:48:42 +01:00
parent 8e54e42899
commit 322b2b50c0
5 changed files with 112 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
advent-of-code-2023.cabal
View File

@@ -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

67
day16/Commons.hs Normal file
View File

@@ -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

12
day16/Main.hs Normal file
View File

@@ -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

8
day16/Part1.hs Normal file
View File

@@ -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

18
day16/Part2.hs Normal file
View File

@@ -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)