Done day 22

[advent-of-code-21.git] / advent15 / Main.hs

diff --git a/advent15/Main.hs b/advent15/Main.hs
index 1186a52df4892550c99578139d1a795ef8fd8ff1..40a152a188969791c03f5dbc986ccc495b8b984f 100644 (file)
--- 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 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
@@ -19,7 +16,6 @@ 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