diff --git a/Y2022.cabal b/Y2022.cabal index df05f81..d22cc71 100644 --- a/Y2022.cabal +++ b/Y2022.cabal @@ -45,6 +45,7 @@ library Days.D09 Days.D10 Days.D11 + Days.D12 build-depends: bytestring , lens @@ -70,4 +71,4 @@ benchmark Y2022-bench main-is: Bench.hs build-depends: Y2022 - , criterion ^>=1.6.3.0 \ No newline at end of file + , criterion ^>=1.6.3.0 diff --git a/app/Main.hs b/app/Main.hs index 24ceae4..2908c5f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -19,6 +19,7 @@ paths = , "./data/09.in" , "./data/10.in" , "./data/11.in" + , "./data/12.in" ] solutions :: [(Int, Day, FilePath)] @@ -37,4 +38,4 @@ main = >>= (\case ["all"] -> runAll solutions _ -> runAll [last solutions]) - >> printFooter \ No newline at end of file + >> printFooter diff --git a/bench/Bench.hs b/bench/Bench.hs index b9ee753..365d46d 100644 --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -18,6 +18,7 @@ paths = , "./data/09.in" , "./data/10.in" , "./data/11.in" + , "./data/12.in" ] solutions :: [(Integer, [Day], FilePath)] @@ -40,4 +41,4 @@ groups :: [Benchmark] groups = map makeGroup solutions main :: IO () -main = defaultMain groups \ No newline at end of file +main = defaultMain groups diff --git a/data/12.in b/data/12.in new file mode 100644 index 0000000..fc9f4ba --- /dev/null +++ b/data/12.in @@ -0,0 +1,41 @@ +abccccccccccccccccccccccccccaaaaaaaaacccccccccccaaacccccccccccccccccccccccccaaaaaaaaccccccccaaaaaaccaaccccccccccccccccccccccccaaaaacaacaaaacccccccccccccccccccccccccccccccccccccaaaaa +abccaaacccccccccccccccccccccaaaaaaaaacccccccccaaaaaacccccccccccccccccccccaaaaaaaaaaaccccccccaaaaaaccaaaaaacccaacaaccccccccccccaaaaaaaacaaaaaaccccccccccccccccccccccccccccccccccaaaaaa +abccaaaaccccccccccccccccccccaaaaaaaaccccccccccaaaaaaccccaaaaaccccccccccccaaaaaaaaaaacccccccccaaaaaccaaaaaccccaaaacccccccccccccccaaaaacccaaaaaccccccccccccccccccccaaccccccccccccaaaaaa +abccaaaacccccccaaaccccccccccaaaaaaacccccccccccaaaaaaccccaaaaaccccccccccccacaaaaaaaaaacccccccaaaaacaaaaaaacccaaaaaccccccccccccccaaaaacccaaaaaccccccccccccccccccccaaaaccccccccccccccaaa +abccaaaccccccaaaaaacccccccccaccaaaccccccccccccaaaaacccccaaaaaaccccaaaacccccaaaaaaaaaaaccccccaaaaacaaaaaaacccaaaaaacccccccccccccaacaaaccaccaacccccccccccccccaaaccaaaaccccccccccccccaaa +abcccccccccccaaaaaacccccccccccccaaacccccccccccaaaaacccccaaaaaaccccaaaaccccccaaaaacaaaaccccccccccccccaaaaaaccacaaaaccccaaaaacccccccaaccccccccccccccccccccccaaaackkkaccccccccccccccccaa +abcccccccccccaaaaaacccccccccccccccaaacccccccccccccccccccaaaaaaccccaaaacccccaaaaaccccaaccccccccccccccaaccaaccccaaccccccaaaaaccccccccccccccccccccccccccccccccaakkkkkkkccccccccccccccccc +abaccccccccccaaaaaccccccccccccccccaaaaccccccccccccccccccccaaaccccccaaccccccccaaaccccccccccccccccccccaacccccccccccccccaaaaaacccccccccccccccccccccaaacccccccccjkkkkkkkkccccccccaacccccc +abaccccccccccaaaaacccccaacccccccccaaaaccccccccccccaacccccccccccccccccccccccccaaacccccccccccccccccccccaaccccccaccaccccaaaaaaaaaccaccccccccccccccaaaaccccccccjjkkoopkkkkaccaacaaacccccc +abaccccccccccccccccaaaaaacccccccccaaacccccccccccccaaaaaacccccccccccccccccccccccccccccccccccccccccccccaaaaaaccaaaaccccaaaaaaaaacaaccccccccccccccaaaacccccccjjjkoooppkkkaccaaaaaaaacccc +abcccccccccccccccccaaaaaaaaccccccccccccccccaccccccaaaaaaccccccccccccccccccccccccaaccaacccccccccccccccaaaaaacaaaaacccccaaacccaaaaacccccccccccccccaaacccccjjjjjoooppppkklccaaaaaaaacccc +abcccccccccccccccccaaaaaaaacccccccccccccccaaacccaaaaaaaccccaacccacccccccccccccccaaaaaaccccccccaaaccaaaaaaaccaaaaaaccccccccaaaaaacccccccccccccccccccccjjjjjjjoooouuppplllccaccaaaacccc +abccccccccccccccccccaaaaaaaccccaacccccaaacaaacccaaaaaaaccccaaacaacccccccccccccccaaaaaacccccccccaaaaaaaaaaaacaaaaaaccccccccaaaaaaaaccccccccccccccccciijjjjjjooouuuupppllllcccccccccccc +abccccccccccccccccccaaaaaccccccaacccccaaaaaaaaaaccaaaaaaccccaaaaaccccccccccccccaaaaaaacccccccaaaaaaaaaaaaaacccaaccccccccccaacaaaaacccccccccccccccciiiijoooooouuuuuuppplllllcccccccccc +abcccccccccccccccccaaaaaacccaacaaaaacccaaaaaaaaaccaaccaaccaaaaaacccccccccccccccaaaaaaaaccccccaaaaacccaaaaaacccaccccccccccccccaacccccccccccccccccciiiinnoooooouuxuuuupppplllllcccccccc +abcccccccccccccccccccccaacccaaaaaaaaccccaaaaaaccccaaccccccaaaaaaaaccaaaccccccccaaaaaaaacccccccaaaaaccaacaaaaaaaacccaaccccccccacccccccccaaaccccccciiinnnnntttuuuxxuuuppppqqllllccccccc +abccccccccccccaacccccccccccccaaaaaccccccaaaaaacccccaaaccccaaaaaaaaccaaaacccccccccaaaccccccccccaaccaccccccaaaaaacccaaaaaaccccccccccccccaaaaccccaaiiinnnntttttuuxxxxuuvpqqqqqllmmcccccc +abccccccccccaaaaaaccccccccccccaaaaaccccaaaaaaacccccaaacccccccaacccccaaaaccccaaccccaacccccccccccccccccccccaaaaaaccccaaaaaccccccccccccccaaaaccccaaiiinnnttttxxxxxxxyuvvvvvqqqqmmmcccccc +abccaaacccccaaaaaacccccccccccaaacaaccccaaacaaacccccaaaaaaacccaccccccaaaccccaaaacccccccccccccccccccccccccaaaaaaaacaaaaaaacccccccccaaacccaaaccccaaaiinnntttxxxxxxxxyyyyvvvvqqqmmmcccccc +abcaaaacccccaaaaaccccccccccccaaaccaccccccccccacccaaaaaaaaaaccccccccccccccccaaaaccccccccccccccccccccccccaaaaaaaaaaaaaaaaaaccccccccaaaaaacccccaaaaaiiinnnttxxxxxxxyyyyyyvvvqqqmmmcccccc +SbcaaaaccccccaaaaacccccaaaccccccaaacccccccccaaccaaaaaaaaaaaacccccccccccccccaaaaccccccccccccccccccccccccaaaaaaaaaaaaaaaaaacccccccaaaaaaacccccaaaaaiiinnntttxxxxEzzyyyyvvvqqqmmmdddcccc +abccaaaccccccaaaaacccccaaaaccccaaaaaaccccccaaaaccaaaaaaacaaacccccaaccccccccccccccccccccccccccccccccccccacaaaaacccccaaacacccccccaaaaaaaccccccaaaaaahhhnnntttxxxyyyyyyvvvvqqmmmmdddcccc +abcccccccccccccccccccccaaaaccccaaaaaaccccccaaaaccccaaaaaaaaaaaaaaaacacccccccccccccccccccccccccccccccccccccaaaacccccaaccccccccccaaaaaaaccccccccaaaahhhnnnnttxxxyyyyyvvvqqqqmmmdddccccc +abcccccccccccccccaacaacaaacccccaaaaaaccccccaaaacccaaaaaaaaaaaaaaaaaaacccccccccccccccccaacaaccccccccccccccccaaccccccccccccccccccccaaaaaacccccccaaccchhhmmmttxwyyyyyyvvrqqqmmmddddccccc +abcccccccccccccccaaaacccccccccccaaaaacccccccccccaaaaaaaaaaaaaaccaaaaccccaacccccaacccccaaaaaccccccccccccccccccccccccccccccccaaaaccaaaaaacccccccaaccahhhmmssswwywwwyyyvvrqmmmmdddcccccc +abccccccccccccccaaaaacccccccccccaacaacccccccccccaaaaaacaaaaaacccaaaaaaacaaccccaaaccccccaaaaacccccccacccccccccccccccccccccccaaaaccaacccccccccccaaaaahhhmmsswwwwwwwwywwvrrnnmdddccccccc +abccccccccccccccaaaaaaccaaccccccccccccccccccccccaaaaaaaaaaaaacccacaacaaaaaccccaaacaaacaaaaaacaaacaaacccccccacccaaccccaaccccaaaacccccccccaaaccccaaaahhhmmssswwwwswwwwwwrrnnndddccccccc +abaaccccccccccccacaaaacaaaaaaaccccccccccaacccccccaaaaaaaacaaaccccccccaaaaaaaaaaaaaaaacaaaacccaaaaaaacccccccaacaaaaaaaaacccccaaccccccccccaaacccaaaaahhhmmsssswsssrrwwwrrrnneddaccccccc +abaaccccccccaaccccaaccccaaaaacccccccccccaacccccccaaaacccccccacccccccaaaaaaaaaaaaaaaaacccaaccccaaaaaacccccccaaaaacaaaaaaacccccccccccccaaaaaaaaaaaaaahhhmmssssssssrrrrrrrrnneedaaaacccc +abacccccccccaaaaccccccaaaaaaaccccccccaaaaaaaacccccccccccccccccccccccaaaaaaaacaaaaaacccaaacccccaaaaaaaacccccaaaaaacaaaaaaaccccccccccccaaaaaaaaaaaaaahhhmmmsssssllrrrrrrrnnneeeaaaacccc +abaaacccccaaaaaaccccccaaaaaaaacccaaccaaaaaaaaccccaaaaaccccccccccccccaaaaaacccaaaaaaccccaaaccaaaaaaaaaaccccaaaaaaaaaaaaaaaccccccccccccccaaaaaccccaachhgmmmmmlllllllrrrrrnnneeeaaaacccc +abaaacccccaaaaaccccaccaaaaaaaacaaaaaaccaaaaccccccaaaaacccccccccccccccccaaacccaaaaaaaccaaaaaaaaaaaaaaaaccccaaaaaaaaaaaaacccccccccccccccaaaaaaccccaaccgggmmmllllllllllnnnnneeeaaaaccccc +abcccccccccaaaaacccaaacaaaacaacaaaaaacaaaaaccccccaaaaaaccccccccccccccccccccccaaacaaacccaaaaaaaacaaaccccccccccaaccaaaaaacccccccccccccccaaaaaacaacccccgggggmlllfffflllnnnnneeeaaaaccccc +abcccccccccaaccacccaaaaaaacccccaaaaaacaacaaacccccaaaaaaccccccccccccccccccccccaccaaccaaaaaaaaacccaaaccccccccccaaccccccaacccccaaaaccccccaccaaaaaaccccccggggggggfffffflnnneeeeeacaaacccc +abaaaccccccccccccccaaaaaacccccccaaaaacacccaaaacccaaaaaacccccccccccccccccccaaacccaaccaaaaaaaaacccaaccccccccccccccccccccccccccaaaaccccaaaccaaaaaacccccccgggggggfffffffffeeeeeaacccccccc +abaaaaacccccccccccaaaaaaaaccccccaaaacccccccaaacccccaacccccccaaacccccccccccaaaacaaacccaaaaaaaacccccccccccccccccccccccccccccccaaaaccccaaacccaaaaaaacccccccccgccaaaafffffeeeeccccccccccc +abaaaaaccccccaaccaaaaaaaaaacccccaaacaaaaaacaaaccccccccccccaaaaaccccccccccaaaaacaaacccccaaaaaaacccccccccccccccccccccccccccccccaacccccaaaaaaaaaaaaaccccccccccccaaaacaafffecccccccccccaa +abaaaacccaaacaaccaaaaaaaaaacccccaaaaaaaaaaaaaaaaacccccccccaaaaaaccccccccccaaaaaaaaaaacaaacccacccaacccccccccaaaaccccaaacccccccccccaaaaaaaaaaaaaaacccccccccccccaaaccccaaccccccccccccaaa +abaaaaacccaaaaacccccaaacaaacccccaaaaaaccaaaaaaaaacccccccccaaaaaaccaaccacccaaaaaaaaaaaaaaaccccccaaacccccccccaaaaccccaaaaccccccccccaaaaaaaaaaaaaaccccccccccccccaaaccccccccccccccccccaaa +abaaaaacccaaaaaaacccaaaccccccccaaaaaaaaccaaaaaaaccccccccccaaaaacccaaaaaccccaaaaaaaaaaaaacccccaaaaaaaaccccccaaaaccccaaaacccccccccccaaaaaaacccaaaccccccccccccccaaacccccccccccccccaaaaaa +abcccccccaaaaaaaaccccaacccccccaaaaaaaaaaaaaaaaacccccccccccaaaaaccaaaaaacccccaaaaaaaaaaaaaccccaaaaaaaacccccccaacccccaaacccccccccccccaaaaaaacccccccccccccccccccccccccccccccccccccaaaaar diff --git a/src/Days/D12.hs b/src/Days/D12.hs new file mode 100644 index 0000000..33fb16b --- /dev/null +++ b/src/Days/D12.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module Days.D12 where + +import Common +import Control.Monad (filterM, foldM) +import Control.Monad.Extra (concatMapM) +import Control.Monad.ST (ST, runST) +import Data.ByteString (ByteString) +import Data.ByteString.Char8 qualified as BS +import Data.ByteString.Unsafe qualified as BS +import Data.Char (ord) +import Data.Functor ((<&>)) +import Data.List (findIndex) +import Data.Maybe (fromMaybe) +import Data.Vector.Storable (Vector) +import Data.Vector.Storable qualified as Vec +import Data.Vector.Storable.Mutable qualified as MutVec +import Foreign.C (castCCharToChar) +import Foreign.ForeignPtr (newForeignPtr_) +import Foreign.Storable (Storable) +import System.IO.Unsafe (unsafePerformIO) + +data Point = P !Int !Int + deriving (Show, Eq, Ord) + +data Grid t = Grid Int Int (Vector t) + +data MGridSet s = MGridSet Int Int (MutVec.MVector s Bool) + +neigh4 :: Point -> [Point] +neigh4 (P x y) = + [ P (x - 1) y, + P (x + 1) y, + P x (y - 1), + P x (y + 1) + ] + +(@) :: (Storable t) => Grid t -> Point -> t +(@) (Grid _ w m) (P x y) = m Vec.! (w * x + y) + +get :: MGridSet s -> Point -> ST s Bool +get (MGridSet _ w m) (P x y) = MutVec.unsafeRead m (w * x + y) + +set :: MGridSet s -> Point -> ST s Bool +set (MGridSet _ w m) (P x y) = MutVec.unsafeExchange m (w * x + y) True + +dims :: Grid t -> (Int, Int) +dims (Grid h w _) = (h, w) + +mkGridSet :: (Int, Int) -> ST s (MGridSet s) +mkGridSet (h, w) = MGridSet h w <$> MutVec.replicate (h * w) False + +contains :: (Storable t) => Grid t -> Point -> Bool +contains (Grid h w _) (P x y) = + 0 <= x + && 0 <= y + && x < h + && y < w + +bfs :: (Storable t) => Grid t -> (Point -> Point -> Bool) -> Point -> [[Point]] +bfs g f start = + runST $ + mkGridSet (dims g) + >>= (\mgs -> set mgs start >> return mgs) + >>= flip go [start] + where + go :: MGridSet s -> [Point] -> ST s [[Point]] + go seen l + | null l = pure [] + | otherwise = (l :) <$> (advance seen l >>= go seen) + + -- advance :: MGridSet s -> [Point] -> ST s [Point] + -- advance seen points = + -- points + -- & concatMap (\point -> [p | p <- neigh4 point, g `contains` p, f point p]) + -- & foldM + -- (\l p -> set seen p <&> (\isNew -> if isNew then l else p : l)) + -- [] + + -- Uglier, but unfortunately significantly faster + advance :: MGridSet s -> [Point] -> ST s [Point] + advance seen = + concatMapM + ( \point -> + filterM (fmap not . get seen) [p | p <- neigh4 point, g `contains` p] + >>= foldM + (\l p -> set seen p <&> \wasSeen -> if wasSeen then l else p : l) + [] + . filter (f point) + ) + +find :: (Storable t, Eq t) => Grid t -> t -> Maybe Point +find (Grid _ w m) v = (\pos -> P (pos `div` w) (pos `mod` w)) <$> Vec.elemIndex v m + +elevation :: Char -> Int +elevation 'S' = ord 'a' +elevation 'E' = ord 'z' +elevation c = ord c + +needGear :: Grid Char -> Point -> Point -> Bool +needGear grid from to = elevation (grid @ to) <= elevation (grid @ from) + 1 + +part1 :: Grid Char -> Maybe Int +part1 grid = do + start <- find grid 'S' + end <- find grid 'E' + let bfsResult = bfs grid (needGear grid) start + findIndex (elem end) bfsResult + +part2 :: Grid Char -> Maybe Int +part2 grid = + find grid 'E' + >>= findIndex (any (\p -> elevation (grid @ p) == elevation 'a')) + . bfs grid (flip $ needGear grid) + +gridify :: ByteString -> Grid Char +gridify bytes = + let numBytes = BS.length bytes + w = fromMaybe numBytes (BS.elemIndex '\n' bytes) + h = (numBytes + 1) `div` (w + 1) + joinedBytes = BS.filter (/= '\n') bytes + in Grid + h + w + ( unsafePerformIO $ + BS.unsafeUseAsCStringLen + joinedBytes + ( \(mem, len) -> + newForeignPtr_ mem + >>= Vec.unsafeFreeze . flip MutVec.unsafeFromForeignPtr0 len + <&> Vec.map castCCharToChar + ) + ) + +day :: Day +day = + ByteStringDay + ( \text -> + let grid = gridify text + in Right (Answer <$> part1 grid, Answer <$> part2 grid) + ) diff --git a/src/Lib.hs b/src/Lib.hs index 46c0630..ca1fc1b 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -23,6 +23,7 @@ import Days.D08 qualified as D08 import Days.D09 qualified as D09 import Days.D10 qualified as D10 import Days.D11 qualified as D11 +import Days.D12 qualified as D12 import Data.ByteString.Char8 qualified as BS import Data.Text.IO qualified as T @@ -46,4 +47,5 @@ days = , [D09.day] , [D10.day] , [D11.day] + , [D12.day] ]