]> Git — Sourcephile - majurity.git/blob - test/HUnit/Merit.hs
Add and test rankOfMajorityValue
[majurity.git] / test / HUnit / Merit.hs
1 {-# LANGUAGE OverloadedLists #-}
2 module HUnit.Merit where
3 import Control.Arrow (second)
4 import Data.Int (Int)
5 import Data.Eq (Eq(..))
6 import Data.Function (($), (.))
7 import Data.Functor ((<$>))
8 import Data.Hashable (Hashable)
9 import Data.List (zip)
10 import Data.Ord (Ord(..))
11 import Data.Ratio ((%))
12 import GHC.Exts (IsList(..))
13 import Text.Show (Show(..))
14 import qualified Data.HashMap.Strict as HM
15
16 import Test.Tasty
17 import Test.Tasty.HUnit
18 import Majority.Judgment
19 import HUnit.Utils
20 import Types
21
22 hunit :: TestTree
23 hunit = testGroup "Merit"
24 [ let m = mkMerit ['A'..'F'] in
25 testMajorityValueOfMerits
26 [ (The, m [136,307,251,148,84,74])
27 ]
28 [ (The,
29 [ Middle ( 57 % 1) 'C' 'C'
30 , Middle (137 % 1) 'B' 'C'
31 , Middle (148 % 1) 'B' 'D'
32 , Middle ( 22 % 1) 'B' 'E'
33 , Middle ( 62 % 1) 'A' 'E'
34 , Middle ( 74 % 1) 'A' 'F'
35 ])
36 ]
37 , let m = mkMerit [ToReject .. TooGood] in
38 testMajorityValueOfMerits
39 [ (This, m [12,10,21,5,5,5,2])
40 , (That, m [12,16,22,3,3,3,1])
41 ]
42 [ (This, [ Middle (8 % 1) Acceptable Acceptable
43 , Middle (5 % 1) Insufficient Acceptable
44 , Middle (5 % 1) Insufficient Good
45 , Middle (5 % 1) ToReject VeryGood
46 , Middle (5 % 1) ToReject Perfect
47 , Middle (2 % 1) ToReject TooGood
48 ])
49 , (That, [ Middle ( 2 % 1) Acceptable Acceptable
50 , Middle (16 % 1) Insufficient Acceptable
51 , Middle ( 2 % 1) ToReject Acceptable
52 , Middle ( 3 % 1) ToReject Good
53 , Middle ( 3 % 1) ToReject VeryGood
54 , Middle ( 3 % 1) ToReject Perfect
55 , Middle ( 1 % 1) ToReject TooGood
56 ])
57 ]
58 ]
59 mkMerit :: (Ord grade, Show grade) => [grade] -> [Share] -> Merit grade
60 mkMerit gs = fromList . (gs`zip`)
61
62 mkMeritByChoice ::
63 (Eq choice, Hashable choice, Ord grade) =>
64 [(choice,[grade])] ->
65 MeritByChoice choice grade
66 mkMeritByChoice os =
67 meritByChoice $ fromList $
68 second (fromList . zip [1::Int ..] . (singleGrade <$>)) <$> os
69
70 testMajorityValueOfMerits ::
71 (Show grade, Show choice, Ord grade, Eq choice, Hashable choice) =>
72 MeritByChoice choice grade ->
73 [(choice, [Middle grade])] -> TestTree
74 testMajorityValueOfMerits ms expect =
75 testCase (elide $ show $ unMeritByChoice ms) $
76 majorityValueByChoice ms
77 @?= (MajorityValue<$>HM.fromList expect)
78