diff --git a/advent-of-code-2023.cabal b/advent-of-code-2023.cabal index ce3a754..b603061 100644 --- a/advent-of-code-2023.cabal +++ b/advent-of-code-2023.cabal @@ -100,3 +100,11 @@ executable day12 build-depends: base ^>=4.15.1.0, MissingH hs-source-dirs: day12 default-language: Haskell2010 + +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 diff --git a/day13/Commons.hs b/day13/Commons.hs new file mode 100644 index 0000000..a07af56 --- /dev/null +++ b/day13/Commons.hs @@ -0,0 +1,69 @@ +module Commons where + +import GHC.IO.Handle (isEOF) +import Data.Array (Array, bounds, listArray, (!)) + + +data Tile = Ash | Rock deriving (Eq, Show) +type Pattern = Array (Int, Int) Tile + + +parseLine :: String -> [Tile] +parseLine [] = [] +parseLine ('.': t) = Ash: parseLine t +parseLine ('#': t) = Rock: parseLine t + +parsePattern :: IO [[Tile]] +parsePattern = do done <- isEOF + if done + then return [] + else do line <- getLine + if null line + then return [] + else do let parsedLine = parseLine line + otherLines <- parsePattern + return $ parsedLine: otherLines + +parsePatterns :: [[[Tile]]] -> IO [Pattern] +parsePatterns otherPatterns = do done <- isEOF + if done + then return $ map (\ p -> listArray ((1, 1), (length p, length (p !! 1))) + $ concat p) otherPatterns + else do pattern <- parsePattern + parsePatterns $ otherPatterns ++ [pattern] + +parse :: IO [Pattern] +parse = parsePatterns [] + + +isLineReflected :: (Int, Int) -> (Int, Int) -> Pattern -> Bool +isLineReflected (y1, x1) (y2, x2) p + | x1 < 1 || x2 > snd (snd $ bounds p) = True + | otherwise = p ! (y1, x1) == p ! (y2, x2) && isLineReflected (y1, x1 - 1) (y2, x2 + 1) p + +isVerticalReflection :: (Int, Int) -> Pattern -> Bool +isVerticalReflection (y, x) p + | y <= fst (snd $ bounds p) = isLineReflected (y, x) (y, x + 1) p && isVerticalReflection (y + 1, x) p + | otherwise = True + +isColReflected :: (Int, Int) -> (Int, Int) -> Pattern -> Bool +isColReflected (y1, x1) (y2, x2) p + | y1 < 1 || y2 > fst (snd $ bounds p) = True + | otherwise = p ! (y1, x1) == p ! (y2, x2) && isColReflected (y1 - 1, x1) (y2 + 1, x2) p + +isHorizontalReflection :: (Int, Int) -> Pattern -> Bool +isHorizontalReflection (y, x) p + | x <= snd (snd $ bounds p) = isColReflected (y, x) (y + 1, x) p && isHorizontalReflection (y, x + 1) p + | otherwise = True + +getVerticalReflection :: Int -> Int -> Pattern -> Int +getVerticalReflection x ignore p | x >= snd (snd $ bounds p) = 0 + | x == ignore = getVerticalReflection (x + 1) ignore p + | isVerticalReflection (1, x) p = x + | otherwise = getVerticalReflection (x + 1) ignore p + +getHorizontalReflection :: Int -> Int -> Pattern -> Int +getHorizontalReflection y ignore p | y >= fst (snd $ bounds p) = 0 + | y == ignore = getHorizontalReflection (y + 1) ignore p + | isHorizontalReflection (y, 1) p = y + | otherwise = getHorizontalReflection (y + 1) ignore p diff --git a/day13/Main.hs b/day13/Main.hs new file mode 100644 index 0000000..3e16292 --- /dev/null +++ b/day13/Main.hs @@ -0,0 +1,12 @@ +module Main where + +import Commons +import qualified Part1 +import qualified Part2 + + +main = do patterns <- parse + let part1Res = Part1.getSummary patterns + print $ sum part1Res + let part2Res = Part2.getSummaryWithSmudges part1Res patterns + print $ sum part2Res diff --git a/day13/Part1.hs b/day13/Part1.hs new file mode 100644 index 0000000..ede3eec --- /dev/null +++ b/day13/Part1.hs @@ -0,0 +1,7 @@ +module Part1 where + +import Commons + + +getSummary :: [Pattern] -> [Int] +getSummary = map (\ p -> getVerticalReflection 1 0 p + 100 * getHorizontalReflection 1 0 p) diff --git a/day13/Part2.hs b/day13/Part2.hs new file mode 100644 index 0000000..ef6f3f0 --- /dev/null +++ b/day13/Part2.hs @@ -0,0 +1,20 @@ +module Part2 where + +import Commons +import Data.Array (bounds, (!), (//)) + + +findSmudges :: (Int, Int) -> [Int] -> [Pattern] -> [Int] +findSmudges _ [] [] = [] +findSmudges (y, x) (sh: st) (ph: pt) + | x > snd (snd $ bounds ph) = findSmudges (y + 1, 1) (sh: st) (ph: pt) + | otherwise = let iV = if sh < 100 then sh else 0 + iH = if sh >= 100 then sh `div` 100 else 0 + newT = if ph ! (y, x) == Ash then Rock else Ash + newR = getVerticalReflection 1 iV (ph // [((y, x), newT)]) + + 100 * getHorizontalReflection 1 iH (ph // [((y, x), newT)]) + in if newR > 0 then newR: findSmudges (1, 1) st pt + else findSmudges (y, x + 1) (sh: st) (ph: pt) + +getSummaryWithSmudges :: [Int] -> [Pattern] -> [Int] +getSummaryWithSmudges = findSmudges (1, 1)