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)