multipass-0.1: examples/Pass.hs

{-# LANGUAGE GADTs, DeriveDataTypeable, StandaloneDeriving, ExtendedDefaultRules, GeneralizedNewtypeDeriving #-}

import Control.Applicative
import Control.Category
import Control.Newtype
import Control.Monad (liftM)
import Data.Binary
import Data.Foldable
import Data.Hashable
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Monoid
import Data.Typeable
import Data.Pass
import Data.Pass.Monoid.Ord
import Prelude hiding (id,(.))

-- example calculation type
data Test a b where
  Total    :: Num a => Test a (Sum a)
  Count    :: Test a (Sum Int)
  Square   :: Num a => Test a a
  Minus    :: Double -> Test Double Double
  Abs      :: Num a => Test a a
  Smallest :: Num a => Test a (Min a)
  Largest  :: Num a => Test a (Max a)
  deriving Typeable

deriving instance Typeable1 Sum -- :(
deriving instance Binary a => Binary (Sum a)

count :: (Step t, Num b) => t Test a b
count = step $ fromIntegral . getSum <$> trans Count

sumSq :: Step t => t Test Double Double
sumSq = step $ Square `prep` total

-- | @E[X^2] - E[X]^2@
var :: Step t => t Test Double Double
var = step $ sumSq / count - mean ^ 2

stddev :: Step t => t Test Double Double
stddev = step $ sqrt var

-- > absDev median -- median absolute deviation
-- > absDev mean   -- mean absolute deviation
absdev :: Pass Test Double Double -> Calc Test Double Double
absdev mu = mu :& \m -> Minus m `prep` Abs `prep` step mu

-- median absolute deviation
mad :: Calc Test Double Double
mad = absdev median

instance Named Test where
  showsFun _ Total     = showString "Total"
  showsFun _ Count     = showString "Count"
  showsFun _ Square    = showString "Square"
  showsFun d (Minus n) = showParen (d > 10) $ showString "Minus " . showsPrec 10 n
  showsFun _ Abs       = showString "Abs"
  showsFun _ Largest   = showString "Largest"
  showsFun _ Smallest  = showString "Smallest"

instance Call Test where
  call Total a = Sum a
  call Count _ = Sum 1
  call Square a = a * a
  call (Minus n) a = a - n
  call Abs a = abs a
  call Largest a = Max a
  call Smallest a = Min a

instance Accelerant Test where
  meanPass  = total / count
  totalPass = getSum <$> trans Total
  largestPass = getMax <$> trans Largest
  smallestPass = getMin <$> trans Smallest

infixl 0 @!

(@!) :: Calc Test a b -> [a] -> b
(@!) = (@@)