From edadad9c2ee998065e6292493ffac16037de477b Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Wed, 14 Dec 2022 22:09:17 +0000 Subject: [PATCH] Done day 12 --- advent-of-code22.cabal | 5 ++ advent12/Main.hs | 155 +++++++++++++++++++++++++++++++++++++++ data/advent12.txt | 41 +++++++++++ data/advent12a.txt | 5 ++ problems/day12.html | 160 +++++++++++++++++++++++++++++++++++++++++ 5 files changed, 366 insertions(+) create mode 100644 advent12/Main.hs create mode 100644 data/advent12.txt create mode 100644 data/advent12a.txt create mode 100644 problems/day12.html diff --git a/advent-of-code22.cabal b/advent-of-code22.cabal index 7d29361..9f7d50a 100644 --- a/advent-of-code22.cabal +++ b/advent-of-code22.cabal @@ -155,3 +155,8 @@ executable advent11 import: common-extensions, build-directives main-is: advent11/Main.hs build-depends: text, attoparsec, containers, lens, mtl + +executable advent12 + import: common-extensions, build-directives + main-is: advent12/Main.hs + build-depends: containers, linear, array, pqueue, mtl, lens \ No newline at end of file diff --git a/advent12/Main.hs b/advent12/Main.hs new file mode 100644 index 0000000..d07fb19 --- /dev/null +++ b/advent12/Main.hs @@ -0,0 +1,155 @@ +-- Writeup at https://work.njae.me.uk/2022/12/14/advent-of-code-2022-day-12/ + +import AoC + +import qualified Data.PQueue.Prio.Min as P +import qualified Data.Set as S +import qualified Data.Sequence as Q +-- import Data.Sequence ((<|), (|>), (><)) +import Data.Sequence ((|>)) +import Data.Foldable (foldl') +import Data.Char +import Control.Monad.Reader +import Control.Lens hiding ((<|), (|>), (:>), (:<), indices) +import Linear (V2(..), (^+^), (^-^)) +import Data.Array.IArray + +-- pattern Empty <- (Q.viewl -> Q.EmptyL) where Empty = Q.empty +-- pattern x :< xs <- (Q.viewl -> x Q.:< xs) where (:<) = (Q.<|) +-- pattern xs :> x <- (Q.viewr -> xs Q.:> x) where (:>) = (Q.|>) + +type Position = V2 Int -- r, c +type Grid = Array Position Int + +data Mountain = Mountain + { _grid :: Grid + , _start :: Position + , _goal :: Position + } deriving (Eq, Ord, Show) +makeLenses ''Mountain + +type MountainContext = Reader Mountain + +data Agendum = + Agendum { _current :: Position + , _trail :: Q.Seq Position + , _trailCost :: Int + , _cost :: Int + } deriving (Show, Eq) +makeLenses ''Agendum + +type Agenda = P.MinPQueue Int Agendum + +type ExploredStates = S.Set Position + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- readFile dataFileName + let mountain = mkMountain text + -- print mountain + print $ part1 mountain + print $ part2 mountain + +part1, part2 :: Mountain -> Int +part1 mountain = maybe 0 _cost result + where s = mountain ^. start + result = runReader (searchMountain s) mountain + +part2 mountain = minimum results + where starts = possibleStarts mountain + results = fmap (runSearch mountain) starts + +runSearch :: Mountain -> Position -> Int +runSearch mountain s = maybe maxCost _cost result + where result = runReader (searchMountain s) mountain + maxCost = length $ indices $ mountain ^. grid + +possibleStarts :: Mountain -> [Position] +possibleStarts mountain = map fst $ filter ((== 0) . snd) + $ assocs $ mountain ^. grid + +mkMountain :: String -> Mountain +mkMountain text = Mountain { _grid = grid, _start = s, _goal = g } + where rows = lines text + r = length rows - 1 + c = (length $ head rows) - 1 + grid0 = listArray ((V2 0 0), (V2 r c)) $ map mkCell $ concat rows + mkCell e = ord e - ord 'a' + s = head [i | i <- range ((V2 0 0), (V2 r c)), grid0 ! i == (mkCell 'S')] + g = head [i | i <- range ((V2 0 0), (V2 r c)), grid0 ! i == (mkCell 'E')] + grid = grid0 // [(s, mkCell 'a'), (g, mkCell 'z')] + +searchMountain :: Position -> MountainContext (Maybe Agendum) +searchMountain startPos = + do agenda <- initAgenda startPos + aStar agenda S.empty + +initAgenda :: Position -> MountainContext Agenda +initAgenda pos = + do c <- estimateCost pos + return $ P.singleton c Agendum { _current = pos, _trail = Q.empty, _trailCost = 0, _cost = c} + +aStar :: Agenda -> ExploredStates -> MountainContext (Maybe Agendum) +aStar agenda closed + -- | trace ("Peeping " ++ (show $ fst $ P.findMin agenda) ++ ": " ++ (show reached) ++ " <- " ++ (show $ toList $ Q.take 1 $ _trail $ currentAgendum) ++ " :: " ++ (show newAgenda)) False = undefined + -- | trace ("Peeping " ++ (show $ _current $ snd $ P.findMin agenda) ) False = undefined + | P.null agenda = return Nothing + | otherwise = + do let (_, currentAgendum) = P.findMin agenda + let reached = currentAgendum ^. current + nexts <- candidates currentAgendum closed + let newAgenda = foldl' (\q a -> P.insert (_cost a) a q) (P.deleteMin agenda) nexts + reachedGoal <- isGoal reached + if reachedGoal + then return (Just currentAgendum) + else if reached `S.member` closed + then aStar (P.deleteMin agenda) closed + else aStar newAgenda (S.insert reached closed) + +candidates :: Agendum -> ExploredStates -> MountainContext (Q.Seq Agendum) +candidates agendum closed = + do let candidate = agendum ^. current + let previous = agendum ^. trail + let prevCost = agendum ^. trailCost + succs <- successors candidate + let nonloops = Q.filter (\s -> s `S.notMember` closed) succs + mapM (makeAgendum previous prevCost) nonloops + + +makeAgendum :: Q.Seq Position -> Int -> Position -> MountainContext Agendum +makeAgendum previous prevCost newPosition = + do predicted <- estimateCost newPosition + grid <- asks _grid + let newTrail = previous |> newPosition + let incurred = prevCost + 1 + return Agendum { _current = newPosition + , _trail = newTrail + , _trailCost = incurred + , _cost = incurred + predicted + } + +isGoal :: Position -> MountainContext Bool +isGoal here = + do goal <- asks _goal + return $ here == goal + +successors :: Position -> MountainContext (Q.Seq Position) +successors here = + do grid <- asks _grid + let heightHere = grid ! here + let neighbours = + filter (\p -> (grid ! p) - heightHere <= 1) + $ + filter (inRange (bounds grid)) + [ here ^+^ delta + | delta <- [V2 -1 0, V2 1 0, V2 0 -1, V2 0 1] + ] + let succs = Q.fromList neighbours + return succs + +estimateCost :: Position -> MountainContext Int +estimateCost here = + do goal <- asks _goal + let (V2 dr dc) = here ^-^ goal + return $ (abs dr) + (abs dc) diff --git a/data/advent12.txt b/data/advent12.txt new file mode 100644 index 0000000..c25c3c6 --- /dev/null +++ b/data/advent12.txt @@ -0,0 +1,41 @@ +abccccccccaaaaccccaaacaccccaaaaaacccccccccccaaaccccccccccaaaaaaacccccccccccccccccccccccccccccacaaaccccccccccccccccccccccccccccccccccccccccaaaaa +abccccccccaaaaccaaaaaaaacccaaaaaacccccccccccaaaacccccccccaaaaaaaaaacccccccccccccccaaccccccccaaaaaccaaaccaacccccccccccccccccccccccccccccccaaaaaa +abcccccccccaacccaaaaaaaaccccaaaaacccccccccccaaaacccccccaaaaaaaaaaaaaccccccccccaaaaaaccccccccaaaaaaaaaaaaaaccccccccccccccccaaaccccccccccccaaaaaa +abcccccccccccccccaaaaaccccccaacaaccccaacccccaaacccccccaaaaaaaaaaaaaaccccccccccaaaaaaacccccccccaaaaacaaaaaaccccccccccccccccaaccccccccccccccccaaa +abccccccccccccccccaaaaaccccccccccaaccaacccccccccccccccaaaaacaaaacacacccccaacccaaaaaaaacccccccaaaaacaaaaaaaccccccccccccccccaaacccccccccccccccaaa +abcccccccccccccccaaaaaaccccccccccaaaaaaccccccccccccccccaaaaaaaacaaaaacaaaaaccccaaaaaaacccccccaacaacaaaaaaaaccccccccaaaaccaakcccccccccccccccccaa +abcccccccccccccccaaaccacccccccccccaaaaaaacccccccaaaccccccaaaaaacaaaaaccaaaaaccaaaaaaccccccccccccaacaaaaaaaacccccccccaaaakkkklllcccccccccccccccc +abcccccaaaccccccccccccccccccccccccaaaaaaacccccccaaacacccaaaaaaaaaaaaacaaaaaaccaaaaaacccccccccccccccccaaaccccccccccccaaakkkkkllllcccccccaacccccc +abccccaaaacccccccccccccccccccccccaaaaaacccccccaccaaaaaccaaaaaaaaaaaaacaaaaccccccccaaccccccccccccccccccaaccccccccccccckkkkkkpllllccccaaaaaaccccc +abccccaaaacccccccccccccccccaaacccaaaaaacccccccaaaaaaaacccaaaaacaaaaaacccaaaccccccccccccccccccccccccccccccccccccccccckkkkpppppplllcccaaaaacccccc +abcccccaaaccccccccccccccccaaaacccccccaaccccccccaaaaacccccaaaccccaaacccccccccccccccccccccccccaaccccccccccccccccccjjjkkkkpppppppplllcccaaaaaacccc +abccccccccccccccccccccccccaaaaccccccccccccccccccaaaaacccccccccccccccccccccccccccccccccccccccaaaaaccccccccccccjjjjjjkkkrppppuppplllccccaaaaacccc +abccccccccccccccaaaccccccccaaaccccccccccccccccccaacaaccccccccccccccccccccccaaaccccccccaacccaaaaaccccccccccccjjjjjjjjrrrpuuuuuppplllcccccaaacccc +abcccccaaccaacccaaacacccccccccccccccccccccccccacaaaaccccccccccccccccccccccaaaaaaccccaaaacccaaaaaaccaccccccccjjjrrrrrrrrruuuuuppplllmcccddcccccc +abcccccaaaaaacaaaaaaaaccccccccccccccccccccccccaacaaaccccccccccccccccccccccaaaaaaccccaaaaaacccaaaaccaaacaaacjjjrrrrrrrrruuuxuuupqqlmmmmddddccccc +abcccccaaaaaccaaaaaaaaccccccccccccccccccccccccaaaaaccccaacccccccccccccccccaaaaaacccccaaaacccaacccccaaaaaaacjjjrrrrtuuuuuuxxyuvqqqqmmmmmddddcccc +abaacccaaaaaaccaaaaaccccccccccccccccccaaaaccccaaaaaaccaaaccccccccccccccccccaaaaaccccaaaaaccccccccccaaaaaaccjjjrrrtttuuuuuxxyvvvqqqqqmmmmdddcccc +abaaccaaaaaaaaccaaaaaccccccccccccccccaaaaaaaaaaaaaaaacaaacaaaccccccccccccccaacaacaacaacaaccccccccaaaaaaaaccijjqqrtttxxxxxxyyvvvvvqqqqmmmmdddccc +abaaccaaaaaaaacaaaaaaccccccccccccccccaaaaaaaaaaaaaaaaaaaaaaaacccccccccccccccaaacaaaccccccccccaaccaaaaaaaaaciiiqqqttxxxxxxxyyvvvvvvvqqqmmmdddccc +abaaaccccaaccccaaaccacccccccccccccccccaaaaaaccccaacaaaaaaaaaaccaaaccccccccccaaaaaaaccccccccccaaaaaaaaaaaaaaiiiqqqtttxxxxxxyyyyyyvvvqqqmmmdddccc +SbaaaccccaacccccccccccccccccccccccccaaaaaaaaccccaacccaaaaaaccaaaaaaccccccccccaaaaaacccccccccccaaaaacaaacaaaaiiiqqqttxxxxEzzyyyyyvvvqqqmmmdddccc +abaaaccccccccccccccccccccccccccccccaaaaaaaaaaccccccccaaaaaaccaaaaaaccccccccccaaaaaaaaccccccccaaaaaacaaaccaaaiiiqqqtttxxxyyyyyyvvvvqqqmmmdddcccc +abaccccccaacccccccccccccccccccccccccaaaaaaaaaaaacccccaaaaaaacaaaaaacccccccccaaaaaaaaacccccccaaaaaaaacaaaaaaaiiiqqqtttxxyyyyyyvvvvqqqqnnmeddcccc +abccccccaaaaccccccccccccaaaccccccccccccaaaaaaaaaaacccaaacaaacaaaaacccccccccaaaaaaaaaacccccccaaaaaaaaccaaaaaaaiiiqqtttxxyyyyyywvrrrrnnnneeeccccc +abccccccaaaacccccaacccccaaaacccccccccccaaaccaaaaaacccacccccccaaaaacccccccccaaacaaacccccccccccccaacccccccaaaaaiiqqqttxxwywwyyywwrrrnnnneeeeccccc +abccccccaaaaccaacaaaccccaaaaccccccaacccaacccaaaaaccccccccccccccccccccccccccccccaaacccccccccccccaaccccccaaaaaaiiqqqttwwwwwwwwywwrrrnnneeeecccccc +abccccccccccccaaaaacccccaaaccccacaaacccccccccaaaaacccccccccccccccccccccccccccccaaacccccccccccccccccccccaaaaaaiiqqpsswwwwsswwwwwrrnnneeeeccccccc +abcccccccccccccaaaaaacccccccccaaaaacaacccccccaacaacccccaaccccccccccccccccccccccccccccccccccccccccccccccaccaahhhpppssssssssswwwwrrnnneeeaccccccc +abcccccccccccaaaaaaaacccccccccaaaaaaaacccccaaccccccaaacaaccccccccccccccccccccccccccccccccccccaaaccaccccccccchhhpppsssssssssswwrrrnnneeeaaaacccc +abcccccccccccaaaaacaacccccccccccaaaaaccaaaaaaccccccaaaaaaccccccccccccccccccccccccccccaaccaaccaaaaaacccccccccchhpppppsspppossrrrrrnnneeeaaaacccc +abccccccccccccacaaaccccccccccccaaaaacccaaaaaaaacccccaaaaaaaccaaaccccccccaaaacccccccccaaaaaacccaaaaacccccccccchhhpppppppppoosrrrroonffeaaaaacccc +abccccccccccccccaaaccccccccccccaacaaaccaaaaaaaaccccaaaaaaaaacaaaccccccccaaaacccccccccaaaaaccaaaaaaacccccccccchhhhpppppppoooooooooonfffaaaaccccc +abcccccccccccccccccccccccaaaccccccaaccccaaaaaaaccccaaaaaaaaaaaaaaaccccccaaaacccccccccaaaaaacaaaaaaaacccccaacchhhhhhhhgggggoooooooofffaaaaaacccc +abcccccccccccccccccccccccaaaaacccaacccccaaaaaccccccaaaaaacaaaaaaaaccccccaaacccccccccaaaaaaaaaaaaaaaaccccaaacccchhhhhgggggggooooooffffaaaaaacccc +abccaaacccccccccccccccccaaaaaaccaaaccccaaaaaacccccccccaaacccaaaaacccccccccccccccccccaaaaaaaaccaaacacccccaaacaaachhhggggggggggfffffffcaacccccccc +abcaaaaccccccccccaacccccaaaaaaccaaacaaaccccaaccccccccccccccaaaaacccccccccccccccccccccccaacccccaaaccccaaaaaaaaaacccccccccaagggffffffcccccccccccc +abcaaaaccccccccccaaccccccaaaaaaaaaaaaaaccccccccccccccccccccaaaaaaccccccccccccccccccccccaaccccccccccccaaaaaaaaaccccccccccaaacgfffffcccccccccccaa +abccaaacccccccaaaaaaaacccaaaaaaaaaaaaaaccccccccaaaaaccaaaaaaaaaaaaaacaacccccccccaaaccacccccccccccccccccaaaaacccccccccccaaaaccccccccccccccccccaa +abccccccccccccaaaaaaaacccccccccaaaaaaccccccccccaaaaaccaaaaaaaaaaaaaacaaaaaacccccaaaaaacccccccccccccccccaaaaaacccccccccccaacccccccccccccccacacaa +abccccccccccccccaaaacccccccccccaaaaaacccccccccaaaaaacccaaaaaaaaaaaaacaaaaaacccccaaaaaacccccccccccccccccaaaaaaaccccccccccaacccccccccccccccaaaaaa +abcccccccccccccaaaaaaccccccccccaaaaaaaccccccccaaaaaaccccccaaaaaacccaaaaaaaaccccaaaaaaaaccccccccccccccccaaacaaacccccccccccccccccccccccccccaaaaaa \ No newline at end of file diff --git a/data/advent12a.txt b/data/advent12a.txt new file mode 100644 index 0000000..433e0d2 --- /dev/null +++ b/data/advent12a.txt @@ -0,0 +1,5 @@ +Sabqponm +abcryxxl +accszExk +acctuvwj +abdefghi \ No newline at end of file diff --git a/problems/day12.html b/problems/day12.html new file mode 100644 index 0000000..9e386d5 --- /dev/null +++ b/problems/day12.html @@ -0,0 +1,160 @@ + + + + +Day 12 - Advent of Code 2022 + + + + + + + + +

Advent of Code

Neil Smith (AoC++) 24*

   <y>2022</y>

+ + + +
+

--- Day 12: Hill Climbing Algorithm ---

You try contacting the Elves using your handheld device, but the river you're following must be too low to get a decent signal.

+

You ask the device for a heightmap of the surrounding area (your puzzle input). The heightmap shows the local area from above broken into a grid; the elevation of each square of the grid is given by a single lowercase letter, where a is the lowest elevation, b is the next-lowest, and so on up to the highest elevation, z.

+

Also included on the heightmap are marks for your current position (S) and the location that should get the best signal (E). Your current position (S) has elevation a, and the location that should get the best signal (E) has elevation z.

+

You'd like to reach E, but to save energy, you should do it in as few steps as possible. During each step, you can move exactly one square up, down, left, or right. To avoid needing to get out your climbing gear, the elevation of the destination square can be at most one higher than the elevation of your current square; that is, if your current elevation is m, you could step to elevation n, but not to elevation o. (This also means that the elevation of the destination square can be much lower than the elevation of your current square.)

+

For example:

+
Sabqponm
+abcryxxl
+accszExk
+acctuvwj
+abdefghi
+
+

Here, you start in the top-left corner; your goal is near the middle. You could start by moving down or right, but eventually you'll need to head toward the e at the bottom. From there, you can spiral around to the goal:

+
v..v<<<<
+>v.vv<<^
+.>vv>E^^
+..v>>>^^
+..>>>>>^
+
+

In the above diagram, the symbols indicate whether the path exits each square moving up (^), down (v), left (<), or right (>). The location that should get the best signal is still E, and . marks unvisited squares.

+

This path reaches the goal in 31 steps, the fewest possible.

+

What is the fewest steps required to move from your current position to the location that should get the best signal?

+
+

Your puzzle answer was 468.

--- Part Two ---

As you walk up the hill, you suspect that the Elves will want to turn this into a hiking trail. The beginning isn't very scenic, though; perhaps you can find a better starting point.

+

To maximize exercise while hiking, the trail should start as low as possible: elevation a. The goal is still the square marked E. However, the trail should still be direct, taking the fewest steps to reach its goal. So, you'll need to find the shortest path from any square at elevation a to the square marked E.

+

Again consider the example from above:

+
Sabqponm
+abcryxxl
+accszExk
+acctuvwj
+abdefghi
+
+

Now, there are six choices for starting position (five marked a, plus the square marked S that counts as being at elevation a). If you start at the bottom-left square, you can reach the goal most quickly:

+
...v<<<<
+...vv<<^
+...v>E^^
+.>v>>>^^
+>^>>>>>^
+
+

This path reaches the goal in only 29 steps, the fewest possible.

+

What is the fewest steps required to move starting from any square with elevation a to the location that should get the best signal?

+
+

Your puzzle answer was 459.

Both parts of this puzzle are complete! They provide two gold stars: **

+

At this point, you should return to your Advent calendar and try another puzzle.

+

If you still want to see it, you can get your puzzle input.

+

You can also this puzzle.

+
+ + + + + + \ No newline at end of file -- 2.34.1