Day 18: Ram Run
Megathread guidelines
- Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
- You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL
FAQ
- What is this?: Here is a post with a large amount of details: https://programming.dev/post/6637268
- Where do I participate?: https://adventofcode.com/
- Is there a leaderboard for the community?: We have a programming.dev leaderboard with the info on how to join in this post: https://programming.dev/post/6631465
You are viewing a single thread.
View all comments 3 points
Haskell
solution
import Control.Arrow
import Control.Monad
import Control.Monad.RWS
import Control.Monad.Trans.Maybe
import Data.Array (inRange)
import Data.Char
import Data.Set qualified as S
import Text.ParserCombinators.ReadP hiding (get)
parse = fst . last . readP_to_S (endBy ((,) <$> num <*> (char ',' *> num)) $ char '\n')
where
num = read <$> munch1 isDigit
bounds = ((0, 0), (70, 70))
bfs :: MaybeT (RWS (S.Set (Int, Int)) () (S.Set (Int, Int), [(Int, (Int, Int))])) Int
bfs = do
(seen, (c, x) : xs) <- get
modify . second $ const xs
isCorrupt <- asks (S.member x)
when (not (x `S.member` seen) && not isCorrupt && inRange bounds x) $
modify (S.insert x *** (++ ((succ c,) <$> neighbors x)))
if x == snd bounds
then return c
else bfs
neighbors (x, y) = [(succ x, y), (pred x, y), (x, succ y), (x, pred y)]
findPath = fst . flip (evalRWS (runMaybeT bfs)) (mempty, [(0, (0, 0))]) . S.fromList
part1 = findPath . take 1024
search corrupt = go 0 (length corrupt)
where
go l r = case (findPath $ take (pred m) corrupt, findPath $ take m corrupt) of
(Just _, Just _) -> go m r
(Just _, Nothing) -> Just $ pred m
(Nothing, Nothing) -> go l m
where
m = (l + r) `div` 2
part2 = liftM2 fmap (!!) search
main = getContents >>= print . (part1 &&& part2) . parse
