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

-- | The selected /game/ & the criteria used in that QuantifiedGame.
data QuantifiedGame x y criterionValue weightedMean	= MkQuantifiedGame {
	QuantifiedGame x y criterionValue weightedMean -> Game x y
getGame					:: Model.Game.Game x y,	-- ^ The /game/ resulting from a sequence of /turn/s.
	QuantifiedGame x y criterionValue weightedMean
-> WeightedMeanAndCriterionValues weightedMean criterionValue
getWeightedMeanAndCriterionValues	:: Attribute.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues weightedMean criterionValue
} deriving (QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Bool
(QuantifiedGame x y criterionValue weightedMean
 -> QuantifiedGame x y criterionValue weightedMean -> Bool)
-> (QuantifiedGame x y criterionValue weightedMean
    -> QuantifiedGame x y criterionValue weightedMean -> Bool)
-> Eq (QuantifiedGame x y criterionValue weightedMean)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y criterionValue weightedMean.
(Enum x, Enum y, Ord x, Ord y, Eq weightedMean,
 Eq criterionValue) =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Bool
/= :: QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Bool
$c/= :: forall x y criterionValue weightedMean.
(Enum x, Enum y, Ord x, Ord y, Eq weightedMean,
 Eq criterionValue) =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Bool
== :: QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Bool
$c== :: forall x y criterionValue weightedMean.
(Enum x, Enum y, Ord x, Ord y, Eq weightedMean,
 Eq criterionValue) =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Bool
Eq, Int -> QuantifiedGame x y criterionValue weightedMean -> ShowS
[QuantifiedGame x y criterionValue weightedMean] -> ShowS
QuantifiedGame x y criterionValue weightedMean -> String
(Int -> QuantifiedGame x y criterionValue weightedMean -> ShowS)
-> (QuantifiedGame x y criterionValue weightedMean -> String)
-> ([QuantifiedGame x y criterionValue weightedMean] -> ShowS)
-> Show (QuantifiedGame x y criterionValue weightedMean)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y criterionValue weightedMean.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y, Show weightedMean,
 Show criterionValue) =>
Int -> QuantifiedGame x y criterionValue weightedMean -> ShowS
forall x y criterionValue weightedMean.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y, Show weightedMean,
 Show criterionValue) =>
[QuantifiedGame x y criterionValue weightedMean] -> ShowS
forall x y criterionValue weightedMean.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y, Show weightedMean,
 Show criterionValue) =>
QuantifiedGame x y criterionValue weightedMean -> String
showList :: [QuantifiedGame x y criterionValue weightedMean] -> ShowS
$cshowList :: forall x y criterionValue weightedMean.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y, Show weightedMean,
 Show criterionValue) =>
[QuantifiedGame x y criterionValue weightedMean] -> ShowS
show :: QuantifiedGame x y criterionValue weightedMean -> String
$cshow :: forall x y criterionValue weightedMean.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y, Show weightedMean,
 Show criterionValue) =>
QuantifiedGame x y criterionValue weightedMean -> String
showsPrec :: Int -> QuantifiedGame x y criterionValue weightedMean -> ShowS
$cshowsPrec :: forall x y criterionValue weightedMean.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y, Show weightedMean,
 Show criterionValue) =>
Int -> QuantifiedGame x y criterionValue weightedMean -> ShowS
Show)

instance Control.DeepSeq.NFData weightedMean => Control.DeepSeq.NFData (QuantifiedGame x y criterionValue weightedMean) where
	rnf :: QuantifiedGame x y criterionValue weightedMean -> ()
rnf MkQuantifiedGame { getWeightedMeanAndCriterionValues :: forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean
-> WeightedMeanAndCriterionValues weightedMean criterionValue
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues weightedMean criterionValue
weightedMeanAndCriterionValues }	= WeightedMeanAndCriterionValues weightedMean criterionValue -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf WeightedMeanAndCriterionValues weightedMean criterionValue
weightedMeanAndCriterionValues	-- The other field is a prerequisite.

instance (Enum x, Enum y, Real criterionValue, Real weightedMean) => Notation.MoveNotation.ShowNotationFloat (QuantifiedGame x y criterionValue weightedMean) where
	showsNotationFloat :: MoveNotation
-> (Double -> ShowS)
-> QuantifiedGame x y criterionValue weightedMean
-> ShowS
showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble QuantifiedGame x y criterionValue weightedMean
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 criterionValue weightedMean
  -> (String, ShowS))
 -> (String, ShowS))
-> [QuantifiedGame x y criterionValue weightedMean
    -> (String, ShowS)]
-> [(String, ShowS)]
forall a b. (a -> b) -> [a] -> [b]
map ((QuantifiedGame x y criterionValue weightedMean -> (String, ShowS))
-> QuantifiedGame x y criterionValue weightedMean
-> (String, ShowS)
forall a b. (a -> b) -> a -> b
$ QuantifiedGame x y criterionValue weightedMean
quantifiedGame) [
		(,) String
Component.Move.tag (ShowS -> (String, ShowS))
-> (QuantifiedGame x y criterionValue weightedMean -> ShowS)
-> QuantifiedGame x y criterionValue weightedMean
-> (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 criterionValue weightedMean -> Turn x y)
-> QuantifiedGame x y criterionValue weightedMean
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y criterionValue weightedMean -> Turn x y
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> Turn x y
getLastTurn,
		(,) String
Attribute.WeightedMeanAndCriterionValues.weightedMeanTag (ShowS -> (String, ShowS))
-> (QuantifiedGame x y criterionValue weightedMean -> ShowS)
-> QuantifiedGame x y criterionValue weightedMean
-> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
showsDouble (Double -> ShowS)
-> (QuantifiedGame x y criterionValue weightedMean -> Double)
-> QuantifiedGame x y criterionValue weightedMean
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. weightedMean -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (weightedMean -> Double)
-> (QuantifiedGame x y criterionValue weightedMean -> weightedMean)
-> QuantifiedGame x y criterionValue weightedMean
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y criterionValue weightedMean -> weightedMean
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> weightedMean
getFitness,
		(,) String
Attribute.WeightedMeanAndCriterionValues.criterionValuesTag (ShowS -> (String, ShowS))
-> (QuantifiedGame x y criterionValue weightedMean -> ShowS)
-> QuantifiedGame x y criterionValue weightedMean
-> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (criterionValue -> ShowS) -> [criterionValue] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
Text.ShowList.showsFormattedList' (Double -> ShowS
showsDouble (Double -> ShowS)
-> (criterionValue -> Double) -> criterionValue -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. criterionValue -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac) ([criterionValue] -> ShowS)
-> (QuantifiedGame x y criterionValue weightedMean
    -> [criterionValue])
-> QuantifiedGame x y criterionValue weightedMean
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WeightedMeanAndCriterionValues weightedMean criterionValue
-> [criterionValue]
forall weightedMean criterionValue.
WeightedMeanAndCriterionValues weightedMean criterionValue
-> [criterionValue]
Attribute.WeightedMeanAndCriterionValues.getCriterionValues (WeightedMeanAndCriterionValues weightedMean criterionValue
 -> [criterionValue])
-> (QuantifiedGame x y criterionValue weightedMean
    -> WeightedMeanAndCriterionValues weightedMean criterionValue)
-> QuantifiedGame x y criterionValue weightedMean
-> [criterionValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y criterionValue weightedMean
-> WeightedMeanAndCriterionValues weightedMean criterionValue
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean
-> WeightedMeanAndCriterionValues weightedMean criterionValue
getWeightedMeanAndCriterionValues
	 ]

instance Property.Null.Null (QuantifiedGame x y criterionValue weightedMean) where
	isNull :: QuantifiedGame x y criterionValue weightedMean -> Bool
isNull MkQuantifiedGame { getGame :: forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> 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 criterionValue weightedMean -> weightedMean
getFitness :: QuantifiedGame x y criterionValue weightedMean -> weightedMean
getFitness MkQuantifiedGame { getWeightedMeanAndCriterionValues :: forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean
-> WeightedMeanAndCriterionValues weightedMean criterionValue
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues weightedMean criterionValue
weightedMeanAndCriterionValues }	= WeightedMeanAndCriterionValues weightedMean criterionValue
-> weightedMean
forall weightedMean criterionValue.
WeightedMeanAndCriterionValues weightedMean criterionValue
-> weightedMean
Attribute.WeightedMeanAndCriterionValues.getWeightedMean WeightedMeanAndCriterionValues weightedMean criterionValue
weightedMeanAndCriterionValues

-- | Like 'fromGame' except that the caller determines the piece-square value.
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	-- ^ The value for the specified game.
	-> Model.Game.Game x y		-- ^ The current state of the /game/.
	-> 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 :: Maybe pieceSquareValue
-> Game x y
-> Reader
     criterionWeight
     pieceSquareValue
     rankValue
     x
     y
     (QuantifiedGame x y criterionValue weightedMean)
fromGame Maybe pieceSquareValue
maybePieceSquareValue Game x y
game	= Game x y
-> WeightedMeanAndCriterionValues weightedMean criterionValue
-> QuantifiedGame x y criterionValue weightedMean
forall x y criterionValue weightedMean.
Game x y
-> WeightedMeanAndCriterionValues weightedMean criterionValue
-> QuantifiedGame x y criterionValue weightedMean
MkQuantifiedGame Game x y
game (WeightedMeanAndCriterionValues weightedMean criterionValue
 -> QuantifiedGame x y criterionValue weightedMean)
-> ReaderT
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
     Identity
     (WeightedMeanAndCriterionValues weightedMean criterionValue)
-> Reader
     criterionWeight
     pieceSquareValue
     rankValue
     x
     y
     (QuantifiedGame x y criterionValue weightedMean)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe pieceSquareValue
-> Game x y
-> ReaderT
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
     Identity
     (WeightedMeanAndCriterionValues weightedMean criterionValue)
forall x y criterionValue pieceSquareValue rankValue weightedMean
       criterionWeight.
(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
-> Game x y
-> Reader
     criterionWeight
     pieceSquareValue
     rankValue
     x
     y
     (WeightedMeanAndCriterionValues weightedMean criterionValue)
Evaluation.Fitness.evaluateFitness Maybe pieceSquareValue
maybePieceSquareValue Game x y
game

-- | Retrieve the /turn/ used to generate the selected /game/.
getLastTurn :: QuantifiedGame x y criterionValue weightedMean -> Component.Turn.Turn x y
getLastTurn :: QuantifiedGame x y criterionValue weightedMean -> Turn x y
getLastTurn MkQuantifiedGame { getGame :: forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> 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 old turns from the start of the chronological sequence, leaving the most recent.
getLatestTurns
	:: Component.Move.NPlies
	-> QuantifiedGame x y criterionValue weightedMean
	-> [Component.Turn.Turn x y]
getLatestTurns :: Int -> QuantifiedGame x y criterionValue weightedMean -> [Turn x y]
getLatestTurns Int
nPlies MkQuantifiedGame { getGame :: forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> Game x y
getGame = Game x y
game }	= Int -> [Turn x y] -> [Turn x y]
forall a. Int -> [a] -> [a]
drop Int
nPlies ([Turn x y] -> [Turn x y]) -> [Turn x y] -> [Turn x y]
forall a b. (a -> b) -> a -> b
$ 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 :: Num weightedMean => QuantifiedGame x y criterionValue weightedMean -> QuantifiedGame x y criterionValue weightedMean
negateFitness :: QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
negateFitness quantifiedGame :: QuantifiedGame x y criterionValue weightedMean
quantifiedGame@MkQuantifiedGame { getWeightedMeanAndCriterionValues :: forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean
-> WeightedMeanAndCriterionValues weightedMean criterionValue
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues weightedMean criterionValue
weightedMeanAndCriterionValues }	= QuantifiedGame x y criterionValue weightedMean
quantifiedGame { getWeightedMeanAndCriterionValues :: WeightedMeanAndCriterionValues weightedMean criterionValue
getWeightedMeanAndCriterionValues = WeightedMeanAndCriterionValues weightedMean criterionValue
-> WeightedMeanAndCriterionValues weightedMean criterionValue
forall weightedMean criterionValue.
Num weightedMean =>
WeightedMeanAndCriterionValues weightedMean criterionValue
-> WeightedMeanAndCriterionValues weightedMean criterionValue
Attribute.WeightedMeanAndCriterionValues.negateWeightedMean WeightedMeanAndCriterionValues weightedMean criterionValue
weightedMeanAndCriterionValues }

-- | Compares fitness.
compareFitness
	:: Ord weightedMean
	=> QuantifiedGame x y criterionValue weightedMean
	-> QuantifiedGame x y criterionValue weightedMean
	-> Ordering
compareFitness :: QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Ordering
compareFitness	= (QuantifiedGame x y criterionValue weightedMean -> weightedMean)
-> QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing QuantifiedGame x y criterionValue weightedMean -> weightedMean
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> weightedMean
getFitness

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

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

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

-- | Reflect the interval about zero.
negateInterval :: Num weightedMean => OpenInterval x y criterionValue weightedMean -> OpenInterval x y criterionValue weightedMean
negateInterval :: OpenInterval x y criterionValue weightedMean
-> OpenInterval x y criterionValue weightedMean
negateInterval (Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlpha, Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeBeta)	= ((Maybe (QuantifiedGame x y criterionValue weightedMean)
 -> Maybe (QuantifiedGame x y criterionValue weightedMean))
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
forall a b. (a -> b) -> a -> b
$ Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeBeta) ((Maybe (QuantifiedGame x y criterionValue weightedMean)
  -> Maybe (QuantifiedGame x y criterionValue weightedMean))
 -> Maybe (QuantifiedGame x y criterionValue weightedMean))
-> ((Maybe (QuantifiedGame x y criterionValue weightedMean)
     -> Maybe (QuantifiedGame x y criterionValue weightedMean))
    -> Maybe (QuantifiedGame x y criterionValue weightedMean))
-> (Maybe (QuantifiedGame x y criterionValue weightedMean)
    -> Maybe (QuantifiedGame x y criterionValue weightedMean))
-> OpenInterval x y criterionValue weightedMean
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Maybe (QuantifiedGame x y criterionValue weightedMean)
 -> Maybe (QuantifiedGame x y criterionValue weightedMean))
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
forall a b. (a -> b) -> a -> b
$ Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlpha) ((Maybe (QuantifiedGame x y criterionValue weightedMean)
  -> Maybe (QuantifiedGame x y criterionValue weightedMean))
 -> OpenInterval x y criterionValue weightedMean)
-> (Maybe (QuantifiedGame x y criterionValue weightedMean)
    -> Maybe (QuantifiedGame x y criterionValue weightedMean))
-> OpenInterval x y criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ (QuantifiedGame x y criterionValue weightedMean
 -> QuantifiedGame x y criterionValue weightedMean)
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall weightedMean x y criterionValue.
Num weightedMean =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
negateFitness