diff options
Diffstat (limited to '2019')
| -rw-r--r-- | 2019/18.hs | 36 |
1 files changed, 15 insertions, 21 deletions
@@ -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)) |