{-# 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.Length as Type.Length
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 x y = MkQuantifiedGame {
QuantifiedGame x y -> Game x y
getGame :: Model.Game.Game x y,
QuantifiedGame x y -> WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues :: Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues
} deriving (QuantifiedGame x y -> QuantifiedGame x y -> Bool
(QuantifiedGame x y -> QuantifiedGame x y -> Bool)
-> (QuantifiedGame x y -> QuantifiedGame x y -> Bool)
-> Eq (QuantifiedGame x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
QuantifiedGame x y -> QuantifiedGame x y -> Bool
/= :: QuantifiedGame x y -> QuantifiedGame x y -> Bool
$c/= :: forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
QuantifiedGame x y -> QuantifiedGame x y -> Bool
== :: QuantifiedGame x y -> QuantifiedGame x y -> Bool
$c== :: forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
QuantifiedGame x y -> QuantifiedGame x y -> Bool
Eq, Int -> QuantifiedGame x y -> ShowS
[QuantifiedGame x y] -> ShowS
QuantifiedGame x y -> String
(Int -> QuantifiedGame x y -> ShowS)
-> (QuantifiedGame x y -> String)
-> ([QuantifiedGame x y] -> ShowS)
-> Show (QuantifiedGame x y)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Int -> QuantifiedGame x y -> ShowS
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
[QuantifiedGame x y] -> ShowS
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QuantifiedGame x y -> String
showList :: [QuantifiedGame x y] -> ShowS
$cshowList :: forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
[QuantifiedGame x y] -> ShowS
show :: QuantifiedGame x y -> String
$cshow :: forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QuantifiedGame x y -> String
showsPrec :: Int -> QuantifiedGame x y -> ShowS
$cshowsPrec :: forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Int -> QuantifiedGame x y -> ShowS
Show)
instance Control.DeepSeq.NFData (QuantifiedGame x y) where
rnf :: QuantifiedGame x y -> ()
rnf MkQuantifiedGame { getWeightedMeanAndCriterionValues :: forall x y. QuantifiedGame x y -> WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues } = WeightedMeanAndCriterionValues -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues
instance (Enum x, Enum y) => Notation.MoveNotation.ShowNotationFloat (QuantifiedGame x y) where
showsNotationFloat :: MoveNotation -> (Double -> ShowS) -> QuantifiedGame x y -> ShowS
showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble QuantifiedGame x y
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 x y -> (String, ShowS)) -> (String, ShowS))
-> [QuantifiedGame x y -> (String, ShowS)] -> [(String, ShowS)]
forall a b. (a -> b) -> [a] -> [b]
map ((QuantifiedGame x y -> (String, ShowS))
-> QuantifiedGame x y -> (String, ShowS)
forall a b. (a -> b) -> a -> b
$ QuantifiedGame x y
quantifiedGame) [
(,) String
Component.Move.tag (ShowS -> (String, ShowS))
-> (QuantifiedGame x y -> ShowS)
-> QuantifiedGame x y
-> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveNotation -> Turn x y -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
Notation.MoveNotation.showsNotation MoveNotation
moveNotation (Turn x y -> ShowS)
-> (QuantifiedGame x y -> Turn x y) -> QuantifiedGame x y -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y -> Turn x y
forall x y. QuantifiedGame x y -> Turn x y
getLastTurn,
(,) String
Metric.WeightedMeanAndCriterionValues.weightedMeanTag (ShowS -> (String, ShowS))
-> (QuantifiedGame x y -> ShowS)
-> QuantifiedGame x y
-> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
showsDouble (Double -> ShowS)
-> (QuantifiedGame x y -> Double) -> QuantifiedGame x y -> 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 x y -> Double) -> QuantifiedGame x y -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y -> Double
forall x y. QuantifiedGame x y -> Double
getFitness,
(,) String
Metric.WeightedMeanAndCriterionValues.criterionValuesTag (ShowS -> (String, ShowS))
-> (QuantifiedGame x y -> ShowS)
-> QuantifiedGame x y
-> (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 x y -> [Double]) -> QuantifiedGame x y -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WeightedMeanAndCriterionValues -> [Double]
Metric.WeightedMeanAndCriterionValues.getCriterionValues (WeightedMeanAndCriterionValues -> [Double])
-> (QuantifiedGame x y -> WeightedMeanAndCriterionValues)
-> QuantifiedGame x y
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y -> WeightedMeanAndCriterionValues
forall x y. QuantifiedGame x y -> WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues
]
instance Property.Null.Null (QuantifiedGame x y) where
isNull :: QuantifiedGame x y -> Bool
isNull MkQuantifiedGame { getGame :: forall x y. QuantifiedGame x y -> Game x y
getGame = Game x y
game } = Game x y -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull Game x y
game
getFitness :: QuantifiedGame x y -> Type.Mass.WeightedMean
getFitness :: QuantifiedGame x y -> Double
getFitness MkQuantifiedGame { getWeightedMeanAndCriterionValues :: forall x y. QuantifiedGame x y -> 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
Enum x,
Enum y,
Fractional pieceSquareValue,
Ord x,
Ord y,
Real pieceSquareValue,
Show x,
Show y
)
=> Maybe pieceSquareValue
-> Model.Game.Game x y
-> Input.EvaluationOptions.Reader pieceSquareValue x y (QuantifiedGame x y)
{-# SPECIALISE fromGame :: Maybe Type.Mass.PieceSquareValue -> Model.Game.Game Type.Length.X Type.Length.Y -> Input.EvaluationOptions.Reader Type.Mass.PieceSquareValue Type.Length.X Type.Length.Y (QuantifiedGame Type.Length.X Type.Length.Y) #-}
fromGame :: Maybe pieceSquareValue
-> Game x y -> Reader pieceSquareValue x y (QuantifiedGame x y)
fromGame Maybe pieceSquareValue
maybePieceSquareValue Game x y
game = Game x y -> WeightedMeanAndCriterionValues -> QuantifiedGame x y
forall x y.
Game x y -> WeightedMeanAndCriterionValues -> QuantifiedGame x y
MkQuantifiedGame Game x y
game (WeightedMeanAndCriterionValues -> QuantifiedGame x y)
-> ReaderT
(EvaluationOptions pieceSquareValue x y)
Identity
WeightedMeanAndCriterionValues
-> Reader pieceSquareValue x y (QuantifiedGame x y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe pieceSquareValue
-> Game x y
-> ReaderT
(EvaluationOptions pieceSquareValue x y)
Identity
WeightedMeanAndCriterionValues
forall x y pieceSquareValue.
(Enum x, Enum y, Fractional pieceSquareValue, Ord x, Ord y,
Real pieceSquareValue, Show x, Show y) =>
Maybe pieceSquareValue
-> Game x y
-> Reader pieceSquareValue x y WeightedMeanAndCriterionValues
Evaluation.Fitness.evaluateFitness Maybe pieceSquareValue
maybePieceSquareValue Game x y
game
getLastTurn :: QuantifiedGame x y -> Component.Turn.Turn x y
getLastTurn :: QuantifiedGame x y -> Turn x y
getLastTurn MkQuantifiedGame { getGame :: forall x y. QuantifiedGame x y -> Game x y
getGame = Game x y
game } = Turn x y -> Maybe (Turn x y) -> Turn x y
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
Exception -> Turn x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Turn x y) -> Exception -> Turn x y
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.Evaluation.QuantifiedGame.getLastTurn:\tzero turns have been made."
) (Maybe (Turn x y) -> Turn x y) -> Maybe (Turn x y) -> Turn x y
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
Model.Game.maybeLastTurn Game x y
game
getLatestTurns
:: Type.Count.NPlies
-> QuantifiedGame x y
-> [Component.Turn.Turn x y]
getLatestTurns :: Int -> QuantifiedGame x y -> [Turn x y]
getLatestTurns Int
nPlies MkQuantifiedGame { getGame :: forall x y. QuantifiedGame x y -> Game x y
getGame = Game x y
game } = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nPlies Int -> [Turn x y] -> [Turn x y]
forall a. Int -> [a] -> [a]
`drop` Game x y -> [Turn x y]
forall x y. Game x y -> [Turn x y]
Model.Game.listTurnsChronologically Game x y
game
negateFitness :: QuantifiedGame x y -> QuantifiedGame x y
negateFitness :: QuantifiedGame x y -> QuantifiedGame x y
negateFitness quantifiedGame :: QuantifiedGame x y
quantifiedGame@MkQuantifiedGame { getWeightedMeanAndCriterionValues :: forall x y. QuantifiedGame x y -> WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues } = QuantifiedGame x y
quantifiedGame { getWeightedMeanAndCriterionValues :: WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues -> WeightedMeanAndCriterionValues
Metric.WeightedMeanAndCriterionValues.negateWeightedMean WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues }
compareFitness :: QuantifiedGame x y -> QuantifiedGame x y -> Ordering
compareFitness :: QuantifiedGame x y -> QuantifiedGame x y -> Ordering
compareFitness = (QuantifiedGame x y -> Double)
-> QuantifiedGame x y -> QuantifiedGame x y -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing QuantifiedGame x y -> Double
forall x y. QuantifiedGame x y -> Double
getFitness
type OpenInterval x y = (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
unboundedInterval :: OpenInterval x y
unboundedInterval :: OpenInterval x y
unboundedInterval = (Maybe (QuantifiedGame x y)
forall a. Maybe a
Nothing, Maybe (QuantifiedGame x y)
forall a. Maybe a
Nothing)
negateInterval :: OpenInterval x y -> OpenInterval x y
negateInterval :: OpenInterval x y -> OpenInterval x y
negateInterval (Maybe (QuantifiedGame x y)
maybeAlpha, Maybe (QuantifiedGame x y)
maybeBeta) = ((Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y))
-> Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y)
forall a b. (a -> b) -> a -> b
$ Maybe (QuantifiedGame x y)
maybeBeta) ((Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y))
-> Maybe (QuantifiedGame x y))
-> ((Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y))
-> Maybe (QuantifiedGame x y))
-> (Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y))
-> OpenInterval x y
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y))
-> Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y)
forall a b. (a -> b) -> a -> b
$ Maybe (QuantifiedGame x y)
maybeAlpha) ((Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y))
-> OpenInterval x y)
-> (Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y))
-> OpenInterval x y
forall a b. (a -> b) -> a -> b
$ (QuantifiedGame x y -> QuantifiedGame x y)
-> Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QuantifiedGame x y -> QuantifiedGame x y
forall x y. QuantifiedGame x y -> QuantifiedGame x y
negateFitness