module BishBosh.Input.CriteriaWeights(
CriteriaWeights(
getWeightOfMaterial,
getWeightOfMobility,
getWeightOfPieceSquareValue,
getWeightOfCastlingPotential,
getWeightOfDefence,
getWeightOfDoubledPawns,
getWeightOfIsolatedPawns,
getWeightOfPassedPawns
),
tag,
weightOfMaterialTag,
weightOfPieceSquareValueTag,
onymousOperators,
calculateWeightedMean,
normalise,
perturbWeights,
mkCriteriaWeights
) where
import qualified BishBosh.Attribute.CriterionValue as Attribute.CriterionValue
import qualified BishBosh.Attribute.CriterionWeight as Attribute.CriterionWeight
import qualified BishBosh.Attribute.WeightedMeanAndCriterionValues as Attribute.WeightedMeanAndCriterionValues
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Property.ShowFloat as Property.ShowFloat
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Types as T
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Default
import qualified System.Random
import qualified Text.XML.HXT.Arrow.Pickle as HXT
tag :: String
tag = "criteriaWeights"
weightOfMaterialTag :: String
weightOfMaterialTag = "material"
weightOfMobilityTag :: String
weightOfMobilityTag = "mobility"
weightOfPieceSquareValueTag :: String
weightOfPieceSquareValueTag = "pieceSquareValue"
weightOfCastlingPotentialTag :: String
weightOfCastlingPotentialTag = "castlingPotential"
weightOfDefenceTag :: String
weightOfDefenceTag = "defence"
weightOfDoubledPawnsTag :: String
weightOfDoubledPawnsTag = "doubledPawns"
weightOfIsolatedPawnsTag :: String
weightOfIsolatedPawnsTag = "isolatedPawns"
weightOfPassedPawnsTag :: String
weightOfPassedPawnsTag = "passedPawns"
data CriteriaWeights criterionWeight = MkCriteriaWeights {
getWeightOfMaterial :: Attribute.CriterionWeight.CriterionWeight criterionWeight,
getWeightOfMobility :: Attribute.CriterionWeight.CriterionWeight criterionWeight,
getWeightOfPieceSquareValue :: Attribute.CriterionWeight.CriterionWeight criterionWeight,
getWeightOfCastlingPotential :: Attribute.CriterionWeight.CriterionWeight criterionWeight,
getWeightOfDefence :: Attribute.CriterionWeight.CriterionWeight criterionWeight,
getWeightOfDoubledPawns :: Attribute.CriterionWeight.CriterionWeight criterionWeight,
getWeightOfIsolatedPawns :: Attribute.CriterionWeight.CriterionWeight criterionWeight,
getWeightOfPassedPawns :: Attribute.CriterionWeight.CriterionWeight criterionWeight
} deriving (Eq, Show)
mkCriteriaWeights
:: (Eq criterionWeight, Num criterionWeight)
=> Attribute.CriterionWeight.CriterionWeight criterionWeight
-> Attribute.CriterionWeight.CriterionWeight criterionWeight
-> Attribute.CriterionWeight.CriterionWeight criterionWeight
-> Attribute.CriterionWeight.CriterionWeight criterionWeight
-> Attribute.CriterionWeight.CriterionWeight criterionWeight
-> Attribute.CriterionWeight.CriterionWeight criterionWeight
-> Attribute.CriterionWeight.CriterionWeight criterionWeight
-> Attribute.CriterionWeight.CriterionWeight criterionWeight
-> CriteriaWeights criterionWeight
mkCriteriaWeights a b c d e f g h
| criteriaWeights == minBound = Control.Exception.throw $ Data.Exception.mkInvalidDatum "BishBosh.Input.CriteriaWeights.mkCriteriaWeights:\tall weights are zero."
| otherwise = criteriaWeights
where
criteriaWeights = MkCriteriaWeights a b c d e f g h
instance Real criterionWeight => Property.ShowFloat.ShowFloat (CriteriaWeights criterionWeight) where
showsFloat fromDouble MkCriteriaWeights {
getWeightOfMaterial = weightOfMaterial,
getWeightOfMobility = weightOfMobility,
getWeightOfPieceSquareValue = weightOfPieceSquareValue,
getWeightOfCastlingPotential = weightOfCastlingPotential,
getWeightOfDefence = weightOfDefence,
getWeightOfDoubledPawns = weightOfDoubledPawns,
getWeightOfIsolatedPawns = weightOfIsolatedPawns,
getWeightOfPassedPawns = weightOfPassedPawns
} = Text.ShowList.showsAssociationList' $ map (
Control.Arrow.second $ fromDouble . realToFrac . Attribute.CriterionWeight.deconstruct
) [
(
weightOfMaterialTag, weightOfMaterial
), (
weightOfMobilityTag, weightOfMobility
), (
weightOfPieceSquareValueTag, weightOfPieceSquareValue
), (
weightOfCastlingPotentialTag, weightOfCastlingPotential
), (
weightOfDefenceTag, weightOfDefence
), (
weightOfDoubledPawnsTag, weightOfDoubledPawns
), (
weightOfIsolatedPawnsTag, weightOfIsolatedPawns
), (
weightOfPassedPawnsTag, weightOfPassedPawns
)
]
instance Num criterionWeight => Data.Default.Default (CriteriaWeights criterionWeight) where
def = MkCriteriaWeights {
getWeightOfMaterial = maxBound,
getWeightOfMobility = Data.Default.def,
getWeightOfPieceSquareValue = Data.Default.def,
getWeightOfCastlingPotential = Data.Default.def,
getWeightOfDefence = Data.Default.def,
getWeightOfDoubledPawns = Data.Default.def,
getWeightOfIsolatedPawns = Data.Default.def,
getWeightOfPassedPawns = Data.Default.def
}
instance Control.DeepSeq.NFData criterionWeight => Control.DeepSeq.NFData (CriteriaWeights criterionWeight) where
rnf (MkCriteriaWeights a b c d e f g h) = Control.DeepSeq.rnf [a, b, c, d, e, f, g, h]
instance Num criterionWeight => Bounded (CriteriaWeights criterionWeight) where
maxBound = MkCriteriaWeights maxBound maxBound maxBound maxBound maxBound maxBound maxBound maxBound
minBound = MkCriteriaWeights minBound minBound minBound minBound minBound minBound minBound minBound
instance (
HXT.XmlPickler criterionWeight,
Num criterionWeight,
Ord criterionWeight,
Show criterionWeight
) => HXT.XmlPickler (CriteriaWeights criterionWeight) where
xpickle = HXT.xpDefault Data.Default.def . HXT.xpElem tag $ HXT.xpWrap (
\(a, b, c, d, e, f, g, h) -> mkCriteriaWeights a b c d e f g h,
\MkCriteriaWeights {
getWeightOfMaterial = weightOfMaterial,
getWeightOfMobility = weightOfMobility,
getWeightOfPieceSquareValue = weightOfPieceSquareValue,
getWeightOfCastlingPotential = weightOfCastlingPotential,
getWeightOfDefence = weightOfDefence,
getWeightOfDoubledPawns = weightOfDoubledPawns,
getWeightOfIsolatedPawns = weightOfIsolatedPawns,
getWeightOfPassedPawns = weightOfPassedPawns
} -> (
weightOfMaterial,
weightOfMobility,
weightOfPieceSquareValue,
weightOfCastlingPotential,
weightOfDefence,
weightOfDoubledPawns,
weightOfIsolatedPawns,
weightOfPassedPawns
)
) $ HXT.xp8Tuple (
xpickle' weightOfMaterialTag
) (
xpickle' weightOfMobilityTag
) (
xpickle' weightOfPieceSquareValueTag
) (
xpickle' weightOfCastlingPotentialTag
) (
xpickle' weightOfDefenceTag
) (
xpickle' weightOfDoubledPawnsTag
) (
xpickle' weightOfIsolatedPawnsTag
) (
xpickle' weightOfPassedPawnsTag
) where
xpickle' = HXT.xpDefault Data.Default.def . (`HXT.xpAttr` HXT.xpickle)
calculateWeightedMean :: (
Fractional weightedMean,
Real criterionValue,
Real criterionWeight
)
=> CriteriaWeights criterionWeight
-> Attribute.CriterionValue.CriterionValue criterionValue
-> Attribute.CriterionValue.CriterionValue criterionValue
-> Attribute.CriterionValue.CriterionValue criterionValue
-> Attribute.CriterionValue.CriterionValue criterionValue
-> Attribute.CriterionValue.CriterionValue criterionValue
-> Attribute.CriterionValue.CriterionValue criterionValue
-> Attribute.CriterionValue.CriterionValue criterionValue
-> Attribute.CriterionValue.CriterionValue criterionValue
-> Attribute.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues weightedMean criterionValue
{-# SPECIALISE calculateWeightedMean
:: CriteriaWeights T.CriterionWeight
-> Attribute.CriterionValue.CriterionValue T.CriterionValue
-> Attribute.CriterionValue.CriterionValue T.CriterionValue
-> Attribute.CriterionValue.CriterionValue T.CriterionValue
-> Attribute.CriterionValue.CriterionValue T.CriterionValue
-> Attribute.CriterionValue.CriterionValue T.CriterionValue
-> Attribute.CriterionValue.CriterionValue T.CriterionValue
-> Attribute.CriterionValue.CriterionValue T.CriterionValue
-> Attribute.CriterionValue.CriterionValue T.CriterionValue
-> Attribute.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues T.WeightedMean T.CriterionValue
#-}
calculateWeightedMean MkCriteriaWeights {
getWeightOfMaterial = weightOfMaterial,
getWeightOfMobility = weightOfMobility,
getWeightOfPieceSquareValue = weightOfPieceSquareValue,
getWeightOfCastlingPotential = weightOfCastlingPotential,
getWeightOfDefence = weightOfDefence,
getWeightOfDoubledPawns = weightOfDoubledPawns,
getWeightOfIsolatedPawns = weightOfIsolatedPawns,
getWeightOfPassedPawns = weightOfPassedPawns
} material mobility pieceSquareValue castlingPotential defence doubledPawns isolatedPawns passedPawns = Attribute.CriterionValue.calculateWeightedMean [
(
material, weightOfMaterial
), (
mobility, weightOfMobility
), (
pieceSquareValue, weightOfPieceSquareValue
), (
castlingPotential, weightOfCastlingPotential
), (
defence, weightOfDefence
), (
doubledPawns, weightOfDoubledPawns
), (
isolatedPawns, weightOfIsolatedPawns
), (
passedPawns, weightOfPassedPawns
)
]
type Transformation criterionWeight = CriteriaWeights criterionWeight -> CriteriaWeights criterionWeight
normalise :: (
Fractional criterionWeight,
Ord criterionWeight,
Show criterionWeight
) => Transformation criterionWeight
normalise criteriaWeights@MkCriteriaWeights {
getWeightOfMaterial = weightOfMaterial,
getWeightOfMobility = weightOfMobility,
getWeightOfPieceSquareValue = weightOfPieceSquareValue,
getWeightOfCastlingPotential = weightOfCastlingPotential,
getWeightOfDefence = weightOfDefence,
getWeightOfDoubledPawns = weightOfDoubledPawns,
getWeightOfIsolatedPawns = weightOfIsolatedPawns,
getWeightOfPassedPawns = weightOfPassedPawns
} = Control.Exception.assert (
criteriaWeights /= minBound
) MkCriteriaWeights {
getWeightOfMaterial = normaliseCriterionWeight weightOfMaterial,
getWeightOfMobility = normaliseCriterionWeight weightOfMobility,
getWeightOfPieceSquareValue = normaliseCriterionWeight weightOfPieceSquareValue,
getWeightOfCastlingPotential = normaliseCriterionWeight weightOfCastlingPotential,
getWeightOfDefence = normaliseCriterionWeight weightOfDefence,
getWeightOfDoubledPawns = normaliseCriterionWeight weightOfDoubledPawns,
getWeightOfIsolatedPawns = normaliseCriterionWeight weightOfIsolatedPawns,
getWeightOfPassedPawns = normaliseCriterionWeight weightOfPassedPawns
} where
normaliseCriterionWeight = Attribute.CriterionWeight.mkCriterionWeight . (
/ Attribute.CriterionWeight.deconstruct (
maximum [
weightOfMaterial,
weightOfMobility,
weightOfPieceSquareValue,
weightOfCastlingPotential,
weightOfDefence,
weightOfDoubledPawns,
weightOfIsolatedPawns,
weightOfPassedPawns
]
)
) . Attribute.CriterionWeight.deconstruct
perturbWeights :: (
Fractional criterionWeight,
Real criterionWeight,
Show criterionWeight,
System.Random.RandomGen randomGen
)
=> randomGen
-> criterionWeight
-> Transformation criterionWeight
perturbWeights _ 0 criteriaWeights = criteriaWeights
perturbWeights randomGen changeMagnitude MkCriteriaWeights {
getWeightOfMaterial = weightOfMaterial,
getWeightOfMobility = weightOfMobility,
getWeightOfPieceSquareValue = weightOfPieceSquareValue,
getWeightOfCastlingPotential = weightOfCastlingPotential,
getWeightOfDefence = weightOfDefence,
getWeightOfDoubledPawns = weightOfDoubledPawns,
getWeightOfIsolatedPawns = weightOfIsolatedPawns,
getWeightOfPassedPawns = weightOfPassedPawns
} = Control.Exception.assert (changeMagnitude > 0) $ normalise MkCriteriaWeights {
getWeightOfMaterial = reduceBy a weightOfMaterial,
getWeightOfMobility = reduceBy b weightOfMobility,
getWeightOfPieceSquareValue = reduceBy c weightOfPieceSquareValue,
getWeightOfCastlingPotential = reduceBy d weightOfCastlingPotential,
getWeightOfDefence = reduceBy e weightOfDefence,
getWeightOfDoubledPawns = reduceBy f weightOfDoubledPawns,
getWeightOfIsolatedPawns = reduceBy g weightOfIsolatedPawns,
getWeightOfPassedPawns = reduceBy h weightOfPassedPawns
} where
(a : b : c : d : e : f : g : h : _) = System.Random.randomRs (1 :: Double, succ $ realToFrac changeMagnitude) randomGen
reduceBy randomValue = Attribute.CriterionWeight.mkCriterionWeight . (/ realToFrac randomValue) . Attribute.CriterionWeight.deconstruct
onymousOperators :: [
(
String,
CriteriaWeights criterionWeight -> Attribute.CriterionWeight.CriterionWeight criterionWeight,
Attribute.CriterionWeight.CriterionWeight criterionWeight -> Transformation criterionWeight
)
]
onymousOperators = [
(
weightOfMaterialTag,
getWeightOfMaterial,
\w criteriaWeights -> criteriaWeights { getWeightOfMaterial = w }
), (
weightOfMobilityTag,
getWeightOfMobility,
\w criteriaWeights -> criteriaWeights { getWeightOfMobility = w }
), (
weightOfPieceSquareValueTag,
getWeightOfPieceSquareValue,
\w criteriaWeights -> criteriaWeights { getWeightOfPieceSquareValue = w }
), (
weightOfCastlingPotentialTag,
getWeightOfCastlingPotential,
\w criteriaWeights -> criteriaWeights { getWeightOfCastlingPotential = w }
), (
weightOfDefenceTag,
getWeightOfDefence,
\w criteriaWeights -> criteriaWeights { getWeightOfDefence = w }
), (
weightOfDoubledPawnsTag,
getWeightOfDoubledPawns,
\w criteriaWeights -> criteriaWeights { getWeightOfDoubledPawns = w }
), (
weightOfIsolatedPawnsTag,
getWeightOfIsolatedPawns,
\w criteriaWeights -> criteriaWeights { getWeightOfIsolatedPawns = w }
), (
weightOfPassedPawnsTag,
getWeightOfPassedPawns,
\w criteriaWeights -> criteriaWeights { getWeightOfPassedPawns = w }
)
]