Day 18: RAM Run

README.md

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

hs/aoc2024.cabal

@@ -30,6 +30,7 @@ library
     Day15
     Day16
     Day17
+    Day18
     Day2
     Day3
     Day4
@@ -87,6 +88,7 @@ test-suite aoc2024-test
     Day15Spec
     Day16Spec
     Day17Spec
+    Day18Spec
     Day1Spec
     Day2Spec
     Day3Spec

hs/app/Main.hs

@@ -17,6 +17,7 @@ import Day14 qualified (part1, part2)
 import Day15 qualified (part1, part2)
 import Day16 qualified (part1, part2)
 import Day17 qualified (part1, part2)
+import Day18 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
 import Day4 qualified (part1, part2)
@@ -65,3 +66,4 @@ main = do
   run 15 (either fail print) [Day15.part1, Day15.part2]
   run 16 (maybe (fail "error") print) [Day16.part1, Day16.part2]
   run 17 (either (fail . errorBundlePretty) $ putStrLn . intercalate "," . map show) [Day17.part1, fmap (: []) . Day17.part2]
+  run 18 (either fail putStrLn) [fmap show . Day18.part1, fmap (uncurry $ (. (',' :) . show) . shows) . Day18.part2]

hs/bench/Main.hs

@@ -15,6 +15,7 @@ import Day14 qualified (part1, part2)
 import Day15 qualified (part1, part2)
 import Day16 qualified (part1, part2)
 import Day17 qualified (part1, part2)
+import Day18 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
 import Day4 qualified (part1, part2)
@@ -141,5 +142,11 @@ main =
           "Day 17"
           [ 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,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module:         Day18
+-- Description:    <https://adventofcode.com/2024/day/18 Day 18: RAM Run>
+module Day18 (part1, part1', part2, part2') where
+
+import Common (readEntire)
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.List.NonEmpty qualified as NonEmpty (cons, toList)
+import Data.Set (Set)
+import Data.Set qualified as Set (empty, fromList, insert, member, notMember)
+import Data.Text (Text)
+import Data.Text qualified as T (lines, stripPrefix)
+import Data.Text.Read (Reader)
+import Data.Text.Read qualified as T (decimal)
+
+coord :: (Integral a) => Reader (a, a)
+coord input = do
+  (x, input1) <- T.decimal input
+  input2 <- maybe (Left "missing comma") Right $ T.stripPrefix "," input1
+  (y, input3) <- T.decimal input2
+  pure ((x, y), input3)
+
+part1 :: Text -> Either String Int
+part1 = part1' 70 1024
+
+part1' :: Int -> Int -> Text -> Either String Int
+part1' size n input = do
+  coords <- mapM (readEntire coord) . take n $ T.lines input
+  case go size $ Set.fromList coords of
+    Just path -> Right $ length path - 1
+    Nothing -> Left "no solution"
+
+go :: Int -> Set (Int, Int) -> Maybe (NonEmpty (Int, Int))
+go size visited = go' visited [(0, 0) :| []] []
+  where
+    go' visited' (path@(pos@(x, y) :| _) : queue1) queue2
+      | pos `Set.member` visited' = go' visited' queue1 queue2
+      | pos == (size, size) = Just path
+      | otherwise =
+          go' (Set.insert pos visited') queue1 $
+            [ NonEmpty.cons pos' path
+            | pos'@(x', y') <- [(x - 1, y), (x, y - 1), (x, y + 1), (x + 1, y)],
+              0 <= x' && x' <= size && 0 <= y' && y' <= size
+            ]
+              ++ queue2
+    go' _ _ [] = Nothing
+    go' visited' [] queue2 = go' visited' (reverse queue2) []
+
+part2 :: Text -> Either String (Int, Int)
+part2 = part2' 70
+
+part2' :: Int -> Text -> Either String (Int, Int)
+part2' size input = mapM (readEntire coord) (T.lines input) >>= go' Set.empty
+  where
+    go' visited (candidate : rest) =
+      case go size visited' of
+        Just path ->
+          let path' = Set.fromList $ NonEmpty.toList path
+              (skip, rest') = span (`Set.notMember` path') rest
+           in go' (visited' <> Set.fromList skip) rest'
+        Nothing -> Right candidate
+      where
+        visited' = Set.insert candidate visited
+    go' _ _ = Left "no solution"

hs/test/Day18Spec.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day18Spec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unlines)
+import Day18 (part1', part2')
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example =
+  T.unlines
+    [ "5,4",
+      "4,2",
+      "4,5",
+      "3,0",
+      "2,1",
+      "6,3",
+      "2,4",
+      "1,5",
+      "0,6",
+      "3,3",
+      "2,6",
+      "5,1",
+      "1,2",
+      "5,5",
+      "2,5",
+      "6,5",
+      "1,4",
+      "0,4",
+      "6,4",
+      "1,1",
+      "6,1",
+      "1,0",
+      "0,5",
+      "1,6",
+      "2,0"
+    ]
+
+spec :: Spec
+spec = do
+  describe "part 1" $ do
+    it "examples" $ do
+      part1' 6 12 example `shouldBe` Right 22
+  describe "part 2" $ do
+    it "examples" $ do
+      part2' 6 example `shouldBe` Right (6, 1)