{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables #-}
{-
	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(
-- * Constants
--	maximumDestinations,
	maximumDefended,
-- * Functions
--	mkPieceSquareCriterionValue,
	measurePieceSquareValue,
	measurePieceSquareValueIncrementally,
	measureValueOfMaterial,
--	measureValueOfMobility,
	measureValueOfCastlingPotential,
	measureValueOfDefence,
	measureValueOfDoubledPawns,
	measureValueOfIsolatedPawns,
	measureValueOfPassedPawns,
	evaluateFitness
) where

import			Control.Applicative((<|>))
import			Control.Arrow((&&&))
import			Data.Array.IArray((!))
import qualified	BishBosh.Attribute.CriterionValue			as Attribute.CriterionValue
import qualified	BishBosh.Attribute.Direction				as Attribute.Direction
import qualified	BishBosh.Attribute.LogicalColour			as Attribute.LogicalColour
import qualified	BishBosh.Attribute.MoveType				as Attribute.MoveType
import qualified	BishBosh.Attribute.RankValues				as Attribute.RankValues
import qualified	BishBosh.Attribute.WeightedMeanAndCriterionValues	as Attribute.WeightedMeanAndCriterionValues
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.Component.Move					as Component.Move
import qualified	BishBosh.Component.Piece				as Component.Piece
import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank
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.Model.Game					as Model.Game
import qualified	BishBosh.Model.GameTerminationReason			as Model.GameTerminationReason
import qualified	BishBosh.Property.Opposable				as Property.Opposable
import qualified	BishBosh.State.Board					as State.Board
import qualified	BishBosh.State.CastleableRooksByLogicalColour		as State.CastleableRooksByLogicalColour
import qualified	BishBosh.Types						as T
import qualified	Control.Monad.Reader
import qualified	Data.Array.IArray
import qualified	Data.List
import qualified	Data.Map.Strict
import qualified	Data.Maybe

#ifdef USE_PARALLEL
import qualified	Control.DeepSeq
#endif

#ifdef USE_UNBOXED_ARRAYS
import qualified	Data.Array.Unboxed
#endif

-- | Construct a criterion-value from a piece-square value.
mkPieceSquareCriterionValue :: (
	Fractional	criterionValue,
	Ord		criterionValue,
	Real		pieceSquareValue
 ) => pieceSquareValue -> Attribute.CriterionValue.CriterionValue criterionValue
mkPieceSquareCriterionValue :: pieceSquareValue -> CriterionValue criterionValue
mkPieceSquareCriterionValue	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
(Num criterionValue, Ord criterionValue) =>
criterionValue -> CriterionValue criterionValue
Attribute.CriterionValue.mkCriterionValue (criterionValue -> CriterionValue criterionValue)
-> (pieceSquareValue -> criterionValue)
-> pieceSquareValue
-> CriterionValue criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	criterionValue -> criterionValue -> criterionValue
forall a. Fractional a => a -> a -> a
/ NPieces -> criterionValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Component.Piece.nPiecesPerSide
 ) (criterionValue -> criterionValue)
-> (pieceSquareValue -> criterionValue)
-> pieceSquareValue
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pieceSquareValue -> criterionValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Measures the piece-square value from the perspective of the last player to move.
measurePieceSquareValue :: (
#ifdef USE_UNBOXED_ARRAYS
	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).
#endif
	Enum							x,
	Enum							y,
	Num							pieceSquareValue,
	Ord							x,
	Ord							y
 )
	=> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank x y pieceSquareValue
	-> Model.Game.Game x y
	-> pieceSquareValue
{-# SPECIALISE measurePieceSquareValue :: Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank T.X T.Y T.PieceSquareValue -> Model.Game.Game T.X T.Y -> T.PieceSquareValue #-}
measurePieceSquareValue :: PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Game x y -> pieceSquareValue
measurePieceSquareValue PieceSquareByCoordinatesByRank x y pieceSquareValue
pieceSquareByCoordinatesByRank Game x y
game
	| LogicalColour -> Bool
Attribute.LogicalColour.isBlack (LogicalColour -> Bool) -> LogicalColour -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game	= pieceSquareValue
difference
	| Bool
otherwise									= pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a
negate pieceSquareValue
difference	-- Represent the piece-square value from Black's perspective.
	where
		[pieceSquareValue
blacksPieceSquareValue, pieceSquareValue
whitesPieceSquareValue]	= Array LogicalColour pieceSquareValue -> [pieceSquareValue]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems (Array LogicalColour pieceSquareValue -> [pieceSquareValue])
-> (Board x y -> Array LogicalColour pieceSquareValue)
-> Board x y
-> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Board x y -> Array LogicalColour pieceSquareValue
forall x y pieceSquareValue.
(Enum x, Enum y, Num pieceSquareValue, Ord x, Ord y) =>
PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Board x y -> ArrayByLogicalColour pieceSquareValue
State.Board.sumPieceSquareValueByLogicalColour PieceSquareByCoordinatesByRank x y pieceSquareValue
pieceSquareByCoordinatesByRank (Board x y -> [pieceSquareValue])
-> Board x y -> [pieceSquareValue]
forall a b. (a -> b) -> a -> b
$ Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
game
		difference :: pieceSquareValue
difference						= pieceSquareValue
whitesPieceSquareValue pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
- pieceSquareValue
blacksPieceSquareValue

{- |
	* Measures the piece-square value from the perspective of the last player to move.

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

	* N.B.: because of diminishing returns, the piece-square value for everything but quiet moves is calculated from scratch.
-}
measurePieceSquareValueIncrementally :: (
#ifdef USE_UNBOXED_ARRAYS
	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).
#endif
	Enum							x,
	Enum							y,
	Num							pieceSquareValue,
	Ord							x,
	Ord							y
 )
	=> pieceSquareValue	-- ^ The value before the last move was applied, & therefore also from the perspective of the previous player.
	-> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank x y pieceSquareValue
	-> Model.Game.Game x y
	-> pieceSquareValue
{-# SPECIALISE measurePieceSquareValueIncrementally :: T.PieceSquareValue -> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank T.X T.Y T.PieceSquareValue -> Model.Game.Game T.X T.Y -> T.PieceSquareValue #-}
measurePieceSquareValueIncrementally :: pieceSquareValue
-> PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Game x y
-> pieceSquareValue
measurePieceSquareValueIncrementally pieceSquareValue
previousPieceSquareValue PieceSquareByCoordinatesByRank x y pieceSquareValue
pieceSquareByCoordinatesByRank Game x y
game
	| MoveType -> Bool
Attribute.MoveType.isQuiet (MoveType -> Bool) -> MoveType -> Bool
forall a b. (a -> b) -> a -> b
$ QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove x y
qualifiedMove	= let
		findPieceSquareValues :: [Coordinates x y] -> [pieceSquareValue]
findPieceSquareValues [Coordinates x y]
coordinatesList	= NPieces
-> LogicalColour
-> Rank
-> [Coordinates x y]
-> PieceSquareByCoordinatesByRank x y pieceSquareValue
-> [pieceSquareValue]
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y) =>
NPieces
-> LogicalColour
-> Rank
-> [Coordinates x y]
-> PieceSquareByCoordinatesByRank x y pieceSquareValue
-> [pieceSquareValue]
Component.PieceSquareByCoordinatesByRank.findPieceSquareValues (
			Board x y -> NPieces
forall x y. Board x y -> NPieces
State.Board.getNPieces (Board x y -> NPieces) -> Board x y -> NPieces
forall a b. (a -> b) -> a -> b
$ Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
game	-- N.B.: no capture occurred.
		 ) (
			LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite (LogicalColour -> LogicalColour) -> LogicalColour -> LogicalColour
forall a b. (a -> b) -> a -> b
$ Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game	-- The last player to move.
		 ) (
			Turn x y -> Rank
forall x y. Turn x y -> Rank
Component.Turn.getRank Turn x y
turn	-- N.B.: no promotion occurred.
		 ) [Coordinates x y]
coordinatesList PieceSquareByCoordinatesByRank x y pieceSquareValue
pieceSquareByCoordinatesByRank

		(Coordinates x y
destination, Coordinates x y
source)					= Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> Coordinates x y)
-> (Move x y -> Coordinates x y)
-> Move x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> (Coordinates x y, Coordinates x y))
-> Move x y -> (Coordinates x y, Coordinates x y)
forall a b. (a -> b) -> a -> b
$ QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove QualifiedMove x y
qualifiedMove
		[pieceSquareValue
destinationPieceSquareValue, pieceSquareValue
sourcePiecesquareValue]	= [Coordinates x y] -> [pieceSquareValue]
findPieceSquareValues [Coordinates x y
destination, Coordinates x y
source]
	in (pieceSquareValue
destinationPieceSquareValue pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
- pieceSquareValue
sourcePiecesquareValue) pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
- pieceSquareValue
previousPieceSquareValue {-from the previous player's perspective-}
	| Bool
otherwise					= PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Game x y -> pieceSquareValue
forall x y pieceSquareValue.
(Enum x, Enum y, Num pieceSquareValue, Ord x, Ord y) =>
PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Game x y -> pieceSquareValue
measurePieceSquareValue PieceSquareByCoordinatesByRank x y pieceSquareValue
pieceSquareByCoordinatesByRank Game x y
game	-- N.B.: though Castling, En-passant, & promotion, can also be calculated, the returns don't justify the effort.
	where
		Just Turn x y
turn	= Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
Model.Game.maybeLastTurn Game x y
game
		qualifiedMove :: QualifiedMove x y
qualifiedMove	= Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
turn

-- | Measure the arithmetic difference between the total /rank-value/ of the /piece/s currently held by either side; <https://www.chessprogramming.org/Material>.
measureValueOfMaterial :: (
	Fractional	criterionValue,
	Fractional	rankValue,
	Ord		criterionValue,
	Real		rankValue
 )
	=> Attribute.RankValues.RankValues rankValue
	-> Model.Game.Game x y
	-> Attribute.CriterionValue.CriterionValue criterionValue
-- {-# SPECIALISE measureValueOfMaterial :: Attribute.RankValues.RankValues T.RankValue -> Model.Game.Game T.X T.Y -> Attribute.CriterionValue.CriterionValue T.CriterionValue #-}
measureValueOfMaterial :: RankValues rankValue -> Game x y -> CriterionValue criterionValue
measureValueOfMaterial RankValues rankValue
rankValues Game x y
game	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
(Num criterionValue, Ord criterionValue) =>
criterionValue -> CriterionValue criterionValue
Attribute.CriterionValue.mkCriterionValue (criterionValue -> CriterionValue criterionValue)
-> (Board x y -> criterionValue)
-> Board x y
-> CriterionValue criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	criterionValue -> criterionValue -> criterionValue
forall a. Fractional a => a -> a -> a
/ NPieces -> criterionValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Component.Piece.nPiecesPerSide	-- Normalise.
 ) (criterionValue -> criterionValue)
-> (Board x y -> criterionValue) -> Board x y -> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rankValue -> criterionValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (rankValue -> criterionValue)
-> (Board x y -> rankValue) -> Board x y -> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	if LogicalColour -> Bool
Attribute.LogicalColour.isBlack (LogicalColour -> Bool) -> LogicalColour -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game
		then rankValue -> rankValue
forall a. a -> a
id		-- White just moved.
		else rankValue -> rankValue
forall a. Num a => a -> a
negate	-- Black just moved.
 ) (rankValue -> rankValue)
-> (Board x y -> rankValue) -> Board x y -> rankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (rankValue -> (Rank, NPieces) -> rankValue)
-> rankValue -> [(Rank, NPieces)] -> rankValue
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
	\rankValue
acc (Rank
rank, NPieces
nPieces) -> if NPieces
nPieces NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
0
		then rankValue
acc	-- Avoid calling 'Attribute.RankValues.findRankValue'.
		else rankValue
acc rankValue -> rankValue -> rankValue
forall a. Num a => a -> a -> a
+ Rank -> RankValues rankValue -> rankValue
forall rankValue. Rank -> RankValues rankValue -> rankValue
Attribute.RankValues.findRankValue Rank
rank RankValues rankValue
rankValues rankValue -> rankValue -> rankValue
forall a. Num a => a -> a -> a
* NPieces -> rankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
nPieces
 ) rankValue
0 ([(Rank, NPieces)] -> rankValue)
-> (Board x y -> [(Rank, NPieces)]) -> Board x y -> rankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Rank NPieces -> [(Rank, NPieces)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (Array Rank NPieces -> [(Rank, NPieces)])
-> (Board x y -> Array Rank NPieces)
-> Board x y
-> [(Rank, NPieces)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board x y -> Array Rank NPieces
forall x y. Board x y -> Array Rank NPieces
State.Board.getNPiecesDifferenceByRank {-which arbitrarily counts White pieces as positive & Black as negative-} (Board x y -> CriterionValue criterionValue)
-> Board x y -> CriterionValue criterionValue
forall a b. (a -> b) -> a -> b
$ Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
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 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 :: (
	Enum		x,
	Enum		y,
	Fractional	criterionValue,
	Ord		criterionValue,
	Ord		x,
	Ord		y,
	Show		x,
	Show		y
 ) => Model.Game.Game x y -> Attribute.CriterionValue.CriterionValue criterionValue
{-# SPECIALISE measureValueOfMobility :: Model.Game.Game T.X T.Y -> Attribute.CriterionValue.CriterionValue T.CriterionValue #-}
measureValueOfMobility :: Game x y -> CriterionValue criterionValue
measureValueOfMobility Game x y
game	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
(Num criterionValue, Ord criterionValue) =>
criterionValue -> CriterionValue criterionValue
Attribute.CriterionValue.mkCriterionValue (criterionValue -> CriterionValue criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> CriterionValue criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (criterionValue -> criterionValue -> criterionValue)
-> (criterionValue, criterionValue) -> criterionValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((criterionValue, criterionValue) -> criterionValue)
-> (LogicalColour -> (criterionValue, criterionValue))
-> LogicalColour
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	LogicalColour -> criterionValue
forall c. Fractional c => LogicalColour -> c
measureConstriction (LogicalColour -> criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> (criterionValue, criterionValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> criterionValue
forall c. Fractional c => LogicalColour -> c
measureConstriction (LogicalColour -> criterionValue)
-> (LogicalColour -> LogicalColour)
-> LogicalColour
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite {-recent mover-}
 ) (LogicalColour -> CriterionValue criterionValue)
-> LogicalColour -> CriterionValue criterionValue
forall a b. (a -> b) -> a -> b
$ Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game where
	measureConstriction :: LogicalColour -> c
measureConstriction LogicalColour
logicalColour	= c -> c
forall a. Fractional a => a -> a
recip (c -> c) -> (NPieces -> c) -> NPieces -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> c) -> (NPieces -> NPieces) -> NPieces -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> NPieces
forall a. Enum a => a -> a
succ {-avoid divide-by-zero-} (NPieces -> c) -> NPieces -> c
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Game x y -> NPieces
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> NPieces
Model.Game.countMovesAvailableTo LogicalColour
logicalColour Game x y
game

-- | Measure the arithmetic difference between the potential to /Castle/, on either side.
measureValueOfCastlingPotential :: (
	Fractional	criterionValue,
	Ord		criterionValue
 ) => Model.Game.Game x y -> Attribute.CriterionValue.CriterionValue criterionValue
-- {-# SPECIALISE measureValueOfCastlingPotential :: Model.Game.Game T.X T.Y -> Attribute.CriterionValue.CriterionValue T.CriterionValue #-}
measureValueOfCastlingPotential :: Game x y -> CriterionValue criterionValue
measureValueOfCastlingPotential Game x y
game	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
(Num criterionValue, Ord criterionValue) =>
criterionValue -> CriterionValue criterionValue
Attribute.CriterionValue.mkCriterionValue (criterionValue -> CriterionValue criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> CriterionValue criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (criterionValue -> criterionValue -> criterionValue)
-> (criterionValue, criterionValue) -> criterionValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((criterionValue, criterionValue) -> criterionValue)
-> (LogicalColour -> (criterionValue, criterionValue))
-> LogicalColour
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	LogicalColour -> criterionValue
castlingPotential (LogicalColour -> criterionValue)
-> (LogicalColour -> LogicalColour)
-> LogicalColour
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite {-recent mover-} (LogicalColour -> criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> (criterionValue, criterionValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> criterionValue
castlingPotential
 ) (LogicalColour -> CriterionValue criterionValue)
-> LogicalColour -> CriterionValue criterionValue
forall a b. (a -> b) -> a -> b
$ Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game where
	castlingPotential :: LogicalColour -> criterionValue
castlingPotential	= criterionValue
-> ([x] -> criterionValue) -> Maybe [x] -> criterionValue
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe criterionValue
1 {-have Castled-} (
		(criterionValue -> criterionValue -> criterionValue
forall a. Fractional a => a -> a -> a
/ criterionValue
2) (criterionValue -> criterionValue)
-> ([x] -> criterionValue) -> [x] -> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> criterionValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> criterionValue)
-> ([x] -> NPieces) -> [x] -> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [x] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length
	 ) (Maybe [x] -> criterionValue)
-> (LogicalColour -> Maybe [x]) -> LogicalColour -> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		LogicalColour -> CastleableRooksByLogicalColour x -> Maybe [x]
forall x.
LogicalColour -> CastleableRooksByLogicalColour x -> Maybe [x]
`State.CastleableRooksByLogicalColour.locateForLogicalColour` Game x y -> CastleableRooksByLogicalColour x
forall x y. Game x y -> CastleableRooksByLogicalColour x
Model.Game.getCastleableRooksByLogicalColour Game x y
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 :: (
	Fractional	criterionValue,
	Ord		criterionValue
 ) => Model.Game.Game x y -> Attribute.CriterionValue.CriterionValue criterionValue
-- {-# SPECIALISE measureValueOfDoubledPawns :: Model.Game.Game T.X T.Y -> Attribute.CriterionValue.CriterionValue T.CriterionValue #-}
measureValueOfDoubledPawns :: Game x y -> CriterionValue criterionValue
measureValueOfDoubledPawns Game x y
game	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
(Num criterionValue, Ord criterionValue) =>
criterionValue -> CriterionValue criterionValue
Attribute.CriterionValue.mkCriterionValue (criterionValue -> CriterionValue criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> CriterionValue criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	criterionValue -> criterionValue -> criterionValue
forall a. Fractional a => a -> a -> a
/ criterionValue
6	-- 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.
 ) (criterionValue -> criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> criterionValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> criterionValue)
-> (LogicalColour -> NPieces) -> LogicalColour -> criterionValue
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 -> CriterionValue criterionValue)
-> LogicalColour -> CriterionValue criterionValue
forall a b. (a -> b) -> a -> b
$ Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game where
	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)
-> (Map x NPieces -> (NPieces, NPieces))
-> Map x NPieces
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		(NPieces -> NPieces -> NPieces)
-> NPieces -> Map x NPieces -> NPieces
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Data.Map.Strict.foldl' NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
(+) NPieces
0 (Map x NPieces -> NPieces)
-> (Map x NPieces -> NPieces)
-> Map x NPieces
-> (NPieces, NPieces)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Map x NPieces -> NPieces
forall k a. Map k a -> NPieces
Data.Map.Strict.size {-one Pawn can't be considered to be doubled, so substract one Pawn per column-}
	 ) (Map x NPieces -> NPieces) -> Map x NPieces -> NPieces
forall a b. (a -> b) -> a -> b
$ Board x y -> NPiecesByFileByLogicalColour x
forall x y. Board x y -> NPiecesByFileByLogicalColour x
State.Board.getNPawnsByFileByLogicalColour (Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
game) NPiecesByFileByLogicalColour x -> LogicalColour -> Map x NPieces
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 :: (
	Enum		x,
	Fractional	criterionValue,
	Ord		criterionValue,
	Ord		x
 ) => Model.Game.Game x y -> Attribute.CriterionValue.CriterionValue criterionValue
{-# SPECIALISE measureValueOfIsolatedPawns :: Model.Game.Game T.X T.Y -> Attribute.CriterionValue.CriterionValue T.CriterionValue #-}
measureValueOfIsolatedPawns :: Game x y -> CriterionValue criterionValue
measureValueOfIsolatedPawns Game x y
game	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
(Num criterionValue, Ord criterionValue) =>
criterionValue -> CriterionValue criterionValue
Attribute.CriterionValue.mkCriterionValue (criterionValue -> CriterionValue criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> CriterionValue criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	criterionValue -> criterionValue -> criterionValue
forall a. Fractional a => a -> a -> a
/ NPieces -> criterionValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Cartesian.Abscissa.xLength	-- 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, ...).
 ) (criterionValue -> criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> criterionValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> criterionValue)
-> (LogicalColour -> NPieces) -> LogicalColour -> criterionValue
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 -> CriterionValue criterionValue)
-> LogicalColour -> CriterionValue criterionValue
forall a b. (a -> b) -> a -> b
$ Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game where
	countIsolatedPawns :: Attribute.LogicalColour.LogicalColour -> Component.Piece.NPieces
	countIsolatedPawns :: LogicalColour -> NPieces
countIsolatedPawns LogicalColour
logicalColour	= (NPieces -> x -> NPieces -> NPieces)
-> NPieces -> Map x NPieces -> NPieces
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Data.Map.Strict.foldlWithKey' (
		\NPieces
acc x
x NPieces
nPawns -> (
			if (x -> Map x NPieces -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Data.Map.Strict.member` Map x NPieces
nPawnsByFile) (x -> Bool) -> [x] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` x -> [x]
forall x. (Enum x, Eq x) => x -> [x]
Cartesian.Abscissa.getAdjacents x
x
				then NPieces -> NPieces
forall a. a -> a
id		-- 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 -> 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
acc
	 ) NPieces
0 Map x NPieces
nPawnsByFile where
		nPawnsByFile :: Map x NPieces
nPawnsByFile	= Board x y -> NPiecesByFileByLogicalColour x
forall x y. Board x y -> NPiecesByFileByLogicalColour x
State.Board.getNPawnsByFileByLogicalColour (Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
game) NPiecesByFileByLogicalColour x -> LogicalColour -> Map x NPieces
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 :: forall x y criterionValue. (
	Enum		y,
	Fractional	criterionValue,
	Ord		criterionValue
 ) => Model.Game.Game x y -> Attribute.CriterionValue.CriterionValue criterionValue
{-# SPECIALISE measureValueOfPassedPawns :: Model.Game.Game T.X T.Y -> Attribute.CriterionValue.CriterionValue T.CriterionValue #-}
measureValueOfPassedPawns :: Game x y -> CriterionValue criterionValue
measureValueOfPassedPawns Game x y
game	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
(Num criterionValue, Ord criterionValue) =>
criterionValue -> CriterionValue criterionValue
Attribute.CriterionValue.mkCriterionValue (criterionValue -> CriterionValue criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> CriterionValue criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	criterionValue -> criterionValue -> criterionValue
forall a. Fractional a => a -> a -> a
/ NPieces -> criterionValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Cartesian.Abscissa.xLength	-- Normalise to [-1 .. 1].
 ) (criterionValue -> criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (criterionValue -> criterionValue -> criterionValue)
-> (criterionValue, criterionValue) -> criterionValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((criterionValue, criterionValue) -> criterionValue)
-> (LogicalColour -> (criterionValue, criterionValue))
-> LogicalColour
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	LogicalColour -> criterionValue
valuePassedPawns (LogicalColour -> criterionValue)
-> (LogicalColour -> LogicalColour)
-> LogicalColour
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite {-recent mover-} (LogicalColour -> criterionValue)
-> (LogicalColour -> criterionValue)
-> LogicalColour
-> (criterionValue, criterionValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> criterionValue
valuePassedPawns
 ) (LogicalColour -> CriterionValue criterionValue)
-> LogicalColour -> CriterionValue criterionValue
forall a b. (a -> b) -> a -> b
$ Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game where
	valuePassedPawns :: Attribute.LogicalColour.LogicalColour -> criterionValue
	valuePassedPawns :: LogicalColour -> criterionValue
valuePassedPawns LogicalColour
logicalColour	= (criterionValue -> Coordinates x y -> criterionValue)
-> criterionValue -> [Coordinates x y] -> criterionValue
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
		\criterionValue
acc -> (criterionValue
acc criterionValue -> criterionValue -> criterionValue
forall a. Num a => a -> a -> a
+) (criterionValue -> criterionValue)
-> (Coordinates x y -> criterionValue)
-> Coordinates x y
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. criterionValue -> criterionValue
forall a. Fractional a => a -> a
recip {-value increases exponentially as distance to promotion decreases-} (criterionValue -> criterionValue)
-> (Coordinates x y -> criterionValue)
-> Coordinates x y
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> criterionValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> criterionValue)
-> (Coordinates x y -> NPieces)
-> Coordinates x y
-> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> NPieces
forall a. Num a => a -> a
abs (NPieces -> NPieces)
-> (Coordinates x y -> NPieces) -> Coordinates x y -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
subtract (
			y -> NPieces
forall a. Enum a => a -> NPieces
fromEnum (
				LogicalColour -> y
forall y. Enum y => LogicalColour -> y
Cartesian.Ordinate.lastRank LogicalColour
logicalColour	:: y
			)
		) (NPieces -> NPieces)
-> (Coordinates x y -> NPieces) -> Coordinates x y -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. y -> NPieces
forall a. Enum a => a -> NPieces
fromEnum (y -> NPieces)
-> (Coordinates x y -> y) -> Coordinates x y -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> y
forall x y. Coordinates x y -> y
Cartesian.Coordinates.getY	-- Measure the distance to promotion.
	 ) criterionValue
0 ([Coordinates x y] -> criterionValue)
-> [Coordinates x y] -> criterionValue
forall a b. (a -> b) -> a -> b
$ Board x y -> CoordinatesByLogicalColour x y
forall x y. Board x y -> CoordinatesByLogicalColour x y
State.Board.getPassedPawnCoordinatesByLogicalColour (Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
game) CoordinatesByLogicalColour x y
-> LogicalColour -> [Coordinates x y]
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.

	* This calculation assumes that:

	** every /piece/ can defend another in every /direction/ it can attack,
	which is impossible, since in a 2-D board one can always draw a perimeter around the /piece/s,
	beyond which there're zero /pieces/ to defend, so the outer /piece/s can never be fully utilised;

	** all @Pawn@s have been /queened/, which is unrealistic.
-}
maximumDefended :: Component.Piece.NPieces
maximumDefended :: NPieces
maximumDefended	= (NPieces
9 {-Queens-} NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ NPieces
1 {-King-} NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ NPieces
2 {-Knights-} NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ NPieces
2 {-Rooks + Bishops-}) NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
* NPieces
Attribute.Direction.nDistinctDirections

{- |
	* 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 :: (
	Fractional	criterionValue,
	Ord		criterionValue
 ) => Model.Game.Game x y -> Attribute.CriterionValue.CriterionValue criterionValue
-- {-# SPECIALISE measureValueOfDefence :: Model.Game.Game T.X T.Y -> Attribute.CriterionValue.CriterionValue T.CriterionValue #-}
measureValueOfDefence :: Game x y -> CriterionValue criterionValue
measureValueOfDefence Game x y
game	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
(Num criterionValue, Ord criterionValue) =>
criterionValue -> CriterionValue criterionValue
Attribute.CriterionValue.mkCriterionValue (criterionValue -> CriterionValue criterionValue)
-> (Board x y -> criterionValue)
-> Board x y
-> CriterionValue criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	criterionValue -> criterionValue -> criterionValue
forall a. Fractional a => a -> a -> a
/ NPieces -> criterionValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
maximumDefended	-- Normalise.
 ) (criterionValue -> criterionValue)
-> (Board x y -> criterionValue) -> Board x y -> criterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> criterionValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> criterionValue)
-> (Board x y -> NPieces) -> Board x y -> criterionValue
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 x y -> (NPieces, NPieces)) -> Board x y -> 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 x y -> Array LogicalColour NPieces)
-> Board x y
-> (NPieces, NPieces)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board x y -> Array LogicalColour NPieces
forall x y. Board x y -> Array LogicalColour NPieces
State.Board.summariseNDefendersByLogicalColour (Board x y -> CriterionValue criterionValue)
-> Board x y -> CriterionValue criterionValue
forall a b. (a -> b) -> a -> b
$ Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
game where
	nextLogicalColour :: LogicalColour
nextLogicalColour	= Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
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 :: (
#ifdef USE_PARALLEL
	Control.DeepSeq.NFData					criterionValue,
#endif
#ifdef USE_UNBOXED_ARRAYS
	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).
#endif
	Enum							x,
	Enum							y,
	Fractional						criterionValue,
	Fractional						pieceSquareValue,
	Fractional						rankValue,
	Fractional						weightedMean,
	Ord							x,
	Ord							y,
	Real							criterionValue,
	Real							criterionWeight,
	Real							pieceSquareValue,
	Real							rankValue,
	Show							x,
	Show							y
 )
	=> Maybe pieceSquareValue	-- ^ An optional value for the specified game.
	-> Model.Game.Game x y
	-> Input.EvaluationOptions.Reader criterionWeight pieceSquareValue rankValue x y (
		Attribute.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues weightedMean criterionValue
	)
{-# SPECIALISE evaluateFitness :: Maybe T.PieceSquareValue -> Model.Game.Game T.X T.Y -> Input.EvaluationOptions.Reader T.CriterionWeight T.PieceSquareValue T.RankValue T.X T.Y (Attribute.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues T.WeightedMean T.CriterionValue) #-}
evaluateFitness :: Maybe pieceSquareValue
-> Game x y
-> Reader
     criterionWeight
     pieceSquareValue
     rankValue
     x
     y
     (WeightedMeanAndCriterionValues weightedMean criterionValue)
evaluateFitness Maybe pieceSquareValue
maybePieceSquareValue Game x y
game
	| Just GameTerminationReason
gameTerminationReason <- Game x y -> Maybe GameTerminationReason
forall x y. Game x y -> Maybe GameTerminationReason
Model.Game.getMaybeTerminationReason Game x y
game	= WeightedMeanAndCriterionValues weightedMean criterionValue
-> Reader
     criterionWeight
     pieceSquareValue
     rankValue
     x
     y
     (WeightedMeanAndCriterionValues weightedMean criterionValue)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Reader-monad-} (WeightedMeanAndCriterionValues weightedMean criterionValue
 -> Reader
      criterionWeight
      pieceSquareValue
      rankValue
      x
      y
      (WeightedMeanAndCriterionValues weightedMean criterionValue))
-> WeightedMeanAndCriterionValues weightedMean criterionValue
-> Reader
     criterionWeight
     pieceSquareValue
     rankValue
     x
     y
     (WeightedMeanAndCriterionValues weightedMean criterionValue)
forall a b. (a -> b) -> a -> b
$ weightedMean
-> [criterionValue]
-> WeightedMeanAndCriterionValues weightedMean criterionValue
forall weightedMean criterionValue.
weightedMean
-> [criterionValue]
-> WeightedMeanAndCriterionValues weightedMean criterionValue
Attribute.WeightedMeanAndCriterionValues.mkWeightedMeanAndCriterionValues (
		if GameTerminationReason -> Bool
Model.GameTerminationReason.isCheckMate GameTerminationReason
gameTerminationReason
			then weightedMean
1	-- The last player to move, has won.
			else weightedMean
0	-- A draw.
	) []
	| Bool
otherwise	= do
		CriteriaWeights criterionWeight
criteriaWeights				<- (EvaluationOptions criterionWeight pieceSquareValue rankValue x y
 -> CriteriaWeights criterionWeight)
-> ReaderT
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
     Identity
     (CriteriaWeights criterionWeight)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> CriteriaWeights criterionWeight
forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> CriteriaWeights criterionWeight
Input.EvaluationOptions.getCriteriaWeights
		RankValues rankValue
rankValues				<- (EvaluationOptions criterionWeight pieceSquareValue rankValue x y
 -> RankValues rankValue)
-> ReaderT
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
     Identity
     (RankValues rankValue)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> RankValues rankValue
forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> RankValues rankValue
Input.EvaluationOptions.getRankValues
		Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
maybePieceSquareByCoordinatesByRank	<- (EvaluationOptions criterionWeight pieceSquareValue rankValue x y
 -> Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue))
-> ReaderT
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
     Identity
     (Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
forall criterionWeight pieceSquareValue rankValue x y.
EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank

		WeightedMeanAndCriterionValues weightedMean criterionValue
-> Reader
     criterionWeight
     pieceSquareValue
     rankValue
     x
     y
     (WeightedMeanAndCriterionValues weightedMean criterionValue)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Reader-monad-} (WeightedMeanAndCriterionValues weightedMean criterionValue
 -> Reader
      criterionWeight
      pieceSquareValue
      rankValue
      x
      y
      (WeightedMeanAndCriterionValues weightedMean criterionValue))
-> WeightedMeanAndCriterionValues weightedMean criterionValue
-> Reader
     criterionWeight
     pieceSquareValue
     rankValue
     x
     y
     (WeightedMeanAndCriterionValues weightedMean criterionValue)
forall a b. (a -> b) -> a -> b
$ CriteriaWeights criterionWeight
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> WeightedMeanAndCriterionValues weightedMean criterionValue
forall criterionValue weightedMean criterionWeight.
(NFData criterionValue, Fractional weightedMean,
 Real criterionValue, Real criterionWeight) =>
CriteriaWeights criterionWeight
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> CriterionValue criterionValue
-> WeightedMeanAndCriterionValues weightedMean criterionValue
Input.CriteriaWeights.calculateWeightedMean CriteriaWeights criterionWeight
criteriaWeights (
			RankValues rankValue -> Game x y -> CriterionValue criterionValue
forall criterionValue rankValue x y.
(Fractional criterionValue, Fractional rankValue,
 Ord criterionValue, Real rankValue) =>
RankValues rankValue -> Game x y -> CriterionValue criterionValue
measureValueOfMaterial RankValues rankValue
rankValues Game x y
game
		 ) (
			Game x y -> CriterionValue criterionValue
forall x y criterionValue.
(Enum x, Enum y, Fractional criterionValue, Ord criterionValue,
 Ord x, Ord y, Show x, Show y) =>
Game x y -> CriterionValue criterionValue
measureValueOfMobility Game x y
game
		 ) (
			CriterionValue criterionValue
-> (pieceSquareValue -> CriterionValue criterionValue)
-> Maybe pieceSquareValue
-> CriterionValue criterionValue
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe CriterionValue criterionValue
forall criterionValue.
Num criterionValue =>
CriterionValue criterionValue
Attribute.CriterionValue.zero pieceSquareValue -> CriterionValue criterionValue
forall criterionValue pieceSquareValue.
(Fractional criterionValue, Ord criterionValue,
 Real pieceSquareValue) =>
pieceSquareValue -> CriterionValue criterionValue
mkPieceSquareCriterionValue (Maybe pieceSquareValue -> CriterionValue criterionValue)
-> Maybe pieceSquareValue -> CriterionValue criterionValue
forall a b. (a -> b) -> a -> b
$ Maybe pieceSquareValue
maybePieceSquareValue Maybe pieceSquareValue
-> Maybe pieceSquareValue -> Maybe pieceSquareValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PieceSquareByCoordinatesByRank x y pieceSquareValue
 -> pieceSquareValue)
-> Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
-> Maybe pieceSquareValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
				PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Game x y -> pieceSquareValue
forall x y pieceSquareValue.
(Enum x, Enum y, Num pieceSquareValue, Ord x, Ord y) =>
PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Game x y -> pieceSquareValue
`measurePieceSquareValue` Game x y
game
			) Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
maybePieceSquareByCoordinatesByRank
		 ) (
			Game x y -> CriterionValue criterionValue
forall criterionValue x y.
(Fractional criterionValue, Ord criterionValue) =>
Game x y -> CriterionValue criterionValue
measureValueOfCastlingPotential Game x y
game
		 ) (
			Game x y -> CriterionValue criterionValue
forall criterionValue x y.
(Fractional criterionValue, Ord criterionValue) =>
Game x y -> CriterionValue criterionValue
measureValueOfDefence Game x y
game
		 ) (
			Game x y -> CriterionValue criterionValue
forall criterionValue x y.
(Fractional criterionValue, Ord criterionValue) =>
Game x y -> CriterionValue criterionValue
measureValueOfDoubledPawns Game x y
game
		 ) (
			Game x y -> CriterionValue criterionValue
forall x criterionValue y.
(Enum x, Fractional criterionValue, Ord criterionValue, Ord x) =>
Game x y -> CriterionValue criterionValue
measureValueOfIsolatedPawns Game x y
game
		 ) (
			Game x y -> CriterionValue criterionValue
forall x y criterionValue.
(Enum y, Fractional criterionValue, Ord criterionValue) =>
Game x y -> CriterionValue criterionValue
measureValueOfPassedPawns Game x y
game
		 )