{-# LANGUAGE CPP #-}
{-
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 .
-}
{- |
[@AUTHOR@] Dr. Alistair Ward
[@DESCRIPTION@]
* The relative values of the various /rank/s of chess-piece.
*
-}
module BishBosh.Input.RankValues(
-- * Types
-- ** Data-types
RankValues(
-- MkRankValues,
-- deconstruct
),
-- * Constants
tag,
-- * Functions
findRankValue,
calculateMaximumTotalValue,
-- ** Constructor
fromAssocs
) where
import Control.Arrow((&&&), (***))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Data.Foldable as Data.Foldable
import qualified BishBosh.Metric.RankValue as Metric.RankValue
import qualified BishBosh.Property.ShowFloat as Property.ShowFloat
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Type.Mass as Type.Mass
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Default
import qualified Data.List
import qualified Text.XML.HXT.Arrow.Pickle as HXT
-- | Used to qualify XML.
tag :: String
tag = "rankValues"
{- |
* The constant value associated with each /rank/; the higher, the more valuable it is considered to be.
* N.B.: only relative values are significant; the absolute value associated with any /rank/ is irrelevant; typically ranks are valued in /centipawns/.
* CAVEAT: a @King@ can never be taken, but assigning the value /infinity/ creates problems, so typically it has the value @0@.
-}
newtype RankValues = MkRankValues {
deconstruct ::
#ifdef UNBOX_TYPEMASS_ARRAYS
Attribute.Rank.UArrayByRank
#else
Attribute.Rank.ArrayByRank
#endif
Metric.RankValue.RankValue
} deriving Eq
instance Read RankValues where
readsPrec precedence = map (Control.Arrow.first fromAssocs) . readsPrec precedence
instance Show RankValues where
showsPrec precedence MkRankValues { deconstruct = byRank } = showsPrec precedence $ Data.Array.IArray.assocs byRank
instance Property.ShowFloat.ShowFloat RankValues where
showsFloat fromDouble = Text.ShowList.showsAssociationList' . map (show *** Property.ShowFloat.showsFloat fromDouble) . Data.Array.IArray.assocs . deconstruct
instance Data.Default.Default RankValues where
def = MkRankValues . Attribute.Rank.listArrayByRank $ map (
fromRational . (/ 10) -- Map into the closed unit-interval.
) [
1,
5,
3,
3,
9,
0 -- N.B.: the King's value is immaterial (since it can't be taken), so it can be defined arbitrarily.
]
instance Control.DeepSeq.NFData RankValues where
rnf (MkRankValues byRank) =
#ifdef UNBOX_TYPEMASS_ARRAYS
Control.DeepSeq.rwhnf
#else
Control.DeepSeq.rnf
#endif
byRank
instance HXT.XmlPickler RankValues where
xpickle = HXT.xpDefault Data.Default.def . HXT.xpWrap (
fromAssocs, -- Construct from an association-list.
Data.Array.IArray.assocs . deconstruct -- Deconstruct to an association-list.
) . HXT.xpList1 . HXT.xpElem tag $ HXT.xpickle {-Rank-} `HXT.xpPair`
#ifndef USE_NEWTYPE_WRAPPERS
HXT.xpAttr Metric.RankValue.tag
#endif
HXT.xpickle
-- | Smart constructor.
fromAssocs :: [(Attribute.Rank.Rank, Metric.RankValue.RankValue)] -> RankValues
fromAssocs assocs
| not $ null undefinedRanks = Control.Exception.throw . Data.Exception.mkInsufficientData . showString "BishBosh.Input.RankValues.fromAssocs:\tranks" . Text.ShowList.showsAssociation $ shows undefinedRanks " are undefined."
| not $ null duplicateRanks = Control.Exception.throw . Data.Exception.mkDuplicateData . showString "BishBosh.Input.RankValues.fromAssocs:\tranks must be distinct; " $ shows duplicateRanks "."
| all (
(== 0) . snd {-RankValue-}
) assocs = Control.Exception.throw . Data.Exception.mkNullDatum . showString "BishBosh.Input.RankValues.fromAssocs:\tat least one rank should have a non-zero value; " $ shows assocs "."
| byRank ! Attribute.Rank.Queen /= maximum [
rankValue |
(rank, rankValue) <- assocs,
rank /= Attribute.Rank.King -- Whose rank-value is irrelevant.
] {-list-comprehension-} = Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Input.RankValues.fromAssocs:\texcepting possibly the King, the Queen should be the most valuable rank; " $ shows assocs "."
| otherwise = MkRankValues byRank
where
(undefinedRanks, duplicateRanks) = Attribute.Rank.findUndefinedRanks &&& Data.Foldable.findDuplicates $ map fst assocs
byRank = Attribute.Rank.arrayByRank assocs
-- | Query.
findRankValue :: RankValues -> Attribute.Rank.Rank -> Metric.RankValue.RankValue
findRankValue (MkRankValues byRank) = (byRank !)
{- |
* The maximum total rank-value one side can have.
* CAVEAT: assumes that zero pieces have been captured, all @Pawn@s have been queened, & that this is the most valuable /rank/ of /piece/.
-}
calculateMaximumTotalValue :: RankValues -> Type.Mass.RankValue
calculateMaximumTotalValue (MkRankValues byRank) = 9 {-accounting for all possible promotions-} * realToFrac (
byRank ! Attribute.Rank.Queen
) + 2 * Data.List.foldl' (
\acc -> (+ acc) . realToFrac . (byRank !)
) 0 Attribute.Rank.flank