module BishBosh.Evaluation.QuantifiedGame(
OpenInterval,
QuantifiedGame(
getGame,
getWeightedMeanAndCriterionValues
),
unboundedInterval,
compareFitness,
getFitness,
fromGame,
getLastTurn,
getLatestTurns,
negateFitness,
negateInterval
) where
import Control.Arrow((&&&))
import qualified BishBosh.Attribute.WeightedMeanAndCriterionValues as Attribute.WeightedMeanAndCriterionValues
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.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.Types as T
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Maybe
import qualified Data.Ord
data QuantifiedGame x y criterionValue weightedMean = MkQuantifiedGame {
getGame :: Model.Game.Game x y,
getWeightedMeanAndCriterionValues :: Attribute.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues weightedMean criterionValue
} deriving (Eq, Show)
instance Control.DeepSeq.NFData weightedMean => Control.DeepSeq.NFData (QuantifiedGame x y criterionValue weightedMean) where
rnf MkQuantifiedGame { getWeightedMeanAndCriterionValues = weightedMeanAndCriterionValues } = Control.DeepSeq.rnf weightedMeanAndCriterionValues
instance (Enum x, Enum y, Real criterionValue, Real weightedMean) => Notation.MoveNotation.ShowNotationFloat (QuantifiedGame x y criterionValue weightedMean) where
showsNotationFloat moveNotation showsDouble quantifiedGame = Text.ShowList.showsAssociationList Text.ShowList.showsSeparator $ map ($ quantifiedGame) [
(,) Component.Move.tag . Notation.MoveNotation.showsNotation moveNotation . getLastTurn,
(,) Attribute.WeightedMeanAndCriterionValues.weightedMeanTag . showsDouble . realToFrac . getFitness,
(,) Attribute.WeightedMeanAndCriterionValues.criterionValuesTag . Text.ShowList.showsFormattedList' (showsDouble . realToFrac) . Attribute.WeightedMeanAndCriterionValues.getCriterionValues . getWeightedMeanAndCriterionValues
]
instance Property.Null.Null (QuantifiedGame x y criterionValue weightedMean) where
isNull MkQuantifiedGame { getGame = game } = Property.Null.isNull game
getFitness :: QuantifiedGame x y criterionValue weightedMean -> weightedMean
getFitness MkQuantifiedGame { getWeightedMeanAndCriterionValues = weightedMeanAndCriterionValues } = Attribute.WeightedMeanAndCriterionValues.getWeightedMean weightedMeanAndCriterionValues
fromGame :: (
Enum x,
Enum y,
Fractional criterionValue,
Fractional pieceSquareValue,
Fractional rankValue,
Fractional weightedMean,
Ord x,
Ord y,
Real criterionValue,
Real criterionWeight,
Real pieceSquareValue,
Real rankValue,
Show x,
Show y
)
=> Maybe pieceSquareValue
-> Model.Game.Game x y
-> Input.EvaluationOptions.Reader criterionWeight pieceSquareValue rankValue x y (QuantifiedGame x y criterionValue weightedMean)
{-# SPECIALISE fromGame :: Maybe T.PieceSquareValue -> Model.Game.Game T.X T.Y -> Input.EvaluationOptions.Reader T.CriterionWeight T.PieceSquareValue T.RankValue T.X T.Y (QuantifiedGame T.X T.Y T.CriterionValue T.WeightedMean) #-}
fromGame maybePieceSquareValue game = MkQuantifiedGame game `fmap` Evaluation.Fitness.evaluateFitness maybePieceSquareValue game
getLastTurn :: QuantifiedGame x y criterionValue weightedMean -> Component.Turn.Turn x y
getLastTurn MkQuantifiedGame { getGame = game } = Data.Maybe.fromMaybe (
Control.Exception.throw $ Data.Exception.mkResultUndefined "BishBosh.Evaluation.QuantifiedGame.getLastTurn:\tzero turns have been made."
) $ Model.Game.maybeLastTurn game
getLatestTurns
:: Component.Move.NPlies
-> QuantifiedGame x y criterionValue weightedMean
-> [Component.Turn.Turn x y]
getLatestTurns nPlies MkQuantifiedGame { getGame = game } = drop nPlies $ Model.Game.listTurnsChronologically game
negateFitness :: Num weightedMean => QuantifiedGame x y criterionValue weightedMean -> QuantifiedGame x y criterionValue weightedMean
negateFitness quantifiedGame@MkQuantifiedGame { getWeightedMeanAndCriterionValues = weightedMeanAndCriterionValues } = quantifiedGame { getWeightedMeanAndCriterionValues = Attribute.WeightedMeanAndCriterionValues.negateWeightedMean weightedMeanAndCriterionValues }
compareFitness
:: Ord weightedMean
=> QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
-> Ordering
compareFitness = Data.Ord.comparing getFitness
type OpenInterval x y criterionValue weightedMean = (Maybe (QuantifiedGame x y criterionValue weightedMean), Maybe (QuantifiedGame x y criterionValue weightedMean))
unboundedInterval :: OpenInterval x y criterionValue weightedMean
unboundedInterval = (Nothing, Nothing)
negateInterval :: Num weightedMean => OpenInterval x y criterionValue weightedMean -> OpenInterval x y criterionValue weightedMean
negateInterval (maybeAlpha, maybeBeta) = ($ maybeBeta) &&& ($ maybeAlpha) $ fmap negateFitness