]> Git — Sourcephile - majurity.git/blob - hjugement/test/HUnit/Value.hs
Add majorityValueOfRank
[majurity.git] / hjugement / test / HUnit / Value.hs
1 {-# LANGUAGE OverloadedLists #-}
2 module HUnit.Value where
3 import Data.Function (($))
4 import Data.Int (Int)
5 import Data.Hashable (Hashable)
6 import Data.Eq (Eq(..))
7 import Data.Functor ((<$>))
8 import Data.Ord (Ord(..), Ordering(..))
9 import Data.Ratio ((%))
10 import Text.Show (Show(..))
11 import qualified Data.HashMap.Strict as HM
12
13 import Test.Tasty
14 import Test.Tasty.HUnit
15 import Majority.Judgment
16 import HUnit.Merit
17 import HUnit.Utils
18 import Types
19
20 hunit :: TestTree
21 hunit = testGroup "Value"
22 [ testGroup "MajorityValue"
23 [ testCompareValue
24 (majorityValue $ Merit [(3,15), (2,7), (1,3), (0::Int,2)])
25 (majorityValue $ Merit [(3,16), (2,6), (1,2), (0,3)])
26 ]
27 , testGroup "MajorityRanking"
28 [ testMajorityValueOfOpinions
29 [ (The, [No,No,No,No,Yes,Yes]) ]
30 [ (The, [ Middle (1 % 1) No No
31 , Middle (2 % 1) No Yes
32 ]) ]
33 , testMajorityValueOfOpinions
34 [ (The, [No,No,No,Yes,Yes,Yes]) ]
35 [ (The, [ Middle (3 % 1) No Yes ]) ]
36 , testMajorityValueOfOpinions
37 [ (The, [No,No,No,No,Yes,Yes,Yes]) ]
38 [ (The, [ Middle (1 % 2) No No
39 , Middle (3 % 1) No Yes ]) ]
40 , testMajorityValueOfOpinions
41 [ (This, [No,No,No,No,Yes,Yes])
42 , (That, [No,Yes,Yes,Yes,Yes,Yes])
43 ]
44 [ (This, [ Middle (1 % 1) No No
45 , Middle (2 % 1) No Yes
46 ])
47 , (That, [ Middle (2 % 1) Yes Yes
48 , Middle (1 % 1) No Yes
49 ])
50 ]
51 , testMajorityValueOfOpinions
52 [ (This, [No,No,No,No,No,No])
53 , (That, [No,No,No,Yes,Yes,Yes])
54 ]
55 [ (This, [Middle (3 % 1) No No])
56 , (That, [Middle (3 % 1) No Yes])
57 ]
58 , testMajorityValueOfOpinions
59 [ (This, [Yes,Yes,Yes,Yes,Yes,Yes])
60 , (That, [No,No,No,Yes,Yes,Yes])
61 ]
62 [ (This, [Middle (3 % 1) Yes Yes])
63 , (That, [Middle (3 % 1) No Yes])
64 ]
65 , testMajorityValueOfOpinions
66 [ (This, [No,No,Yes,Yes,Yes,Yes])
67 , (That, [No,No,No,Yes,Yes,Yes])
68 ]
69 [ (This, [ Middle (1 % 1) Yes Yes
70 , Middle (2 % 1) No Yes
71 ])
72 , (That, [ Middle (3 % 1) No Yes ])
73 ]
74 , testMajorityValueOfOpinions
75 [ (1::Int, [Perfect,Perfect,VeryGood,Perfect,Perfect,Perfect])
76 , (2, [Perfect,VeryGood,VeryGood,VeryGood,Good,VeryGood])
77 , (3, [Acceptable,Perfect,Good,VeryGood,VeryGood,Perfect])
78 , (4, [VeryGood,Good,Acceptable,Good,Good,Good])
79 , (5, [Good,Acceptable,VeryGood,Good,Good,Good])
80 , (6, [VeryGood,Acceptable,Insufficient,Acceptable,Acceptable,Good])
81 ]
82 [ (1, [ Middle (2 % 1) Perfect Perfect
83 , Middle (1 % 1) VeryGood Perfect
84 ])
85 , (2, [ Middle (2 % 1) VeryGood VeryGood
86 , Middle (1 % 1) Good Perfect
87 ])
88 , (3, [ Middle (1 % 1) VeryGood VeryGood
89 , Middle (1 % 1) Good Perfect
90 , Middle (1 % 1) Acceptable Perfect
91 ])
92 , (4, [ Middle (2 % 1) Good Good
93 , Middle (1 % 1) Acceptable VeryGood
94 ])
95 , (5, [ Middle (2 % 1) Good Good
96 , Middle (1 % 1) Acceptable VeryGood
97 ])
98 , (6, [ Middle (1 % 1) Acceptable Acceptable
99 , Middle (1 % 1) Acceptable Good
100 , Middle (1 % 1) Insufficient VeryGood
101 ])
102 ]
103 ]
104 ]
105
106 testCompareValue ::
107 (Ord grade, Show grade) =>
108 MajorityValue grade -> MajorityValue grade -> TestTree
109 testCompareValue x y =
110 testGroup (elide $ show (unMajorityValue x, unMajorityValue y))
111 [ testCase "x == x" $ x`compare`x @?= EQ
112 , testCase "y == y" $ y`compare`y @?= EQ
113 , testCase "x < y" $ x`compare`y @?= LT
114 , testCase "y > x" $ y`compare`x @?= GT
115 ]
116
117 testMajorityRanking ::
118 (Eq choice, Hashable choice, Ord grade, Show grade, Show choice) =>
119 [(choice, [grade])] ->
120 MajorityRanking choice grade -> TestTree
121 testMajorityRanking os expect =
122 testCase (elide $ show os) $
123 majorityRanking (mkMeritByChoice os) @?= expect
124
125 testMajorityValueOfOpinions ::
126 (Show grade, Show choice, Ord grade, Eq choice, Hashable choice) =>
127 [(choice, [grade])] ->
128 [(choice, [Middle grade])] -> TestTree
129 testMajorityValueOfOpinions os expect =
130 testCase (elide $ show os) $
131 majorityValueByChoice (mkMeritByChoice os)
132 @?= (MajorityValue<$>HM.fromList expect)