{-# LANGUAGE CPP, FlexibleContexts #-}
module BishBosh.Evaluation.Fitness(
maximumDefended,
measurePieceSquareValue,
measurePieceSquareValueIncrementally,
measureValueOfMaterial,
measureValueOfCastlingPotential,
measureValueOfDefence,
measureValueOfDoubledPawns,
measureValueOfIsolatedPawns,
measureValueOfPassedPawns,
evaluateFitness
) where
import Control.Applicative((<|>))
import Control.Arrow((&&&))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
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.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
#ifdef USE_UNBOXED_ARRAYS
import qualified Data.Array.Unboxed
#endif
measurePieceSquareValue :: (
#ifdef USE_UNBOXED_ARRAYS
Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue,
#endif
Num pieceSquareValue
)
=> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank pieceSquareValue
-> Model.Game.Game
-> pieceSquareValue
{-# SPECIALISE measurePieceSquareValue :: Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank Type.Mass.PieceSquareValue -> Model.Game.Game -> Type.Mass.PieceSquareValue #-}
measurePieceSquareValue :: PieceSquareByCoordinatesByRank pieceSquareValue
-> Game -> pieceSquareValue
measurePieceSquareValue PieceSquareByCoordinatesByRank pieceSquareValue
pieceSquareByCoordinatesByRank Game
game = (
if LogicalColour -> Bool
Attribute.LogicalColour.isBlack (LogicalColour -> Bool) -> LogicalColour -> Bool
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game
then pieceSquareValue -> pieceSquareValue
forall a. a -> a
id
else pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a
negate
) (pieceSquareValue -> pieceSquareValue)
-> pieceSquareValue -> pieceSquareValue
forall a b. (a -> b) -> a -> b
$ pieceSquareValue
whitesPieceSquareValue pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
- pieceSquareValue
blacksPieceSquareValue 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 -> Array LogicalColour pieceSquareValue)
-> Board
-> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceSquareByCoordinatesByRank pieceSquareValue
-> Board -> Array LogicalColour pieceSquareValue
forall pieceSquareValue.
Num pieceSquareValue =>
PieceSquareByCoordinatesByRank pieceSquareValue
-> Board -> ArrayByLogicalColour pieceSquareValue
State.Board.sumPieceSquareValueByLogicalColour PieceSquareByCoordinatesByRank pieceSquareValue
pieceSquareByCoordinatesByRank (Board -> [pieceSquareValue]) -> Board -> [pieceSquareValue]
forall a b. (a -> b) -> a -> b
$ Game -> Board
Model.Game.getBoard Game
game
measurePieceSquareValueIncrementally :: (
#ifdef USE_UNBOXED_ARRAYS
Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue,
#endif
Num pieceSquareValue
)
=> pieceSquareValue
-> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank pieceSquareValue
-> Model.Game.Game
-> pieceSquareValue
{-# SPECIALISE measurePieceSquareValueIncrementally :: Type.Mass.PieceSquareValue -> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank Type.Mass.PieceSquareValue -> Model.Game.Game -> Type.Mass.PieceSquareValue #-}
measurePieceSquareValueIncrementally :: pieceSquareValue
-> PieceSquareByCoordinatesByRank pieceSquareValue
-> Game
-> pieceSquareValue
measurePieceSquareValueIncrementally pieceSquareValue
previousPieceSquareValue PieceSquareByCoordinatesByRank pieceSquareValue
pieceSquareByCoordinatesByRank Game
game
| MoveType -> Bool
Attribute.MoveType.isSimple (MoveType -> Bool) -> MoveType -> Bool
forall a b. (a -> b) -> a -> b
$ QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove = let
findPieceSquareValue :: Coordinates -> pieceSquareValue
findPieceSquareValue = (NPieces
-> LogicalColour -> Rank -> Coordinates -> pieceSquareValue)
-> (NPieces, LogicalColour)
-> Rank
-> Coordinates
-> pieceSquareValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
PieceSquareByCoordinatesByRank pieceSquareValue
-> NPieces
-> LogicalColour
-> Rank
-> Coordinates
-> pieceSquareValue
forall pieceSquareValue.
PieceSquareByCoordinatesByRank pieceSquareValue
-> NPieces
-> LogicalColour
-> Rank
-> Coordinates
-> pieceSquareValue
Component.PieceSquareByCoordinatesByRank.findPieceSquareValue PieceSquareByCoordinatesByRank pieceSquareValue
pieceSquareByCoordinatesByRank
) (
Board -> NPieces
State.Board.getNPieces (Board -> NPieces) -> (Game -> Board) -> Game -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Board
Model.Game.getBoard (Game -> NPieces)
-> (Game -> LogicalColour) -> Game -> (NPieces, LogicalColour)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& 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 -> (NPieces, LogicalColour))
-> Game -> (NPieces, LogicalColour)
forall a b. (a -> b) -> a -> b
$ Game
game
) (
Turn -> Rank
Component.Turn.getRank Turn
turn
)
in (pieceSquareValue -> pieceSquareValue -> pieceSquareValue)
-> (pieceSquareValue, pieceSquareValue) -> pieceSquareValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) (
Coordinates -> pieceSquareValue
findPieceSquareValue (Coordinates -> pieceSquareValue)
-> (Move -> Coordinates) -> Move -> pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getDestination (Move -> pieceSquareValue)
-> (Move -> pieceSquareValue)
-> Move
-> (pieceSquareValue, pieceSquareValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Coordinates -> pieceSquareValue
findPieceSquareValue (Coordinates -> pieceSquareValue)
-> (Move -> Coordinates) -> Move -> pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getSource (Move -> (pieceSquareValue, pieceSquareValue))
-> Move -> (pieceSquareValue, pieceSquareValue)
forall a b. (a -> b) -> a -> b
$ QualifiedMove -> Move
Component.QualifiedMove.getMove QualifiedMove
qualifiedMove
) pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
- pieceSquareValue
previousPieceSquareValue
| Bool
otherwise = PieceSquareByCoordinatesByRank pieceSquareValue
-> Game -> pieceSquareValue
forall pieceSquareValue.
Num pieceSquareValue =>
PieceSquareByCoordinatesByRank pieceSquareValue
-> Game -> pieceSquareValue
measurePieceSquareValue PieceSquareByCoordinatesByRank pieceSquareValue
pieceSquareByCoordinatesByRank Game
game
where
Just Turn
turn = Game -> Maybe Turn
Model.Game.maybeLastTurn Game
game
qualifiedMove :: QualifiedMove
qualifiedMove = Turn -> QualifiedMove
Component.Turn.getQualifiedMove Turn
turn
measureValueOfMaterial
:: Input.RankValues.RankValues
-> Type.Mass.RankValue
-> Model.Game.Game
-> Metric.CriterionValue.CriterionValue
measureValueOfMaterial :: RankValues -> RankValue -> Game -> RankValue
measureValueOfMaterial RankValues
rankValues RankValue
maximumTotalRankValue Game
game = RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue)
-> (Board -> RankValue) -> Board -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
RankValue -> RankValue -> RankValue
forall a. Fractional a => a -> a -> a
/ RankValue
maximumTotalRankValue
) (RankValue -> RankValue)
-> (Board -> RankValue) -> Board -> RankValue
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 -> LogicalColour
Model.Game.getNextLogicalColour Game
game
then RankValue -> RankValue
forall a. a -> a
id
else RankValue -> RankValue
forall a. Num a => a -> a
negate
) (RankValue -> RankValue)
-> (Board -> RankValue) -> Board -> 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
nPiecesDifference) -> if NPieces
nPiecesDifference NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
0
then RankValue
acc
else RankValue
acc RankValue -> RankValue -> RankValue
forall a. Num a => a -> a -> a
+ RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (
Rank -> RankValues -> RankValue
Input.RankValues.findRankValue Rank
rank RankValues
rankValues
) RankValue -> RankValue -> RankValue
forall a. Num a => a -> a -> a
* NPieces -> RankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
nPiecesDifference
) RankValue
0 ([(Rank, NPieces)] -> RankValue)
-> (Board -> [(Rank, NPieces)]) -> Board -> 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 -> Array Rank NPieces) -> Board -> [(Rank, NPieces)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board -> Array Rank NPieces
State.Board.getNPiecesDifferenceByRank (Board -> RankValue) -> Board -> RankValue
forall a b. (a -> b) -> a -> b
$ Game -> Board
Model.Game.getBoard Game
game
measureValueOfMobility :: Model.Game.Game -> Metric.CriterionValue.CriterionValue
measureValueOfMobility :: Game -> RankValue
measureValueOfMobility Game
game = RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue)
-> (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RankValue -> RankValue -> RankValue)
-> (RankValue, RankValue) -> RankValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((RankValue, RankValue) -> RankValue)
-> (LogicalColour -> (RankValue, RankValue))
-> LogicalColour
-> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
LogicalColour -> RankValue
measureConstriction (LogicalColour -> RankValue)
-> (LogicalColour -> RankValue)
-> LogicalColour
-> (RankValue, RankValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> RankValue
measureConstriction (LogicalColour -> RankValue)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite
) (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game where
measureConstriction :: Attribute.LogicalColour.LogicalColour -> Type.Mass.CriterionValue
measureConstriction :: LogicalColour -> RankValue
measureConstriction LogicalColour
logicalColour = RankValue -> RankValue
forall a. Fractional a => a -> a
recip (RankValue -> RankValue)
-> (NPieces -> RankValue) -> NPieces -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> RankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> RankValue)
-> (NPieces -> NPieces) -> NPieces -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> NPieces
forall a. Enum a => a -> a
succ (NPieces -> RankValue) -> NPieces -> RankValue
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Game -> NPieces
Model.Game.countPliesAvailableTo LogicalColour
logicalColour Game
game
measureValueOfCastlingPotential :: Model.Game.Game -> Metric.CriterionValue.CriterionValue
measureValueOfCastlingPotential :: Game -> RankValue
measureValueOfCastlingPotential Game
game = RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue)
-> (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RankValue -> RankValue -> RankValue)
-> (RankValue, RankValue) -> RankValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((RankValue, RankValue) -> RankValue)
-> (LogicalColour -> (RankValue, RankValue))
-> LogicalColour
-> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
LogicalColour -> RankValue
castlingPotential (LogicalColour -> RankValue)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite (LogicalColour -> RankValue)
-> (LogicalColour -> RankValue)
-> LogicalColour
-> (RankValue, RankValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> RankValue
castlingPotential
) (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game where
castlingPotential :: Attribute.LogicalColour.LogicalColour -> Type.Mass.CriterionValue
castlingPotential :: LogicalColour -> RankValue
castlingPotential = RankValue
-> ([NPieces] -> RankValue) -> Maybe [NPieces] -> RankValue
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe RankValue
1 (
(RankValue -> RankValue -> RankValue
forall a. Fractional a => a -> a -> a
/ RankValue
2) (RankValue -> RankValue)
-> ([NPieces] -> RankValue) -> [NPieces] -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> RankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> RankValue)
-> ([NPieces] -> NPieces) -> [NPieces] -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NPieces] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length
) (Maybe [NPieces] -> RankValue)
-> (LogicalColour -> Maybe [NPieces]) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
LogicalColour -> CastleableRooksByLogicalColour -> Maybe [NPieces]
`State.CastleableRooksByLogicalColour.locateForLogicalColour` Game -> CastleableRooksByLogicalColour
Model.Game.getCastleableRooksByLogicalColour Game
game
)
measureValueOfDoubledPawns :: Model.Game.Game -> Metric.CriterionValue.CriterionValue
measureValueOfDoubledPawns :: Game -> RankValue
measureValueOfDoubledPawns Game
game = RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue)
-> (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
RankValue -> RankValue -> RankValue
forall a. Fractional a => a -> a -> a
/ (
RankValue
6 :: Type.Mass.CriterionValue
)
) (RankValue -> RankValue)
-> (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> RankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> RankValue)
-> (LogicalColour -> NPieces) -> LogicalColour -> RankValue
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 -> RankValue) -> LogicalColour -> RankValue
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game where
countDoubledPawns :: Attribute.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 -> RankValue
measureValueOfIsolatedPawns Game
game = RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue)
-> (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
RankValue -> RankValue -> RankValue
forall a. Fractional a => a -> a -> a
/ (
NPieces -> RankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Cartesian.Abscissa.xLength :: Type.Mass.CriterionValue
)
) (RankValue -> RankValue)
-> (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> RankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> RankValue)
-> (LogicalColour -> NPieces) -> LogicalColour -> RankValue
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 -> RankValue) -> LogicalColour -> RankValue
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game where
countIsolatedPawns :: Attribute.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 -> RankValue
measureValueOfPassedPawns Game
game = RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue)
-> (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
RankValue -> RankValue -> RankValue
forall a. Fractional a => a -> a -> a
/ NPieces -> RankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Cartesian.Abscissa.xLength
) (RankValue -> RankValue)
-> (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RankValue -> RankValue -> RankValue)
-> (RankValue, RankValue) -> RankValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((RankValue, RankValue) -> RankValue)
-> (LogicalColour -> (RankValue, RankValue))
-> LogicalColour
-> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
LogicalColour -> RankValue
valuePassedPawns (LogicalColour -> RankValue)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite (LogicalColour -> RankValue)
-> (LogicalColour -> RankValue)
-> LogicalColour
-> (RankValue, RankValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> RankValue
valuePassedPawns
) (LogicalColour -> RankValue) -> LogicalColour -> RankValue
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game where
valuePassedPawns :: Attribute.LogicalColour.LogicalColour -> Type.Mass.CriterionValue
valuePassedPawns :: LogicalColour -> RankValue
valuePassedPawns LogicalColour
logicalColour = (RankValue -> Coordinates -> RankValue)
-> RankValue -> [Coordinates] -> RankValue
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\RankValue
acc -> (RankValue
acc RankValue -> RankValue -> RankValue
forall a. Num a => a -> a -> a
+) (RankValue -> RankValue)
-> (Coordinates -> RankValue) -> Coordinates -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValue -> RankValue
forall a. Fractional a => a -> a
recip (RankValue -> RankValue)
-> (Coordinates -> RankValue) -> Coordinates -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> RankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> RankValue)
-> (Coordinates -> NPieces) -> Coordinates -> RankValue
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
) RankValue
0 ([Coordinates] -> RankValue) -> [Coordinates] -> RankValue
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 -> RankValue
measureValueOfDefence Game
game = RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue)
-> (Board -> RankValue) -> Board -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
RankValue -> RankValue -> RankValue
forall a. Fractional a => a -> a -> a
/ (
NPieces -> RankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
maximumDefended :: Type.Mass.CriterionValue
)
) (RankValue -> RankValue)
-> (Board -> RankValue) -> Board -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> RankValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> RankValue) -> (Board -> NPieces) -> Board -> RankValue
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 -> RankValue) -> Board -> RankValue
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 :: (
#ifdef USE_UNBOXED_ARRAYS
Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue,
#endif
Fractional pieceSquareValue,
Real pieceSquareValue
)
=> Maybe pieceSquareValue
-> Model.Game.Game
-> Input.EvaluationOptions.Reader pieceSquareValue Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues
{-# SPECIALISE evaluateFitness :: Maybe Type.Mass.PieceSquareValue -> Model.Game.Game -> Input.EvaluationOptions.Reader Type.Mass.PieceSquareValue Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues #-}
evaluateFitness :: Maybe pieceSquareValue
-> Game -> Reader pieceSquareValue WeightedMeanAndCriterionValues
evaluateFitness Maybe pieceSquareValue
maybePieceSquareValue Game
game
| Just GameTerminationReason
gameTerminationReason <- Game -> Maybe GameTerminationReason
Model.Game.getMaybeTerminationReason Game
game = WeightedMeanAndCriterionValues
-> Reader pieceSquareValue WeightedMeanAndCriterionValues
forall (m :: * -> *) a. Monad m => a -> m a
return (WeightedMeanAndCriterionValues
-> Reader pieceSquareValue WeightedMeanAndCriterionValues)
-> WeightedMeanAndCriterionValues
-> Reader pieceSquareValue WeightedMeanAndCriterionValues
forall a b. (a -> b) -> a -> b
$ RankValue -> [RankValue] -> WeightedMeanAndCriterionValues
Metric.WeightedMeanAndCriterionValues.mkWeightedMeanAndCriterionValues (
if GameTerminationReason -> Bool
Rule.GameTerminationReason.isCheckMate GameTerminationReason
gameTerminationReason
then RankValue
1
else RankValue
0
) []
| Bool
otherwise = do
CriteriaWeights
criteriaWeights <- (EvaluationOptions pieceSquareValue -> CriteriaWeights)
-> ReaderT
(EvaluationOptions pieceSquareValue) Identity CriteriaWeights
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks EvaluationOptions pieceSquareValue -> CriteriaWeights
forall pieceSquareValue.
EvaluationOptions pieceSquareValue -> CriteriaWeights
Input.EvaluationOptions.getCriteriaWeights
(RankValues, RankValue)
rankValuePair <- (EvaluationOptions pieceSquareValue -> (RankValues, RankValue))
-> ReaderT
(EvaluationOptions pieceSquareValue)
Identity
(RankValues, RankValue)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks ((EvaluationOptions pieceSquareValue -> (RankValues, RankValue))
-> ReaderT
(EvaluationOptions pieceSquareValue)
Identity
(RankValues, RankValue))
-> (EvaluationOptions pieceSquareValue -> (RankValues, RankValue))
-> ReaderT
(EvaluationOptions pieceSquareValue)
Identity
(RankValues, RankValue)
forall a b. (a -> b) -> a -> b
$ EvaluationOptions pieceSquareValue -> RankValues
forall pieceSquareValue.
EvaluationOptions pieceSquareValue -> RankValues
Input.EvaluationOptions.getRankValues (EvaluationOptions pieceSquareValue -> RankValues)
-> (EvaluationOptions pieceSquareValue -> RankValue)
-> EvaluationOptions pieceSquareValue
-> (RankValues, RankValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& EvaluationOptions pieceSquareValue -> RankValue
forall pieceSquareValue.
EvaluationOptions pieceSquareValue -> RankValue
Input.EvaluationOptions.getMaximumTotalRankValue
Maybe (PieceSquareByCoordinatesByRank pieceSquareValue)
maybePieceSquareByCoordinatesByRank <- (EvaluationOptions pieceSquareValue
-> Maybe (PieceSquareByCoordinatesByRank pieceSquareValue))
-> ReaderT
(EvaluationOptions pieceSquareValue)
Identity
(Maybe (PieceSquareByCoordinatesByRank pieceSquareValue))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks EvaluationOptions pieceSquareValue
-> Maybe (PieceSquareByCoordinatesByRank pieceSquareValue)
forall pieceSquareValue.
EvaluationOptions pieceSquareValue
-> Maybe (PieceSquareByCoordinatesByRank pieceSquareValue)
Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank
WeightedMeanAndCriterionValues
-> Reader pieceSquareValue WeightedMeanAndCriterionValues
forall (m :: * -> *) a. Monad m => a -> m a
return (WeightedMeanAndCriterionValues
-> Reader pieceSquareValue WeightedMeanAndCriterionValues)
-> WeightedMeanAndCriterionValues
-> Reader pieceSquareValue WeightedMeanAndCriterionValues
forall a b. (a -> b) -> a -> b
$ CriteriaWeights
-> RankValue
-> RankValue
-> RankValue
-> RankValue
-> RankValue
-> RankValue
-> RankValue
-> RankValue
-> WeightedMeanAndCriterionValues
Input.CriteriaWeights.calculateWeightedMean CriteriaWeights
criteriaWeights (
(RankValues -> RankValue -> Game -> RankValue)
-> (RankValues, RankValue) -> Game -> RankValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RankValues -> RankValue -> Game -> RankValue
measureValueOfMaterial (RankValues, RankValue)
rankValuePair Game
game
) (
Game -> RankValue
measureValueOfMobility Game
game
) (
RankValue
-> (pieceSquareValue -> RankValue)
-> Maybe pieceSquareValue
-> RankValue
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe RankValue
0 (
pieceSquareValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (pieceSquareValue -> RankValue)
-> (pieceSquareValue -> pieceSquareValue)
-> pieceSquareValue
-> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Fractional a => a -> a -> a
/ NPieces -> pieceSquareValue
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Component.Piece.nPiecesPerSide)
) (Maybe pieceSquareValue -> RankValue)
-> Maybe pieceSquareValue -> RankValue
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 pieceSquareValue
-> pieceSquareValue)
-> Maybe (PieceSquareByCoordinatesByRank pieceSquareValue)
-> Maybe pieceSquareValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PieceSquareByCoordinatesByRank pieceSquareValue
-> Game -> pieceSquareValue
forall pieceSquareValue.
Num pieceSquareValue =>
PieceSquareByCoordinatesByRank pieceSquareValue
-> Game -> pieceSquareValue
`measurePieceSquareValue` Game
game) Maybe (PieceSquareByCoordinatesByRank pieceSquareValue)
maybePieceSquareByCoordinatesByRank
) (
Game -> RankValue
measureValueOfCastlingPotential Game
game
) (
Game -> RankValue
measureValueOfDefence Game
game
) (
Game -> RankValue
measureValueOfDoubledPawns Game
game
) (
Game -> RankValue
measureValueOfIsolatedPawns Game
game
) (
Game -> RankValue
measureValueOfPassedPawns Game
game
)