module BishBosh.Evaluation.QuantifiedGame(
OpenInterval,
QuantifiedGame(
getGame,
getWeightedMeanAndCriterionValues
),
unboundedInterval,
getFitness,
fromGame,
getLastTurn,
getLatestTurns,
negateFitness,
negateInterval,
(<=>),
(===)
) where
import Control.Arrow((&&&))
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Component.Turn as Component.Turn
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Evaluation.Fitness as Evaluation.Fitness
import qualified BishBosh.Input.EvaluationOptions as Input.EvaluationOptions
import qualified BishBosh.Metric.WeightedMeanAndCriterionValues as Metric.WeightedMeanAndCriterionValues
import qualified BishBosh.Model.Game as Model.Game
import qualified BishBosh.Notation.MoveNotation as Notation.MoveNotation
import qualified BishBosh.Property.Null as Property.Null
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Type.Count as Type.Count
import qualified BishBosh.Type.Mass as Type.Mass
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Maybe
import qualified Data.Ord
data QuantifiedGame = MkQuantifiedGame {
QuantifiedGame -> Game
getGame :: Model.Game.Game,
QuantifiedGame -> WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues :: Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues
} deriving (QuantifiedGame -> QuantifiedGame -> Bool
(QuantifiedGame -> QuantifiedGame -> Bool)
-> (QuantifiedGame -> QuantifiedGame -> Bool) -> Eq QuantifiedGame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuantifiedGame -> QuantifiedGame -> Bool
$c/= :: QuantifiedGame -> QuantifiedGame -> Bool
== :: QuantifiedGame -> QuantifiedGame -> Bool
$c== :: QuantifiedGame -> QuantifiedGame -> Bool
Eq, Int -> QuantifiedGame -> ShowS
[QuantifiedGame] -> ShowS
QuantifiedGame -> String
(Int -> QuantifiedGame -> ShowS)
-> (QuantifiedGame -> String)
-> ([QuantifiedGame] -> ShowS)
-> Show QuantifiedGame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuantifiedGame] -> ShowS
$cshowList :: [QuantifiedGame] -> ShowS
show :: QuantifiedGame -> String
$cshow :: QuantifiedGame -> String
showsPrec :: Int -> QuantifiedGame -> ShowS
$cshowsPrec :: Int -> QuantifiedGame -> ShowS
Show)
instance Control.DeepSeq.NFData QuantifiedGame where
rnf :: QuantifiedGame -> ()
rnf MkQuantifiedGame { getWeightedMeanAndCriterionValues :: QuantifiedGame -> WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues } = WeightedMeanAndCriterionValues -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues
instance Notation.MoveNotation.ShowNotationFloat QuantifiedGame where
showsNotationFloat :: MoveNotation -> (Double -> ShowS) -> QuantifiedGame -> ShowS
showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble QuantifiedGame
quantifiedGame = ShowS -> [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList ShowS
Text.ShowList.showsSeparator ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ ((QuantifiedGame -> (String, ShowS)) -> (String, ShowS))
-> [QuantifiedGame -> (String, ShowS)] -> [(String, ShowS)]
forall a b. (a -> b) -> [a] -> [b]
map ((QuantifiedGame -> (String, ShowS))
-> QuantifiedGame -> (String, ShowS)
forall a b. (a -> b) -> a -> b
$ QuantifiedGame
quantifiedGame) [
(,) String
Component.Move.tag (ShowS -> (String, ShowS))
-> (QuantifiedGame -> ShowS) -> QuantifiedGame -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveNotation -> Turn -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
Notation.MoveNotation.showsNotation MoveNotation
moveNotation (Turn -> ShowS)
-> (QuantifiedGame -> Turn) -> QuantifiedGame -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame -> Turn
getLastTurn,
(,) String
Metric.WeightedMeanAndCriterionValues.weightedMeanTag (ShowS -> (String, ShowS))
-> (QuantifiedGame -> ShowS) -> QuantifiedGame -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
showsDouble (Double -> ShowS)
-> (QuantifiedGame -> Double) -> QuantifiedGame -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Double)
-> (QuantifiedGame -> Double) -> QuantifiedGame -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame -> Double
getFitness,
(,) String
Metric.WeightedMeanAndCriterionValues.criterionValuesTag (ShowS -> (String, ShowS))
-> (QuantifiedGame -> ShowS) -> QuantifiedGame -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> ShowS) -> [Double] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
Text.ShowList.showsFormattedList' (Double -> ShowS
showsDouble (Double -> ShowS) -> (Double -> Double) -> Double -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac) ([Double] -> ShowS)
-> (QuantifiedGame -> [Double]) -> QuantifiedGame -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WeightedMeanAndCriterionValues -> [Double]
Metric.WeightedMeanAndCriterionValues.getCriterionValues (WeightedMeanAndCriterionValues -> [Double])
-> (QuantifiedGame -> WeightedMeanAndCriterionValues)
-> QuantifiedGame
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame -> WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues
]
instance Property.Null.Null QuantifiedGame where
isNull :: QuantifiedGame -> Bool
isNull MkQuantifiedGame { getGame :: QuantifiedGame -> Game
getGame = Game
game } = Game -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull Game
game
getFitness :: QuantifiedGame -> Type.Mass.WeightedMean
getFitness :: QuantifiedGame -> Double
getFitness MkQuantifiedGame { getWeightedMeanAndCriterionValues :: QuantifiedGame -> WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues } = WeightedMeanAndCriterionValues -> Double
Metric.WeightedMeanAndCriterionValues.getWeightedMean WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues
(<=>) :: QuantifiedGame -> QuantifiedGame -> Ordering
<=> :: QuantifiedGame -> QuantifiedGame -> Ordering
(<=>) = (QuantifiedGame -> Double)
-> QuantifiedGame -> QuantifiedGame -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing QuantifiedGame -> Double
getFitness
infix 4 <=>
(===) :: QuantifiedGame -> QuantifiedGame -> Bool
QuantifiedGame
lhs === :: QuantifiedGame -> QuantifiedGame -> Bool
=== QuantifiedGame
rhs = (TurnsByLogicalColour -> TurnsByLogicalColour -> Bool)
-> (TurnsByLogicalColour, TurnsByLogicalColour) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TurnsByLogicalColour -> TurnsByLogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((TurnsByLogicalColour, TurnsByLogicalColour) -> Bool)
-> ((QuantifiedGame -> TurnsByLogicalColour)
-> (TurnsByLogicalColour, TurnsByLogicalColour))
-> (QuantifiedGame -> TurnsByLogicalColour)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((QuantifiedGame -> TurnsByLogicalColour)
-> QuantifiedGame -> TurnsByLogicalColour
forall a b. (a -> b) -> a -> b
$ QuantifiedGame
lhs) ((QuantifiedGame -> TurnsByLogicalColour) -> TurnsByLogicalColour)
-> ((QuantifiedGame -> TurnsByLogicalColour)
-> TurnsByLogicalColour)
-> (QuantifiedGame -> TurnsByLogicalColour)
-> (TurnsByLogicalColour, TurnsByLogicalColour)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((QuantifiedGame -> TurnsByLogicalColour)
-> QuantifiedGame -> TurnsByLogicalColour
forall a b. (a -> b) -> a -> b
$ QuantifiedGame
rhs)) ((QuantifiedGame -> TurnsByLogicalColour) -> Bool)
-> (QuantifiedGame -> TurnsByLogicalColour) -> Bool
forall a b. (a -> b) -> a -> b
$ Game -> TurnsByLogicalColour
Model.Game.getTurnsByLogicalColour (Game -> TurnsByLogicalColour)
-> (QuantifiedGame -> Game)
-> QuantifiedGame
-> TurnsByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame -> Game
getGame
infix 4 ===
fromGame
:: Maybe Type.Mass.Base
-> Model.Game.Game
-> Input.EvaluationOptions.Reader QuantifiedGame
fromGame :: Maybe Double -> Game -> Reader QuantifiedGame
fromGame Maybe Double
maybePieceSquareValueDifference Game
game = Game -> WeightedMeanAndCriterionValues -> QuantifiedGame
MkQuantifiedGame Game
game (WeightedMeanAndCriterionValues -> QuantifiedGame)
-> ReaderT
EvaluationOptions Identity WeightedMeanAndCriterionValues
-> Reader QuantifiedGame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
-> Game
-> ReaderT
EvaluationOptions Identity WeightedMeanAndCriterionValues
Evaluation.Fitness.evaluateFitness Maybe Double
maybePieceSquareValueDifference Game
game
getLastTurn :: QuantifiedGame -> Component.Turn.Turn
getLastTurn :: QuantifiedGame -> Turn
getLastTurn MkQuantifiedGame { getGame :: QuantifiedGame -> Game
getGame = Game
game } = Turn -> Maybe Turn -> Turn
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
Exception -> Turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Turn) -> Exception -> Turn
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.Evaluation.QuantifiedGame.getLastTurn:\tzero turns have been made."
) (Maybe Turn -> Turn) -> Maybe Turn -> Turn
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Turn
Model.Game.maybeLastTurn Game
game
getLatestTurns
:: Type.Count.NPlies
-> QuantifiedGame
-> [Component.Turn.Turn]
getLatestTurns :: Int -> QuantifiedGame -> [Turn]
getLatestTurns Int
nPlies MkQuantifiedGame { getGame :: QuantifiedGame -> Game
getGame = Game
game } = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nPlies Int -> [Turn] -> [Turn]
forall a. Int -> [a] -> [a]
`drop` Game -> [Turn]
Model.Game.listTurnsChronologically Game
game
negateFitness :: QuantifiedGame -> QuantifiedGame
negateFitness :: QuantifiedGame -> QuantifiedGame
negateFitness quantifiedGame :: QuantifiedGame
quantifiedGame@MkQuantifiedGame { getWeightedMeanAndCriterionValues :: QuantifiedGame -> WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues } = QuantifiedGame
quantifiedGame { getWeightedMeanAndCriterionValues :: WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues -> WeightedMeanAndCriterionValues
Metric.WeightedMeanAndCriterionValues.negateWeightedMean WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues }
type OpenInterval = (Maybe QuantifiedGame, Maybe QuantifiedGame)
unboundedInterval :: OpenInterval
unboundedInterval :: OpenInterval
unboundedInterval = (Maybe QuantifiedGame
forall a. Maybe a
Nothing, Maybe QuantifiedGame
forall a. Maybe a
Nothing)
negateInterval :: OpenInterval -> OpenInterval
negateInterval :: OpenInterval -> OpenInterval
negateInterval (Maybe QuantifiedGame
maybeAlpha, Maybe QuantifiedGame
maybeBeta) = ((Maybe QuantifiedGame -> Maybe QuantifiedGame)
-> Maybe QuantifiedGame -> Maybe QuantifiedGame
forall a b. (a -> b) -> a -> b
$ Maybe QuantifiedGame
maybeBeta) ((Maybe QuantifiedGame -> Maybe QuantifiedGame)
-> Maybe QuantifiedGame)
-> ((Maybe QuantifiedGame -> Maybe QuantifiedGame)
-> Maybe QuantifiedGame)
-> (Maybe QuantifiedGame -> Maybe QuantifiedGame)
-> OpenInterval
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Maybe QuantifiedGame -> Maybe QuantifiedGame)
-> Maybe QuantifiedGame -> Maybe QuantifiedGame
forall a b. (a -> b) -> a -> b
$ Maybe QuantifiedGame
maybeAlpha) ((Maybe QuantifiedGame -> Maybe QuantifiedGame) -> OpenInterval)
-> (Maybe QuantifiedGame -> Maybe QuantifiedGame) -> OpenInterval
forall a b. (a -> b) -> a -> b
$ (QuantifiedGame -> QuantifiedGame)
-> Maybe QuantifiedGame -> Maybe QuantifiedGame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QuantifiedGame -> QuantifiedGame
negateFitness