Day 18

advent-of-code-2023.cabal

@@ -123,3 +123,10 @@ executable day17
     build-depends:      base ^>=4.15.1.0, array, containers, pqueue
     hs-source-dirs:     day17
     default-language:   Haskell2010
+
+executable day18
+    main-is:          Main.hs
+    other-modules:    Commons Part1 Part2
+    build-depends:    base ^>=4.15.1.0, containers, MissingH
+    hs-source-dirs:   day18
+    default-language: Haskell2010

day18/Commons.hs

@@ -0,0 +1,93 @@
+module Commons where
+
+import GHC.IO.Handle (isEOF)
+import Data.Map (Map, assocs, member, (!), fromList)
+
+
+data Direction = North | East | West | South deriving (Eq, Show)
+data Hole = Hole { direction :: Direction, size :: Int } deriving (Eq, Show)
+type Grid = Map (Int, Int) Hole
+
+
+getAllLines :: IO [String]
+getAllLines = do done <- isEOF
+                 if done then return []
+                 else do line <- getLine
+                         otherLines <- getAllLines
+                         return $ line: otherLines
+
+parseInstruction :: (Int, Int) -> Direction -> Int -> ((Int, Int), Hole)
+parseInstruction (y, x) South n = ((y + 1, x), Hole {direction = South, size = n - 1})
+parseInstruction (y, x) East n = ((y, x + 1), Hole {direction = East, size = n - 1})
+parseInstruction (y, x) North n = ((y - 1, x), Hole {direction = North, size = n - 1})
+parseInstruction (y, x) West n = ((y, x - 1), Hole {direction = West, size = n - 1})
+
+parseGrid :: ((Int, Int) -> String -> ((Int, Int), Hole)) ->
+             [String] -> [((Int, Int), Hole)] -> Grid
+parseGrid _ [] otherTiles = fromList otherTiles
+parseGrid parseLine (line: t) otherTiles = if null otherTiles then parseGrid parseLine t [parseLine (1, 1) line]
+                                                              else let ((y, x), lastHole) = last otherTiles
+                                                                       newStart = case direction lastHole of
+                                                                                       North -> (y - size lastHole, x)
+                                                                                       East -> (y, x + size lastHole)
+                                                                                       South -> (y + size lastHole, x)
+                                                                                       West -> (y, x - size lastHole)
+                                                                       tiles = parseLine newStart line
+                                                                   in parseGrid parseLine t (otherTiles ++ [tiles])
+
+
+getBounds :: [((Int, Int), Hole)] -> ((Int, Int), (Int, Int)) -> ((Int, Int), (Int, Int))
+getBounds [] coords = coords
+getBounds (((y, x), h): t) ((yMin, xMin), (yMax, xMax))
+  | y < yMin  = getBounds (((y, x), h): t) ((y, xMin), (yMax, xMax))
+  | x < xMin  = getBounds (((y, x), h): t) ((yMin, x), (yMax, xMax))
+  | y > yMax  = getBounds (((y, x), h): t) ((yMin, xMin), (y, xMax))
+  | x > xMax  = getBounds (((y, x), h): t) ((yMin, xMin), (yMax, x))
+  | otherwise = getBounds t ((yMin, xMin), (yMax, xMax))
+
+getAreaToStart :: (Int, Int) -> Int -> Hole -> Grid -> Bool -> Int
+getAreaToStart (1, 2) _ _ _ True = 0
+getAreaToStart (1, 0) _ _ _ True = 0
+getAreaToStart (2, 1) _ _ _ True = 0
+getAreaToStart (0, 1) _ _ _ True = 0
+getAreaToStart (y, x) xMax h grid _ | direction h == South =
+  let (newY, newX) = (y + size h, x)
+  in size h * (xMax - x) +
+     if member (newY, newX + 1) grid
+     then getAreaToStart (newY, newX + 1) xMax (grid ! (newY, newX + 1)) grid True
+     else xMax - x + getAreaToStart (newY, newX - 1) xMax (grid ! (newY, newX - 1)) grid True
+getAreaToStart (y, x) xMax h grid _ | direction h == West =
+  let (newY, newX) = (y, x - size h)
+  in if member (newY - 1, newX) grid
+     then newX - xMax - 1 + getAreaToStart (newY - 1, newX) xMax (grid ! (newY - 1, newX)) grid True
+     else getAreaToStart (newY + 1, newX) xMax (grid ! (newY + 1, newX)) grid True
+getAreaToStart (y, x) xMax h grid _ | direction h == North =
+  let (newY, newX) = (y - size h, x)
+  in size h * (x - xMax - 1) +
+     if member (newY, newX + 1) grid
+     then x - xMax - 1 + getAreaToStart (newY, newX + 1) xMax (grid ! (newY, newX + 1)) grid True
+     else getAreaToStart (newY, newX - 1) xMax (grid ! (newY, newX - 1)) grid True
+getAreaToStart (y, x) xMax h grid _ | direction h == East =
+  let (newY, newX) = (y, x + size h)
+  in if member (newY - 1, newX) grid
+     then getAreaToStart (newY - 1, newX) xMax (grid ! (newY - 1, newX)) grid True
+     else xMax - newX + getAreaToStart (newY + 1, newX) xMax (grid ! (newY + 1, newX)) grid True
+
+getInnerArea :: Grid -> Int
+getInnerArea grid =
+  let ((yMin, xMin), (yMax, xMax)) = getBounds (assocs grid) ((maxBound, maxBound), (minBound, minBound))
+  in if member (2, 1) grid
+     then getAreaToStart (2, 1) xMax (grid ! (2, 1)) grid False
+     else if member (1, 2) grid
+          then getAreaToStart (1, 2) xMax (grid ! (1, 2)) grid False
+          else if member (1, 0) grid
+               then getAreaToStart (1, 0) xMax (grid ! (1, 0)) grid False
+               else getAreaToStart (0, 1) xMax (grid ! (0, 1)) grid False
+
+getPerimeter :: Grid -> Int
+getPerimeter = foldr (\ (_, t) -> (+) (size t + 1)) 0 . assocs
+
+getArea :: Grid -> Int
+getArea grid = let innerArea = getInnerArea grid
+               in if innerArea < 0 then abs innerArea
+                  else innerArea + getPerimeter grid

day18/Main.hs

@@ -0,0 +1,14 @@
+module Main where
+
+import Commons
+import qualified Part1
+import qualified Part2
+
+
+main = do lines <- getAllLines
+          let grid1 = Part1.parse lines
+          let part1Res = getArea grid1
+          print part1Res
+          let grid2 = Part2.parse lines
+          let part2Res = getArea grid2
+          print part2Res

day18/Part1.hs

@@ -0,0 +1,19 @@
+module Part1 where
+
+import Commons
+import Data.List.Utils (split)
+import GHC.IO.Handle (isEOF)
+import Data.Map (fromList)
+
+
+parseLine :: (Int, Int) -> String -> ((Int, Int), Hole)
+parseLine coords line = let (d: n: _) = split " " line
+                            actualD = case d of
+                                           "U" -> North
+                                           "D" -> South
+                                           "R" -> East
+                                           "L" -> West
+                        in parseInstruction coords actualD (read n)
+
+parse :: [String] -> Grid
+parse lines = parseGrid parseLine lines []

day18/Part2.hs

@@ -0,0 +1,21 @@
+module Part2 where
+
+import Commons
+import Numeric (readHex)
+import Data.List.Utils (split)
+
+
+parseColor :: String -> (Int, Direction)
+parseColor raw = (fst $ head $ readHex $ init raw, case last raw of
+                                                        '0' -> East
+                                                        '1' -> South
+                                                        '2' -> West
+                                                        '3' -> North)
+
+parseLine :: (Int, Int) -> String -> ((Int, Int), Hole)
+parseLine coords line = let (_: _: ('(': '#': c): _) = split " " line
+                            (n, d) = parseColor $ init c
+                        in parseInstruction coords d n
+
+parse :: [String] -> Grid
+parse lines = parseGrid parseLine lines []