From 5d826bffff482ec1d78fab0879c383f4d220caaf Mon Sep 17 00:00:00 2001 From: RhiobeT Date: Mon, 18 Dec 2023 15:21:29 +0100 Subject: [PATCH] Day 18 --- advent-of-code-2023.cabal | 7 +++ day18/Commons.hs | 93 +++++++++++++++++++++++++++++++++++++++ day18/Main.hs | 14 ++++++ day18/Part1.hs | 19 ++++++++ day18/Part2.hs | 21 +++++++++ 5 files changed, 154 insertions(+) create mode 100644 day18/Commons.hs create mode 100644 day18/Main.hs create mode 100644 day18/Part1.hs create mode 100644 day18/Part2.hs diff --git a/advent-of-code-2023.cabal b/advent-of-code-2023.cabal index c31394e..6273c04 100644 --- a/advent-of-code-2023.cabal +++ b/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 diff --git a/day18/Commons.hs b/day18/Commons.hs new file mode 100644 index 0000000..83366b9 --- /dev/null +++ b/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 diff --git a/day18/Main.hs b/day18/Main.hs new file mode 100644 index 0000000..82d5a98 --- /dev/null +++ b/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 diff --git a/day18/Part1.hs b/day18/Part1.hs new file mode 100644 index 0000000..72aa1bc --- /dev/null +++ b/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 [] diff --git a/day18/Part2.hs b/day18/Part2.hs new file mode 100644 index 0000000..b375692 --- /dev/null +++ b/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 []