{-
	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@]

	* Defines configurable options related to the evaluation of the game at any instance.

	* N.B.: /evaluation/ is distinct from /search/:
		evaluation => how one assesses the fitness of candidate moves;
		search => the order in which one evaluates candidates before selecting on the basis of their fitness.
-}

module BishBosh.Input.EvaluationOptions(
-- * Types
-- ** Type-synonyms
	IncrementalEvaluation,
--	PieceSquareTablePair,
	Reader,
-- ** Data-types
	EvaluationOptions(
--		MkEvaluationOptions,
		getRankValues,
		getMaximumTotalRankValue,
		getCriteriaWeights,
		getIncrementalEvaluation,
--		getMaybePieceSquareTablePair,
		getMaybePieceSquareValueByCoordinatesByRank
	),
-- * Constants
	tag,
--	incrementalEvaluationTag,
--	pieceSquareTablesTag,
--	pieceSquareTableEndGameTag,
	nPiecesBounds,
-- * Functions
--	interpolatePieceSquareValues,
--	fromPieceSquareTablePair,
-- ** Constructor
	mkEvaluationOptions
) where

import			BishBosh.Data.Bool()
import			Control.Arrow((&&&), (***))
import qualified	BishBosh.Colour.LogicalColour				as Colour.LogicalColour
import qualified	BishBosh.Component.Piece				as Component.Piece
import qualified	BishBosh.Component.PieceSquareValueByCoordinates	as Component.PieceSquareValueByCoordinates
import qualified	BishBosh.Component.PieceSquareValueByCoordinatesByRank	as Component.PieceSquareValueByCoordinatesByRank
import qualified	BishBosh.Data.Exception					as Data.Exception
import qualified	BishBosh.Input.CriteriaWeights				as Input.CriteriaWeights
import qualified	BishBosh.Input.PieceSquareTable				as Input.PieceSquareTable
import qualified	BishBosh.Input.RankValues				as Input.RankValues
import qualified	BishBosh.Property.FixedMembership			as Property.FixedMembership
import qualified	BishBosh.Property.ShowFloat				as Property.ShowFloat
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	Control.Monad.Reader
import qualified	Data.Array.IArray
import qualified	Data.Default
import qualified	Data.Foldable
import qualified	Data.Maybe
import qualified	Text.XML.HXT.Arrow.Pickle				as HXT

-- | Used to qualify XML.
tag :: String
tag :: String
tag	= String
"evaluationOptions"

-- | Used to qualify XML.
incrementalEvaluationTag :: String
incrementalEvaluationTag :: String
incrementalEvaluationTag	= String
"incrementalEvaluation"

-- | Used to qualify XML.
pieceSquareTablesTag :: String
pieceSquareTablesTag :: String
pieceSquareTablesTag	= String -> ShowS
showString String
Input.PieceSquareTable.tag String
"s"

-- | Used to qualify XML.
pieceSquareTableEndGameTag :: String
pieceSquareTableEndGameTag :: String
pieceSquareTableEndGameTag	= String -> ShowS
showString String
Input.PieceSquareTable.tag String
"EndGame"

-- | Whether to generate position-hashes incrementally from the hash of the position prior to the last move.
type IncrementalEvaluation	= Bool

-- | A pair of piece-square tables representing the opening & end-games respectively.
type PieceSquareTablePair	= (Input.PieceSquareTable.PieceSquareTable, Input.PieceSquareTable.PieceSquareTable)

-- | Defines the options related to the automatic selection of /move/s.
data EvaluationOptions	= MkEvaluationOptions {
	EvaluationOptions -> RankValues
getRankValues					:: Input.RankValues.RankValues,									-- ^ The static value associated with each /piece/'s /rank/.
	EvaluationOptions -> RankValue
getMaximumTotalRankValue			:: Type.Mass.RankValue,										-- ^ Used to normalise the total value of pieces. Derived from 'getRankValues'.
	EvaluationOptions -> CriteriaWeights
getCriteriaWeights				:: Input.CriteriaWeights.CriteriaWeights,							-- ^ The weights applied to each of the heterogeneous criterion-values used to select a /move/.
	EvaluationOptions -> IncrementalEvaluation
getIncrementalEvaluation			:: IncrementalEvaluation,									-- ^ Whether to generate position-hashes & evaluate the piece-square value, from the previous value or from scratch.
	EvaluationOptions -> Maybe PieceSquareTablePair
getMaybePieceSquareTablePair			:: Maybe PieceSquareTablePair,									-- ^ A optional pair of piece-square tables representing the opening & end-games respectively.
	EvaluationOptions -> Maybe PieceSquareValueByCoordinatesByRank
getMaybePieceSquareValueByCoordinatesByRank	:: Maybe Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank	-- ^ The optional value for each rank of /piece/, when occupying each coordinate, at each phase of the game.
}

instance Control.DeepSeq.NFData EvaluationOptions where
	rnf :: EvaluationOptions -> ()
rnf MkEvaluationOptions {
--		getRankValues					= rankValues,
		getMaximumTotalRankValue :: EvaluationOptions -> RankValue
getMaximumTotalRankValue			= RankValue
maximumTotalValue,
		getCriteriaWeights :: EvaluationOptions -> CriteriaWeights
getCriteriaWeights				= CriteriaWeights
criteriaWeights,
		getIncrementalEvaluation :: EvaluationOptions -> IncrementalEvaluation
getIncrementalEvaluation			= IncrementalEvaluation
incrementalEvaluation,
--		getMaybePieceSquareTablePair			= maybePieceSquareTablePair,
		getMaybePieceSquareValueByCoordinatesByRank :: EvaluationOptions -> Maybe PieceSquareValueByCoordinatesByRank
getMaybePieceSquareValueByCoordinatesByRank	= Maybe PieceSquareValueByCoordinatesByRank
maybePieceSquareValueByCoordinatesByRank
	} = (RankValue, CriteriaWeights, IncrementalEvaluation,
 Maybe PieceSquareValueByCoordinatesByRank)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (RankValue
maximumTotalValue, CriteriaWeights
criteriaWeights, IncrementalEvaluation
incrementalEvaluation, Maybe PieceSquareValueByCoordinatesByRank
maybePieceSquareValueByCoordinatesByRank)

instance Property.ShowFloat.ShowFloat EvaluationOptions where
	showsFloat :: (RankValue -> ShowS) -> EvaluationOptions -> ShowS
showsFloat RankValue -> ShowS
fromDouble MkEvaluationOptions {
		getRankValues :: EvaluationOptions -> RankValues
getRankValues					= RankValues
rankValues,
--		getMaximumTotalRankValue			= maximumTotalValue,
		getCriteriaWeights :: EvaluationOptions -> CriteriaWeights
getCriteriaWeights				= CriteriaWeights
criteriaWeights,
		getIncrementalEvaluation :: EvaluationOptions -> IncrementalEvaluation
getIncrementalEvaluation			= IncrementalEvaluation
incrementalEvaluation,
		getMaybePieceSquareTablePair :: EvaluationOptions -> Maybe PieceSquareTablePair
getMaybePieceSquareTablePair			= Maybe PieceSquareTablePair
maybePieceSquareTablePair
--		getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ [
		(
			String
Input.RankValues.tag,		(RankValue -> ShowS) -> RankValues -> ShowS
forall a. ShowFloat a => (RankValue -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat RankValue -> ShowS
fromDouble RankValues
rankValues
		), (
			String
incrementalEvaluationTag,	IncrementalEvaluation -> ShowS
forall a. Show a => a -> ShowS
shows IncrementalEvaluation
incrementalEvaluation
		), (
			String
Input.CriteriaWeights.tag,	(RankValue -> ShowS) -> CriteriaWeights -> ShowS
forall a. ShowFloat a => (RankValue -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat RankValue -> ShowS
fromDouble CriteriaWeights
criteriaWeights
		)
	 ] [(String, ShowS)] -> [(String, ShowS)] -> [(String, ShowS)]
forall a. [a] -> [a] -> [a]
++ [(String, ShowS)]
-> (PieceSquareTablePair -> [(String, ShowS)])
-> Maybe PieceSquareTablePair
-> [(String, ShowS)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [] (
		\(PieceSquareTable
t, PieceSquareTable
t')	-> [
			(
				String
Input.PieceSquareTable.tag,
				(RankValue -> ShowS) -> PieceSquareTable -> ShowS
forall a. ShowFloat a => (RankValue -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat RankValue -> ShowS
fromDouble PieceSquareTable
t
			), (
				String
pieceSquareTableEndGameTag,
				(RankValue -> ShowS) -> PieceSquareTable -> ShowS
forall a. ShowFloat a => (RankValue -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat RankValue -> ShowS
fromDouble PieceSquareTable
t'
			)
		]
	 ) Maybe PieceSquareTablePair
maybePieceSquareTablePair

instance Data.Default.Default EvaluationOptions where
	def :: EvaluationOptions
def = MkEvaluationOptions :: RankValues
-> RankValue
-> CriteriaWeights
-> IncrementalEvaluation
-> Maybe PieceSquareTablePair
-> Maybe PieceSquareValueByCoordinatesByRank
-> EvaluationOptions
MkEvaluationOptions {
		getRankValues :: RankValues
getRankValues					= RankValues
rankValues,
		getMaximumTotalRankValue :: RankValue
getMaximumTotalRankValue			= RankValues -> RankValue
Input.RankValues.calculateMaximumTotalValue RankValues
rankValues,
		getCriteriaWeights :: CriteriaWeights
getCriteriaWeights				= CriteriaWeights
forall a. Default a => a
Data.Default.def,
		getIncrementalEvaluation :: IncrementalEvaluation
getIncrementalEvaluation			= IncrementalEvaluation
True,
		getMaybePieceSquareTablePair :: Maybe PieceSquareTablePair
getMaybePieceSquareTablePair			= Maybe PieceSquareTablePair
forall a. Maybe a
Nothing,
		getMaybePieceSquareValueByCoordinatesByRank :: Maybe PieceSquareValueByCoordinatesByRank
getMaybePieceSquareValueByCoordinatesByRank	= Maybe PieceSquareValueByCoordinatesByRank
forall a. Maybe a
Nothing
	} where
		rankValues :: RankValues
rankValues	= RankValues
forall a. Default a => a
Data.Default.def

instance Eq EvaluationOptions where
	MkEvaluationOptions {
		getRankValues :: EvaluationOptions -> RankValues
getRankValues					= RankValues
rankValues,
--		getMaximumTotalRankValue			= maximumTotalValue,
		getCriteriaWeights :: EvaluationOptions -> CriteriaWeights
getCriteriaWeights				= CriteriaWeights
criteriaWeights,
		getIncrementalEvaluation :: EvaluationOptions -> IncrementalEvaluation
getIncrementalEvaluation			= IncrementalEvaluation
incrementalEvaluation,
		getMaybePieceSquareTablePair :: EvaluationOptions -> Maybe PieceSquareTablePair
getMaybePieceSquareTablePair			= Maybe PieceSquareTablePair
maybePieceSquareTablePair
--		getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank
	} == :: EvaluationOptions -> EvaluationOptions -> IncrementalEvaluation
== MkEvaluationOptions {
		getRankValues :: EvaluationOptions -> RankValues
getRankValues					= RankValues
rankValues',
--		getMaximumTotalRankValue			= maximumTotalValue',
		getCriteriaWeights :: EvaluationOptions -> CriteriaWeights
getCriteriaWeights				= CriteriaWeights
criteriaWeights',
		getIncrementalEvaluation :: EvaluationOptions -> IncrementalEvaluation
getIncrementalEvaluation			= IncrementalEvaluation
incrementalEvaluation',
		getMaybePieceSquareTablePair :: EvaluationOptions -> Maybe PieceSquareTablePair
getMaybePieceSquareTablePair			= Maybe PieceSquareTablePair
maybePieceSquareTablePair'
--		getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank'
	} = RankValues
rankValues RankValues -> RankValues -> IncrementalEvaluation
forall a. Eq a => a -> a -> IncrementalEvaluation
== RankValues
rankValues' IncrementalEvaluation
-> IncrementalEvaluation -> IncrementalEvaluation
&& CriteriaWeights
criteriaWeights CriteriaWeights -> CriteriaWeights -> IncrementalEvaluation
forall a. Eq a => a -> a -> IncrementalEvaluation
== CriteriaWeights
criteriaWeights' IncrementalEvaluation
-> IncrementalEvaluation -> IncrementalEvaluation
&& IncrementalEvaluation
incrementalEvaluation IncrementalEvaluation
-> IncrementalEvaluation -> IncrementalEvaluation
forall a. Eq a => a -> a -> IncrementalEvaluation
== IncrementalEvaluation
incrementalEvaluation' IncrementalEvaluation
-> IncrementalEvaluation -> IncrementalEvaluation
&& Maybe PieceSquareTablePair
maybePieceSquareTablePair Maybe PieceSquareTablePair
-> Maybe PieceSquareTablePair -> IncrementalEvaluation
forall a. Eq a => a -> a -> IncrementalEvaluation
== Maybe PieceSquareTablePair
maybePieceSquareTablePair'

instance HXT.XmlPickler EvaluationOptions where
	xpickle :: PU EvaluationOptions
xpickle	= EvaluationOptions -> PU EvaluationOptions -> PU EvaluationOptions
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault EvaluationOptions
def (PU EvaluationOptions -> PU EvaluationOptions)
-> (PU PieceSquareTablePair -> PU EvaluationOptions)
-> PU PieceSquareTablePair
-> PU EvaluationOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU EvaluationOptions -> PU EvaluationOptions
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU EvaluationOptions -> PU EvaluationOptions)
-> (PU PieceSquareTablePair -> PU EvaluationOptions)
-> PU PieceSquareTablePair
-> PU EvaluationOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RankValues, CriteriaWeights, IncrementalEvaluation,
  Maybe PieceSquareTablePair)
 -> EvaluationOptions,
 EvaluationOptions
 -> (RankValues, CriteriaWeights, IncrementalEvaluation,
     Maybe PieceSquareTablePair))
-> PU
     (RankValues, CriteriaWeights, IncrementalEvaluation,
      Maybe PieceSquareTablePair)
-> PU EvaluationOptions
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(RankValues
a, CriteriaWeights
b, IncrementalEvaluation
c, Maybe PieceSquareTablePair
d) -> RankValues
-> CriteriaWeights
-> IncrementalEvaluation
-> Maybe PieceSquareTablePair
-> EvaluationOptions
mkEvaluationOptions RankValues
a CriteriaWeights
b IncrementalEvaluation
c Maybe PieceSquareTablePair
d,	-- Construct.
		\MkEvaluationOptions {
			getRankValues :: EvaluationOptions -> RankValues
getRankValues					= RankValues
rankValues,
--			getMaximumTotalRankValue			= maximumTotalRankValue,
			getCriteriaWeights :: EvaluationOptions -> CriteriaWeights
getCriteriaWeights				= CriteriaWeights
criteriaWeights,
			getIncrementalEvaluation :: EvaluationOptions -> IncrementalEvaluation
getIncrementalEvaluation			= IncrementalEvaluation
incrementalEvaluation,
			getMaybePieceSquareTablePair :: EvaluationOptions -> Maybe PieceSquareTablePair
getMaybePieceSquareTablePair			= Maybe PieceSquareTablePair
maybePieceSquareTablePair
--			getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank
		} -> (
			RankValues
rankValues,
			CriteriaWeights
criteriaWeights,
			IncrementalEvaluation
incrementalEvaluation,
			Maybe PieceSquareTablePair
maybePieceSquareTablePair
		) -- Deconstruct.
	 ) (PU
   (RankValues, CriteriaWeights, IncrementalEvaluation,
    Maybe PieceSquareTablePair)
 -> PU EvaluationOptions)
-> (PU PieceSquareTablePair
    -> PU
         (RankValues, CriteriaWeights, IncrementalEvaluation,
          Maybe PieceSquareTablePair))
-> PU PieceSquareTablePair
-> PU EvaluationOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU RankValues
-> PU CriteriaWeights
-> PU IncrementalEvaluation
-> PU (Maybe PieceSquareTablePair)
-> PU
     (RankValues, CriteriaWeights, IncrementalEvaluation,
      Maybe PieceSquareTablePair)
forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
HXT.xp4Tuple PU RankValues
forall a. XmlPickler a => PU a
HXT.xpickle {-RankValues-} PU CriteriaWeights
forall a. XmlPickler a => PU a
HXT.xpickle {-CriteriaWeights-} (
		EvaluationOptions -> IncrementalEvaluation
getIncrementalEvaluation EvaluationOptions
def IncrementalEvaluation
-> PU IncrementalEvaluation -> PU IncrementalEvaluation
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU IncrementalEvaluation -> PU IncrementalEvaluation
forall a. String -> PU a -> PU a
HXT.xpAttr String
incrementalEvaluationTag PU IncrementalEvaluation
forall a. XmlPickler a => PU a
HXT.xpickle {-Bool-}
	 ) (PU (Maybe PieceSquareTablePair)
 -> PU
      (RankValues, CriteriaWeights, IncrementalEvaluation,
       Maybe PieceSquareTablePair))
-> (PU PieceSquareTablePair -> PU (Maybe PieceSquareTablePair))
-> PU PieceSquareTablePair
-> PU
     (RankValues, CriteriaWeights, IncrementalEvaluation,
      Maybe PieceSquareTablePair)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU PieceSquareTablePair -> PU (Maybe PieceSquareTablePair)
forall a. PU a -> PU (Maybe a)
HXT.xpOption (PU PieceSquareTablePair -> PU (Maybe PieceSquareTablePair))
-> (PU PieceSquareTablePair -> PU PieceSquareTablePair)
-> PU PieceSquareTablePair
-> PU (Maybe PieceSquareTablePair)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU PieceSquareTablePair -> PU PieceSquareTablePair
forall a. String -> PU a -> PU a
HXT.xpElem String
pieceSquareTablesTag (PU PieceSquareTablePair -> PU EvaluationOptions)
-> PU PieceSquareTablePair -> PU EvaluationOptions
forall a b. (a -> b) -> a -> b
$ String -> PU PieceSquareTable -> PU PieceSquareTable
forall a. String -> PU a -> PU a
HXT.xpElem String
Input.PieceSquareTable.tag PU PieceSquareTable
forall a. XmlPickler a => PU a
HXT.xpickle PU PieceSquareTable
-> PU PieceSquareTable -> PU PieceSquareTablePair
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` String -> PU PieceSquareTable -> PU PieceSquareTable
forall a. String -> PU a -> PU a
HXT.xpElem String
pieceSquareTableEndGameTag PU PieceSquareTable
forall a. XmlPickler a => PU a
HXT.xpickle where
		def :: EvaluationOptions
def	= EvaluationOptions
forall a. Default a => a
Data.Default.def

instance Show EvaluationOptions where
	showsPrec :: Int -> EvaluationOptions -> ShowS
showsPrec Int
precedence MkEvaluationOptions {
		getRankValues :: EvaluationOptions -> RankValues
getRankValues					= RankValues
rankValues,
--		getMaximumTotalRankValue			= maximumTotalRankValue,
		getCriteriaWeights :: EvaluationOptions -> CriteriaWeights
getCriteriaWeights				= CriteriaWeights
criteriaWeights,
		getIncrementalEvaluation :: EvaluationOptions -> IncrementalEvaluation
getIncrementalEvaluation			= IncrementalEvaluation
incrementalEvaluation,
		getMaybePieceSquareTablePair :: EvaluationOptions -> Maybe PieceSquareTablePair
getMaybePieceSquareTablePair			= Maybe PieceSquareTablePair
maybePieceSquareTablePair
--		getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank
	} = Int
-> (RankValues, CriteriaWeights, IncrementalEvaluation,
    Maybe PieceSquareTablePair)
-> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence (RankValues
rankValues, CriteriaWeights
criteriaWeights, IncrementalEvaluation
incrementalEvaluation, Maybe PieceSquareTablePair
maybePieceSquareTablePair)

-- | The constant bounds of the number of pieces on the board, at the end-game & opening-game respectively.
nPiecesBounds :: (Type.Count.NPieces, Type.Count.NPieces)
nPiecesBounds :: (Int, Int)
nPiecesBounds	= (
	Int
3 {-minimum sufficient material-},
	Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Colour.LogicalColour.nDistinctLogicalColours Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
Component.Piece.nPiecesPerSide
 )

-- | Given the bounds over which a piece-square value varies, as the game progresses from opening to end, return the linearly interpolated value for the specified stage.
interpolatePieceSquareValues
	:: Type.Count.NPieces						-- ^ The value to interpolate.
	-> (Type.Mass.PieceSquareValue, Type.Mass.PieceSquareValue)	-- ^ (Opening-game, End-game) values.
	-> Type.Mass.PieceSquareValue
interpolatePieceSquareValues :: Int -> (RankValue, RankValue) -> RankValue
interpolatePieceSquareValues Int
nPieces (RankValue
openingGame, RankValue
endGame)	= Rational -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> RankValue)
-> (Rational -> Rational) -> Rational -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational)
-> (Rational, Rational) -> Rational
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+) ((Rational, Rational) -> Rational)
-> (Rational -> (Rational, Rational)) -> Rational -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	(Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* RankValue -> Rational
forall a. Real a => a -> Rational
toRational RankValue
openingGame) (Rational -> Rational)
-> (Rational -> Rational) -> Rational -> (Rational, Rational)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* RankValue -> Rational
forall a. Real a => a -> Rational
toRational RankValue
endGame) (Rational -> Rational)
-> (Rational -> Rational) -> Rational -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-)	-- N.B.: arithmetic must be conducted in an unbounded type, instead of 'PieceSquareValue'.
 ) (Rational -> RankValue) -> Rational -> RankValue
forall a b. (a -> b) -> a -> b
$ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (
	Int
nPieces Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Int) -> Int
forall a b. (a, b) -> a
fst {-minimum-} (Int, Int)
nPiecesBounds
 ) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (
	(Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract (Int, Int)
nPiecesBounds	-- N.B.: this can't reasonably be zero.
 )

-- | Derive 'PieceSquareValueByCoordinatesByRank'.
fromPieceSquareTablePair :: PieceSquareTablePair -> Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank
fromPieceSquareTablePair :: PieceSquareTablePair -> PieceSquareValueByCoordinatesByRank
fromPieceSquareTablePair PieceSquareTablePair
pieceSquareTablePair	= (Rank -> PieceSquareValueByCoordinatesByEitherNPieces)
-> PieceSquareValueByCoordinatesByRank
Component.PieceSquareValueByCoordinatesByRank.mkPieceSquareValueByCoordinatesByRank ((Rank -> PieceSquareValueByCoordinatesByEitherNPieces)
 -> PieceSquareValueByCoordinatesByRank)
-> (Rank -> PieceSquareValueByCoordinatesByEitherNPieces)
-> PieceSquareValueByCoordinatesByRank
forall a b. (a -> b) -> a -> b
$ \Rank
rank -> (
	\(PieceSquareValueByCoordinates
openingGamePieceSquareValueByCoordinates, Maybe PieceSquareValueByCoordinates
maybeEndGamePieceSquareValueByCoordinates) -> PieceSquareValueByCoordinatesByEitherNPieces
-> (PieceSquareValueByCoordinates
    -> PieceSquareValueByCoordinatesByEitherNPieces)
-> Maybe PieceSquareValueByCoordinates
-> PieceSquareValueByCoordinatesByEitherNPieces
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
		PieceSquareValueByCoordinates
-> PieceSquareValueByCoordinatesByEitherNPieces
forall a b. a -> Either a b
Left PieceSquareValueByCoordinates
openingGamePieceSquareValueByCoordinates	-- There's only one value for this rank, so no interpolation is required.
	) (
		\PieceSquareValueByCoordinates
endGamePieceSquareValueByCoordinates -> Array Int PieceSquareValueByCoordinates
-> PieceSquareValueByCoordinatesByEitherNPieces
forall a b. b -> Either a b
Right (Array Int PieceSquareValueByCoordinates
 -> PieceSquareValueByCoordinatesByEitherNPieces)
-> Array Int PieceSquareValueByCoordinates
-> PieceSquareValueByCoordinatesByEitherNPieces
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> [PieceSquareValueByCoordinates]
-> Array Int PieceSquareValueByCoordinates
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Int, Int)
nPiecesBounds (
			(Int -> PieceSquareValueByCoordinates)
-> [Int] -> [PieceSquareValueByCoordinates]
forall a b. (a -> b) -> [a] -> [b]
map (
				\Int
nPieces -> [RankValue] -> PieceSquareValueByCoordinates
Component.PieceSquareValueByCoordinates.fromList ([RankValue] -> PieceSquareValueByCoordinates)
-> [RankValue] -> PieceSquareValueByCoordinates
forall a b. (a -> b) -> a -> b
$ (Coordinates -> RankValue) -> [Coordinates] -> [RankValue]
forall a b. (a -> b) -> [a] -> [b]
map (
					Int -> (RankValue, RankValue) -> RankValue
interpolatePieceSquareValues Int
nPieces ((RankValue, RankValue) -> RankValue)
-> (Coordinates -> (RankValue, RankValue))
-> Coordinates
-> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates -> RankValue)
 -> (Coordinates -> RankValue)
 -> Coordinates
 -> (RankValue, RankValue))
-> (Coordinates -> RankValue, Coordinates -> RankValue)
-> Coordinates
-> (RankValue, RankValue)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Coordinates -> RankValue)
-> (Coordinates -> RankValue)
-> Coordinates
-> (RankValue, RankValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (
						((PieceSquareValueByCoordinates -> Coordinates -> RankValue)
-> PieceSquareValueByCoordinates -> Coordinates -> RankValue
forall a b. (a -> b) -> a -> b
$ PieceSquareValueByCoordinates
openingGamePieceSquareValueByCoordinates) ((PieceSquareValueByCoordinates -> Coordinates -> RankValue)
 -> Coordinates -> RankValue)
-> ((PieceSquareValueByCoordinates -> Coordinates -> RankValue)
    -> Coordinates -> RankValue)
-> (PieceSquareValueByCoordinates -> Coordinates -> RankValue)
-> (Coordinates -> RankValue, Coordinates -> RankValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((PieceSquareValueByCoordinates -> Coordinates -> RankValue)
-> PieceSquareValueByCoordinates -> Coordinates -> RankValue
forall a b. (a -> b) -> a -> b
$ PieceSquareValueByCoordinates
endGamePieceSquareValueByCoordinates) ((PieceSquareValueByCoordinates -> Coordinates -> RankValue)
 -> (Coordinates -> RankValue, Coordinates -> RankValue))
-> (PieceSquareValueByCoordinates -> Coordinates -> RankValue)
-> (Coordinates -> RankValue, Coordinates -> RankValue)
forall a b. (a -> b) -> a -> b
$ PieceSquareValueByCoordinates -> Coordinates -> RankValue
Component.PieceSquareValueByCoordinates.dereference
					)
				) [Coordinates]
forall a. FixedMembership a => [a]
Property.FixedMembership.members	-- Coordinates.
			) ([Int] -> [PieceSquareValueByCoordinates])
-> [Int] -> [PieceSquareValueByCoordinates]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> [Int]) -> (Int, Int) -> [Int]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo (Int, Int)
nPiecesBounds
		 )
	) Maybe PieceSquareValueByCoordinates
maybeEndGamePieceSquareValueByCoordinates
 ) ((PieceSquareValueByCoordinates,
  Maybe PieceSquareValueByCoordinates)
 -> PieceSquareValueByCoordinatesByEitherNPieces)
-> (PieceSquareValueByCoordinates,
    Maybe PieceSquareValueByCoordinates)
-> PieceSquareValueByCoordinatesByEitherNPieces
forall a b. (a -> b) -> a -> b
$ (
	((PieceSquareTable -> PieceSquareValueByCoordinates)
 -> (PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
 -> PieceSquareTablePair
 -> (PieceSquareValueByCoordinates,
     Maybe PieceSquareValueByCoordinates))
-> (PieceSquareTable -> PieceSquareValueByCoordinates,
    PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
-> PieceSquareTablePair
-> (PieceSquareValueByCoordinates,
    Maybe PieceSquareValueByCoordinates)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (PieceSquareTable -> PieceSquareValueByCoordinates)
-> (PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
-> PieceSquareTablePair
-> (PieceSquareValueByCoordinates,
    Maybe PieceSquareValueByCoordinates)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) ((PieceSquareTable -> PieceSquareValueByCoordinates,
  PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
 -> PieceSquareTablePair
 -> (PieceSquareValueByCoordinates,
     Maybe PieceSquareValueByCoordinates))
-> ((PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
    -> (PieceSquareTable -> PieceSquareValueByCoordinates,
        PieceSquareTable -> Maybe PieceSquareValueByCoordinates))
-> (PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
-> PieceSquareTablePair
-> (PieceSquareValueByCoordinates,
    Maybe PieceSquareValueByCoordinates)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		(Maybe PieceSquareValueByCoordinates
 -> PieceSquareValueByCoordinates)
-> (PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
-> PieceSquareTable
-> PieceSquareValueByCoordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Maybe PieceSquareValueByCoordinates
-> PieceSquareValueByCoordinates
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust {-all ranks must be defined for the openingGame-} ((PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
 -> PieceSquareTable -> PieceSquareValueByCoordinates)
-> ((PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
    -> PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
-> (PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
-> (PieceSquareTable -> PieceSquareValueByCoordinates,
    PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
-> PieceSquareTable -> Maybe PieceSquareValueByCoordinates
forall a. a -> a
id
	) ((PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
 -> PieceSquareTablePair
 -> (PieceSquareValueByCoordinates,
     Maybe PieceSquareValueByCoordinates))
-> (PieceSquareTable -> Maybe PieceSquareValueByCoordinates)
-> PieceSquareTablePair
-> (PieceSquareValueByCoordinates,
    Maybe PieceSquareValueByCoordinates)
forall a b. (a -> b) -> a -> b
$ Rank -> PieceSquareTable -> Maybe PieceSquareValueByCoordinates
Input.PieceSquareTable.findPieceSquareValueByCoordinates Rank
rank
 ) PieceSquareTablePair
pieceSquareTablePair

-- | Smart constructor.
mkEvaluationOptions
	:: Input.RankValues.RankValues			-- ^ The static value associated with each /piece/'s /rank/.
	-> Input.CriteriaWeights.CriteriaWeights	-- ^ The weights applied to the values of the criteria used to select a /move/.
	-> IncrementalEvaluation
	-> Maybe PieceSquareTablePair			-- ^ The value to each type of piece, of each square, during normal play & the end-game.
	-> EvaluationOptions
mkEvaluationOptions :: RankValues
-> CriteriaWeights
-> IncrementalEvaluation
-> Maybe PieceSquareTablePair
-> EvaluationOptions
mkEvaluationOptions RankValues
rankValues CriteriaWeights
criteriaWeights IncrementalEvaluation
incrementalEvaluation Maybe PieceSquareTablePair
maybePieceSquareTablePair
	| Just (PieceSquareTable
pieceSquareTable, PieceSquareTable
_)	<- Maybe PieceSquareTablePair
maybePieceSquareTablePair
	, let undefinedRanks :: Set Rank
undefinedRanks	= PieceSquareTable -> Set Rank
Input.PieceSquareTable.findUndefinedRanks PieceSquareTable
pieceSquareTable
	, IncrementalEvaluation -> IncrementalEvaluation
not (IncrementalEvaluation -> IncrementalEvaluation)
-> IncrementalEvaluation -> IncrementalEvaluation
forall a b. (a -> b) -> a -> b
$ Set Rank -> IncrementalEvaluation
forall (t :: * -> *) a. Foldable t => t a -> IncrementalEvaluation
Data.Foldable.null Set Rank
undefinedRanks
	= Exception -> EvaluationOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> EvaluationOptions)
-> (String -> Exception) -> String -> EvaluationOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInsufficientData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.EvaluationOptions.mkEvaluationOptions:\tranks" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> EvaluationOptions) -> String -> EvaluationOptions
forall a b. (a -> b) -> a -> b
$ [Rank] -> ShowS
forall a. Show a => a -> ShowS
shows (Set Rank -> [Rank]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Set Rank
undefinedRanks) String
" are undefined."
	| CriteriaWeights -> CriterionWeight
Input.CriteriaWeights.getWeightOfPieceSquareValue CriteriaWeights
criteriaWeights CriterionWeight -> CriterionWeight -> IncrementalEvaluation
forall a. Eq a => a -> a -> IncrementalEvaluation
/= CriterionWeight
forall a. Bounded a => a
minBound
	, Maybe PieceSquareTablePair -> IncrementalEvaluation
forall a. Maybe a -> IncrementalEvaluation
Data.Maybe.isNothing Maybe PieceSquareTablePair
maybePieceSquareTablePair
	= Exception -> EvaluationOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> EvaluationOptions)
-> (String -> Exception) -> String -> EvaluationOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.EvaluationOptions.mkEvaluationOptions:\tweight of " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
Input.CriteriaWeights.weightOfPieceSquareValueTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" is defined but " (String -> EvaluationOptions) -> String -> EvaluationOptions
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
Input.PieceSquareTable.tag String
" isn't."
	| RankValue
maximumTotalRankValue RankValue -> RankValue -> IncrementalEvaluation
forall a. Eq a => a -> a -> IncrementalEvaluation
== RankValue
0 IncrementalEvaluation
-> IncrementalEvaluation -> IncrementalEvaluation
&& CriteriaWeights -> CriterionWeight
Input.CriteriaWeights.getWeightOfMaterial CriteriaWeights
criteriaWeights CriterionWeight -> CriterionWeight -> IncrementalEvaluation
forall a. Eq a => a -> a -> IncrementalEvaluation
/= CriterionWeight
0	= Exception -> EvaluationOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> EvaluationOptions)
-> (String -> Exception) -> String -> EvaluationOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.EvaluationOptions.mkEvaluationOptions:\tweight of " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
Input.CriteriaWeights.weightOfMaterialTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" is non-zero, but the maximum total rank-value is " (String -> EvaluationOptions) -> String -> EvaluationOptions
forall a b. (a -> b) -> a -> b
$ RankValues -> ShowS
forall a. Show a => a -> ShowS
shows RankValues
rankValues String
"."
	| IncrementalEvaluation
otherwise		= MkEvaluationOptions :: RankValues
-> RankValue
-> CriteriaWeights
-> IncrementalEvaluation
-> Maybe PieceSquareTablePair
-> Maybe PieceSquareValueByCoordinatesByRank
-> EvaluationOptions
MkEvaluationOptions {
		getRankValues :: RankValues
getRankValues					= RankValues
rankValues,
		getMaximumTotalRankValue :: RankValue
getMaximumTotalRankValue			= RankValue
maximumTotalRankValue,
		getCriteriaWeights :: CriteriaWeights
getCriteriaWeights				= CriteriaWeights
criteriaWeights,
		getIncrementalEvaluation :: IncrementalEvaluation
getIncrementalEvaluation			= IncrementalEvaluation
incrementalEvaluation,
		getMaybePieceSquareTablePair :: Maybe PieceSquareTablePair
getMaybePieceSquareTablePair			= Maybe PieceSquareTablePair
maybePieceSquareTablePair,
		getMaybePieceSquareValueByCoordinatesByRank :: Maybe PieceSquareValueByCoordinatesByRank
getMaybePieceSquareValueByCoordinatesByRank	= PieceSquareTablePair -> PieceSquareValueByCoordinatesByRank
fromPieceSquareTablePair (PieceSquareTablePair -> PieceSquareValueByCoordinatesByRank)
-> Maybe PieceSquareTablePair
-> Maybe PieceSquareValueByCoordinatesByRank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PieceSquareTablePair
maybePieceSquareTablePair	-- Infer.
	} where
		maximumTotalRankValue :: RankValue
maximumTotalRankValue	= RankValues -> RankValue
Input.RankValues.calculateMaximumTotalValue RankValues
rankValues

-- | Self-documentation.
type Reader	= Control.Monad.Reader.Reader EvaluationOptions