This commit is contained in:
2023-12-16 14:48:42 +01:00
parent 8e54e42899
commit 322b2b50c0
5 changed files with 112 additions and 16 deletions

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