X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent18%2Fsrc%2Fadvent18direct.hs;h=346e61f268eedbb64f7c7d19d17d9d057e131389;hb=8e595f23837d5efb625ba2c0dacf470bdd5ccb06;hp=ac0c1da98b4bcda08c0824c57838755c8537b8ad;hpb=4a61ffa7679d3214f2fc32cef607279ca8835131;p=advent-of-code-19.git diff --git a/advent18/src/advent18direct.hs b/advent18/src/advent18direct.hs index ac0c1da..346e61f 100644 --- a/advent18/src/advent18direct.hs +++ b/advent18/src/advent18direct.hs @@ -23,7 +23,7 @@ type Keys = S.Set Char type PointOfInterest = M.Map Position Char -class (Eq e, Ord e) => ExplorerC e where +class (Eq e, Ord e, Show e) => Explorer e where successors :: e -> CaveContext (Q.Seq e) estimateCost :: e -> CaveContext Int -- positionE :: e -> Position @@ -52,7 +52,7 @@ data Agendum e = Agendum { _current :: e type Agenda e = P.MinPQueue Int (Agendum e) -- type Candidates e = S.Set (Int, Agendum e) -instance ExplorerC Explorer1 where +instance Explorer Explorer1 where successors explorer = do let here = _position1 explorer let locations0 = possibleNeighbours here @@ -84,7 +84,7 @@ instance ExplorerC Explorer1 where keysHeldE = _keysHeld1 emptyExplorer = Explorer1 { _position1 = (0, 0), _keysHeld1 = S.empty } -instance ExplorerC Explorer4 where +instance Explorer Explorer4 where successors explorer = do let rawHeres = _position4 explorer let heres = setToSeq $ allSplits rawHeres @@ -126,7 +126,7 @@ main = do print $ part1 cc explorer print $ part2 cc explorer -part1 :: ExplorerC e => CaveComplex -> e -> Int +part1 :: Explorer e => CaveComplex -> e -> Int part1 cave explorer = maybe 0 (( + 1) . _cost ) result where result = runReader (searchCave explorer) cave @@ -145,13 +145,13 @@ part2 caveComplex0 explorer1 = maybe 0 (( + 1) . _cost ) result explorer = Explorer4 {_position4 = [(re + 1, ce + 1), (re - 1, ce + 1), (re + 1, ce - 1), (re - 1, ce - 1)], _keysHeld4 = S.empty } result = runReader (searchCave explorer) caveComplex -keySeq :: ExplorerC e => (Agendum e) -> Q.Seq Keys +keySeq :: Explorer e => (Agendum e) -> Q.Seq Keys keySeq agendum = Q.filter (not . S.null) kdiff where keyss = fmap keysHeldE $ _trail agendum kdiff = fmap (uncurry S.difference) $ Q.zip ((keysHeldE $ _current agendum) <| keyss) keyss -searchCave :: ExplorerC e => e -> CaveContext (Maybe (Agendum e)) +searchCave :: Explorer e => e -> CaveContext (Maybe (Agendum e)) searchCave explorer = do agenda <- initAgenda explorer aStar agenda S.empty @@ -174,13 +174,13 @@ buildCaveCell r (cc, explorer) (c, char) here = (r, c) -initAgenda :: ExplorerC e => e -> CaveContext (Agenda e) +initAgenda :: Explorer e => e -> CaveContext (Agenda e) initAgenda explorer = do cost <- estimateCost explorer return $ P.singleton cost Agendum { _current = explorer, _trail = Q.empty, _cost = cost} -aStar :: ExplorerC e => Agenda e -> ExploredStates e -> CaveContext (Maybe (Agendum e)) +aStar :: Explorer e => Agenda e -> ExploredStates e -> CaveContext (Maybe (Agendum e)) -- aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0} aStar agenda closed -- | trace ("Peeping " ++ (show $ fst $ P.findMin agenda) ++ ": " ++ (show reached) ++ " <- " ++ (show $ toList $ Q.take 1 $ _trail $ currentAgendum) ++ " :: " ++ (show newAgenda)) False = undefined @@ -191,6 +191,7 @@ aStar agenda closed let reached = _current currentAgendum nexts <- candidates currentAgendum closed let newAgenda = foldl' (\q a -> P.insert (_cost a) a q) (P.deleteMin agenda) nexts + -- let newAgenda = trace ("nexts " ++ ( show nexts)) newAgenda0 reachedGoal <- isGoal reached if reachedGoal then return (Just currentAgendum) @@ -199,13 +200,14 @@ aStar agenda closed else aStar newAgenda (S.insert reached closed) -isGoal :: ExplorerC e => e -> CaveContext Bool +isGoal :: Explorer e => e -> CaveContext Bool isGoal explorer = do keys <- asks (S.fromList . M.elems . _keys) return $ keys == keysHeldE explorer -candidates :: ExplorerC e => Agendum e -> ExploredStates e -> CaveContext (Q.Seq (Agendum e)) +candidates :: Explorer e => Agendum e -> ExploredStates e -> CaveContext (Q.Seq (Agendum e)) +-- candidates a _ | trace ("Cand " ++ show (a)) False = undefined candidates agendum closed = do let candidate = _current agendum let previous = _trail agendum @@ -213,7 +215,8 @@ candidates agendum closed = let nonloops = Q.filter (\s -> not $ s `S.member` closed) succs mapM (makeAgendum candidate previous) nonloops -makeAgendum :: ExplorerC e => e -> (Q.Seq e) -> e -> CaveContext (Agendum e) +makeAgendum :: Explorer e => e -> (Q.Seq e) -> e -> CaveContext (Agendum e) +-- makeAgendum c _p n | trace ("Agendum " ++ (show c) ++ " " ++ (show n) ) False = undefined makeAgendum candidate previous new = do cost <- estimateCost new return Agendum { _current = new @@ -263,4 +266,4 @@ allSplits :: Ord a => S.Set a -> S.Set (a, S.Set a) allSplits xs = S.map (\x -> (x, S.delete x xs)) xs setToSeq :: Ord a => S.Set a -> Q.Seq a -setToSeq = S.foldl (|>) Q.empty +setToSeq xs = foldl' (|>) Q.empty $ S.toAscList xs