module BishBosh.Input.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.Foldable as Data.Foldable
import qualified BishBosh.Metric.RankValue as Metric.RankValue
import qualified BishBosh.Property.ShowFloat as Property.ShowFloat
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Type.Mass as Type.Mass
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Default
import qualified Data.List
import qualified Text.XML.HXT.Arrow.Pickle as HXT
tag :: String
tag :: String
tag = String
"rankValues"
newtype RankValues = MkRankValues {
RankValues -> ArrayByRank RankValue
deconstruct :: Attribute.Rank.ArrayByRank Metric.RankValue.RankValue
} deriving (RankValues -> RankValues -> Bool
(RankValues -> RankValues -> Bool)
-> (RankValues -> RankValues -> Bool) -> Eq RankValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RankValues -> RankValues -> Bool
$c/= :: RankValues -> RankValues -> Bool
== :: RankValues -> RankValues -> Bool
$c== :: RankValues -> RankValues -> Bool
Eq, ReadPrec [RankValues]
ReadPrec RankValues
Int -> ReadS RankValues
ReadS [RankValues]
(Int -> ReadS RankValues)
-> ReadS [RankValues]
-> ReadPrec RankValues
-> ReadPrec [RankValues]
-> Read RankValues
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RankValues]
$creadListPrec :: ReadPrec [RankValues]
readPrec :: ReadPrec RankValues
$creadPrec :: ReadPrec RankValues
readList :: ReadS [RankValues]
$creadList :: ReadS [RankValues]
readsPrec :: Int -> ReadS RankValues
$creadsPrec :: Int -> ReadS RankValues
Read, Int -> RankValues -> ShowS
[RankValues] -> ShowS
RankValues -> String
(Int -> RankValues -> ShowS)
-> (RankValues -> String)
-> ([RankValues] -> ShowS)
-> Show RankValues
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RankValues] -> ShowS
$cshowList :: [RankValues] -> ShowS
show :: RankValues -> String
$cshow :: RankValues -> String
showsPrec :: Int -> RankValues -> ShowS
$cshowsPrec :: Int -> RankValues -> ShowS
Show)
instance Property.ShowFloat.ShowFloat RankValues where
showsFloat :: (Double -> ShowS) -> RankValues -> ShowS
showsFloat Double -> ShowS
fromDouble = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS)
-> (RankValues -> [(String, ShowS)]) -> RankValues -> 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) -> RankValue -> ShowS
forall a. ShowFloat a => (Double -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat Double -> ShowS
fromDouble) ([(Rank, RankValue)] -> [(String, ShowS)])
-> (RankValues -> [(Rank, RankValue)])
-> RankValues
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByRank RankValue -> [(Rank, RankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (ArrayByRank RankValue -> [(Rank, RankValue)])
-> (RankValues -> ArrayByRank RankValue)
-> RankValues
-> [(Rank, RankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues -> ArrayByRank RankValue
deconstruct
instance Data.Default.Default RankValues where
def :: RankValues
def = ArrayByRank RankValue -> RankValues
MkRankValues (ArrayByRank RankValue -> RankValues)
-> ([RankValue] -> ArrayByRank RankValue)
-> [RankValue]
-> RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RankValue] -> ArrayByRank RankValue
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Rank e
Attribute.Rank.listArrayByRank ([RankValue] -> RankValues) -> [RankValue] -> RankValues
forall a b. (a -> b) -> a -> b
$ (Rational -> RankValue) -> [Rational] -> [RankValue]
forall a b. (a -> b) -> [a] -> [b]
map (
Rational -> RankValue
forall a. Fractional a => Rational -> a
fromRational (Rational -> RankValue)
-> (Rational -> Rational) -> Rational -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
10)
) [
Rational
1,
Rational
5,
Rational
3,
Rational
3,
Rational
9,
Rational
0
]
instance Control.DeepSeq.NFData RankValues where
rnf :: RankValues -> ()
rnf (MkRankValues ArrayByRank RankValue
byRank) = ArrayByRank RankValue -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf ArrayByRank RankValue
byRank
instance HXT.XmlPickler RankValues where
xpickle :: PU RankValues
xpickle = RankValues -> PU RankValues -> PU RankValues
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault RankValues
forall a. Default a => a
Data.Default.def (PU RankValues -> PU RankValues)
-> (PU (Rank, RankValue) -> PU RankValues)
-> PU (Rank, RankValue)
-> PU RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Rank, RankValue)] -> RankValues,
RankValues -> [(Rank, RankValue)])
-> PU [(Rank, RankValue)] -> PU RankValues
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
[(Rank, RankValue)] -> RankValues
fromAssocs,
ArrayByRank RankValue -> [(Rank, RankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (ArrayByRank RankValue -> [(Rank, RankValue)])
-> (RankValues -> ArrayByRank RankValue)
-> RankValues
-> [(Rank, RankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues -> ArrayByRank RankValue
deconstruct
) (PU [(Rank, RankValue)] -> PU RankValues)
-> (PU (Rank, RankValue) -> PU [(Rank, RankValue)])
-> PU (Rank, RankValue)
-> PU RankValues
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)
-> PU (Rank, RankValue) -> PU RankValues
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` PU RankValue
forall a. XmlPickler a => PU a
HXT.xpickle
fromAssocs :: [(Attribute.Rank.Rank, Metric.RankValue.RankValue)] -> RankValues
fromAssocs :: [(Rank, RankValue)] -> RankValues
fromAssocs [(Rank, RankValue)]
assocs
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Rank] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Rank]
undefinedRanks = Exception -> RankValues
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues)
-> (String -> Exception) -> String -> RankValues
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.Input.RankValues.fromAssocs:\tranks" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> RankValues) -> String -> RankValues
forall a b. (a -> b) -> a -> b
$ [Rank] -> ShowS
forall a. Show a => a -> ShowS
shows [Rank]
undefinedRanks String
" are undefined."
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Rank] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Rank]
duplicateRanks = Exception -> RankValues
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues)
-> (String -> Exception) -> String -> RankValues
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.RankValues.fromAssocs:\tranks must be distinct; " (String -> RankValues) -> String -> RankValues
forall a b. (a -> b) -> a -> b
$ [Rank] -> ShowS
forall a. Show a => a -> ShowS
shows [Rank]
duplicateRanks String
"."
| ((Rank, RankValue) -> Bool) -> [(Rank, RankValue)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
(RankValue -> RankValue -> Bool
forall a. Eq a => a -> a -> Bool
== RankValue
0) (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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues)
-> (String -> Exception) -> String -> RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkNullDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.RankValues.fromAssocs:\tat least one rank should have a non-zero value; " (String -> RankValues) -> String -> RankValues
forall a b. (a -> b) -> a -> b
$ [(Rank, RankValue)] -> ShowS
forall a. Show a => a -> ShowS
shows [(Rank, RankValue)]
assocs String
"."
| ArrayByRank RankValue
byRank ArrayByRank RankValue -> Rank -> RankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Queen RankValue -> RankValue -> Bool
forall a. Eq a => a -> a -> Bool
/= [RankValue] -> RankValue
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
RankValue
rankValue |
(Rank
rank, RankValue
rankValue) <- [(Rank, RankValue)]
assocs,
Rank
rank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank
Attribute.Rank.King
] = Exception -> RankValues
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValues)
-> (String -> Exception) -> String -> RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.RankValues.fromAssocs:\texcepting possibly the King, the Queen should be the most valuable rank; " (String -> RankValues) -> String -> RankValues
forall a b. (a -> b) -> a -> b
$ [(Rank, RankValue)] -> ShowS
forall a. Show a => a -> ShowS
shows [(Rank, RankValue)]
assocs String
"."
| Bool
otherwise = ArrayByRank RankValue -> RankValues
MkRankValues ArrayByRank RankValue
byRank
where
([Rank]
undefinedRanks, [Rank]
duplicateRanks) = [Rank] -> [Rank]
Attribute.Rank.findUndefinedRanks ([Rank] -> [Rank])
-> ([Rank] -> [Rank]) -> [Rank] -> ([Rank], [Rank])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Rank] -> [Rank]
forall (foldable :: * -> *) a.
(Foldable foldable, Ord a) =>
foldable a -> [a]
Data.Foldable.findDuplicates ([Rank] -> ([Rank], [Rank])) -> [Rank] -> ([Rank], [Rank])
forall a b. (a -> b) -> a -> b
$ ((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 :: ArrayByRank RankValue
byRank = [(Rank, RankValue)] -> ArrayByRank RankValue
forall (a :: * -> * -> *) e. IArray a e => [(Rank, e)] -> a Rank e
Attribute.Rank.arrayByRank [(Rank, RankValue)]
assocs
findRankValue :: Attribute.Rank.Rank -> RankValues -> Metric.RankValue.RankValue
findRankValue :: Rank -> RankValues -> RankValue
findRankValue Rank
rank (MkRankValues ArrayByRank RankValue
byRank) = ArrayByRank RankValue
byRank ArrayByRank RankValue -> Rank -> RankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank
calculateMaximumTotalValue :: RankValues -> Type.Mass.RankValue
calculateMaximumTotalValue :: RankValues -> Double
calculateMaximumTotalValue (MkRankValues ArrayByRank RankValue
byRank) = Double
9 Double -> Double -> Double
forall a. Num a => a -> a -> a
* RankValue -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (
ArrayByRank RankValue
byRank ArrayByRank RankValue -> Rank -> RankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Queen
) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Rank -> Double) -> Double -> [Rank] -> Double
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\Double
acc -> (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
acc) (Double -> Double) -> (Rank -> Double) -> Rank -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValue -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> Double) -> (Rank -> RankValue) -> Rank -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayByRank RankValue
byRank ArrayByRank RankValue -> Rank -> RankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
) Double
0 [Rank]
Attribute.Rank.flank