<commit_before>{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, TypeFamilies #-}
-- | Breadth first search algorithm.
module Game.LambdaHack.Client.Bfs
  ( BfsDistance, MoveLegal(..), minKnownBfs, apartBfs, maxBfsDistance, fillBfs
  , AndPath(..), actorsAvoidedDist, findPathBfs
  , accessBfs
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , abortedKnownBfs, abortedUnknownBfs
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Control.Monad.ST.Strict
import           Data.Binary
import           Data.Bits (Bits, complement, (.&.), (.|.))
import qualified Data.EnumMap.Strict as EM
import qualified Data.IntMap.Strict as IM
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as VM
import           GHC.Generics (Generic)

import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Vector
import           Game.LambdaHack.Core.Point
import qualified Game.LambdaHack.Core.PointArray as PointArray

-- | Weighted distance between points along shortest paths.
newtype BfsDistance = BfsDistance {bfsDistance :: Word8}
  deriving (Show, Eq, Ord, Enum, Bits)

instance PointArray.UnboxRepClass BfsDistance where
  type UnboxRep BfsDistance = Word8
  toUnboxRepUnsafe = bfsDistance
  fromUnboxRep = BfsDistance

-- | State of legality of moves between adjacent points.
data MoveLegal = MoveBlocked | MoveToOpen | MoveToClosed | MoveToUnknown
  deriving Eq

-- | The minimal distance value assigned to paths that don't enter
-- any unknown tiles.
minKnownBfs :: BfsDistance
minKnownBfs = BfsDistance $ toEnum $ (1 + fromEnum (maxBound :: Word8)) `div` 2

-- | The distance value that denotes no legal path between points,
-- either due to blocked tiles or pathfinding aborted at earlier tiles,
-- e.g., due to unknown tiles.
apartBfs :: BfsDistance
apartBfs = pred minKnownBfs

-- | Maximum value of the type.
maxBfsDistance :: BfsDistance
maxBfsDistance = BfsDistance (maxBound :: Word8)

-- | The distance value that denotes that path search was aborted
-- at this tile due to too large actual distance
-- and that the tile was known and not blocked.
-- It is also a true distance value for this tile
-- (shifted by minKnownBfs, as all distances of known tiles).
abortedKnownBfs :: BfsDistance
abortedKnownBfs = pred maxBfsDistance

-- | The distance value that denotes that path search was aborted
-- at this tile due to too large actual distance
-- and that the tile was unknown.
-- It is also a true distance value for this tile.
abortedUnknownBfs :: BfsDistance
abortedUnknownBfs = pred apartBfs

-- | Fill out the given BFS array (not all cells are overwritten,
-- so we assume the array is previously filled with @apartBfs@).
-- Unsafe @PointArray@ operations are OK here, because the intermediate
-- values of the vector don't leak anywhere outside nor are kept unevaluated
-- and so they can't be overwritten by the unsafe side-effect.
--
-- When computing move cost, we assume doors openable at no cost,
-- because other actors use them, too, so the cost is shared and the extra
-- visiblity is valuable, too. We treat unknown tiles specially.
-- Whether suspect tiles are considered openable depends on @smarkSuspect@.
fillBfs :: PointArray.Array Word8
        -> Word8
        -> Point                          -- ^ starting position
        -> PointArray.Array BfsDistance   -- ^ initial array, with @apartBfs@
        -> ()
{-# INLINE fillBfs #-}
fillBfs lalter alterSkill source arr@PointArray.Array{..} =
  let unsafeWriteI :: PointI -> BfsDistance -> ()
      {-# INLINE unsafeWriteI #-}
      unsafeWriteI p c = runST $ do
        vThawed <- U.unsafeThaw avector
        VM.unsafeWrite vThawed p (bfsDistance c)
        void $ U.unsafeFreeze vThawed
      bfs :: BfsDistance -> [PointI] -> ()  -- modifies the vector
      bfs !distance !predK =
        let processKnown :: PointI -> [PointI] -> [PointI]
            processKnown !pos !succK2 =
              -- Terrible hack trigger warning!
              -- Unsafe ops inside @fKnown@ seem to be OK, for no particularly
              -- clear reason. The array value given to each p depends on
              -- array value only at p (it's not overwritten if already there).
              -- So the only problem with the unsafe ops writing at p is
              -- if one with higher depth (dist) is evaluated earlier
              -- than another with lower depth. The particular pattern of
              -- laziness and order of list elements below somehow
              -- esures the lowest possible depth is always written first.
              -- The code also doesn't keep a wholly evaluated list of all p
              -- at a given depth, but generates them on demand, unlike a fully
              -- strict version inside the ST monad. So it uses little memory
              -- and is fast.
              let fKnown :: [PointI] -> VectorI -> [PointI]
                  fKnown !l !move =
                    let !p = pos + move
                        visitedMove =
                          BfsDistance (arr `PointArray.accessI` p) /= apartBfs
                    in if visitedMove
                       then l
                       else let alter :: Word8
                                !alter = lalter `PointArray.accessI` p
                            in if | alterSkill < alter -> l
                                  | alter == 1 ->
                                      let distCompl =
                                            distance .&. complement minKnownBfs
                                      in unsafeWriteI p distCompl
                                         `seq` l
                                  | otherwise -> unsafeWriteI p distance
                                                 `seq` p : l
              in foldl' fKnown succK2 movesI
            succK4 = foldr processKnown [] predK
        in if null succK4 || distance == abortedKnownBfs
           then () -- no more dungeon positions to check, or we delved too deep
           else bfs (succ distance) succK4
  in bfs (succ minKnownBfs) [fromEnum source]

data AndPath = AndPath
  { pathSource :: Point    -- never included in @pathList@
  , pathList   :: [Point]
  , pathGoal   :: Point    -- needn't be @last pathList@
  , pathLen    :: Int      -- needn't be @length pathList@
  }
  deriving (Show, Generic)

instance Binary AndPath

actorsAvoidedDist :: BfsDistance
actorsAvoidedDist = BfsDistance 5

-- | Find a path, without the source position, with the smallest length.
-- The @eps@ coefficient determines which direction (of the closest
-- directions available) that path should prefer, where 0 means north-west
-- and 1 means north. The path tries hard to avoid actors and tries to avoid
-- tiles that need altering and ambient light. Actors are avoided only close
-- to the start of the path, because elsewhere they are likely to move
-- before they are reached. Even projectiles are avoided,
-- which sometimes has the effect of choosing a safer route
-- (regardless if the projectiles are friendly fire or not).
--
-- An unwelcome side effect of avoiding actors is that friends will sometimes<commit_msg>Rewrite BFS to honestly run in ST<commit_after>{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, RankNTypes,
             TypeFamilies #-}
-- | Breadth first search algorithm.
module Game.LambdaHack.Client.Bfs
  ( BfsDistance, MoveLegal(..), minKnownBfs, apartBfs, maxBfsDistance, fillBfs
  , AndPath(..), actorsAvoidedDist, findPathBfs
  , accessBfs
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , abortedKnownBfs, abortedUnknownBfs
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Control.Monad.ST.Strict
import           Data.Binary
import           Data.Bits (Bits, complement, (.&.), (.|.))
import qualified Data.EnumMap.Strict as EM
import qualified Data.IntMap.Strict as IM
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as VM
import           GHC.Generics (Generic)

import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Vector
import           Game.LambdaHack.Core.Point
import qualified Game.LambdaHack.Core.PointArray as PointArray

-- | Weighted distance between points along shortest paths.
newtype BfsDistance = BfsDistance {bfsDistance :: Word8}
  deriving (Show, Eq, Ord, Enum, Bits)

instance PointArray.UnboxRepClass BfsDistance where
  type UnboxRep BfsDistance = Word8
  toUnboxRepUnsafe = bfsDistance
  fromUnboxRep = BfsDistance

-- | State of legality of moves between adjacent points.
data MoveLegal = MoveBlocked | MoveToOpen | MoveToClosed | MoveToUnknown
  deriving Eq

-- | The minimal distance value assigned to paths that don't enter
-- any unknown tiles.
minKnownBfs :: BfsDistance
minKnownBfs = BfsDistance $ toEnum $ (1 + fromEnum (maxBound :: Word8)) `div` 2

-- | The distance value that denotes no legal path between points,
-- either due to blocked tiles or pathfinding aborted at earlier tiles,
-- e.g., due to unknown tiles.
apartBfs :: BfsDistance
apartBfs = pred minKnownBfs

-- | Maximum value of the type.
maxBfsDistance :: BfsDistance
maxBfsDistance = BfsDistance (maxBound :: Word8)

-- | The distance value that denotes that path search was aborted
-- at this tile due to too large actual distance
-- and that the tile was known and not blocked.
-- It is also a true distance value for this tile
-- (shifted by minKnownBfs, as all distances of known tiles).
abortedKnownBfs :: BfsDistance
abortedKnownBfs = pred maxBfsDistance

-- | The distance value that denotes that path search was aborted
-- at this tile due to too large actual distance
-- and that the tile was unknown.
-- It is also a true distance value for this tile.
abortedUnknownBfs :: BfsDistance
abortedUnknownBfs = pred apartBfs

-- | Fill out the given BFS array (not all cells are overwritten,
-- so we assume the array is previously filled with @apartBfs@).
-- Unsafe @PointArray@ operations are OK here, because the intermediate
-- values of the vector don't leak anywhere outside nor are kept unevaluated
-- and so they can't be overwritten by the unsafe side-effect.
--
-- When computing move cost, we assume doors openable at no cost,
-- because other actors use them, too, so the cost is shared and the extra
-- visiblity is valuable, too. We treat unknown tiles specially.
-- Whether suspect tiles are considered openable depends on @smarkSuspect@.
fillBfs :: PointArray.Array Word8
        -> Word8
        -> Point                          -- ^ starting position
        -> PointArray.Array BfsDistance   -- ^ initial array, with @apartBfs@
        -> ()
{-# INLINE fillBfs #-}
fillBfs lalter alterSkill source PointArray.Array{..} =
  let fillBfsInST :: forall s. ST s ()
      fillBfsInST = do
        vThawed <- U.unsafeThaw avector
        let unsafeWriteI :: PointI -> BfsDistance -> ST s ()
            {-# INLINE unsafeWriteI #-}
            unsafeWriteI p c = VM.unsafeWrite vThawed p (bfsDistance c)
            bfs :: BfsDistance -> [PointI] -> ST s ()
            bfs !distance !predK = do
              let processKnown :: [PointI] -> PointI -> ST s [PointI]
                  processKnown !succK2 !pos  = do
                    let fKnown :: [PointI] -> VectorI -> ST s [PointI]
                        fKnown !l !move = do
                          let !p = pos + move
                          w <- VM.unsafeRead vThawed p
                          let visitedMove = BfsDistance w /= apartBfs
                          if visitedMove
                          then return l
                          else do
                            let alter :: Word8
                                !alter = lalter `PointArray.accessI` p
                            if | alterSkill < alter -> return l
                               | alter == 1 -> do
                                 let distCompl =
                                       distance .&. complement minKnownBfs
                                 unsafeWriteI p distCompl
                                 return l
                               | otherwise -> do
                                 unsafeWriteI p distance
                                 return $ p : l
                    foldM fKnown succK2 movesI
              succK4 <- foldM processKnown [] predK
              if null succK4 || distance == abortedKnownBfs
              then return () -- no more close enough dungeon positions
              else bfs (succ distance) succK4
        bfs (succ minKnownBfs) [fromEnum source]
        void $ U.unsafeFreeze vThawed
  in runST fillBfsInST

data AndPath = AndPath
  { pathSource :: Point    -- never included in @pathList@
  , pathList   :: [Point]
  , pathGoal   :: Point    -- needn't be @last pathList@
  , pathLen    :: Int      -- needn't be @length pathList@
  }
  deriving (Show, Generic)

instance Binary AndPath

actorsAvoidedDist :: BfsDistance
actorsAvoidedDist = BfsDistance 5

-- | Find a path, without the source position, with the smallest length.
-- The @eps@ coefficient determines which direction (of the closest
-- directions available) that path should prefer, where 0 means north-west
-- and 1 means north. The path tries hard to avoid actors and tries to avoid
-- tiles that need altering and ambient light. Actors are avoided only close
-- to the start of the path, because elsewhere they are likely to move
-- before they are reached. Even projectiles are avoided,
-- which sometimes has the effect of choosing a safer route
-- (regardless if the projectiles are friendly fire or not).
--
-- An unwelcome side effect of avoiding actors is that friends will sometimes
{'fraction_non_alphanumeric': 0.07299642674834099, 'fraction_numerical': 0.0026252461168234523, 'mean_word_length': 2.2474544162917356, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 33, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 1, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 20, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3386568', 'n_tokens_mistral': 3721, 'n_tokens_neox': 3579, 'n_words': 1483}