diff --git a/README.md b/README.md index 17df9f83..13931f56 100644 --- a/README.md +++ b/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)|||| diff --git a/hs/aoc2024.cabal b/hs/aoc2024.cabal index aaf1e363..0a1b1a7b 100644 --- a/hs/aoc2024.cabal +++ b/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 diff --git a/hs/app/Main.hs b/hs/app/Main.hs index 27ad83de..b9a538d0 100644 --- a/hs/app/Main.hs +++ b/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] diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs index 9d0bcb0c..05e15ca3 100644 --- a/hs/bench/Main.hs +++ b/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 ] ] diff --git a/hs/src/Day18.hs b/hs/src/Day18.hs new file mode 100644 index 00000000..e34341e7 --- /dev/null +++ b/hs/src/Day18.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Day18 +-- Description: +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" diff --git a/hs/test/Day18Spec.hs b/hs/test/Day18Spec.hs new file mode 100644 index 00000000..9aa4b880 --- /dev/null +++ b/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)