{-
	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
-- ** Accessors
	getFitness,
-- ** Constructors
	fromGame,
-- ** Accessors
	getLastTurn,
	getLatestTurns,
-- ** Mutators
	negateFitness,
	negateInterval,
-- ** Predicates
	(<=>),
	(===)
 ) 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

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

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

-- | Accessor.
getFitness :: QuantifiedGame -> Type.Mass.WeightedMean
getFitness :: QuantifiedGame -> Double
getFitness MkQuantifiedGame { getWeightedMeanAndCriterionValues :: QuantifiedGame -> WeightedMeanAndCriterionValues
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues }	= WeightedMeanAndCriterionValues -> Double
Metric.WeightedMeanAndCriterionValues.getWeightedMean WeightedMeanAndCriterionValues
weightedMeanAndCriterionValues

-- | Space-ship operator, like in Perl.
(<=>) :: 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 <=>	-- Same as (>).

{- |
	* Whether the games have taken the same move-sequences, & as such have the same position.

	* CAVEAT: the games won't be identical if they started from different positions, but by some fluke managed to make the same sequence of moves.
-}
(===) :: 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 ===	-- Same as (==).

-- | Constructor.
fromGame
	:: Maybe Type.Mass.Base	-- ^ The piece-square value difference for the specified game.
	-> Model.Game.Game	-- ^ The current state of the /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

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

-- | 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
	-> [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

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

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

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

-- | Constant.
unboundedInterval :: OpenInterval
unboundedInterval :: OpenInterval
unboundedInterval	= (Maybe QuantifiedGame
forall a. Maybe a
Nothing, Maybe QuantifiedGame
forall a. Maybe a
Nothing)

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