module BishBosh.Input.PieceSquareTable(
PieceSquareTable(
getByRank
),
tag,
reflectOnYTag,
findUndefinedRanks,
dereference,
mkPieceSquareTable
) 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.Num as Data.Num
import qualified BishBosh.Property.ShowFloat as Property.ShowFloat
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified Control.Arrow
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Default
import qualified Data.Map
import qualified Data.Set
import qualified Text.XML.HXT.Arrow.Pickle as HXT
tag :: String
tag = "pieceSquareTable"
reflectOnYTag :: String
reflectOnYTag = "reflectOnY"
data PieceSquareTable x y pieceSquareValue = MkPieceSquareTable {
getReflectOnY :: Bool,
getByRank :: Data.Map.Map Attribute.Rank.Rank (
Cartesian.Coordinates.ByCoordinates x y pieceSquareValue
)
} deriving (Eq, Show)
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Real pieceSquareValue,
Show pieceSquareValue
) => Property.ShowFloat.ShowFloat (PieceSquareTable x y pieceSquareValue) where
showsFloat fromDouble MkPieceSquareTable {
getReflectOnY = reflectOnY,
getByRank = byRank
} = Text.ShowList.showsAssociationList Text.ShowList.showsSeparator $ (
reflectOnYTag,
shows reflectOnY
) : map (
show *** Text.ShowList.showsFormattedList' (
fromDouble . realToFrac
) . (
if reflectOnY
then unmirror
else id
) . Data.Array.IArray.elems
) (
Data.Map.assocs byRank
)
instance Data.Default.Default (PieceSquareTable x y pieceSquareValue) where
def = MkPieceSquareTable {
getReflectOnY = True,
getByRank = Data.Map.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 = HXT.xpWrap (
uncurry mkPieceSquareTable,
\MkPieceSquareTable {
getReflectOnY = reflectOnY,
getByRank = byRank
} -> (
reflectOnY,
Data.Map.assocs $ Data.Map.map (
(
if reflectOnY
then unmirror
else id
) . Data.Array.IArray.elems
) byRank
)
) $ (
getReflectOnY Data.Default.def `HXT.xpDefault` HXT.xpAttr reflectOnYTag HXT.xpickle
) `HXT.xpPair` HXT.xpList1 (
HXT.xpElem "byRank" $ HXT.xpickle `HXT.xpPair` HXT.xpWrap (
\s -> [
realToFrac (pieceSquareValue :: Double) |
word <- words s,
(pieceSquareValue, "") <- reads word
],
unwords . map (show . (\pieceSquareValue -> realToFrac pieceSquareValue :: Double))
) (HXT.xpTextAttr "byCoordinates")
)
mirror :: Show pieceSquareValue => [pieceSquareValue] -> [pieceSquareValue]
mirror (a : b : c : d : remainder) = a : b : c : d : d : c : b : a : mirror remainder
mirror [] = []
mirror pieceSquareValues = Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Input.PieceSquareTable.mirror:\tthe number of piece-square values must be a multiple of " . shows (Cartesian.Abscissa.xLength `div` 2) . showString "; " $ shows pieceSquareValues "."
unmirror :: Show pieceSquareValue => [pieceSquareValue] -> [pieceSquareValue]
unmirror (a : b : c : d : remainder) = a : b : c : d : unmirror (drop (fromIntegral Cartesian.Abscissa.xLength `div` 2) remainder)
unmirror [] = []
unmirror pieceSquareValues = Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Input.PieceSquareTable.unmirror:\tthe number of piece-square values must be a multiple of " . shows (Cartesian.Abscissa.xLength `div` 2) . showString "; " $ shows pieceSquareValues "."
mkPieceSquareTable :: (
Enum x,
Enum y,
Num pieceSquareValue,
Ord pieceSquareValue,
Ord x,
Ord y,
Show pieceSquareValue
)
=> Bool
-> [(Attribute.Rank.Rank, [pieceSquareValue])]
-> PieceSquareTable x y pieceSquareValue
mkPieceSquareTable reflectOnY assocs
| any (
(/= nValuesRequired) . length . snd
) assocs = Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Input.PieceSquareTable.mkPieceSquareTable:\texactly " . shows nValuesRequired . showString " values must be defined for each type of piece; " $ shows assocs "."
| any (
any (
not . Data.Num.inClosedUnitInterval
) . snd
) assocs = Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.PieceSquareTable.mkPieceSquareTable:\tall values must be within the closed unit-interval [0,1]; " $ shows assocs "."
| otherwise = MkPieceSquareTable {
getReflectOnY = reflectOnY,
getByRank = Data.Map.fromList . map (Control.Arrow.second Cartesian.Coordinates.listArrayByCoordinates) $ (
if reflectOnY
then map $ Control.Arrow.second mirror
else id
) assocs
}
where
nValuesRequired = (
if reflectOnY
then (`div` 2)
else id
) Cartesian.Coordinates.nSquares
findUndefinedRanks :: PieceSquareTable x y pieceSquareValue -> Data.Set.Set Attribute.Rank.Rank
findUndefinedRanks MkPieceSquareTable { getByRank = byRank } = Data.Set.fromAscList Attribute.Rank.range `Data.Set.difference` Data.Map.keysSet byRank
dereference :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Attribute.Rank.Rank -> PieceSquareTable x y pieceSquareValue -> Maybe [pieceSquareValue]
dereference rank MkPieceSquareTable { getByRank = byRank} = Data.Array.IArray.elems `fmap` Data.Map.lookup rank byRank