Day 10

advent-of-code-2023.cabal

@@ -76,3 +76,11 @@ executable day09
     build-depends:    base ^>=4.15.1.0, MissingH
     hs-source-dirs:   day09
     default-language: Haskell2010
+
+executable day10
+    main-is:          Main.hs
+    other-modules:    Commons Part1 Part2
+
+    build-depends:    base ^>=4.15.1.0, array
+    hs-source-dirs:   day10
+    default-language: Haskell2010

day10/Commons.hs

@@ -0,0 +1,49 @@
+module Commons where
+
+import GHC.IO.Handle (isEOF)
+import Data.Array (Array, listArray, (!), indices)
+
+
+data Direction = North | East | West | South deriving (Eq, Show)
+data Tile = Ground | Start | Pipe (Direction, Direction) deriving (Eq, Show)
+type Grid = Array (Int, Int) Tile
+
+
+parseLine :: String -> [Tile]
+parseLine [] = []
+parseLine ('.': t) = Ground: parseLine t
+parseLine ('S': t) = Start: parseLine t
+parseLine ('|': t) = Pipe (North, South): parseLine t
+parseLine ('-': t) = Pipe (East, West): parseLine t
+parseLine ('L': t) = Pipe (North, East): parseLine t
+parseLine ('J': t) = Pipe (North, West): parseLine t
+parseLine ('7': t) = Pipe (South, West): parseLine t
+parseLine ('F': t) = Pipe (South, East): parseLine t
+
+parseGrid :: [[Tile]] -> IO Grid
+parseGrid otherTiles = do done <- isEOF
+                          if done
+                             then return $ listArray ((1, 1), (length otherTiles, length (otherTiles !! 1)))
+                                         $ concat otherTiles
+                             else do line <- getLine
+                                     let tiles = parseLine line
+                                     parseGrid (otherTiles ++ [tiles])
+
+parse :: IO Grid
+parse = parseGrid []
+
+
+findStart :: [(Int, Int)] -> Grid -> (Int, Int)
+findStart (h: t) grid | grid ! h == Start = h
+                      | otherwise         = findStart t grid
+
+getStartCoordinates :: Grid -> (Int, Int)
+getStartCoordinates grid = findStart (indices grid) grid
+
+getStartDirection :: (Int, Int) -> Grid -> (Direction, (Int, Int))
+getStartDirection (y, x) grid | grid ! (y + 1, x) == Pipe (North, South) = (South, (y + 1, x))
+                              | grid ! (y + 1, x) == Pipe (North, East) = (South, (y + 1, x))
+                              | grid ! (y + 1, x) == Pipe (North, West) = (South, (y + 1, x))
+                              | grid ! (y, x + 1) == Pipe (East, West) = (East, (y, x + 1))
+                              | grid ! (y, x + 1) == Pipe (North, West) = (East, (y, x + 1))
+                              | grid ! (y, x + 1) == Pipe (South, West) = (East, (y, x + 1))

day10/Main.hs

@@ -0,0 +1,14 @@
+module Main where
+
+import Commons
+import qualified Part1
+import qualified Part2
+
+
+main = do grid <- parse
+          let part1Res = Part1.getCycleLength grid `div` 2
+          print part1Res
+          let part2ResTmp = Part2.getCycleArea grid
+          let part2Res = if part2ResTmp >= 0 then part2ResTmp
+                                             else abs part2ResTmp - 2 * part1Res
+          print part2Res

day10/Part1.hs

@@ -0,0 +1,35 @@
+module Part1 where
+
+import Commons
+import Data.Array ((!))
+
+
+getDistanceToStart :: (Int, Int) -> Direction -> Grid -> Int
+getDistanceToStart (y, x) South grid =
+  case grid ! (y, x) of
+       Pipe (North, South) -> 1 + getDistanceToStart (y + 1, x) South grid
+       Pipe (North, East) -> 1 + getDistanceToStart (y, x + 1) East grid
+       Pipe (North, West) -> 1 + getDistanceToStart (y, x - 1) West grid
+       Start -> 0
+getDistanceToStart (y, x) West grid =
+  case grid ! (y, x) of
+       Pipe (East, West) -> 1 + getDistanceToStart (y, x - 1) West grid
+       Pipe (North, East) -> 1 + getDistanceToStart (y - 1, x) North grid
+       Pipe (South, East) -> 1 + getDistanceToStart (y + 1, x) South grid
+       Start -> 0
+getDistanceToStart (y, x) North grid =
+  case grid ! (y, x) of
+       Pipe (North, South) -> 1 + getDistanceToStart (y - 1, x) North grid
+       Pipe (South, East) -> 1 + getDistanceToStart (y, x + 1) East grid
+       Pipe (South, West) -> 1 + getDistanceToStart (y, x - 1) West grid
+       Start -> 0
+getDistanceToStart (y, x) East grid =
+  case grid ! (y, x) of
+       Pipe (East, West) -> 1 + getDistanceToStart (y, x + 1) East grid
+       Pipe (North, West) -> 1 + getDistanceToStart (y - 1, x) North grid
+       Pipe (South, West) -> 1 + getDistanceToStart (y + 1, x) South grid
+       Start -> 0
+
+getCycleLength :: Grid -> Int
+getCycleLength grid = let (dir, startCoords) = getStartDirection (getStartCoordinates grid) grid
+                    in 1 + getDistanceToStart startCoords dir grid 

day10/Part2.hs

@@ -0,0 +1,36 @@
+module Part2 where
+
+import Commons
+import Data.Array ((!), bounds)
+
+
+getAreaToStart :: (Int, Int) -> (Int, Int) -> Direction -> Direction -> Grid -> Int
+getAreaToStart (y, x) (yMax, xMax) South sdir grid =
+  case grid ! (y, x) of
+       Pipe (North, South) -> xMax - x + getAreaToStart (y + 1, x) (yMax, xMax) South sdir grid
+       Pipe (North, East) -> getAreaToStart (y, x + 1) (yMax, xMax) East sdir grid
+       Pipe (North, West) -> xMax - x + getAreaToStart (y, x - 1) (yMax, xMax) West sdir grid
+       Start -> if sdir == South then xMax - x else 0
+getAreaToStart (y, x) (yMax, xMax) West sdir grid =
+  case grid ! (y, x) of
+       Pipe (East, West) -> getAreaToStart (y, x - 1) (yMax, xMax) West sdir grid
+       Pipe (North, East) -> x - xMax - 1 + getAreaToStart (y - 1, x) (yMax, xMax) North sdir grid
+       Pipe (South, East) -> getAreaToStart (y + 1, x) (yMax, xMax) South sdir grid
+       Start -> 0
+getAreaToStart (y, x) (yMax, xMax) North sdir grid =
+  case grid ! (y, x) of
+       Pipe (North, South) -> x - xMax - 1 + getAreaToStart (y - 1, x) (yMax, xMax) North sdir grid
+       Pipe (South, East) -> x - xMax - 1 + getAreaToStart (y, x + 1) (yMax, xMax) East sdir grid
+       Pipe (South, West) -> getAreaToStart (y, x - 1) (yMax, xMax) West sdir grid
+       Start -> if sdir == East then x - xMax - 1 else 0
+getAreaToStart (y, x) (yMax, xMax) East sdir grid =
+  case grid ! (y, x) of
+       Pipe (East, West) -> getAreaToStart (y, x + 1) (yMax, xMax) East sdir grid
+       Pipe (North, West) -> getAreaToStart (y - 1, x) (yMax, xMax) North sdir grid
+       Pipe (South, West) -> xMax - x + getAreaToStart (y + 1, x) (yMax, xMax) South sdir grid
+       Start -> if sdir == South then xMax - x else 0
+
+getCycleArea :: Grid -> Int
+getCycleArea grid = let (dir, startCoords) = getStartDirection (getStartCoordinates grid) grid
+                        ((_, _), (yMax, xMax)) = bounds grid
+                    in getAreaToStart startCoords (yMax, xMax) dir dir grid