module BishBosh.Input.PieceSquareTable(
IOFormat,
Assocs,
PieceSquareTable(
getPieceSquareValueByCoordinatesByRank
),
tag,
reflectOnYTag,
normaliseToUnitInterval,
mirror,
unmirror,
findUndefinedRanks,
dereference,
mkPieceSquareTable,
inClosedUnitInterval
) where
import BishBosh.Data.Bool()
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.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 Control.Arrow
import qualified Control.Exception
import qualified Data.Default
import qualified Data.Foldable
import qualified Data.Map.Strict as Map
import qualified Data.Set
import qualified Text.XML.HXT.Arrow.Pickle as HXT
tag :: String
tag :: String
tag = String
"pieceSquareTable"
normaliseTag :: String
normaliseTag :: String
normaliseTag = String
"normalise"
reflectOnYTag :: String
reflectOnYTag :: String
reflectOnYTag = String
"reflectOnY"
type Normalise = Bool
type ReflectOnY = Bool
data PieceSquareTable pieceSquareValue = MkPieceSquareTable {
PieceSquareTable pieceSquareValue -> Normalise
getNormalise :: Normalise,
PieceSquareTable pieceSquareValue -> Normalise
getReflectOnY :: ReflectOnY,
PieceSquareTable pieceSquareValue
-> Map Rank (ArrayByCoordinates pieceSquareValue)
getPieceSquareValueByCoordinatesByRank :: Map.Map Attribute.Rank.Rank (
Cartesian.Coordinates.ArrayByCoordinates pieceSquareValue
)
} deriving (PieceSquareTable pieceSquareValue
-> PieceSquareTable pieceSquareValue -> Normalise
(PieceSquareTable pieceSquareValue
-> PieceSquareTable pieceSquareValue -> Normalise)
-> (PieceSquareTable pieceSquareValue
-> PieceSquareTable pieceSquareValue -> Normalise)
-> Eq (PieceSquareTable pieceSquareValue)
forall pieceSquareValue.
Eq pieceSquareValue =>
PieceSquareTable pieceSquareValue
-> PieceSquareTable pieceSquareValue -> Normalise
forall a. (a -> a -> Normalise) -> (a -> a -> Normalise) -> Eq a
/= :: PieceSquareTable pieceSquareValue
-> PieceSquareTable pieceSquareValue -> Normalise
$c/= :: forall pieceSquareValue.
Eq pieceSquareValue =>
PieceSquareTable pieceSquareValue
-> PieceSquareTable pieceSquareValue -> Normalise
== :: PieceSquareTable pieceSquareValue
-> PieceSquareTable pieceSquareValue -> Normalise
$c== :: forall pieceSquareValue.
Eq pieceSquareValue =>
PieceSquareTable pieceSquareValue
-> PieceSquareTable pieceSquareValue -> Normalise
Eq, Int -> PieceSquareTable pieceSquareValue -> ShowS
[PieceSquareTable pieceSquareValue] -> ShowS
PieceSquareTable pieceSquareValue -> String
(Int -> PieceSquareTable pieceSquareValue -> ShowS)
-> (PieceSquareTable pieceSquareValue -> String)
-> ([PieceSquareTable pieceSquareValue] -> ShowS)
-> Show (PieceSquareTable pieceSquareValue)
forall pieceSquareValue.
Show pieceSquareValue =>
Int -> PieceSquareTable pieceSquareValue -> ShowS
forall pieceSquareValue.
Show pieceSquareValue =>
[PieceSquareTable pieceSquareValue] -> ShowS
forall pieceSquareValue.
Show pieceSquareValue =>
PieceSquareTable pieceSquareValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PieceSquareTable pieceSquareValue] -> ShowS
$cshowList :: forall pieceSquareValue.
Show pieceSquareValue =>
[PieceSquareTable pieceSquareValue] -> ShowS
show :: PieceSquareTable pieceSquareValue -> String
$cshow :: forall pieceSquareValue.
Show pieceSquareValue =>
PieceSquareTable pieceSquareValue -> String
showsPrec :: Int -> PieceSquareTable pieceSquareValue -> ShowS
$cshowsPrec :: forall pieceSquareValue.
Show pieceSquareValue =>
Int -> PieceSquareTable pieceSquareValue -> ShowS
Show)
instance (Real pieceSquareValue, Show pieceSquareValue) => Property.ShowFloat.ShowFloat (PieceSquareTable pieceSquareValue) where
showsFloat :: (Double -> ShowS) -> PieceSquareTable pieceSquareValue -> ShowS
showsFloat Double -> ShowS
fromDouble MkPieceSquareTable {
getNormalise :: forall pieceSquareValue.
PieceSquareTable pieceSquareValue -> Normalise
getNormalise = Normalise
normalise,
getReflectOnY :: forall pieceSquareValue.
PieceSquareTable pieceSquareValue -> Normalise
getReflectOnY = Normalise
reflectOnY,
getPieceSquareValueByCoordinatesByRank :: forall pieceSquareValue.
PieceSquareTable pieceSquareValue
-> Map Rank (ArrayByCoordinates pieceSquareValue)
getPieceSquareValueByCoordinatesByRank = Map Rank (ArrayByCoordinates 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 pieceSquareValue) -> (String, ShowS))
-> [(Rank, ArrayByCoordinates pieceSquareValue)]
-> [(String, ShowS)]
forall a b. (a -> b) -> [a] -> [b]
map (
Rank -> String
forall a. Show a => a -> String
show (Rank -> String)
-> (ArrayByCoordinates pieceSquareValue -> ShowS)
-> (Rank, ArrayByCoordinates 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 pieceSquareValue -> [pieceSquareValue])
-> ArrayByCoordinates 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 pieceSquareValue -> [pieceSquareValue])
-> ArrayByCoordinates pieceSquareValue
-> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByCoordinates pieceSquareValue -> [pieceSquareValue]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList
) (
Map Rank (ArrayByCoordinates pieceSquareValue)
-> [(Rank, ArrayByCoordinates pieceSquareValue)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Rank (ArrayByCoordinates pieceSquareValue)
byRank
)
instance Data.Default.Default (PieceSquareTable pieceSquareValue) where
def :: PieceSquareTable pieceSquareValue
def = MkPieceSquareTable :: forall pieceSquareValue.
Normalise
-> Normalise
-> Map Rank (ArrayByCoordinates pieceSquareValue)
-> PieceSquareTable pieceSquareValue
MkPieceSquareTable {
getNormalise :: Normalise
getNormalise = Normalise
False,
getReflectOnY :: Normalise
getReflectOnY = Normalise
True,
getPieceSquareValueByCoordinatesByRank :: Map Rank (ArrayByCoordinates pieceSquareValue)
getPieceSquareValueByCoordinatesByRank = Map Rank (ArrayByCoordinates pieceSquareValue)
forall a. Empty a => a
Property.Empty.empty
}
type IOFormat = Double
instance (
Fractional pieceSquareValue,
Ord pieceSquareValue,
Real pieceSquareValue,
Show pieceSquareValue
) => HXT.XmlPickler (PieceSquareTable pieceSquareValue) where
xpickle :: PU (PieceSquareTable pieceSquareValue)
xpickle = ((Normalise, Normalise, Assocs Rank pieceSquareValue)
-> PieceSquareTable pieceSquareValue,
PieceSquareTable pieceSquareValue
-> (Normalise, Normalise, Assocs Rank pieceSquareValue))
-> PU (Normalise, Normalise, Assocs Rank pieceSquareValue)
-> PU (PieceSquareTable 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 pieceSquareValue
forall pieceSquareValue.
(Fractional pieceSquareValue, Ord pieceSquareValue,
Show pieceSquareValue) =>
Normalise
-> Normalise
-> Assocs Rank pieceSquareValue
-> PieceSquareTable pieceSquareValue
mkPieceSquareTable Normalise
a Normalise
b Assocs Rank pieceSquareValue
c,
\MkPieceSquareTable {
getNormalise :: forall pieceSquareValue.
PieceSquareTable pieceSquareValue -> Normalise
getNormalise = Normalise
normalise,
getReflectOnY :: forall pieceSquareValue.
PieceSquareTable pieceSquareValue -> Normalise
getReflectOnY = Normalise
reflectOnY,
getPieceSquareValueByCoordinatesByRank :: forall pieceSquareValue.
PieceSquareTable pieceSquareValue
-> Map Rank (ArrayByCoordinates pieceSquareValue)
getPieceSquareValueByCoordinatesByRank = Map Rank (ArrayByCoordinates pieceSquareValue)
byRank
} -> (
Normalise
normalise,
Normalise
reflectOnY,
Map Rank [pieceSquareValue] -> Assocs Rank pieceSquareValue
forall k a. Map k a -> [(k, a)]
Map.toList (Map Rank [pieceSquareValue] -> Assocs Rank pieceSquareValue)
-> Map Rank [pieceSquareValue] -> Assocs Rank pieceSquareValue
forall a b. (a -> b) -> a -> b
$ (ArrayByCoordinates pieceSquareValue -> [pieceSquareValue])
-> Map Rank (ArrayByCoordinates pieceSquareValue)
-> Map Rank [pieceSquareValue]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.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 pieceSquareValue -> [pieceSquareValue])
-> ArrayByCoordinates pieceSquareValue
-> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByCoordinates pieceSquareValue -> [pieceSquareValue]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList
) Map Rank (ArrayByCoordinates pieceSquareValue)
byRank
)
) (PU (Normalise, Normalise, Assocs Rank pieceSquareValue)
-> PU (PieceSquareTable pieceSquareValue))
-> (PU (Assocs Rank pieceSquareValue)
-> PU (Normalise, Normalise, Assocs Rank pieceSquareValue))
-> PU (Assocs Rank pieceSquareValue)
-> PU (PieceSquareTable 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 -> Normalise
forall pieceSquareValue.
PieceSquareTable pieceSquareValue -> Normalise
getNormalise PieceSquareTable 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
) (
PieceSquareTable Any -> Normalise
forall pieceSquareValue.
PieceSquareTable pieceSquareValue -> Normalise
getReflectOnY PieceSquareTable 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
) (PU (Assocs Rank pieceSquareValue)
-> PU (PieceSquareTable pieceSquareValue))
-> PU (Assocs Rank pieceSquareValue)
-> PU (PieceSquareTable 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 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 :: IOFormat) |
String
word <- String -> [String]
words String
s,
(Double
pieceSquareValue, String
"") <- ReadS Double
forall a. Read a => ReadS a
reads String
word
],
[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 :: IOFormat))
) (
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 Assocs rank pieceSquareValue = [(rank, [pieceSquareValue])]
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
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
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
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
"."
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
"."
mkPieceSquareTable :: (
Fractional pieceSquareValue,
Ord pieceSquareValue,
Show pieceSquareValue
)
=> Normalise
-> ReflectOnY
-> Assocs Attribute.Rank.Rank pieceSquareValue
-> PieceSquareTable pieceSquareValue
mkPieceSquareTable :: Normalise
-> Normalise
-> Assocs Rank pieceSquareValue
-> PieceSquareTable 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
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int)
-> ((Rank, [pieceSquareValue]) -> Int)
-> (Rank, [pieceSquareValue])
-> Int
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
) Assocs Rank pieceSquareValue
assocs = Exception -> PieceSquareTable pieceSquareValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable pieceSquareValue)
-> (String -> Exception)
-> String
-> PieceSquareTable 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 pieceSquareValue)
-> String -> PieceSquareTable 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 pieceSquareValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable pieceSquareValue)
-> (String -> Exception)
-> String
-> PieceSquareTable 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 pieceSquareValue)
-> String -> PieceSquareTable 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 pieceSquareValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable pieceSquareValue)
-> (String -> Exception)
-> String
-> PieceSquareTable 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 pieceSquareValue)
-> String -> PieceSquareTable 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 pieceSquareValue.
Normalise
-> Normalise
-> Map Rank (ArrayByCoordinates pieceSquareValue)
-> PieceSquareTable pieceSquareValue
MkPieceSquareTable {
getNormalise :: Normalise
getNormalise = Normalise
normalise,
getReflectOnY :: Normalise
getReflectOnY = Normalise
reflectOnY,
getPieceSquareValueByCoordinatesByRank :: Map Rank (ArrayByCoordinates pieceSquareValue)
getPieceSquareValueByCoordinatesByRank = [(Rank, ArrayByCoordinates pieceSquareValue)]
-> Map Rank (ArrayByCoordinates pieceSquareValue)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Rank, ArrayByCoordinates pieceSquareValue)]
-> Map Rank (ArrayByCoordinates pieceSquareValue))
-> (Assocs Rank pieceSquareValue
-> [(Rank, ArrayByCoordinates pieceSquareValue)])
-> Assocs Rank pieceSquareValue
-> Map Rank (ArrayByCoordinates pieceSquareValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rank, [pieceSquareValue])
-> (Rank, ArrayByCoordinates pieceSquareValue))
-> Assocs Rank pieceSquareValue
-> [(Rank, ArrayByCoordinates pieceSquareValue)]
forall a b. (a -> b) -> [a] -> [b]
map (
([pieceSquareValue] -> ArrayByCoordinates pieceSquareValue)
-> (Rank, [pieceSquareValue])
-> (Rank, ArrayByCoordinates pieceSquareValue)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second [pieceSquareValue] -> ArrayByCoordinates pieceSquareValue
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Coordinates e
Cartesian.Coordinates.listArrayByCoordinates
) (Assocs Rank pieceSquareValue
-> [(Rank, ArrayByCoordinates pieceSquareValue)])
-> (Assocs Rank pieceSquareValue -> Assocs Rank pieceSquareValue)
-> Assocs Rank pieceSquareValue
-> [(Rank, ArrayByCoordinates 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 pieceSquareValue))
-> Assocs Rank pieceSquareValue
-> Map Rank (ArrayByCoordinates 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
findUndefinedRanks :: PieceSquareTable pieceSquareValue -> Data.Set.Set Attribute.Rank.Rank
findUndefinedRanks :: PieceSquareTable pieceSquareValue -> Set Rank
findUndefinedRanks MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank :: forall pieceSquareValue.
PieceSquareTable pieceSquareValue
-> Map Rank (ArrayByCoordinates pieceSquareValue)
getPieceSquareValueByCoordinatesByRank = Map Rank (ArrayByCoordinates 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 pieceSquareValue) -> Set Rank
forall k a. Map k a -> Set k
Map.keysSet Map Rank (ArrayByCoordinates pieceSquareValue)
pieceSquareValueByCoordinatesByRank
dereference
:: Attribute.Rank.Rank
-> PieceSquareTable pieceSquareValue
-> Maybe (Cartesian.Coordinates.ArrayByCoordinates pieceSquareValue)
dereference :: Rank
-> PieceSquareTable pieceSquareValue
-> Maybe (ArrayByCoordinates pieceSquareValue)
dereference Rank
rank MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank :: forall pieceSquareValue.
PieceSquareTable pieceSquareValue
-> Map Rank (ArrayByCoordinates pieceSquareValue)
getPieceSquareValueByCoordinatesByRank = Map Rank (ArrayByCoordinates pieceSquareValue)
pieceSquareValueByCoordinatesByRank } = Rank
-> Map Rank (ArrayByCoordinates pieceSquareValue)
-> Maybe (ArrayByCoordinates pieceSquareValue)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Rank
rank Map Rank (ArrayByCoordinates pieceSquareValue)
pieceSquareValueByCoordinatesByRank