<commit_before>{-# LANGUAGE DataKinds #-}
-- | Semantics of abilities in terms of actions and the AI procedure
-- for picking the best action for an actor.
module Game.LambdaHack.Client.AI.HandleAbilityClient
  ( actionStrategy
  ) where

import Control.Applicative
import Control.Arrow (second)
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Function
import Data.List
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Text (Text)

import Game.LambdaHack.Client.AI.ConditionClient
import Game.LambdaHack.Client.AI.Preferences
import Game.LambdaHack.Client.AI.Strategy
import Game.LambdaHack.Client.BfsClient
import Game.LambdaHack.Client.CommonClient
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.Ability
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Frequency
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemStrongest
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Request
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Content.TileKind as TK

type ToAny a = Strategy (RequestTimed a) -> Strategy RequestAnyAbility

toAny :: ToAny a
toAny strat = RequestAnyAbility <$> strat

-- | AI strategy based on actor's sight, smell, etc.
-- Never empty.
actionStrategy :: forall m. MonadClient m
               => ActorId -> m (Strategy RequestAnyAbility)
actionStrategy aid = do
  body <- getsState $ getActorBody aid
  activeItems <- activeItemsClient aid
  fact <- getsState $ (EM.! bfid body) . sfactionD
  condTgtEnemyPresent <- condTgtEnemyPresentM aid
  condTgtEnemyRemembered <- condTgtEnemyRememberedM aid
  condTgtEnemyAdjFriend <- condTgtEnemyAdjFriendM aid
  condAnyFoeAdj <- condAnyFoeAdjM aid
  threatDistL <- threatDistList aid
  condHpTooLow <- condHpTooLowM aid
  condOnTriggerable <- condOnTriggerableM aid
  condBlocksFriends <- condBlocksFriendsM aid
  condNoEqpWeapon <- condNoEqpWeaponM aid
  let condNoUsableWeapon = all (not . isMelee) activeItems
  condEnoughGear <- condEnoughGearM aid
  condFloorWeapon <- condFloorWeaponM aid
  condCanProject <- condCanProjectM False aid
  condNotCalmEnough <- condNotCalmEnoughM aid
  condDesirableFloorItem <- condDesirableFloorItemM aid
  condMeleeBad <- condMeleeBadM aid
  condTgtNonmoving <- condTgtNonmovingM aid
  aInAmbient <- getsState $ actorInAmbient body
  explored <- getsClient sexplored
  (fleeL, badVic) <- fleeList aid
  let lidExplored = ES.member (blid body) explored
      panicFleeL = fleeL ++ badVic
      actorShines = sumSlotNoFilter IK.EqpSlotAddLight activeItems > 0
      condThreatAdj = not $ null $ takeWhile ((== 1) . fst) threatDistL
      condThreatAtHand = not $ null $ takeWhile ((<= 2) . fst) threatDistL
      condThreatNearby = not $ null $ takeWhile ((<= 9) . fst) threatDistL
      speed1_5 = speedScale (3%2) (bspeed body activeItems)
      condFastThreatAdj = any (\(_, (_, b)) -> bspeed b activeItems > speed1_5)
                          $ takeWhile ((== 1) . fst) threatDistL
      heavilyDistressed =  -- actor hit by a proj or similarly distressed
        deltaSerious (bcalmDelta body)
  actorMaxSk <- maxActorSkillsClient aid
  let abInMaxSkill ab = EM.findWithDefault 0 ab actorMaxSk > 0
      stratToFreq :: MonadStateRead m
                  => Int -> m (Strategy RequestAnyAbility)
                  -> m (Frequency RequestAnyAbility)
      stratToFreq scale mstrat = do
        st <- mstrat
        return $! if scale == 0
                  then mzero
                  else scaleFreq scale $ bestVariant st  -- TODO: flatten instead?
      -- Order matters within the list, because it's summed with .| after
      -- filtering. Also, the results of prefix, distant and suffix
      -- are summed with .| at the end.
      prefix, suffix :: [([Ability], m (Strategy RequestAnyAbility), Bool)]
      prefix =
        [ ( [AbApply], (toAny :: ToAny AbApply)
            <$> applyItem aid ApplyFirstAid
          , condHpTooLow && not condAnyFoeAdj
            && not condOnTriggerable )  -- don't block stairs, perhaps ascend
        , ( [AbTrigger], (toAny :: ToAny AbTrigger)
            <$> trigger aid True
              -- flee via stairs, even if to wrong level
              -- may return via different stairs
          , condOnTriggerable
            && ((condNotCalmEnough || condHpTooLow)
                && condThreatNearby && not condTgtEnemyPresent
                || condMeleeBad && condThreatAdj) )
        , ( [AbDisplace]
          , displaceFoe aid  -- only swap with an enemy to expose him
          , condBlocksFriends && condAnyFoeAdj
            && not condOnTriggerable && not condDesirableFloorItem )
        , ( [AbMoveItem], (toAny :: ToAny AbMoveItem)
            <$> pickup aid True
          , condNoEqpWeapon && condFloorWeapon && not condHpTooLow
            && abInMaxSkill AbMelee )
        , ( [AbMelee], (toAny :: ToAny AbMelee)
            <$> meleeBlocker aid  -- only melee target or blocker
          , condAnyFoeAdj
            || not (abInMaxSkill AbDisplace)  -- melee friends, not displace
               && fleaderMode (gplayer fact) == LeaderNull  -- not restrained
               && condTgtEnemyPresent )  -- excited
        , ( [AbTrigger], (toAny :: ToAny AbTrigger)
            <$> trigger aid False
          , condOnTriggerable && not condDesirableFloorItem
            && (lidExplored || condEnoughGear)
            && not condTgtEnemyPresent )
        , ( [AbMove]
          , flee aid fleeL
          , condMeleeBad && not condFastThreatAdj
            -- Don't keep fleeing if was just hit, unless can't melee at all.
            && not (heavilyDistressed
                    && abInMaxSkill AbMelee
                    && not condNoUsableWeapon)
            && condThreatAtHand )
        , ( [AbDisplace]  -- prevents some looping movement
          , displaceBlocker aid  -- fires up only when path blocked
          , not condDesirableFloorItem )
        , ( [AbMoveItem], (toAny :: ToAny AbMoveItem)
            <$> equipItems aid  -- doesn't take long, very useful if safe
                                -- only if calm enough, so high priority
          , not condAnyFoeAdj && not condDesirableFloorItem )
        ]
      -- Order doesn't matter, scaling does.
      distant :: [([Ability], m (Frequency RequestAnyAbility), Bool)]
      distant =
        [ ( [AbProject]  -- for high-value target, shoot even in melee
          , stratToFreq 2 $ (toAny :: ToAny AbProject)
            <$> projectItem aid
          , condTgtEnemyPresent && condCanProject && not condOnTriggerable )
        , ( [AbApply]
          , stratToFreq 2 $ (toAny :: ToAny AbApply)
            <$> applyItem aid ApplyAll  -- use any potion or scroll
          , (condTgtEnemyPresent || condThreatNearby)  -- can affect enemies
            && not condOnTriggerable )
        , ( [AbMove]
          , stratToFreq (if not condTgtEnemyPresent
                         then 3  -- if enemy only remembered, investigate anyway
                         else if condTgtNonmoving
                         then 0
                         else if condTgtEnemyAdjFriend
                         then 1000  -- friends probably pummeled, go to help
                         else 100)
            $ chase aid True (condMeleeBad && condThreatNearby
                              && not aInAmbient && not actorShines)
          , (condTgtEnemyPresent || condTgtEnemyRemembered)
            && not (condDesirableFloorItem && not condThreatAtHand)
            && abInMaxSkill AbMelee
            && not condNoUsableWeapon )
        ]
      -- Order matters again.
      suffix =
        [ ( [AbMoveItem], (toAny :: ToAny AbMoveItem)
            <$> pickup aid False
          , not condThreatAtHand )  -- e.g., to give to other party members
        , ( [AbMelee], (toAny :: ToAny AbMelee)
            <$> meleeAny aid  -- avoid getting damaged for naught
          , condAnyFoeAdj )
        , ( [AbMove]
          , flee aid panicFleeL  -- ultimate panic mode, displaces foes
          , condAnyFoeAdj )
        , ( [AbMoveItem], (toAny :: ToAny AbMoveItem)
            <$> unEquipItems aid  -- late, because better to throw than unequip
          , True )
        , ( [AbMove]
          , chase aid True (condTgtEnemyPresent
                            -- Don't keep hiding in darkness if hit right now,
                            -- unless can't melee at all.
                            && not (heavilyDistressed
                                    && abInMaxSkill AbMelee
                                    && not condNoUsableWeapon)
                            && condMeleeBad && condThreatNearby
                            && not aInAmbient && not actorShines)
          , True )
        ]
      fallback =
        [ ( [AbWait], (toAny :: ToAny AbWait)<commit_msg>Don't close up with immobile enemies, unless on path to other targets<commit_after>{-# LANGUAGE DataKinds #-}
-- | Semantics of abilities in terms of actions and the AI procedure
-- for picking the best action for an actor.
module Game.LambdaHack.Client.AI.HandleAbilityClient
  ( actionStrategy
  ) where

import Control.Applicative
import Control.Arrow (second)
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Function
import Data.List
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Text (Text)

import Game.LambdaHack.Client.AI.ConditionClient
import Game.LambdaHack.Client.AI.Preferences
import Game.LambdaHack.Client.AI.Strategy
import Game.LambdaHack.Client.BfsClient
import Game.LambdaHack.Client.CommonClient
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.Ability
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Frequency
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemStrongest
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Request
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Content.TileKind as TK

type ToAny a = Strategy (RequestTimed a) -> Strategy RequestAnyAbility

toAny :: ToAny a
toAny strat = RequestAnyAbility <$> strat

-- | AI strategy based on actor's sight, smell, etc.
-- Never empty.
actionStrategy :: forall m. MonadClient m
               => ActorId -> m (Strategy RequestAnyAbility)
actionStrategy aid = do
  body <- getsState $ getActorBody aid
  activeItems <- activeItemsClient aid
  fact <- getsState $ (EM.! bfid body) . sfactionD
  condTgtEnemyPresent <- condTgtEnemyPresentM aid
  condTgtEnemyRemembered <- condTgtEnemyRememberedM aid
  condTgtEnemyAdjFriend <- condTgtEnemyAdjFriendM aid
  condAnyFoeAdj <- condAnyFoeAdjM aid
  threatDistL <- threatDistList aid
  condHpTooLow <- condHpTooLowM aid
  condOnTriggerable <- condOnTriggerableM aid
  condBlocksFriends <- condBlocksFriendsM aid
  condNoEqpWeapon <- condNoEqpWeaponM aid
  let condNoUsableWeapon = all (not . isMelee) activeItems
  condEnoughGear <- condEnoughGearM aid
  condFloorWeapon <- condFloorWeaponM aid
  condCanProject <- condCanProjectM False aid
  condNotCalmEnough <- condNotCalmEnoughM aid
  condDesirableFloorItem <- condDesirableFloorItemM aid
  condMeleeBad <- condMeleeBadM aid
  condTgtNonmoving <- condTgtNonmovingM aid
  aInAmbient <- getsState $ actorInAmbient body
  explored <- getsClient sexplored
  (fleeL, badVic) <- fleeList aid
  let lidExplored = ES.member (blid body) explored
      panicFleeL = fleeL ++ badVic
      actorShines = sumSlotNoFilter IK.EqpSlotAddLight activeItems > 0
      condThreatAdj = not $ null $ takeWhile ((== 1) . fst) threatDistL
      condThreatAtHand = not $ null $ takeWhile ((<= 2) . fst) threatDistL
      condThreatNearby = not $ null $ takeWhile ((<= 9) . fst) threatDistL
      speed1_5 = speedScale (3%2) (bspeed body activeItems)
      condFastThreatAdj = any (\(_, (_, b)) -> bspeed b activeItems > speed1_5)
                          $ takeWhile ((== 1) . fst) threatDistL
      heavilyDistressed =  -- actor hit by a proj or similarly distressed
        deltaSerious (bcalmDelta body)
  actorMaxSk <- maxActorSkillsClient aid
  let abInMaxSkill ab = EM.findWithDefault 0 ab actorMaxSk > 0
      stratToFreq :: MonadStateRead m
                  => Int -> m (Strategy RequestAnyAbility)
                  -> m (Frequency RequestAnyAbility)
      stratToFreq scale mstrat = do
        st <- mstrat
        return $! if scale == 0
                  then mzero
                  else scaleFreq scale $ bestVariant st  -- TODO: flatten instead?
      -- Order matters within the list, because it's summed with .| after
      -- filtering. Also, the results of prefix, distant and suffix
      -- are summed with .| at the end.
      prefix, suffix :: [([Ability], m (Strategy RequestAnyAbility), Bool)]
      prefix =
        [ ( [AbApply], (toAny :: ToAny AbApply)
            <$> applyItem aid ApplyFirstAid
          , condHpTooLow && not condAnyFoeAdj
            && not condOnTriggerable )  -- don't block stairs, perhaps ascend
        , ( [AbTrigger], (toAny :: ToAny AbTrigger)
            <$> trigger aid True
              -- flee via stairs, even if to wrong level
              -- may return via different stairs
          , condOnTriggerable
            && ((condNotCalmEnough || condHpTooLow)
                && condThreatNearby && not condTgtEnemyPresent
                || condMeleeBad && condThreatAdj) )
        , ( [AbDisplace]
          , displaceFoe aid  -- only swap with an enemy to expose him
          , condBlocksFriends && condAnyFoeAdj
            && not condOnTriggerable && not condDesirableFloorItem )
        , ( [AbMoveItem], (toAny :: ToAny AbMoveItem)
            <$> pickup aid True
          , condNoEqpWeapon && condFloorWeapon && not condHpTooLow
            && abInMaxSkill AbMelee )
        , ( [AbMelee], (toAny :: ToAny AbMelee)
            <$> meleeBlocker aid  -- only melee target or blocker
          , condAnyFoeAdj
            || not (abInMaxSkill AbDisplace)  -- melee friends, not displace
               && fleaderMode (gplayer fact) == LeaderNull  -- not restrained
               && condTgtEnemyPresent )  -- excited
        , ( [AbTrigger], (toAny :: ToAny AbTrigger)
            <$> trigger aid False
          , condOnTriggerable && not condDesirableFloorItem
            && (lidExplored || condEnoughGear)
            && not condTgtEnemyPresent )
        , ( [AbMove]
          , flee aid fleeL
          , condMeleeBad && not condFastThreatAdj
            -- Don't keep fleeing if was just hit, unless can't melee at all.
            && not (heavilyDistressed
                    && abInMaxSkill AbMelee
                    && not condNoUsableWeapon)
            && condThreatAtHand )
        , ( [AbDisplace]  -- prevents some looping movement
          , displaceBlocker aid  -- fires up only when path blocked
          , not condDesirableFloorItem )
        , ( [AbMoveItem], (toAny :: ToAny AbMoveItem)
            <$> equipItems aid  -- doesn't take long, very useful if safe
                                -- only if calm enough, so high priority
          , not condAnyFoeAdj && not condDesirableFloorItem )
        ]
      -- Order doesn't matter, scaling does.
      distant :: [([Ability], m (Frequency RequestAnyAbility), Bool)]
      distant =
        [ ( [AbProject]  -- for high-value target, shoot even in melee
          , stratToFreq 2 $ (toAny :: ToAny AbProject)
            <$> projectItem aid
          , condTgtEnemyPresent && condCanProject && not condOnTriggerable )
        , ( [AbApply]
          , stratToFreq 2 $ (toAny :: ToAny AbApply)
            <$> applyItem aid ApplyAll  -- use any potion or scroll
          , (condTgtEnemyPresent || condThreatNearby)  -- can affect enemies
            && not condOnTriggerable )
        , ( [AbMove]
          , stratToFreq (if not condTgtEnemyPresent
                         then 3  -- if enemy only remembered, investigate anyway
                         else if condTgtNonmoving
                         then 0
                         else if condTgtEnemyAdjFriend
                         then 1000  -- friends probably pummeled, go to help
                         else 100)
            $ chase aid True (condMeleeBad && condThreatNearby
                              && not aInAmbient && not actorShines)
          , (condTgtEnemyPresent || condTgtEnemyRemembered)
            && not (condDesirableFloorItem && not condThreatAtHand)
            && abInMaxSkill AbMelee
            && not condNoUsableWeapon )
        ]
      -- Order matters again.
      suffix =
        [ ( [AbMoveItem], (toAny :: ToAny AbMoveItem)
            <$> pickup aid False
          , not condThreatAtHand )  -- e.g., to give to other party members
        , ( [AbMelee], (toAny :: ToAny AbMelee)
            <$> meleeAny aid  -- avoid getting damaged for naught
          , condAnyFoeAdj )
        , ( [AbMove]
          , flee aid panicFleeL  -- ultimate panic mode, displaces foes
          , condAnyFoeAdj )
        , ( [AbMoveItem], (toAny :: ToAny AbMoveItem)
            <$> unEquipItems aid  -- late, because better to throw than unequip
          , True )
        , ( [AbMove]
          , chase aid True (condTgtEnemyPresent
                            -- Don't keep hiding in darkness if hit right now,
                            -- unless can't melee at all.
                            && not (heavilyDistressed
                                    && abInMaxSkill AbMelee
                                    && not condNoUsableWeapon)
                            && condMeleeBad && condThreatNearby
                            && not aInAmbient && not actorShines)
          , not (condTgtNonmoving && condThreatAtHand) )
            -- TODO: unless tgt can't melee
        ]
      fallback =
        [ ( [AbWait], (toAny :: ToAny AbWait)
{'fraction_non_alphanumeric': 0.08156657963446476, 'fraction_numerical': 0.0026109660574412533, 'mean_word_length': 2.2775971247646756, 'pattern_counts': {'":': 0, '<': 79, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 12, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1078044', 'n_tokens_mistral': 5713, 'n_tokens_neox': 5474, 'n_words': 1539}