{-# LANGUAGE DeriveTraversable, TupleSections #-}
-- | AI strategies to direct actors not controlled directly by human players.
-- No operation in this module involves the @State@ type or any of our
-- client/server monads types.
module Game.LambdaHack.Client.AI.Strategy
  ( Strategy, nullStrategy, liftFrequency
  , (.|), reject, (.=>), only, bestVariant, returN, mapStrategyM
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Control.Applicative

import Game.LambdaHack.Core.Frequency

-- | A strategy is a choice of (non-empty) frequency tables
-- of possible actions.
--
-- Currently, the way we use it, the list could have at most one element
-- (we filter out void frequencies early and only ever access the first).
-- except for the argument of @mapStrategyM@, which may even be process
-- to the end of the list, if no earlier strategies can be transformed
-- into non-null ones.
newtype Strategy a = Strategy { forall a. Strategy a -> [Frequency a]
runStrategy :: [Frequency a] }
  deriving (Int -> Strategy a -> ShowS
[Strategy a] -> ShowS
Strategy a -> String
(Int -> Strategy a -> ShowS)
-> (Strategy a -> String)
-> ([Strategy a] -> ShowS)
-> Show (Strategy a)
forall a. Show a => Int -> Strategy a -> ShowS
forall a. Show a => [Strategy a] -> ShowS
forall a. Show a => Strategy a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Strategy a -> ShowS
showsPrec :: Int -> Strategy a -> ShowS
$cshow :: forall a. Show a => Strategy a -> String
show :: Strategy a -> String
$cshowList :: forall a. Show a => [Strategy a] -> ShowS
showList :: [Strategy a] -> ShowS
Show, (forall m. Monoid m => Strategy m -> m)
-> (forall m a. Monoid m => (a -> m) -> Strategy a -> m)
-> (forall m a. Monoid m => (a -> m) -> Strategy a -> m)
-> (forall a b. (a -> b -> b) -> b -> Strategy a -> b)
-> (forall a b. (a -> b -> b) -> b -> Strategy a -> b)
-> (forall b a. (b -> a -> b) -> b -> Strategy a -> b)
-> (forall b a. (b -> a -> b) -> b -> Strategy a -> b)
-> (forall a. (a -> a -> a) -> Strategy a -> a)
-> (forall a. (a -> a -> a) -> Strategy a -> a)
-> (forall a. Strategy a -> [a])
-> (forall a. Strategy a -> Bool)
-> (forall a. Strategy a -> Int)
-> (forall a. Eq a => a -> Strategy a -> Bool)
-> (forall a. Ord a => Strategy a -> a)
-> (forall a. Ord a => Strategy a -> a)
-> (forall a. Num a => Strategy a -> a)
-> (forall a. Num a => Strategy a -> a)
-> Foldable Strategy
forall a. Eq a => a -> Strategy a -> Bool
forall a. Num a => Strategy a -> a
forall a. Ord a => Strategy a -> a
forall m. Monoid m => Strategy m -> m
forall a. Strategy a -> Bool
forall a. Strategy a -> Int
forall a. Strategy a -> [a]
forall a. (a -> a -> a) -> Strategy a -> a
forall m a. Monoid m => (a -> m) -> Strategy a -> m
forall b a. (b -> a -> b) -> b -> Strategy a -> b
forall a b. (a -> b -> b) -> b -> Strategy a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Strategy m -> m
fold :: forall m. Monoid m => Strategy m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Strategy a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Strategy a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Strategy a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Strategy a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Strategy a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Strategy a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Strategy a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Strategy a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Strategy a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Strategy a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Strategy a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Strategy a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Strategy a -> a
foldr1 :: forall a. (a -> a -> a) -> Strategy a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Strategy a -> a
foldl1 :: forall a. (a -> a -> a) -> Strategy a -> a
$ctoList :: forall a. Strategy a -> [a]
toList :: forall a. Strategy a -> [a]
$cnull :: forall a. Strategy a -> Bool
null :: forall a. Strategy a -> Bool
$clength :: forall a. Strategy a -> Int
length :: forall a. Strategy a -> Int
$celem :: forall a. Eq a => a -> Strategy a -> Bool
elem :: forall a. Eq a => a -> Strategy a -> Bool
$cmaximum :: forall a. Ord a => Strategy a -> a
maximum :: forall a. Ord a => Strategy a -> a
$cminimum :: forall a. Ord a => Strategy a -> a
minimum :: forall a. Ord a => Strategy a -> a
$csum :: forall a. Num a => Strategy a -> a
sum :: forall a. Num a => Strategy a -> a
$cproduct :: forall a. Num a => Strategy a -> a
product :: forall a. Num a => Strategy a -> a
Foldable, Functor Strategy
Foldable Strategy
(Functor Strategy, Foldable Strategy) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Strategy a -> f (Strategy b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Strategy (f a) -> f (Strategy a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Strategy a -> m (Strategy b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Strategy (m a) -> m (Strategy a))
-> Traversable Strategy
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Strategy (m a) -> m (Strategy a)
forall (f :: * -> *) a.
Applicative f =>
Strategy (f a) -> f (Strategy a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Strategy a -> m (Strategy b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Strategy a -> f (Strategy b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Strategy a -> f (Strategy b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Strategy a -> f (Strategy b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Strategy (f a) -> f (Strategy a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Strategy (f a) -> f (Strategy a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Strategy a -> m (Strategy b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Strategy a -> m (Strategy b)
$csequence :: forall (m :: * -> *) a. Monad m => Strategy (m a) -> m (Strategy a)
sequence :: forall (m :: * -> *) a. Monad m => Strategy (m a) -> m (Strategy a)
Traversable)

instance Monad Strategy where
  Strategy a
m >>= :: forall a b. Strategy a -> (a -> Strategy b) -> Strategy b
>>= a -> Strategy b
f  = Strategy b -> Strategy b
forall a. Strategy a -> Strategy a
normalizeStrategy (Strategy b -> Strategy b) -> Strategy b -> Strategy b
forall a b. (a -> b) -> a -> b
$ [Frequency b] -> Strategy b
forall a. [Frequency a] -> Strategy a
Strategy
    [ Text -> [(Int, b)] -> Frequency b
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
name [
#ifdef WITH_EXPENSIVE_ASSERTIONS
                    Bool -> (Int, b) -> (Int, b)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
q
                            Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
maxBoundInt32)
#endif
                    (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
q, b
b)
                  | (Int
p, a
a) <- Frequency a -> [(Int, a)]
forall a. Frequency a -> [(Int, a)]
runFrequency Frequency a
x
                  , Frequency b
y <- Strategy b -> [Frequency b]
forall a. Strategy a -> [Frequency a]
runStrategy (a -> Strategy b
f a
a)
                  , (Int
q, b
b) <- Frequency b -> [(Int, b)]
forall a. Frequency a -> [(Int, a)]
runFrequency Frequency b
y
                  ]
    | Frequency a
x <- Strategy a -> [Frequency a]
forall a. Strategy a -> [Frequency a]
runStrategy Strategy a
m
    , let name :: Text
name = Text
"Strategy_bind (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Frequency a -> Text
forall a. Frequency a -> Text
nameFrequency Frequency a
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"]

instance Functor Strategy where
  fmap :: forall a b. (a -> b) -> Strategy a -> Strategy b
fmap a -> b
f (Strategy [Frequency a]
fs) = [Frequency b] -> Strategy b
forall a. [Frequency a] -> Strategy a
Strategy ((Frequency a -> Frequency b) -> [Frequency a] -> [Frequency b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Frequency a -> Frequency b
forall a b. (a -> b) -> Frequency a -> Frequency b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Frequency a]
fs)

instance Applicative Strategy where
  {-# INLINE pure #-}
  pure :: forall a. a -> Strategy a
pure a
x = [Frequency a] -> Strategy a
forall a. [Frequency a] -> Strategy a
Strategy ([Frequency a] -> Strategy a) -> [Frequency a] -> Strategy a
forall a b. (a -> b) -> a -> b
$ Frequency a -> [Frequency a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Frequency a -> [Frequency a]) -> Frequency a -> [Frequency a]
forall a b. (a -> b) -> a -> b
$! Text -> [a] -> Frequency a
forall a. Text -> [a] -> Frequency a
uniformFreq Text
"Strategy_pure" [a
x]
  <*> :: forall a b. Strategy (a -> b) -> Strategy a -> Strategy b
(<*>) = Strategy (a -> b) -> Strategy a -> Strategy b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance MonadPlus Strategy where
  mzero :: forall a. Strategy a
mzero = [Frequency a] -> Strategy a
forall a. [Frequency a] -> Strategy a
Strategy []
  mplus :: forall a. Strategy a -> Strategy a -> Strategy a
mplus (Strategy [Frequency a]
xs) (Strategy [Frequency a]
ys) = [Frequency a] -> Strategy a
forall a. [Frequency a] -> Strategy a
Strategy ([Frequency a]
xs [Frequency a] -> [Frequency a] -> [Frequency a]
forall a. [a] -> [a] -> [a]
++ [Frequency a]
ys)

instance Alternative Strategy where
  <|> :: forall a. Strategy a -> Strategy a -> Strategy a
(<|>) = Strategy a -> Strategy a -> Strategy a
forall a. Strategy a -> Strategy a -> Strategy a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
  empty :: forall a. Strategy a
empty = Strategy a
forall a. Strategy a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

normalizeStrategy :: Strategy a -> Strategy a
normalizeStrategy :: forall a. Strategy a -> Strategy a
normalizeStrategy (Strategy [Frequency a]
fs) = [Frequency a] -> Strategy a
forall a. [Frequency a] -> Strategy a
Strategy ([Frequency a] -> Strategy a) -> [Frequency a] -> Strategy a
forall a b. (a -> b) -> a -> b
$ (Frequency a -> Bool) -> [Frequency a] -> [Frequency a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Frequency a -> Bool) -> Frequency a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frequency a -> Bool
forall a. Frequency a -> Bool
nullFreq) [Frequency a]
fs

nullStrategy :: Strategy a -> Bool
nullStrategy :: forall a. Strategy a -> Bool
nullStrategy Strategy a
strat = [Frequency a] -> Bool
forall a. [a] -> Bool
null ([Frequency a] -> Bool) -> [Frequency a] -> Bool
forall a b. (a -> b) -> a -> b
$ Strategy a -> [Frequency a]
forall a. Strategy a -> [Frequency a]
runStrategy Strategy a
strat

-- | Strategy where only the actions from the given single frequency table
-- can be picked.
liftFrequency :: Frequency a -> Strategy a
liftFrequency :: forall a. Frequency a -> Strategy a
liftFrequency Frequency a
f = Strategy a -> Strategy a
forall a. Strategy a -> Strategy a
normalizeStrategy (Strategy a -> Strategy a) -> Strategy a -> Strategy a
forall a b. (a -> b) -> a -> b
$ [Frequency a] -> Strategy a
forall a. [Frequency a] -> Strategy a
Strategy ([Frequency a] -> Strategy a) -> [Frequency a] -> Strategy a
forall a b. (a -> b) -> a -> b
$ Frequency a -> [Frequency a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return Frequency a
f

infixr 2 .|

-- | Strategy with the actions from both argument strategies,
-- with original frequencies.
(.|) :: Strategy a -> Strategy a -> Strategy a
.| :: forall a. Strategy a -> Strategy a -> Strategy a
(.|) = Strategy a -> Strategy a -> Strategy a
forall a. Strategy a -> Strategy a -> Strategy a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

-- | Strategy with no actions at all.
reject :: Strategy a
reject :: forall a. Strategy a
reject = Strategy a
forall a. Strategy a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

infix 3 .=>

-- | Conditionally accepted strategy.
(.=>) :: Bool -> Strategy a -> Strategy a
Bool
p .=> :: forall a. Bool -> Strategy a -> Strategy a
.=> Strategy a
m | Bool
p         = Strategy a
m
        | Bool
otherwise = Strategy a
forall a. Strategy a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Strategy with all actions not satisfying the predicate removed.
-- The remaining actions keep their original relative frequency values.
only :: (a -> Bool) -> Strategy a -> Strategy a
only :: forall a. (a -> Bool) -> Strategy a -> Strategy a
only a -> Bool
p Strategy a
s = Strategy a -> Strategy a
forall a. Strategy a -> Strategy a
normalizeStrategy (Strategy a -> Strategy a) -> Strategy a -> Strategy a
forall a b. (a -> b) -> a -> b
$ do
  a
x <- Strategy a
s
  a -> Bool
p a
x Bool -> Strategy a -> Strategy a
forall a. Bool -> Strategy a -> Strategy a
.=> a -> Strategy a
forall a. a -> Strategy a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | When better choices are towards the start of the list,
-- this is the best frequency of the strategy.
bestVariant :: Strategy a -> Frequency a
bestVariant :: forall a. Strategy a -> Frequency a
bestVariant (Strategy []) = Frequency a
forall a. Frequency a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
bestVariant (Strategy (Frequency a
f : [Frequency a]
_)) = Frequency a
f

-- | Like 'return', but pick a name of the single frequency.
returN :: Text -> a -> Strategy a
returN :: forall a. Text -> a -> Strategy a
returN Text
name a
x = [Frequency a] -> Strategy a
forall a. [Frequency a] -> Strategy a
Strategy ([Frequency a] -> Strategy a) -> [Frequency a] -> Strategy a
forall a b. (a -> b) -> a -> b
$ Frequency a -> [Frequency a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Frequency a -> [Frequency a]) -> Frequency a -> [Frequency a]
forall a b. (a -> b) -> a -> b
$! Text -> [a] -> Frequency a
forall a. Text -> [a] -> Frequency a
uniformFreq Text
name [a
x]

mapStrategyM :: Monad m => (a -> m (Maybe b)) -> Strategy a -> m (Strategy b)
mapStrategyM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Strategy a -> m (Strategy b)
mapStrategyM a -> m (Maybe b)
f Strategy a
s = do
  let mapFreq :: Frequency a -> m (Frequency b)
mapFreq Frequency a
freq = do
        let g :: (Int, a) -> m (Maybe (Int, b))
g (Int
k, a
a) = do
              Maybe b
mb <- a -> m (Maybe b)
f a
a
              Maybe (Int, b) -> m (Maybe (Int, b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, b) -> m (Maybe (Int, b)))
-> Maybe (Int, b) -> m (Maybe (Int, b))
forall a b. (a -> b) -> a -> b
$! (Int
k,) (b -> (Int, b)) -> Maybe b -> Maybe (Int, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b
mb
        [Maybe (Int, b)]
lbm <- ((Int, a) -> m (Maybe (Int, b)))
-> [(Int, a)] -> m [Maybe (Int, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int, a) -> m (Maybe (Int, b))
g ([(Int, a)] -> m [Maybe (Int, b)])
-> [(Int, a)] -> m [Maybe (Int, b)]
forall a b. (a -> b) -> a -> b
$ Frequency a -> [(Int, a)]
forall a. Frequency a -> [(Int, a)]
runFrequency Frequency a
freq
        Frequency b -> m (Frequency b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frequency b -> m (Frequency b)) -> Frequency b -> m (Frequency b)
forall a b. (a -> b) -> a -> b
$! Text -> [(Int, b)] -> Frequency b
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"mapStrategyM" ([(Int, b)] -> Frequency b) -> [(Int, b)] -> Frequency b
forall a b. (a -> b) -> a -> b
$ [Maybe (Int, b)] -> [(Int, b)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, b)]
lbm
      ls :: [Frequency a]
ls = Strategy a -> [Frequency a]
forall a. Strategy a -> [Frequency a]
runStrategy Strategy a
s
  [Frequency b]
lt <- (Frequency a -> m (Frequency b))
-> [Frequency a] -> m [Frequency b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Frequency a -> m (Frequency b)
mapFreq [Frequency a]
ls
  Strategy b -> m (Strategy b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy b -> m (Strategy b)) -> Strategy b -> m (Strategy b)
forall a b. (a -> b) -> a -> b
$! Strategy b -> Strategy b
forall a. Strategy a -> Strategy a
normalizeStrategy (Strategy b -> Strategy b) -> Strategy b -> Strategy b
forall a b. (a -> b) -> a -> b
$ [Frequency b] -> Strategy b
forall a. [Frequency a] -> Strategy a
Strategy [Frequency b]
lt