CohensKappa.hs

module CohensKappa where

import Data.Hashable
import qualified Data.HashMap.Strict as HashMap

-- | Cohen's kappa coefficient (κ)
--
-- https://en.wikipedia.org/wiki/Cohen%27s_kappa
cohensKappa :: (Hashable c, Fractional a) => [(c,c)] -> a
cohensKappa xs = (po - pe) / (1 - pe)
  where
    n = fromIntegral $ length xs
    as = fmap (/ n) $ HashMap.fromListWith (+) [(a, 1) | (a, _) <- xs]
    bs = fmap (/ n) $ HashMap.fromListWith (+) [(b, 1) | (_, b) <- xs]
    po = fromIntegral (length [() | (a,b) <- xs, a==b]) / n
    pe = sum $ HashMap.elems (HashMap.intersectionWith (*) as bs)

-- from https://en.wikipedia.org/wiki/Cohen%27s_kappa
testData1 :: [(Bool, Bool)]
testData1 =
  replicate 20 (True,True) ++ replicate 5 (True,False) ++
  replicate 10 (False,True) ++ replicate 15 (False,False)

-- from https://en.wikipedia.org/wiki/Cohen%27s_kappa
testData2 :: [(Bool, Bool)]
testData2 =
  replicate 45 (True,True) ++ replicate 15 (True,False) ++
  replicate 25 (False,True) ++ replicate 15 (False,False)

-- from https://en.wikipedia.org/wiki/Cohen%27s_kappa
testData3 :: [(Bool, Bool)]
testData3 =
  replicate 25 (True,True) ++ replicate 35 (True,False) ++
  replicate 5 (False,True) ++ replicate 35 (False,False)

-- https://kamiyacho.org/ebm/ce201.html
testData4 :: [(String, String)]
testData4 =
  replicate 61 ("肺炎","肺炎") ++ replicate 3 ("肺炎","結核") ++ replicate 1 ("肺炎","肺癌") ++
  replicate 10 ("結核","肺炎") ++ replicate 7 ("結核","結核") ++ replicate 3 ("結核","肺癌") ++
  replicate  4 ("肺癌","肺炎") ++ replicate 5 ("肺癌","結核") ++ replicate 6 ("肺癌","肺癌")

FleissKappa.hs

module FleissKappa where

import Data.Hashable
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap

-- | Fleiss' kappa
--
-- https://en.wikipedia.org/wiki/Fleiss%27_kappa
fleissKappa :: (Hashable c, Fractional a) => [HashMap c Integer] -> a
fleissKappa [] = 1
fleissKappa hs@(h0 : _) = (p - pe) / (1 - pe)
  where
    numSubjects = fromIntegral (length hs)
    numRatingPerSubjects = sum h0
    p = fromIntegral ((sum [nij ^ (2::Int) | h <- hs, nij <- HashMap.elems h] - numSubjects * numRatingPerSubjects))
      / fromIntegral (numSubjects * numRatingPerSubjects * (numRatingPerSubjects - 1))
    pe = fromIntegral (sum [nj ^ (2::Int) | nj <- HashMap.elems (unionsWith (+) hs)])
       / fromIntegral ((numSubjects * numRatingPerSubjects) ^ (2::Int))

unionsWith :: Hashable k => (v -> v -> v) -> [HashMap k v] -> HashMap k v
unionsWith f =  foldl (HashMap.unionWith f) HashMap.empty

-- from https://en.wikipedia.org/wiki/Fleiss%27_kappa
testData :: [HashMap Int Integer]
testData = [HashMap.fromList (zip [1..5] xs) | xs <- xss]
  where
    xss =
      [ [0, 0, 0, 0, 14]
      , [0, 2, 6, 4, 2]
      , [0, 0, 3, 5, 6]
      , [0, 3, 9, 2, 0]
      , [2, 2, 8, 1, 1]
      , [7, 7, 0, 0, 0]
      , [3, 2, 6, 3, 0]
      , [2, 5, 3, 2, 2]
      , [6, 5, 2, 1, 0]
      , [0, 2, 2, 3, 7]
      ]