Day 18: Lavaduct Lagoon

README.md

@@ -22,3 +22,4 @@ Development occurs in language-specific directories:
 |[Day15.hs](hs/src/Day15.hs)|[Day15.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day15.kt)|[day15.py](py/aoc2023/day15.py)|[day15.rs](rs/src/day15.rs)|
 |[Day16.hs](hs/src/Day16.hs)|[Day16.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day16.kt)|[day16.py](py/aoc2023/day16.py)|[day16.rs](rs/src/day16.rs)|
 |[Day17.hs](hs/src/Day17.hs)|[Day17.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day17.kt)|[day17.py](py/aoc2023/day17.py)|[day17.rs](rs/src/day17.rs)|
+|[Day18.hs](hs/src/Day18.hs)||||

hs/aoc2023.cabal

@@ -37,7 +37,8 @@ library
         Day14,
         Day15,
         Day16,
-        Day17
+        Day17,
+        Day18
 
     -- Modules included in this library but not exported.
     other-modules:
@@ -105,7 +106,8 @@ test-suite aoc2023-test
         Day14Spec,
         Day15Spec,
         Day16Spec,
-        Day17Spec
+        Day17Spec,
+        Day18Spec
     build-depends:
         aoc2023,
         base ^>=4.17.2.0,

hs/app/Main.hs

@@ -18,6 +18,7 @@ import qualified Day14 (part1, part2)
 import qualified Day15 (part1, part2)
 import qualified Day16 (part1, part2)
 import qualified Day17 (part1, part2)
+import qualified Day18 (part1, part2)
 
 import Control.Monad (ap, when)
 import Data.Foldable (find)
@@ -65,3 +66,4 @@ main = do
     run 15 print [Day15.part1, Day15.part2]
     run 16 print [Day16.part1, Day16.part2]
     run 17 (maybe (fail "error") print) [Day17.part1, Day17.part2]
+    run 18 (either (fail . errorBundlePretty) print) [Day18.part1, Day18.part2]

hs/bench/Main.hs

@@ -23,6 +23,7 @@ import qualified Day14 (part1, part2)
 import qualified Day15 (part1, part2)
 import qualified Day16 (part1, part2)
 import qualified Day17 (part1, part2)
+import qualified Day18 (part1, part2)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 import System.FilePath (combine)
 
@@ -108,4 +109,8 @@ main = defaultMain
       [ bench "part 1" $ nf Day17.part1 input
       , bench "part 2" $ nf Day17.part2 input
       ]
+  , env (getDayInput 18) $ \input -> bgroup "Day 18"
+      [ bench "part 1" $ nf Day18.part1 input
+      , bench "part 2" $ nf Day18.part2 input
+      ]
   ]

hs/src/Day18.hs

@@ -0,0 +1,41 @@
+{-|
+Module:         Day18
+Description:    <https://adventofcode.com/2023/day/18 Day 18: Lavaduct Lagoon>
+-}
+{-# LANGUAGE OverloadedStrings #-}
+module Day18 (part1, part2) where
+
+import Control.Monad (replicateM)
+import Data.Functor (($>))
+import Data.List (foldl')
+import Data.Text (Text)
+import Data.Void (Void)
+import Numeric (readHex)
+import Text.Megaparsec (MonadParsec, ParseErrorBundle, Parsec, Stream(Token), choice, eof, oneOf, parse, sepEndBy, skipManyTill)
+import Text.Megaparsec.Char (char, digitChar, hexDigitChar, hspace1, newline, string)
+import Text.Megaparsec.Char.Lexer (decimal)
+
+data Direction = U | L | D | R deriving (Show)
+
+solve :: (Token s ~ Char, Stream s, Ord e, Integral a) => Parsec e s (Direction, a) -> s -> Either (ParseErrorBundle s e) a
+solve parser input = do
+    moves <- parse (parser `sepEndBy` newline <* eof) "" input
+    let (_, a, l) = foldl' f ((0, 0), 0, 2) moves
+    pure $ abs a + l `div` 2
+  where
+    f ((y, x), a, l) (d, n)
+      | U <- d = ((y - n, x), a, l + n)
+      | L <- d = ((y, x - n), a - y * n, l + n)
+      | D <- d = ((y + n, x), a, l + n)
+      | R <- d = ((y, x + n), a + y * n, l + n)
+
+part1, part2 :: Text -> Either (ParseErrorBundle Text Void) Int
+part1 = solve $ do
+    d <- choice [char 'U' $> U, char 'L' $> L, char 'D' $> D, char 'R' $> R]
+    n <- hspace1 *> decimal
+    hspace1 *> string "(#" *> skipManyTill hexDigitChar (char ')') $> (d, n)
+part2 = solve $ do
+    oneOf @[] "ULDR" *> hspace1 *> skipManyTill digitChar hspace1 *> string "(#"
+    (n, ""):_ <- readHex <$> replicateM 5 hexDigitChar
+    d <- choice [char '0' $> R, char '1' $> D, char '2' $> L, char '3' $> U]
+    char ')' $> (d, n)

hs/test/Day18Spec.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Day18Spec (spec) where
+
+import Data.Text (Text)
+import qualified Data.Text as T (unlines)
+import Day18 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example = T.unlines
+  [ -- :r!wl-paste | sed 's/.*/  , "&"/;1s/,/ /'
+    "R 6 (#70c710)"
+  , "D 5 (#0dc571)"
+  , "L 2 (#5713f0)"
+  , "D 2 (#d2c081)"
+  , "R 2 (#59c680)"
+  , "D 2 (#411b91)"
+  , "L 5 (#8ceee2)"
+  , "U 2 (#caa173)"
+  , "L 1 (#1b58a2)"
+  , "U 2 (#caa171)"
+  , "R 2 (#7807d2)"
+  , "U 3 (#a77fa3)"
+  , "L 2 (#015232)"
+  , "U 2 (#7a21e3)"
+  ]
+
+spec :: Spec
+spec = do
+    describe "part 1" $ do
+        it "examples" $ do
+            part1 example `shouldBe` Right 62
+    describe "part 2" $ do
+        it "examples" $ do
+            part2 example `shouldBe` Right 952408144115