{-
	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,
	Reader,
-- ** Data-types
	EvaluationOptions(
--		MkEvaluationOptions,
		getRankValues,
		getCriteriaWeights,
		getIncrementalEvaluation,
--		getMaybePieceSquareTables,
		getMaybePieceSquareArray
	),
-- * Constants
	tag,
--	incrementalEvaluationTag,
--	pieceSquareTablesTag,
--	pieceSquareTableEndGameTag,
-- * Functions
-- ** Constructor
	mkEvaluationOptions
) where

import			BishBosh.Data.Bool()
import			Control.Arrow((&&&), (***))
import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour
import qualified	BishBosh.Attribute.RankValues		as Attribute.RankValues
import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates
import qualified	BishBosh.Component.Piece		as Component.Piece
import qualified	BishBosh.Component.PieceSquareArray	as Component.PieceSquareArray
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.Property.ShowFloat		as Property.ShowFloat
import qualified	BishBosh.Text.ShowList			as Text.ShowList
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.Maybe
import qualified	Data.Set
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

-- | Defines the options related to the automatic selection of /move/s.
data EvaluationOptions criterionWeight pieceSquareValue rankValue x y	= MkEvaluationOptions {
	EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> RankValues rankValue
getRankValues			:: Attribute.RankValues.RankValues rankValue,			-- ^ The static value associated with each /piece/'s /rank/.
	EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> CriteriaWeights criterionWeight
getCriteriaWeights		:: Input.CriteriaWeights.CriteriaWeights criterionWeight,	-- ^ The weights applied to each of the heterogeneous criterion-values used to select a /move/.
	EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
getIncrementalEvaluation	:: IncrementalEvaluation,					-- ^ Whether to generate position-hashes & evaluate the piece-square value, from the previous value or from scratch.
	EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> Maybe
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
getMaybePieceSquareTables	:: Maybe (
		Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue,
		Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue
	),												-- ^ Optional piece-square tables; the first governs normal play & the second governs the end-game.
	EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> Maybe (PieceSquareArray x y pieceSquareValue)
getMaybePieceSquareArray	:: Maybe (
		Component.PieceSquareArray.PieceSquareArray x y pieceSquareValue
	)												-- ^ The optional value for each type of /piece/ of occupying each coordinate, at each stage in the lifetime of the game.
} deriving (EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
(EvaluationOptions criterionWeight pieceSquareValue rankValue x y
 -> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
 -> IncrementalEvaluation)
-> (EvaluationOptions
      criterionWeight pieceSquareValue rankValue x y
    -> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
    -> IncrementalEvaluation)
-> Eq
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
forall a.
(a -> a -> IncrementalEvaluation)
-> (a -> a -> IncrementalEvaluation) -> Eq a
forall criterionWeight pieceSquareValue rankValue x y.
(Enum x, Enum y, Ord x, Ord y, Eq rankValue, Eq criterionWeight,
 Eq pieceSquareValue) =>
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
/= :: EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
$c/= :: forall criterionWeight pieceSquareValue rankValue x y.
(Enum x, Enum y, Ord x, Ord y, Eq rankValue, Eq criterionWeight,
 Eq pieceSquareValue) =>
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
== :: EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
$c== :: forall criterionWeight pieceSquareValue rankValue x y.
(Enum x, Enum y, Ord x, Ord y, Eq rankValue, Eq criterionWeight,
 Eq pieceSquareValue) =>
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
Eq, Int
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> ShowS
[EvaluationOptions criterionWeight pieceSquareValue rankValue x y]
-> ShowS
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> String
(Int
 -> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
 -> ShowS)
-> (EvaluationOptions
      criterionWeight pieceSquareValue rankValue x y
    -> String)
-> ([EvaluationOptions
       criterionWeight pieceSquareValue rankValue x y]
    -> ShowS)
-> Show
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall criterionWeight pieceSquareValue rankValue x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue) =>
Int
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> ShowS
forall criterionWeight pieceSquareValue rankValue x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue) =>
[EvaluationOptions criterionWeight pieceSquareValue rankValue x y]
-> ShowS
forall criterionWeight pieceSquareValue rankValue x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue) =>
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> String
showList :: [EvaluationOptions criterionWeight pieceSquareValue rankValue x y]
-> ShowS
$cshowList :: forall criterionWeight pieceSquareValue rankValue x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue) =>
[EvaluationOptions criterionWeight pieceSquareValue rankValue x y]
-> ShowS
show :: EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> String
$cshow :: forall criterionWeight pieceSquareValue rankValue x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue) =>
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> String
showsPrec :: Int
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> ShowS
$cshowsPrec :: forall criterionWeight pieceSquareValue rankValue x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue) =>
Int
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> ShowS
Show)

instance (
	Control.DeepSeq.NFData	criterionWeight,
	Control.DeepSeq.NFData	pieceSquareValue,
	Control.DeepSeq.NFData	rankValue,
	Control.DeepSeq.NFData	x,
	Control.DeepSeq.NFData	y
 ) => Control.DeepSeq.NFData (EvaluationOptions criterionWeight pieceSquareValue rankValue x y) where
	rnf :: EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> ()
rnf MkEvaluationOptions {
		getRankValues :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> RankValues rankValue
getRankValues			= RankValues rankValue
rankValues,
		getCriteriaWeights :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> CriteriaWeights criterionWeight
getCriteriaWeights		= CriteriaWeights criterionWeight
criteriaWeights,
		getIncrementalEvaluation :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
getIncrementalEvaluation	= IncrementalEvaluation
incrementalEvaluation,
--		getMaybePieceSquareTables	= maybePieceSquareTables,
		getMaybePieceSquareArray :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> Maybe (PieceSquareArray x y pieceSquareValue)
getMaybePieceSquareArray	= Maybe (PieceSquareArray x y pieceSquareValue)
maybePieceSquareArray
	} = (RankValues rankValue, CriteriaWeights criterionWeight,
 IncrementalEvaluation,
 Maybe (PieceSquareArray x y pieceSquareValue))
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (RankValues rankValue
rankValues, CriteriaWeights criterionWeight
criteriaWeights, IncrementalEvaluation
incrementalEvaluation, Maybe (PieceSquareArray x y pieceSquareValue)
maybePieceSquareArray)

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Real	criterionWeight,
	Real	pieceSquareValue,
	Real	rankValue,
	Show	pieceSquareValue
 ) => Property.ShowFloat.ShowFloat (EvaluationOptions criterionWeight pieceSquareValue rankValue x y) where
	showsFloat :: (Double -> ShowS)
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> ShowS
showsFloat Double -> ShowS
fromDouble MkEvaluationOptions {
		getRankValues :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> RankValues rankValue
getRankValues			= RankValues rankValue
rankValues,
		getCriteriaWeights :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> CriteriaWeights criterionWeight
getCriteriaWeights		= CriteriaWeights criterionWeight
criteriaWeights,
		getIncrementalEvaluation :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
getIncrementalEvaluation	= IncrementalEvaluation
incrementalEvaluation,
		getMaybePieceSquareTables :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> Maybe
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
getMaybePieceSquareTables	= Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
maybePieceSquareTables
--		getMaybePieceSquareArray	= maybePieceSquareArray
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ [
		(
			String
Attribute.RankValues.tag,	(Double -> ShowS) -> RankValues rankValue -> ShowS
forall a. ShowFloat a => (Double -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat Double -> ShowS
fromDouble RankValues rankValue
rankValues
		), (
			String
incrementalEvaluationTag,	IncrementalEvaluation -> ShowS
forall a. Show a => a -> ShowS
shows IncrementalEvaluation
incrementalEvaluation
		), (
			String
Input.CriteriaWeights.tag,	(Double -> ShowS) -> CriteriaWeights criterionWeight -> ShowS
forall a. ShowFloat a => (Double -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat Double -> ShowS
fromDouble CriteriaWeights criterionWeight
criteriaWeights
		)
	 ] [(String, ShowS)] -> [(String, ShowS)] -> [(String, ShowS)]
forall a. [a] -> [a] -> [a]
++ [(String, ShowS)]
-> ((PieceSquareTable x y pieceSquareValue,
     PieceSquareTable x y pieceSquareValue)
    -> [(String, ShowS)])
-> Maybe
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> [(String, ShowS)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [] (
		\(PieceSquareTable x y pieceSquareValue
t, PieceSquareTable x y pieceSquareValue
t')	-> [
			(
				String
Input.PieceSquareTable.tag,
				(Double -> ShowS) -> PieceSquareTable x y pieceSquareValue -> ShowS
forall a. ShowFloat a => (Double -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat Double -> ShowS
fromDouble PieceSquareTable x y pieceSquareValue
t
			), (
				String
pieceSquareTableEndGameTag,
				(Double -> ShowS) -> PieceSquareTable x y pieceSquareValue -> ShowS
forall a. ShowFloat a => (Double -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat Double -> ShowS
fromDouble PieceSquareTable x y pieceSquareValue
t'
			)
		]
	 ) Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
maybePieceSquareTables

instance (
	Fractional	rankValue,
	Num		criterionWeight,
	Ord		rankValue,
	Show		rankValue
 ) => Data.Default.Default (EvaluationOptions criterionWeight pieceSquareValue rankValue x y) where
	def :: EvaluationOptions criterionWeight pieceSquareValue rankValue x y
def = MkEvaluationOptions :: forall criterionWeight pieceSquareValue rankValue x y.
RankValues rankValue
-> CriteriaWeights criterionWeight
-> IncrementalEvaluation
-> Maybe
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> Maybe (PieceSquareArray x y pieceSquareValue)
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
MkEvaluationOptions {
		getRankValues :: RankValues rankValue
getRankValues			= RankValues rankValue
forall a. Default a => a
Data.Default.def,
		getCriteriaWeights :: CriteriaWeights criterionWeight
getCriteriaWeights		= CriteriaWeights criterionWeight
forall a. Default a => a
Data.Default.def,
		getIncrementalEvaluation :: IncrementalEvaluation
getIncrementalEvaluation	= IncrementalEvaluation
True,
		getMaybePieceSquareTables :: Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
getMaybePieceSquareTables	= Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
forall a. Maybe a
Nothing,
		getMaybePieceSquareArray :: Maybe (PieceSquareArray x y pieceSquareValue)
getMaybePieceSquareArray	= Maybe (PieceSquareArray x y pieceSquareValue)
forall a. Maybe a
Nothing
	}

instance (
	Enum		x,
	Enum		y,
	Fractional	pieceSquareValue,
	Fractional	rankValue,
	HXT.XmlPickler	criterionWeight,
	HXT.XmlPickler	rankValue,
	Num		criterionWeight,
	Ord		criterionWeight,
	Ord		pieceSquareValue,
	Ord		rankValue,
	Ord		x,
	Ord		y,
	Real		pieceSquareValue,
	Show		pieceSquareValue,
	Show		criterionWeight,
	Show		rankValue
 ) => HXT.XmlPickler (EvaluationOptions criterionWeight pieceSquareValue rankValue x y) where
	xpickle :: PU
  (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
xpickle	= EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> PU
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
-> PU
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault EvaluationOptions criterionWeight pieceSquareValue rankValue x y
def (PU
   (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
 -> PU
      (EvaluationOptions criterionWeight pieceSquareValue rankValue x y))
-> (PU
      (PieceSquareTable x y pieceSquareValue,
       PieceSquareTable x y pieceSquareValue)
    -> PU
         (EvaluationOptions criterionWeight pieceSquareValue rankValue x y))
-> PU
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> PU
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> PU
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
-> PU
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU
   (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
 -> PU
      (EvaluationOptions criterionWeight pieceSquareValue rankValue x y))
-> (PU
      (PieceSquareTable x y pieceSquareValue,
       PieceSquareTable x y pieceSquareValue)
    -> PU
         (EvaluationOptions criterionWeight pieceSquareValue rankValue x y))
-> PU
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> PU
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RankValues rankValue, CriteriaWeights criterionWeight,
  IncrementalEvaluation,
  Maybe
    (PieceSquareTable x y pieceSquareValue,
     PieceSquareTable x y pieceSquareValue))
 -> EvaluationOptions
      criterionWeight pieceSquareValue rankValue x y,
 EvaluationOptions criterionWeight pieceSquareValue rankValue x y
 -> (RankValues rankValue, CriteriaWeights criterionWeight,
     IncrementalEvaluation,
     Maybe
       (PieceSquareTable x y pieceSquareValue,
        PieceSquareTable x y pieceSquareValue)))
-> PU
     (RankValues rankValue, CriteriaWeights criterionWeight,
      IncrementalEvaluation,
      Maybe
        (PieceSquareTable x y pieceSquareValue,
         PieceSquareTable x y pieceSquareValue))
-> PU
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(RankValues rankValue
a, CriteriaWeights criterionWeight
b, IncrementalEvaluation
c, Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
d) -> RankValues rankValue
-> CriteriaWeights criterionWeight
-> IncrementalEvaluation
-> Maybe
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
forall x y pieceSquareValue criterionWeight rankValue.
(Enum x, Enum y, Eq pieceSquareValue, Eq criterionWeight,
 Fractional pieceSquareValue, Num criterionWeight, Ord x, Ord y) =>
RankValues rankValue
-> CriteriaWeights criterionWeight
-> IncrementalEvaluation
-> Maybe
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
mkEvaluationOptions RankValues rankValue
a CriteriaWeights criterionWeight
b IncrementalEvaluation
c Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
d,	-- Construct.
		\MkEvaluationOptions {
			getRankValues :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> RankValues rankValue
getRankValues			= RankValues rankValue
rankValues,
			getCriteriaWeights :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> CriteriaWeights criterionWeight
getCriteriaWeights		= CriteriaWeights criterionWeight
criteriaWeights,
			getIncrementalEvaluation :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
getIncrementalEvaluation	= IncrementalEvaluation
incrementalEvaluation,
			getMaybePieceSquareTables :: forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> Maybe
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
getMaybePieceSquareTables	= Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
maybePieceSquareTables
--			getMaybePieceSquareArray	= maybePieceSquareArray
		} -> (
			RankValues rankValue
rankValues,
			CriteriaWeights criterionWeight
criteriaWeights,
			IncrementalEvaluation
incrementalEvaluation,
			Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
maybePieceSquareTables
		) -- Deconstruct.
	 ) (PU
   (RankValues rankValue, CriteriaWeights criterionWeight,
    IncrementalEvaluation,
    Maybe
      (PieceSquareTable x y pieceSquareValue,
       PieceSquareTable x y pieceSquareValue))
 -> PU
      (EvaluationOptions criterionWeight pieceSquareValue rankValue x y))
-> (PU
      (PieceSquareTable x y pieceSquareValue,
       PieceSquareTable x y pieceSquareValue)
    -> PU
         (RankValues rankValue, CriteriaWeights criterionWeight,
          IncrementalEvaluation,
          Maybe
            (PieceSquareTable x y pieceSquareValue,
             PieceSquareTable x y pieceSquareValue)))
-> PU
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> PU
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU (RankValues rankValue)
-> PU (CriteriaWeights criterionWeight)
-> PU IncrementalEvaluation
-> PU
     (Maybe
        (PieceSquareTable x y pieceSquareValue,
         PieceSquareTable x y pieceSquareValue))
-> PU
     (RankValues rankValue, CriteriaWeights criterionWeight,
      IncrementalEvaluation,
      Maybe
        (PieceSquareTable x y pieceSquareValue,
         PieceSquareTable x y pieceSquareValue))
forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
HXT.xp4Tuple PU (RankValues rankValue)
forall a. XmlPickler a => PU a
HXT.xpickle {-RankValues-} PU (CriteriaWeights criterionWeight)
forall a. XmlPickler a => PU a
HXT.xpickle {-CriteriaWeights-} (
		EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> IncrementalEvaluation
getIncrementalEvaluation EvaluationOptions criterionWeight pieceSquareValue rankValue x y
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
      (PieceSquareTable x y pieceSquareValue,
       PieceSquareTable x y pieceSquareValue))
 -> PU
      (RankValues rankValue, CriteriaWeights criterionWeight,
       IncrementalEvaluation,
       Maybe
         (PieceSquareTable x y pieceSquareValue,
          PieceSquareTable x y pieceSquareValue)))
-> (PU
      (PieceSquareTable x y pieceSquareValue,
       PieceSquareTable x y pieceSquareValue)
    -> PU
         (Maybe
            (PieceSquareTable x y pieceSquareValue,
             PieceSquareTable x y pieceSquareValue)))
-> PU
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> PU
     (RankValues rankValue, CriteriaWeights criterionWeight,
      IncrementalEvaluation,
      Maybe
        (PieceSquareTable x y pieceSquareValue,
         PieceSquareTable x y pieceSquareValue))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
-> PU
     (Maybe
        (PieceSquareTable x y pieceSquareValue,
         PieceSquareTable x y pieceSquareValue))
forall a. PU a -> PU (Maybe a)
HXT.xpOption (PU
   (PieceSquareTable x y pieceSquareValue,
    PieceSquareTable x y pieceSquareValue)
 -> PU
      (Maybe
         (PieceSquareTable x y pieceSquareValue,
          PieceSquareTable x y pieceSquareValue)))
-> (PU
      (PieceSquareTable x y pieceSquareValue,
       PieceSquareTable x y pieceSquareValue)
    -> PU
         (PieceSquareTable x y pieceSquareValue,
          PieceSquareTable x y pieceSquareValue))
-> PU
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> PU
     (Maybe
        (PieceSquareTable x y pieceSquareValue,
         PieceSquareTable x y pieceSquareValue))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> PU
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> PU
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
forall a. String -> PU a -> PU a
HXT.xpElem String
pieceSquareTablesTag (PU
   (PieceSquareTable x y pieceSquareValue,
    PieceSquareTable x y pieceSquareValue)
 -> PU
      (EvaluationOptions criterionWeight pieceSquareValue rankValue x y))
-> PU
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> PU
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
forall a b. (a -> b) -> a -> b
$ String
-> PU (PieceSquareTable x y pieceSquareValue)
-> PU (PieceSquareTable x y pieceSquareValue)
forall a. String -> PU a -> PU a
HXT.xpElem String
Input.PieceSquareTable.tag PU (PieceSquareTable x y pieceSquareValue)
forall a. XmlPickler a => PU a
HXT.xpickle PU (PieceSquareTable x y pieceSquareValue)
-> PU (PieceSquareTable x y pieceSquareValue)
-> PU
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` String
-> PU (PieceSquareTable x y pieceSquareValue)
-> PU (PieceSquareTable x y pieceSquareValue)
forall a. String -> PU a -> PU a
HXT.xpElem String
pieceSquareTableEndGameTag PU (PieceSquareTable x y pieceSquareValue)
forall a. XmlPickler a => PU a
HXT.xpickle where
		def :: EvaluationOptions criterionWeight pieceSquareValue rankValue x y
def	= EvaluationOptions criterionWeight pieceSquareValue rankValue x y
forall a. Default a => a
Data.Default.def

-- | Smart constructor.
mkEvaluationOptions :: (
	Enum		x,
	Enum		y,
	Eq		pieceSquareValue,
	Eq		criterionWeight,
	Fractional	pieceSquareValue,
	Num		criterionWeight,
	Ord		x,
	Ord		y
 )
	=> Attribute.RankValues.RankValues rankValue												-- ^ The static value associated with each /piece/'s /rank/.
	-> Input.CriteriaWeights.CriteriaWeights criterionWeight										-- ^ The weights applied to the values of the criteria used to select a /move/.
	-> IncrementalEvaluation
	-> Maybe (Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue, Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue)	-- ^ The value to each type of piece, of each square, during normal play & the end-game.
	-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
mkEvaluationOptions :: RankValues rankValue
-> CriteriaWeights criterionWeight
-> IncrementalEvaluation
-> Maybe
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
mkEvaluationOptions RankValues rankValue
rankValues CriteriaWeights criterionWeight
criteriaWeights IncrementalEvaluation
incrementalEvaluation Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
maybePieceSquareTables
	| Just (PieceSquareTable x y pieceSquareValue
pieceSquareTable, PieceSquareTable x y pieceSquareValue
_)	<- Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
maybePieceSquareTables
	, let undefinedRanks :: Set Rank
undefinedRanks	= PieceSquareTable x y pieceSquareValue -> Set Rank
forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue -> Set Rank
Input.PieceSquareTable.findUndefinedRanks PieceSquareTable x y pieceSquareValue
pieceSquareTable
	, IncrementalEvaluation -> IncrementalEvaluation
not (IncrementalEvaluation -> IncrementalEvaluation)
-> IncrementalEvaluation -> IncrementalEvaluation
forall a b. (a -> b) -> a -> b
$ Set Rank -> IncrementalEvaluation
forall a. Set a -> IncrementalEvaluation
Data.Set.null Set Rank
undefinedRanks
	= Exception
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception
 -> EvaluationOptions
      criterionWeight pieceSquareValue rankValue x y)
-> (String -> Exception)
-> String
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
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
      criterionWeight pieceSquareValue rankValue x y)
-> String
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
forall a b. (a -> b) -> a -> b
$ [Rank] -> ShowS
forall a. Show a => a -> ShowS
shows (Set Rank -> [Rank]
forall a. Set a -> [a]
Data.Set.toList Set Rank
undefinedRanks) String
" are undefined."
	| CriteriaWeights criterionWeight -> CriterionWeight criterionWeight
forall criterionWeight.
CriteriaWeights criterionWeight -> CriterionWeight criterionWeight
Input.CriteriaWeights.getWeightOfPieceSquareValue CriteriaWeights criterionWeight
criteriaWeights CriterionWeight criterionWeight
-> CriterionWeight criterionWeight -> IncrementalEvaluation
forall a. Eq a => a -> a -> IncrementalEvaluation
/= CriterionWeight criterionWeight
forall a. Bounded a => a
minBound
	, Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
-> IncrementalEvaluation
forall a. Maybe a -> IncrementalEvaluation
Data.Maybe.isNothing Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
maybePieceSquareTables
	= Exception
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception
 -> EvaluationOptions
      criterionWeight pieceSquareValue rankValue x y)
-> (String -> Exception)
-> String
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
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
      criterionWeight pieceSquareValue rankValue x y)
-> String
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
Input.PieceSquareTable.tag String
" isn't."
	| IncrementalEvaluation
otherwise		= MkEvaluationOptions :: forall criterionWeight pieceSquareValue rankValue x y.
RankValues rankValue
-> CriteriaWeights criterionWeight
-> IncrementalEvaluation
-> Maybe
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> Maybe (PieceSquareArray x y pieceSquareValue)
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
MkEvaluationOptions {
		getRankValues :: RankValues rankValue
getRankValues			= RankValues rankValue
rankValues,
		getCriteriaWeights :: CriteriaWeights criterionWeight
getCriteriaWeights		= CriteriaWeights criterionWeight
criteriaWeights,
		getIncrementalEvaluation :: IncrementalEvaluation
getIncrementalEvaluation	= IncrementalEvaluation
incrementalEvaluation,
		getMaybePieceSquareTables :: Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
getMaybePieceSquareTables	= Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
maybePieceSquareTables,
		getMaybePieceSquareArray :: Maybe (PieceSquareArray x y pieceSquareValue)
getMaybePieceSquareArray	= (
			\(PieceSquareTable x y pieceSquareValue,
 PieceSquareTable x y pieceSquareValue)
pieceSquareTablePair -> (Rank
 -> InterpolatedPieceSquareValuesByCoordinates x y pieceSquareValue)
-> PieceSquareArray x y pieceSquareValue
forall x y pieceSquareValue.
(Rank
 -> InterpolatedPieceSquareValuesByCoordinates x y pieceSquareValue)
-> PieceSquareArray x y pieceSquareValue
Component.PieceSquareArray.mkPieceSquareArray (
				\Rank
rank -> [Either pieceSquareValue (Array Int pieceSquareValue)]
-> InterpolatedPieceSquareValuesByCoordinates x y pieceSquareValue
forall (a :: * -> * -> *) e x y.
(IArray a e, Enum x, Enum y, Ord x, Ord y) =>
[e] -> a (Coordinates x y) e
Cartesian.Coordinates.listArrayByCoordinates ([Either pieceSquareValue (Array Int pieceSquareValue)]
 -> InterpolatedPieceSquareValuesByCoordinates x y pieceSquareValue)
-> (([pieceSquareValue], Maybe [pieceSquareValue])
    -> [Either pieceSquareValue (Array Int pieceSquareValue)])
-> ([pieceSquareValue], Maybe [pieceSquareValue])
-> InterpolatedPieceSquareValuesByCoordinates x y pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
					\([pieceSquareValue]
normal, Maybe [pieceSquareValue]
maybeEndGame) -> [Either pieceSquareValue (Array Int pieceSquareValue)]
-> ([pieceSquareValue]
    -> [Either pieceSquareValue (Array Int pieceSquareValue)])
-> Maybe [pieceSquareValue]
-> [Either pieceSquareValue (Array Int pieceSquareValue)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
						(pieceSquareValue
 -> Either pieceSquareValue (Array Int pieceSquareValue))
-> [pieceSquareValue]
-> [Either pieceSquareValue (Array Int pieceSquareValue)]
forall a b. (a -> b) -> [a] -> [b]
map pieceSquareValue
-> Either pieceSquareValue (Array Int pieceSquareValue)
forall a b. a -> Either a b
Left [pieceSquareValue]
normal
					) (
						(pieceSquareValue
 -> pieceSquareValue
 -> Either pieceSquareValue (Array Int pieceSquareValue))
-> [pieceSquareValue]
-> [pieceSquareValue]
-> [Either pieceSquareValue (Array Int pieceSquareValue)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith pieceSquareValue
-> pieceSquareValue
-> Either pieceSquareValue (Array Int pieceSquareValue)
forall pieceSquareValue.
(Eq pieceSquareValue, Fractional pieceSquareValue) =>
pieceSquareValue
-> pieceSquareValue
-> InterpolatedPieceSquareValues pieceSquareValue
interpolatePieceSquareValues [pieceSquareValue]
normal
					) Maybe [pieceSquareValue]
maybeEndGame
				) (([pieceSquareValue], Maybe [pieceSquareValue])
 -> InterpolatedPieceSquareValuesByCoordinates x y pieceSquareValue)
-> ([pieceSquareValue], Maybe [pieceSquareValue])
-> InterpolatedPieceSquareValuesByCoordinates x y pieceSquareValue
forall a b. (a -> b) -> a -> b
$ (
					 Maybe [pieceSquareValue] -> [pieceSquareValue]
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe [pieceSquareValue] -> [pieceSquareValue])
-> (PieceSquareTable x y pieceSquareValue
    -> Maybe [pieceSquareValue])
-> PieceSquareTable x y pieceSquareValue
-> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank
-> PieceSquareTable x y pieceSquareValue
-> Maybe [pieceSquareValue]
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y) =>
Rank
-> PieceSquareTable x y pieceSquareValue
-> Maybe [pieceSquareValue]
Input.PieceSquareTable.dereference Rank
rank (PieceSquareTable x y pieceSquareValue -> [pieceSquareValue])
-> (PieceSquareTable x y pieceSquareValue
    -> Maybe [pieceSquareValue])
-> (PieceSquareTable x y pieceSquareValue,
    PieceSquareTable x y pieceSquareValue)
-> ([pieceSquareValue], Maybe [pieceSquareValue])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Rank
-> PieceSquareTable x y pieceSquareValue
-> Maybe [pieceSquareValue]
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y) =>
Rank
-> PieceSquareTable x y pieceSquareValue
-> Maybe [pieceSquareValue]
Input.PieceSquareTable.dereference Rank
rank
				) (PieceSquareTable x y pieceSquareValue,
 PieceSquareTable x y pieceSquareValue)
pieceSquareTablePair
			)
		) ((PieceSquareTable x y pieceSquareValue,
  PieceSquareTable x y pieceSquareValue)
 -> PieceSquareArray x y pieceSquareValue)
-> Maybe
     (PieceSquareTable x y pieceSquareValue,
      PieceSquareTable x y pieceSquareValue)
-> Maybe (PieceSquareArray x y pieceSquareValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe
  (PieceSquareTable x y pieceSquareValue,
   PieceSquareTable x y pieceSquareValue)
maybePieceSquareTables
	} where
		nPiecesBounds :: (Int, Int)
nPiecesBounds@(Int
minNPieces, Int
maxNPieces)	= (Int
3 {-minimum sufficient material-}, Int
Attribute.LogicalColour.nDistinctLogicalColours Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
Component.Piece.nPiecesPerSide)

		interpolatePieceSquareValues :: (
			Eq		pieceSquareValue,
			Fractional	pieceSquareValue
		 ) => pieceSquareValue -> pieceSquareValue -> Component.PieceSquareArray.InterpolatedPieceSquareValues pieceSquareValue
		interpolatePieceSquareValues :: pieceSquareValue
-> pieceSquareValue
-> InterpolatedPieceSquareValues pieceSquareValue
interpolatePieceSquareValues pieceSquareValue
normal pieceSquareValue
endGame
			| pieceSquareValue
endGame pieceSquareValue -> pieceSquareValue -> IncrementalEvaluation
forall a. Eq a => a -> a -> IncrementalEvaluation
/= pieceSquareValue
normal	= Array Int pieceSquareValue
-> InterpolatedPieceSquareValues pieceSquareValue
forall a b. b -> Either a b
Right (Array Int pieceSquareValue
 -> InterpolatedPieceSquareValues pieceSquareValue)
-> ([Int] -> Array Int pieceSquareValue)
-> [Int]
-> InterpolatedPieceSquareValues pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [pieceSquareValue] -> Array Int pieceSquareValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Int, Int)
nPiecesBounds ([pieceSquareValue] -> Array Int pieceSquareValue)
-> ([Int] -> [pieceSquareValue])
-> [Int]
-> Array Int pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> pieceSquareValue) -> [Int] -> [pieceSquareValue]
forall a b. (a -> b) -> [a] -> [b]
map (
				(pieceSquareValue -> pieceSquareValue -> pieceSquareValue)
-> (pieceSquareValue, pieceSquareValue) -> pieceSquareValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
(+) ((pieceSquareValue, pieceSquareValue) -> pieceSquareValue)
-> (Int -> (pieceSquareValue, pieceSquareValue))
-> Int
-> pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
					(pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
* pieceSquareValue
normal) (pieceSquareValue -> pieceSquareValue)
-> (pieceSquareValue -> pieceSquareValue)
-> pieceSquareValue
-> (pieceSquareValue, pieceSquareValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
* pieceSquareValue
endGame) (pieceSquareValue -> pieceSquareValue)
-> (pieceSquareValue -> pieceSquareValue)
-> pieceSquareValue
-> pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (pieceSquareValue
1 pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
-)
				) (pieceSquareValue -> (pieceSquareValue, pieceSquareValue))
-> (Int -> pieceSquareValue)
-> Int
-> (pieceSquareValue, pieceSquareValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
					pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Fractional a => a -> a -> a
/ Int -> pieceSquareValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (
						Int
maxNPieces Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minNPieces
					) -- Normalise into the closed unit-interval [0,1].
				) (pieceSquareValue -> pieceSquareValue)
-> (Int -> pieceSquareValue) -> Int -> pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> pieceSquareValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> pieceSquareValue)
-> (Int -> Int) -> Int -> pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
minNPieces
			) ([Int] -> InterpolatedPieceSquareValues pieceSquareValue)
-> [Int] -> InterpolatedPieceSquareValues pieceSquareValue
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
			| IncrementalEvaluation
otherwise		= pieceSquareValue -> InterpolatedPieceSquareValues pieceSquareValue
forall a b. a -> Either a b
Left pieceSquareValue
normal	-- Interpolation is unnecessary.

-- | Self-documentation.
type Reader criterionWeight pieceSquareValue rankValue x y	= Control.Monad.Reader.Reader (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)