Day 20: Race Condition
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 2 points
*
Haskell
solution
import Control.Arrow
import Data.Array.Unboxed
import Data.Functor
import Data.List
import Data.Map qualified as M
import Data.Set qualified as S
type Pos = (Int, Int)
type Board = Array Pos Char
type Path = M.Map Pos Int
parse board = listArray ((1, 1), (length l, length $ head l)) (concat l)
where
l = lines board
moves :: Pos -> [Pos]
moves p = [first succ p, first pred p, second succ p, second pred p]
getOrigin :: Board -> Maybe Pos
getOrigin = fmap fst . find ((== 'S') . snd) . assocs
getPath :: Board -> Pos -> [Pos]
getPath board p
| not $ inRange (bounds board) p = []
| board ! p == 'E' = [p]
| board ! p == '#' = []
| otherwise = p : (moves p >>= getPath (board // [(p, '#')]))
taxiCab (xa, ya) (xb, yb) = abs (xa - xb) + abs (ya - yb)
solve dist board = do
path <- M.fromList . flip zip [1 ..] <$> (getOrigin board <&> getPath board)
let positions = M.keys path
jumps = [ (path M.! a) - (path M.! b) - d | a <- positions, b <- positions, d <- [taxiCab a b], d <= dist]
return $ length $ filter (>=100) jumps
main = getContents >>= print . (solve 2 &&& solve 20) . parse
1 point
