Proper dijkstra in 18 (thanks @bertptrs)

1 files changed, 15 insertions, 21 deletions

diff --git a/2019/18.hs b/2019/18.hs
index c84f710..c758446 100644
--- a/2019/18.hs
+++ b/2019/18.hs
@@ -125,18 +125,18 @@ reachable (Implicit _ graph distarr) keys start = snd (go 0 (SIS.singleton start
                then (seen, result')
                else foldl (\(sn, rs) c -> go (dist + distarr A.! (at, c)) sn c rs) (seen', result') nextNonpearls
 
-searchBFS :: SmallIntSet -> Implicit -> (Int, [Int])
-searchBFS allKeys implicit@(Implicit nstart _ distarr) =
+searchBFS :: Implicit -> (Int, [Int])
+searchBFS implicit@(Implicit nstart _ _) =
     let startNodes = [52 + i | i <- [0..nstart-1]]
-    in go 0 (Set.singleton (heuristic startNodes SIS.empty, 0, startNodes, SIS.empty, [])) Map.empty
+    in go 0 (Set.singleton (0, startNodes, SIS.empty, [])) Map.empty
   where
     -- pqueue: f-val, distance, nodes, keys, key order
     -- visited: nodes, keys => distance
-    go :: Int -> Set (Int, Int, [Int], SmallIntSet, [Int]) -> Map ([Int], SmallIntSet) Int -> (Int, [Int])
+    go :: Int -> Set (Int, [Int], SmallIntSet, [Int]) -> Map ([Int], SmallIntSet) Int -> (Int, [Int])
     go ctr pqueue visited =
-        let ((heurval, dist, curnodes, keys, keyorder), newpqueue) = Set.deleteFindMin pqueue
+        let ((dist, curnodes, keys, keyorder), newpqueue) = Set.deleteFindMin pqueue
             reachLists = [reachable implicit keys node | node <- curnodes]
-            nextStates = [(dist + stepDist + heuristic stepNodes stepKeys, dist + stepDist, stepNodes, stepKeys, stepC : keyorder)
+            nextStates = [(dist + stepDist, stepNodes, stepKeys, stepC : keyorder)
                          | (robotIdx, reach) <- zip [0..] reachLists
                          , (stepC, stepDist) <- IntMap.assocs reach
                          , let stepKeys = SIS.insert stepC keys
@@ -146,23 +146,18 @@ searchBFS allKeys implicit@(Implicit nstart _ distarr) =
             visited' = Map.insert (curnodes, keys) dist visited
             pqueue' = newpqueue <> Set.fromList nextStates
             result = 
-               if all IntMap.null reachLists
-                   then if heurval == dist then (dist, keyorder) else error ("heurval - dist = " ++ show (heurval - dist) ++ " in terminal state!")
-                   else go (ctr + 1) pqueue' visited'
+                if maybe True (dist <) (Map.lookup (curnodes, keys) visited)
+                    then if all IntMap.null reachLists
+                        then (dist, keyorder)
+                        else go (ctr + 1) pqueue' visited'
+                    else go (ctr + 1) newpqueue visited
         in -- (if ctr `rem` 20000 == 0 || all IntMap.null reachLists
-           --      then trace ("go #pqueue=" ++ show (Set.size pqueue) ++ " #visited=" ++ show (Map.size visited)
-           --                  ++ "  curnodes=" ++ show curnodes ++ " dist=" ++ show dist ++ " heurval=" ++ show heurval ++ " keys=" ++ show keyorder
+           --      then trace ("go ctr=" ++ show ctr ++ " #pqueue=" ++ show (Set.size pqueue) ++ " #visited=" ++ show (Map.size visited)
+           --                  ++ "  curnodes=" ++ show curnodes ++ " dist=" ++ show dist ++ " keys=" ++ show keyorder
            --                  {- ++ "  next->" ++ show nextStates -})
            --      else id)
            result
 
-    heuristic :: [Int] -> SmallIntSet -> Int
-    heuristic _curnodes keys =
-        let remainKeys = allKeys SIS.\\ keys
-            allDists = [distarr A.! (x, y) | x:xs <- tails (SIS.toList remainKeys), y <- xs]
-            distLowerBound = sum (take (SIS.size remainKeys - 1) (sort (filter (/= -1) allDists)))
-        in distLowerBound
-
 main :: IO ()
 main = do
     stringbd <- getInput 18
@@ -170,8 +165,7 @@ main = do
         startpos = fromJust (lookup '@' (map (\(x,y) -> (y,x)) (Map.assocs bd)))
 
     let imgraph = implicitGraph bd [startpos]
-        allKeys = SIS.fromList [ord c - ord 'a' | c <- Map.elems bd, isLower c]
-    print (fst (searchBFS allKeys imgraph))
+    print (fst (searchBFS imgraph))
 
     let (sx, sy) = startpos
         bd2 = Map.unionWith (const id) bd
@@ -180,4 +174,4 @@ main = do
                                           ,((sx-1,sy+1), '3'), ((sx,sy+1), '#'), ((sx+1,sy+1), '4')])
         imgraph2 = implicitGraph bd2 [(sx-1,sy-1), (sx+1,sy-1), (sx-1,sy+1), (sx+1,sy+1)]
 
-    print (fst (searchBFS allKeys imgraph2))
+    print (fst (searchBFS imgraph2))