Day 13

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

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

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

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)

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)