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

Refactor day 16

Browse Source
This commit is contained in:
RhiobeT Chan
2023-12-16 15:56:38 +01:00
parent 322b2b50c0
commit 55a77c8d5d
3 changed files with 60 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -115,3 +115,4 @@ executable day16
build-depends: base ^>=4.15.1.0, array, containers build-depends: base ^>=4.15.1.0, array, containers
hs-source-dirs: day16 hs-source-dirs: day16
default-language: Haskell2010 default-language: Haskell2010
default-extensions: LambdaCase

76
day16/Commons.hs
View File

@@ -11,12 +11,12 @@ type Cavern = Array (Int, Int) Tile
parseLine :: String -> [Tile] parseLine :: String -> [Tile]
parseLine [] = [] parseLine = map (\case
parseLine ('/': t) = Mirror: parseLine t '/' -> Mirror
parseLine ('\\': t) = AntiMirror: parseLine t '\\' -> AntiMirror
parseLine ('-': t) = HSplitter: parseLine t '-' -> HSplitter
parseLine ('|': t) = VSplitter: parseLine t '|' -> VSplitter
parseLine ('.': t) = Empty: parseLine t '.' -> Empty)
parseCavern :: IO [[Tile]] parseCavern :: IO [[Tile]]
parseCavern = do done <- isEOF parseCavern = do done <- isEOF
@@ -32,36 +32,52 @@ parse = do cavern <- parseCavern
return (listArray ((1, 1), (length cavern, length $ head cavern)) $ concat cavern) return (listArray ((1, 1), (length cavern, length $ head cavern)) $ concat cavern)
lightBeamEast :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
lightBeamEast (y, x) d en = lightBeam (y, x + 1) d $ insert (y, x, East) en
lightBeamSouth :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
lightBeamSouth (y, x) d en = lightBeam (y + 1, x) d $ insert (y, x, South) en
lightBeamWest :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
lightBeamWest (y, x) d en = lightBeam (y, x - 1) d $ insert (y, x, West) en
lightBeamNorth :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
lightBeamNorth (y, x) d en = lightBeam (y - 1, x) d $ insert (y, x, North) en
lightBeam :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction) lightBeam :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
lightBeam (y, x) East en c lightBeam (y, x) East en c
| member (y, x, East) en = en | member (y, x, East) en = en
| not (inRange (bounds c) (y, x + 1)) = insert (y, x, East) 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 | otherwise =
| c ! (y, x + 1) == Mirror = lightBeam (y, x + 1) North (insert (y, x, East) en) c case c ! (y, x + 1) of
| c ! (y, x + 1) == AntiMirror = lightBeam (y, x + 1) South (insert (y, x, East) en) c Mirror -> lightBeamEast (y, x) North en c
| c ! (y, x + 1) == VSplitter = AntiMirror -> lightBeamEast (y, x) South en c
let en2 = lightBeam (y, x + 1) North (insert (y, x, East) en) c in lightBeam (y, x + 1) South en2 c VSplitter -> lightBeamEast (y, x) South (lightBeamEast (y, x) North en c) c
_ -> lightBeamEast (y, x) East en c
lightBeam (y, x) West en c lightBeam (y, x) West en c
| member (y, x, West) en = en | member (y, x, West) en = en
| not (inRange (bounds c) (y, x - 1)) = insert (y, x, West) 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 | otherwise =
| c ! (y, x - 1) == Mirror = lightBeam (y, x - 1) South (insert (y, x, West) en) c case c ! (y, x - 1) of
| c ! (y, x - 1) == AntiMirror = lightBeam (y, x - 1) North (insert (y, x, West) en) c Mirror -> lightBeamWest (y, x) South en c
| c ! (y, x - 1) == VSplitter = AntiMirror -> lightBeamWest (y, x) North en c
let en2 = lightBeam (y, x - 1) North (insert (y, x, West) en) c in lightBeam (y, x - 1) South en2 c VSplitter -> lightBeamWest (y, x) South (lightBeamWest (y, x) North en c) c
_ -> lightBeamWest (y, x) West en c
lightBeam (y, x) South en c lightBeam (y, x) South en c
| member (y, x, South) en = en | member (y, x, South) en = en
| not (inRange (bounds c) (y + 1, x)) = insert (y, x, South) 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 | otherwise =
| c ! (y + 1, x) == Mirror = lightBeam (y + 1, x) West (insert (y, x, South) en) c case c ! (y + 1, x) of
| c ! (y + 1, x) == AntiMirror = lightBeam (y + 1, x) East (insert (y, x, South) en) c Mirror -> lightBeamSouth (y, x) West en c
| c ! (y + 1, x) == HSplitter = AntiMirror -> lightBeamSouth (y, x) East en c
let en2 = lightBeam (y + 1, x) West (insert (y, x, South) en) c in lightBeam (y + 1, x) East en2 c HSplitter -> lightBeamSouth (y, x) East (lightBeamSouth (y, x) West en c) c
_ -> lightBeamSouth (y, x) South en c
lightBeam (y, x) North en c lightBeam (y, x) North en c
| member (y, x, North) en = en | member (y, x, North) en = en
| not (inRange (bounds c) (y - 1, x)) = insert (y, x, North) 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 | otherwise =
| c ! (y - 1, x) == Mirror = lightBeam (y - 1, x) East (insert (y, x, North) en) c case c ! (y - 1, x) of
| c ! (y - 1, x) == AntiMirror = lightBeam (y - 1, x) West (insert (y, x, North) en) c Mirror -> lightBeamNorth (y, x) East en c
| c ! (y - 1, x) == HSplitter = AntiMirror -> lightBeamNorth (y, x) West en c
let en2 = lightBeam (y - 1, x) West (insert (y, x, North) en) c in lightBeam (y - 1, x) East en2 c HSplitter -> lightBeamNorth (y, x) East (lightBeamNorth (y, x) West en c) c
_ -> lightBeamNorth (y, x) North en c

8
day16/Part2.hs
View File

@@ -9,10 +9,10 @@ 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 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 :: Cavern -> [(Int, Int, Direction)]
getStarts c = [(y, 0, East) | y <- [1..(fst (snd $ bounds c))]] getStarts c = [(y, 0, East) | y <- [1..fst (snd $ bounds c)]]
++ [(y, 1 + snd (snd $ bounds c), West) | 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))]] ++ [(0, x, South) | x <- [1..snd (snd $ bounds c)]]
++ [(1 + fst (snd $ bounds c), x, North) | x <- [1..(snd (snd $ bounds c))]] ++ [(1 + fst (snd $ bounds c), x, North) | x <- [1..snd (snd $ bounds c)]]
getMaxEnergized :: Cavern -> Int getMaxEnergized :: Cavern -> Int
getMaxEnergized c = maximum (Prelude.map (\s -> length $ getEnergized s c) $ getStarts c) getMaxEnergized c = maximum (Prelude.map (\s -> length $ getEnergized s c) $ getStarts c)