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 2 points
*
Haskell
Wasn’t there a pathfinding problem just recently?
Edit: Optimization to avoid recalculating paths all the time
Haskell with lambdas
import Control.Arrow
import Control.Monad
import Data.Bifunctor hiding (first, second)
import Data.Set (Set)
import Data.Map (Map)
import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
parse :: String -> [(Int, Int)]
parse = map (join bimap read) . map (break (== ',') >>> second (drop 1)) . filter (/= "") . lines
lowerBounds = (0, 0)
exitPosition = (70, 70)
initialBytes = 1024
adjacent (py, px) = Set.fromDistinctAscList [(py-1, px), (py, px-1), (py, px+1), (py+1, px)]
data Cost = Wall | Explored Int
deriving (Show, Eq)
inBounds (py, px)
| py < 0 = False
| px < 0 = False
| py > fst exitPosition = False
| px > snd exitPosition = False
| otherwise = True
dijkstra :: Map Int (Set (Int, Int)) -> Map (Int, Int) Cost -> (Int, (Int, Int), Map (Int, Int) Cost)
dijkstra queue walls
| Map.null queue = (-1, (-1, -1), Map.empty)
| minPos == exitPosition = (minKey, minPos, walls)
| Maybe.isJust (walls Map.!? minPos) = dijkstra remainingQueue' walls
| not . inBounds $ minPos = dijkstra remainingQueue' walls
| otherwise = dijkstra neighborQueue updatedWalls
where
((minKey, posSet), remainingQueue) = Maybe.fromJust . Map.minViewWithKey $ queue
(minPos, remainingPosSet) = Maybe.fromJust . Set.minView $ posSet
remainingQueue' = if not . Set.null $ remainingPosSet then Map.insert minKey remainingPosSet remainingQueue else remainingQueue
neighborQueue = List.foldl (\ m n -> Map.insertWith (Set.union) neighborKey (Set.singleton n) m) remainingQueue' neighbors
updatedWalls = Map.insert minPos (Explored minKey) walls
neighborKey = minKey + 1
neighbors = adjacent minPos
isExplored :: Cost -> Bool
isExplored Wall = False
isExplored (Explored _) = True
findPath :: Int -> (Int, Int) -> Map (Int, Int) Cost -> [(Int, Int)]
findPath n p ts
| p == lowerBounds = [lowerBounds]
| n == 0 = error "Out of steps when tracing backwards"
| List.null neighbors = error "No matching neighbors when tracing backwards"
| otherwise = p : findPath (pred n) (fst . head $ neighbors) ts
where
neighbors = List.filter ((== Explored (pred n)) . snd) . List.filter (isExplored . snd) . List.map (join (,) >>> second (ts Map.!)) . List.filter inBounds . Set.toList . adjacent $ p
runDijkstra = flip zip (repeat Wall)
>>> Map.fromList
>>> dijkstra (Map.singleton 0 (Set.singleton lowerBounds))
fst3 :: (a, b, c) -> a
fst3 (a, _, _) = a
thrd :: (a, b, c) -> c
thrd (_, _, c) = c
part1 = take initialBytes
>>> runDijkstra
>>> \ (n, _, _) -> n
firstFailing :: [(Int, Int)] -> [[(Int, Int)]] -> (Int, Int)
firstFailing path (bs:bss)
| List.last bs `List.notElem` path = firstFailing path bss
| c == (-1) = List.last bs
| otherwise = firstFailing (findPath c p ts) bss
where
(c, p, ts) = runDijkstra bs
part2 bs = repeat
>>> zip [initialBytes..length bs]
>>> map (uncurry take)
>>> firstFailing path
$ bs
where
(n, p, ts) = runDijkstra . take 1024 $ bs
path = findPath n p ts
main = getContents
>>= print
. (part1 &&& part2)
. parse