From aec4b7b0c4f083562a24305e5b65a289d5a1db07 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Wed, 15 Dec 2021 21:25:55 +0100 Subject: Cleanup 15 --- 2021/15.hs | 43 ++++++++----------------------------------- 1 file changed, 8 insertions(+), 35 deletions(-) diff --git a/2021/15.hs b/2021/15.hs index 542ba42..271a49d 100644 --- a/2021/15.hs +++ b/2021/15.hs @@ -9,8 +9,6 @@ import Data.Function (on) import Data.List hiding (insert) import Data.Ord --- import Debug.Trace - import Input @@ -32,55 +30,33 @@ qAdds = \pairs (PQueue l) -> PQueue (inserts (let PQueue pq = qFromList pairs in LT -> (k, vs) : inserts restnews l EQ -> (k, vs ++ vs') : inserts restnews rest GT -> (k', vs') : inserts news rest -qAdd :: Ord k => k -> v -> PQueue k v -> PQueue k v -qAdd k v pq = qAdds [(k, v)] pq qPop :: PQueue k v -> Maybe ((k, v), PQueue k v) qPop (PQueue []) = Nothing qPop (PQueue ((k, [v]) : l)) = Just ((k, v), PQueue l) qPop (PQueue ((k, v:vs) : l)) = Just ((k, v), PQueue ((k, vs) : l)) qPop (PQueue ((_, []) : l)) = qPop (PQueue l) --- Return array: (parent position, minimal distance) -dijkstra :: A.Array (Int, Int) Int -> A.Array (Int, Int) ((Int, Int), Int) +dijkstra :: A.Array (Int, Int) Int -> A.Array (Int, Int) Int dijkstra board = MA.runSTArray $ do - arr <- MA.newArray (A.bounds board) ((-1, -1), maxBound) - MA.writeArray arr (0, 0) ((-1, -1), 0) + arr <- MA.newArray (A.bounds board) maxBound + MA.writeArray arr (0, 0) 0 loop arr (qFromList [(0, (0, 0))]) return arr where - loop :: MA.STArray s (Int, Int) ((Int, Int), Int) -> PQueue Int (Int, Int) -> ST s () + loop :: MA.STArray s (Int, Int) Int -> PQueue Int (Int, Int) -> ST s () loop arr qu | Just ((curdist, (x, y)), qu') <- qPop qu = do - -- traceM ("pq = " ++ show qu) - -- traceM ("visit " ++ show (x, y)) - -- traceM ("pq = " ++ show qu') - neighbours <- mapM (\pos -> (pos,) . snd <$> MA.readArray arr pos) + neighbours <- mapM (\pos -> (pos,) <$> MA.readArray arr pos) . filter (A.inRange (A.bounds board)) $ [(x+1,y), (x,y+1), (x-1,y), (x,y-1)] let updates = [(curdist + board A.! pos', pos') | (pos', dist) <- neighbours , dist > curdist + board A.! pos'] - -- traceM ("updates = " ++ show updates) forM_ updates $ \(newdist, pos') -> - MA.writeArray arr pos' ((x, y), newdist) - -- MA.freeze arr >>= traceM . printDists + MA.writeArray arr pos' newdist loop arr (qAdds updates qu') | otherwise = return () -printDists :: A.Array (Int, Int) ((Int, Int), Int) -> String -printDists dists = - let pad2 s = let s' = " " ++ s in drop (length s' - 2) s' - (_, (ymax, xmax)) = A.bounds dists - in unlines [intercalate " " [let d = snd (dists A.! (y, x)) - in if d == maxBound then "--" else pad2 (show d) - | x <- [0..xmax]] - | y <- [0..ymax]] - -tracePath :: A.Array (Int, Int) ((Int, Int), Int) -> (Int, Int) -> [((Int, Int), Int)] -tracePath _ (-1, -1) = [] -tracePath dists to = let (next, dist) = dists A.! to - in (to, dist) : tracePath dists next - expand :: Int -> (Int -> a -> a) -> A.Array (Int, Int) a -> A.Array (Int, Int) a expand times f arr = let ((0, 0), (ymax, xmax)) = A.bounds arr @@ -95,9 +71,6 @@ main = do board <- map (map (read . pure)) <$> getInput 15 let (h, w) = (length board, length (head board)) let boardarr = A.listArray ((0, 0), (h-1, w-1)) (concat board) - print (snd (dijkstra boardarr A.! (h-1, w-1))) + print (dijkstra boardarr A.! (h-1, w-1)) let expanded = expand 5 (\n x -> (x + n - 1) `mod` 9 + 1) boardarr - -- putStr $ unlines [concatMap show [expanded A.! (y, x) | x <- [0 .. 5*w-1]] | y <- [0 .. 5*h-1]] - print (snd (dijkstra expanded A.! (5*h-1, 5*w-1))) - -- mapM_ print $ reverse (tracePath dists (h-1, w-1)) - -- putStr (printDists dists) + print (dijkstra expanded A.! (5*h-1, 5*w-1)) -- cgit v1.2.3-54-g00ecf