{-
	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.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.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	= MkRankValues {
	RankValues -> ArrayByRank RankValue
deconstruct	:: Attribute.Rank.ArrayByRank Metric.RankValue.RankValue
} deriving (RankValues -> RankValues -> Bool
(RankValues -> RankValues -> Bool)
-> (RankValues -> RankValues -> Bool) -> Eq RankValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RankValues -> RankValues -> Bool
$c/= :: RankValues -> RankValues -> Bool
== :: RankValues -> RankValues -> Bool
$c== :: RankValues -> RankValues -> Bool
Eq, ReadPrec [RankValues]
ReadPrec RankValues
Int -> ReadS RankValues
ReadS [RankValues]
(Int -> ReadS RankValues)
-> ReadS [RankValues]
-> ReadPrec RankValues
-> ReadPrec [RankValues]
-> Read RankValues
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RankValues]
$creadListPrec :: ReadPrec [RankValues]
readPrec :: ReadPrec RankValues
$creadPrec :: ReadPrec RankValues
readList :: ReadS [RankValues]
$creadList :: ReadS [RankValues]
readsPrec :: Int -> ReadS RankValues
$creadsPrec :: Int -> ReadS RankValues
Read, Int -> RankValues -> ShowS
[RankValues] -> ShowS
RankValues -> String
(Int -> RankValues -> ShowS)
-> (RankValues -> String)
-> ([RankValues] -> ShowS)
-> Show RankValues
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RankValues] -> ShowS
$cshowList :: [RankValues] -> ShowS
show :: RankValues -> String
$cshow :: RankValues -> String
showsPrec :: Int -> RankValues -> ShowS
$cshowsPrec :: Int -> RankValues -> ShowS
Show)

instance Property.ShowFloat.ShowFloat RankValues where
	showsFloat :: (Double -> ShowS) -> RankValues -> ShowS
showsFloat Double -> ShowS
fromDouble	= [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS)
-> (RankValues -> [(String, ShowS)]) -> RankValues -> 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) -> RankValue -> ShowS
forall a. ShowFloat a => (Double -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat Double -> ShowS
fromDouble) ([(Rank, RankValue)] -> [(String, ShowS)])
-> (RankValues -> [(Rank, RankValue)])
-> RankValues
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByRank RankValue -> [(Rank, RankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (ArrayByRank RankValue -> [(Rank, RankValue)])
-> (RankValues -> ArrayByRank RankValue)
-> RankValues
-> [(Rank, RankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues -> ArrayByRank RankValue
deconstruct

instance Data.Default.Default RankValues where
	def :: RankValues
def = ArrayByRank RankValue -> RankValues
MkRankValues (ArrayByRank RankValue -> RankValues)
-> ([RankValue] -> ArrayByRank RankValue)
-> [RankValue]
-> RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RankValue] -> ArrayByRank RankValue
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Rank e
Attribute.Rank.listArrayByRank ([RankValue] -> RankValues) -> [RankValue] -> RankValues
forall a b. (a -> b) -> a -> b
$ (Rational -> RankValue) -> [Rational] -> [RankValue]
forall a b. (a -> b) -> [a] -> [b]
map (
		Rational -> RankValue
forall a. Fractional a => Rational -> a
fromRational (Rational -> RankValue)
-> (Rational -> Rational) -> Rational -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
10)	-- Map into the closed unit-interval.
	 ) [
		Rational
1,
		Rational
5,
		Rational
3,
		Rational
3,
		Rational
9,
		Rational
0	-- N.B.: move-selection is independent of the King's value (since it can't be taken), so it can be defined arbitrarily.
	 ]

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

instance HXT.XmlPickler RankValues where
	xpickle :: PU RankValues
xpickle	= RankValues -> PU RankValues -> PU RankValues
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault RankValues
forall a. Default a => a
Data.Default.def (PU RankValues -> PU RankValues)
-> (PU (Rank, RankValue) -> PU RankValues)
-> PU (Rank, RankValue)
-> PU RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Rank, RankValue)] -> RankValues,
 RankValues -> [(Rank, RankValue)])
-> PU [(Rank, RankValue)] -> PU RankValues
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		[(Rank, RankValue)] -> RankValues
fromAssocs,				-- Construct from an association-list.
		ArrayByRank RankValue -> [(Rank, RankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (ArrayByRank RankValue -> [(Rank, RankValue)])
-> (RankValues -> ArrayByRank RankValue)
-> RankValues
-> [(Rank, RankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues -> ArrayByRank RankValue
deconstruct	-- Deconstruct to an association-list.
	 ) (PU [(Rank, RankValue)] -> PU RankValues)
-> (PU (Rank, RankValue) -> PU [(Rank, RankValue)])
-> PU (Rank, RankValue)
-> PU RankValues
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)
-> PU (Rank, RankValue) -> PU RankValues
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` PU RankValue
forall a. XmlPickler a => PU a
HXT.xpickle {-RankValue-}

-- | Smart constructor.
fromAssocs :: [(Attribute.Rank.Rank, Metric.RankValue.RankValue)] -> RankValues
fromAssocs :: [(Rank, RankValue)] -> RankValues
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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues)
-> (String -> Exception) -> String -> RankValues
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.Input.RankValues.fromAssocs:\tranks" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> RankValues) -> String -> RankValues
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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues)
-> (String -> Exception) -> String -> RankValues
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.Input.RankValues.fromAssocs:\tranks must be distinct; " (String -> RankValues) -> String -> RankValues
forall a b. (a -> b) -> a -> b
$ [Rank] -> ShowS
forall a. Show a => a -> ShowS
shows [Rank]
duplicateRanks String
"."
	| ((Rank, RankValue) -> Bool) -> [(Rank, RankValue)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
		(RankValue -> RankValue -> Bool
forall a. Eq a => a -> a -> Bool
== RankValue
0) (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 {-RankValue-}
	) [(Rank, RankValue)]
assocs			= Exception -> RankValues
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues)
-> (String -> Exception) -> String -> RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkNullDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.RankValues.fromAssocs:\tat least one rank should have a non-zero value; " (String -> RankValues) -> String -> RankValues
forall a b. (a -> b) -> a -> b
$ [(Rank, RankValue)] -> ShowS
forall a. Show a => a -> ShowS
shows [(Rank, RankValue)]
assocs String
"."
	| 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 -> Bool
forall a. Eq a => a -> a -> Bool
/= [RankValue] -> RankValue
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
		RankValue
rankValue |
			(Rank
rank, RankValue
rankValue)	<- [(Rank, RankValue)]
assocs,
			Rank
rank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank
Attribute.Rank.King	-- Whose rank-value is irrelevant.
	] {-list-comprehension-}	= Exception -> RankValues
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues)
-> (String -> Exception) -> String -> RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.RankValues.fromAssocs:\texcepting possibly the King, the Queen should be the most valuable rank; " (String -> RankValues) -> String -> RankValues
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
MkRankValues ArrayByRank RankValue
byRank
	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
		byRank :: ArrayByRank RankValue
byRank					= [(Rank, RankValue)] -> ArrayByRank RankValue
forall (a :: * -> * -> *) e. IArray a e => [(Rank, e)] -> a Rank e
Attribute.Rank.arrayByRank [(Rank, RankValue)]
assocs

-- | Query.
findRankValue :: RankValues -> Attribute.Rank.Rank -> Metric.RankValue.RankValue
findRankValue :: RankValues -> Rank -> RankValue
findRankValue (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
!)

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