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

  • VegOwOtenks@lemmy.world
    link
    fedilink
    English
    arrow-up
    2
    ·
    edit-2
    9 days ago

    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