{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Defines configurable options related to the evaluation of the game at any instance.

	* N.B.: 'evaluation' is distinct from 'search':
		evaluation => how one assesses the fitness of candidate moves;
		search => the order in which one evaluates candidates before selecting on the basis of their fitness.
-}

module BishBosh.Input.EvaluationOptions(
-- * Types
-- ** Type-synonyms
        IncrementalEvaluation,
        Reader,
-- ** Data-types
        EvaluationOptions(
--		MkEvaluationOptions,
                getRankValues,
                getCriteriaWeights,
                getIncrementalEvaluation,
--		getMaybePieceSquareTables,
                getMaybePieceSquareArray
        ),
-- * Constants
        tag,
--	incrementalEvaluationTag,
--	pieceSquareTablesTag,
--	pieceSquareTableEndGameTag,
-- * Functions
-- ** Constructor
        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

-- | Used to qualify XML.
tag :: String
tag                             = "evaluationOptions"

-- | Used to qualify XML.
incrementalEvaluationTag :: String
incrementalEvaluationTag        = "incrementalEvaluation"

-- | Used to qualify XML.
pieceSquareTablesTag :: String
pieceSquareTablesTag            = showString Input.PieceSquareTable.tag "s"

-- | Used to qualify XML.
pieceSquareTableEndGameTag :: String
pieceSquareTableEndGameTag      = showString Input.PieceSquareTable.tag "EndGame"

-- | Whether to generate position-hashes incrementally from the hash of the position prior to the last move.
type IncrementalEvaluation      = Bool

-- | Defines the options related to the automatic selection of /move/s.
data EvaluationOptions criterionWeight pieceSquareValue rankValue x y   = MkEvaluationOptions {
        getRankValues                   :: Attribute.RankValues.RankValues rankValue,                   -- ^ The static value associated with each /piece/'s /rank/.
        getCriteriaWeights              :: Input.CriteriaWeights.CriteriaWeights criterionWeight,       -- ^ The weights applied to each of the heterogeneous criterion-values used to select a /move/.
        getIncrementalEvaluation        :: IncrementalEvaluation,                                       -- ^ Whether to generate position-hashes & evaluate the piece-square value, from the previous value or from scratch.
        getMaybePieceSquareTables       :: Maybe (
                Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue,
                Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue
        ),                                                                                              -- ^ Optional piece-square tables; the first governs normal play & the second governs the end-game.
        getMaybePieceSquareArray        :: Maybe (
                Component.PieceSquareArray.PieceSquareArray x y pieceSquareValue
        )                                                                                               -- ^ The optional value for each type of /piece/ of occupying each coordinate, at each stage in the lifetime of the game.
} 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,
--		getMaybePieceSquareTables	= maybePieceSquareTables,
                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
--		getMaybePieceSquareArray	= maybePieceSquareArray
        } = 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,   -- Construct.
                \MkEvaluationOptions {
                        getRankValues                   = rankValues,
                        getCriteriaWeights              = criteriaWeights,
                        getIncrementalEvaluation        = incrementalEvaluation,
                        getMaybePieceSquareTables       = maybePieceSquareTables
--			getMaybePieceSquareArray	= maybePieceSquareArray
                } -> (
                        rankValues,
                        criteriaWeights,
                        incrementalEvaluation,
                        maybePieceSquareTables
                ) -- Deconstruct.
         ) . HXT.xp4Tuple HXT.xpickle {-RankValues-} HXT.xpickle {-CriteriaWeights-} (
                getIncrementalEvaluation def `HXT.xpDefault` HXT.xpAttr incrementalEvaluationTag HXT.xpickle {-Bool-}
         ) . HXT.xpOption . HXT.xpElem pieceSquareTablesTag $ HXT.xpElem Input.PieceSquareTable.tag HXT.xpickle `HXT.xpPair` HXT.xpElem pieceSquareTableEndGameTag HXT.xpickle where
                def     = Data.Default.def

-- | Smart constructor.
mkEvaluationOptions :: (
        Enum            x,
        Enum            y,
        Eq              pieceSquareValue,
        Eq              criterionWeight,
        Fractional      pieceSquareValue,
        Num             criterionWeight,
        Ord             x,
        Ord             y
 )
        => Attribute.RankValues.RankValues rankValue                                                                                            -- ^ The static value associated with each /piece/'s /rank/.
        -> Input.CriteriaWeights.CriteriaWeights criterionWeight                                                                                -- ^ The weights applied to the values of the criteria used to select a /move/.
        -> IncrementalEvaluation
        -> Maybe (Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue, Input.PieceSquareTable.PieceSquareTable x y pieceSquareValue)   -- ^ The value to each type of piece, of each square, during normal play & the end-game.
        -> 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 {-minimum sufficient material-}, 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
                                        ) -- Normalise into the closed unit-interval [0,1].
                                ) . fromIntegral . subtract minNPieces
                        ) $ uncurry enumFromTo nPiecesBounds
                        | otherwise             = Left normal   -- Interpolation is unnecessary.

-- | Self-documentation.
type Reader criterionWeight pieceSquareValue rankValue x y      = Control.Monad.Reader.Reader (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)