Refactor day 16
This commit is contained in:
@@ -11,12 +11,12 @@ 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
|
||||
parseLine = map (\case
|
||||
'/' -> Mirror
|
||||
'\\' -> AntiMirror
|
||||
'-' -> HSplitter
|
||||
'|' -> VSplitter
|
||||
'.' -> Empty)
|
||||
|
||||
parseCavern :: IO [[Tile]]
|
||||
parseCavern = do done <- isEOF
|
||||
@@ -32,36 +32,52 @@ parse = do cavern <- parseCavern
|
||||
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 (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
|
||||
| member (y, x, East) en = en
|
||||
| not $ inRange (bounds c) (y, x + 1) = insert (y, x, East) en
|
||||
| otherwise =
|
||||
case c ! (y, x + 1) of
|
||||
Mirror -> lightBeamEast (y, x) North en c
|
||||
AntiMirror -> lightBeamEast (y, x) South en 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
|
||||
| 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
|
||||
| member (y, x, West) en = en
|
||||
| not $ inRange (bounds c) (y, x - 1) = insert (y, x, West) en
|
||||
| otherwise =
|
||||
case c ! (y, x - 1) of
|
||||
Mirror -> lightBeamWest (y, x) South en c
|
||||
AntiMirror -> lightBeamWest (y, x) North en 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
|
||||
| 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
|
||||
| member (y, x, South) en = en
|
||||
| not $ inRange (bounds c) (y + 1, x) = insert (y, x, South) en
|
||||
| otherwise =
|
||||
case c ! (y + 1, x) of
|
||||
Mirror -> lightBeamSouth (y, x) West en c
|
||||
AntiMirror -> lightBeamSouth (y, x) East en 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
|
||||
| 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
|
||||
| member (y, x, North) en = en
|
||||
| not $ inRange (bounds c) (y - 1, x) = insert (y, x, North) en
|
||||
| otherwise =
|
||||
case c ! (y - 1, x) of
|
||||
Mirror -> lightBeamNorth (y, x) East en c
|
||||
AntiMirror -> lightBeamNorth (y, x) West en c
|
||||
HSplitter -> lightBeamNorth (y, x) East (lightBeamNorth (y, x) West en c) c
|
||||
_ -> lightBeamNorth (y, x) North en c
|
||||
|
||||
@@ -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
|
||||
|
||||
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))]]
|
||||
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)
|
||||
getMaxEnergized c = maximum $ Prelude.map (\s -> length $ getEnergized s c) $ getStarts c
|
||||
|
||||
Reference in New Issue
Block a user