For day 12 “Hill Climbing Algorithm”1 of
Advent of Code, we’re
looking for limited-descent-rate paths from a grid’s top spot to the
lowest ones. The ones labelled S
for part 1, the ones
labelled a
for part 2.
Continuing in the literate Haskell groove, here are a few imports.
import Control.Applicative (asum,liftA2)
import Control.Arrow ((&&&),(***))
import Control.Monad (guard)
import Data.Array
import Data.Char (ord)
import Data.List (find,foldl')
import Data.Monoid (Alt(Alt,getAlt))
import Data.Sequence (ViewL((:<)),(><))
import qualified Data.Sequence as Q
import qualified Data.Set as Set
I’ll be using the input grid’s characters raw, so let’s define a function to extract an altitude out of them without having to traverse the grid too many times to isolate its singular points.
altitude :: Char -> Int
'E' = ord 'z'
altitude 'S' = ord 'a'
altitude = ord x altitude x
No need to normalize or unbias as we’re only ever comparing them to each other, never using the absolute value.
Now let’s read the grid from standard input:
main :: IO ()
= do
main <- lines <$> getContents
rawGrid let h = length rawGrid
= length (head rawGrid)
w = listArray ((1,1),(h,w)) (concat rawGrid) grid
We can now define point expansion routines. Movement is standard axes only, no diagonals:
let neighbors (i,j) =
filter (inRange (bounds grid))
+1,j), (i-1,j), (i,j+1), (i,j-1) ] [ (i
We can walk from a point to the other if the backwards ascent
(p'
to p
) doesn’t go higher than 1:
= altitude (grid ! p) - altitude (grid ! p') <= 1 steppable p p'
Node expansion is now a simple combination of the both:
= filter <$> steppable <*> neighbors expand
We’ll look for shortest paths using a simple BFS. We’ll need to traverse the grid once to find the search starting point. Which happens to be the Elves’ target.
let Just target = find ((== 'E') . (grid !)) (indices grid)
Let’s now generate the list of all distances from that point:
= bfs target expand bfo
We can now look for S
or a
, going through
the list at most once.
= guard (grid!p == c) *> Alt (Just i)
lookFor c (p,i) = scanl1 (<>) . map (lookFor 'S' &&& lookFor 'a')
lookForEither = uncurry (liftA2 (,)) . (getAlt *** getAlt)
needBoth print $ asum $ map needBoth $ lookForEither bfo
That’s a lot of plumbing for little actual computation.
lookFor
returns Just i
when it finds the
altitude it was looking for, Nothing
in other spots. We
call it once per puzzle part and wrap its results in Alt
so
that we can merge them by pairs, making use of the standard
Monoid
instances for pairs in lookForEither
.
We then unwrap using getAlt
and reinterpret in a single
Maybe
functor per pair, this time with straight
Monoid
semantics, returning Just (a,b)
only
when both components of the input pair were Just
s. Finally
asum
short-circuits to the first such item, yielding both
parts’ answers at once.
As support code, a fairly generic BFS:
bfs :: Ord a => a -> (a -> [a]) -> [(a,Int)]
= go (Set.singleton start) (Q.singleton (start,0)) where
bfs start expand = case Q.viewl q of
go cl q Q.EmptyL -> []
:< q' -> d' `seq` (p,d) : go cl' (q' >< q'')
(p,d) where
= d + 1
d' = Q.fromList (map (, d') ns)
q'' = filter (`Set.notMember` cl) (expand p)
ns = foldl' (flip Set.insert) cl ns cl'
This concludes today’s solution. Much more straightforward than yesterday’s, as promised. See you tomorrow!
I do appreciate the irony of titling the puzzle with an algorithm class that’s not really the one used to solve it.↩︎