{-# LANGUAGE BangPatterns #-}
module Moo.GeneticAlgorithm.Statistics
( average
, variance
, quantiles
, median
, iqr
) where
import Data.List (sort, foldl')
average :: (Num a, Fractional a) => [a] -> a
average = uncurry (/) . foldl' (\(!s, !c) x -> (s+x, c+1)) (0, 0)
variance :: (Floating a) => [a] -> a
variance xs = let (n, _, q) = foldr go (0, 0, 0) xs
in q / fromIntegral n
where
go :: Floating a => a -> (Int, a, a) -> (Int, a, a)
go x (n, sa, qa)
| n == 0 = (1, x, 0)
| otherwise =
let na = fromIntegral n
delta = x - sa/na
sa' = sa + x
qa' = qa + delta*delta*na/(na+1)
in (n + 1, sa', qa')
quantiles :: (Real a, RealFrac a)
=> [a]
-> [a]
-> [a]
quantiles xs probs =
let xs' = sort xs
n = length xs'
in map (quantile7 n xs') probs
quantile7 :: (Real a, RealFrac a)
=> Int
-> [a]
-> a
-> a
quantile7 n xs prob =
let h = fromIntegral (n-1) * prob + 1
i = floor h
x1 = xs !! (i-1)
x2 = xs !! (i)
in case (i >= n, i < 1) of
(True, _) -> xs !! (i-1)
(_, True) -> xs !! 0
_ -> x1 + (h - fromIntegral i)*(x2 -x1)
median :: (Real a, RealFrac a) => [a] -> a
median xs = head $ quantiles xs [0.5]
iqr :: (Real a, RealFrac a) => [a] -> a
iqr xs =
let [q1,q2] = quantiles xs [0.25, 0.75]
in q2 - q1