{-# OPTIONS_GHC -fno-warn-orphans #-}
module Majurity.Judgment.Value where

import Data.Bool
import Data.Eq (Eq(..))
import Data.Function (($), (.), on)
import Data.Functor ((<$>))
import Data.List as List
import Data.Maybe (Maybe(..), listToMaybe)
import Data.Ord (Ord(..), Ordering(..), Down(..))
import Data.Ratio ((%), numerator, denominator)
import Data.Semigroup (Semigroup(..))
import Data.Tuple (snd)
import Prelude (Num(..), fromIntegral, lcm, div, )
import Text.Show (Show(..))
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as Map

import Majurity.Judgment.Merit

-- * Type 'MajorityValue'
-- | A 'MajorityValue' is a list of 'grade's
-- made from the successive lower middlemosts of a 'Merit',
-- i.e. from the most consensual 'majorityGrade' to the least.
--
-- For using less resources and generalizing to non-integral 'Share's,
-- this 'MajorityValue' is actually encoded as an Abbreviated Majority Value,
-- instead of a big list of 'grade's.
newtype MajorityValue grade = MajorityValue [Middle grade]
 deriving (MajorityValue grade -> MajorityValue grade -> Bool
(MajorityValue grade -> MajorityValue grade -> Bool)
-> (MajorityValue grade -> MajorityValue grade -> Bool)
-> Eq (MajorityValue grade)
forall grade.
Eq grade =>
MajorityValue grade -> MajorityValue grade -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MajorityValue grade -> MajorityValue grade -> Bool
$c/= :: forall grade.
Eq grade =>
MajorityValue grade -> MajorityValue grade -> Bool
== :: MajorityValue grade -> MajorityValue grade -> Bool
$c== :: forall grade.
Eq grade =>
MajorityValue grade -> MajorityValue grade -> Bool
Eq, Int -> MajorityValue grade -> ShowS
[MajorityValue grade] -> ShowS
MajorityValue grade -> String
(Int -> MajorityValue grade -> ShowS)
-> (MajorityValue grade -> String)
-> ([MajorityValue grade] -> ShowS)
-> Show (MajorityValue grade)
forall grade. Show grade => Int -> MajorityValue grade -> ShowS
forall grade. Show grade => [MajorityValue grade] -> ShowS
forall grade. Show grade => MajorityValue grade -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MajorityValue grade] -> ShowS
$cshowList :: forall grade. Show grade => [MajorityValue grade] -> ShowS
show :: MajorityValue grade -> String
$cshow :: forall grade. Show grade => MajorityValue grade -> String
showsPrec :: Int -> MajorityValue grade -> ShowS
$cshowsPrec :: forall grade. Show grade => Int -> MajorityValue grade -> ShowS
Show)
unMajorityValue :: MajorityValue grade -> [Middle grade]
unMajorityValue :: MajorityValue grade -> [Middle grade]
unMajorityValue (MajorityValue [Middle grade]
ms) = [Middle grade]
ms
instance Ord grade => Ord (MajorityValue grade) where
	MajorityValue []compare :: MajorityValue grade -> MajorityValue grade -> Ordering
`compare`MajorityValue [] = Ordering
EQ
	MajorityValue []`compare`MajorityValue [Middle grade]
ys | (Middle grade -> Bool) -> [Middle grade] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Share -> Share -> Bool
forall a. Eq a => a -> a -> Bool
==Share
0) (Share -> Bool) -> (Middle grade -> Share) -> Middle grade -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Middle grade -> Share
forall grade. Middle grade -> Share
middleShare) [Middle grade]
ys = Ordering
EQ
	                                          | Bool
otherwise                    = Ordering
LT
	MajorityValue [Middle grade]
xs`compare`MajorityValue [] | (Middle grade -> Bool) -> [Middle grade] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Share -> Share -> Bool
forall a. Eq a => a -> a -> Bool
==Share
0) (Share -> Bool) -> (Middle grade -> Share) -> Middle grade -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Middle grade -> Share
forall grade. Middle grade -> Share
middleShare) [Middle grade]
xs = Ordering
EQ
	                                          | Bool
otherwise                    = Ordering
GT
	mx :: MajorityValue grade
mx@(MajorityValue (Middle grade
x:[Middle grade]
xs)) `compare` my :: MajorityValue grade
my@(MajorityValue (Middle grade
y:[Middle grade]
ys))
	 | Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
x Share -> Share -> Bool
forall a. Ord a => a -> a -> Bool
<= Share
0 Bool -> Bool -> Bool
&& Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
y Share -> Share -> Bool
forall a. Ord a => a -> a -> Bool
<= Share
0 = [Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue [Middle grade]
xsMajorityValue grade -> MajorityValue grade -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`[Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue [Middle grade]
ys
	 | Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
x Share -> Share -> Bool
forall a. Ord a => a -> a -> Bool
<= Share
0 = [Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue [Middle grade]
xsMajorityValue grade -> MajorityValue grade -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`MajorityValue grade
my
	 | Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
y Share -> Share -> Bool
forall a. Ord a => a -> a -> Bool
<= Share
0 = MajorityValue grade
mxMajorityValue grade -> MajorityValue grade -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`[Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue [Middle grade]
ys
	 | Bool
otherwise =
		Middle grade -> grade
forall grade. Middle grade -> grade
lowGrade Middle grade
xgrade -> grade -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`Middle grade -> grade
forall grade. Middle grade -> grade
lowGrade Middle grade
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
		Middle grade -> grade
forall grade. Middle grade -> grade
highGrade Middle grade
xgrade -> grade -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`Middle grade -> grade
forall grade. Middle grade -> grade
highGrade Middle grade
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
		case Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
xShare -> Share -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
y of
		 Ordering
LT -> MajorityValue grade -> MajorityValue grade -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue [Middle grade]
xs) ([Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue (Middle grade
y{middleShare :: Share
middleShare = Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
y Share -> Share -> Share
forall a. Num a => a -> a -> a
- Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
x} Middle grade -> [Middle grade] -> [Middle grade]
forall a. a -> [a] -> [a]
: [Middle grade]
ys))
		 Ordering
EQ -> MajorityValue grade -> MajorityValue grade -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue [Middle grade]
xs) ([Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue [Middle grade]
ys)
		 Ordering
GT -> MajorityValue grade -> MajorityValue grade -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue (Middle grade
x{middleShare :: Share
middleShare = Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
x Share -> Share -> Share
forall a. Num a => a -> a -> a
- Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
y} Middle grade -> [Middle grade] -> [Middle grade]
forall a. a -> [a] -> [a]
: [Middle grade]
xs)) ([Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue [Middle grade]
ys)

-- ** Type 'Middle'
-- | A centered middle of a 'Merit'.
-- Needed to handle the 'Fractional' capabilities of a 'Share'.
--
-- By construction in 'majorityValue',
-- 'lowGrade' is always lower or equal to 'highGrade'.
data Middle grade = Middle
 { Middle grade -> Share
middleShare :: Share -- ^ the same 'Share' of 'lowGrade' and 'highGrade'.
 , Middle grade -> grade
lowGrade    :: grade
 , Middle grade -> grade
highGrade   :: grade
 } deriving (Middle grade -> Middle grade -> Bool
(Middle grade -> Middle grade -> Bool)
-> (Middle grade -> Middle grade -> Bool) -> Eq (Middle grade)
forall grade. Eq grade => Middle grade -> Middle grade -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Middle grade -> Middle grade -> Bool
$c/= :: forall grade. Eq grade => Middle grade -> Middle grade -> Bool
== :: Middle grade -> Middle grade -> Bool
$c== :: forall grade. Eq grade => Middle grade -> Middle grade -> Bool
Eq, Eq (Middle grade)
Eq (Middle grade)
-> (Middle grade -> Middle grade -> Ordering)
-> (Middle grade -> Middle grade -> Bool)
-> (Middle grade -> Middle grade -> Bool)
-> (Middle grade -> Middle grade -> Bool)
-> (Middle grade -> Middle grade -> Bool)
-> (Middle grade -> Middle grade -> Middle grade)
-> (Middle grade -> Middle grade -> Middle grade)
-> Ord (Middle grade)
Middle grade -> Middle grade -> Bool
Middle grade -> Middle grade -> Ordering
Middle grade -> Middle grade -> Middle grade
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall grade. Ord grade => Eq (Middle grade)
forall grade. Ord grade => Middle grade -> Middle grade -> Bool
forall grade. Ord grade => Middle grade -> Middle grade -> Ordering
forall grade.
Ord grade =>
Middle grade -> Middle grade -> Middle grade
min :: Middle grade -> Middle grade -> Middle grade
$cmin :: forall grade.
Ord grade =>
Middle grade -> Middle grade -> Middle grade
max :: Middle grade -> Middle grade -> Middle grade
$cmax :: forall grade.
Ord grade =>
Middle grade -> Middle grade -> Middle grade
>= :: Middle grade -> Middle grade -> Bool
$c>= :: forall grade. Ord grade => Middle grade -> Middle grade -> Bool
> :: Middle grade -> Middle grade -> Bool
$c> :: forall grade. Ord grade => Middle grade -> Middle grade -> Bool
<= :: Middle grade -> Middle grade -> Bool
$c<= :: forall grade. Ord grade => Middle grade -> Middle grade -> Bool
< :: Middle grade -> Middle grade -> Bool
$c< :: forall grade. Ord grade => Middle grade -> Middle grade -> Bool
compare :: Middle grade -> Middle grade -> Ordering
$ccompare :: forall grade. Ord grade => Middle grade -> Middle grade -> Ordering
$cp1Ord :: forall grade. Ord grade => Eq (Middle grade)
Ord)
instance Show grade => Show (Middle grade) where
	showsPrec :: Int -> Middle grade -> ShowS
showsPrec Int
p (Middle Share
s grade
l grade
h) = Int -> (Share, grade, grade) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Share
s,grade
l,grade
h)

-- | The 'majorityValue' is the list of the 'Middle's of the 'Merit' of a 'choice',
-- from the most consensual to the least.
majorityValue :: Ord grade => Merit grade -> MajorityValue grade
majorityValue :: Merit grade -> MajorityValue grade
majorityValue (Merit Map grade Share
countByGrade) = [Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue ([Middle grade] -> MajorityValue grade)
-> [Middle grade] -> MajorityValue grade
forall a b. (a -> b) -> a -> b
$ Share -> [(grade, Share)] -> [(grade, Share)] -> [Middle grade]
forall grade.
Ord grade =>
Share -> [(grade, Share)] -> [(grade, Share)] -> [Middle grade]
goMiddle Share
0 [] ([(grade, Share)] -> [Middle grade])
-> [(grade, Share)] -> [Middle grade]
forall a b. (a -> b) -> a -> b
$ Map grade Share -> [(grade, Share)]
forall k a. Map k a -> [(k, a)]
Map.toList Map grade Share
countByGrade
	where
	total :: Share
total = Map grade Share -> Share
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Map grade Share
countByGrade
	middle :: Share
middle = (Integer
1Integer -> Integer -> Share
forall a. Integral a => a -> a -> Ratio a
%Integer
2) Share -> Share -> Share
forall a. Num a => a -> a -> a
* Share
total
	goMiddle :: Ord grade => Share -> [(grade,Share)] -> [(grade,Share)] -> [Middle grade]
	goMiddle :: Share -> [(grade, Share)] -> [(grade, Share)] -> [Middle grade]
goMiddle Share
prevShare [(grade, Share)]
ps [(grade, Share)]
next =
		case [(grade, Share)]
next of
		 [] -> []
		 curr :: (grade, Share)
curr@(grade
currGrade,Share
currShare):[(grade, Share)]
ns ->
			let nextShare :: Share
nextShare = Share
prevShare Share -> Share -> Share
forall a. Num a => a -> a -> a
+ Share
currShare in
			case Share
nextShareShare -> Share -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`Share
middle of
			 Ordering
LT -> Share -> [(grade, Share)] -> [(grade, Share)] -> [Middle grade]
forall grade.
Ord grade =>
Share -> [(grade, Share)] -> [(grade, Share)] -> [Middle grade]
goMiddle Share
nextShare ((grade, Share)
curr(grade, Share) -> [(grade, Share)] -> [(grade, Share)]
forall a. a -> [a] -> [a]
:[(grade, Share)]
ps) [(grade, Share)]
ns
			 Ordering
EQ -> [(grade, Share)] -> [(grade, Share)] -> [Middle grade]
forall grade.
[(grade, Share)] -> [(grade, Share)] -> [Middle grade]
goBorders ((grade, Share)
curr(grade, Share) -> [(grade, Share)] -> [(grade, Share)]
forall a. a -> [a] -> [a]
:[(grade, Share)]
ps) [(grade, Share)]
ns
			 Ordering
GT ->
				let lowShare :: Share
lowShare  = Share
middle Share -> Share -> Share
forall a. Num a => a -> a -> a
- Share
prevShare in
				let highShare :: Share
highShare = Share
nextShare Share -> Share -> Share
forall a. Num a => a -> a -> a
- Share
middle in
				let minShare :: Share
minShare  = Share -> Share -> Share
forall a. Ord a => a -> a -> a
min Share
lowShare Share
highShare in
				Share -> grade -> grade -> Middle grade
forall grade. Share -> grade -> grade -> Middle grade
Middle Share
minShare grade
currGrade grade
currGrade Middle grade -> [Middle grade] -> [Middle grade]
forall a. a -> [a] -> [a]
:
				[(grade, Share)] -> [(grade, Share)] -> [Middle grade]
forall grade.
[(grade, Share)] -> [(grade, Share)] -> [Middle grade]
goBorders
				 ((grade
currGrade, Share
lowShare  Share -> Share -> Share
forall a. Num a => a -> a -> a
- Share
minShare) (grade, Share) -> [(grade, Share)] -> [(grade, Share)]
forall a. a -> [a] -> [a]
: [(grade, Share)]
ps)
				 ((grade
currGrade, Share
highShare Share -> Share -> Share
forall a. Num a => a -> a -> a
- Share
minShare) (grade, Share) -> [(grade, Share)] -> [(grade, Share)]
forall a. a -> [a] -> [a]
: [(grade, Share)]
ns)
	goBorders :: [(grade,Share)] -> [(grade,Share)] -> [Middle grade]
	goBorders :: [(grade, Share)] -> [(grade, Share)] -> [Middle grade]
goBorders [(grade, Share)]
lows [(grade, Share)]
highs =
		case ([(grade, Share)]
lows,[(grade, Share)]
highs) of
		 ((grade
lowGrade,Share
lowShare):[(grade, Share)]
ls, (grade
highGrade,Share
highShare):[(grade, Share)]
hs)
		  | Share
lowShare  Share -> Share -> Bool
forall a. Ord a => a -> a -> Bool
<= Share
0 -> [(grade, Share)] -> [(grade, Share)] -> [Middle grade]
forall grade.
[(grade, Share)] -> [(grade, Share)] -> [Middle grade]
goBorders [(grade, Share)]
ls [(grade, Share)]
highs
		  | Share
highShare Share -> Share -> Bool
forall a. Ord a => a -> a -> Bool
<= Share
0 -> [(grade, Share)] -> [(grade, Share)] -> [Middle grade]
forall grade.
[(grade, Share)] -> [(grade, Share)] -> [Middle grade]
goBorders [(grade, Share)]
lows [(grade, Share)]
hs
		  | Bool
otherwise ->
				let minShare :: Share
minShare = Share -> Share -> Share
forall a. Ord a => a -> a -> a
min Share
lowShare Share
highShare in
				Share -> grade -> grade -> Middle grade
forall grade. Share -> grade -> grade -> Middle grade
Middle Share
minShare grade
lowGrade grade
highGrade Middle grade -> [Middle grade] -> [Middle grade]
forall a. a -> [a] -> [a]
:
				[(grade, Share)] -> [(grade, Share)] -> [Middle grade]
forall grade.
[(grade, Share)] -> [(grade, Share)] -> [Middle grade]
goBorders
				 ((grade
lowGrade , Share
lowShare  Share -> Share -> Share
forall a. Num a => a -> a -> a
- Share
minShare) (grade, Share) -> [(grade, Share)] -> [(grade, Share)]
forall a. a -> [a] -> [a]
: [(grade, Share)]
ls)
				 ((grade
highGrade, Share
highShare Share -> Share -> Share
forall a. Num a => a -> a -> a
- Share
minShare) (grade, Share) -> [(grade, Share)] -> [(grade, Share)]
forall a. a -> [a] -> [a]
: [(grade, Share)]
hs)
		 ([(grade, Share)], [(grade, Share)])
_ -> []
instance Ord grade => Ord (Merit grade) where
	compare :: Merit grade -> Merit grade -> Ordering
compare = MajorityValue grade -> MajorityValue grade -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (MajorityValue grade -> MajorityValue grade -> Ordering)
-> (Merit grade -> MajorityValue grade)
-> Merit grade
-> Merit grade
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Merit grade -> MajorityValue grade
forall grade. Ord grade => Merit grade -> MajorityValue grade
majorityValue

-- | The 'majorityGrade' is the lower middlemost
-- (also known as median by experts) of the 'grade's
-- given to a 'choice' by the 'Judges'.
--
-- It is the highest 'grade' approved by an absolute majority of the 'Judges':
-- more than 50% of the 'Judges' give the 'choice' at least a 'grade' of 'majorityGrade',
-- but every 'grade' lower than 'majorityGrade' is rejected by an absolute majority
-- Thus the 'majorityGrade' of a 'choice'
-- is the final 'grade' wished by the majority.
--
-- The 'majorityGrade' is necessarily a word that belongs to 'grades',
-- and it has an absolute meaning.
--
-- When the number of 'Judges' is even, there is a middle-interval
-- (which can, of course, be reduced to a single 'grade'
-- if the two middle 'grade's are the same),
-- then the 'majorityGrade' is the lowest 'grade' of the middle-interval
-- (the “lower middlemost” when there are two in the middle),
-- which is the only one which respects consensus:
-- any other 'choice' whose grades are all within this middle-interval,
-- has a 'majorityGrade' which is greater or equal to this lower middlemost.
majorityGrade :: Ord grade => MajorityValue grade -> Maybe grade
majorityGrade :: MajorityValue grade -> Maybe grade
majorityGrade (MajorityValue [Middle grade]
mv) = Middle grade -> grade
forall grade. Middle grade -> grade
lowGrade (Middle grade -> grade) -> Maybe (Middle grade) -> Maybe grade
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Middle grade] -> Maybe (Middle grade)
forall a. [a] -> Maybe a
listToMaybe [Middle grade]
mv

-- * Type 'MajorityRanking'
type MajorityRanking choice grade = [(choice, MajorityValue grade)]

majorityValueByChoice :: Ord grade => MeritByChoice choice grade -> HM.HashMap choice (MajorityValue grade)
majorityValueByChoice :: MeritByChoice choice grade -> HashMap choice (MajorityValue grade)
majorityValueByChoice (MeritByChoice HashMap choice (Merit grade)
ms) = Merit grade -> MajorityValue grade
forall grade. Ord grade => Merit grade -> MajorityValue grade
majorityValue (Merit grade -> MajorityValue grade)
-> HashMap choice (Merit grade)
-> HashMap choice (MajorityValue grade)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap choice (Merit grade)
ms

-- | The 'majorityRanking' ranks all the 'choice's on the basis of their 'grade's.
--
-- Choice A ranks higher than 'choice' B in the 'majorityRanking'
-- if and only if A’s 'majorityValue' is lexicographically above B’s.
-- There can be no tie unless two 'choice's have precisely the same 'majorityValue's.
majorityRanking :: Ord grade => MeritByChoice choice grade -> MajorityRanking choice grade
majorityRanking :: MeritByChoice choice grade -> MajorityRanking choice grade
majorityRanking = ((choice, MajorityValue grade) -> Down (MajorityValue grade))
-> MajorityRanking choice grade -> MajorityRanking choice grade
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (MajorityValue grade -> Down (MajorityValue grade)
forall a. a -> Down a
Down (MajorityValue grade -> Down (MajorityValue grade))
-> ((choice, MajorityValue grade) -> MajorityValue grade)
-> (choice, MajorityValue grade)
-> Down (MajorityValue grade)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (choice, MajorityValue grade) -> MajorityValue grade
forall a b. (a, b) -> b
snd) (MajorityRanking choice grade -> MajorityRanking choice grade)
-> (MeritByChoice choice grade -> MajorityRanking choice grade)
-> MeritByChoice choice grade
-> MajorityRanking choice grade
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap choice (MajorityValue grade)
-> MajorityRanking choice grade
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap choice (MajorityValue grade)
 -> MajorityRanking choice grade)
-> (MeritByChoice choice grade
    -> HashMap choice (MajorityValue grade))
-> MeritByChoice choice grade
-> MajorityRanking choice grade
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeritByChoice choice grade -> HashMap choice (MajorityValue grade)
forall grade choice.
Ord grade =>
MeritByChoice choice grade -> HashMap choice (MajorityValue grade)
majorityValueByChoice

-- | Expand a 'MajorityValue' such that each 'grade' has a 'Share' of '1'.
--
-- WARNING: the resulting list of 'grade's may have a different length
-- than the list of 'grade's used to build the 'Merit'.
expandValue :: Eq grade => MajorityValue grade -> [grade]
expandValue :: MajorityValue grade -> [grade]
expandValue (MajorityValue [Middle grade]
ms) =
	let lcm' :: Integer
lcm' = (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm Integer
1 (Share -> Integer
forall a. Ratio a -> a
denominator (Share -> Integer)
-> (Middle grade -> Share) -> Middle grade -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Middle grade -> Share
forall grade. Middle grade -> Share
middleShare (Middle grade -> Integer) -> [Middle grade] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Middle grade]
ms) in
	[[grade]] -> [grade]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[grade]] -> [grade]) -> [[grade]] -> [grade]
forall a b. (a -> b) -> a -> b
$ ((Middle grade -> [grade]) -> [Middle grade] -> [[grade]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Middle grade]
ms) ((Middle grade -> [grade]) -> [[grade]])
-> (Middle grade -> [grade]) -> [[grade]]
forall a b. (a -> b) -> a -> b
$ \(Middle Share
s grade
l grade
h) ->
		let r :: Integer
r = Share -> Integer
forall a. Ratio a -> a
numerator Share
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
lcm' Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Share -> Integer
forall a. Ratio a -> a
denominator Share
s) in
		[[grade]] -> [grade]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [grade] -> [[grade]]
forall a. Int -> a -> [a]
replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r) [grade
l, grade
h])
		{-
		case r`divMod`2 of
		 (quo,0) -> concat (replicate (fromIntegral quo) [l, h])
		 (quo,_) -> l:concat (replicate (fromIntegral quo) [l, h])
		-}

-- | @'normalizeMajorityValue' m@ multiply all 'Share's
-- by their least common denominator to get integral 'Share's.
normalizeMajorityValue :: MajorityValue grade -> MajorityValue grade
normalizeMajorityValue :: MajorityValue grade -> MajorityValue grade
normalizeMajorityValue (MajorityValue [Middle grade]
mv) =
	[Middle grade] -> MajorityValue grade
forall grade. [Middle grade] -> MajorityValue grade
MajorityValue ([Middle grade] -> MajorityValue grade)
-> [Middle grade] -> MajorityValue grade
forall a b. (a -> b) -> a -> b
$ (\Middle grade
m -> Middle grade
m{middleShare :: Share
middleShare = Share
lcm' Share -> Share -> Share
forall a. Num a => a -> a -> a
* Middle grade -> Share
forall grade. Middle grade -> Share
middleShare Middle grade
m}) (Middle grade -> Middle grade) -> [Middle grade] -> [Middle grade]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Middle grade]
mv
	where
	lcm' :: Share
lcm' = (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm Integer
1 (Share -> Integer
forall a. Ratio a -> a
denominator (Share -> Integer)
-> (Middle grade -> Share) -> Middle grade -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Middle grade -> Share
forall grade. Middle grade -> Share
middleShare (Middle grade -> Integer) -> [Middle grade] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Middle grade]
mv) Integer -> Integer -> Share
forall a. Integral a => a -> a -> Ratio a
% Integer
den
	den :: Integer
den  = case [Middle grade]
mv of
	 Middle Share
s grade
_l grade
_h:[Middle grade]
_ -> Share -> Integer
forall a. Ratio a -> a
denominator Share
s
	 [Middle grade]
_ -> Integer
1