15

2 files changed, 203 insertions, 0 deletions

diff --git a/2021/15.hs b/2021/15.hs
new file mode 100644
index 0000000..542ba42
--- /dev/null
+++ b/2021/15.hs
@@ -0,0 +1,103 @@
+{-# LANGUAGE TupleSections #-}
+module Main where
+
+import Control.Monad (forM_)
+import Control.Monad.ST (ST)
+import qualified Data.Array as A
+import qualified Data.Array.ST as MA
+import Data.Function (on)
+import Data.List hiding (insert)
+import Data.Ord
+
+-- import Debug.Trace
+
+import Input
+
+
+-- Priority queue that only performs okay if there are only a small number of
+-- distinct keys in the queue at any one time.
+newtype PQueue k v = PQueue [(k, [v])]
+  deriving (Show)
+qFromList :: Ord k => [(k, v)] -> PQueue k v
+qFromList [] = PQueue []
+qFromList l = PQueue (map ((,) <$> fst . head <*> map snd)
+                      . groupBy ((==) `on` fst)
+                      $ sortBy (comparing fst) l)
+qAdds :: Ord k => [(k, v)] -> PQueue k v -> PQueue k v
+qAdds = \pairs (PQueue l) -> PQueue (inserts (let PQueue pq = qFromList pairs in pq) l)
+  where inserts :: Ord k => [(k, [v])] -> [(k, [v])] -> [(k, [v])]
+        inserts [] l = l
+        inserts news [] = news
+        inserts news@((k, vs) : restnews) l@((k', vs') : rest) = case compare k k' of
+          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 board = MA.runSTArray $ do
+    arr <- MA.newArray (A.bounds board) ((-1, -1), maxBound)
+    MA.writeArray arr (0, 0) ((-1, -1), 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 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)
+                        . 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
+          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
+        (h, w) = (ymax + 1, xmax + 1)
+    in A.listArray ((0, 0), (times * h - 1, times * w - 1))
+         [f (x `div` w + y `div` w) (arr A.! (y `mod` h, x `mod` w))
+         | y <- [0 .. times * h - 1]
+         , x <- [0 .. times * w - 1]]
+
+main :: IO ()
+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)))
+    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)
diff --git a/2021/15.in b/2021/15.in
new file mode 100644
index 0000000..d1a90d5
--- /dev/null
+++ b/2021/15.in
@@ -0,0 +1,100 @@
+6763679391685199321216293379889971448824578974299594779321588588854917594121939988499223486918759869
+2316279872424397812389627435928425571522864993268981993135231281632931912219714272492398841364337743
+2611672912699479934143747711184533124498991233998359921827688713818629591848267212751251782193999574
+6912169338419564193119921496213581987492424159798957517399336988989137775762957929689971478512677295
+3932311559122894111729688681511182241159886994773792138139838569578133999317372937113824879568115791
+8589559297931592498862929729979441917281114429312571991515483885553657942311696693187113914917719999
+8215113889897867537369472795288394514311281463548681147471413974111467312128797923211571493578216618
+8353591188598582985969267941199579989219858339399879528759128156699712595424919231926423577793888319
+7968158785991328349741182178823359987435932199259784623665394822298984991599994974239363919518451979
+4719769796126416122596629937853975319746131691284132121869728172317997172141428897895794796191812167
+3715796581651751161784761598687561271125699522733481968514817818771137272533379148686393358399562697
+8962557499696333687128936247423429275688421766599283984442229598921259494162139235897485497997417698
+2182921896724715397151528121721594929388481339121986131936359796235664119251178868889159217485672977
+2828391155451888689511271529962927197658791494698163842856727412981821697293253119184773912119989595
+9199386341352517771926352819889757985144519361117599547314166929999995972716284565918358465675673988
+8722511734918316438427142154119225846521916542121666685543317729394927826333442319376948819282625186
+1477775698392989993392219356859976719258173183628158123159842811277192868899697572971451899974811444
+8335153624471899974521698617192979799279846783499194279818499779819993698148766775278931949849681136
+2269391966932443996719216591454851181957749968945583939554283869612267695171361752994867961193376666
+9861712325484181139982862631919269143595262461191729137191664394921995697291311623719788971894557112
+3112924177579979863258192877919454273941796893715949583554934558911631754244367342151872134159993285
+2979941956219158611766883428493219185525886883611119191938587953596273121943489333147616528786997189
+6911351423565397282381124199883475198396389555252699348494149975992869258195112131399297298977795897
+9119199355931828419162999986929799583691289619982317919828137147697551391791243988459169917431599811
+3848535265995589835498483569499111894179811797988524139731991816798915115719188982418358989615316197
+9986394864159675512549196699791852181845314977319988969899439522116944611392429241976152135959496687
+1761296827993117963817612129952997912232911828816999868511211229529681228381151777711719891779972859
+9849862226991147961391718387156998929941716949984572288291485879679697217224997668438772548619172679
+2896199355897526963449291963999361199143143424688187155899714182931423911884487471881515515658192867
+8882999928819749128875119614594191789229917398195439659381686259712273461799994165868781999354911927
+6293896891611311711917811764936777917992419746299291928141929236699957831472193155131929614221383779
+1728911221599715849995857841992339722725816297697995975879639548179113113959417185128498668951991497
+6389814779572888297744659943499321785461891927895956813219966863392927311261947592959791194244193985
+4712939391449918111131972657951783573919121925419474446716964951423691926889216751829199971929971132
+6699393113173611979749359993737683829563992223191989431431991486229753888571121391169999878623437521
+1198142461644317844741991158835235118423789877114199729435917618739231152683794599876297129118987729
+7111721965894267271711241998912592181993889216116948256156274679111482128896321191168811482813644926
+1171113376212775991947216339497719768861872218996599392728399271322997169438555172469628987211141167
+4971813199829153127388192731965829199759623126139328216651191296739154191919321549673351715616929225
+8119853972258311171879982114156481797449119753397856132264122489141398797971999829792199497347937184
+1561927699676538752366853298261467719967474391978893889187186993911227929965998393176697961138881969
+3959543274866211216958741199781999369818266285521119327231111949788966823231813299914822949693166178
+6854334615997742391438812963442348142383912111514912819499189236198343918618996193813217929982888331
+8591288815988159958617116297298498195754511127153431788392191923719497543218299627991945622899279289
+1198181911718723715273338822929941917461229991426187431333885549983141594522995949791148288364399931
+9892771631174419697317439985991838611951224884481231136571449581393892332789397968799983813949946771
+9691923978185936311116748722117898552719939491217617698689477616899284218259911527919573958121194566
+1843959822758422286269513881221514742239331123871961146817735961867178733293667759597321611856364687
+6977982858241122656318958728139689829747681724996991567112142583112379441312489192619155735979429668
+6864883774995893992121211469519696127454667681591441917467229798514197759483539991821689423396931376
+3192522673899612494271981219195459514965899598392186194369342687247433627873639189288865189581796451
+6193892956996137113415685193111676238918282975948726168585412815746185395326782967392782846445773697
+1188865911911546793619591679249496642955219194954776936299621427191849498935988721841952878212961283
+8694399699295137671549998897263823738366959893492139427998171551895683249779412599116969296375488479
+7877598934985997851215297123318237642987983729213129426654775659332934214699911779979746936272991192
+4175196464729659417156311852378196911437496911391319497971434617443518159949999724995188783613191262
+3762316191918893118954134928121247287121688294319514979584434758992189222213767189269961981712572193
+9981882951928288197367958981851556961646895153776691782279112427148955797179663174911297574899971912
+9895926311251443254199633719115569998677994839525436526347578387872641421492919519516711971912127392
+9723333996192974279158728199716934988493621698998331467858916957375227137984979938714344915111827182
+1489298994798826597544143761492942354121188712292616383251311951685245147566949991744458552776489586
+3211451591643914838596299339712994772187111828984686683882184719386899356485897381553187228879431569
+3259651629398171558779297578391789196514939231918933422179195617371647233469447869642991783645897982
+2189951822939529117192393161419994119171944662568828111311499919463717394995779991162414161719332911
+6899749988259797792429961362715358939636711635174199885892389153199229186421823334294179228734911269
+1895185897772972825953599619294129599869824625386123522999289881519328792475665963443599326534417127
+1422838395994495358964648891923798731481939992848921648929946289995168912914361941528948493335781149
+1317917384867191387219277529343126299981599689294419264273884458618911827925925837774616338553561629
+8982434966658784238385743322589831393888399172871716379119313128392163811311519839188471992219378467
+5395261691648469592639393691332481954629942491921281189152991281859952918822165534198758892953939121
+6329251216799321932117288219179141299519462991931239519193384798587198173781939892827679183111344218
+3812529999729156619987867616929265585873977681595939647814448735791934148324446952891313111995972677
+5282338992996313613159211993928283819929873988655191555399565229817638959377739269398838668781572226
+4378531984893973581486991728926841115919613871448996179956749642471991995965911222685526627192999981
+5982889739797551811388582535136873719759679761139313976924211474849296399512823999129477342278145322
+1218281999719267672993931254981112865424986972187191477949981863168351999531146991641381242421214511
+8911997846692872463596818916972951916181657731917916963182871214914196812971788959961183392597197251
+4915117978531879932257171943259639189397181298918962191166572986181981965998337591167599159129997195
+5161697792393852322887583417693725518643111468281969197221126116117739823199999132753611955461991483
+6748848121519929146139951181494977716178656879667787982537212682114283552983879198195439947113885979
+8162766788818429134853376715291665789982415877811787277133682815985779596453652213379733961271558178
+7126616955919123997999947924157132389218111416139312121275578993825788959911541852194817157964691211
+8145196921476116692616113197789995261996944598741116866263325522282139715958136659697393892119667448
+9763151993822121312993191662941511916997145299292999193935168979452131598797394513569918623184664781
+2292147194129589895647189423118915917258999813964921785795452817643488469847272158199168247483795532
+8559629983984149491384859997366788978721291219851118825772145961874767133913997798554453199924989818
+1182466299236599621536199516511164491992491155296741794213949818647429481999868811793169519371262165
+4738281697798982828461677528585949457922936232449965278919419114997399511378492966791946451772819131
+1757396912274429287116228948911154651917537842154149919872599997971951639199787486133851179929798555
+1719739825171841761948755899899216798392923289899987521533913487812899954886369899998971639512215499
+8791281434118421465514992618674529217949339778941898165388344994151819153515931268975815718393699133
+5931698111196917992731929569985187236913914645973813563987549997719875759193672475788621993978779973
+1884255199381966237561622788671247184371139285597612245451393421737133245891898958424829971676219425
+2583899597668762774732855241679313519878428388682177491132991946939823251369684298843866186992234148
+5571952912139441554944189828841898317272294283772779929696126131222992624995317231851888338393316119
+8975999266148778637445788139847923481453515261188263961114697957477262989851194731696756118191947696
+4382229563773717134612151111919923747618491994839882891451393414319819915995472618861242184413895712
+2111697733928869231956532219642919971371939921939182129518341429926954783299694818222137624318218193
+7918331918611351816139112921322828652131814891298482791235912154914156276127996537498197874799924122
+7836996594939159837193584991869184956399715111271353229592112889346822858939489744779468277719668577