{-# 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 <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.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	= MkRankValues {
	RankValues -> UArrayByRank RankValue
deconstruct	::
#ifdef UNBOX_TYPEMASS_ARRAYS
		Attribute.Rank.UArrayByRank
#else
		Attribute.Rank.ArrayByRank
#endif
			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

instance Read RankValues where
	readsPrec :: Int -> ReadS RankValues
readsPrec Int
precedence	= (([(Rank, RankValue)], String) -> (RankValues, String))
-> [([(Rank, RankValue)], String)] -> [(RankValues, String)]
forall a b. (a -> b) -> [a] -> [b]
map (([(Rank, RankValue)] -> RankValues)
-> ([(Rank, RankValue)], String) -> (RankValues, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first [(Rank, RankValue)] -> RankValues
fromAssocs) ([([(Rank, RankValue)], String)] -> [(RankValues, String)])
-> (String -> [([(Rank, RankValue)], String)]) -> ReadS RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [([(Rank, RankValue)], String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
precedence

instance Show RankValues where
	showsPrec :: Int -> RankValues -> ShowS
showsPrec Int
precedence MkRankValues { deconstruct :: RankValues -> UArrayByRank RankValue
deconstruct = UArrayByRank RankValue
byRank }	= Int -> [(Rank, RankValue)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence ([(Rank, RankValue)] -> ShowS) -> [(Rank, RankValue)] -> ShowS
forall a b. (a -> b) -> a -> b
$ UArrayByRank RankValue -> [(Rank, RankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs UArrayByRank RankValue
byRank

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

instance Data.Default.Default RankValues where
	def :: RankValues
def = UArrayByRank RankValue -> RankValues
MkRankValues (UArrayByRank RankValue -> RankValues)
-> ([RankValue] -> UArrayByRank RankValue)
-> [RankValue]
-> RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RankValue] -> UArrayByRank 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.: 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 :: RankValues -> ()
rnf (MkRankValues UArrayByRank RankValue
byRank)	=
#ifdef UNBOX_TYPEMASS_ARRAYS
		UArrayByRank RankValue -> ()
forall a. a -> ()
Control.DeepSeq.rwhnf
#else
		Control.DeepSeq.rnf
#endif
			UArrayByRank 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.
		UArrayByRank RankValue -> [(Rank, RankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (UArrayByRank RankValue -> [(Rank, RankValue)])
-> (RankValues -> UArrayByRank RankValue)
-> RankValues
-> [(Rank, RankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues -> UArrayByRank 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`
#ifndef USE_NEWTYPE_WRAPPERS
		String -> PU RankValue -> PU RankValue
forall a. String -> PU a -> PU a
HXT.xpAttr String
Metric.RankValue.tag
#endif
		PU RankValue
forall a. XmlPickler a => PU a
HXT.xpickle

-- | 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
"."
	| UArrayByRank RankValue
byRank UArrayByRank 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			= UArrayByRank RankValue -> RankValues
MkRankValues UArrayByRank 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 :: UArrayByRank RankValue
byRank					= [(Rank, RankValue)] -> UArrayByRank 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 UArrayByRank RankValue
byRank)	= (UArrayByRank RankValue
byRank UArrayByRank 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 -> RankValue
calculateMaximumTotalValue (MkRankValues UArrayByRank RankValue
byRank)	= RankValue
9 {-accounting for all possible promotions-} RankValue -> RankValue -> RankValue
forall a. Num a => a -> a -> a
* RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (
	UArrayByRank RankValue
byRank UArrayByRank 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
. RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue)
-> (Rank -> RankValue) -> Rank -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UArrayByRank RankValue
byRank UArrayByRank RankValue -> Rank -> RankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
 ) RankValue
0 [Rank]
Attribute.Rank.flank