{-
	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 the value for each type of piece, of occupying different squares.

	* This module is used to parse the user's configuration, which may involve reflecting their configuration to generate values for the RHS of the board.

	* This metric includes aspects of both control of the centre, & material advantage,
	in that a side's score can increase either by occupying squares of greater value, or simply by having more pieces.

	* N.B.: the evaluation of fitness by material COULD be entirely built into these tables, so that the average value for a @Queen@ is ~9 times that for a @Pawn@,
	but under these circumstances a non-zero material value for a @King@ must be arbitrarily chosen.

	* N.B. The normal & end-game phases are typically represented by independent instances.
	CAVEAT: any normalisation is performed on each of these instances independently, using their respective minimum & maximum values, rather than using the global minimum & maximum.
-}

module BishBosh.Input.PieceSquareTable(
-- * Types
-- ** Type-synonyms
--	Normalise,
--	ReflectOnY,
	Assocs,
-- ** Data-types
	PieceSquareTable(
--		MkPieceSquareTable,
--		getNormalise,
--		getReflectOnY,
		getPieceSquareValueByCoordinatesByRank
	),
-- * Constants
	tag,
	reflectOnYTag,
-- * Functions
	normaliseToUnitInterval,
	mirror,
	unmirror,
	findUndefinedRanks,
	dereference,
-- ** Constructors
	mkPieceSquareTable,
-- ** Predicates
	inClosedUnitInterval
) where

import			BishBosh.Data.Bool()	-- HXT.XmlPickler.
import			Control.Arrow((&&&), (***))
import qualified	BishBosh.Attribute.Rank			as Attribute.Rank
import qualified	BishBosh.Cartesian.Abscissa		as Cartesian.Abscissa
import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates
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.FixedMembership	as Property.FixedMembership
import qualified	BishBosh.Property.ShowFloat		as Property.ShowFloat
import qualified	BishBosh.Text.Case			as Text.Case
import qualified	BishBosh.Text.ShowList			as Text.ShowList
import qualified	BishBosh.Type.Mass			as Type.Mass
import qualified	Control.Arrow
import qualified	Control.Exception
import qualified	Data.Array.IArray
import qualified	Data.Default
import qualified	Data.Map.Strict
import qualified	Data.Set
import qualified	Text.XML.HXT.Arrow.Pickle		as HXT

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

-- | Used to qualify XML.
normaliseTag :: String
normaliseTag :: String
normaliseTag	= String
"normalise"

-- | Used to qualify XML.
reflectOnYTag :: String
reflectOnYTag :: String
reflectOnYTag	= String
"reflectOnY"

-- | Type-synonym.
type Normalise	= Bool

-- | Type-synonym.
type ReflectOnY	= Bool

-- | Defines the value for each type of piece, of occupying each square.
data PieceSquareTable x y pieceSquareValue	= MkPieceSquareTable {
	PieceSquareTable x y pieceSquareValue -> Normalise
getNormalise				:: Normalise,	-- ^ Whether to map the specified values into the closed unit-interval.	CAVEAT: incompatible with RelaxNG, the specification for which already constrains values to the unit-interval.
	PieceSquareTable x y pieceSquareValue -> Normalise
getReflectOnY				:: ReflectOnY,	-- ^ Whether values for the RHS of the board should be inferred by reflection about the y-axis.
	PieceSquareTable x y pieceSquareValue
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
getPieceSquareValueByCoordinatesByRank	:: Data.Map.Strict.Map Attribute.Rank.Rank (
		Cartesian.Coordinates.ArrayByCoordinates x y pieceSquareValue
	)							-- ^ N.B.: on the assumption that the values for Black pieces are the reflection of those for White, merely the /rank/ of each /piece/ need be defined.
} deriving (PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Normalise
(PieceSquareTable x y pieceSquareValue
 -> PieceSquareTable x y pieceSquareValue -> Normalise)
-> (PieceSquareTable x y pieceSquareValue
    -> PieceSquareTable x y pieceSquareValue -> Normalise)
-> Eq (PieceSquareTable x y pieceSquareValue)
forall a. (a -> a -> Normalise) -> (a -> a -> Normalise) -> Eq a
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Eq pieceSquareValue) =>
PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Normalise
/= :: PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Normalise
$c/= :: forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Eq pieceSquareValue) =>
PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Normalise
== :: PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Normalise
$c== :: forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Eq pieceSquareValue) =>
PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Normalise
Eq, Int -> PieceSquareTable x y pieceSquareValue -> ShowS
[PieceSquareTable x y pieceSquareValue] -> ShowS
PieceSquareTable x y pieceSquareValue -> String
(Int -> PieceSquareTable x y pieceSquareValue -> ShowS)
-> (PieceSquareTable x y pieceSquareValue -> String)
-> ([PieceSquareTable x y pieceSquareValue] -> ShowS)
-> Show (PieceSquareTable x y pieceSquareValue)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
Int -> PieceSquareTable x y pieceSquareValue -> ShowS
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
[PieceSquareTable x y pieceSquareValue] -> ShowS
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
PieceSquareTable x y pieceSquareValue -> String
showList :: [PieceSquareTable x y pieceSquareValue] -> ShowS
$cshowList :: forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
[PieceSquareTable x y pieceSquareValue] -> ShowS
show :: PieceSquareTable x y pieceSquareValue -> String
$cshow :: forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
PieceSquareTable x y pieceSquareValue -> String
showsPrec :: Int -> PieceSquareTable x y pieceSquareValue -> ShowS
$cshowsPrec :: forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
Int -> PieceSquareTable x y pieceSquareValue -> ShowS
Show)

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Real	pieceSquareValue,
	Show	pieceSquareValue
 ) => Property.ShowFloat.ShowFloat (PieceSquareTable x y pieceSquareValue) where
	showsFloat :: (Double -> ShowS) -> PieceSquareTable x y pieceSquareValue -> ShowS
showsFloat Double -> ShowS
fromDouble MkPieceSquareTable {
		getNormalise :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue -> Normalise
getNormalise				= Normalise
normalise,
		getReflectOnY :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue -> Normalise
getReflectOnY				= Normalise
reflectOnY,
		getPieceSquareValueByCoordinatesByRank :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
getPieceSquareValueByCoordinatesByRank	= Map Rank (ArrayByCoordinates x y pieceSquareValue)
byRank
	} = ShowS -> [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList ShowS
Text.ShowList.showsSeparator ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ (
		String
normaliseTag,
		Normalise -> ShowS
forall a. Show a => a -> ShowS
shows Normalise
normalise
	 ) (String, ShowS) -> [(String, ShowS)] -> [(String, ShowS)]
forall a. a -> [a] -> [a]
: (
		String
reflectOnYTag,
		Normalise -> ShowS
forall a. Show a => a -> ShowS
shows Normalise
reflectOnY
	 ) (String, ShowS) -> [(String, ShowS)] -> [(String, ShowS)]
forall a. a -> [a] -> [a]
: ((Rank, ArrayByCoordinates x y pieceSquareValue)
 -> (String, ShowS))
-> [(Rank, ArrayByCoordinates x y pieceSquareValue)]
-> [(String, ShowS)]
forall a b. (a -> b) -> [a] -> [b]
map (
		Rank -> String
forall a. Show a => a -> String
show {-rank-} (Rank -> String)
-> (ArrayByCoordinates x y pieceSquareValue -> ShowS)
-> (Rank, ArrayByCoordinates x y pieceSquareValue)
-> (String, ShowS)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (pieceSquareValue -> ShowS) -> [pieceSquareValue] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
Text.ShowList.showsFormattedList' (
			Double -> ShowS
fromDouble (Double -> ShowS)
-> (pieceSquareValue -> Double) -> pieceSquareValue -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pieceSquareValue -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
		) ([pieceSquareValue] -> ShowS)
-> (ArrayByCoordinates x y pieceSquareValue -> [pieceSquareValue])
-> ArrayByCoordinates x y pieceSquareValue
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
			if Normalise
reflectOnY
				then [pieceSquareValue] -> [pieceSquareValue]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
unmirror
				else [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> a
id
		) ([pieceSquareValue] -> [pieceSquareValue])
-> (ArrayByCoordinates x y pieceSquareValue -> [pieceSquareValue])
-> ArrayByCoordinates x y pieceSquareValue
-> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByCoordinates x y pieceSquareValue -> [pieceSquareValue]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems
	 ) (
		Map Rank (ArrayByCoordinates x y pieceSquareValue)
-> [(Rank, ArrayByCoordinates x y pieceSquareValue)]
forall k a. Map k a -> [(k, a)]
Data.Map.Strict.assocs Map Rank (ArrayByCoordinates x y pieceSquareValue)
byRank
	 )

instance Data.Default.Default (PieceSquareTable x y pieceSquareValue) where
	def :: PieceSquareTable x y pieceSquareValue
def = MkPieceSquareTable :: forall x y pieceSquareValue.
Normalise
-> Normalise
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
-> PieceSquareTable x y pieceSquareValue
MkPieceSquareTable {
		getNormalise :: Normalise
getNormalise				= Normalise
False,
		getReflectOnY :: Normalise
getReflectOnY				= Normalise
True,
		getPieceSquareValueByCoordinatesByRank :: Map Rank (ArrayByCoordinates x y pieceSquareValue)
getPieceSquareValueByCoordinatesByRank	= Map Rank (ArrayByCoordinates x y pieceSquareValue)
forall k a. Map k a
Data.Map.Strict.empty
	}

instance (
	Enum		x,
	Enum		y,
	Fractional	pieceSquareValue,
	Ord		pieceSquareValue,
	Ord		x,
	Ord		y,
	Real		pieceSquareValue,
	Show		pieceSquareValue
 ) => HXT.XmlPickler (PieceSquareTable x y pieceSquareValue) where
	xpickle :: PU (PieceSquareTable x y pieceSquareValue)
xpickle	= ((Normalise, Normalise, Assocs Rank pieceSquareValue)
 -> PieceSquareTable x y pieceSquareValue,
 PieceSquareTable x y pieceSquareValue
 -> (Normalise, Normalise, Assocs Rank pieceSquareValue))
-> PU (Normalise, Normalise, Assocs Rank pieceSquareValue)
-> PU (PieceSquareTable x y pieceSquareValue)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(Normalise
a, Normalise
b, Assocs Rank pieceSquareValue
c)	-> Normalise
-> Normalise
-> Assocs Rank pieceSquareValue
-> PieceSquareTable x y pieceSquareValue
forall x y pieceSquareValue.
(Enum x, Enum y, Fractional pieceSquareValue, Ord pieceSquareValue,
 Ord x, Ord y, Show pieceSquareValue) =>
Normalise
-> Normalise
-> Assocs Rank pieceSquareValue
-> PieceSquareTable x y pieceSquareValue
mkPieceSquareTable Normalise
a Normalise
b Assocs Rank pieceSquareValue
c,	-- Construct.
		\MkPieceSquareTable {
			getNormalise :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue -> Normalise
getNormalise				= Normalise
normalise,
			getReflectOnY :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue -> Normalise
getReflectOnY				= Normalise
reflectOnY,
			getPieceSquareValueByCoordinatesByRank :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
getPieceSquareValueByCoordinatesByRank	= Map Rank (ArrayByCoordinates x y pieceSquareValue)
byRank
		} -> (
			Normalise
normalise,
			Normalise
reflectOnY,
			Map Rank [pieceSquareValue] -> Assocs Rank pieceSquareValue
forall k a. Map k a -> [(k, a)]
Data.Map.Strict.assocs (Map Rank [pieceSquareValue] -> Assocs Rank pieceSquareValue)
-> Map Rank [pieceSquareValue] -> Assocs Rank pieceSquareValue
forall a b. (a -> b) -> a -> b
$ (ArrayByCoordinates x y pieceSquareValue -> [pieceSquareValue])
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
-> Map Rank [pieceSquareValue]
forall a b k. (a -> b) -> Map k a -> Map k b
Data.Map.Strict.map (
				(
					if Normalise
reflectOnY
						then [pieceSquareValue] -> [pieceSquareValue]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
unmirror
						else [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> a
id
				) ([pieceSquareValue] -> [pieceSquareValue])
-> (ArrayByCoordinates x y pieceSquareValue -> [pieceSquareValue])
-> ArrayByCoordinates x y pieceSquareValue
-> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByCoordinates x y pieceSquareValue -> [pieceSquareValue]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems
			) Map Rank (ArrayByCoordinates x y pieceSquareValue)
byRank
		) -- Deconstruct to tuple.
	 ) (PU (Normalise, Normalise, Assocs Rank pieceSquareValue)
 -> PU (PieceSquareTable x y pieceSquareValue))
-> (PU (Assocs Rank pieceSquareValue)
    -> PU (Normalise, Normalise, Assocs Rank pieceSquareValue))
-> PU (Assocs Rank pieceSquareValue)
-> PU (PieceSquareTable x y pieceSquareValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU Normalise
-> PU Normalise
-> PU (Assocs Rank pieceSquareValue)
-> PU (Normalise, Normalise, Assocs Rank pieceSquareValue)
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
HXT.xpTriple (
		PieceSquareTable Any Any Any -> Normalise
forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue -> Normalise
getNormalise PieceSquareTable Any Any Any
forall a. Default a => a
Data.Default.def Normalise -> PU Normalise -> PU Normalise
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU Normalise -> PU Normalise
forall a. String -> PU a -> PU a
HXT.xpAttr String
normaliseTag PU Normalise
forall a. XmlPickler a => PU a
HXT.xpickle {-Bool-}
	 ) (
		PieceSquareTable Any Any Any -> Normalise
forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue -> Normalise
getReflectOnY PieceSquareTable Any Any Any
forall a. Default a => a
Data.Default.def Normalise -> PU Normalise -> PU Normalise
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU Normalise -> PU Normalise
forall a. String -> PU a -> PU a
HXT.xpAttr String
reflectOnYTag PU Normalise
forall a. XmlPickler a => PU a
HXT.xpickle {-Bool-}
	 ) (PU (Assocs Rank pieceSquareValue)
 -> PU (PieceSquareTable x y pieceSquareValue))
-> PU (Assocs Rank pieceSquareValue)
-> PU (PieceSquareTable x y pieceSquareValue)
forall a b. (a -> b) -> a -> b
$ PU (Rank, [pieceSquareValue]) -> PU (Assocs Rank pieceSquareValue)
forall a. PU a -> PU [a]
HXT.xpList1 (
		String
-> PU (Rank, [pieceSquareValue]) -> PU (Rank, [pieceSquareValue])
forall a. String -> PU a -> PU a
HXT.xpElem (
			String -> ShowS
showString String
"by" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
Text.Case.toUpperInitial String
Attribute.Rank.tag
		) (PU (Rank, [pieceSquareValue]) -> PU (Rank, [pieceSquareValue]))
-> PU (Rank, [pieceSquareValue]) -> PU (Rank, [pieceSquareValue])
forall a b. (a -> b) -> a -> b
$ PU Rank
forall a. XmlPickler a => PU a
HXT.xpickle {-rank-} PU Rank -> PU [pieceSquareValue] -> PU (Rank, [pieceSquareValue])
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` (String -> [pieceSquareValue], [pieceSquareValue] -> String)
-> PU String -> PU [pieceSquareValue]
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
			\String
s -> [
				Double -> pieceSquareValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double
pieceSquareValue :: Type.Mass.PieceSquareValue) |
					String
word			<- String -> [String]
words String
s,
					(Double
pieceSquareValue, String
"")	<- ReadS Double
forall a. Read a => ReadS a
reads String
word
			], -- List-comprehension.
			[String] -> String
unwords ([String] -> String)
-> ([pieceSquareValue] -> [String]) -> [pieceSquareValue] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (pieceSquareValue -> String) -> [pieceSquareValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> String
forall a. Show a => a -> String
show (Double -> String)
-> (pieceSquareValue -> Double) -> pieceSquareValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\pieceSquareValue
pieceSquareValue -> pieceSquareValue -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac pieceSquareValue
pieceSquareValue :: Type.Mass.PieceSquareValue))
		) (
			String -> PU String
HXT.xpTextAttr (String -> PU String) -> ShowS -> String -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"by" (String -> PU String) -> String -> PU String
forall a b. (a -> b) -> a -> b
$ ShowS
Text.Case.toUpperInitial String
Cartesian.Coordinates.tag
		)
	 )

-- | Type-synonym.
type Assocs rank pieceSquareValue	= [(rank, [pieceSquareValue])]

-- | Map the range of values onto the Closed Unit Interval.
normaliseToUnitInterval
	:: (Fractional pieceSquareValue, Ord pieceSquareValue)
	=> Assocs rank pieceSquareValue
	-> Assocs rank pieceSquareValue
normaliseToUnitInterval :: Assocs rank pieceSquareValue -> Assocs rank pieceSquareValue
normaliseToUnitInterval []	= []
normaliseToUnitInterval Assocs rank pieceSquareValue
assocs
	| pieceSquareValue
range pieceSquareValue -> pieceSquareValue -> Normalise
forall a. Eq a => a -> a -> Normalise
== pieceSquareValue
0	= Exception -> Assocs rank pieceSquareValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Assocs rank pieceSquareValue)
-> Exception -> Assocs rank pieceSquareValue
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkNullDatum String
"BishBosh.Input.PieceSquareTable.normaliseToUnitInterval:\tthe specified piece-square values are identical."
	| Normalise
otherwise	= ((rank, [pieceSquareValue]) -> (rank, [pieceSquareValue]))
-> Assocs rank pieceSquareValue -> Assocs rank pieceSquareValue
forall a b. (a -> b) -> [a] -> [b]
map (
		([pieceSquareValue] -> [pieceSquareValue])
-> (rank, [pieceSquareValue]) -> (rank, [pieceSquareValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (([pieceSquareValue] -> [pieceSquareValue])
 -> (rank, [pieceSquareValue]) -> (rank, [pieceSquareValue]))
-> ([pieceSquareValue] -> [pieceSquareValue])
-> (rank, [pieceSquareValue])
-> (rank, [pieceSquareValue])
forall a b. (a -> b) -> a -> b
$ (pieceSquareValue -> pieceSquareValue)
-> [pieceSquareValue] -> [pieceSquareValue]
forall a b. (a -> b) -> [a] -> [b]
map ((pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Fractional a => a -> a -> a
/ pieceSquareValue
range) (pieceSquareValue -> pieceSquareValue)
-> (pieceSquareValue -> pieceSquareValue)
-> pieceSquareValue
-> pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
subtract pieceSquareValue
minimum')
	) Assocs rank pieceSquareValue
assocs
	where
		bounds :: (pieceSquareValue, pieceSquareValue)
bounds@(pieceSquareValue
minimum', pieceSquareValue
_)	= [pieceSquareValue] -> pieceSquareValue
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([pieceSquareValue] -> pieceSquareValue)
-> ([pieceSquareValue] -> pieceSquareValue)
-> [pieceSquareValue]
-> (pieceSquareValue, pieceSquareValue)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [pieceSquareValue] -> pieceSquareValue
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([pieceSquareValue] -> (pieceSquareValue, pieceSquareValue))
-> [pieceSquareValue] -> (pieceSquareValue, pieceSquareValue)
forall a b. (a -> b) -> a -> b
$ ((rank, [pieceSquareValue]) -> [pieceSquareValue])
-> Assocs rank pieceSquareValue -> [pieceSquareValue]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (rank, [pieceSquareValue]) -> [pieceSquareValue]
forall a b. (a, b) -> b
snd Assocs rank pieceSquareValue
assocs	-- Analyse the range of values.
		range :: pieceSquareValue
range			= (pieceSquareValue -> pieceSquareValue -> pieceSquareValue)
-> (pieceSquareValue, pieceSquareValue) -> pieceSquareValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
subtract (pieceSquareValue, pieceSquareValue)
bounds

-- | Check that the range of values is in the Closed Unit Interval.
inClosedUnitInterval
	:: (Num pieceSquareValue, Ord pieceSquareValue)
	=> Assocs rank pieceSquareValue
	-> Bool
inClosedUnitInterval :: Assocs rank pieceSquareValue -> Normalise
inClosedUnitInterval	= ((rank, [pieceSquareValue]) -> Normalise)
-> Assocs rank pieceSquareValue -> Normalise
forall (t :: * -> *) a.
Foldable t =>
(a -> Normalise) -> t a -> Normalise
all (((rank, [pieceSquareValue]) -> Normalise)
 -> Assocs rank pieceSquareValue -> Normalise)
-> ((rank, [pieceSquareValue]) -> Normalise)
-> Assocs rank pieceSquareValue
-> Normalise
forall a b. (a -> b) -> a -> b
$ (pieceSquareValue -> Normalise) -> [pieceSquareValue] -> Normalise
forall (t :: * -> *) a.
Foldable t =>
(a -> Normalise) -> t a -> Normalise
all pieceSquareValue -> Normalise
forall n. (Num n, Ord n) => n -> Normalise
Data.Num.inClosedUnitInterval ([pieceSquareValue] -> Normalise)
-> ((rank, [pieceSquareValue]) -> [pieceSquareValue])
-> (rank, [pieceSquareValue])
-> Normalise
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (rank, [pieceSquareValue]) -> [pieceSquareValue]
forall a b. (a, b) -> b
snd {-[pieceSquareValue]-}

-- | Generates a mirror-symmetric RHS, to build a complete description.
mirror :: Show pieceSquareValue => [pieceSquareValue] -> [pieceSquareValue]
mirror :: [pieceSquareValue] -> [pieceSquareValue]
mirror (pieceSquareValue
a : pieceSquareValue
b : pieceSquareValue
c : pieceSquareValue
d : [pieceSquareValue]
remainder)	= pieceSquareValue
a pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
b pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
c pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
d pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
d pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
c pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
b pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
a pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: [pieceSquareValue] -> [pieceSquareValue]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
mirror [pieceSquareValue]
remainder
mirror []				= []
mirror [pieceSquareValue]
pieceSquareValues		= Exception -> [pieceSquareValue]
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> [pieceSquareValue])
-> (String -> Exception) -> String -> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PieceSquareTable.mirror:\tthe number of piece-square values must be a multiple of " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int
Cartesian.Abscissa.xLength Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; " (String -> [pieceSquareValue]) -> String -> [pieceSquareValue]
forall a b. (a -> b) -> a -> b
$ [pieceSquareValue] -> ShowS
forall a. Show a => a -> ShowS
shows [pieceSquareValue]
pieceSquareValues String
"."

-- | Removes the mirror-symmetric RHS, for a concise description.
unmirror :: Show pieceSquareValue => [pieceSquareValue] -> [pieceSquareValue]
unmirror :: [pieceSquareValue] -> [pieceSquareValue]
unmirror (pieceSquareValue
a : pieceSquareValue
b : pieceSquareValue
c : pieceSquareValue
d : [pieceSquareValue]
remainder)	= pieceSquareValue
a pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
b pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
c pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
d pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: [pieceSquareValue] -> [pieceSquareValue]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
unmirror (Int -> [pieceSquareValue] -> [pieceSquareValue]
forall a. Int -> [a] -> [a]
drop (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Abscissa.xLength Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [pieceSquareValue]
remainder)
unmirror []				= []
unmirror [pieceSquareValue]
pieceSquareValues		= Exception -> [pieceSquareValue]
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> [pieceSquareValue])
-> (String -> Exception) -> String -> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PieceSquareTable.unmirror:\tthe number of piece-square values must be a multiple of " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int
Cartesian.Abscissa.xLength Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; " (String -> [pieceSquareValue]) -> String -> [pieceSquareValue]
forall a b. (a -> b) -> a -> b
$ [pieceSquareValue] -> ShowS
forall a. Show a => a -> ShowS
shows [pieceSquareValue]
pieceSquareValues String
"."

-- | Smart constructor.
mkPieceSquareTable :: (
	Enum		x,
	Enum		y,
	Fractional	pieceSquareValue,
	Ord		pieceSquareValue,
	Ord		x,
	Ord		y,
	Show		pieceSquareValue
 )
	=> Normalise	-- ^ Whether to normalise the specified values into the closed unit interval.
	-> ReflectOnY	-- ^ Whether values for the RHS of the board are inferred by reflection about the y-axis.
	-> Assocs Attribute.Rank.Rank pieceSquareValue
	-> PieceSquareTable x y pieceSquareValue
mkPieceSquareTable :: Normalise
-> Normalise
-> Assocs Rank pieceSquareValue
-> PieceSquareTable x y pieceSquareValue
mkPieceSquareTable Normalise
normalise Normalise
reflectOnY Assocs Rank pieceSquareValue
assocs
	| ((Rank, [pieceSquareValue]) -> Normalise)
-> Assocs Rank pieceSquareValue -> Normalise
forall (t :: * -> *) a.
Foldable t =>
(a -> Normalise) -> t a -> Normalise
any (
		(Int -> Int -> Normalise
forall a. Eq a => a -> a -> Normalise
/= Int
nValuesRequired) (Int -> Normalise)
-> ((Rank, [pieceSquareValue]) -> Int)
-> (Rank, [pieceSquareValue])
-> Normalise
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [pieceSquareValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([pieceSquareValue] -> Int)
-> ((Rank, [pieceSquareValue]) -> [pieceSquareValue])
-> (Rank, [pieceSquareValue])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank, [pieceSquareValue]) -> [pieceSquareValue]
forall a b. (a, b) -> b
snd {-pieceSquareValues-}
	) Assocs Rank pieceSquareValue
assocs						= Exception -> PieceSquareTable x y pieceSquareValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable x y pieceSquareValue)
-> (String -> Exception)
-> String
-> PieceSquareTable x y pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PieceSquareTable.mkPieceSquareTable:\texactly " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
nValuesRequired ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" values must be defined for each type of piece; " (String -> PieceSquareTable x y pieceSquareValue)
-> String -> PieceSquareTable x y pieceSquareValue
forall a b. (a -> b) -> a -> b
$ Assocs Rank pieceSquareValue -> ShowS
forall a. Show a => a -> ShowS
shows Assocs Rank pieceSquareValue
assocs String
"."
	| Normalise -> Normalise
not (Normalise -> Normalise) -> Normalise -> Normalise
forall a b. (a -> b) -> a -> b
$ [Rank] -> Normalise
forall (t :: * -> *) a. Foldable t => t a -> Normalise
null [Rank]
duplicateRanks				= Exception -> PieceSquareTable x y pieceSquareValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable x y pieceSquareValue)
-> (String -> Exception)
-> String
-> PieceSquareTable x y pieceSquareValue
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.PieceSquareTable.mkPieceSquareTable:\tranks must be distinct; " (String -> PieceSquareTable x y pieceSquareValue)
-> String -> PieceSquareTable x y pieceSquareValue
forall a b. (a -> b) -> a -> b
$ [Rank] -> ShowS
forall a. Show a => a -> ShowS
shows [Rank]
duplicateRanks String
"."
	| Normalise -> Normalise
not (Normalise -> Normalise) -> Normalise -> Normalise
forall a b. (a -> b) -> a -> b
$ Normalise
normalise Normalise -> Normalise -> Normalise
|| Assocs Rank pieceSquareValue -> Normalise
forall pieceSquareValue rank.
(Num pieceSquareValue, Ord pieceSquareValue) =>
Assocs rank pieceSquareValue -> Normalise
inClosedUnitInterval Assocs Rank pieceSquareValue
assocs	= Exception -> PieceSquareTable x y pieceSquareValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable x y pieceSquareValue)
-> (String -> Exception)
-> String
-> PieceSquareTable x y pieceSquareValue
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.Input.PieceSquareTable.mkPieceSquareTable:\tall values must be within the closed unit-interval [0,1]; " (String -> PieceSquareTable x y pieceSquareValue)
-> String -> PieceSquareTable x y pieceSquareValue
forall a b. (a -> b) -> a -> b
$ Assocs Rank pieceSquareValue -> ShowS
forall a. Show a => a -> ShowS
shows Assocs Rank pieceSquareValue
assocs String
"."
	| Normalise
otherwise						= MkPieceSquareTable :: forall x y pieceSquareValue.
Normalise
-> Normalise
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
-> PieceSquareTable x y pieceSquareValue
MkPieceSquareTable {
		getNormalise :: Normalise
getNormalise				= Normalise
normalise,
		getReflectOnY :: Normalise
getReflectOnY				= Normalise
reflectOnY,
		getPieceSquareValueByCoordinatesByRank :: Map Rank (ArrayByCoordinates x y pieceSquareValue)
getPieceSquareValueByCoordinatesByRank	= [(Rank, ArrayByCoordinates x y pieceSquareValue)]
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.Strict.fromList ([(Rank, ArrayByCoordinates x y pieceSquareValue)]
 -> Map Rank (ArrayByCoordinates x y pieceSquareValue))
-> (Assocs Rank pieceSquareValue
    -> [(Rank, ArrayByCoordinates x y pieceSquareValue)])
-> Assocs Rank pieceSquareValue
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rank, [pieceSquareValue])
 -> (Rank, ArrayByCoordinates x y pieceSquareValue))
-> Assocs Rank pieceSquareValue
-> [(Rank, ArrayByCoordinates x y pieceSquareValue)]
forall a b. (a -> b) -> [a] -> [b]
map (
			([pieceSquareValue] -> ArrayByCoordinates x y pieceSquareValue)
-> (Rank, [pieceSquareValue])
-> (Rank, ArrayByCoordinates x y pieceSquareValue)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second [pieceSquareValue] -> ArrayByCoordinates x y pieceSquareValue
forall (a :: * -> * -> *) e x y.
(IArray a e, Enum x, Enum y, Ord x, Ord y) =>
[e] -> a (Coordinates x y) e
Cartesian.Coordinates.listArrayByCoordinates
		) (Assocs Rank pieceSquareValue
 -> [(Rank, ArrayByCoordinates x y pieceSquareValue)])
-> (Assocs Rank pieceSquareValue -> Assocs Rank pieceSquareValue)
-> Assocs Rank pieceSquareValue
-> [(Rank, ArrayByCoordinates x y pieceSquareValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
			if Normalise
reflectOnY
				then ((Rank, [pieceSquareValue]) -> (Rank, [pieceSquareValue]))
-> Assocs Rank pieceSquareValue -> Assocs Rank pieceSquareValue
forall a b. (a -> b) -> [a] -> [b]
map (((Rank, [pieceSquareValue]) -> (Rank, [pieceSquareValue]))
 -> Assocs Rank pieceSquareValue -> Assocs Rank pieceSquareValue)
-> ((Rank, [pieceSquareValue]) -> (Rank, [pieceSquareValue]))
-> Assocs Rank pieceSquareValue
-> Assocs Rank pieceSquareValue
forall a b. (a -> b) -> a -> b
$ ([pieceSquareValue] -> [pieceSquareValue])
-> (Rank, [pieceSquareValue]) -> (Rank, [pieceSquareValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second [pieceSquareValue] -> [pieceSquareValue]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
mirror
				else Assocs Rank pieceSquareValue -> Assocs Rank pieceSquareValue
forall a. a -> a
id
		) (Assocs Rank pieceSquareValue
 -> Map Rank (ArrayByCoordinates x y pieceSquareValue))
-> Assocs Rank pieceSquareValue
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
forall a b. (a -> b) -> a -> b
$ (
			if Normalise
normalise
				then Assocs Rank pieceSquareValue -> Assocs Rank pieceSquareValue
forall pieceSquareValue rank.
(Fractional pieceSquareValue, Ord pieceSquareValue) =>
Assocs rank pieceSquareValue -> Assocs rank pieceSquareValue
normaliseToUnitInterval
				else Assocs Rank pieceSquareValue -> Assocs Rank pieceSquareValue
forall a. a -> a
id
		) Assocs Rank pieceSquareValue
assocs
	}
	where
		duplicateRanks :: [Rank]
duplicateRanks	= [Rank] -> [Rank]
forall (foldable :: * -> *) a.
(Foldable foldable, Ord a) =>
foldable a -> [a]
Data.Foldable.findDuplicates ([Rank] -> [Rank]) -> [Rank] -> [Rank]
forall a b. (a -> b) -> a -> b
$ ((Rank, [pieceSquareValue]) -> Rank)
-> Assocs Rank pieceSquareValue -> [Rank]
forall a b. (a -> b) -> [a] -> [b]
map (Rank, [pieceSquareValue]) -> Rank
forall a b. (a, b) -> a
fst Assocs Rank pieceSquareValue
assocs

		nValuesRequired :: Int
nValuesRequired	= (
			if Normalise
reflectOnY
				then (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
				else Int -> Int
forall a. a -> a
id
		 ) Int
Cartesian.Coordinates.nSquares

-- | Identify any /rank/ lacking a definition.
findUndefinedRanks :: PieceSquareTable x y pieceSquareValue -> Data.Set.Set Attribute.Rank.Rank
findUndefinedRanks :: PieceSquareTable x y pieceSquareValue -> Set Rank
findUndefinedRanks MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
getPieceSquareValueByCoordinatesByRank = Map Rank (ArrayByCoordinates x y pieceSquareValue)
pieceSquareValueByCoordinatesByRank }	= [Rank] -> Set Rank
forall a. Eq a => [a] -> Set a
Data.Set.fromAscList [Rank]
forall a. FixedMembership a => [a]
Property.FixedMembership.members Set Rank -> Set Rank -> Set Rank
forall a. Ord a => Set a -> Set a -> Set a
`Data.Set.difference` Map Rank (ArrayByCoordinates x y pieceSquareValue) -> Set Rank
forall k a. Map k a -> Set k
Data.Map.Strict.keysSet Map Rank (ArrayByCoordinates x y pieceSquareValue)
pieceSquareValueByCoordinatesByRank

-- | Lookup the values for all /coordinates/, corresponding to the specified /rank/.
dereference
	:: Attribute.Rank.Rank
	-> PieceSquareTable x y pieceSquareValue
	-> Maybe (Cartesian.Coordinates.ArrayByCoordinates x y pieceSquareValue)
dereference :: Rank
-> PieceSquareTable x y pieceSquareValue
-> Maybe (ArrayByCoordinates x y pieceSquareValue)
dereference Rank
rank MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
getPieceSquareValueByCoordinatesByRank = Map Rank (ArrayByCoordinates x y pieceSquareValue)
pieceSquareValueByCoordinatesByRank }	= Rank
-> Map Rank (ArrayByCoordinates x y pieceSquareValue)
-> Maybe (ArrayByCoordinates x y pieceSquareValue)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.Strict.lookup Rank
rank Map Rank (ArrayByCoordinates x y pieceSquareValue)
pieceSquareValueByCoordinatesByRank