{-# LANGUAGE CPP, FlexibleContexts #-}
module BishBosh.Evaluation.QuantifiedGame(
OpenInterval,
QuantifiedGame(
getGame,
getWeightedMeanAndCriterionValues
),
unboundedInterval,
compareFitness,
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
#ifdef USE_UNBOXED_ARRAYS
import qualified Data.Array.Unboxed
#endif
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
fromGame :: (
#ifdef USE_UNBOXED_ARRAYS
Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue,
#endif
Fractional pieceSquareValue,
Real pieceSquareValue
)
=> Maybe pieceSquareValue
-> Model.Game.Game
-> Input.EvaluationOptions.Reader pieceSquareValue QuantifiedGame
fromGame :: Maybe pieceSquareValue
-> Game -> Reader pieceSquareValue QuantifiedGame
fromGame Maybe pieceSquareValue
maybePieceSquareValue Game
game = Game -> WeightedMeanAndCriterionValues -> QuantifiedGame
MkQuantifiedGame Game
game (WeightedMeanAndCriterionValues -> QuantifiedGame)
-> ReaderT
(EvaluationOptions pieceSquareValue)
Identity
WeightedMeanAndCriterionValues
-> Reader pieceSquareValue QuantifiedGame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe pieceSquareValue
-> Game
-> ReaderT
(EvaluationOptions pieceSquareValue)
Identity
WeightedMeanAndCriterionValues
forall pieceSquareValue.
(Fractional pieceSquareValue, Real pieceSquareValue) =>
Maybe pieceSquareValue
-> Game -> Reader pieceSquareValue WeightedMeanAndCriterionValues
Evaluation.Fitness.evaluateFitness Maybe pieceSquareValue
maybePieceSquareValue 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 }
compareFitness :: QuantifiedGame -> QuantifiedGame -> Ordering
compareFitness :: QuantifiedGame -> QuantifiedGame -> Ordering
compareFitness = (QuantifiedGame -> Double)
-> QuantifiedGame -> QuantifiedGame -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing QuantifiedGame -> Double
getFitness
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