{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables #-}
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.Length as Type.Length
import qualified BishBosh.Type.Mass as Type.Mass
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_UNBOXED_ARRAYS
import qualified Data.Array.Unboxed
#endif
mkPieceSquareCriterionValue :: Real pieceSquareValue => pieceSquareValue -> Metric.CriterionValue.CriterionValue
mkPieceSquareCriterionValue :: pieceSquareValue -> CriterionValue
mkPieceSquareCriterionValue = Rational -> CriterionValue
forall a. Fractional a => Rational -> a
fromRational (Rational -> CriterionValue)
-> (pieceSquareValue -> Rational)
-> pieceSquareValue
-> CriterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ NPieces -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Component.Piece.nPiecesPerSide
) (Rational -> Rational)
-> (pieceSquareValue -> Rational) -> pieceSquareValue -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pieceSquareValue -> Rational
forall a. Real a => a -> Rational
toRational
measurePieceSquareValue :: (
#ifdef USE_UNBOXED_ARRAYS
Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue,
#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 Type.Length.X Type.Length.Y Type.Mass.PieceSquareValue -> Model.Game.Game Type.Length.X Type.Length.Y -> Type.Mass.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
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
measurePieceSquareValueIncrementally :: (
#ifdef USE_UNBOXED_ARRAYS
Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue,
#endif
Enum x,
Enum y,
Num pieceSquareValue,
Ord x,
Ord y
)
=> pieceSquareValue
-> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Model.Game.Game x y
-> pieceSquareValue
{-# SPECIALISE measurePieceSquareValueIncrementally :: Type.Mass.PieceSquareValue -> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank Type.Length.X Type.Length.Y Type.Mass.PieceSquareValue -> Model.Game.Game Type.Length.X Type.Length.Y -> Type.Mass.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
) (
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
) (
Turn x y -> Rank
forall x y. Turn x y -> Rank
Component.Turn.getRank Turn x y
turn
) [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
| 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
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
measureValueOfMaterial
:: Input.RankValues.RankValues
-> Type.Mass.RankValue
-> Model.Game.Game x y
-> Metric.CriterionValue.CriterionValue
measureValueOfMaterial :: RankValues -> CriterionValue -> Game x y -> CriterionValue
measureValueOfMaterial RankValues
rankValues CriterionValue
maximumTotalRankValue Game x y
game = Rational -> CriterionValue
forall a. Fractional a => Rational -> a
fromRational (Rational -> CriterionValue)
-> (Board x y -> Rational) -> Board x y -> CriterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ CriterionValue -> Rational
forall a. Real a => a -> Rational
toRational CriterionValue
maximumTotalRankValue
) (Rational -> Rational)
-> (Board x y -> Rational) -> Board x y -> Rational
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 Rational -> Rational
forall a. a -> a
id
else Rational -> Rational
forall a. Num a => a -> a
negate
) (Rational -> Rational)
-> (Board x y -> Rational) -> Board x y -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> (Rank, NPieces) -> Rational)
-> Rational -> [(Rank, NPieces)] -> Rational
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\Rational
acc (Rank
rank, NPieces
nPiecesDifference) -> if NPieces
nPiecesDifference NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
0
then Rational
acc
else Rational
acc Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ RankValue -> Rational
forall a. Real a => a -> Rational
toRational (
Rank -> RankValues -> RankValue
Input.RankValues.findRankValue Rank
rank RankValues
rankValues
) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* NPieces -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
nPiecesDifference
) Rational
0 ([(Rank, NPieces)] -> Rational)
-> (Board x y -> [(Rank, NPieces)]) -> Board x y -> Rational
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 (Board x y -> CriterionValue) -> Board x y -> 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
measureValueOfMobility :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Model.Game.Game x y -> Metric.CriterionValue.CriterionValue
{-# SPECIALISE measureValueOfMobility :: Model.Game.Game Type.Length.X Type.Length.Y -> Metric.CriterionValue.CriterionValue #-}
measureValueOfMobility :: Game x y -> CriterionValue
measureValueOfMobility Game x y
game = Rational -> CriterionValue
forall a. Fractional a => Rational -> a
fromRational (Rational -> CriterionValue)
-> (LogicalColour -> Rational) -> LogicalColour -> CriterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational)
-> (Rational, Rational) -> Rational
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((Rational, Rational) -> Rational)
-> (LogicalColour -> (Rational, Rational))
-> LogicalColour
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
LogicalColour -> Rational
forall c. Fractional c => LogicalColour -> c
measureConstriction (LogicalColour -> Rational)
-> (LogicalColour -> Rational)
-> LogicalColour
-> (Rational, Rational)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Rational
forall c. Fractional c => LogicalColour -> c
measureConstriction (LogicalColour -> Rational)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite
) (LogicalColour -> CriterionValue)
-> LogicalColour -> 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 (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.countPliesAvailableTo LogicalColour
logicalColour Game x y
game
measureValueOfCastlingPotential :: Model.Game.Game x y -> Metric.CriterionValue.CriterionValue
measureValueOfCastlingPotential :: Game x y -> CriterionValue
measureValueOfCastlingPotential Game x y
game = Rational -> CriterionValue
forall a. Fractional a => Rational -> a
fromRational (Rational -> CriterionValue)
-> (LogicalColour -> Rational) -> LogicalColour -> CriterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational)
-> (Rational, Rational) -> Rational
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((Rational, Rational) -> Rational)
-> (LogicalColour -> (Rational, Rational))
-> LogicalColour
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
LogicalColour -> Rational
castlingPotential (LogicalColour -> Rational)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite (LogicalColour -> Rational)
-> (LogicalColour -> Rational)
-> LogicalColour
-> (Rational, Rational)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Rational
castlingPotential
) (LogicalColour -> CriterionValue)
-> LogicalColour -> 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 -> Rational
castlingPotential = Rational -> ([x] -> Rational) -> Maybe [x] -> Rational
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Rational
1 (
(Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2) (Rational -> Rational) -> ([x] -> Rational) -> [x] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> Rational) -> ([x] -> NPieces) -> [x] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [x] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length
) (Maybe [x] -> Rational)
-> (LogicalColour -> Maybe [x]) -> LogicalColour -> Rational
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
)
measureValueOfDoubledPawns :: Model.Game.Game x y -> Metric.CriterionValue.CriterionValue
measureValueOfDoubledPawns :: Game x y -> CriterionValue
measureValueOfDoubledPawns Game x y
game = Rational -> CriterionValue
forall a. Fractional a => Rational -> a
fromRational (Rational -> CriterionValue)
-> (LogicalColour -> Rational) -> LogicalColour -> CriterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
6
) (Rational -> Rational)
-> (LogicalColour -> Rational) -> LogicalColour -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> Rational)
-> (LogicalColour -> NPieces) -> LogicalColour -> Rational
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 -> CriterionValue)
-> LogicalColour -> 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')
&&& NPieces -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> NPieces)
-> (Map x NPieces -> NPieces) -> Map x NPieces -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map x NPieces -> NPieces
forall k a. Map k a -> NPieces
Data.Map.Strict.size
) (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
measureValueOfIsolatedPawns :: (Enum x, Ord x) => Model.Game.Game x y -> Metric.CriterionValue.CriterionValue
{-# SPECIALISE measureValueOfIsolatedPawns :: Model.Game.Game Type.Length.X Type.Length.Y -> Metric.CriterionValue.CriterionValue #-}
measureValueOfIsolatedPawns :: Game x y -> CriterionValue
measureValueOfIsolatedPawns Game x y
game = Rational -> CriterionValue
forall a. Fractional a => Rational -> a
fromRational (Rational -> CriterionValue)
-> (LogicalColour -> Rational) -> LogicalColour -> CriterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ NPieces -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Cartesian.Abscissa.xLength
) (Rational -> Rational)
-> (LogicalColour -> Rational) -> LogicalColour -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> Rational)
-> (LogicalColour -> NPieces) -> LogicalColour -> Rational
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 -> CriterionValue)
-> LogicalColour -> 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 -> Type.Count.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
else (NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ NPieces
nPawns)
) 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
measureValueOfPassedPawns :: forall x y. Enum y => Model.Game.Game x y -> Metric.CriterionValue.CriterionValue
{-# SPECIALISE measureValueOfPassedPawns :: Model.Game.Game Type.Length.X Type.Length.Y -> Metric.CriterionValue.CriterionValue #-}
measureValueOfPassedPawns :: Game x y -> CriterionValue
measureValueOfPassedPawns Game x y
game = Rational -> CriterionValue
forall a. Fractional a => Rational -> a
fromRational (Rational -> CriterionValue)
-> (LogicalColour -> Rational) -> LogicalColour -> CriterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ NPieces -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Cartesian.Abscissa.xLength
) (Rational -> Rational)
-> (LogicalColour -> Rational) -> LogicalColour -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational)
-> (Rational, Rational) -> Rational
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((Rational, Rational) -> Rational)
-> (LogicalColour -> (Rational, Rational))
-> LogicalColour
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
LogicalColour -> Rational
forall c. Fractional c => LogicalColour -> c
valuePassedPawns (LogicalColour -> Rational)
-> (LogicalColour -> LogicalColour) -> LogicalColour -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite (LogicalColour -> Rational)
-> (LogicalColour -> Rational)
-> LogicalColour
-> (Rational, Rational)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Rational
forall c. Fractional c => LogicalColour -> c
valuePassedPawns
) (LogicalColour -> CriterionValue)
-> LogicalColour -> 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 :: LogicalColour -> c
valuePassedPawns LogicalColour
logicalColour = (c -> Coordinates x y -> c) -> c -> [Coordinates x y] -> c
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\c
acc -> (c
acc c -> c -> c
forall a. Num a => a -> a -> a
+) (c -> c) -> (Coordinates x y -> c) -> Coordinates x y -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> c
forall a. Fractional a => a -> a
recip (c -> c) -> (Coordinates x y -> c) -> Coordinates x y -> 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)
-> (Coordinates x y -> NPieces) -> Coordinates x y -> c
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
) c
0 ([Coordinates x y] -> c) -> [Coordinates x y] -> c
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
maximumDefended :: Type.Count.NPieces
maximumDefended :: NPieces
maximumDefended = NPieces
70
measureValueOfDefence :: Model.Game.Game x y -> Metric.CriterionValue.CriterionValue
measureValueOfDefence :: Game x y -> CriterionValue
measureValueOfDefence Game x y
game = Rational -> CriterionValue
forall a. Fractional a => Rational -> a
fromRational (Rational -> CriterionValue)
-> (Board x y -> Rational) -> Board x y -> CriterionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ NPieces -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
maximumDefended
) (Rational -> Rational)
-> (Board x y -> Rational) -> Board x y -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> Rational)
-> (Board x y -> NPieces) -> Board x y -> Rational
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 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) -> Board x y -> 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
evaluateFitness :: (
#ifdef USE_UNBOXED_ARRAYS
Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue,
#endif
Enum x,
Enum y,
Fractional pieceSquareValue,
Ord x,
Ord y,
Real pieceSquareValue,
Show x,
Show y
)
=> Maybe pieceSquareValue
-> Model.Game.Game x y
-> Input.EvaluationOptions.Reader pieceSquareValue x y Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues
{-# SPECIALISE evaluateFitness :: Maybe Type.Mass.PieceSquareValue -> Model.Game.Game Type.Length.X Type.Length.Y -> Input.EvaluationOptions.Reader Type.Mass.PieceSquareValue Type.Length.X Type.Length.Y Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues #-}
evaluateFitness :: Maybe pieceSquareValue
-> Game x y
-> Reader pieceSquareValue x y WeightedMeanAndCriterionValues
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
-> Reader pieceSquareValue x y WeightedMeanAndCriterionValues
forall (m :: * -> *) a. Monad m => a -> m a
return (WeightedMeanAndCriterionValues
-> Reader pieceSquareValue x y WeightedMeanAndCriterionValues)
-> WeightedMeanAndCriterionValues
-> Reader pieceSquareValue x y WeightedMeanAndCriterionValues
forall a b. (a -> b) -> a -> b
$ CriterionValue
-> [CriterionValue] -> WeightedMeanAndCriterionValues
Metric.WeightedMeanAndCriterionValues.mkWeightedMeanAndCriterionValues (
if GameTerminationReason -> Bool
Rule.GameTerminationReason.isCheckMate GameTerminationReason
gameTerminationReason
then CriterionValue
1
else CriterionValue
0
) []
| Bool
otherwise = do
CriteriaWeights
criteriaWeights <- (EvaluationOptions pieceSquareValue x y -> CriteriaWeights)
-> ReaderT
(EvaluationOptions pieceSquareValue x y) Identity CriteriaWeights
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks EvaluationOptions pieceSquareValue x y -> CriteriaWeights
forall pieceSquareValue x y.
EvaluationOptions pieceSquareValue x y -> CriteriaWeights
Input.EvaluationOptions.getCriteriaWeights
(RankValues, CriterionValue)
rankValuePair <- (EvaluationOptions pieceSquareValue x y
-> (RankValues, CriterionValue))
-> ReaderT
(EvaluationOptions pieceSquareValue x y)
Identity
(RankValues, CriterionValue)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks ((EvaluationOptions pieceSquareValue x y
-> (RankValues, CriterionValue))
-> ReaderT
(EvaluationOptions pieceSquareValue x y)
Identity
(RankValues, CriterionValue))
-> (EvaluationOptions pieceSquareValue x y
-> (RankValues, CriterionValue))
-> ReaderT
(EvaluationOptions pieceSquareValue x y)
Identity
(RankValues, CriterionValue)
forall a b. (a -> b) -> a -> b
$ EvaluationOptions pieceSquareValue x y -> RankValues
forall pieceSquareValue x y.
EvaluationOptions pieceSquareValue x y -> RankValues
Input.EvaluationOptions.getRankValues (EvaluationOptions pieceSquareValue x y -> RankValues)
-> (EvaluationOptions pieceSquareValue x y -> CriterionValue)
-> EvaluationOptions pieceSquareValue x y
-> (RankValues, CriterionValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& EvaluationOptions pieceSquareValue x y -> CriterionValue
forall pieceSquareValue x y.
EvaluationOptions pieceSquareValue x y -> CriterionValue
Input.EvaluationOptions.getMaximumTotalRankValue
Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
maybePieceSquareByCoordinatesByRank <- (EvaluationOptions pieceSquareValue x y
-> Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue))
-> ReaderT
(EvaluationOptions pieceSquareValue x y)
Identity
(Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks EvaluationOptions pieceSquareValue x y
-> Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
forall pieceSquareValue x y.
EvaluationOptions pieceSquareValue x y
-> Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank
WeightedMeanAndCriterionValues
-> Reader pieceSquareValue x y WeightedMeanAndCriterionValues
forall (m :: * -> *) a. Monad m => a -> m a
return (WeightedMeanAndCriterionValues
-> Reader pieceSquareValue x y WeightedMeanAndCriterionValues)
-> WeightedMeanAndCriterionValues
-> Reader pieceSquareValue x y WeightedMeanAndCriterionValues
forall a b. (a -> b) -> a -> b
$ CriteriaWeights
-> CriterionValue
-> CriterionValue
-> CriterionValue
-> CriterionValue
-> CriterionValue
-> CriterionValue
-> CriterionValue
-> CriterionValue
-> WeightedMeanAndCriterionValues
Input.CriteriaWeights.calculateWeightedMean CriteriaWeights
criteriaWeights (
(RankValues -> CriterionValue -> Game x y -> CriterionValue)
-> (RankValues, CriterionValue) -> Game x y -> CriterionValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RankValues -> CriterionValue -> Game x y -> CriterionValue
forall x y.
RankValues -> CriterionValue -> Game x y -> CriterionValue
measureValueOfMaterial (RankValues, CriterionValue)
rankValuePair Game x y
game
) (
Game x y -> CriterionValue
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> CriterionValue
measureValueOfMobility Game x y
game
) (
CriterionValue
-> (pieceSquareValue -> CriterionValue)
-> Maybe pieceSquareValue
-> CriterionValue
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe CriterionValue
0 pieceSquareValue -> CriterionValue
forall pieceSquareValue.
Real pieceSquareValue =>
pieceSquareValue -> CriterionValue
mkPieceSquareCriterionValue (Maybe pieceSquareValue -> CriterionValue)
-> Maybe pieceSquareValue -> 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
forall x y. Game x y -> CriterionValue
measureValueOfCastlingPotential Game x y
game
) (
Game x y -> CriterionValue
forall x y. Game x y -> CriterionValue
measureValueOfDefence Game x y
game
) (
Game x y -> CriterionValue
forall x y. Game x y -> CriterionValue
measureValueOfDoubledPawns Game x y
game
) (
Game x y -> CriterionValue
forall x y. (Enum x, Ord x) => Game x y -> CriterionValue
measureValueOfIsolatedPawns Game x y
game
) (
Game x y -> CriterionValue
forall x y. Enum y => Game x y -> CriterionValue
measureValueOfPassedPawns Game x y
game
)