{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}

-- | Online statistics for ordered data (such as time-series data), modelled as [mealy machines](https://en.wikipedia.org/wiki/Mealy_machine)
module Data.Mealy
  ( -- * Types
    Mealy (..),
    pattern M,
    scan,
    fold,
    Averager (..),
    pattern A,
    av,
    av_,
    online,

    -- * Statistics
    -- $setup
    ma,
    absma,
    sqma,
    std,
    cov,
    corrGauss,
    corr,
    beta1,
    alpha1,
    reg1,
    beta,
    alpha,
    reg,
    asum,
    aconst,
    delay1,
    delay,
    depState,
    Model1 (..),
    zeroModel1,
    depModel1,

    -- * median
    Medianer (..),
    onlineL1,
    onlineL1',
    maL1,
    absmaL1,
  )
where

import Control.Lens hiding (Empty, Unwrapped, Wrapped, index, (:>), (|>))
import Data.Fold hiding (M)
import Data.Functor.Rep
import Data.Generics.Labels ()

-- import qualified Numeric.LinearAlgebra as LA

import qualified Data.Matrix as M
import qualified Data.Sequence as Seq
import qualified NumHask.Array.Fixed as F
import NumHask.Array.Shape (HasShape)
import NumHask.Prelude hiding (L1, State, StateT, asum, fold, get, replace, runState, runStateT, state)

-- $setup
-- Generate some random variates for the examples.
--
-- xs0, xs1 & xs2 are samples from N(0,1)
--
-- xsp is a pair of N(0,1)s with a correlation of 0.8
--
-- >>> :set -XDataKinds
-- >>> import Control.Category ((>>>))
-- >>> import Data.List
-- >>> import Data.Mealy.Simulate
-- >>> g <- create
-- >>> xs0 <- rvs g 10000
-- >>> xs1 <- rvs g 10000
-- >>> xs2 <- rvs g 10000
-- >>> xsp <- rvsp g 10000 0.8

-- | A 'Mealy' is a triple of functions
--
-- * (a -> b) __inject__ Convert an input into the state type.
-- * (b -> a -> b) __step__ Update state given prior state and (new) input.
-- * (c -> b) __extract__ Convert state to the output type.
--
-- By adopting this order, a Mealy sum looks like:
--
-- > M id (+) id
--
-- where the first id is the initial injection to a contravariant position, and the second id is the covriant extraction.
--
-- __inject__ kicks off state on the initial element of the Foldable, but is otherwise be independent of __step__.
--
-- > scan (M e s i) (x : xs) = e <$> scanl' s (i x) xs
newtype Mealy a b = Mealy {Mealy a b -> L1 a b
l1 :: L1 a b}
  deriving (q b c -> Mealy a b -> Mealy a c
Mealy b c -> q a b -> Mealy a c
(a -> b) -> (c -> d) -> Mealy b c -> Mealy a d
(a -> b) -> Mealy b c -> Mealy a c
(b -> c) -> Mealy a b -> Mealy a c
(forall a b c d. (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d)
-> (forall a b c. (a -> b) -> Mealy b c -> Mealy a c)
-> (forall b c a. (b -> c) -> Mealy a b -> Mealy a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible c b =>
    q b c -> Mealy a b -> Mealy a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible b a =>
    Mealy b c -> q a b -> Mealy a c)
-> Profunctor Mealy
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
forall b c a. (b -> c) -> Mealy a b -> Mealy a c
forall a b c d. (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d
forall a b c (q :: * -> * -> *).
Coercible b a =>
Mealy b c -> q a b -> Mealy a c
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Mealy a b -> Mealy a c
forall (p :: * -> * -> *).
(forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d)
-> (forall a b c. (a -> b) -> p b c -> p a c)
-> (forall b c a. (b -> c) -> p a b -> p a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible c b =>
    q b c -> p a b -> p a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible b a =>
    p b c -> q a b -> p a c)
-> Profunctor p
.# :: Mealy b c -> q a b -> Mealy a c
$c.# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
Mealy b c -> q a b -> Mealy a c
#. :: q b c -> Mealy a b -> Mealy a c
$c#. :: forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Mealy a b -> Mealy a c
rmap :: (b -> c) -> Mealy a b -> Mealy a c
$crmap :: forall b c a. (b -> c) -> Mealy a b -> Mealy a c
lmap :: (a -> b) -> Mealy b c -> Mealy a c
$clmap :: forall a b c. (a -> b) -> Mealy b c -> Mealy a c
dimap :: (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d
$cdimap :: forall a b c d. (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d
Profunctor, Mealy a a
Mealy b c -> Mealy a b -> Mealy a c
(forall a. Mealy a a)
-> (forall b c a. Mealy b c -> Mealy a b -> Mealy a c)
-> Category Mealy
forall a. Mealy a a
forall b c a. Mealy b c -> Mealy a b -> Mealy a c
forall k (cat :: k -> k -> *).
(forall (a :: k). cat a a)
-> (forall (b :: k) (c :: k) (a :: k).
    cat b c -> cat a b -> cat a c)
-> Category cat
. :: Mealy b c -> Mealy a b -> Mealy a c
$c. :: forall b c a. Mealy b c -> Mealy a b -> Mealy a c
id :: Mealy a a
$cid :: forall a. Mealy a a
Category) via L1
  deriving (a -> Mealy a b -> Mealy a a
(a -> b) -> Mealy a a -> Mealy a b
(forall a b. (a -> b) -> Mealy a a -> Mealy a b)
-> (forall a b. a -> Mealy a b -> Mealy a a) -> Functor (Mealy a)
forall a b. a -> Mealy a b -> Mealy a a
forall a b. (a -> b) -> Mealy a a -> Mealy a b
forall a a b. a -> Mealy a b -> Mealy a a
forall a a b. (a -> b) -> Mealy a a -> Mealy a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Mealy a b -> Mealy a a
$c<$ :: forall a a b. a -> Mealy a b -> Mealy a a
fmap :: (a -> b) -> Mealy a a -> Mealy a b
$cfmap :: forall a a b. (a -> b) -> Mealy a a -> Mealy a b
Functor, Functor (Mealy a)
a -> Mealy a a
Functor (Mealy a)
-> (forall a. a -> Mealy a a)
-> (forall a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b)
-> (forall a b c.
    (a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c)
-> (forall a b. Mealy a a -> Mealy a b -> Mealy a b)
-> (forall a b. Mealy a a -> Mealy a b -> Mealy a a)
-> Applicative (Mealy a)
Mealy a a -> Mealy a b -> Mealy a b
Mealy a a -> Mealy a b -> Mealy a a
Mealy a (a -> b) -> Mealy a a -> Mealy a b
(a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c
forall a. Functor (Mealy a)
forall a. a -> Mealy a a
forall a a. a -> Mealy a a
forall a b. Mealy a a -> Mealy a b -> Mealy a a
forall a b. Mealy a a -> Mealy a b -> Mealy a b
forall a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
forall a a b. Mealy a a -> Mealy a b -> Mealy a a
forall a a b. Mealy a a -> Mealy a b -> Mealy a b
forall a a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
forall a b c. (a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c
forall a a b c.
(a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Mealy a a -> Mealy a b -> Mealy a a
$c<* :: forall a a b. Mealy a a -> Mealy a b -> Mealy a a
*> :: Mealy a a -> Mealy a b -> Mealy a b
$c*> :: forall a a b. Mealy a a -> Mealy a b -> Mealy a b
liftA2 :: (a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c
$cliftA2 :: forall a a b c.
(a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c
<*> :: Mealy a (a -> b) -> Mealy a a -> Mealy a b
$c<*> :: forall a a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
pure :: a -> Mealy a a
$cpure :: forall a a. a -> Mealy a a
$cp1Applicative :: forall a. Functor (Mealy a)
Applicative) via L1 a

-- | Pattern for a 'Mealy'.
--
-- @M extract step inject@
pattern M :: (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
pattern $bM :: (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
$mM :: forall r a b.
Mealy a b
-> (forall c. (a -> c) -> (c -> a -> c) -> (c -> b) -> r)
-> (Void# -> r)
-> r
M i s e = Mealy (L1 e s i)

{-# COMPLETE M #-}

-- | Fold a list through a 'Mealy'.
--
-- > cosieve == fold
fold :: Mealy a b -> [a] -> b
fold :: Mealy a b -> [a] -> b
fold Mealy a b
_ [] = Text -> b
forall a. HasCallStack => Text -> a
panic Text
"on the streets of Birmingham."
fold (M a -> c
i c -> a -> c
s c -> b
e) (a
x : [a]
xs) = c -> b
e (c -> b) -> c -> b
forall a b. (a -> b) -> a -> b
$ (c -> a -> c) -> c -> [a] -> c
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' c -> a -> c
s (a -> c
i a
x) [a]
xs

-- | Run a list through a 'Mealy' and return a list of values for every step
--
-- > length (scan _ xs) == length xs
scan :: Mealy a b -> [a] -> [b]
scan :: Mealy a b -> [a] -> [b]
scan Mealy a b
_ [] = []
scan (M a -> c
i c -> a -> c
s c -> b
e) (a
x : [a]
xs) = [Item [b]] -> [b]
forall l. IsList l => [Item l] -> l
fromList (c -> b
e (c -> b) -> [c] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> a -> c) -> c -> [a] -> [c]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' c -> a -> c
s (a -> c
i a
x) [a]
xs)

-- | Most common statistics are averages, which are some sort of aggregation of values (sum) and some sort of sample size (count).
newtype Averager a b = Averager
  { Averager a b -> (a, b)
sumCount :: (a, b)
  }
  deriving (Averager a b -> Averager a b -> Bool
(Averager a b -> Averager a b -> Bool)
-> (Averager a b -> Averager a b -> Bool) -> Eq (Averager a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Averager a b -> Averager a b -> Bool
/= :: Averager a b -> Averager a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Averager a b -> Averager a b -> Bool
== :: Averager a b -> Averager a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Averager a b -> Averager a b -> Bool
Eq, Int -> Averager a b -> ShowS
[Averager a b] -> ShowS
Averager a b -> String
(Int -> Averager a b -> ShowS)
-> (Averager a b -> String)
-> ([Averager a b] -> ShowS)
-> Show (Averager a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Averager a b -> ShowS
forall a b. (Show a, Show b) => [Averager a b] -> ShowS
forall a b. (Show a, Show b) => Averager a b -> String
showList :: [Averager a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Averager a b] -> ShowS
show :: Averager a b -> String
$cshow :: forall a b. (Show a, Show b) => Averager a b -> String
showsPrec :: Int -> Averager a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Averager a b -> ShowS
Show)

-- | Pattern for an 'Averager'.
--
-- @A sum count@
pattern A :: a -> b -> Averager a b
pattern $bA :: a -> b -> Averager a b
$mA :: forall r a b. Averager a b -> (a -> b -> r) -> (Void# -> r) -> r
A s c = Averager (s, c)

{-# COMPLETE A #-}

instance (Additive a, Additive b) => Semigroup (Averager a b) where
  <> :: Averager a b -> Averager a b -> Averager a b
(<>) (A a
s b
c) (A a
s' b
c') = a -> b -> Averager a b
forall a b. a -> b -> Averager a b
A (a
s a -> a -> a
forall a. Additive a => a -> a -> a
+ a
s') (b
c b -> b -> b
forall a. Additive a => a -> a -> a
+ b
c')

-- |
-- > av mempty == nan
instance (Additive a, Additive b) => Monoid (Averager a b) where
  mempty :: Averager a b
mempty = a -> b -> Averager a b
forall a b. a -> b -> Averager a b
A a
forall a. Additive a => a
zero b
forall a. Additive a => a
zero
  mappend :: Averager a b -> Averager a b -> Averager a b
mappend = Averager a b -> Averager a b -> Averager a b
forall a. Semigroup a => a -> a -> a
(<>)

-- | extract the average from an 'Averager'
--
-- av gives NaN on zero divide
av :: (Divisive a) => Averager a a -> a
av :: Averager a a -> a
av (A a
s a
c) = a
s a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
c

-- | substitute a default value on zero-divide
--
-- > av_ (Averager (0,0)) x == x
av_ :: (Eq a, Additive a, Divisive a) => Averager a a -> a -> a
av_ :: Averager a a -> a -> a
av_ (A a
s a
c) a
def = a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
def (a
s a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
c) (a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Additive a => a
zero)

-- | @online f g@ is a 'Mealy' where f is a transformation of the data and g is a decay function (convergent tozero) applied at each step.
--
-- > online id id == av
online :: (Divisive b, Additive b) => (a -> b) -> (b -> b) -> Mealy a b
online :: (a -> b) -> (b -> b) -> Mealy a b
online a -> b
f b -> b
g = (a -> Averager b b)
-> (Averager b b -> a -> Averager b b)
-> (Averager b b -> b)
-> Mealy a b
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> Averager b b
intract Averager b b -> a -> Averager b b
step Averager b b -> b
forall a. Divisive a => Averager a a -> a
av
  where
    intract :: a -> Averager b b
intract a
a = b -> b -> Averager b b
forall a b. a -> b -> Averager a b
A (a -> b
f a
a) b
forall a. Multiplicative a => a
one
    step :: Averager b b -> a -> Averager b b
step (A b
s b
c) a
a =
      let (A b
s' b
c') = a -> Averager b b
intract a
a
       in b -> b -> Averager b b
forall a b. a -> b -> Averager a b
A (b -> b
g b
s b -> b -> b
forall a. Additive a => a -> a -> a
+ b
s') (b -> b
g b
c b -> b -> b
forall a. Additive a => a -> a -> a
+ b
c')

-- | A moving average using a decay rate of r. r=1 represents the simple average, and r=0 represents the latest value.
--
-- >>> fold (ma 0) (fromList [1..100])
-- 100.0
--
-- >>> fold (ma 1) (fromList [1..100])
-- 50.5
--
-- >>> fold (ma 0.99) xs0
-- -4.292501077490672e-2
--
-- A change in the underlying mean at n=10000 in the chart below highlights the trade-off between stability of the statistic and response to non-stationarity.
--
-- ![ma chart](other/ex-ma.svg)
ma :: (Divisive a, Additive a) => a -> Mealy a a
ma :: a -> Mealy a a
ma a
r = (a -> a) -> (a -> a) -> Mealy a a
forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Mealy a b
online a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE ma #-}

-- | absolute average
--
-- >>> fold (absma 1) xs0
-- 0.7894201075535578
absma :: (Divisive a, Signed a) => a -> Mealy a a
absma :: a -> Mealy a a
absma a
r = (a -> a) -> (a -> a) -> Mealy a a
forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Mealy a b
online a -> a
forall a. Signed a => a -> a
abs (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE absma #-}

-- | average square
--
-- > fold (ma r) . fmap (**2) == fold (sqma r)
sqma :: (Divisive a, Additive a) => a -> Mealy a a
sqma :: a -> Mealy a a
sqma a
r = (a -> a) -> (a -> a) -> Mealy a a
forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Mealy a b
online (\a
x -> a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x) (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE sqma #-}

-- | standard deviation
--
-- The construction of standard deviation, using the Applicative instance of a 'Mealy':
--
-- > (\s ss -> sqrt (ss - s ** (one+one))) <$> ma r <*> sqma r
--
-- The average deviation of the numbers 1..1000 is about 1 / sqrt 12 * 1000
-- <https://en.wikipedia.org/wiki/Uniform_distribution_(continuous)#Standard_uniform>
--
-- >>> fold (std 1) [0..1000]
-- 288.9636655359978
--
-- The average deviation with a decay of 0.99
--
-- >>> fold (std 0.99) [0..1000]
-- 99.28328803163829
--
-- >>> fold (std 1) xs0
-- 0.9923523681261158
--
-- ![std chart](other/ex-std.svg)
std :: (Divisive a, ExpField a) => a -> Mealy a a
std :: a -> Mealy a a
std a
r = (\a
s a
ss -> a -> a
forall a. ExpField a => a -> a
sqrt (a
ss a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
s a -> a -> a
forall a. ExpField a => a -> a -> a
** (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
forall a. Multiplicative a => a
one))) (a -> a -> a) -> Mealy a a -> Mealy a (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Mealy a a
forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r Mealy a (a -> a) -> Mealy a a -> Mealy a a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Mealy a a
forall a. (Divisive a, Additive a) => a -> Mealy a a
sqma a
r
{-# INLINEABLE std #-}

-- | The covariance of a tuple given an underlying central tendency fold.
--
-- >>> fold (cov (ma 1)) xsp
-- 0.8011368250045314
cov :: (Field a) => Mealy a a -> Mealy (a, a) a
cov :: Mealy a a -> Mealy (a, a) a
cov Mealy a a
m =
  (\a
xy a
x' a
y' -> a
xy a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
x' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y') (a -> a -> a -> a) -> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*)) Mealy a a
m Mealy (a, a) (a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> a
fst Mealy a a
m Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> b
snd Mealy a a
m
{-# INLINEABLE cov #-}

-- | correlation of a tuple, specialised to Guassian
--
-- >>> fold (corrGauss 1) xsp
-- 0.8020637696465039
corrGauss :: (ExpField a) => a -> Mealy (a, a) a
corrGauss :: a -> Mealy (a, a) a
corrGauss a
r =
  (\a
cov' a
stdx a
stdy -> a
cov' a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
stdx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
stdy)) (a -> a -> a -> a) -> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mealy a a -> Mealy (a, a) a
forall a. Field a => Mealy a a -> Mealy (a, a) a
cov (a -> Mealy a a
forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r)
    Mealy (a, a) (a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> a
fst (a -> Mealy a a
forall a. (Divisive a, ExpField a) => a -> Mealy a a
std a
r)
    Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> b
snd (a -> Mealy a a
forall a. (Divisive a, ExpField a) => a -> Mealy a a
std a
r)
{-# INLINEABLE corrGauss #-}

-- | a generalised version of correlation of a tuple
--
-- >>> fold (corr (ma 1) (std 1)) xsp
-- 0.8020637696465039
--
-- > corr (ma r) (std r) == corrGauss r
corr :: (ExpField a) => Mealy a a -> Mealy a a -> Mealy (a, a) a
corr :: Mealy a a -> Mealy a a -> Mealy (a, a) a
corr Mealy a a
central Mealy a a
deviation =
  (\a
cov' a
stdx a
stdy -> a
cov' a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
stdx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
stdy)) (a -> a -> a -> a) -> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mealy a a -> Mealy (a, a) a
forall a. Field a => Mealy a a -> Mealy (a, a) a
cov Mealy a a
central
    Mealy (a, a) (a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> a
fst Mealy a a
deviation
    Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> b
snd Mealy a a
deviation
{-# INLINEABLE corr #-}

-- | The beta in a simple linear regression of an (independent variable, single dependent variable) tuple given an underlying central tendency fold.
--
-- This is a generalisation of the classical regression formula, where averages are replaced by 'Mealy' statistics.
--
-- \[
-- \begin{align}
-- \beta & = \frac{n\sum xy - \sum x \sum y}{n\sum x^2 - (\sum x)^2} \\
--     & = \frac{n^2 \overline{xy} - n^2 \bar{x} \bar{y}}{n^2 \overline{x^2} - n^2 \bar{x}^2} \\
--     & = \frac{\overline{xy} - \bar{x} \bar{y}}{\overline{x^2} - \bar{x}^2} \\
-- \end{align}
-- \]
--
-- >>> fold (beta1 (ma 1)) $ zipWith (\x y -> (y, x + y)) xs0 xs1
-- 0.9953875263096014
beta1 :: (ExpField a) => Mealy a a -> Mealy (a, a) a
beta1 :: Mealy a a -> Mealy (a, a) a
beta1 Mealy a a
m =
  (\a
xy a
x' a
y' a
x2 -> (a
xy a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
x' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y') a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
x2 a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
x' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x')) (a -> a -> a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*)) Mealy a a
m
    Mealy (a, a) (a -> a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> a
fst Mealy a a
m
    Mealy (a, a) (a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> b
snd Mealy a a
m
    Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (\(a
x, a
_) -> a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x) Mealy a a
m
{-# INLINEABLE beta1 #-}

-- | The alpha in a simple linear regression of an (independent variable, single dependent variable) tuple given an underlying central tendency fold.
--
-- \[
-- \begin{align}
-- \alpha & = \frac{\sum y \sum x^2 - \sum x \sum xy}{n\sum x^2 - (\sum x)^2} \\
--     & = \frac{n^2 \bar{y} \overline{x^2} - n^2 \bar{x} \overline{xy}}{n^2 \overline{x^2} - n^2 \bar{x}^2} \\
--     & = \frac{\bar{y} \overline{x^2} - \bar{x} \overline{xy}}{\overline{x^2} - \bar{x}^2} \\
-- \end{align}
-- \]
--
-- >>> fold (alpha1 (ma 1)) $ zipWith (\x y -> ((3+y), x + 0.5 * (3 + y))) xs0 xs1
-- 1.1880996822796197e-2
alpha1 :: (ExpField a) => Mealy a a -> Mealy (a, a) a
alpha1 :: Mealy a a -> Mealy (a, a) a
alpha1 Mealy a a
m = (\a
x a
b a
y -> a
y a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
b a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x) (a -> a -> a -> a) -> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> a
fst Mealy a a
m Mealy (a, a) (a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mealy a a -> Mealy (a, a) a
forall a. ExpField a => Mealy a a -> Mealy (a, a) a
beta1 Mealy a a
m Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> b
snd Mealy a a
m
{-# INLINEABLE alpha1 #-}

-- | The (alpha, beta) tuple in a simple linear regression of an (independent variable, single dependent variable) tuple given an underlying central tendency fold.
--
-- >>> fold (reg1 (ma 1)) $ zipWith (\x y -> ((3+y), x + 0.5 * (3 + y))) xs0 xs1
-- (1.1880996822796197e-2,0.49538752630956845)
reg1 :: (ExpField a) => Mealy a a -> Mealy (a, a) (a, a)
reg1 :: Mealy a a -> Mealy (a, a) (a, a)
reg1 Mealy a a
m = (,) (a -> a -> (a, a)) -> Mealy (a, a) a -> Mealy (a, a) (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mealy a a -> Mealy (a, a) a
forall a. ExpField a => Mealy a a -> Mealy (a, a) a
alpha1 Mealy a a
m Mealy (a, a) (a -> (a, a)) -> Mealy (a, a) a -> Mealy (a, a) (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mealy a a -> Mealy (a, a) a
forall a. ExpField a => Mealy a a -> Mealy (a, a) a
beta1 Mealy a a
m

data RegressionState (n :: Nat) a = RegressionState
  { RegressionState n a -> Array '[n, n] a
_xx :: F.Array '[n, n] a,
    RegressionState n a -> Array '[n] a
_x :: F.Array '[n] a,
    RegressionState n a -> Array '[n] a
_xy :: F.Array '[n] a,
    RegressionState n a -> a
_y :: a
  }
  deriving (a -> RegressionState n b -> RegressionState n a
(a -> b) -> RegressionState n a -> RegressionState n b
(forall a b.
 (a -> b) -> RegressionState n a -> RegressionState n b)
-> (forall a b. a -> RegressionState n b -> RegressionState n a)
-> Functor (RegressionState n)
forall a b. a -> RegressionState n b -> RegressionState n a
forall a b. (a -> b) -> RegressionState n a -> RegressionState n b
forall (n :: Nat) a b.
a -> RegressionState n b -> RegressionState n a
forall (n :: Nat) a b.
(a -> b) -> RegressionState n a -> RegressionState n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RegressionState n b -> RegressionState n a
$c<$ :: forall (n :: Nat) a b.
a -> RegressionState n b -> RegressionState n a
fmap :: (a -> b) -> RegressionState n a -> RegressionState n b
$cfmap :: forall (n :: Nat) a b.
(a -> b) -> RegressionState n a -> RegressionState n b
Functor)

-- | multiple regression
--
-- \[
-- \begin{align}
-- {\hat  {{\mathbf  {B}}}}=({\mathbf  {X}}^{{{\rm {T}}}}{\mathbf  {X}})^{{ -1}}{\mathbf  {X}}^{{{\rm {T}}}}{\mathbf  {Y}}
-- \end{align}
-- \]
--
-- \[
-- \begin{align}
-- {\mathbf  {X}}={\begin{bmatrix}{\mathbf  {x}}_{1}^{{{\rm {T}}}}\\{\mathbf  {x}}_{2}^{{{\rm {T}}}}\\\vdots \\{\mathbf  {x}}_{n}^{{{\rm {T}}}}\end{bmatrix}}={\begin{bmatrix}x_{{1,1}}&\cdots &x_{{1,k}}\\x_{{2,1}}&\cdots &x_{{2,k}}\\\vdots &\ddots &\vdots \\x_{{n,1}}&\cdots &x_{{n,k}}\end{bmatrix}}
-- \end{align}
-- \]
--
-- > let ys = zipWith3 (\x y z -> 0.1 * x + 0.5 * y + 1 * z) xs0 xs1 xs2
-- > let zs = zip (zipWith (\x y -> fromList [x,y] :: F.Array '[2] Double) xs1 xs2) ys
-- > fold (beta 0.99) zs
-- [0.4982692361226971, 1.038192474255091]
beta :: (Field a, KnownNat n, Fractional a, Eq a) => a -> Mealy (F.Array '[n] a, a) (F.Array '[n] a)
beta :: a -> Mealy (Array '[n] a, a) (Array '[n] a)
beta a
r = ((Array '[n] a, a) -> Averager (RegressionState n a) a)
-> (Averager (RegressionState n a) a
    -> (Array '[n] a, a) -> Averager (RegressionState n a) a)
-> (Averager (RegressionState n a) a -> Array '[n] a)
-> Mealy (Array '[n] a, a) (Array '[n] a)
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M (Array '[n] a, a) -> Averager (RegressionState n a) a
forall (n :: Nat) a b.
(KnownNat n, Multiplicative a, Multiplicative b) =>
(Array '[n] a, a) -> Averager (RegressionState n a) b
inject Averager (RegressionState n a) a
-> (Array '[n] a, a) -> Averager (RegressionState n a) a
step Averager (RegressionState n a) a -> Array '[n] a
forall (n :: Nat) a.
(KnownNat n, Fractional a, Eq a, Divisive a, Subtractive a) =>
Averager (RegressionState n a) a -> Array '[n] a
extract
  where
    -- extract :: Averager (RegressionState n a) a -> (F.Array '[n] a)
    extract :: Averager (RegressionState n a) a -> Array '[n] a
extract (A (RegressionState Array '[n, n] a
xx Array '[n] a
x Array '[n] a
xy a
y) a
c) =
      (\Array '[n, n] a
a Array '[n] a
b -> Array '[n, n] a -> Array '[n, n] a
forall (n :: Nat) a.
(KnownNat n, Fractional a, Eq a) =>
Array '[n, n] a -> Array '[n, n] a
inverse Array '[n, n] a
a Array '[n, n] a -> Array '[n] a -> Array '[n] a
forall a (sa :: [Nat]) (sb :: [Nat]) (s' :: [Nat]) (ss :: [Nat])
       (se :: [Nat]).
(Additive a, Multiplicative a, HasShape sa, HasShape sb,
 HasShape (sa ++ sb),
 se ~ TakeIndexes (sa ++ sb) '[Rank sa - 1, Rank sa], HasShape se,
 KnownNat (Minimum se), KnownNat (Rank sa - 1), KnownNat (Rank sa),
 ss ~ '[Minimum se], HasShape ss,
 s' ~ DropIndexes (sa ++ sb) '[Rank sa - 1, Rank sa],
 HasShape s') =>
Array sa a -> Array sb a -> Array s' a
`F.mult` Array '[n] a
b)
        ((a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
c) a -> Array '[n, n] a -> Array '[n, n] a
forall m a. MultiplicativeAction m a => a -> m -> m
.* (Array '[n, n] a
xx Array '[n, n] a -> Array '[n, n] a -> Array '[n, n] a
forall a. Subtractive a => a -> a -> a
- (a -> a -> a)
-> Array '[n] a -> Array '[n] a -> Array ('[n] ++ '[n]) a
forall (s :: [Nat]) (s' :: [Nat]) a b c.
(HasShape s, HasShape s', HasShape (s ++ s')) =>
(a -> b -> c) -> Array s a -> Array s' b -> Array (s ++ s') c
F.expand a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*) Array '[n] a
x Array '[n] a
x))
        ((Array '[n] a
xy Array '[n] a -> Array '[n] a -> Array '[n] a
forall a. Subtractive a => a -> a -> a
- (a
y a -> Array '[n] a -> Array '[n] a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Array '[n] a
x)) Array '[n] a -> a -> Array '[n] a
forall m a. MultiplicativeAction m a => m -> a -> m
*. (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
c))
    step :: Averager (RegressionState n a) a
-> (Array '[n] a, a) -> Averager (RegressionState n a) a
step Averager (RegressionState n a) a
x (Array '[n] a
xs, a
y) = a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
forall a (n :: Nat).
(Field a, KnownNat n) =>
a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
rsOnline a
r Averager (RegressionState n a) a
x ((Array '[n] a, a) -> Averager (RegressionState n a) a
forall (n :: Nat) a b.
(KnownNat n, Multiplicative a, Multiplicative b) =>
(Array '[n] a, a) -> Averager (RegressionState n a) b
inject (Array '[n] a
xs, a
y))
    -- inject :: (F.Array '[n] a, a) -> Averager (RegressionState n a) a
    inject :: (Array '[n] a, a) -> Averager (RegressionState n a) b
inject (Array '[n] a
xs, a
y) =
      RegressionState n a -> b -> Averager (RegressionState n a) b
forall a b. a -> b -> Averager a b
A (Array '[n, n] a
-> Array '[n] a -> Array '[n] a -> a -> RegressionState n a
forall (n :: Nat) a.
Array '[n, n] a
-> Array '[n] a -> Array '[n] a -> a -> RegressionState n a
RegressionState ((a -> a -> a)
-> Array '[n] a -> Array '[n] a -> Array ('[n] ++ '[n]) a
forall (s :: [Nat]) (s' :: [Nat]) a b c.
(HasShape s, HasShape s', HasShape (s ++ s')) =>
(a -> b -> c) -> Array s a -> Array s' b -> Array (s ++ s') c
F.expand a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*) Array '[n] a
xs Array '[n] a
xs) Array '[n] a
xs (a
y a -> Array '[n] a -> Array '[n] a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Array '[n] a
xs) a
y) b
forall a. Multiplicative a => a
one
{-# INLINEABLE beta #-}

toMatrix :: (KnownNat n, KnownNat m) => F.Array [m, n] a -> M.Matrix a
toMatrix :: Array '[m, n] a -> Matrix a
toMatrix Array '[m, n] a
a = Int -> Int -> ((Int, Int) -> a) -> Matrix a
forall a. Int -> Int -> ((Int, Int) -> a) -> Matrix a
M.matrix Int
m Int
n (Array '[m, n] a -> Rep (Array '[m, n]) -> a
forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index Array '[m, n] a
a ([Int] -> a) -> ((Int, Int) -> [Int]) -> (Int, Int) -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\(Int
i, Int
j) -> [Int
i, Int
j]))
  where
    (Int
m : Int
n : [Int]
_) = Array '[m, n] a -> [Int]
forall a (s :: [Nat]). HasShape s => Array s a -> [Int]
F.shape Array '[m, n] a
a

fromMatrix :: (KnownNat n, KnownNat m) => M.Matrix a -> F.Array [m, n] a
fromMatrix :: Matrix a -> Array '[m, n] a
fromMatrix = [a] -> Array '[m, n] a
forall l. IsList l => [Item l] -> l
fromList ([a] -> Array '[m, n] a)
-> (Matrix a -> [a]) -> Matrix a -> Array '[m, n] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Matrix a -> [a]
forall a. Matrix a -> [a]
M.toList

data MatrixException = MatrixException
  deriving (Int -> MatrixException -> ShowS
[MatrixException] -> ShowS
MatrixException -> String
(Int -> MatrixException -> ShowS)
-> (MatrixException -> String)
-> ([MatrixException] -> ShowS)
-> Show MatrixException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatrixException] -> ShowS
$cshowList :: [MatrixException] -> ShowS
show :: MatrixException -> String
$cshow :: MatrixException -> String
showsPrec :: Int -> MatrixException -> ShowS
$cshowsPrec :: Int -> MatrixException -> ShowS
Show)

instance Exception MatrixException

-- | The inverse of a square matrix.
inverse :: (KnownNat n, Fractional a, Eq a) => F.Array [n, n] a -> F.Array [n, n] a
inverse :: Array '[n, n] a -> Array '[n, n] a
inverse = (String -> Array '[n, n] a)
-> (Matrix a -> Array '[n, n] a)
-> Either String (Matrix a)
-> Array '[n, n] a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Array '[n, n] a -> String -> Array '[n, n] a
forall a b. a -> b -> a
const (Array '[n, n] a -> String -> Array '[n, n] a)
-> Array '[n, n] a -> String -> Array '[n, n] a
forall a b. (a -> b) -> a -> b
$ MatrixException -> Array '[n, n] a
forall a e. Exception e => e -> a
throw MatrixException
MatrixException) Matrix a -> Array '[n, n] a
forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
Matrix a -> Array '[m, n] a
fromMatrix (Either String (Matrix a) -> Array '[n, n] a)
-> (Array '[n, n] a -> Either String (Matrix a))
-> Array '[n, n] a
-> Array '[n, n] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Matrix a -> Either String (Matrix a)
forall a.
(Fractional a, Eq a) =>
Matrix a -> Either String (Matrix a)
M.inverse (Matrix a -> Either String (Matrix a))
-> (Array '[n, n] a -> Matrix a)
-> Array '[n, n] a
-> Either String (Matrix a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Array '[n, n] a -> Matrix a
forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
Array '[m, n] a -> Matrix a
toMatrix

rsOnline :: (Field a, KnownNat n) => a -> Averager (RegressionState n a) a -> Averager (RegressionState n a) a -> Averager (RegressionState n a) a
rsOnline :: a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
rsOnline a
r (A (RegressionState Array '[n, n] a
xx Array '[n] a
x Array '[n] a
xy a
y) a
c) (A (RegressionState Array '[n, n] a
xx' Array '[n] a
x' Array '[n] a
xy' a
y') a
c') =
  RegressionState n a -> a -> Averager (RegressionState n a) a
forall a b. a -> b -> Averager a b
A (Array '[n, n] a
-> Array '[n] a -> Array '[n] a -> a -> RegressionState n a
forall (n :: Nat) a.
Array '[n, n] a
-> Array '[n] a -> Array '[n] a -> a -> RegressionState n a
RegressionState ((a -> a -> a)
-> Array '[n, n] a -> Array '[n, n] a -> Array '[n, n] a
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 a -> a -> a
d Array '[n, n] a
xx Array '[n, n] a
xx') ((a -> a -> a) -> Array '[n] a -> Array '[n] a -> Array '[n] a
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 a -> a -> a
d Array '[n] a
x Array '[n] a
x') ((a -> a -> a) -> Array '[n] a -> Array '[n] a -> Array '[n] a
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 a -> a -> a
d Array '[n] a
xy Array '[n] a
xy') (a -> a -> a
d a
y a
y')) (a -> a -> a
d a
c a
c')
  where
    d :: a -> a -> a
d a
s a
s' = a
r a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
s a -> a -> a
forall a. Additive a => a -> a -> a
+ a
s'

-- | alpha in a multiple regression
alpha :: (ExpField a, KnownNat n, Fractional a, Eq a) => a -> Mealy (F.Array '[n] a, a) a
alpha :: a -> Mealy (Array '[n] a, a) a
alpha a
r = (\Array '[n] a
xs Array '[n] a
b a
y -> a
y a -> a -> a
forall a. Subtractive a => a -> a -> a
- Array '[n] a -> a
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum ((a -> a -> a) -> Array '[n] a -> Array '[n] a -> Array '[n] a
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*) Array '[n] a
b Array '[n] a
xs)) (Array '[n] a -> Array '[n] a -> a -> a)
-> Mealy (Array '[n] a, a) (Array '[n] a)
-> Mealy (Array '[n] a, a) (Array '[n] a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Array '[n] a, a) -> Array '[n] a)
-> Mealy (Array '[n] a) (Array '[n] a)
-> Mealy (Array '[n] a, a) (Array '[n] a)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Array '[n] a, a) -> Array '[n] a
forall a b. (a, b) -> a
fst (Mealy a a -> Mealy (Array '[n] a) (Array '[n] a)
forall (s :: [Nat]) a b.
HasShape s =>
Mealy a b -> Mealy (Array s a) (Array s b)
arrayify (Mealy a a -> Mealy (Array '[n] a) (Array '[n] a))
-> Mealy a a -> Mealy (Array '[n] a) (Array '[n] a)
forall a b. (a -> b) -> a -> b
$ a -> Mealy a a
forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r) Mealy (Array '[n] a, a) (Array '[n] a -> a -> a)
-> Mealy (Array '[n] a, a) (Array '[n] a)
-> Mealy (Array '[n] a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Mealy (Array '[n] a, a) (Array '[n] a)
forall a (n :: Nat).
(Field a, KnownNat n, Fractional a, Eq a) =>
a -> Mealy (Array '[n] a, a) (Array '[n] a)
beta a
r Mealy (Array '[n] a, a) (a -> a)
-> Mealy (Array '[n] a, a) a -> Mealy (Array '[n] a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Array '[n] a, a) -> a) -> Mealy a a -> Mealy (Array '[n] a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Array '[n] a, a) -> a
forall a b. (a, b) -> b
snd (a -> Mealy a a
forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r)
{-# INLINEABLE alpha #-}

arrayify :: (HasShape s) => Mealy a b -> Mealy (F.Array s a) (F.Array s b)
arrayify :: Mealy a b -> Mealy (Array s a) (Array s b)
arrayify (M a -> c
sExtract c -> a -> c
sStep c -> b
sInject) = (Array s a -> Array s c)
-> (Array s c -> Array s a -> Array s c)
-> (Array s c -> Array s b)
-> Mealy (Array s a) (Array s b)
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M Array s a -> Array s c
extract Array s c -> Array s a -> Array s c
step Array s c -> Array s b
inject
  where
    extract :: Array s a -> Array s c
extract = (a -> c) -> Array s a -> Array s c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> c
sExtract
    step :: Array s c -> Array s a -> Array s c
step = (c -> a -> c) -> Array s c -> Array s a -> Array s c
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 c -> a -> c
sStep
    inject :: Array s c -> Array s b
inject = (c -> b) -> Array s c -> Array s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> b
sInject

-- | multiple regression
--
-- > let ys = zipWith3 (\x y z -> 0.1 * x + 0.5 * y + 1 * z) xs0 xs1 xs2
-- > let zs = zip (zipWith (\x y -> fromList [x,y] :: F.Array '[2] Double) xs1 xs2) ys
-- > fold (reg 0.99) zs
-- ([0.4982692361226971, 1.038192474255091],2.087160803386695e-3)
reg :: (ExpField a, KnownNat n, Fractional a, Eq a) => a -> Mealy (F.Array '[n] a, a) (F.Array '[n] a, a)
reg :: a -> Mealy (Array '[n] a, a) (Array '[n] a, a)
reg a
r = (,) (Array '[n] a -> a -> (Array '[n] a, a))
-> Mealy (Array '[n] a, a) (Array '[n] a)
-> Mealy (Array '[n] a, a) (a -> (Array '[n] a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Mealy (Array '[n] a, a) (Array '[n] a)
forall a (n :: Nat).
(Field a, KnownNat n, Fractional a, Eq a) =>
a -> Mealy (Array '[n] a, a) (Array '[n] a)
beta a
r Mealy (Array '[n] a, a) (a -> (Array '[n] a, a))
-> Mealy (Array '[n] a, a) a
-> Mealy (Array '[n] a, a) (Array '[n] a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Mealy (Array '[n] a, a) a
forall a (n :: Nat).
(ExpField a, KnownNat n, Fractional a, Eq a) =>
a -> Mealy (Array '[n] a, a) a
alpha a
r
{-# INLINEABLE reg #-}

-- | accumulated sum
asum :: (Additive a) => Mealy a a
asum :: Mealy a a
asum = (a -> a) -> (a -> a -> a) -> (a -> a) -> Mealy a a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id a -> a -> a
forall a. Additive a => a -> a -> a
(+) a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | constant Mealy
aconst :: b -> Mealy a b
aconst :: b -> Mealy a b
aconst b
b = (a -> ()) -> (() -> a -> ()) -> (() -> b) -> Mealy a b
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M (() -> a -> ()
forall a b. a -> b -> a
const ()) (\()
_ a
_ -> ()) (b -> () -> b
forall a b. a -> b -> a
const b
b)

-- | delay input values by 1
delay1 :: a -> Mealy a a
delay1 :: a -> Mealy a a
delay1 a
x0 = (a -> (a, a))
-> ((a, a) -> a -> (a, a)) -> ((a, a) -> a) -> Mealy a a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M (a
x0,) (\(a
_, a
x) a
a -> (a
x, a
a)) (a, a) -> a
forall a b. (a, b) -> a
fst

-- | delays values by n steps
--
-- delay [0] == delay1 0
--
-- delay [] == id
--
-- delay [1,2] = delay1 2 . delay1 1
--
-- >>> scan (delay [-2,-1]) [0..3]
-- [-2,-1,0,1]
--
-- Autocorrelation example:
--
-- > scan (((,) <$> id <*> delay [0]) >>> beta (ma 0.99)) xs0
delay ::
  -- | initial statistical values, delay equals length
  [a] ->
  Mealy a a
delay :: [a] -> Mealy a a
delay [a]
x0 = (a -> Seq a) -> (Seq a -> a -> Seq a) -> (Seq a -> a) -> Mealy a a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> Seq a
inject Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
step Seq a -> a
forall a. Seq a -> a
extract
  where
    inject :: a -> Seq a
inject a
a = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a]
x0 Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
a
    extract :: Seq a -> a
    extract :: Seq a -> a
extract Seq a
Seq.Empty = Text -> a
forall a. HasCallStack => Text -> a
panic Text
"ACAB"
    extract (a
x Seq.:<| Seq a
_) = a
x
    step :: Seq a -> a -> Seq a
    step :: Seq a -> a -> Seq a
step Seq a
Seq.Empty a
_ = Text -> Seq a
forall a. HasCallStack => Text -> a
panic Text
"ACAB"
    step (a
_ Seq.:<| Seq a
xs) a
a = Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
a

-- | Add a state dependency to a series.
--
-- Typical regression analytics tend to assume that moments of a distributional assumption are unconditional with respect to prior instantiations of the stochastics being studied.
--
-- For time series analytics, a major preoccupation is estimation of the current moments given what has happened in the past.
--
-- IID:
--
-- \[
-- \begin{align}
-- x_{t+1} & = alpha_t^x + s_{t+1}\\
-- s_{t+1} & = alpha_t^s * N(0,1)
-- \end{align}
-- \]
--
-- Example: including a linear dependency on moving average history:
--
-- \[
-- \begin{align}
-- x_{t+1} & = (alpha_t^x + beta_t^{x->x} * ma_t^x) + s_{t+1}\\
-- s_{t+1} & = alpha_t^s * N(0,1)
-- \end{align}
-- \]
--
-- >>> let xs' = scan (depState (\a m -> a + 0.1 * m) (ma 0.99)) xs0
-- >>> let ma' = scan ((ma (1 - 0.01)) >>> delay [0]) xs'
-- >>> let xsb = fold (beta1 (ma (1 - 0.001))) $ drop 1 $ zip ma' xs'
-- >>> -- beta measurement if beta of ma was, in reality, zero.
-- >>> let xsb0 = fold (beta1 (ma (1 - 0.001))) $ drop 1 $ zip ma' xs0
-- >>> xsb - xsb0
-- 9.999999999999976e-2
--
-- This simple model of relationship between a series and it's historical average shows how fragile the evidence can be.
--
-- ![madep](other/ex-madep.svg)
--
-- In unravelling the drivers of this result, the standard deviation of a moving average scan seems well behaved for r > 0.01, but increases substantively for values less than this.  This result seems to occur for wide beta values. For high r, the standard deviation of the moving average seems to be proprtional to r**0.5, and equal to around (0.5*r)**0.5.
--
-- > fold (std 1) (scan (ma (1 - 0.01)) xs0)
--
-- ![stdma](other/ex-stdma.svg)
depState :: (a -> b -> a) -> Mealy a b -> Mealy a a
depState :: (a -> b -> a) -> Mealy a b -> Mealy a a
depState a -> b -> a
f (M a -> c
sInject c -> a -> c
sStep c -> b
sExtract) = (a -> (a, c))
-> ((a, c) -> a -> (a, c)) -> ((a, c) -> a) -> Mealy a a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> (a, c)
inject (a, c) -> a -> (a, c)
step (a, c) -> a
forall a b. (a, b) -> a
extract
  where
    inject :: a -> (a, c)
inject a
a = (a
a, a -> c
sInject a
a)
    step :: (a, c) -> a -> (a, c)
step (a
_, c
x) a
a = let a' :: a
a' = a -> b -> a
f a
a (c -> b
sExtract c
x) in (a
a', c -> a -> c
sStep c
x a
a')
    extract :: (a, b) -> a
extract (a
a, b
_) = a
a

-- | a linear model of state dependencies for the first two moments
--
-- \[
-- \begin{align}
-- x_{t+1} & = (alpha_t^x + beta_t^{x->x} * ma_t^x + beta_t^{s->x} * std_t^x) + s_{t+1}\\
-- s_{t+1} & = (alpha_t^s + beta_t^{x->s} * ma_t^x + beta_t^{s->s} * std_t^x) * N(0,1)
-- \end{align}
-- \]
data Model1 = Model1
  { Model1 -> Double
alphaX :: Double,
    Model1 -> Double
alphaS :: Double,
    Model1 -> Double
betaMa2X :: Double,
    Model1 -> Double
betaMa2S :: Double,
    Model1 -> Double
betaStd2X :: Double,
    Model1 -> Double
betaStd2S :: Double
  }
  deriving (Model1 -> Model1 -> Bool
(Model1 -> Model1 -> Bool)
-> (Model1 -> Model1 -> Bool) -> Eq Model1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Model1 -> Model1 -> Bool
$c/= :: Model1 -> Model1 -> Bool
== :: Model1 -> Model1 -> Bool
$c== :: Model1 -> Model1 -> Bool
Eq, Int -> Model1 -> ShowS
[Model1] -> ShowS
Model1 -> String
(Int -> Model1 -> ShowS)
-> (Model1 -> String) -> ([Model1] -> ShowS) -> Show Model1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Model1] -> ShowS
$cshowList :: [Model1] -> ShowS
show :: Model1 -> String
$cshow :: Model1 -> String
showsPrec :: Int -> Model1 -> ShowS
$cshowsPrec :: Int -> Model1 -> ShowS
Show, (forall x. Model1 -> Rep Model1 x)
-> (forall x. Rep Model1 x -> Model1) -> Generic Model1
forall x. Rep Model1 x -> Model1
forall x. Model1 -> Rep Model1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Model1 x -> Model1
$cfrom :: forall x. Model1 -> Rep Model1 x
Generic)

zeroModel1 :: Model1
zeroModel1 :: Model1
zeroModel1 = Double -> Double -> Double -> Double -> Double -> Double -> Model1
Model1 Double
0 Double
0 Double
0 Double
0 Double
0 Double
0

-- | Apply a model1 relationship using a single decay factor.
--
-- >>> :set -XOverloadedLabels
-- >>> fold (depModel1 0.01 (zeroModel1 & #betaMa2X .~ 0.1)) xs0
-- -0.47228537123218206
depModel1 :: Double -> Model1 -> Mealy Double Double
depModel1 :: Double -> Model1 -> Mealy Double Double
depModel1 Double
r Model1
m1 =
  (Double -> (Double, Double) -> Double)
-> Mealy Double (Double, Double) -> Mealy Double Double
forall a b. (a -> b -> a) -> Mealy a b -> Mealy a a
depState Double -> (Double, Double) -> Double
fX Mealy Double (Double, Double)
st
  where
    st :: Mealy Double (Double, Double)
st = (,) (Double -> Double -> (Double, Double))
-> Mealy Double Double -> Mealy Double (Double -> (Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Mealy Double Double
forall a. (Divisive a, Additive a) => a -> Mealy a a
ma (Double
1 Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
r) Mealy Double (Double -> (Double, Double))
-> Mealy Double Double -> Mealy Double (Double, Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Double -> Mealy Double Double
forall a. (Divisive a, ExpField a) => a -> Mealy a a
std (Double
1 Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
r)
    fX :: Double -> (Double, Double) -> Double
fX Double
a (Double
m, Double
s) =
      Double
a
        Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* ( (Double
1 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "alphaS" (Getting Double Model1 Double)
Getting Double Model1 Double
#alphaS)
              Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "betaMa2S" (Getting Double Model1 Double)
Getting Double Model1 Double
#betaMa2S) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
m
              Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "betaStd2S" (Getting Double Model1 Double)
Getting Double Model1 Double
#betaStd2S) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Double
s Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
1)
          )
        Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "alphaX" (Getting Double Model1 Double)
Getting Double Model1 Double
#alphaX
        Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "betaMa2X" (Getting Double Model1 Double)
Getting Double Model1 Double
#betaMa2X)
        Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
m
        Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "betaStd2X" (Getting Double Model1 Double)
Getting Double Model1 Double
#betaStd2X)
        Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Double
s Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
1)

-- | A rough Median.
-- The average absolute value of the stat is used to callibrate estimate drift towards the median
data Medianer a b = Medianer
  { Medianer a b -> a
medAbsSum :: a,
    Medianer a b -> b
medCount :: b,
    Medianer a b -> a
medianEst :: a
  }

-- | onlineL1' takes a function and turns it into a `Mealy` where the step is an incremental update of an (isomorphic) median statistic.
onlineL1' ::
  (Ord b, Field b, Signed b) => b -> b -> (a -> b) -> (b -> b) -> Mealy a (b, b)
onlineL1' :: b -> b -> (a -> b) -> (b -> b) -> Mealy a (b, b)
onlineL1' b
i b
d a -> b
f b -> b
g = (a -> Medianer b b)
-> (Medianer b b -> a -> Medianer b b)
-> (Medianer b b -> (b, b))
-> Mealy a (b, b)
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> Medianer b b
inject Medianer b b -> a -> Medianer b b
step Medianer b b -> (b, b)
forall b. Divisive b => Medianer b b -> (b, b)
extract
  where
    inject :: a -> Medianer b b
inject a
a = let s :: b
s = b -> b
forall a. Signed a => a -> a
abs (a -> b
f a
a) in b -> b -> b -> Medianer b b
forall a b. a -> b -> a -> Medianer a b
Medianer b
s b
forall a. Multiplicative a => a
one (b
i b -> b -> b
forall a. Multiplicative a => a -> a -> a
* b
s)
    step :: Medianer b b -> a -> Medianer b b
step (Medianer b
s b
c b
m) a
a =
      b -> b -> b -> Medianer b b
forall a b. a -> b -> a -> Medianer a b
Medianer
        (b -> b
g (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
s b -> b -> b
forall a. Additive a => a -> a -> a
+ b -> b
forall a. Signed a => a -> a
abs (a -> b
f a
a))
        (b -> b
g (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
c b -> b -> b
forall a. Additive a => a -> a -> a
+ b
forall a. Multiplicative a => a
one)
        ((b
forall a. Multiplicative a => a
one b -> b -> b
forall a. Subtractive a => a -> a -> a
- b
d) b -> b -> b
forall a. Multiplicative a => a -> a -> a
* (b
m b -> b -> b
forall a. Additive a => a -> a -> a
+ a -> b -> b
sign' a
a b
m b -> b -> b
forall a. Multiplicative a => a -> a -> a
* b
i b -> b -> b
forall a. Multiplicative a => a -> a -> a
* b
s b -> b -> b
forall a. Divisive a => a -> a -> a
/ b
c') b -> b -> b
forall a. Additive a => a -> a -> a
+ b
d b -> b -> b
forall a. Multiplicative a => a -> a -> a
* a -> b
f a
a)
      where
        c' :: b
c' =
          if b
c b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
forall a. Additive a => a
zero
            then b
forall a. Multiplicative a => a
one
            else b
c
    extract :: Medianer b b -> (b, b)
extract (Medianer b
s b
c b
m) = (b
s b -> b -> b
forall a. Divisive a => a -> a -> a
/ b
c, b
m)
    sign' :: a -> b -> b
sign' a
a b
m
      | a -> b
f a
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
m = b
forall a. Multiplicative a => a
one
      | a -> b
f a
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
m = b -> b
forall a. Subtractive a => a -> a
negate b
forall a. Multiplicative a => a
one
      | Bool
otherwise = b
forall a. Additive a => a
zero
{-# INLINEABLE onlineL1' #-}

-- | onlineL1 takes a function and turns it into a `Control.Foldl.Fold` where the step is an incremental update of an (isomorphic) median statistic.
onlineL1 :: (Ord b, Field b, Signed b) => b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 :: b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 b
i b
d a -> b
f b -> b
g = (b, b) -> b
forall a b. (a, b) -> b
snd ((b, b) -> b) -> Mealy a (b, b) -> Mealy a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> b -> (a -> b) -> (b -> b) -> Mealy a (b, b)
forall b a.
(Ord b, Field b, Signed b) =>
b -> b -> (a -> b) -> (b -> b) -> Mealy a (b, b)
onlineL1' b
i b
d a -> b
f b -> b
g
{-# INLINEABLE onlineL1 #-}

-- $setup
--
-- >>> import qualified Control.Foldl as L
-- >>> let n = 100
-- >>> let inc = 0.1
-- >>> let d = 0
-- >>> let r = 0.9

-- | moving median
-- > L.fold (maL1 inc d r) [1..n]
-- 93.92822312742108
maL1 :: (Ord a, Field a, Signed a) => a -> a -> a -> Mealy a a
maL1 :: a -> a -> a -> Mealy a a
maL1 a
i a
d a
r = a -> a -> (a -> a) -> (a -> a) -> Mealy a a
forall b a.
(Ord b, Field b, Signed b) =>
b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 a
i a
d a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE maL1 #-}

-- | moving absolute deviation
absmaL1 :: (Ord a, Field a, Signed a) => a -> a -> a -> Mealy a a
absmaL1 :: a -> a -> a -> Mealy a a
absmaL1 a
i a
d a
r = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> Mealy a (a, a) -> Mealy a a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> (a -> a) -> (a -> a) -> Mealy a (a, a)
forall b a.
(Ord b, Field b, Signed b) =>
b -> b -> (a -> b) -> (b -> b) -> Mealy a (b, b)
onlineL1' a
i a
d a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE absmaL1 #-}