Наивный Байесовский классификатор

(Перенос поста со старого сайта от 22 июня 2016 года)

Потребовалось тут для проверки одной идеи быстро сделать Байесовскую классификацию, а тащить ничего большого из hackage не хотелось. Если у кого-то будет схожая ситуация, ниже код:

module Bayes where
 
import Data.Map.Strict (Map(..), (!), elems)
 
newtype Classifier c s = Classifier { getClass :: Map c [s] }
 
count :: Eq a => a -> [a] -> Int
count y = foldl (\acc x -> if y == x then acc + 1 else acc) 0
 
classSize :: Ord c => Classifier c s -> c -> Int
classSize cl = length . (getClass cl !)
 
totalSize :: Classifier c s -> Int
totalSize = length . concat . elems . getClass
 
sampleCount :: Eq s => Classifier c s -> s -> Int
sampleCount cl s = count s . concat . elems . getClass $ cl
 
sampleCountInClass :: (Ord c, Eq s) => Classifier c s -> s -> c -> Int
sampleCountInClass cl s = count s . (getClass cl !)
 
-- P(C)
prior :: Ord c => Classifier c s -> c -> Double
prior cl c = if tot == 0 then 0 else tr / fromIntegral tot
  where tr = fromIntegral $ classSize cl c
        tot = totalSize cl
 
-- P(D|C)
likelihood :: (Ord c, Eq s) => Classifier c s -> s -> c -> Double
likelihood cl s c = if tr == 0 then 0 else ss / fromIntegral tr
  where ss = fromIntegral $ sampleCountInClass cl s c
        tr = classSize cl c
 
-- P (D)
evidance :: Eq s => Classifier c s -> s -> Double
evidance cl s = if tot == 0 then 0 else sam / fromIntegral tot
  where sam = fromIntegral $ sampleCount cl s
        tot = totalSize cl
 
-- P(C|D) = P(D|C) * P(C) / P(D)
posterior :: (Ord c, Eq s) => Classifier c s -> c -> s -> Double
posterior cl c s = l * p / e
  where p = prior cl c
        l = likelihood cl s c
        e = evidance cl s
 
-- ln $ P(C|D) / P(not-C|D)
logLike :: (Ord c, Eq s) => Classifier c s -> c -> s -> Double
logLike cl c s = log $ p / (1 - p)
  where p = posterior cl c s