{-# LANGUAGE LambdaCase #-}
module BishBosh.Evaluation.Fitness(
maximumDefended,
measurePieceSquareValueDifference,
measurePieceSquareValueDifferenceIncrementally,
measureValueOfMaterial,
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
measurePieceSquareValueDifference
:: Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank
-> Model.Game.Game
-> Type.Mass.Base
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 (-)
) ([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
measurePieceSquareValueDifferenceIncrementally
:: Type.Mass.Base
-> Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank
-> Model.Game.Game
-> Type.Mass.Base
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
) (
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,
\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
) (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
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
measureValueOfMaterial
:: Input.RankValues.RankValues
-> Type.Mass.RankValue
-> 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
) (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
else Base -> Base
forall a. Num a => a -> a
negate
) (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
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 (Board -> Base) -> Board -> Base
forall a b. (a -> b) -> a -> b
$ Game -> Board
Model.Game.getBoard Game
game
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
) (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 (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 (NPieces -> Base) -> NPieces -> Base
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour -> NPieces
Model.Game.countPliesAvailableTo Game
game LogicalColour
logicalColour
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 (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 (
(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
)
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
)
) (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 -> 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
) (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
) (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
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 NPieces
Cartesian.Abscissa.xLength :: Type.Mass.CriterionValue
)
) (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 -> 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
) (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
else NPieces
acc NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ NPieces
nPawns
) 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
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 NPieces
Cartesian.Abscissa.xLength
) (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 (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 (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
) 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
maximumDefended :: Type.Count.NPieces
maximumDefended :: NPieces
maximumDefended = NPieces
70
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
maximumDefended :: Type.Mass.CriterionValue
)
) (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 -> 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 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
evaluateFitness
:: Maybe Type.Mass.Base
-> 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 (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
else Base
0
) []
| 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 (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)
) (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
)