module BishBosh.Input.EvaluationOptions(
IncrementalEvaluation,
Reader,
EvaluationOptions(
getRankValues,
getCriteriaWeights,
getIncrementalEvaluation,
getMaybePieceSquareArray
),
tag,
mkEvaluationOptions
) where
import BishBosh.Data.Bool()
import Control.Arrow((&&&), (***))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Attribute.RankValues as Attribute.RankValues
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Component.Piece as Component.Piece
import qualified BishBosh.Component.PieceSquareArray as Component.PieceSquareArray
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Input.CriteriaWeights as Input.CriteriaWeights
import qualified BishBosh.Input.PieceSquareTable as Input.PieceSquareTable
import qualified BishBosh.Property.ShowFloat as Property.ShowFloat
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Control.Monad.Reader
import qualified Data.Array.IArray
import qualified Data.Default
import qualified Data.Maybe
import qualified Data.Set
import qualified Text.XML.HXT.Arrow.Pickle as HXT
tag :: String
tag = "evaluationOptions"
incrementalEvaluationTag :: String
incrementalEvaluationTag = "incrementalEvaluation"
pieceSquareTablesTag :: String
pieceSquareTablesTag = showString Input.PieceSquareTable.tag "s"
pieceSquareTableEndGameTag :: String
pieceSquareTableEndGameTag = showString Input.PieceSquareTable.tag "EndGame"
type IncrementalEvaluation = Bool
data EvaluationOptions criterionWeight pieceSquareValue rankValue x y = MkEvaluationOptions {
getRankValues :: Attribute.RankValues.RankValues rankValue,
getCriteriaWeights :: Input.CriteriaWeights.CriteriaWeights criterionWeight,
getIncrementalEvaluation :: IncrementalEvaluation,
getMaybePieceSquareTables :: Maybe (
Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue,
Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue
),
getMaybePieceSquareArray :: Maybe (
Component.PieceSquareArray.PieceSquareArray x y pieceSquareValue
)
} deriving (Eq, Show)
instance (
Control.DeepSeq.NFData criterionWeight,
Control.DeepSeq.NFData pieceSquareValue,
Control.DeepSeq.NFData rankValue,
Control.DeepSeq.NFData x,
Control.DeepSeq.NFData y
) => Control.DeepSeq.NFData (EvaluationOptions criterionWeight pieceSquareValue rankValue x y) where
rnf MkEvaluationOptions {
getRankValues = rankValues,
getCriteriaWeights = criteriaWeights,
getIncrementalEvaluation = incrementalEvaluation,
getMaybePieceSquareArray = maybePieceSquareArray
} = Control.DeepSeq.rnf (rankValues, criteriaWeights, incrementalEvaluation, maybePieceSquareArray)
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Real criterionWeight,
Real pieceSquareValue,
Real rankValue,
Show pieceSquareValue
) => Property.ShowFloat.ShowFloat (EvaluationOptions criterionWeight pieceSquareValue rankValue x y) where
showsFloat fromDouble MkEvaluationOptions {
getRankValues = rankValues,
getCriteriaWeights = criteriaWeights,
getIncrementalEvaluation = incrementalEvaluation,
getMaybePieceSquareTables = maybePieceSquareTables
} = Text.ShowList.showsAssociationList' $ [
(
Attribute.RankValues.tag, Property.ShowFloat.showsFloat fromDouble rankValues
), (
incrementalEvaluationTag, shows incrementalEvaluation
), (
Input.CriteriaWeights.tag, Property.ShowFloat.showsFloat fromDouble criteriaWeights
)
] ++ Data.Maybe.maybe [] (
\(t, t') -> [
(
Input.PieceSquareTable.tag,
Property.ShowFloat.showsFloat fromDouble t
), (
pieceSquareTableEndGameTag,
Property.ShowFloat.showsFloat fromDouble t'
)
]
) maybePieceSquareTables
instance (
Fractional rankValue,
Num criterionWeight,
Ord rankValue,
Show rankValue
) => Data.Default.Default (EvaluationOptions criterionWeight pieceSquareValue rankValue x y) where
def = MkEvaluationOptions {
getRankValues = Data.Default.def,
getCriteriaWeights = Data.Default.def,
getIncrementalEvaluation = True,
getMaybePieceSquareTables = Nothing,
getMaybePieceSquareArray = Nothing
}
instance (
Enum x,
Enum y,
Fractional pieceSquareValue,
Fractional rankValue,
HXT.XmlPickler criterionWeight,
HXT.XmlPickler rankValue,
Num criterionWeight,
Ord criterionWeight,
Ord pieceSquareValue,
Ord rankValue,
Ord x,
Ord y,
Real pieceSquareValue,
Show pieceSquareValue,
Show criterionWeight,
Show rankValue
) => HXT.XmlPickler (EvaluationOptions criterionWeight pieceSquareValue rankValue x y) where
xpickle = HXT.xpDefault def . HXT.xpElem tag . HXT.xpWrap (
\(a, b, c, d) -> mkEvaluationOptions a b c d,
\MkEvaluationOptions {
getRankValues = rankValues,
getCriteriaWeights = criteriaWeights,
getIncrementalEvaluation = incrementalEvaluation,
getMaybePieceSquareTables = maybePieceSquareTables
} -> (
rankValues,
criteriaWeights,
incrementalEvaluation,
maybePieceSquareTables
)
) . HXT.xp4Tuple HXT.xpickle HXT.xpickle (
getIncrementalEvaluation def `HXT.xpDefault` HXT.xpAttr incrementalEvaluationTag HXT.xpickle
) . HXT.xpOption . HXT.xpElem pieceSquareTablesTag $ HXT.xpElem Input.PieceSquareTable.tag HXT.xpickle `HXT.xpPair` HXT.xpElem pieceSquareTableEndGameTag HXT.xpickle where
def = Data.Default.def
mkEvaluationOptions :: (
Enum x,
Enum y,
Eq pieceSquareValue,
Eq criterionWeight,
Fractional pieceSquareValue,
Num criterionWeight,
Ord x,
Ord y
)
=> Attribute.RankValues.RankValues rankValue
-> Input.CriteriaWeights.CriteriaWeights criterionWeight
-> IncrementalEvaluation
-> Maybe (Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue, Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue)
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
mkEvaluationOptions rankValues criteriaWeights incrementalEvaluation maybePieceSquareTables
| Just (pieceSquareTable, _) <- maybePieceSquareTables
, let undefinedRanks = Input.PieceSquareTable.findUndefinedRanks pieceSquareTable
, not $ Data.Set.null undefinedRanks
= Control.Exception.throw . Data.Exception.mkInsufficientData . showString "BishBosh.Input.EvaluationOptions.mkEvaluationOptions:\tranks" . Text.ShowList.showsAssociation $ shows (Data.Set.toList undefinedRanks) " are undefined."
| Input.CriteriaWeights.getWeightOfPieceSquareValue criteriaWeights /= minBound
, Data.Maybe.isNothing maybePieceSquareTables
= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Input.EvaluationOptions.mkEvaluationOptions:\tweight of " . shows Input.CriteriaWeights.weightOfPieceSquareValueTag . showString " is defined but " $ shows Input.PieceSquareTable.tag " isn't."
| otherwise = MkEvaluationOptions {
getRankValues = rankValues,
getCriteriaWeights = criteriaWeights,
getIncrementalEvaluation = incrementalEvaluation,
getMaybePieceSquareTables = maybePieceSquareTables,
getMaybePieceSquareArray = (
\pieceSquareTablePair -> Component.PieceSquareArray.mkPieceSquareArray (
\rank -> Cartesian.Coordinates.listArrayByCoordinates . (
\(normal, maybeEndGame) -> Data.Maybe.maybe (
map Left normal
) (
zipWith interpolatePieceSquareValues normal
) maybeEndGame
) $ (
Data.Maybe.fromJust . Input.PieceSquareTable.dereference rank *** Input.PieceSquareTable.dereference rank
) pieceSquareTablePair
)
) `fmap` maybePieceSquareTables
} where
nPiecesBounds@(minNPieces, maxNPieces) = (3 , Attribute.LogicalColour.nDistinctLogicalColours * Component.Piece.nPiecesPerSide)
interpolatePieceSquareValues :: (
Eq pieceSquareValue,
Fractional pieceSquareValue
) => pieceSquareValue -> pieceSquareValue -> Component.PieceSquareArray.InterpolatedPieceSquareValues pieceSquareValue
interpolatePieceSquareValues normal endGame
| endGame /= normal = Right . Data.Array.IArray.listArray nPiecesBounds . map (
uncurry (+) . (
(* normal) &&& (* endGame) . (1 -)
) . (
/ fromIntegral (
maxNPieces - minNPieces
)
) . fromIntegral . subtract minNPieces
) $ uncurry enumFromTo nPiecesBounds
| otherwise = Left normal
type Reader criterionWeight pieceSquareValue rankValue x y = Control.Monad.Reader.Reader (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)