module BishBosh.Attribute.RankValues(
RankValues(),
tag,
findRankValue,
calculateMaximumTotalValue,
fromAssocs
) where
import Control.Arrow((***))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Data.Num as Data.Num
import qualified BishBosh.Property.ShowFloat as Property.ShowFloat
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Default
import qualified Data.List
import qualified Data.Set
import qualified Text.XML.HXT.Arrow.Pickle as HXT
tag :: String
tag :: String
tag = String
"rankValues"
newtype RankValues rankValue = MkRankValues {
RankValues rankValue -> ByRank rankValue
deconstruct :: Attribute.Rank.ByRank rankValue
} deriving (RankValues rankValue -> RankValues rankValue -> Bool
(RankValues rankValue -> RankValues rankValue -> Bool)
-> (RankValues rankValue -> RankValues rankValue -> Bool)
-> Eq (RankValues rankValue)
forall rankValue.
Eq rankValue =>
RankValues rankValue -> RankValues rankValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RankValues rankValue -> RankValues rankValue -> Bool
$c/= :: forall rankValue.
Eq rankValue =>
RankValues rankValue -> RankValues rankValue -> Bool
== :: RankValues rankValue -> RankValues rankValue -> Bool
$c== :: forall rankValue.
Eq rankValue =>
RankValues rankValue -> RankValues rankValue -> Bool
Eq, ReadPrec [RankValues rankValue]
ReadPrec (RankValues rankValue)
Int -> ReadS (RankValues rankValue)
ReadS [RankValues rankValue]
(Int -> ReadS (RankValues rankValue))
-> ReadS [RankValues rankValue]
-> ReadPrec (RankValues rankValue)
-> ReadPrec [RankValues rankValue]
-> Read (RankValues rankValue)
forall rankValue. Read rankValue => ReadPrec [RankValues rankValue]
forall rankValue. Read rankValue => ReadPrec (RankValues rankValue)
forall rankValue.
Read rankValue =>
Int -> ReadS (RankValues rankValue)
forall rankValue. Read rankValue => ReadS [RankValues rankValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RankValues rankValue]
$creadListPrec :: forall rankValue. Read rankValue => ReadPrec [RankValues rankValue]
readPrec :: ReadPrec (RankValues rankValue)
$creadPrec :: forall rankValue. Read rankValue => ReadPrec (RankValues rankValue)
readList :: ReadS [RankValues rankValue]
$creadList :: forall rankValue. Read rankValue => ReadS [RankValues rankValue]
readsPrec :: Int -> ReadS (RankValues rankValue)
$creadsPrec :: forall rankValue.
Read rankValue =>
Int -> ReadS (RankValues rankValue)
Read, Int -> RankValues rankValue -> ShowS
[RankValues rankValue] -> ShowS
RankValues rankValue -> String
(Int -> RankValues rankValue -> ShowS)
-> (RankValues rankValue -> String)
-> ([RankValues rankValue] -> ShowS)
-> Show (RankValues rankValue)
forall rankValue.
Show rankValue =>
Int -> RankValues rankValue -> ShowS
forall rankValue. Show rankValue => [RankValues rankValue] -> ShowS
forall rankValue. Show rankValue => RankValues rankValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RankValues rankValue] -> ShowS
$cshowList :: forall rankValue. Show rankValue => [RankValues rankValue] -> ShowS
show :: RankValues rankValue -> String
$cshow :: forall rankValue. Show rankValue => RankValues rankValue -> String
showsPrec :: Int -> RankValues rankValue -> ShowS
$cshowsPrec :: forall rankValue.
Show rankValue =>
Int -> RankValues rankValue -> ShowS
Show)
instance Real rankValue => Property.ShowFloat.ShowFloat (RankValues rankValue) where
showsFloat :: (Double -> ShowS) -> RankValues rankValue -> ShowS
showsFloat Double -> ShowS
fromDouble = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS)
-> (RankValues rankValue -> [(String, ShowS)])
-> RankValues rankValue
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rank, rankValue) -> (String, ShowS))
-> [(Rank, rankValue)] -> [(String, ShowS)]
forall a b. (a -> b) -> [a] -> [b]
map (Rank -> String
forall a. Show a => a -> String
show (Rank -> String)
-> (rankValue -> ShowS) -> (Rank, rankValue) -> (String, ShowS)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Double -> ShowS
fromDouble (Double -> ShowS) -> (rankValue -> Double) -> rankValue -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rankValue -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac) ([(Rank, rankValue)] -> [(String, ShowS)])
-> (RankValues rankValue -> [(Rank, rankValue)])
-> RankValues rankValue
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Rank rankValue -> [(Rank, rankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (Array Rank rankValue -> [(Rank, rankValue)])
-> (RankValues rankValue -> Array Rank rankValue)
-> RankValues rankValue
-> [(Rank, rankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues rankValue -> Array Rank rankValue
forall rankValue. RankValues rankValue -> ByRank rankValue
deconstruct
instance (
Fractional rankValue,
Ord rankValue,
Show rankValue
) => Data.Default.Default (RankValues rankValue) where
def :: RankValues rankValue
def = [(Rank, rankValue)] -> RankValues rankValue
forall rankValue.
(Fractional rankValue, Ord rankValue, Show rankValue) =>
[(Rank, rankValue)] -> RankValues rankValue
fromAssocs [
(
Rank
Attribute.Rank.Pawn, rankValue
0.1
), (
Rank
Attribute.Rank.Rook, rankValue
0.525
), (
Rank
Attribute.Rank.Knight, rankValue
0.35
), (
Rank
Attribute.Rank.Bishop, rankValue
0.35
), (
Rank
Attribute.Rank.Queen, rankValue
1
), (
Rank
Attribute.Rank.King, rankValue
0
)
]
instance Control.DeepSeq.NFData rankValue => Control.DeepSeq.NFData (RankValues rankValue) where
rnf :: RankValues rankValue -> ()
rnf (MkRankValues ByRank rankValue
byRank) = ByRank rankValue -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf ByRank rankValue
byRank
instance (
Fractional rankValue,
HXT.XmlPickler rankValue,
Ord rankValue,
Show rankValue
) => HXT.XmlPickler (RankValues rankValue) where
xpickle :: PU (RankValues rankValue)
xpickle = RankValues rankValue
-> PU (RankValues rankValue) -> PU (RankValues rankValue)
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault RankValues rankValue
forall a. Default a => a
Data.Default.def (PU (RankValues rankValue) -> PU (RankValues rankValue))
-> (PU (Rank, rankValue) -> PU (RankValues rankValue))
-> PU (Rank, rankValue)
-> PU (RankValues rankValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Rank, rankValue)] -> RankValues rankValue,
RankValues rankValue -> [(Rank, rankValue)])
-> PU [(Rank, rankValue)] -> PU (RankValues rankValue)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
[(Rank, rankValue)] -> RankValues rankValue
forall rankValue.
(Fractional rankValue, Ord rankValue, Show rankValue) =>
[(Rank, rankValue)] -> RankValues rankValue
fromAssocs,
Array Rank rankValue -> [(Rank, rankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (Array Rank rankValue -> [(Rank, rankValue)])
-> (RankValues rankValue -> Array Rank rankValue)
-> RankValues rankValue
-> [(Rank, rankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues rankValue -> Array Rank rankValue
forall rankValue. RankValues rankValue -> ByRank rankValue
deconstruct
) (PU [(Rank, rankValue)] -> PU (RankValues rankValue))
-> (PU (Rank, rankValue) -> PU [(Rank, rankValue)])
-> PU (Rank, rankValue)
-> PU (RankValues rankValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU (Rank, rankValue) -> PU [(Rank, rankValue)]
forall a. PU a -> PU [a]
HXT.xpList1 (PU (Rank, rankValue) -> PU [(Rank, rankValue)])
-> (PU (Rank, rankValue) -> PU (Rank, rankValue))
-> PU (Rank, rankValue)
-> PU [(Rank, rankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU (Rank, rankValue) -> PU (Rank, rankValue)
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU (Rank, rankValue) -> PU (RankValues rankValue))
-> PU (Rank, rankValue) -> PU (RankValues rankValue)
forall a b. (a -> b) -> a -> b
$ PU Rank
forall a. XmlPickler a => PU a
HXT.xpickle PU Rank -> PU rankValue -> PU (Rank, rankValue)
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` String -> PU rankValue -> PU rankValue
forall a. String -> PU a -> PU a
HXT.xpAttr String
"value" PU rankValue
forall a. XmlPickler a => PU a
HXT.xpickle
fromAssocs :: (
Fractional rankValue,
Ord rankValue,
Show rankValue
) => [(Attribute.Rank.Rank, rankValue)] -> RankValues rankValue
fromAssocs :: [(Rank, rankValue)] -> RankValues rankValue
fromAssocs [(Rank, rankValue)]
assocs
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set Rank -> Bool
forall a. Set a -> Bool
Data.Set.null Set Rank
undefinedRanks = Exception -> RankValues rankValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues rankValue)
-> (String -> Exception) -> String -> RankValues rankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInsufficientData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Attribute.RankValues.fromAssocs:\tranks" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> RankValues rankValue) -> String -> RankValues rankValue
forall a b. (a -> b) -> a -> b
$ [Rank] -> ShowS
forall a. Show a => a -> ShowS
shows (Set Rank -> [Rank]
forall a. Set a -> [a]
Data.Set.toList Set Rank
undefinedRanks) String
" are undefined."
| ((Rank, rankValue) -> Bool) -> [(Rank, rankValue)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
Bool -> Bool
not (Bool -> Bool)
-> ((Rank, rankValue) -> Bool) -> (Rank, rankValue) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rankValue -> Bool
forall n. (Num n, Ord n) => n -> Bool
Data.Num.inClosedUnitInterval (rankValue -> Bool)
-> ((Rank, rankValue) -> rankValue) -> (Rank, rankValue) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank, rankValue) -> rankValue
forall a b. (a, b) -> b
snd
) [(Rank, rankValue)]
assocs = Exception -> RankValues rankValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues rankValue)
-> (String -> Exception) -> String -> RankValues rankValue
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.Attribute.RankValues.fromAssocs:\tall values must be within the closed unit-interval, [0,1]; " (String -> RankValues rankValue) -> String -> RankValues rankValue
forall a b. (a -> b) -> a -> b
$ [(Rank, rankValue)] -> ShowS
forall a. Show a => a -> ShowS
shows [(Rank, rankValue)]
assocs String
"."
| Bool
otherwise = ByRank rankValue -> RankValues rankValue
forall rankValue. ByRank rankValue -> RankValues rankValue
MkRankValues ByRank rankValue
byRank
where
undefinedRanks :: Set Rank
undefinedRanks = [Rank] -> Set Rank
forall a. Eq a => [a] -> Set a
Data.Set.fromAscList [Rank]
Attribute.Rank.range Set Rank -> Set Rank -> Set Rank
forall a. Ord a => Set a -> Set a -> Set a
`Data.Set.difference` [Rank] -> Set Rank
forall a. Ord a => [a] -> Set a
Data.Set.fromList (((Rank, rankValue) -> Rank) -> [(Rank, rankValue)] -> [Rank]
forall a b. (a -> b) -> [a] -> [b]
map (Rank, rankValue) -> Rank
forall a b. (a, b) -> a
fst [(Rank, rankValue)]
assocs)
byRank :: ByRank rankValue
byRank = (Rank, Rank) -> [(Rank, rankValue)] -> ByRank rankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
Data.Array.IArray.array (Rank
forall a. Bounded a => a
minBound, Rank
forall a. Bounded a => a
maxBound) [(Rank, rankValue)]
assocs
findRankValue :: Attribute.Rank.Rank -> RankValues rankValue -> rankValue
findRankValue :: Rank -> RankValues rankValue -> rankValue
findRankValue Rank
rank (MkRankValues ByRank rankValue
byRank) = ByRank rankValue
byRank ByRank rankValue -> Rank -> rankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank
calculateMaximumTotalValue :: Num rankValue => RankValues rankValue -> rankValue
calculateMaximumTotalValue :: RankValues rankValue -> rankValue
calculateMaximumTotalValue (MkRankValues ByRank rankValue
byRank) = rankValue
9 rankValue -> rankValue -> rankValue
forall a. Num a => a -> a -> a
* (ByRank rankValue
byRank ByRank rankValue -> Rank -> rankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Queen) rankValue -> rankValue -> rankValue
forall a. Num a => a -> a -> a
+ rankValue
2 rankValue -> rankValue -> rankValue
forall a. Num a => a -> a -> a
* (rankValue -> Rank -> rankValue)
-> rankValue -> [Rank] -> rankValue
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\rankValue
acc -> (rankValue -> rankValue -> rankValue
forall a. Num a => a -> a -> a
+ rankValue
acc) (rankValue -> rankValue)
-> (Rank -> rankValue) -> Rank -> rankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByRank rankValue
byRank ByRank rankValue -> Rank -> rankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
) rankValue
0 [Rank]
Attribute.Rank.flank