{-
	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@]

	* The relative values of the various /rank/s of chess-piece.

	* <https://en.wikipedia.org/wiki/Chess_piece_relative_value#Hans_Berliner.27s_system%20Chess-piece%20relative%20values>
-}

module BishBosh.Attribute.RankValues(
-- * Types
-- ** Data-types
	RankValues(),
-- * 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.Data.Num		as Data.Num
import qualified	BishBosh.Property.ShowFloat	as Property.ShowFloat
import qualified	BishBosh.Text.ShowList		as Text.ShowList
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 :: String
tag	= String
"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 rankValue	= MkRankValues {
	RankValues rankValue -> ArrayByRank rankValue
deconstruct	:: Attribute.Rank.ArrayByRank rankValue
} deriving (RankValues rankValue -> RankValues rankValue -> Bool
(RankValues rankValue -> RankValues rankValue -> Bool)
-> (RankValues rankValue -> RankValues rankValue -> Bool)
-> Eq (RankValues rankValue)
forall rankValue.
Eq rankValue =>
RankValues rankValue -> RankValues rankValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RankValues rankValue -> RankValues rankValue -> Bool
$c/= :: forall rankValue.
Eq rankValue =>
RankValues rankValue -> RankValues rankValue -> Bool
== :: RankValues rankValue -> RankValues rankValue -> Bool
$c== :: forall rankValue.
Eq rankValue =>
RankValues rankValue -> RankValues rankValue -> Bool
Eq, ReadPrec [RankValues rankValue]
ReadPrec (RankValues rankValue)
Int -> ReadS (RankValues rankValue)
ReadS [RankValues rankValue]
(Int -> ReadS (RankValues rankValue))
-> ReadS [RankValues rankValue]
-> ReadPrec (RankValues rankValue)
-> ReadPrec [RankValues rankValue]
-> Read (RankValues rankValue)
forall rankValue. Read rankValue => ReadPrec [RankValues rankValue]
forall rankValue. Read rankValue => ReadPrec (RankValues rankValue)
forall rankValue.
Read rankValue =>
Int -> ReadS (RankValues rankValue)
forall rankValue. Read rankValue => ReadS [RankValues rankValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RankValues rankValue]
$creadListPrec :: forall rankValue. Read rankValue => ReadPrec [RankValues rankValue]
readPrec :: ReadPrec (RankValues rankValue)
$creadPrec :: forall rankValue. Read rankValue => ReadPrec (RankValues rankValue)
readList :: ReadS [RankValues rankValue]
$creadList :: forall rankValue. Read rankValue => ReadS [RankValues rankValue]
readsPrec :: Int -> ReadS (RankValues rankValue)
$creadsPrec :: forall rankValue.
Read rankValue =>
Int -> ReadS (RankValues rankValue)
Read, Int -> RankValues rankValue -> ShowS
[RankValues rankValue] -> ShowS
RankValues rankValue -> String
(Int -> RankValues rankValue -> ShowS)
-> (RankValues rankValue -> String)
-> ([RankValues rankValue] -> ShowS)
-> Show (RankValues rankValue)
forall rankValue.
Show rankValue =>
Int -> RankValues rankValue -> ShowS
forall rankValue. Show rankValue => [RankValues rankValue] -> ShowS
forall rankValue. Show rankValue => RankValues rankValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RankValues rankValue] -> ShowS
$cshowList :: forall rankValue. Show rankValue => [RankValues rankValue] -> ShowS
show :: RankValues rankValue -> String
$cshow :: forall rankValue. Show rankValue => RankValues rankValue -> String
showsPrec :: Int -> RankValues rankValue -> ShowS
$cshowsPrec :: forall rankValue.
Show rankValue =>
Int -> RankValues rankValue -> ShowS
Show)

instance Real rankValue => Property.ShowFloat.ShowFloat (RankValues rankValue) where
	showsFloat :: (Double -> ShowS) -> RankValues rankValue -> ShowS
showsFloat Double -> ShowS
fromDouble	= [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS)
-> (RankValues rankValue -> [(String, ShowS)])
-> RankValues rankValue
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rank, rankValue) -> (String, ShowS))
-> [(Rank, rankValue)] -> [(String, ShowS)]
forall a b. (a -> b) -> [a] -> [b]
map (Rank -> String
forall a. Show a => a -> String
show (Rank -> String)
-> (rankValue -> ShowS) -> (Rank, rankValue) -> (String, ShowS)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Double -> ShowS
fromDouble (Double -> ShowS) -> (rankValue -> Double) -> rankValue -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rankValue -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac) ([(Rank, rankValue)] -> [(String, ShowS)])
-> (RankValues rankValue -> [(Rank, rankValue)])
-> RankValues rankValue
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Rank rankValue -> [(Rank, rankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (Array Rank rankValue -> [(Rank, rankValue)])
-> (RankValues rankValue -> Array Rank rankValue)
-> RankValues rankValue
-> [(Rank, rankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues rankValue -> Array Rank rankValue
forall rankValue. RankValues rankValue -> ArrayByRank rankValue
deconstruct

instance (
	Fractional	rankValue,
	Ord		rankValue,
	Show		rankValue
 ) => Data.Default.Default (RankValues rankValue) where
	def :: RankValues rankValue
def = [(Rank, rankValue)] -> RankValues rankValue
forall rankValue.
(Fractional rankValue, Ord rankValue, Show rankValue) =>
[(Rank, rankValue)] -> RankValues rankValue
fromAssocs ([(Rank, rankValue)] -> RankValues rankValue)
-> [(Rank, rankValue)] -> RankValues rankValue
forall a b. (a -> b) -> a -> b
$ ((Rank, rankValue) -> (Rank, rankValue))
-> [(Rank, rankValue)] -> [(Rank, rankValue)]
forall a b. (a -> b) -> [a] -> [b]
map (
		(rankValue -> rankValue) -> (Rank, rankValue) -> (Rank, rankValue)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (rankValue -> rankValue -> rankValue
forall a. Fractional a => a -> a -> a
/ rankValue
10)	-- Map into the closed unit-interval.
	 ) [
		(
			Rank
Attribute.Rank.Pawn,	rankValue
1
		), (
			Rank
Attribute.Rank.Rook,	rankValue
5
		), (
			Rank
Attribute.Rank.Knight,	rankValue
3
		), (
			Rank
Attribute.Rank.Bishop,	rankValue
3
		), (
			Rank
Attribute.Rank.Queen,	rankValue
9
		), (
			Rank
Attribute.Rank.King,	rankValue
0	-- N.B.: move-selection is independent of this value (since it can't be taken), so it can be defined arbitrarily.
		)
	 ]

instance Control.DeepSeq.NFData rankValue => Control.DeepSeq.NFData (RankValues rankValue) where
	rnf :: RankValues rankValue -> ()
rnf (MkRankValues ArrayByRank rankValue
byRank)	= ArrayByRank rankValue -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf ArrayByRank rankValue
byRank

instance (
	Fractional	rankValue,
	HXT.XmlPickler	rankValue,
	Ord		rankValue,
	Show		rankValue
 ) => HXT.XmlPickler (RankValues rankValue) where
	xpickle :: PU (RankValues rankValue)
xpickle	= RankValues rankValue
-> PU (RankValues rankValue) -> PU (RankValues rankValue)
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault RankValues rankValue
forall a. Default a => a
Data.Default.def (PU (RankValues rankValue) -> PU (RankValues rankValue))
-> (PU (Rank, rankValue) -> PU (RankValues rankValue))
-> PU (Rank, rankValue)
-> PU (RankValues rankValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Rank, rankValue)] -> RankValues rankValue,
 RankValues rankValue -> [(Rank, rankValue)])
-> PU [(Rank, rankValue)] -> PU (RankValues rankValue)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		[(Rank, rankValue)] -> RankValues rankValue
forall rankValue.
(Fractional rankValue, Ord rankValue, Show rankValue) =>
[(Rank, rankValue)] -> RankValues rankValue
fromAssocs,				-- Construct from an association-list.
		Array Rank rankValue -> [(Rank, rankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (Array Rank rankValue -> [(Rank, rankValue)])
-> (RankValues rankValue -> Array Rank rankValue)
-> RankValues rankValue
-> [(Rank, rankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues rankValue -> Array Rank rankValue
forall rankValue. RankValues rankValue -> ArrayByRank rankValue
deconstruct	-- Deconstruct to an association-list.
	 ) (PU [(Rank, rankValue)] -> PU (RankValues rankValue))
-> (PU (Rank, rankValue) -> PU [(Rank, rankValue)])
-> PU (Rank, rankValue)
-> PU (RankValues rankValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU (Rank, rankValue) -> PU [(Rank, rankValue)]
forall a. PU a -> PU [a]
HXT.xpList1 (PU (Rank, rankValue) -> PU [(Rank, rankValue)])
-> (PU (Rank, rankValue) -> PU (Rank, rankValue))
-> PU (Rank, rankValue)
-> PU [(Rank, rankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU (Rank, rankValue) -> PU (Rank, rankValue)
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU (Rank, rankValue) -> PU (RankValues rankValue))
-> PU (Rank, rankValue) -> PU (RankValues rankValue)
forall a b. (a -> b) -> a -> b
$ PU Rank
forall a. XmlPickler a => PU a
HXT.xpickle {-rank-} PU Rank -> PU rankValue -> PU (Rank, rankValue)
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` String -> PU rankValue -> PU rankValue
forall a. String -> PU a -> PU a
HXT.xpAttr String
"value" PU rankValue
forall a. XmlPickler a => PU a
HXT.xpickle

-- | Smart-constructor.
fromAssocs :: (
	Fractional	rankValue,
	Ord		rankValue,
	Show		rankValue
 ) => [(Attribute.Rank.Rank, rankValue)] -> RankValues rankValue
fromAssocs :: [(Rank, rankValue)] -> RankValues rankValue
fromAssocs [(Rank, rankValue)]
assocs
	| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Rank] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Rank]
undefinedRanks	= Exception -> RankValues rankValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues rankValue)
-> (String -> Exception) -> String -> RankValues rankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInsufficientData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Attribute.RankValues.fromAssocs:\tranks" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> RankValues rankValue) -> String -> RankValues rankValue
forall a b. (a -> b) -> a -> b
$ [Rank] -> ShowS
forall a. Show a => a -> ShowS
shows [Rank]
undefinedRanks String
" are undefined."
	| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Rank] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Rank]
duplicateRanks	= Exception -> RankValues rankValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues rankValue)
-> (String -> Exception) -> String -> RankValues rankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkDuplicateData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Attribute.RankValues.fromAssocs:\tranks must be distinct; " (String -> RankValues rankValue) -> String -> RankValues rankValue
forall a b. (a -> b) -> a -> b
$ [Rank] -> ShowS
forall a. Show a => a -> ShowS
shows [Rank]
duplicateRanks String
"."
	| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((Rank, rankValue) -> Bool) -> [(Rank, rankValue)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
		rankValue -> Bool
forall n. (Num n, Ord n) => n -> Bool
Data.Num.inClosedUnitInterval (rankValue -> Bool)
-> ((Rank, rankValue) -> rankValue) -> (Rank, rankValue) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank, rankValue) -> rankValue
forall a b. (a, b) -> b
snd {-rank-value-}
	) [(Rank, rankValue)]
assocs			= Exception -> RankValues rankValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues rankValue)
-> (String -> Exception) -> String -> RankValues rankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Attribute.RankValues.fromAssocs:\tall values must be within the closed unit-interval, [0,1]; " (String -> RankValues rankValue) -> String -> RankValues rankValue
forall a b. (a -> b) -> a -> b
$ [(Rank, rankValue)] -> ShowS
forall a. Show a => a -> ShowS
shows [(Rank, rankValue)]
assocs String
"."
	| Bool
otherwise			= ArrayByRank rankValue -> RankValues rankValue
forall rankValue. ArrayByRank rankValue -> RankValues rankValue
MkRankValues (ArrayByRank rankValue -> RankValues rankValue)
-> ArrayByRank rankValue -> RankValues rankValue
forall a b. (a -> b) -> a -> b
$ [(Rank, rankValue)] -> ArrayByRank rankValue
forall (a :: * -> * -> *) e. IArray a e => [(Rank, e)] -> a Rank e
Attribute.Rank.arrayByRank [(Rank, rankValue)]
assocs
	where
		([Rank]
undefinedRanks, [Rank]
duplicateRanks)	= [Rank] -> [Rank]
Attribute.Rank.findUndefinedRanks ([Rank] -> [Rank])
-> ([Rank] -> [Rank]) -> [Rank] -> ([Rank], [Rank])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Rank] -> [Rank]
forall (foldable :: * -> *) a.
(Foldable foldable, Ord a) =>
foldable a -> [a]
Data.Foldable.findDuplicates ([Rank] -> ([Rank], [Rank])) -> [Rank] -> ([Rank], [Rank])
forall a b. (a -> b) -> a -> b
$ ((Rank, rankValue) -> Rank) -> [(Rank, rankValue)] -> [Rank]
forall a b. (a -> b) -> [a] -> [b]
map (Rank, rankValue) -> Rank
forall a b. (a, b) -> a
fst [(Rank, rankValue)]
assocs

-- | Query.
findRankValue :: Attribute.Rank.Rank -> RankValues rankValue -> rankValue
findRankValue :: Rank -> RankValues rankValue -> rankValue
findRankValue Rank
rank (MkRankValues ArrayByRank rankValue
byRank)	= ArrayByRank rankValue
byRank ArrayByRank rankValue -> Rank -> rankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank

{- |
	* 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 :: Num rankValue => RankValues rankValue -> rankValue
calculateMaximumTotalValue :: RankValues rankValue -> rankValue
calculateMaximumTotalValue (MkRankValues ArrayByRank rankValue
byRank)	= rankValue
9 {-accounting for all possible promotions-} rankValue -> rankValue -> rankValue
forall a. Num a => a -> a -> a
* (ArrayByRank rankValue
byRank ArrayByRank rankValue -> Rank -> rankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Queen) rankValue -> rankValue -> rankValue
forall a. Num a => a -> a -> a
+ rankValue
2 rankValue -> rankValue -> rankValue
forall a. Num a => a -> a -> a
* (rankValue -> Rank -> rankValue)
-> rankValue -> [Rank] -> rankValue
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
	\rankValue
acc -> (rankValue -> rankValue -> rankValue
forall a. Num a => a -> a -> a
+ rankValue
acc) (rankValue -> rankValue)
-> (Rank -> rankValue) -> Rank -> rankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayByRank rankValue
byRank ArrayByRank rankValue -> Rank -> rankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
 ) rankValue
0 [Rank]
Attribute.Rank.flank