{-# LANGUAGE CPP, FlexibleContexts #-}
{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Quantifies a /game/, & therefore the sequence of moves applied.

	* The fitness & its breakdown into constituent criterion-values, are also recorded.
-}

module BishBosh.Evaluation.QuantifiedGame(
-- * Types
-- ** Type-synonyms
	OpenInterval,
-- ** Data-types
	QuantifiedGame(
--		MkQuantifiedGame,
		getGame,
		getWeightedMeanAndCriterionValues
	),
-- * Constants
	unboundedInterval,
-- * Functions
	compareFitness,
-- ** Accessors
	getFitness,
-- ** Constructors
	fromGame,
-- ** Accessors
	getLastTurn,
	getLatestTurns,
-- ** Mutators
	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

-- | The selected /game/ & the criteria against which it was quantified.
data QuantifiedGame x y	= MkQuantifiedGame {
	QuantifiedGame x y -> Game x y
getGame					:: Model.Game.Game x y,	-- ^ The /game/ resulting from a sequence of /turn/s.
	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	-- The other field is a prerequisite.

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

-- | Accessor.
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

-- | Constructor.
fromGame :: (
#ifdef USE_UNBOXED_ARRAYS
	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).
#endif
	Enum							x,
	Enum							y,
	Fractional						pieceSquareValue,
	Ord							x,
	Ord							y,
	Real							pieceSquareValue,
	Show							x,
	Show							y
 )
	=> Maybe pieceSquareValue	-- ^ The value for the specified game.
	-> Model.Game.Game x y		-- ^ The current state of the /game/.
	-> 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

-- | Retrieve the /turn/ used to generate the selected /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

-- | Drop the specified number of plies from the start of the chronological sequence, leaving the most recent.
getLatestTurns
	:: Type.Count.NPlies	-- ^ The number of plies to drop from the start of the chronological sequence.
	-> 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

-- | Represent the /fitness/ of the /game/ resulting from a future /move/ by the opponent, from the perspective of the current player.
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 }

-- | Compares fitness.
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

{- |
	* The open interval in which to search for better solutions.

	* N.B.: 'Nothing' is interpreted as unbounded.
-}
type OpenInterval x y	= (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))

-- | Constant.
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)

-- | Reflect the interval about zero.
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