{-
	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,
	IOFormat,
	Assocs,
-- ** Data-types
	PieceSquareTable(
--		MkPieceSquareTable,
--		getNormalise,
--		getReflectOnY,
		getPieceSquareValueByCoordinatesByRank
	),
-- * Constants
	tag,
	reflectOnYTag,
-- * Functions
	normaliseToUnitInterval,
	mirror,
	unmirror,
-- ** Accessors
	findUndefinedRanks,
	findPieceSquareValueByCoordinates,
-- ** 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.Component.PieceSquareValueByCoordinates	as Component.PieceSquareValueByCoordinates
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.Empty					as Property.Empty
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.Default
import qualified	Data.Map.Strict						as Map
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	= MkPieceSquareTable {
	PieceSquareTable -> 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 -> Normalise
getReflectOnY				:: ReflectOnY,												-- ^ Whether values for the RHS of the board should be inferred by reflection about the y-axis.
	PieceSquareTable -> Map Rank PieceSquareValueByCoordinates
getPieceSquareValueByCoordinatesByRank	:: Map.Map Attribute.Rank.Rank Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates	-- ^ 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 -> PieceSquareTable -> Normalise
(PieceSquareTable -> PieceSquareTable -> Normalise)
-> (PieceSquareTable -> PieceSquareTable -> Normalise)
-> Eq PieceSquareTable
forall a. (a -> a -> Normalise) -> (a -> a -> Normalise) -> Eq a
/= :: PieceSquareTable -> PieceSquareTable -> Normalise
$c/= :: PieceSquareTable -> PieceSquareTable -> Normalise
== :: PieceSquareTable -> PieceSquareTable -> Normalise
$c== :: PieceSquareTable -> PieceSquareTable -> Normalise
Eq, Int -> PieceSquareTable -> ShowS
[PieceSquareTable] -> ShowS
PieceSquareTable -> String
(Int -> PieceSquareTable -> ShowS)
-> (PieceSquareTable -> String)
-> ([PieceSquareTable] -> ShowS)
-> Show PieceSquareTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PieceSquareTable] -> ShowS
$cshowList :: [PieceSquareTable] -> ShowS
show :: PieceSquareTable -> String
$cshow :: PieceSquareTable -> String
showsPrec :: Int -> PieceSquareTable -> ShowS
$cshowsPrec :: Int -> PieceSquareTable -> ShowS
Show)

instance Property.ShowFloat.ShowFloat PieceSquareTable where
	showsFloat :: (Double -> ShowS) -> PieceSquareTable -> ShowS
showsFloat Double -> ShowS
fromDouble MkPieceSquareTable {
		getNormalise :: PieceSquareTable -> Normalise
getNormalise				= Normalise
normalise,
		getReflectOnY :: PieceSquareTable -> Normalise
getReflectOnY				= Normalise
reflectOnY,
		getPieceSquareValueByCoordinatesByRank :: PieceSquareTable -> Map Rank PieceSquareValueByCoordinates
getPieceSquareValueByCoordinatesByRank	= Map Rank PieceSquareValueByCoordinates
pieceSquareValueByCoordinatesByRank
	} = 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, PieceSquareValueByCoordinates) -> (String, ShowS))
-> [(Rank, PieceSquareValueByCoordinates)] -> [(String, ShowS)]
forall a b. (a -> b) -> [a] -> [b]
map (
		Rank -> String
forall a. Show a => a -> String
show {-rank-} (Rank -> String)
-> (PieceSquareValueByCoordinates -> ShowS)
-> (Rank, PieceSquareValueByCoordinates)
-> (String, ShowS)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Double -> ShowS) -> [Double] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
Text.ShowList.showsFormattedList' (
			Double -> ShowS
fromDouble (Double -> ShowS) -> (Double -> Double) -> Double -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
		) ([Double] -> ShowS)
-> (PieceSquareValueByCoordinates -> [Double])
-> PieceSquareValueByCoordinates
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
			if Normalise
reflectOnY
				then [Double] -> [Double]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
unmirror
				else [Double] -> [Double]
forall a. a -> a
id
		) ([Double] -> [Double])
-> (PieceSquareValueByCoordinates -> [Double])
-> PieceSquareValueByCoordinates
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceSquareValueByCoordinates -> [Double]
Component.PieceSquareValueByCoordinates.toList
	 ) (
		Map Rank PieceSquareValueByCoordinates
-> [(Rank, PieceSquareValueByCoordinates)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Rank PieceSquareValueByCoordinates
pieceSquareValueByCoordinatesByRank
	 )

instance Data.Default.Default PieceSquareTable where
	def :: PieceSquareTable
def = MkPieceSquareTable :: Normalise
-> Normalise
-> Map Rank PieceSquareValueByCoordinates
-> PieceSquareTable
MkPieceSquareTable {
		getNormalise :: Normalise
getNormalise				= Normalise
False,
		getReflectOnY :: Normalise
getReflectOnY				= Normalise
True,
		getPieceSquareValueByCoordinatesByRank :: Map Rank PieceSquareValueByCoordinates
getPieceSquareValueByCoordinatesByRank	= Map Rank PieceSquareValueByCoordinates
forall a. Empty a => a
Property.Empty.empty
	}

-- | The format of the values when read or written.
type IOFormat	= Double

instance HXT.XmlPickler PieceSquareTable where
	xpickle :: PU PieceSquareTable
xpickle	= ((Normalise, Normalise, Assocs Rank Double) -> PieceSquareTable,
 PieceSquareTable -> (Normalise, Normalise, Assocs Rank Double))
-> PU (Normalise, Normalise, Assocs Rank Double)
-> PU PieceSquareTable
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(Normalise
a, Normalise
b, Assocs Rank Double
c)	-> Normalise -> Normalise -> Assocs Rank Double -> PieceSquareTable
mkPieceSquareTable Normalise
a Normalise
b Assocs Rank Double
c,	-- Construct.
		\MkPieceSquareTable {
			getNormalise :: PieceSquareTable -> Normalise
getNormalise				= Normalise
normalise,
			getReflectOnY :: PieceSquareTable -> Normalise
getReflectOnY				= Normalise
reflectOnY,
			getPieceSquareValueByCoordinatesByRank :: PieceSquareTable -> Map Rank PieceSquareValueByCoordinates
getPieceSquareValueByCoordinatesByRank	= Map Rank PieceSquareValueByCoordinates
pieceSquareValueByCoordinatesByRank
		} -> (
			Normalise
normalise,
			Normalise
reflectOnY,
			Map Rank [Double] -> Assocs Rank Double
forall k a. Map k a -> [(k, a)]
Map.toList (Map Rank [Double] -> Assocs Rank Double)
-> Map Rank [Double] -> Assocs Rank Double
forall a b. (a -> b) -> a -> b
$ (PieceSquareValueByCoordinates -> [Double])
-> Map Rank PieceSquareValueByCoordinates -> Map Rank [Double]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (
				(Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([Double] -> [Double])
-> (PieceSquareValueByCoordinates -> [Double])
-> PieceSquareValueByCoordinates
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
					if Normalise
reflectOnY
						then [Double] -> [Double]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
unmirror
						else [Double] -> [Double]
forall a. a -> a
id
				) ([Double] -> [Double])
-> (PieceSquareValueByCoordinates -> [Double])
-> PieceSquareValueByCoordinates
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceSquareValueByCoordinates -> [Double]
Component.PieceSquareValueByCoordinates.toList
			) Map Rank PieceSquareValueByCoordinates
pieceSquareValueByCoordinatesByRank
		) -- Deconstruct to tuple.
	 ) (PU (Normalise, Normalise, Assocs Rank Double)
 -> PU PieceSquareTable)
-> (PU (Assocs Rank Double)
    -> PU (Normalise, Normalise, Assocs Rank Double))
-> PU (Assocs Rank Double)
-> PU PieceSquareTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU Normalise
-> PU Normalise
-> PU (Assocs Rank Double)
-> PU (Normalise, Normalise, Assocs Rank Double)
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
HXT.xpTriple (
		PieceSquareTable -> Normalise
getNormalise PieceSquareTable
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 -> Normalise
getReflectOnY PieceSquareTable
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 Double) -> PU PieceSquareTable)
-> PU (Assocs Rank Double) -> PU PieceSquareTable
forall a b. (a -> b) -> a -> b
$ PU (Rank, [Double]) -> PU (Assocs Rank Double)
forall a. PU a -> PU [a]
HXT.xpList1 (
		String -> PU (Rank, [Double]) -> PU (Rank, [Double])
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, [Double]) -> PU (Rank, [Double]))
-> PU (Rank, [Double]) -> PU (Rank, [Double])
forall a b. (a -> b) -> a -> b
$ PU Rank
forall a. XmlPickler a => PU a
HXT.xpickle {-rank-} PU Rank -> PU [Double] -> PU (Rank, [Double])
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` (String -> [Double], [Double] -> String)
-> PU String -> PU [Double]
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
			\String
s -> [
				(Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: IOFormat -> Type.Mass.Base) Double
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)
-> ([Double] -> [String]) -> [Double] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> String) -> [Double] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (
				Double -> String
forall a. Show a => a -> String
show (Double -> String) -> (Double -> Double) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: Type.Mass.Base -> IOFormat)
			) -- Deconstruct.
		) (
			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 pieceSquareValueIn, Real pieceSquareValueIn, Fractional pieceSquareValueOut) => Assocs rank pieceSquareValueIn -> Assocs rank pieceSquareValueOut
normaliseToUnitInterval :: Assocs rank pieceSquareValueIn -> Assocs rank pieceSquareValueOut
normaliseToUnitInterval []	= []
normaliseToUnitInterval Assocs rank pieceSquareValueIn
assocs
	| pieceSquareValueIn
range pieceSquareValueIn -> pieceSquareValueIn -> Normalise
forall a. Eq a => a -> a -> Normalise
== pieceSquareValueIn
0	= Exception -> Assocs rank pieceSquareValueOut
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Assocs rank pieceSquareValueOut)
-> Exception -> Assocs rank pieceSquareValueOut
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, [pieceSquareValueIn]) -> (rank, [pieceSquareValueOut]))
-> Assocs rank pieceSquareValueIn
-> Assocs rank pieceSquareValueOut
forall a b. (a -> b) -> [a] -> [b]
map (
		([pieceSquareValueIn] -> [pieceSquareValueOut])
-> (rank, [pieceSquareValueIn]) -> (rank, [pieceSquareValueOut])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (([pieceSquareValueIn] -> [pieceSquareValueOut])
 -> (rank, [pieceSquareValueIn]) -> (rank, [pieceSquareValueOut]))
-> ([pieceSquareValueIn] -> [pieceSquareValueOut])
-> (rank, [pieceSquareValueIn])
-> (rank, [pieceSquareValueOut])
forall a b. (a -> b) -> a -> b
$ (pieceSquareValueIn -> pieceSquareValueOut)
-> [pieceSquareValueIn] -> [pieceSquareValueOut]
forall a b. (a -> b) -> [a] -> [b]
map (pieceSquareValueIn -> pieceSquareValueOut
forall a b. (Real a, Fractional b) => a -> b
realToFrac (pieceSquareValueIn -> pieceSquareValueOut)
-> (pieceSquareValueIn -> pieceSquareValueIn)
-> pieceSquareValueIn
-> pieceSquareValueOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (pieceSquareValueIn -> pieceSquareValueIn -> pieceSquareValueIn
forall a. Fractional a => a -> a -> a
/ pieceSquareValueIn
range) (pieceSquareValueIn -> pieceSquareValueIn)
-> (pieceSquareValueIn -> pieceSquareValueIn)
-> pieceSquareValueIn
-> pieceSquareValueIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pieceSquareValueIn -> pieceSquareValueIn -> pieceSquareValueIn
forall a. Num a => a -> a -> a
subtract pieceSquareValueIn
minimum')
	) Assocs rank pieceSquareValueIn
assocs
	where
		bounds :: (pieceSquareValueIn, pieceSquareValueIn)
bounds@(pieceSquareValueIn
minimum', pieceSquareValueIn
_)	= [pieceSquareValueIn] -> pieceSquareValueIn
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([pieceSquareValueIn] -> pieceSquareValueIn)
-> ([pieceSquareValueIn] -> pieceSquareValueIn)
-> [pieceSquareValueIn]
-> (pieceSquareValueIn, pieceSquareValueIn)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [pieceSquareValueIn] -> pieceSquareValueIn
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([pieceSquareValueIn] -> (pieceSquareValueIn, pieceSquareValueIn))
-> [pieceSquareValueIn] -> (pieceSquareValueIn, pieceSquareValueIn)
forall a b. (a -> b) -> a -> b
$ ((rank, [pieceSquareValueIn]) -> [pieceSquareValueIn])
-> Assocs rank pieceSquareValueIn -> [pieceSquareValueIn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (rank, [pieceSquareValueIn]) -> [pieceSquareValueIn]
forall a b. (a, b) -> b
snd Assocs rank pieceSquareValueIn
assocs	-- Analyse the range of values.
		range :: pieceSquareValueIn
range			= (pieceSquareValueIn -> pieceSquareValueIn -> pieceSquareValueIn)
-> (pieceSquareValueIn, pieceSquareValueIn) -> pieceSquareValueIn
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry pieceSquareValueIn -> pieceSquareValueIn -> pieceSquareValueIn
forall a. Num a => a -> a -> a
subtract (pieceSquareValueIn, pieceSquareValueIn)
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
	:: 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 Type.Mass.Base
	-> PieceSquareTable
mkPieceSquareTable :: Normalise -> Normalise -> Assocs Rank Double -> PieceSquareTable
mkPieceSquareTable Normalise
normalise Normalise
reflectOnY Assocs Rank Double
assocs
	| ((Rank, [Double]) -> Normalise) -> Assocs Rank Double -> 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, [Double]) -> Int) -> (Rank, [Double]) -> Normalise
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int)
-> ((Rank, [Double]) -> Int) -> (Rank, [Double]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int)
-> ((Rank, [Double]) -> [Double]) -> (Rank, [Double]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank, [Double]) -> [Double]
forall a b. (a, b) -> b
snd {-PieceSquareValues-}
	) Assocs Rank Double
assocs						= Exception -> PieceSquareTable
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable)
-> (String -> Exception) -> String -> PieceSquareTable
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) -> String -> PieceSquareTable
forall a b. (a -> b) -> a -> b
$ Assocs Rank Double -> ShowS
forall a. Show a => a -> ShowS
shows Assocs Rank Double
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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable)
-> (String -> Exception) -> String -> PieceSquareTable
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) -> String -> PieceSquareTable
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 Double -> Normalise
forall pieceSquareValue rank.
(Num pieceSquareValue, Ord pieceSquareValue) =>
Assocs rank pieceSquareValue -> Normalise
inClosedUnitInterval Assocs Rank Double
assocs	= Exception -> PieceSquareTable
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable)
-> (String -> Exception) -> String -> PieceSquareTable
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) -> String -> PieceSquareTable
forall a b. (a -> b) -> a -> b
$ Assocs Rank Double -> ShowS
forall a. Show a => a -> ShowS
shows Assocs Rank Double
assocs String
"."
	| Normalise
otherwise						= MkPieceSquareTable :: Normalise
-> Normalise
-> Map Rank PieceSquareValueByCoordinates
-> PieceSquareTable
MkPieceSquareTable {
		getNormalise :: Normalise
getNormalise				= Normalise
normalise,
		getReflectOnY :: Normalise
getReflectOnY				= Normalise
reflectOnY,
		getPieceSquareValueByCoordinatesByRank :: Map Rank PieceSquareValueByCoordinates
getPieceSquareValueByCoordinatesByRank	= [(Rank, PieceSquareValueByCoordinates)]
-> Map Rank PieceSquareValueByCoordinates
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Rank, PieceSquareValueByCoordinates)]
 -> Map Rank PieceSquareValueByCoordinates)
-> (Assocs Rank Double -> [(Rank, PieceSquareValueByCoordinates)])
-> Assocs Rank Double
-> Map Rank PieceSquareValueByCoordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rank, [Double]) -> (Rank, PieceSquareValueByCoordinates))
-> Assocs Rank Double -> [(Rank, PieceSquareValueByCoordinates)]
forall a b. (a -> b) -> [a] -> [b]
map (
			([Double] -> PieceSquareValueByCoordinates)
-> (Rank, [Double]) -> (Rank, PieceSquareValueByCoordinates)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second [Double] -> PieceSquareValueByCoordinates
Component.PieceSquareValueByCoordinates.fromList
		) (Assocs Rank Double -> [(Rank, PieceSquareValueByCoordinates)])
-> (Assocs Rank Double -> Assocs Rank Double)
-> Assocs Rank Double
-> [(Rank, PieceSquareValueByCoordinates)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
			if Normalise
reflectOnY
				then ((Rank, [Double]) -> (Rank, [Double]))
-> Assocs Rank Double -> Assocs Rank Double
forall a b. (a -> b) -> [a] -> [b]
map (((Rank, [Double]) -> (Rank, [Double]))
 -> Assocs Rank Double -> Assocs Rank Double)
-> ((Rank, [Double]) -> (Rank, [Double]))
-> Assocs Rank Double
-> Assocs Rank Double
forall a b. (a -> b) -> a -> b
$ ([Double] -> [Double]) -> (Rank, [Double]) -> (Rank, [Double])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second [Double] -> [Double]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
mirror
				else Assocs Rank Double -> Assocs Rank Double
forall a. a -> a
id
		) (Assocs Rank Double -> Map Rank PieceSquareValueByCoordinates)
-> Assocs Rank Double -> Map Rank PieceSquareValueByCoordinates
forall a b. (a -> b) -> a -> b
$ (
			if Normalise
normalise
				then Assocs Rank Double -> Assocs Rank Double
forall pieceSquareValueIn pieceSquareValueOut rank.
(Fractional pieceSquareValueIn, Real pieceSquareValueIn,
 Fractional pieceSquareValueOut) =>
Assocs rank pieceSquareValueIn -> Assocs rank pieceSquareValueOut
normaliseToUnitInterval
				else ((Rank, [Double]) -> (Rank, [Double]))
-> Assocs Rank Double -> Assocs Rank Double
forall a b. (a -> b) -> [a] -> [b]
map (([Double] -> [Double]) -> (Rank, [Double]) -> (Rank, [Double])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (([Double] -> [Double]) -> (Rank, [Double]) -> (Rank, [Double]))
-> ([Double] -> [Double]) -> (Rank, [Double]) -> (Rank, [Double])
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac)
		) Assocs Rank Double
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, [Double]) -> Rank) -> Assocs Rank Double -> [Rank]
forall a b. (a -> b) -> [a] -> [b]
map (Rank, [Double]) -> Rank
forall a b. (a, b) -> a
fst Assocs Rank Double
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 -> Data.Set.Set Attribute.Rank.Rank
findUndefinedRanks :: PieceSquareTable -> Set Rank
findUndefinedRanks MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank :: PieceSquareTable -> Map Rank PieceSquareValueByCoordinates
getPieceSquareValueByCoordinatesByRank = Map Rank PieceSquareValueByCoordinates
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 PieceSquareValueByCoordinates -> Set Rank
forall k a. Map k a -> Set k
Map.keysSet Map Rank PieceSquareValueByCoordinates
pieceSquareValueByCoordinatesByRank

-- | Lookup the values for all /coordinates/, corresponding to the specified /rank/.
findPieceSquareValueByCoordinates :: Attribute.Rank.Rank -> PieceSquareTable -> Maybe Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates
findPieceSquareValueByCoordinates :: Rank -> PieceSquareTable -> Maybe PieceSquareValueByCoordinates
findPieceSquareValueByCoordinates Rank
rank MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank :: PieceSquareTable -> Map Rank PieceSquareValueByCoordinates
getPieceSquareValueByCoordinatesByRank = Map Rank PieceSquareValueByCoordinates
pieceSquareValueByCoordinatesByRank }	= Rank
-> Map Rank PieceSquareValueByCoordinates
-> Maybe PieceSquareValueByCoordinates
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Rank
rank Map Rank PieceSquareValueByCoordinates
pieceSquareValueByCoordinatesByRank