X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent15%2FMain.hs;h=e9242f90ac1b47908b0399d630ca2413afa37a1b;hb=1ab3e062eb1b3b28a8aead9834afc962ca142451;hp=1186a52df4892550c99578139d1a795ef8fd8ff1;hpb=ebd6d5f3f72d7fc7b5b0d7e17054373058cdf103;p=advent-of-code-21.git diff --git a/advent15/Main.hs b/advent15/Main.hs index 1186a52..e9242f9 100644 --- a/advent15/Main.hs +++ b/advent15/Main.hs @@ -1,12 +1,9 @@ --- Writeup at https://work.njae.me.uk/2021/12/13/advent-of-code-2021-day-13/ +-- Writeup at https://work.njae.me.uk/2021/12/16/advent-of-code-2021-day-15/ - -import Debug.Trace +-- import Debug.Trace -- import qualified Data.Text.IO as TIO --- import qualified Data.Map.Strict as M --- import Data.Map.Strict ((!)) import qualified Data.PQueue.Prio.Min as P import qualified Data.Set as S import qualified Data.Sequence as Q @@ -15,11 +12,10 @@ import Data.Foldable (foldl', sum) -- (toList, foldr', foldl', all) import Data.Char import Control.Monad.Reader import Control.Lens hiding ((<|), (|>), (:>), (:<)) -import Data.Maybe (fromMaybe) +-- import Data.Maybe (fromMaybe) import Linear (V2(..), (^+^), (^-^), (*^), (^*)) import Data.Array.IArray - pattern Empty <- (Q.viewl -> Q.EmptyL) where Empty = Q.empty pattern x :< xs <- (Q.viewl -> x Q.:< xs) where (:<) = (Q.<|) pattern xs :> x <- (Q.viewr -> xs Q.:> x) where (:>) = (Q.|>) @@ -39,10 +35,10 @@ makeLenses ''Cave type CaveContext = Reader Cave - data Agendum s = Agendum { _current :: s , _trail :: Q.Seq s + , _trailCost :: Int , _cost :: Int } deriving (Show, Eq) makeLenses ''Agendum @@ -53,9 +49,9 @@ type ExploredStates s = S.Set s class (Eq s, Ord s, Show s) => SearchState s where unwrapPos :: s -> BasePosition + emptySearchState :: s successors :: s -> CaveContext (Q.Seq s) estimateCost :: s -> CaveContext Int - emptySearchState :: s isGoal :: s -> CaveContext Bool entryCost :: s -> CaveContext Int @@ -67,37 +63,37 @@ instance SearchState Position where emptySearchState = Position (V2 0 0) -- successors :: Position -> CaveContext (Q.Seq Position) - successors here = + successors (Position here) = do grid <- asks _grid let neighbours = filter (inRange (bounds grid)) - [ (unwrapPos here) ^+^ delta + [ here ^+^ delta | delta <- [V2 -1 0, V2 1 0, V2 0 -1, V2 0 1] ] let succs = Q.fromList $ map Position neighbours return succs -- estimateCost :: Position -> CaveContext Int - estimateCost here = + estimateCost (Position here) = do goal <- asks _goal - let (V2 dr dc) = (unwrapPos here) ^-^ goal + let (V2 dr dc) = here ^-^ goal return $ (abs dr) + (abs dc) -- isGoal :: here -> CaveContext Bool - isGoal here = + isGoal (Position here) = do goal <- asks _goal - return $ (unwrapPos here) == goal + return $ here == goal - entryCost here = + entryCost (Position here) = do grid <- asks _grid - return $ grid ! (unwrapPos here) + return $ grid ! here instance SearchState TiledPosition where - emptySearchState = TiledPosition (V2 0 0) - unwrapPos (TiledPosition p) = p + emptySearchState = TiledPosition (V2 0 0) + -- successors :: Position -> CaveContext (Q.Seq Position) successors (TiledPosition here) = do grid <- asks _grid @@ -130,16 +126,13 @@ instance SearchState TiledPosition where let (tileR, gridR) = r `divMod` (maxR + 1) let (tileC, gridC) = c `divMod` (maxC + 1) let gridCost = grid ! (V2 gridR gridC) - let cost = (gridCost - 1 + tileR + tileC) `mod` 9 + 1 + let !cost = (gridCost - 1 + tileR + tileC) `mod` 9 + 1 return cost tileScale :: BasePosition -> BasePosition tileScale (V2 r c) = V2 (ts r) (ts c) where ts n = (n + 1) * 5 - 1 --- enTilePosition :: Position -> TiledPosition --- enTilePosition (V2 a b) = V2 a b - ------------------------------ main :: IO () @@ -160,20 +153,13 @@ mkCave text = Cave { _grid = grid, _goal = V2 r c } part1 :: Cave -> Int --- part1 :: Maze -> Maybe (Agendum Portal) part1 cave = maybe 0 _cost result where result = runReader searchCave cave :: Maybe (Agendum Position) part2 :: Cave -> Int --- part1 :: Maze -> Maybe (Agendum Portal) part2 cave = maybe 0 _cost result where result = runReader searchCave cave :: Maybe (Agendum TiledPosition) --- part2 :: Maze -> Int --- -- part2 :: Maze -> Maybe (Agendum LevelledSearchState) --- part2 maze = maybe 0 _cost result --- where result = runReader searchMaze maze :: Maybe (Agendum LevelledSearchState) - searchCave :: SearchState s => CaveContext (Maybe (Agendum s)) searchCave = @@ -184,7 +170,7 @@ initAgenda :: SearchState s => CaveContext (Agenda s) initAgenda = do let ss = emptySearchState c <- estimateCost ss - return $ P.singleton c Agendum { _current = ss, _trail = Q.empty, _cost = c} + return $ P.singleton c Agendum { _current = ss, _trail = Q.empty, _trailCost = 0, _cost = c} aStar :: SearchState s => Agenda s -> ExploredStates s -> CaveContext (Maybe (Agendum s)) @@ -209,21 +195,22 @@ candidates :: SearchState s => Agendum s -> ExploredStates s -> CaveContext (Q. candidates agendum closed = do let candidate = agendum ^. current let previous = agendum ^. trail - -- let prevCost = agendum ^. cost + let prevCost = agendum ^. trailCost succs <- successors candidate let nonloops = Q.filter (\s -> s `S.notMember` closed) succs - mapM (makeAgendum previous) nonloops + mapM (makeAgendum previous prevCost) nonloops + -makeAgendum :: SearchState s => (Q.Seq s) -> s -> CaveContext (Agendum s) -makeAgendum previous newPosition = +makeAgendum :: SearchState s => (Q.Seq s) -> Int -> s -> CaveContext (Agendum s) +makeAgendum previous prevCost newPosition = do predicted <- estimateCost newPosition grid <- asks _grid let newTrail = previous |> newPosition - let _ :< entered = newTrail - -- let incurred = foldr (+) 0 $ mapM entryCost entered - incurredQ <- mapM entryCost newTrail - let incurred = foldr (+) 0 incurredQ + newPositionCost <- entryCost newPosition + let incurred = prevCost + newPositionCost return Agendum { _current = newPosition , _trail = newTrail + , _trailCost = incurred , _cost = incurred + predicted } + \ No newline at end of file