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 SetI’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
altitude 'E' = ord 'z'
altitude 'S' = ord 'a'
altitude x = ord xNo 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 ()
main = do
rawGrid <- lines <$> getContents
let h = length rawGrid
w = length (head rawGrid)
grid = listArray ((1,1),(h,w)) (concat rawGrid)We can now define point expansion routines. Movement is standard axes only, no diagonals:
let neighbors (i,j) =
filter (inRange (bounds grid))
[ (i+1,j), (i-1,j), (i,j+1), (i,j-1) ]We can walk from a point to the other if the backwards ascent
(p' to p) doesn’t go higher than 1:
steppable p p' = altitude (grid ! p) - altitude (grid ! p') <= 1Node expansion is now a simple combination of the both:
expand = filter <$> steppable <*> neighborsWe’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:
bfo = bfs target expandWe can now look for S or a, going through
the list at most once.
lookFor c (p,i) = guard (grid!p == c) *> Alt (Just i)
lookForEither = scanl1 (<>) . map (lookFor 'S' &&& lookFor 'a')
needBoth = uncurry (liftA2 (,)) . (getAlt *** getAlt)
print $ asum $ map needBoth $ lookForEither bfoThat’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 Justs. 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)]
bfs start expand = go (Set.singleton start) (Q.singleton (start,0)) where
go cl q = case Q.viewl q of
Q.EmptyL -> []
(p,d) :< q' -> d' `seq` (p,d) : go cl' (q' >< q'')
where
d' = d + 1
q'' = Q.fromList (map (, d') ns)
ns = filter (`Set.notMember` cl) (expand p)
cl' = foldl' (flip Set.insert) cl nsThis 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.↩︎