{-# LANGUAGE CPP #-}
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.Arrow
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 -> UArrayByRank RankValue
deconstruct ::
#ifdef UNBOX_TYPEMASS_ARRAYS
Attribute.Rank.UArrayByRank
#else
Attribute.Rank.ArrayByRank
#endif
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
instance Read RankValues where
readsPrec :: Int -> ReadS RankValues
readsPrec Int
precedence = (([(Rank, RankValue)], String) -> (RankValues, String))
-> [([(Rank, RankValue)], String)] -> [(RankValues, String)]
forall a b. (a -> b) -> [a] -> [b]
map (([(Rank, RankValue)] -> RankValues)
-> ([(Rank, RankValue)], String) -> (RankValues, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first [(Rank, RankValue)] -> RankValues
fromAssocs) ([([(Rank, RankValue)], String)] -> [(RankValues, String)])
-> (String -> [([(Rank, RankValue)], String)]) -> ReadS RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [([(Rank, RankValue)], String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
precedence
instance Show RankValues where
showsPrec :: Int -> RankValues -> ShowS
showsPrec Int
precedence MkRankValues { deconstruct :: RankValues -> UArrayByRank RankValue
deconstruct = UArrayByRank RankValue
byRank } = Int -> [(Rank, RankValue)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence ([(Rank, RankValue)] -> ShowS) -> [(Rank, RankValue)] -> ShowS
forall a b. (a -> b) -> a -> b
$ UArrayByRank RankValue -> [(Rank, RankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs UArrayByRank RankValue
byRank
instance Property.ShowFloat.ShowFloat RankValues where
showsFloat :: (RankValue -> ShowS) -> RankValues -> ShowS
showsFloat RankValue -> 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')
*** (RankValue -> ShowS) -> RankValue -> ShowS
forall a. ShowFloat a => (RankValue -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat RankValue -> ShowS
fromDouble) ([(Rank, RankValue)] -> [(String, ShowS)])
-> (RankValues -> [(Rank, RankValue)])
-> RankValues
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UArrayByRank RankValue -> [(Rank, RankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (UArrayByRank RankValue -> [(Rank, RankValue)])
-> (RankValues -> UArrayByRank RankValue)
-> RankValues
-> [(Rank, RankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues -> UArrayByRank RankValue
deconstruct
instance Data.Default.Default RankValues where
def :: RankValues
def = UArrayByRank RankValue -> RankValues
MkRankValues (UArrayByRank RankValue -> RankValues)
-> ([RankValue] -> UArrayByRank RankValue)
-> [RankValue]
-> RankValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RankValue] -> UArrayByRank 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 UArrayByRank RankValue
byRank) =
#ifdef UNBOX_TYPEMASS_ARRAYS
UArrayByRank RankValue -> ()
forall a. a -> ()
Control.DeepSeq.rwhnf
#else
Control.DeepSeq.rnf
#endif
UArrayByRank 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,
UArrayByRank RankValue -> [(Rank, RankValue)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (UArrayByRank RankValue -> [(Rank, RankValue)])
-> (RankValues -> UArrayByRank RankValue)
-> RankValues
-> [(Rank, RankValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValues -> UArrayByRank 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`
#ifndef USE_NEWTYPE_WRAPPERS
String -> PU RankValue -> PU RankValue
forall a. String -> PU a -> PU a
HXT.xpAttr String
Metric.RankValue.tag
#endif
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
"."
| UArrayByRank RankValue
byRank UArrayByRank 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 = UArrayByRank RankValue -> RankValues
MkRankValues UArrayByRank 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 :: UArrayByRank RankValue
byRank = [(Rank, RankValue)] -> UArrayByRank RankValue
forall (a :: * -> * -> *) e. IArray a e => [(Rank, e)] -> a Rank e
Attribute.Rank.arrayByRank [(Rank, RankValue)]
assocs
findRankValue :: RankValues -> Attribute.Rank.Rank -> Metric.RankValue.RankValue
findRankValue :: RankValues -> Rank -> RankValue
findRankValue (MkRankValues UArrayByRank RankValue
byRank) = (UArrayByRank RankValue
byRank UArrayByRank RankValue -> Rank -> RankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
calculateMaximumTotalValue :: RankValues -> Type.Mass.RankValue
calculateMaximumTotalValue :: RankValues -> RankValue
calculateMaximumTotalValue (MkRankValues UArrayByRank RankValue
byRank) = RankValue
9 RankValue -> RankValue -> RankValue
forall a. Num a => a -> a -> a
* RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (
UArrayByRank RankValue
byRank UArrayByRank 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
. RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue)
-> (Rank -> RankValue) -> Rank -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UArrayByRank RankValue
byRank UArrayByRank RankValue -> Rank -> RankValue
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
) RankValue
0 [Rank]
Attribute.Rank.flank