{-# LANGUAGE LambdaCase #-}
{-
	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 the fitness of a game.

	* By measuring the fitness from the perspective of the player who just moved (rather than the next player to move),
	an automated player can test various /move/s & select the fittest.
-}

module BishBosh.Evaluation.Fitness(
-- * Types
-- * Constants
--	maximumDestinations,
	maximumDefended,
-- * Functions
	measurePieceSquareValueDifference,
	measurePieceSquareValueDifferenceIncrementally,
	measureValueOfMaterial,
--	measureValueOfMobility,
	measureValueOfCastlingPotential,
	measureValueOfDefence,
	measureValueOfDoubledPawns,
	measureValueOfIsolatedPawns,
	measureValueOfPassedPawns,
	evaluateFitness
) where

import			Control.Applicative((<|>))
import			Control.Arrow((&&&), (***))
import			Data.Array.IArray((!))
import qualified	BishBosh.Attribute.MoveType				as Attribute.MoveType
import qualified	BishBosh.Attribute.Rank					as Attribute.Rank
import qualified	BishBosh.Cartesian.Abscissa				as Cartesian.Abscissa
import qualified	BishBosh.Cartesian.Coordinates				as Cartesian.Coordinates
import qualified	BishBosh.Cartesian.Ordinate				as Cartesian.Ordinate
import qualified	BishBosh.Colour.LogicalColour				as Colour.LogicalColour
import qualified	BishBosh.Component.CastlingMove				as Component.CastlingMove
import qualified	BishBosh.Component.Move					as Component.Move
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.Component.QualifiedMove			as Component.QualifiedMove
import qualified	BishBosh.Component.Turn					as Component.Turn
import qualified	BishBosh.Input.CriteriaWeights				as Input.CriteriaWeights
import qualified	BishBosh.Input.EvaluationOptions			as Input.EvaluationOptions
import qualified	BishBosh.Input.RankValues				as Input.RankValues
import qualified	BishBosh.Metric.CriterionValue				as Metric.CriterionValue
import qualified	BishBosh.Metric.WeightedMeanAndCriterionValues		as Metric.WeightedMeanAndCriterionValues
import qualified	BishBosh.Model.Game					as Model.Game
import qualified	BishBosh.Property.Opposable				as Property.Opposable
import qualified	BishBosh.Rule.GameTerminationReason			as Rule.GameTerminationReason
import qualified	BishBosh.State.Board					as State.Board
import qualified	BishBosh.State.CastleableRooksByLogicalColour		as State.CastleableRooksByLogicalColour
import qualified	BishBosh.Type.Count					as Type.Count
import qualified	BishBosh.Type.Mass					as Type.Mass
import qualified	Control.Monad.Reader
import qualified	Data.Array.IArray
import qualified	Data.Foldable
import qualified	Data.List
import qualified	Data.Map.Strict						as Map
import qualified	Data.Maybe

-- | Measures the difference in /piece-square value/ between players, from the perspective of the last player to move.
measurePieceSquareValueDifference
	:: Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank
	-> Model.Game.Game
	-> Type.Mass.Base	-- ^ Unbounded difference.
measurePieceSquareValueDifference :: PieceSquareValueByCoordinatesByRank -> Game -> Base
measurePieceSquareValueDifference PieceSquareValueByCoordinatesByRank
pieceSquareValueByCoordinatesByRank Game
game	= (Base -> Base -> Base) -> [Base] -> Base
forall a. (a -> a -> a) -> [a] -> a
Data.List.foldl1' (
	if LogicalColour -> Bool
Colour.LogicalColour.isBlack (LogicalColour -> Bool) -> LogicalColour -> Bool
forall a b. (a -> b) -> a -> b
$! Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game
		then Base -> Base -> Base
forall a. Num a => a -> a -> a
subtract
		else (-)	-- Represent the piece-square value difference from Black's perspective; i.e. the last player to move.
 ) ([Base] -> Base) -> (Board -> [Base]) -> Board -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceSquareValueByCoordinatesByRank -> Board -> [Base]
State.Board.sumPieceSquareValueByLogicalColour PieceSquareValueByCoordinatesByRank
pieceSquareValueByCoordinatesByRank (Board -> Base) -> Board -> Base
forall a b. (a -> b) -> a -> b
$ Game -> Board
Model.Game.getBoard Game
game

{- |
	* Measures the difference in /piece-square value/ between players, from the perspective of the last player to move.

	* The previous value is provided, to enable calculation by difference.

	* CAVEAT: after a capture, the value is recounted from scratch, because there's one fewer pieces remaining & the piece-square value may depend on NPieces, so all pieces are potentially impacted.
-}
measurePieceSquareValueDifferenceIncrementally
	:: Type.Mass.Base	-- ^ The difference between players in the piece-square value, before the last move was applied & therefore also from the perspective of the previous player.
	-> Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank
	-> Model.Game.Game
	-> Type.Mass.Base	-- ^ Unbounded difference.
measurePieceSquareValueDifferenceIncrementally :: Base -> PieceSquareValueByCoordinatesByRank -> Game -> Base
measurePieceSquareValueDifferenceIncrementally Base
previousPieceSquareValueDifference PieceSquareValueByCoordinatesByRank
pieceSquareValueByCoordinatesByRank Game
game	= Base -> (Base -> Base) -> Maybe Base -> Base
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
	PieceSquareValueByCoordinatesByRank -> Game -> Base
measurePieceSquareValueDifference PieceSquareValueByCoordinatesByRank
pieceSquareValueByCoordinatesByRank Game
game	-- Recalculate.
 ) (
	Base -> Base -> Base
forall a. Num a => a -> a -> a
subtract Base
previousPieceSquareValueDifference
 ) (Maybe Base -> Base)
-> (MoveType -> Maybe Base) -> MoveType -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Maybe Base, Maybe Base,
 (Maybe Rank, Maybe Rank) -> Maybe Base)
-> MoveType -> Maybe Base
forall a.
(Bool -> a, a, (Maybe Rank, Maybe Rank) -> a) -> MoveType -> a
Attribute.MoveType.apply (
	\Bool
isShort	-> Base -> Maybe Base
forall a. a -> Maybe a
Just (Base -> Maybe Base)
-> ((CastlingMove, CastlingMove) -> Base)
-> (CastlingMove, CastlingMove)
-> Maybe Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base -> Base -> Base
forall a. Num a => a -> a -> a
+ Base
quietMovePieceSquareDifference) (Base -> Base)
-> ((CastlingMove, CastlingMove) -> Base)
-> (CastlingMove, CastlingMove)
-> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base -> Base -> Base) -> (Base, Base) -> Base
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Base -> Base -> Base
forall a. Num a => a -> a -> a
subtract ((Base, Base) -> Base)
-> ((CastlingMove, CastlingMove) -> (Base, Base))
-> (CastlingMove, CastlingMove)
-> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates -> Base)
 -> (Coordinates -> Base)
 -> (Coordinates, Coordinates)
 -> (Base, Base))
-> (Coordinates -> Base, Coordinates -> Base)
-> (Coordinates, Coordinates)
-> (Base, Base)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Coordinates -> Base)
-> (Coordinates -> Base)
-> (Coordinates, Coordinates)
-> (Base, Base)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) (
		PieceSquareValueByCoordinates -> Coordinates -> Base
getPieceSquareValue (PieceSquareValueByCoordinates -> Coordinates -> Base)
-> (PieceSquareValueByCoordinates -> Coordinates -> Base)
-> PieceSquareValueByCoordinates
-> (Coordinates -> Base, Coordinates -> Base)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PieceSquareValueByCoordinates -> Coordinates -> Base
getPieceSquareValue (PieceSquareValueByCoordinates
 -> (Coordinates -> Base, Coordinates -> Base))
-> PieceSquareValueByCoordinates
-> (Coordinates -> Base, Coordinates -> Base)
forall a b. (a -> b) -> a -> b
$! Rank -> PieceSquareValueByCoordinates
getPieceSquareValueByCoordinates Rank
Attribute.Rank.Rook
	) ((Coordinates, Coordinates) -> (Base, Base))
-> ((CastlingMove, CastlingMove) -> (Coordinates, Coordinates))
-> (CastlingMove, CastlingMove)
-> (Base, Base)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		Move -> Coordinates
Component.Move.getSource (Move -> Coordinates)
-> (Move -> Coordinates) -> Move -> (Coordinates, Coordinates)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move -> Coordinates
Component.Move.getDestination
	) (Move -> (Coordinates, Coordinates))
-> ((CastlingMove, CastlingMove) -> Move)
-> (CastlingMove, CastlingMove)
-> (Coordinates, Coordinates)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove -> Move
Component.CastlingMove.getRooksMove (CastlingMove -> Move)
-> ((CastlingMove, CastlingMove) -> CastlingMove)
-> (CastlingMove, CastlingMove)
-> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		if Bool
isShort then (CastlingMove, CastlingMove) -> CastlingMove
forall a b. (a, b) -> b
snd else (CastlingMove, CastlingMove) -> CastlingMove
forall a b. (a, b) -> a
fst
	) ((CastlingMove, CastlingMove) -> Maybe Base)
-> (CastlingMove, CastlingMove) -> Maybe Base
forall a b. (a -> b) -> a -> b
$ LogicalColour -> (CastlingMove, CastlingMove)
Component.CastlingMove.getLongAndShortMoves LogicalColour
previousLogicalColour,
	Maybe Base
forall a. Maybe a
Nothing,	-- En-passant.
	\case
		(Maybe Rank
Nothing, Maybe Rank
maybePromotionRank)	-> Base -> Maybe Base
forall a. a -> Maybe a
Just (Base -> Maybe Base) -> Base -> Maybe Base
forall a b. (a -> b) -> a -> b
$! Base -> (Rank -> Base) -> Maybe Rank -> Base
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Base
quietMovePieceSquareDifference (
			(Base -> Base -> Base) -> (Base, Base) -> Base
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Base -> Base -> Base
forall a. Num a => a -> a -> a
subtract ((Base, Base) -> Base) -> (Rank -> (Base, Base)) -> Rank -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PieceSquareValueByCoordinates -> Base)
 -> (PieceSquareValueByCoordinates -> Base)
 -> (PieceSquareValueByCoordinates, PieceSquareValueByCoordinates)
 -> (Base, Base))
-> (PieceSquareValueByCoordinates -> Base,
    PieceSquareValueByCoordinates -> Base)
-> (PieceSquareValueByCoordinates, PieceSquareValueByCoordinates)
-> (Base, Base)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (PieceSquareValueByCoordinates -> Base)
-> (PieceSquareValueByCoordinates -> Base)
-> (PieceSquareValueByCoordinates, PieceSquareValueByCoordinates)
-> (Base, Base)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) (PieceSquareValueByCoordinates -> Base,
 PieceSquareValueByCoordinates -> Base)
getMovePieceSquareValues ((PieceSquareValueByCoordinates, PieceSquareValueByCoordinates)
 -> (Base, Base))
-> (Rank
    -> (PieceSquareValueByCoordinates, PieceSquareValueByCoordinates))
-> Rank
-> (Base, Base)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (Rank -> PieceSquareValueByCoordinates
getPieceSquareValueByCoordinates Rank
rank) (PieceSquareValueByCoordinates
 -> (PieceSquareValueByCoordinates, PieceSquareValueByCoordinates))
-> (Rank -> PieceSquareValueByCoordinates)
-> Rank
-> (PieceSquareValueByCoordinates, PieceSquareValueByCoordinates)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> PieceSquareValueByCoordinates
getPieceSquareValueByCoordinates
		 ) Maybe Rank
maybePromotionRank
		(Maybe Rank, Maybe Rank)
_				-> Maybe Base
forall a. Maybe a
Nothing	-- Capture.
 ) (MoveType -> Base) -> MoveType -> Base
forall a b. (a -> b) -> a -> b
$! QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove where
	(LogicalColour
previousLogicalColour, (QualifiedMove
qualifiedMove, Rank
rank))	= LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite (LogicalColour -> LogicalColour)
-> (Game -> LogicalColour) -> Game -> LogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> LogicalColour
Model.Game.getNextLogicalColour (Game -> LogicalColour)
-> (Game -> (QualifiedMove, Rank))
-> Game
-> (LogicalColour, (QualifiedMove, Rank))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Turn -> QualifiedMove
Component.Turn.getQualifiedMove (Turn -> QualifiedMove)
-> (Turn -> Rank) -> Turn -> (QualifiedMove, Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Turn -> Rank
Component.Turn.getRank) (Turn -> (QualifiedMove, Rank))
-> (Game -> Turn) -> Game -> (QualifiedMove, Rank)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Turn -> Turn
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Turn -> Turn) -> (Game -> Maybe Turn) -> Game -> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe Turn
Model.Game.maybeLastTurn (Game -> (LogicalColour, (QualifiedMove, Rank)))
-> Game -> (LogicalColour, (QualifiedMove, Rank))
forall a b. (a -> b) -> a -> b
$ Game
game	-- Deconstruct.

	getPieceSquareValueByCoordinates :: Attribute.Rank.Rank -> Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates
	getPieceSquareValueByCoordinates :: Rank -> PieceSquareValueByCoordinates
getPieceSquareValueByCoordinates	= PieceSquareValueByCoordinatesByRank
-> NPieces -> Rank -> PieceSquareValueByCoordinates
Component.PieceSquareValueByCoordinatesByRank.getPieceSquareValueByCoordinates PieceSquareValueByCoordinatesByRank
pieceSquareValueByCoordinatesByRank (NPieces -> Rank -> PieceSquareValueByCoordinates)
-> (Board -> NPieces)
-> Board
-> Rank
-> PieceSquareValueByCoordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board -> NPieces
State.Board.getNPieces (Board -> Rank -> PieceSquareValueByCoordinates)
-> Board -> Rank -> PieceSquareValueByCoordinates
forall a b. (a -> b) -> a -> b
$ Game -> Board
Model.Game.getBoard Game
game

	getPieceSquareValue :: Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates -> Cartesian.Coordinates.Coordinates -> Type.Mass.Base
	getPieceSquareValue :: PieceSquareValueByCoordinates -> Coordinates -> Base
getPieceSquareValue PieceSquareValueByCoordinates
pieceSquareByCoordinates	= Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Base -> Base) -> (Coordinates -> Base) -> Coordinates -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceSquareValueByCoordinates
-> LogicalColour -> Coordinates -> Base
Component.PieceSquareValueByCoordinates.getPieceSquareValue PieceSquareValueByCoordinates
pieceSquareByCoordinates LogicalColour
previousLogicalColour

	getMovePieceSquareValues :: (Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates -> Type.Mass.Base, Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates -> Type.Mass.Base)
	getMovePieceSquareValues :: (PieceSquareValueByCoordinates -> Base,
 PieceSquareValueByCoordinates -> Base)
getMovePieceSquareValues	= ((Coordinates -> PieceSquareValueByCoordinates -> Base)
 -> (Coordinates -> PieceSquareValueByCoordinates -> Base)
 -> (Coordinates, Coordinates)
 -> (PieceSquareValueByCoordinates -> Base,
     PieceSquareValueByCoordinates -> Base))
-> (Coordinates -> PieceSquareValueByCoordinates -> Base,
    Coordinates -> PieceSquareValueByCoordinates -> Base)
-> (Coordinates, Coordinates)
-> (PieceSquareValueByCoordinates -> Base,
    PieceSquareValueByCoordinates -> Base)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Coordinates -> PieceSquareValueByCoordinates -> Base)
-> (Coordinates -> PieceSquareValueByCoordinates -> Base)
-> (Coordinates, Coordinates)
-> (PieceSquareValueByCoordinates -> Base,
    PieceSquareValueByCoordinates -> Base)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) ((Coordinates -> PieceSquareValueByCoordinates -> Base)
-> Coordinates -> PieceSquareValueByCoordinates -> Base
forall a. a -> a
id ((Coordinates -> PieceSquareValueByCoordinates -> Base)
 -> Coordinates -> PieceSquareValueByCoordinates -> Base)
-> ((Coordinates -> PieceSquareValueByCoordinates -> Base)
    -> Coordinates -> PieceSquareValueByCoordinates -> Base)
-> (Coordinates -> PieceSquareValueByCoordinates -> Base)
-> (Coordinates -> PieceSquareValueByCoordinates -> Base,
    Coordinates -> PieceSquareValueByCoordinates -> Base)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Coordinates -> PieceSquareValueByCoordinates -> Base)
-> Coordinates -> PieceSquareValueByCoordinates -> Base
forall a. a -> a
id ((Coordinates -> PieceSquareValueByCoordinates -> Base)
 -> (Coordinates -> PieceSquareValueByCoordinates -> Base,
     Coordinates -> PieceSquareValueByCoordinates -> Base))
-> (Coordinates -> PieceSquareValueByCoordinates -> Base)
-> (Coordinates -> PieceSquareValueByCoordinates -> Base,
    Coordinates -> PieceSquareValueByCoordinates -> Base)
forall a b. (a -> b) -> a -> b
$ (PieceSquareValueByCoordinates -> Coordinates -> Base)
-> Coordinates -> PieceSquareValueByCoordinates -> Base
forall a b c. (a -> b -> c) -> b -> a -> c
flip PieceSquareValueByCoordinates -> Coordinates -> Base
getPieceSquareValue) ((Coordinates, Coordinates)
 -> (PieceSquareValueByCoordinates -> Base,
     PieceSquareValueByCoordinates -> Base))
-> (Move -> (Coordinates, Coordinates))
-> Move
-> (PieceSquareValueByCoordinates -> Base,
    PieceSquareValueByCoordinates -> Base)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Move -> Coordinates
Component.Move.getSource (Move -> Coordinates)
-> (Move -> Coordinates) -> Move -> (Coordinates, Coordinates)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move -> Coordinates
Component.Move.getDestination) (Move
 -> (PieceSquareValueByCoordinates -> Base,
     PieceSquareValueByCoordinates -> Base))
-> Move
-> (PieceSquareValueByCoordinates -> Base,
    PieceSquareValueByCoordinates -> Base)
forall a b. (a -> b) -> a -> b
$ QualifiedMove -> Move
Component.QualifiedMove.getMove QualifiedMove
qualifiedMove

	quietMovePieceSquareDifference :: Base
quietMovePieceSquareDifference	= (Base -> Base -> Base) -> (Base, Base) -> Base
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Base -> Base -> Base
forall a. Num a => a -> a -> a
subtract ((Base, Base) -> Base)
-> (PieceSquareValueByCoordinates -> (Base, Base))
-> PieceSquareValueByCoordinates
-> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PieceSquareValueByCoordinates -> Base)
 -> (PieceSquareValueByCoordinates -> Base)
 -> PieceSquareValueByCoordinates
 -> (Base, Base))
-> (PieceSquareValueByCoordinates -> Base,
    PieceSquareValueByCoordinates -> Base)
-> PieceSquareValueByCoordinates
-> (Base, Base)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (PieceSquareValueByCoordinates -> Base)
-> (PieceSquareValueByCoordinates -> Base)
-> PieceSquareValueByCoordinates
-> (Base, Base)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (PieceSquareValueByCoordinates -> Base,
 PieceSquareValueByCoordinates -> Base)
getMovePieceSquareValues (PieceSquareValueByCoordinates -> Base)
-> PieceSquareValueByCoordinates -> Base
forall a b. (a -> b) -> a -> b
$! Rank -> PieceSquareValueByCoordinates
getPieceSquareValueByCoordinates Rank
rank

-- | Measure the arithmetic difference between the total /rank-value/ of the /piece/s currently held by either side; <https://www.chessprogramming.org/Material>.
measureValueOfMaterial
	:: Input.RankValues.RankValues
	-> Type.Mass.RankValue	-- ^ Maximum total rank-value.
	-> Model.Game.Game
	-> Metric.CriterionValue.CriterionValue
measureValueOfMaterial :: RankValues -> Base -> Game -> Base
measureValueOfMaterial RankValues
rankValues Base
maximumTotalRankValue Game
game	= Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Base -> Base) -> (Board -> Base) -> Board -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	Base -> Base -> Base
forall a. Fractional a => a -> a -> a
/ Base
maximumTotalRankValue	-- Normalise.
 ) (Base -> Base) -> (Board -> Base) -> Board -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	if LogicalColour -> Bool
Colour.LogicalColour.isBlack (LogicalColour -> Bool) -> LogicalColour -> Bool
forall a b. (a -> b) -> a -> b
$! Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game
		then Base -> Base
forall a. a -> a
id		-- White just moved.
		else Base -> Base
forall a. Num a => a -> a
negate	-- Black just moved.
 ) (Base -> Base) -> (Board -> Base) -> Board -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base -> (Rank, NPieces) -> Base)
-> Base -> [(Rank, NPieces)] -> Base
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
	\Base
acc (Rank
rank, NPieces
nPiecesDifference) -> if NPieces
nPiecesDifference NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
0
		then Base
acc	-- Avoid calling 'Input.RankValues.findRankValue'.
		else Base
acc Base -> Base -> Base
forall a. Num a => a -> a -> a
+ Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (
			RankValues -> Rank -> Base
Input.RankValues.findRankValue RankValues
rankValues Rank
rank
		) Base -> Base -> Base
forall a. Num a => a -> a -> a
* NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
nPiecesDifference
 ) Base
0 ([(Rank, NPieces)] -> Base)
-> (Board -> [(Rank, NPieces)]) -> Board -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UArray Rank NPieces -> [(Rank, NPieces)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (UArray Rank NPieces -> [(Rank, NPieces)])
-> (Board -> UArray Rank NPieces) -> Board -> [(Rank, NPieces)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board -> UArray Rank NPieces
State.Board.getNPiecesDifferenceByRank {-which arbitrarily counts White pieces as positive & Black as negative-} (Board -> Base) -> Board -> Base
forall a b. (a -> b) -> a -> b
$ Game -> Board
Model.Game.getBoard Game
game

{- |
	* Count the difference between the reciprocals (cf. <https://www.chessprogramming.org/Mobility>), of the total number of /move/s available to each player.

	* Using the reciprocal facilitates mapping into the /closed unit-interval/, & also emphasises the difference between having just one available move & having zero (i.e. mate).
	In consequence, it is more about restricting the opponent's mobility (particularly the @King@) rather than increasing one's own.
	This metric drives the game towards check-mate, rather than merely fighting a war of attrition.

	* CAVEAT: avoiding a reduction of one's mobility to zero (i.e. mate) must be paramount => losing one's @Queen@ should be preferable.
	measureValueOfMobility = 1 when mobility = 0, whereas loss of a @Queen@ = @ (rankValues ! Queen) / maximumTotalRankValue @,
	=> getWeightOfMobility * 1 > weightOfMaterial * (8.8 / 102.47)
	=> getWeightOfMobility > weightOfMaterial / 11.6

	The corollary is that one probably shouldn't sacrifice even a @Knight@ to temporarily reduce one's opponent's mobility to one.
	measureValueOfMobility = 0.5 when mobility = 1,
	=> getWeightOfMobility * 0.5 < weightOfMaterial * (3.2 / 102.47)
	=> getWeightOfMobility < weightOfMaterial / 16.0
	CAVEAT: the loss of a @Knight@ occurs on the subsequent turn & is therefore downgraded, so even this represents too high a weighting.

	This presents a paradox !
-}
measureValueOfMobility :: Model.Game.Game -> Metric.CriterionValue.CriterionValue
measureValueOfMobility :: Game -> Base
measureValueOfMobility Game
game	= Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Base -> Base) -> (LogicalColour -> Base) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base -> Base -> Base) -> (Base, Base) -> Base
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((Base, Base) -> Base)
-> (LogicalColour -> (Base, Base)) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	LogicalColour -> Base
measureConstriction (LogicalColour -> Base)
-> (LogicalColour -> Base) -> LogicalColour -> (Base, Base)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Base
measureConstriction (LogicalColour -> Base)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite {-recent mover-}
 ) (LogicalColour -> Base) -> LogicalColour -> Base
forall a b. (a -> b) -> a -> b
$! Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game where
	measureConstriction :: Colour.LogicalColour.LogicalColour -> Type.Mass.CriterionValue
	measureConstriction :: LogicalColour -> Base
measureConstriction LogicalColour
logicalColour	= Base -> Base
forall a. Fractional a => a -> a
recip (Base -> Base) -> (NPieces -> Base) -> NPieces -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral {-NPlies-} (NPieces -> Base) -> (NPieces -> NPieces) -> NPieces -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> NPieces
forall a. Enum a => a -> a
succ {-avoid divide-by-zero-} (NPieces -> Base) -> NPieces -> Base
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour -> NPieces
Model.Game.countPliesAvailableTo Game
game LogicalColour
logicalColour

-- | Measure the arithmetic difference between the potential to /Castle/, on either side.
measureValueOfCastlingPotential :: Model.Game.Game -> Metric.CriterionValue.CriterionValue
measureValueOfCastlingPotential :: Game -> Base
measureValueOfCastlingPotential Game
game	= Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Base -> Base) -> (LogicalColour -> Base) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base -> Base -> Base) -> (Base, Base) -> Base
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((Base, Base) -> Base)
-> (LogicalColour -> (Base, Base)) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	LogicalColour -> Base
castlingPotential (LogicalColour -> Base)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite {-recent mover-} (LogicalColour -> Base)
-> (LogicalColour -> Base) -> LogicalColour -> (Base, Base)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Base
castlingPotential
 ) (LogicalColour -> Base) -> LogicalColour -> Base
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game where
	castlingPotential :: Colour.LogicalColour.LogicalColour -> Type.Mass.CriterionValue
	castlingPotential :: LogicalColour -> Base
castlingPotential	= Base -> ([NPieces] -> Base) -> Maybe [NPieces] -> Base
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Base
1 {-have Castled-} (
		(Base -> Base -> Base
forall a. Fractional a => a -> a -> a
/ Base
2) (Base -> Base) -> ([NPieces] -> Base) -> [NPieces] -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> Base) -> ([NPieces] -> NPieces) -> [NPieces] -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NPieces] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length
	 ) (Maybe [NPieces] -> Base)
-> (LogicalColour -> Maybe [NPieces]) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastleableRooksByLogicalColour -> LogicalColour -> Maybe [NPieces]
State.CastleableRooksByLogicalColour.locateForLogicalColour (
		Game -> CastleableRooksByLogicalColour
Model.Game.getCastleableRooksByLogicalColour Game
game
	 )

{- |
	* Measure the arithmetic difference between the number of /doubled/ @Pawn@s on either side; <https://www.chessprogramming.org/Doubled_Pawn>.

	* N.B.: measures tripled @Pawn@s as equivalent to two doubled @Pawn@s.

	* CAVEAT: this is a negative attribute, so the weighted normalised value shouldn't exceed the reduction due to 'measureValueOfMaterial' resulting from a @Pawn@-sacrifice.
-}
measureValueOfDoubledPawns :: Model.Game.Game -> Metric.CriterionValue.CriterionValue
measureValueOfDoubledPawns :: Game -> Base
measureValueOfDoubledPawns Game
game	= Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Base -> Base) -> (LogicalColour -> Base) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	Base -> Base -> Base
forall a. Fractional a => a -> a -> a
/ (
		Base
6	:: Type.Mass.CriterionValue	-- Normalise to [-1 .. 1]; the optimal scenario is all files containing one Pawn; the worst scenario is two files each containing four Pawns, all but one per file of which are counted as doubled.
	)
 ) (Base -> Base) -> (LogicalColour -> Base) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral {-NPieces-} (NPieces -> Base)
-> (LogicalColour -> NPieces) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NPieces -> NPieces -> NPieces) -> (NPieces, NPieces) -> NPieces
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((NPieces, NPieces) -> NPieces)
-> (LogicalColour -> (NPieces, NPieces))
-> LogicalColour
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	LogicalColour -> NPieces
countDoubledPawns (LogicalColour -> NPieces)
-> (LogicalColour -> NPieces)
-> LogicalColour
-> (NPieces, NPieces)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> NPieces
countDoubledPawns (LogicalColour -> NPieces)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite {-recent mover-}
 ) (LogicalColour -> Base) -> LogicalColour -> Base
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game where
	countDoubledPawns :: Colour.LogicalColour.LogicalColour -> Type.Count.NPieces
	countDoubledPawns :: LogicalColour -> NPieces
countDoubledPawns LogicalColour
logicalColour	= (NPieces -> NPieces -> NPieces) -> (NPieces, NPieces) -> NPieces
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((NPieces, NPieces) -> NPieces)
-> (NPiecesByFile -> (NPieces, NPieces))
-> NPiecesByFile
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		(NPieces -> NPieces -> NPieces)
-> NPieces -> NPiecesByFile -> NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
(+) NPieces
0 (NPiecesByFile -> NPieces)
-> (NPiecesByFile -> NPieces)
-> NPiecesByFile
-> (NPieces, NPieces)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& NPieces -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> NPieces)
-> (NPiecesByFile -> NPieces) -> NPiecesByFile -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPiecesByFile -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
Data.Foldable.length {-one Pawn can't be considered to be doubled, so substract one Pawn per column-}
	 ) (NPiecesByFile -> NPieces) -> NPiecesByFile -> NPieces
forall a b. (a -> b) -> a -> b
$ Board -> NPiecesByFileByLogicalColour
State.Board.getNPawnsByFileByLogicalColour (Game -> Board
Model.Game.getBoard Game
game) NPiecesByFileByLogicalColour -> LogicalColour -> NPiecesByFile
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour

{- |
	* Measure the arithmetic difference between the number of /isolated/ @Pawn@s on either side; <https://www.chessprogramming.org/Isolated_Pawn>.

	* CAVEAT: this is a negative attribute, so the weighted normalised value shouldn't exceed the reduction due to 'measureValueOfMaterial' resulting from a @Pawn@-sacrifice.
-}
measureValueOfIsolatedPawns :: Model.Game.Game -> Metric.CriterionValue.CriterionValue
measureValueOfIsolatedPawns :: Game -> Base
measureValueOfIsolatedPawns Game
game	= Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Base -> Base) -> (LogicalColour -> Base) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	Base -> Base -> Base
forall a. Fractional a => a -> a -> a
/ (
		NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral {-X-} NPieces
Cartesian.Abscissa.xLength	:: Type.Mass.CriterionValue	-- Normalise to [-1 .. 1]; the optimal scenario is eight files each containing one Pawn & the worst scenario is all Pawns isolated (e.g. 4 alternate files of 2, 2 separate files or 4, ...).
	)
 ) (Base -> Base) -> (LogicalColour -> Base) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral {-NPieces-} (NPieces -> Base)
-> (LogicalColour -> NPieces) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NPieces -> NPieces -> NPieces) -> (NPieces, NPieces) -> NPieces
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((NPieces, NPieces) -> NPieces)
-> (LogicalColour -> (NPieces, NPieces))
-> LogicalColour
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	LogicalColour -> NPieces
countIsolatedPawns (LogicalColour -> NPieces)
-> (LogicalColour -> NPieces)
-> LogicalColour
-> (NPieces, NPieces)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> NPieces
countIsolatedPawns (LogicalColour -> NPieces)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite {-recent mover-}
 ) (LogicalColour -> Base) -> LogicalColour -> Base
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game where
	countIsolatedPawns :: Colour.LogicalColour.LogicalColour -> Type.Count.NPieces
	countIsolatedPawns :: LogicalColour -> NPieces
countIsolatedPawns LogicalColour
logicalColour	= (NPieces -> NPieces -> NPieces -> NPieces)
-> NPieces -> NPiecesByFile -> NPieces
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (
		\NPieces
acc NPieces
x NPieces
nPawns -> if (NPieces -> NPiecesByFile -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` NPiecesByFile
nPawnsByFile) (NPieces -> Bool) -> [NPieces] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` NPieces -> [NPieces]
Cartesian.Abscissa.getAdjacents NPieces
x
			then NPieces
acc		-- This file has at least one neighbouring Pawn which can (if at a suitable rank) be used to protect any of those in this file.
			else NPieces
acc NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ NPieces
nPawns	-- All the Pawns on this file are isolated & thus lack the protection that may be offered by adjacent Pawns.
	 ) NPieces
0 NPiecesByFile
nPawnsByFile where
		nPawnsByFile :: NPiecesByFile
nPawnsByFile	= Board -> NPiecesByFileByLogicalColour
State.Board.getNPawnsByFileByLogicalColour (Game -> Board
Model.Game.getBoard Game
game) NPiecesByFileByLogicalColour -> LogicalColour -> NPiecesByFile
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour

-- | Measure the arithmetic difference between the number of /passed/ @Pawn@s on either side; <https://www.chessprogramming.org/Passed_Pawn>.
measureValueOfPassedPawns :: Model.Game.Game -> Metric.CriterionValue.CriterionValue
measureValueOfPassedPawns :: Game -> Base
measureValueOfPassedPawns Game
game	= Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Base -> Base) -> (LogicalColour -> Base) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	Base -> Base -> Base
forall a. Fractional a => a -> a -> a
/ NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral {-X-} NPieces
Cartesian.Abscissa.xLength	-- Normalise to [-1 .. 1]; the optimal scenario is all files containing exactly one Pawn, of one's own logical colour, on the 7th rank.
 ) (Base -> Base) -> (LogicalColour -> Base) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base -> Base -> Base) -> (Base, Base) -> Base
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((Base, Base) -> Base)
-> (LogicalColour -> (Base, Base)) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	LogicalColour -> Base
valuePassedPawns (LogicalColour -> Base)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite {-recent mover-} (LogicalColour -> Base)
-> (LogicalColour -> Base) -> LogicalColour -> (Base, Base)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Base
valuePassedPawns
 ) (LogicalColour -> Base) -> LogicalColour -> Base
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game where
	valuePassedPawns :: Colour.LogicalColour.LogicalColour -> Type.Mass.CriterionValue
	valuePassedPawns :: LogicalColour -> Base
valuePassedPawns LogicalColour
logicalColour	= (Base -> Coordinates -> Base) -> Base -> [Coordinates] -> Base
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
		\Base
acc -> (Base
acc Base -> Base -> Base
forall a. Num a => a -> a -> a
+) (Base -> Base) -> (Coordinates -> Base) -> Coordinates -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> Base
forall a. Fractional a => a -> a
recip {-value increases exponentially as distance to promotion decreases-} (Base -> Base) -> (Coordinates -> Base) -> Coordinates -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> Base)
-> (Coordinates -> NPieces) -> Coordinates -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> NPieces
forall a. Num a => a -> a
abs (NPieces -> NPieces)
-> (Coordinates -> NPieces) -> Coordinates -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
subtract (
			LogicalColour -> NPieces
Cartesian.Ordinate.lastRank LogicalColour
logicalColour
		) (NPieces -> NPieces)
-> (Coordinates -> NPieces) -> Coordinates -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> NPieces
Cartesian.Coordinates.getY	-- Measure the distance to promotion.
	 ) Base
0 ([Coordinates] -> Base) -> [Coordinates] -> Base
forall a b. (a -> b) -> a -> b
$ Board -> CoordinatesByLogicalColour
State.Board.getPassedPawnCoordinatesByLogicalColour (Game -> Board
Model.Game.getBoard Game
game) CoordinatesByLogicalColour -> LogicalColour -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour

{- |
	* The constant maximum total number of times the /piece/s of either side, can be defended.

	* Assumes all Pawns have been Queened.

	* CAVEAT: assuming the optimal arrangement of pieces:

	RQQB	= 3 + 7 + 3 + 2	= 15
	QQQN	= 4 + 6 + 8 + 4	= 22
	NQQK	= 4 + 8 + 6 + 0	= 18
	BQQR	= 2 + 3 + 7 + 3	= 15
				= 70
-}
maximumDefended :: Type.Count.NPieces
maximumDefended :: NPieces
maximumDefended	= NPieces
70

{- |
	* Measure the normalised arithmetic difference between the number of /piece/s defending each of one's own, on either side.

	* N.B. the /rank-value/ of the defended /piece/ is irrelevant because; it's the unknown value of the attacker that counts, since that's what the defender has the opportunity to counter-strike.
	CAVEAT: the validity of this depends on the duration of the battle.

	* N.B. defence of the @King@ is irrelevent, because it can't be taken.

	* N.B. it's the total number of defenders which is relevant, rather than whether each piece has some protection, since it's not the individual battles but the war which counts.

	* CAVEAT: this criterion competes with /mobility/, since each defended /piece/ blocks the path of the defender.
-}
measureValueOfDefence :: Model.Game.Game -> Metric.CriterionValue.CriterionValue
measureValueOfDefence :: Game -> Base
measureValueOfDefence Game
game	= Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Base -> Base) -> (Board -> Base) -> Board -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	Base -> Base -> Base
forall a. Fractional a => a -> a -> a
/ (
		NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral {-NPieces-} NPieces
maximumDefended	:: Type.Mass.CriterionValue	-- Normalise.
	)
 ) (Base -> Base) -> (Board -> Base) -> Board -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral {-NPieces-} (NPieces -> Base) -> (Board -> NPieces) -> Board -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NPieces -> NPieces -> NPieces) -> (NPieces, NPieces) -> NPieces
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((NPieces, NPieces) -> NPieces)
-> (Board -> (NPieces, NPieces)) -> Board -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	(Array LogicalColour NPieces -> LogicalColour -> NPieces
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite {-recent mover-} LogicalColour
nextLogicalColour) (Array LogicalColour NPieces -> NPieces)
-> (Array LogicalColour NPieces -> NPieces)
-> Array LogicalColour NPieces
-> (NPieces, NPieces)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Array LogicalColour NPieces -> LogicalColour -> NPieces
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
nextLogicalColour)
 ) (Array LogicalColour NPieces -> (NPieces, NPieces))
-> (Board -> Array LogicalColour NPieces)
-> Board
-> (NPieces, NPieces)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board -> Array LogicalColour NPieces
State.Board.summariseNDefendersByLogicalColour (Board -> Base) -> Board -> Base
forall a b. (a -> b) -> a -> b
$ Game -> Board
Model.Game.getBoard Game
game where
	nextLogicalColour :: LogicalColour
nextLogicalColour	= Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game

{- |
	* Evaluates the fitness of the /board/ from the perspective of the last player to move.
	If the game has ended, the fitness is maximum for checkmate or zero for a draw,
	but otherwise is the /weighted mean/ of various criteria; <https://www.chessprogramming.org/Evaluation>.

	* Also returns the break-down of those /criterion-value/s with a non-zero /criterion-weight/.

	* Besides measuring the difference between the total /rank-value/ on either side, other criteria are selected to represent known attributes of a good position.

	* Many possible criteria aren't measured because they're, either currently or imminently, represented by those that are, typically by 'measureValueOfMaterial'.
-}
evaluateFitness
	:: Maybe Type.Mass.Base	-- ^ An optional piece-square value difference for the specified game.
	-> Model.Game.Game
	-> Input.EvaluationOptions.Reader Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues
evaluateFitness :: Maybe Base -> Game -> Reader WeightedMeanAndCriterionValues
evaluateFitness Maybe Base
maybePieceSquareValueDifference Game
game
	| Just GameTerminationReason
gameTerminationReason <- Game -> Maybe GameTerminationReason
Model.Game.getMaybeTerminationReason Game
game	= WeightedMeanAndCriterionValues
-> Reader WeightedMeanAndCriterionValues
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Reader-monad-} (WeightedMeanAndCriterionValues
 -> Reader WeightedMeanAndCriterionValues)
-> WeightedMeanAndCriterionValues
-> Reader WeightedMeanAndCriterionValues
forall a b. (a -> b) -> a -> b
$! Base -> [Base] -> WeightedMeanAndCriterionValues
Metric.WeightedMeanAndCriterionValues.mkWeightedMeanAndCriterionValues (
		if GameTerminationReason -> Bool
Rule.GameTerminationReason.isCheckMate GameTerminationReason
gameTerminationReason
			then Base
1	-- The last player to move, has won.
			else Base
0	-- A draw.
	) []
	| Bool
otherwise	= do
		CriteriaWeights
criteriaWeights					<- (EvaluationOptions -> CriteriaWeights)
-> ReaderT EvaluationOptions Identity CriteriaWeights
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks EvaluationOptions -> CriteriaWeights
Input.EvaluationOptions.getCriteriaWeights
		(RankValues, Base)
rankValuePair					<- (EvaluationOptions -> (RankValues, Base))
-> ReaderT EvaluationOptions Identity (RankValues, Base)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks ((EvaluationOptions -> (RankValues, Base))
 -> ReaderT EvaluationOptions Identity (RankValues, Base))
-> (EvaluationOptions -> (RankValues, Base))
-> ReaderT EvaluationOptions Identity (RankValues, Base)
forall a b. (a -> b) -> a -> b
$ EvaluationOptions -> RankValues
Input.EvaluationOptions.getRankValues (EvaluationOptions -> RankValues)
-> (EvaluationOptions -> Base)
-> EvaluationOptions
-> (RankValues, Base)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& EvaluationOptions -> Base
Input.EvaluationOptions.getMaximumTotalRankValue
		Maybe PieceSquareValueByCoordinatesByRank
maybePieceSquareValueByCoordinatesByRank	<- (EvaluationOptions -> Maybe PieceSquareValueByCoordinatesByRank)
-> ReaderT
     EvaluationOptions
     Identity
     (Maybe PieceSquareValueByCoordinatesByRank)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks EvaluationOptions -> Maybe PieceSquareValueByCoordinatesByRank
Input.EvaluationOptions.getMaybePieceSquareValueByCoordinatesByRank

		WeightedMeanAndCriterionValues
-> Reader WeightedMeanAndCriterionValues
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Reader-monad-} (WeightedMeanAndCriterionValues
 -> Reader WeightedMeanAndCriterionValues)
-> WeightedMeanAndCriterionValues
-> Reader WeightedMeanAndCriterionValues
forall a b. (a -> b) -> a -> b
$! CriteriaWeights
-> Base
-> Base
-> Base
-> Base
-> Base
-> Base
-> Base
-> Base
-> WeightedMeanAndCriterionValues
Input.CriteriaWeights.calculateWeightedMean CriteriaWeights
criteriaWeights (
			(RankValues -> Base -> Game -> Base)
-> (RankValues, Base) -> Game -> Base
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RankValues -> Base -> Game -> Base
measureValueOfMaterial (RankValues, Base)
rankValuePair Game
game
		 ) (
			Game -> Base
measureValueOfMobility Game
game
		 ) (
			Base -> (Base -> Base) -> Maybe Base -> Base
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Base
0 (
				Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Base -> Base) -> (Base -> Base) -> Base -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base -> Base -> Base
forall a. Fractional a => a -> a -> a
/ NPieces -> Base
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Component.Piece.nPiecesPerSide)	-- Normalise.
			) (Maybe Base -> Base) -> Maybe Base -> Base
forall a b. (a -> b) -> a -> b
$ Maybe Base
maybePieceSquareValueDifference Maybe Base -> Maybe Base -> Maybe Base
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PieceSquareValueByCoordinatesByRank -> Base)
-> Maybe PieceSquareValueByCoordinatesByRank -> Maybe Base
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PieceSquareValueByCoordinatesByRank -> Game -> Base
`measurePieceSquareValueDifference` Game
game) Maybe PieceSquareValueByCoordinatesByRank
maybePieceSquareValueByCoordinatesByRank
		 ) (
			Game -> Base
measureValueOfCastlingPotential Game
game
		 ) (
			Game -> Base
measureValueOfDefence Game
game
		 ) (
			Game -> Base
measureValueOfDoubledPawns Game
game
		 ) (
			Game -> Base
measureValueOfIsolatedPawns Game
game
		 ) (
			Game -> Base
measureValueOfPassedPawns Game
game
		 )