+instance SearchState Portal where
+
+ emptySearchState portal = portal
+
+ -- successors :: Portal -> MazeContext (Q.Seq (Portal, Edge))
+ successors portal =
+ do maze <- asks _maze
+ let edges = S.filter (edgeTouches portal) maze
+ let locations = S.map (\e -> (edgeOther portal e, e)) edges
+ let succs = S.foldr' (<|) Q.empty locations
+ return succs
+
+ -- estimateCost :: Portal -> MazeContext Int
+ estimateCost _portal = return 0
+
+ -- isGoal :: Portal -> MazeContext Bool
+ isGoal portal = return $ portal ^. label == "ZZ"
+
+instance SearchState LevelledSearchState where
+ emptySearchState portal = LevelledSearchState {_portalS = portal, _levelS = 0}
+
+ -- successors :: LevelledSearchState -> MazeContext (Q.Seq (LevelledSearchState, Edge))
+ successors ss =
+ do maze <- asks _maze
+ let lvl = ss ^. levelS
+ let portal = ss ^. portalS
+ let edges = S.filter (edgeTouches portal) maze
+ let lvlEdges = S.filter (edgeAtLevel portal lvl) edges
+ let locations = S.map (\e -> (newLSS portal lvl e, e)) lvlEdges
+ let locations' = S.filter (\(s, _) -> (s ^. levelS) >= 0) locations
+ let succs = S.foldr' (<|) Q.empty locations'
+ return succs
+
+ -- estimateCost :: Portal -> MazeContext Int
+ estimateCost ss = -- return 0
+ do let lvl = ss ^. levelS
+ cpl <- asks _costPerLevel
+ ctf <- asks _costToFinish
+ let cplT = if ss ^. portalS . location == Outer
+ then cpl * (lvl - 1) + 1
+ else cpl * lvl
+ if isTerminal (ss ^. portalS)
+ then return 0
+ else return (cplT + ctf)
+
+ -- isGoal :: LevelledSearchState -> MazeContext Bool
+ isGoal ss = return $ ss ^. portalS . label == "ZZ"
+
+edgeAtLevel portal lvl edge
+ -- | (lvl == 0) && (isTerminal other) && (et == Walk) = True
+ | (lvl /= 0) && (isTerminal other) && (et == Walk) = False
+ | (lvl == 0) && (not $ isTerminal other) && (et == Walk) && ((other ^. location) == Outer) = False
+ | otherwise = True
+ where other = edgeOther portal edge
+ et = edge ^. edgeType
+
+isTerminal p = (p ^. label == "AA") || (p ^. label == "ZZ")
+
+newLSS :: Portal -> Int -> Edge -> LevelledSearchState
+newLSS portal lvl edge
+ | et == Teleport && pl == Outer = LevelledSearchState { _portalS = otherPortal, _levelS = lvl - 1 }
+ | et == Teleport && pl == Inner = LevelledSearchState { _portalS = otherPortal, _levelS = lvl + 1 }
+ | otherwise = LevelledSearchState { _portalS = otherPortal, _levelS = lvl } -- et == Walk
+ where pl = portal ^. location
+ et = edge ^. edgeType
+ otherPortal = edgeOther portal edge