-- | Actor preferences for targets and actions, based on actor aspects.
module Game.LambdaHack.Client.Preferences
  ( totalUsefulness
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , effectToBenefit
  , averageTurnValue, avgItemDelay, avgItemLife, durabilityMult
  , organBenefit, recBenefit, fakeItem
  , aspectToBenefit, capStat, aspectRecordToBenefit
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM

import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Core.Dice as Dice
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Definition.Flavour

-- | How much AI benefits from applying the effect.
-- The first component is benefit when applied to self, the second
-- is benefit (preferably negative) when applied to enemy (via melee).
-- This represents benefit from using the effect every @avgItemDelay@ turns,
-- so if the item is not durable, the value is adjusted down elsewhere.
-- The benefit includes the drawback of having to use the actor's turn,
-- except when there is battle and item is a weapon and so there is usually
-- nothing better to do than to melee, or when the actor is stuck or idle
-- or laying in wait or luring an enemy from a safe distance.
-- So there is less than @averageTurnValue@ included in each benefit,
-- so in case when turn is not spent, e.g, periodic activation or conditions,
-- the difference in value is only slight.
effectToBenefit :: COps -> FactionId -> FactionDict -> IK.Effect
                -> (Double, Double)
effectToBenefit :: COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit cops :: COps
cops fid :: FactionId
fid factionD :: FactionDict
factionD eff :: Effect
eff =
  let delta :: b -> (b, b)
delta x :: b
x = (b
x, b
x)
  in case Effect
eff of
    IK.Burn d :: Dice
d -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (Double -> (Double, Double)) -> Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ -(Double -> Double -> Double
forall a. Ord a => a -> a -> a
min 1000 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ 10 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Dice -> Double
Dice.meanDice Dice
d)
    IK.Explode IK.S_SINGLE_SPARK -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (-1)  -- probing and flavour
    IK.Explode IK.S_SPARK -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (-9)  -- small, to not affect weapon order
    IK.Explode IK.S_FRAGRANCE -> (1, -5)  -- situational
    IK.Explode _ ->
      -- There is a risk the explosion is focused and harmful to self
      -- or not focused and beneficial to nearby foes, but not to self.
      -- It's too costly to analyze, so we assume applying an exploding
      -- item is a bad idea and it's better to project it at foes.
      -- Due to this assumption, healing explosives should be wrapped
      -- in @OnSmash@, or else they are counted as an incentive for throwing
      -- an item at foes, which in that case is counterproductive.
      Double -> (Double, Double)
forall b. b -> (b, b)
delta (-50)  -- not too low so that S_INK_SAC used by AI
    IK.RefillHP p :: Int
p ->
      Double -> (Double, Double)
forall b. b -> (b, b)
delta (Double -> (Double, Double)) -> Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
              then Double -> Double -> Double
forall a. Ord a => a -> a -> a
min 2000 (20 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
intToDouble Int
p)
              else Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (-1000) (10 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
intToDouble Int
p)
        -- one HP healed is worth a bit more than one HP dealt to enemy,
        -- because if the actor survives, he may deal damage many times;
        -- however, AI is mostly for non-heroes that fight in suicidal crowds,
        -- so the two values are kept close enough to maintain berserk approach
    IK.RefillCalm p :: Int
p ->
      ( if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
        then Double -> Double -> Double
forall a. Ord a => a -> a -> a
min 100 (Int -> Double
intToDouble Int
p)
          -- this may cause ice to be attractive to AI,
          -- but it doesn't trigger it due to no @ConsideredByAI@
        else if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= -5
             then Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (-100) (Int -> Double
intToDouble Int
p)
             else Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (-1500) (15 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
intToDouble Int
p)
          -- big Calm drains are incredibly dangerous, so don't be stupid
          -- and don't self-inflict them, particularly if you are an intelligent
          -- high-HP actor, which is likely if you collect and apply items
      , if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
        then Double -> Double -> Double
forall a. Ord a => a -> a -> a
min 100 (Int -> Double
intToDouble Int
p)
        else Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (-500) (5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
intToDouble Int
p) )
          -- quite a powerful weapon, especially against high-HP foes
    IK.Dominate -> (0, -100)  -- I obtained an actor with, say 10HP,
                              -- worth 200, and enemy lost him, another 100;
                              -- divided by 3, because impression needed first
    IK.Impress -> (0, -20)  -- this causes heroes to waste a crucial resource
                            -- but makes aliens more aggresive than defensive;
                            -- also, smart use is hardcoded in AI action choice
    IK.PutToSleep -> (-10, -50)  -- can affect friends, but more often enemies
    IK.Yell -> (-1, -2)  -- usually uncontrollably wakes up enemies, so bad
    IK.Summon grp :: GroupName ItemKind
grp d :: Dice
d ->  -- contrived by not checking if enemies also control
                        -- that group; safe for normal dungeon crawl content;
                        -- not correct for symmetric scenarios, but let it be
      let ben :: Double
ben = Dice -> Double
Dice.meanDice Dice
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* 200  -- the new actor can have, say, 10HP
          fact :: Faction
fact = FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid
          friendlyHasGrp :: FactionId -> Bool
friendlyHasGrp fid2 :: FactionId
fid2 =
            FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fid Faction
fact FactionId
fid2
            Bool -> Bool -> Bool
&& GroupName ItemKind
grp GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Player -> [GroupName ItemKind]
fgroups (Faction -> Player
gplayer (Faction -> Player) -> Faction -> Player
forall a b. (a -> b) -> a -> b
$ FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid2)
      in -- Prefer applying summoning items to flinging them; the actor gets
         -- spawned further from foes, but it's more robust.
         if (FactionId -> Bool) -> [FactionId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FactionId -> Bool
friendlyHasGrp ([FactionId] -> Bool) -> [FactionId] -> Bool
forall a b. (a -> b) -> a -> b
$ FactionDict -> [FactionId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys FactionDict
factionD
         then (Double
ben, -1)
         else (-Double
ben Double -> Double -> Double
forall a. Num a => a -> a -> a
* 3, 1)  -- the foe may spawn during battle and gang up
    IK.Ascend{} -> (0, 0)
      -- only change levels sensibly, in teams, and don't remove enemy too far,
      -- he may be easy to kill and may have essential loot
    IK.Escape{} -> (-9999, 9999)  -- even if can escape, loots first and then
                                  -- handles escape as a special case
    -- The following two are expensive, because they ofen activate
    -- while in melee, in which case each turn is worth x HP, where x
    -- is the average effective weapon damage in the game, which would
    -- be ~5. (Plus a huge risk factor for any non-spawner faction.)
    -- So, each turn in battle is worth ~100. And on average, in and out
    -- of battle, let's say each turn is worth ~10.
    IK.Paralyze d :: Dice
d -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (Double -> (Double, Double)) -> Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ -20 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Dice -> Double
Dice.meanDice Dice
d  -- clips
    IK.ParalyzeInWater d :: Dice
d -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (Double -> (Double, Double)) -> Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ -10 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Dice -> Double
Dice.meanDice Dice
d  -- clips; resistable
    IK.InsertMove d :: Dice
d -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (Double -> (Double, Double)) -> Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ 10 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Dice -> Double
Dice.meanDice Dice
d  -- turns
    IK.Teleport{} -> (-9, -1)  -- for self, don't derail exploration
                               -- for foes, fight with one less at a time
    IK.CreateItem _ COrgan IK.CONDITION _ ->
      (1, -1)  -- varied, big bunch, but try to create it anyway
    IK.CreateItem _ COrgan grp :: GroupName ItemKind
grp timer :: TimerDice
timer ->  -- assumed temporary
      let turnTimer :: Double
turnTimer = Double
-> (Dice -> Double) -> (Dice -> Double) -> TimerDice -> Double
forall a. a -> (Dice -> a) -> (Dice -> a) -> TimerDice -> a
IK.foldTimer 1 Dice -> Double
Dice.meanDice Dice -> Double
Dice.meanDice TimerDice
timer
            -- copy count used instead of timer for organs with many copies
          (total :: Double
total, count :: Int
count) = Double
-> GroupName ItemKind
-> COps
-> FactionId
-> FactionDict
-> (Double, Int)
organBenefit Double
turnTimer GroupName ItemKind
grp COps
cops FactionId
fid FactionDict
factionD
      in Double -> (Double, Double)
forall b. b -> (b, b)
delta (Double -> (Double, Double)) -> Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Double
total Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
intToDouble Int
count
           -- the same when created in me and in foe
           -- average over all matching grps; simplified: rarities ignored
    IK.CreateItem _ _ IK.TREASURE _ -> (100, 0)  -- assumed not temporary
    IK.CreateItem _ _ IK.COMMON_ITEM _ -> (70, 0)
    IK.CreateItem _ _ IK.CRAWL_ITEM _ -> (70, 0)
    IK.CreateItem _ _ IK.ANY_SCROLL _ -> (50, 0)
    IK.CreateItem _ _ IK.ANY_GLASS _ -> (75, 0)
    IK.CreateItem _ _ IK.ANY_POTION _ -> (100, 0)
    IK.CreateItem _ _ IK.ANY_FLASK _ -> (50, 0)
    IK.CreateItem _ _ IK.EXPLOSIVE _ -> (50, 0)
    IK.CreateItem _ _ IK.ANY_JEWELRY _ -> (100, 0)
    IK.CreateItem _ _ grp :: GroupName ItemKind
grp _ ->  -- assumed not temporary and @grp@ tiny
      let (total :: Double
total, count :: Int
count) = GroupName ItemKind
-> COps -> FactionId -> FactionDict -> (Double, Int)
recBenefit GroupName ItemKind
grp COps
cops FactionId
fid FactionDict
factionD
      in (Double
total Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
intToDouble Int
count, 0)
    IK.DestroyItem{} -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (-10)  -- potentially harmful
    IK.ConsumeItems{} -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (-10)  -- potentially harmful
    IK.DropItem _ _ COrgan IK.CONDITION ->
      (0, -1)  -- negative value necessary to collect such items;
               -- smart use on self is hardcoded in AI action choice
    IK.DropItem ngroup :: Int
ngroup kcopy :: Int
kcopy COrgan grp :: GroupName ItemKind
grp ->  -- assumed temporary
      -- Simplified: we assume actor has an average number of copies
      -- (and none have yet run out, e.g., prompt curing of poisoning)
      -- of a single kind of organ (and so @ngroup@ doesn't matter)
      -- of average benefit and that @kcopy@ is such that all copies
      -- are dropped. Separately we add bonuses for @ngroup@ and @kcopy@.
      -- Remaining time of the organ is arbitrarily assumed to be 20 turns.
      let turnTimer :: Double
turnTimer = 20
          (total :: Double
total, count :: Int
count) = Double
-> GroupName ItemKind
-> COps
-> FactionId
-> FactionDict
-> (Double, Int)
organBenefit Double
turnTimer GroupName ItemKind
grp COps
cops FactionId
fid FactionDict
factionD
          boundBonus :: a -> p
boundBonus n :: a
n = if a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
maxBound then 10 else 0
      in Double -> (Double, Double)
forall b. b -> (b, b)
delta (Double -> (Double, Double)) -> Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a p. (Eq a, Bounded a, Num p) => a -> p
boundBonus Int
ngroup Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a p. (Eq a, Bounded a, Num p) => a -> p
boundBonus Int
kcopy
                 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
total Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
intToDouble Int
count
                   -- the same when dropped from me and foe
    IK.DropItem{} -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (-10)  -- depends a lot on what is dropped
    IK.Recharge n :: Int
n d :: Dice
d -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (Double -> (Double, Double)) -> Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Int -> Double
intToDouble Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Dice -> Double
Dice.meanDice Dice
d Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 10
      -- this high value to price weapons with @OnUser@ over fists
    IK.Discharge n :: Int
n d :: Dice
d -> Double -> (Double, Double)
forall b. b -> (b, b)
delta (Double -> (Double, Double)) -> Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ - Int -> Double
intToDouble Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Dice -> Double
Dice.meanDice Dice
d Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 10
    IK.PolyItem -> (1, 0)  -- may fizzle, so AI never uses (could loop)
    IK.RerollItem -> (1, 0)  -- may fizzle, so AI never uses (could loop)
    IK.DupItem -> (1, 0)  -- may fizzle, so AI never uses (could loop)
    IK.Identify -> (1, 0)  -- may fizzle, so AI never uses (could loop)
    IK.Detect IK.DetectAll radius :: Int
radius -> (Int -> Double
intToDouble Int
radius Double -> Double -> Double
forall a. Num a => a -> a -> a
* 2, 0)
    IK.Detect IK.DetectLoot radius :: Int
radius -> (Int -> Double
intToDouble Int
radius Double -> Double -> Double
forall a. Num a => a -> a -> a
* 2, 0)
    IK.Detect IK.DetectExit radius :: Int
radius -> (Int -> Double
intToDouble Int
radius Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 2, 0)
    IK.Detect _ radius :: Int
radius -> (Int -> Double
intToDouble Int
radius, 0)
    IK.SendFlying _ -> (0, -1)   -- very context dependent, but lack of control
    IK.PullActor _ -> (0, -1)    -- is deadly on some maps, leading to harm;
    IK.PushActor _ -> (0, -100)  -- pushing others may crush them against wall
                                 -- and give us time to fling at them
    IK.ApplyPerfume -> Double -> (Double, Double)
forall b. b -> (b, b)
delta 0  -- depends on smell sense of friends and foes
    IK.AtMostOneOf effs :: [Effect]
effs ->
      let bs :: [(Double, Double)]
bs = (Effect -> (Double, Double)) -> [Effect] -> [(Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD) [Effect]
effs
          f :: (a, b) -> (a, b) -> (a, b)
f (self :: a
self, foe :: b
foe) (accSelf :: a
accSelf, accFoe :: b
accFoe) = (a
self a -> a -> a
forall a. Num a => a -> a -> a
+ a
accSelf, b
foe b -> b -> b
forall a. Num a => a -> a -> a
+ b
accFoe)
          (effSelf :: Double
effSelf, effFoe :: Double
effFoe) = ((Double, Double) -> (Double, Double) -> (Double, Double))
-> (Double, Double) -> [(Double, Double)] -> (Double, Double)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Double, Double) -> (Double, Double) -> (Double, Double)
forall a b. (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
f (0, 0) [(Double, Double)]
bs
      in (Double
effSelf Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
intToDouble ([(Double, Double)] -> Int
forall a. [a] -> Int
length [(Double, Double)]
bs), Double
effFoe Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
intToDouble ([(Double, Double)] -> Int
forall a. [a] -> Int
length [(Double, Double)]
bs))
    IK.OneOf effs :: [Effect]
effs ->
      let bs :: [(Double, Double)]
bs = (Effect -> (Double, Double)) -> [Effect] -> [(Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD) [Effect]
effs
          f :: (a, b) -> (a, b) -> (a, b)
f (self :: a
self, foe :: b
foe) (accSelf :: a
accSelf, accFoe :: b
accFoe) = (a
self a -> a -> a
forall a. Num a => a -> a -> a
+ a
accSelf, b
foe b -> b -> b
forall a. Num a => a -> a -> a
+ b
accFoe)
          (effSelf :: Double
effSelf, effFoe :: Double
effFoe) = ((Double, Double) -> (Double, Double) -> (Double, Double))
-> (Double, Double) -> [(Double, Double)] -> (Double, Double)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Double, Double) -> (Double, Double) -> (Double, Double)
forall a b. (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
f (0, 0) [(Double, Double)]
bs
      in (Double
effSelf Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
intToDouble ([(Double, Double)] -> Int
forall a. [a] -> Int
length [(Double, Double)]
bs), Double
effFoe Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
intToDouble ([(Double, Double)] -> Int
forall a. [a] -> Int
length [(Double, Double)]
bs))
    IK.OnSmash _ -> Double -> (Double, Double)
forall b. b -> (b, b)
delta 0
      -- can be beneficial; we'd need to analyze explosions, range, etc.
    IK.OnCombine eff1 :: Effect
eff1 -> COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD Effect
eff1
    IK.OnUser eff1 :: Effect
eff1 ->
      let (effSelf :: Double
effSelf, _) = COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD Effect
eff1
      in (Double
effSelf, - Double
effSelf)
           -- in both cases just applies the effect to itself,
           -- which is approximately equal to applying the opposite to foe;
           -- this may result in double-counting, but ensures that weapons
           -- that harm their wielders are properly discouted;
           -- in a way, this should be double-counted, because the effect
           -- not only hinders (or enhances) applying the item,
           -- but meleeing with it, too
    IK.NopEffect -> Double -> (Double, Double)
forall b. b -> (b, b)
delta 0
    IK.AndEffect eff1 :: Effect
eff1 _ -> COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD Effect
eff1
      -- for simplicity; so in content make sure to place initial animations
      -- among normal effects, not at the start of composite effect
      -- (animations should not fail, after all), and start composite
      -- effect with the main thing
    IK.OrEffect eff1 :: Effect
eff1 _ -> COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD Effect
eff1
    IK.SeqEffect effs :: [Effect]
effs -> COps -> FactionId -> FactionDict -> [Effect] -> (Double, Double)
effectToBenefits COps
cops FactionId
fid FactionDict
factionD [Effect]
effs
    IK.When _cond :: Condition
_cond eff1 :: Effect
eff1 ->
      -- Assuming the condition met most of the time. Really, too hard for AI.
      COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD Effect
eff1
    IK.Unless _cond :: Condition
_cond eff1 :: Effect
eff1 ->
      -- Assuming the condition *not* met most of the time.
      -- Really, too hard for AI.
      COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD Effect
eff1
    IK.IfThenElse _cond :: Condition
_cond eff1 :: Effect
eff1 _eff2 :: Effect
_eff2 ->
      -- Assuming the first is much more common. Really, too hard for AI.
      COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD Effect
eff1
    IK.VerbNoLonger{} -> Double -> (Double, Double)
forall b. b -> (b, b)
delta 0  -- flavour only, no benefit
    IK.VerbMsg{} -> Double -> (Double, Double)
forall b. b -> (b, b)
delta 0  -- flavour only, no benefit
    IK.VerbMsgFail{} -> Double -> (Double, Double)
forall b. b -> (b, b)
delta 0

effectToBenefits :: COps -> FactionId -> FactionDict -> [IK.Effect]
                 -> (Double, Double)
effectToBenefits :: COps -> FactionId -> FactionDict -> [Effect] -> (Double, Double)
effectToBenefits cops :: COps
cops fid :: FactionId
fid factionD :: FactionDict
factionD effs :: [Effect]
effs =
  let effPairs :: [(Double, Double)]
effPairs = (Effect -> (Double, Double)) -> [Effect] -> [(Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD) [Effect]
effs
      f :: (a, b) -> (a, b) -> (a, b)
f (self :: a
self, foe :: b
foe) (accSelf :: a
accSelf, accFoe :: b
accFoe) = (a
self a -> a -> a
forall a. Num a => a -> a -> a
+ a
accSelf, b
foe b -> b -> b
forall a. Num a => a -> a -> a
+ b
accFoe)
  in ((Double, Double) -> (Double, Double) -> (Double, Double))
-> (Double, Double) -> [(Double, Double)] -> (Double, Double)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Double, Double) -> (Double, Double) -> (Double, Double)
forall a b. (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
f (0, 0) [(Double, Double)]
effPairs

-- See the comment for @Paralyze@.
averageTurnValue :: Double
averageTurnValue :: Double
averageTurnValue = 10

-- Average delay between desired item uses. Some items are best activated
-- every turn, e.g., healing (but still, on average, the activation would be
-- useless some of the time, namely when HP is at max, which is rare,
-- or when some combat boost is already lasting, which is probably also rare).
-- However, e.g., for detection, activating every few turns is enough.
-- Also, sometimes actor has many activable items, so he doesn't want to use
-- the less powerful ones as often as when they are alone.
-- For weapons, it depends. Sometimes a weapon with disorienting effect
-- should be used once every couple of turns and stronger raw damage
-- weapons all the remaining time. In other cases a single weapon
-- with a devastating effect would ideally be available each turn.
-- We don't want to undervalue rarely used items with long timeouts
-- and we think that most interesting gameplay comes from alternating
-- item use, so we arbitrarily set the full value timeout to 3.
avgItemDelay :: Double
avgItemDelay :: Double
avgItemDelay = 3

-- The average time between consumable item being found
-- (and enough skill obtained to use it) and the item
-- not being worth using any more. We specifically ignore
-- item not being used any more, because it is not durable and is consumed.
-- However we do consider actor mortality (especially common for spawners)
-- and item contending with many other very different but valuable items
-- that all vie for the same turn needed to activate them (especially common
-- for non-spawners). Another reason is item getting obsolete or duplicated,
-- by finding a strictly better item or an identical item.
-- The @avgItemLife@ constant only makes sense for items with non-periodic
-- effects, because the effects' benefit is not cumulated
-- by just placing them in equipment and they cost a turn to activate.
-- We set the value to 30, assuming if the actor finds an item, then he is
-- most likely at an unlooted level, so he will find more loot soon,
-- or he is in a battle, so he will die soon (or win even more loot).
avgItemLife :: Double
avgItemLife :: Double
avgItemLife = 30

-- The value of durable item is this many times higher than non-durable,
-- because the item will on average be activated this many times
-- before it stops being used.
durabilityMult :: Double
durabilityMult :: Double
durabilityMult = Double
avgItemLife Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
avgItemDelay

-- We assume the organ is temporary (@Fragile@ and @Periodic@)
-- and also that it doesn't provide any functionality,
-- e.g., detection or raw damage. However, we take into account effects
-- knowing in some temporary organs, e.g., poison or regeneration,
-- they are triggered at each item copy destruction. They are applied to self,
-- hence we take the self component of valuation. We multiply by the count
-- of created/dropped organs, because for conditions it determines
-- how many times the effect is applied, before the last copy expires.
--
-- The temporary organs are not durable nor in infnite copies, so to give
-- continous benefit, organ has to be recreated each @turnTimer@ turns.
-- Creation takes a turn, so incurs @averageTurnValue@ cost.
-- That's how the lack of durability impacts their value, not via
-- @durabilityMult@, which however may be applied to organ creating item.
-- So, on average, maintaining the organ costs @averageTurnValue/turnTimer@.
-- So, if an item lasts @averageTurnValue@ and can be created at will, it's
-- almost as valuable as permanent. This makes sense even if the item creating
-- the organ is not durable, but the timer is huge. One may think the lack
-- of durability should be offset by the timer, but remember that average
-- item life @avgItemLife@ is rather low, so either a new item will be found
-- soon and so the long timer doesn't matter or the actor will die
-- or the gameplay context will change (e.g., out of battle) and so the effect
-- will no longer be useful.
--
-- When considering the effects, we just use their standard valuation,
-- despite them not using up actor's turn to be applied each turn,
-- because, similarly as for periodic items, we don't control when they
-- are applied and we can't stop/restart them.
--
-- We assume, only one of the timer and count mechanisms is present at once
-- (@count@ or @turnTimer@ is 1).
-- We assume no organ has effect that drops its group or creates its group;
-- otherwise we'd loop.
organBenefit :: Double -> GroupName ItemKind -> COps -> FactionId -> FactionDict
             -> (Double, Int)
organBenefit :: Double
-> GroupName ItemKind
-> COps
-> FactionId
-> FactionDict
-> (Double, Int)
organBenefit turnTimer :: Double
turnTimer grp :: GroupName ItemKind
grp cops :: COps
cops@COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} fid :: FactionId
fid factionD :: FactionDict
factionD =
  let f :: (Double, Int)
-> Int -> ContentId ItemKind -> ItemKind -> (Double, Int)
f (!Double
sacc, !Int
pacc) !Int
p _ !ItemKind
kind =
        let count :: Double
count = Dice -> Double
Dice.meanDice (ItemKind -> Dice
IK.icount ItemKind
kind)
            paspect :: Aspect -> Double
paspect asp :: Aspect
asp =
              Int -> Double
intToDouble Int
p
              Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
count Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
turnTimer
                -- the aspect stays for this many turns'
               Double -> Double -> Double
forall a. Num a => a -> a -> a
* Aspect -> Double
aspectToBenefit Aspect
asp
            peffect :: Effect -> Double
peffect eff :: Effect
eff =
              Int -> Double
intToDouble Int
p
              Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
count
                -- this many consecutive effects will be generated, if any
              Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double, Double) -> Double
forall a b. (a, b) -> a
fst (COps -> FactionId -> FactionDict -> Effect -> (Double, Double)
effectToBenefit COps
cops FactionId
fid FactionDict
factionD Effect
eff)
        in ( Double
sacc Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ([Double] -> Double
forall a. Num a => [a] -> a
sum ((Aspect -> Double) -> [Aspect] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Aspect -> Double
paspect ([Aspect] -> [Double]) -> [Aspect] -> [Double]
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Aspect]
IK.iaspects ItemKind
kind)
                     Double -> Double -> Double
forall a. Num a => a -> a -> a
+ [Double] -> Double
forall a. Num a => [a] -> a
sum ((Effect -> Double) -> [Effect] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Double
peffect ([Effect] -> [Double]) -> [Effect] -> [Double]
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects ItemKind
kind))
             Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
averageTurnValue  -- the cost of 1 turn spent acquiring the organ
                                 -- (or of inflexibility of periodic items)
           , Int
pacc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p )
  in ContentData ItemKind
-> GroupName ItemKind
-> ((Double, Int)
    -> Int -> ContentId ItemKind -> ItemKind -> (Double, Int))
-> (Double, Int)
-> (Double, Int)
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ItemKind
coitem GroupName ItemKind
grp (Double, Int)
-> Int -> ContentId ItemKind -> ItemKind -> (Double, Int)
f (0, 0)

-- We assume no item has effect that drops its group or creates its group;
-- otherwise we'd loop.
recBenefit :: GroupName ItemKind -> COps -> FactionId -> FactionDict
           -> (Double, Int)
recBenefit :: GroupName ItemKind
-> COps -> FactionId -> FactionDict -> (Double, Int)
recBenefit grp :: GroupName ItemKind
grp cops :: COps
cops@COps{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem, ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup} fid :: FactionId
fid factionD :: FactionDict
factionD =
  let f :: (Double, Int)
-> Int -> ContentId ItemKind -> ItemKind -> (Double, Int)
f (!Double
sacc, !Int
pacc) !Int
p !ContentId ItemKind
kindId !ItemKind
kind =
        let km :: KindMean
km = ContentId ItemKind -> ItemSpeedup -> KindMean
getKindMean ContentId ItemKind
kindId ItemSpeedup
coItemSpeedup
            recPickup :: Double
recPickup =
              Benefit -> Double
benPickup (Benefit -> Double) -> Benefit -> Double
forall a b. (a -> b) -> a -> b
$ COps -> FactionId -> FactionDict -> ItemFull -> Benefit
totalUsefulness COps
cops FactionId
fid FactionDict
factionD
                                          (ContentId ItemKind -> ItemKind -> KindMean -> ItemFull
fakeItem ContentId ItemKind
kindId ItemKind
kind KindMean
km)
        in ( Double
sacc Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dice -> Double
Dice.meanDice (ItemKind -> Dice
IK.icount ItemKind
kind) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
recPickup
           , Int
pacc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p )
  in ContentData ItemKind
-> GroupName ItemKind
-> ((Double, Int)
    -> Int -> ContentId ItemKind -> ItemKind -> (Double, Int))
-> (Double, Int)
-> (Double, Int)
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ItemKind
coitem GroupName ItemKind
grp (Double, Int)
-> Int -> ContentId ItemKind -> ItemKind -> (Double, Int)
f (0, 0)

fakeItem :: ContentId IK.ItemKind -> IK.ItemKind -> IA.KindMean -> ItemFull
fakeItem :: ContentId ItemKind -> ItemKind -> KindMean -> ItemFull
fakeItem kindId :: ContentId ItemKind
kindId kind :: ItemKind
kind km :: KindMean
km =
  let jkind :: ItemIdentity
jkind    = ContentId ItemKind -> ItemIdentity
IdentityObvious ContentId ItemKind
kindId
      jfid :: Maybe a
jfid     = Maybe a
forall a. Maybe a
Nothing  -- the default
      jflavour :: Flavour
jflavour = FancyName -> Color -> Flavour
Flavour (Int -> FancyName
forall a. Enum a => Int -> a
toEnum 0) (Int -> Color
forall a. Enum a => Int -> a
toEnum 0) -- dummy
      itemBase :: Item
itemBase = $WItem :: ItemIdentity -> Maybe FactionId -> Flavour -> Item
Item{..}
      itemDisco :: ItemDisco
itemDisco = KindMean -> ItemDisco
ItemDiscoMean KindMean
km
  in Item
-> ContentId ItemKind -> ItemKind -> ItemDisco -> Bool -> ItemFull
ItemFull Item
itemBase ContentId ItemKind
kindId ItemKind
kind ItemDisco
itemDisco Bool
True

-- The value of aspect bonus is supposed to be, roughly, the benefit
-- of having that bonus on actor for one turn (as if equipping didn't cost
-- any time). Comparing or adding this value later on to the benefit of one-time
-- applying the item makes sense, especially if the item is durable,
-- but even if not, as lont as I have many items relative to equipment slots.
-- If I have scarcity of items, the value should be higher, because if I apply
-- a non-durable item, it no longer benefits me, but if I wear it,
-- it can benefit me next turn also. The time cost of equipping balances this
-- to some extent, just as @durabilityMult@ and the equipment slot limit.
--
-- Value of aspects and effects is linked by some deep economic principles
-- which I'm unfortunately ignorant of. E.g., average weapon hits for 5HP,
-- so it's worth 50 per turn, so that should also be the worth per turn
-- of equpping a sword oil that doubles damage via @AddHurtMelee@.
-- Which almost matches up, since 100% effective oil is worth 100.
-- Perhaps oil is worth double (despite cap, etc.), because it's addictive
-- and raw weapon damage is not; so oil stays and old weapons get trashed.
-- However, using the weapon in combat costs 100 (the value of extra
-- battle turn). However, one turn per turn is almost free, because something
-- has to be done to move the time forward. If the oil required wasting a turn
-- to affect next strike, then we'd have two turns per turn, so the cost
-- would be real and 100% oil would not have any significant good or bad effect
-- any more, but 200% oil (if not for the cap) would still be worth it.
--
-- Anyway, that suggests that the current scaling of effect vs aspect values
-- is reasonable. What is even more important is consistency among aspects
-- so that, e.g., a shield or a torch is never equipped by AI, but oil lamp is.
-- Valuation of effects, and more precisely, more the signs than absolute
-- values, ensures that both shield and torch get auto-picked up so that
-- the human player can nevertheless equip them in very special cases.
aspectToBenefit :: IK.Aspect -> Double
aspectToBenefit :: Aspect -> Double
aspectToBenefit asp :: Aspect
asp =
  case Aspect
asp of
    IK.Timeout{} -> 0
    IK.AddSkill Ability.SkMove p :: Dice
p -> Double -> Double
capStat (Dice -> Double
Dice.meanDice Dice
p) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 5
    IK.AddSkill Ability.SkMelee p :: Dice
p -> Double -> Double
capStat (Dice -> Double
Dice.meanDice Dice
p) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 5
    IK.AddSkill Ability.SkDisplace p :: Dice
p -> Double -> Double
capStat (Dice -> Double
Dice.meanDice Dice
p)
    IK.AddSkill Ability.SkAlter p :: Dice
p -> Double -> Double
capStat (Dice -> Double
Dice.meanDice Dice
p)
    IK.AddSkill Ability.SkWait p :: Dice
p -> Double -> Double
capStat (Dice -> Double
Dice.meanDice Dice
p)
    IK.AddSkill Ability.SkMoveItem p :: Dice
p -> Double -> Double
capStat (Dice -> Double
Dice.meanDice Dice
p)
    IK.AddSkill Ability.SkProject p :: Dice
p -> Double -> Double
capStat (Dice -> Double
Dice.meanDice Dice
p) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 2
    IK.AddSkill Ability.SkApply p :: Dice
p -> Double -> Double
capStat (Dice -> Double
Dice.meanDice Dice
p) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 2
    IK.AddSkill Ability.SkSwimming p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p
    IK.AddSkill Ability.SkFlying p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p
    IK.AddSkill Ability.SkHurtMelee p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p  -- offence favoured
    IK.AddSkill Ability.SkArmorMelee p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 4
                                              -- only partial protection
    IK.AddSkill Ability.SkArmorRanged p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 4
    IK.AddSkill Ability.SkMaxHP p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p
    IK.AddSkill Ability.SkMaxCalm p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 5
    IK.AddSkill Ability.SkSpeed p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* 25
      -- 1 speed ~ 5% melee; times 5 for no caps, escape, pillar-dancing, etc.;
      -- OTOH, it's 1 extra turn each 20 turns, so 100/20, so 5; figures
    IK.AddSkill Ability.SkSight p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* 5
    IK.AddSkill Ability.SkSmell p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p
    IK.AddSkill Ability.SkShine p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* 2
    IK.AddSkill Ability.SkNocto p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* 30
                                       -- > sight + light; stealth, slots
    IK.AddSkill Ability.SkHearing p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p
    IK.AddSkill Ability.SkAggression _ -> 0  -- dunno
    IK.AddSkill Ability.SkOdor p :: Dice
p -> - Dice -> Double
Dice.meanDice Dice
p Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 4
      -- rarely, if big enough, determines if one is trackable
    IK.AddSkill Ability.SkDeflectRanged p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* 100
    IK.AddSkill Ability.SkDeflectMelee p :: Dice
p -> Dice -> Double
Dice.meanDice Dice
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* 100
    IK.SetFlag{} -> 0
      -- valuing @UnderRanged@ and @UnderMelee@ vs retaining the charge
      -- and explicit applying is too hard, hence ignored
    IK.ELabel{} -> 0
    IK.ToThrow{} -> 0  -- counted elsewhere
    IK.PresentAs{} -> 0
    IK.EqpSlot{} -> 0
    IK.Odds{} -> 0
      -- Should be already rolled; if not, can't tell easily.
      -- In particular, any timeouts there or @Periodic@ flags
      -- would be ignored, so they should be avoided under @Odds@
      -- in not fully-identified items, because they are so crucial
      -- for evaluation.

-- We simplify, assuming stats are unlikely to be higher than 10
-- and to be affected by more than one non-organ item at a time.
capStat :: Double -> Double
capStat :: Double -> Double
capStat x :: Double
x = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (-10) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
min 10 Double
x

aspectRecordToBenefit :: IA.AspectRecord -> [Double]
aspectRecordToBenefit :: AspectRecord -> [Double]
aspectRecordToBenefit arItem :: AspectRecord
arItem =
  (Aspect -> Double) -> [Aspect] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Aspect -> Double
aspectToBenefit ([Aspect] -> [Double]) -> [Aspect] -> [Double]
forall a b. (a -> b) -> a -> b
$ AspectRecord -> [Aspect]
IA.aspectRecordToList AspectRecord
arItem

-- | Compute the whole 'Benefit' structure, containing various facets
-- of AI item preference, for an item with the given effects and aspects.
totalUsefulness :: COps -> FactionId -> FactionDict -> ItemFull -> Benefit
totalUsefulness :: COps -> FactionId -> FactionDict -> ItemFull -> Benefit
totalUsefulness cops :: COps
cops fid :: FactionId
fid factionD :: FactionDict
factionD itemFull :: ItemFull
itemFull@ItemFull{ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind, Bool
itemSuspect :: ItemFull -> Bool
itemSuspect :: Bool
itemSuspect} =
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      -- If the item is periodic, we only add effects to equipment benefit,
      -- because we assume it's in equipment and then
      -- we can't effectively apply it, because it's never recharged,
      -- because it activates as soon as recharged.
      -- We ignore the rare case of a periodic item kept in stash
      -- to be applied manually. AI is too silly to choose it and we
      -- certainly don't want AI to destroy periodic items out of silliness.
      -- We don't assign a special bonus or malus due to being periodic,
      -- because periodic items are bad in that one can't
      -- activate them at will and they take equipment space,
      -- and good in that one saves a turn, not having
      -- to manually activate them. Additionally, no weapon can be periodic,
      -- because damage would be applied to the fighter, so a large class
      -- of items with timeout is excluded from the consideration.
      -- Generally, periodic seems more helpful on items with low timeout
      -- and obviously beneficial effects, e.g., frequent periodic healing
      -- or nearby detection is better, but infrequent periodic teleportation
      -- or harmful outward explosion is worse. But the rule is not strict
      -- and also dependent on gameplay context of the moment,
      -- hence no numerical value.
      periodic :: Bool
periodic = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem
      -- Timeout between 0 and 1 means item usable each turn, so we consider
      -- it equivalent to a permanent item --- one without timeout restriction.
      -- Timeout 2 means two such items are needed to use the effect each turn,
      -- so a single such item may be worth half of the permanent value.
      -- E.g., when item heals 1 HP each turn, that's precisly the calculation.
      timeout :: Double
timeout = Int -> Double
intToDouble (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ AspectRecord -> Int
IA.aTimeout AspectRecord
arItem
      scalePeriodic :: Double -> Double
scalePeriodic value :: Double
value = Double
value Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 1 Double
timeout
      -- With non-periodic items, when we need to expend a turn to apply the
      -- item or, e.g., we lose the opportunity to use another weapon if we hit
      -- with this one, the loss of value due to timeout is lower.
      -- Also, by the time cooldown recharges, one of combatants is often dead
      -- or fled, so some effects are no longer useful (but 1 HP gain is).
      -- To balance all that, we consider a square root of timeout
      -- and assume we need to spend turn on other actions at least every other
      -- turn (hence @max 2@). Note that this makes AI like powerful weapons
      -- with high timeout a bit more, though it still prefers low timeouts.
      timeoutSqrt :: Double
timeoutSqrt = Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 2 Double
timeout
      scaleTimeout :: Double -> Double
scaleTimeout v :: Double
v = Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
timeoutSqrt
      (effSelf :: Double
effSelf, effFoe :: Double
effFoe) =
        COps -> FactionId -> FactionDict -> [Effect] -> (Double, Double)
effectToBenefits COps
cops FactionId
fid FactionDict
factionD (ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind)
      -- Durability doesn't have any numerical impact on @eqpSum,
      -- because item is never consumed by just being stored in equipment.
      -- Also no numerical impact for flinging, because we can't fling it again
      -- in the same skirmish and also enemy can pick up and fling back.
      -- Only @benMeleeAvg@ and @benApply@ are affected, regardless if the item
      -- is in equipment or not. As summands of @benPickup@ they should be
      -- impacted by durability, because picking an item to be used
      -- only once is less advantageous than when the item is durable.
      -- For deciding which item to apply or melee with, they should be
      -- impacted, because it makes more sense to use an item that is durable
      -- and save the option for using non-durable item for the future, e.g.,
      -- when both items have timeouts, starting with durable is beneficial,
      -- because it recharges while the non-durable is prepared and used.
      durable :: Bool
durable = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem
      -- For applying, we add the self part only.
      benApply :: Double
benApply = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 0 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$  -- because optional; I don't need to apply
        if Bool
periodic
        then 0  -- because always in eqp and so never recharged
        else Double -> Double
scaleTimeout (Double
effSelf Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
effDice)
               -- hits self with kintetic dice too, when applying
             Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ if Bool
durable then 1 else Double
durabilityMult
      -- This assumes attacker hurt skill and enemy armor skill balance
      -- and so this value doesn't need to be recomputed at each equipment
      -- change and distributing weapons among AI actors doesn't need
      -- to match each weapon to each actor's equipment. However,
      -- a bad side-effect is that if an actor has terrible hurt skill,
      -- a weapon with high dice is still used by him before a burning weapon.
      -- Unless the opponent has even more terrible armor, unlikely,
      -- the chosen weapon is definitely not the best.
      effDice :: Double
effDice = - ItemKind -> Double
IK.damageUsefulness ItemKind
itemKind
      -- For melee, we add the foe part only.
      benMelee :: Double
benMelee = if Bool
periodic
                 then 0  -- because never recharged, so never ready for melee
                 else Double
effFoe Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
effDice  -- @AddHurtMelee@ already in @eqpSum@
      benMeleeAvg :: Double
benMeleeAvg = Double -> Double
scaleTimeout Double
benMelee
                    Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ if Bool
durable then 1 else Double
durabilityMult
      -- Experimenting is fun, but it's better to risk foes' skin than ours,
      -- so we only buff flinging, not applying, when item not identified.
      -- It's also more gameplay fun when enemies throw at us rather than
      -- when they use items on themselves.
      benFling :: Double
benFling = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
benFlingRaw (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ if Bool
itemSuspect then -10 else 0
      -- If periodic, we assume the item was in equipment, so effects
      -- were activated before flinging, so when projectile hits,
      -- it's discharged, so no kintetic damage value nor effect benefit
      -- is added to @benFling@.
      -- However, if item is not periodic, we assume the item was recharged,
      -- and so all the effects are activated at projectile impact,
      -- hence their full value is added to the kinetic damage value.
      benFlingRaw :: Double
benFlingRaw = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min 0 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$
        if Bool
periodic then 0 else Double
effFoe Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
benFlingDice
      benFlingDice :: Double
benFlingDice | ItemKind -> Dice
IK.idamage ItemKind
itemKind Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 0  -- speedup
                   | Bool
otherwise = Bool -> Double -> Double
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= 0) Double
v
       where
        -- We assume victim completely unbuffed and not blocking. If not,
        -- let's hope the actor is similarly buffed to compensate.
        hurtMult :: Int
hurtMult = Bool -> Skills -> Skills -> Int
armorHurtCalculation Bool
True (AspectRecord -> Skills
IA.aSkills AspectRecord
arItem)
                                             Skills
Ability.zeroSkills
        dmg :: Double
dmg = Dice -> Double
Dice.meanDice (Dice -> Double) -> Dice -> Double
forall a b. (a -> b) -> a -> b
$ ItemKind -> Dice
IK.idamage ItemKind
itemKind
        rawDeltaHP :: Int64
rawDeltaHP = Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int64) -> Double -> Int64
forall a b. (a -> b) -> a -> b
$ Int -> Double
intToDouble Int
hurtMult Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
xD Double
dmg Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 100
        -- For simplicity, we ignore range bonus/malus and @Lobable@.
        IK.ThrowMod{Int
throwVelocity :: ThrowMod -> Int
throwVelocity :: Int
IK.throwVelocity} = AspectRecord -> ThrowMod
IA.aToThrow AspectRecord
arItem
        speed :: Speed
speed = Int -> Int -> Speed
speedFromWeight (ItemKind -> Int
IK.iweight ItemKind
itemKind) Int
throwVelocity
        v :: Double
v = - Int64 -> Double
int64ToDouble (Int64 -> Speed -> Int64
modifyDamageBySpeed Int64
rawDeltaHP Speed
speed) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
xD 1
          -- 1 damage valued at 10, just as in @damageUsefulness@
      -- If item is periodic, we factor in the self value of effects,
      -- because they are applied to self, whether the actor wants it or not.
      -- We don't add a bonus of @averageTurnValue@ to the value of periodic
      -- effects, even though they save a turn, by being auto-applied,
      -- because on the flip side, player is not in control of the precise
      -- timing of their activation and also occasionally needs to spend a turn
      -- unequipping them to prevent activation. Note also that periodic
      -- activations don't consume the item, whether it's durable or not.
      aspectBenefits :: [Double]
aspectBenefits = AspectRecord -> [Double]
aspectRecordToBenefit AspectRecord
arItem
      eqpBens :: Double
eqpBens =
        [Double] -> Double
forall a. Num a => [a] -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ [Double]
aspectBenefits [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ [Double -> Double
scalePeriodic (Double
effSelf Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
effDice) | Bool
periodic]
      -- Equipped items may incur crippling maluses via aspects (but rather
      -- not via periodic effects). Examples of crippling maluses are zeroing
      -- melee or move skills. AI can't live with those and can't
      -- value those competently against any equally enormous bonuses
      -- the item might provide to compensate and so be even considered.
      cripplingDrawback :: Bool
cripplingDrawback = Bool -> Bool
not ([Double] -> Bool
forall a. [a] -> Bool
null [Double]
aspectBenefits)
                          Bool -> Bool -> Bool
&& [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
aspectBenefits Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< -25
      eqpSum :: Double
eqpSum = Double
eqpBens Double -> Double -> Double
forall a. Num a => a -> a -> a
- if Bool
cripplingDrawback then 100 else 0
      vApplyFling :: Double
vApplyFling = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
benApply (- Double
benFling)
      -- If a weapon heals enemy at impact, given choice, it won't be used
      -- for melee, but can be equipped anyway, for beneficial aspects.
      -- OTOH, cif it harms wearer too much, it won't be worn
      -- but still may be flung and so may be worth picking up.
      (benInEqp :: Bool
benInEqp, benPickupRaw :: Double
benPickupRaw)
        | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem
            -- the flag probably known even if item not identified
          Bool -> Bool -> Bool
&& (Double
benMelee Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Bool
itemSuspect)
          Bool -> Bool -> Bool
&& Double
eqpSum Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= -20 =
            let vEqp :: Double
vEqp = Double
eqpSum Double -> Double -> Double
forall a. Num a => a -> a -> a
+ [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double
benApply, - Double
benMeleeAvg, 0]
                      -- equip plus apply or melee or not
                v :: Double
v = if | Double
vEqp Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> Double
vEqp
                           -- pick up to equip; melee is crucial
                       | Double
vApplyFling Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> Double
vApplyFling
                           -- at least pick up to apply or fling, if feasible,
                           -- and equip just in case interesting effect;
                           -- will be taken off if very harmful
                       | Bool
otherwise -> Double
vEqp
                           -- do not pick up, but if forced, the best bet
                           -- is equip anyway
            in (Bool
True, Double
v)
        | (AspectRecord -> Bool
IA.goesIntoEqp AspectRecord
arItem
           Bool -> Bool -> Bool
|| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem)
                -- hack to record benefit, to use, e.g., to assign colour
          Bool -> Bool -> Bool
&& (Double
eqpSum Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
|| Bool
itemSuspect) =  -- weapon or other equippable
          ( Bool
True  -- equip; long time bonus usually outweighs fling or apply
          , Double
eqpSum  -- possibly spent turn equipping, so reap the benefits
            Double -> Double -> Double
forall a. Num a => a -> a -> a
+ if Bool
durable
              then Double
benApply  -- apply or not but don't fling
              else 0)  -- don't remove from equipment by using up
        | Bool
otherwise = (Bool
False, Double
vApplyFling)  -- apply or fling
      benPickupRaw2 :: Double
benPickupRaw2 = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
benPickupRaw (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ if Bool
itemSuspect then 10 else 0
      -- If periodic, pick up to deny to foes and sometimes to apply
      -- to activate the first effect only (easier than computing if the first
      -- effect is really beneficial, while all effects detrimental).
      benPickup :: Double
benPickup = if Bool
periodic then Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 1 Double
benPickupRaw2 else Double
benPickupRaw2
  in $WBenefit :: Bool -> Double -> Double -> Double -> Double -> Benefit
Benefit{..}