--- 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
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.|>)
type CaveContext = Reader Cave
-
data Agendum s =
Agendum { _current :: s
, _trail :: Q.Seq s
+ , _trailCost :: Int
, _cost :: Int
} deriving (Show, Eq)
makeLenses ''Agendum
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
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
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 ()
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 =
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))
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