{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-pattern-namespace-specifier #-}

-- | Streaming statistics and state-machine specialisations built on
-- 'Circuit.Process.Process'.
--
-- The 'Process' carrier itself lives in "Circuit.Process"; this module is the
-- box library: moving averages, standard deviations, regression, quantiles,
-- delays, and related streaming combinators.
--
-- 'fold' is re-exported from "Circuit.Process" and is total (it returns
-- 'Nothing' for an empty list). The statistical implementations in this module
-- are the canonical @circuits-stats@ reference boxes.
module Circuit.Stats
  ( -- * Process re-export
    Process (..),
    dipure,
    before,
    after,
    scan,
    fold,
    Averager (..),
    pattern A,
    av,
    av_,
    online,

    -- * Statistics
    -- $example-set
    ma,
    absma,
    sqma,
    std,
    cov,
    corrGauss,
    corr,
    beta1,
    alpha1,
    reg1,
    beta,
    alpha,
    reg,
    asum,
    aconst,
    last,
    maybeLast,
    delay1,
    delay,
    window,
    diff,
    gdiff,
    same,
    countM,
    sumM,
    listify,

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

import Circuit.Category (id, (.))
import Circuit.Mat.Field (inverseM)
import Circuit.Process (Process (..), fold, scan)
import Control.Exception
import Data.Map qualified as Map
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (Text)
import Data.Vector (Vector)
import GHC.TypeLits
import Harpie.Fixed qualified as Box
import Harpie.Fixed.Generic qualified as F
import Harpie.Shape qualified as S
import NumHask.Prelude hiding (asum, diff, fold, id, last, (.), (|*))

-- | Scale a functorial container by a scalar.
(|*) :: (Functor f, Multiplicative a) => f a -> a -> f a
f a
a |* :: forall (f :: * -> *) a.
(Functor f, Multiplicative a) =>
f a -> a -> f a
|* a
s = (a -> a) -> f a -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
s) f a
a

-- | Convert between the generic vector array and the boxed default array.
toBox :: F.Array Vector s a -> Box.Array s a
toBox :: forall (s :: [Nat]) a. Array Vector s a -> Array s a
toBox (F.Array Vector a
v) = Vector a -> Array s a
forall a (s :: [Nat]). Vector a -> Array s a
Box.Array Vector a
v

fromBox :: Box.Array s a -> F.Array Vector s a
fromBox :: forall (s :: [Nat]) a. Array s a -> Array Vector s a
fromBox (Box.Array Vector a
v) = Vector a -> Array Vector s a
forall {k} (v :: k -> *) (s :: [Nat]) (a :: k). v a -> Array v s a
F.Array Vector a
v

-- $setup
--
-- >>> :set -XDataKinds
-- >>> import Control.Category ((>>>))
-- >>> import Data.List
-- >>> import Data.Maybe (fromMaybe)
-- >>> import Circuit.Stats.Simulate
-- >>> import Data.Vector (Vector)
-- >>> import Harpie.Fixed.Generic qualified as F
-- >>> let fold' p = fromMaybe (error "fold': empty input") . fold p
-- >>> g <- create
-- >>> xs0 <- rvs g 10000
-- >>> xs1 <- rvs g 10000
-- >>> xs2 <- rvs g 10000
-- >>> xsp <- rvsp g 10000 0.8

-- $example-set
-- The doctest examples are composed from some random series generated with Circuit.Stats.Simulate.
--
-- - 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 Data.Maybe (fromMaybe)
-- >>> import Circuit.Stats.Simulate
-- >>> let fold' p = fromMaybe (error "fold': empty input") . fold p
-- >>> g <- create
-- >>> xs0 <- rvs g 10000
-- >>> xs1 <- rvs g 10000
-- >>> xs2 <- rvs g 10000
-- >>> xsp <- rvsp g 10000 0.8

newtype ProcessStatsError = ProcessStatsError {ProcessStatsError -> Text
processStatsErrorMessage :: Text}
  deriving (Int -> ProcessStatsError -> ShowS
[ProcessStatsError] -> ShowS
ProcessStatsError -> String
(Int -> ProcessStatsError -> ShowS)
-> (ProcessStatsError -> String)
-> ([ProcessStatsError] -> ShowS)
-> Show ProcessStatsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessStatsError -> ShowS
showsPrec :: Int -> ProcessStatsError -> ShowS
$cshow :: ProcessStatsError -> String
show :: ProcessStatsError -> String
$cshowList :: [ProcessStatsError] -> ShowS
showList :: [ProcessStatsError] -> ShowS
Show)

instance Exception ProcessStatsError

-- | Create a 'Process' from a (pure) binary operation.
dipure :: (a -> a -> a) -> Process a a
dipure :: forall a. (a -> a -> a) -> Process a a
dipure a -> a -> a
f = (a -> a) -> (a -> a -> a) -> (a -> a) -> Process a a
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process a -> a
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id a -> a -> a
f a -> a
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id

-- | Precompose a pure function before a process.
before :: Process b c -> (a -> b) -> Process a c
before :: forall b c a. Process b c -> (a -> b) -> Process a c
before (Process b -> s
i s -> b -> s
st s -> c
ex) a -> b
f = (a -> s) -> (s -> a -> s) -> (s -> c) -> Process a c
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process (b -> s
i (b -> s) -> (a -> b) -> a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall k (arr :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category arr =>
arr b c -> arr a b -> arr a c
. a -> b
f) (\s
s a
a -> s -> b -> s
st s
s (a -> b
f a
a)) s -> c
ex
{-# INLINEABLE before #-}

-- | Postcompose a pure function after a process.
after :: Process a b -> (b -> c) -> Process a c
after :: forall a b c. Process a b -> (b -> c) -> Process a c
after (Process a -> s
i s -> a -> s
st s -> b
ex) b -> c
f = (a -> s) -> (s -> a -> s) -> (s -> c) -> Process a c
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process a -> s
i s -> a -> s
st (b -> c
f (b -> c) -> (s -> b) -> s -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall k (arr :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category arr =>
arr b c -> arr a b -> arr a c
. s -> b
ex)
{-# INLINEABLE after #-}

-- | Run two processes on the same input and combine their outputs.
parWith :: (x -> y -> z) -> Process a x -> Process a y -> Process a z
parWith :: forall x y z a.
(x -> y -> z) -> Process a x -> Process a y -> Process a z
parWith x -> y -> z
combine (Process a -> s
i1 s -> a -> s
st1 s -> x
ex1) (Process a -> s
i2 s -> a -> s
st2 s -> y
ex2) =
  (a -> (s, s))
-> ((s, s) -> a -> (s, s)) -> ((s, s) -> z) -> Process a z
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process (\a
a -> (a -> s
i1 a
a, a -> s
i2 a
a)) (\(s
s1, s
s2) a
a -> (s -> a -> s
st1 s
s1 a
a, s -> a -> s
st2 s
s2 a
a)) (\(s
s1, s
s2) -> x -> y -> z
combine (s -> x
ex1 s
s1) (s -> y
ex2 s
s2))
{-# INLINEABLE parWith #-}

-- | Run three processes on the same input and combine their outputs.
parWith3 :: (x -> y -> z -> w) -> Process a x -> Process a y -> Process a z -> Process a w
parWith3 :: forall x y z w a.
(x -> y -> z -> w)
-> Process a x -> Process a y -> Process a z -> Process a w
parWith3 x -> y -> z -> w
combine (Process a -> s
i1 s -> a -> s
st1 s -> x
ex1) (Process a -> s
i2 s -> a -> s
st2 s -> y
ex2) (Process a -> s
i3 s -> a -> s
st3 s -> z
ex3) =
  (a -> (s, s, s))
-> ((s, s, s) -> a -> (s, s, s)) -> ((s, s, s) -> w) -> Process a w
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process
    (\a
a -> (a -> s
i1 a
a, a -> s
i2 a
a, a -> s
i3 a
a))
    (\(s
s1, s
s2, s
s3) a
a -> (s -> a -> s
st1 s
s1 a
a, s -> a -> s
st2 s
s2 a
a, s -> a -> s
st3 s
s3 a
a))
    (\(s
s1, s
s2, s
s3) -> x -> y -> z -> w
combine (s -> x
ex1 s
s1) (s -> y
ex2 s
s2) (s -> z
ex3 s
s3))
{-# INLINEABLE parWith3 #-}

-- | Run four processes on the same input and combine their outputs.
parWith4 :: (w -> x -> y -> z -> r) -> Process a w -> Process a x -> Process a y -> Process a z -> Process a r
parWith4 :: forall w x y z r a.
(w -> x -> y -> z -> r)
-> Process a w
-> Process a x
-> Process a y
-> Process a z
-> Process a r
parWith4 w -> x -> y -> z -> r
combine (Process a -> s
i1 s -> a -> s
st1 s -> w
ex1) (Process a -> s
i2 s -> a -> s
st2 s -> x
ex2) (Process a -> s
i3 s -> a -> s
st3 s -> y
ex3) (Process a -> s
i4 s -> a -> s
st4 s -> z
ex4) =
  (a -> (s, s, s, s))
-> ((s, s, s, s) -> a -> (s, s, s, s))
-> ((s, s, s, s) -> r)
-> Process a r
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process
    (\a
a -> (a -> s
i1 a
a, a -> s
i2 a
a, a -> s
i3 a
a, a -> s
i4 a
a))
    (\(s
s1, s
s2, s
s3, s
s4) a
a -> (s -> a -> s
st1 s
s1 a
a, s -> a -> s
st2 s
s2 a
a, s -> a -> s
st3 s
s3 a
a, s -> a -> s
st4 s
s4 a
a))
    (\(s
s1, s
s2, s
s3, s
s4) -> w -> x -> y -> z -> r
combine (s -> w
ex1 s
s1) (s -> x
ex2 s
s2) (s -> y
ex3 s
s3) (s -> z
ex4 s
s4))
{-# INLINEABLE parWith4 #-}

-- | 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
  { forall a b. 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
$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
/= :: 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
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Averager a b -> ShowS
showsPrec :: Int -> Averager a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => Averager a b -> String
show :: Averager a b -> String
$cshowList :: forall a b. (Show a, Show b) => [Averager a b] -> ShowS
showList :: [Averager a b] -> ShowS
Show)

-- | Pattern for an 'Averager'.
--
-- @A sum count@
pattern A :: a -> b -> Averager a b
pattern $bA :: forall a b. a -> b -> Averager a b
$mA :: forall {r} {a} {b}.
Averager a b -> (a -> b -> r) -> ((# #) -> 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
(<>)

instance (Additive a, Additive b) => Additive (Averager a b) where
  zero :: Averager a b
zero = 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
  A a
s b
c + :: Averager a b -> Averager a b -> Averager a b
+ 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')

instance (Subtractive a, Subtractive b) => Subtractive (Averager a b) where
  negate :: Averager a b -> Averager a b
negate (A a
s b
c) = a -> b -> Averager a b
forall a b. a -> b -> Averager a b
A (a -> a
forall a. Subtractive a => a -> a
negate a
s) (b -> b
forall a. Subtractive a => a -> a
negate b
c)
  A a
s b
c - :: Averager a b -> Averager a b -> Averager a b
- 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. Subtractive a => a -> a -> a
- a
s') (b
c b -> b -> b
forall a. Subtractive a => a -> a -> a
- b
c')

-- | extract the average from an 'Averager'
--
-- av gives NaN on zero divide
av :: (Divisive a) => Averager a a -> a
av :: forall a. Divisive a => 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_ :: forall a. (Eq a, Additive a, Divisive a) => 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 'Process' where f is a transformation of the data and
-- g is a decay function (usually convergent to zero) applied at each step.
--
-- > online id id == av
--
-- @online@ is best understood by examining usage
-- to produce a moving average and standard deviation:
--
-- An exponentially-weighted moving average with a decay rate of 0.9
--
-- > ma r == online id (*r)
--
-- An exponentially-weighted moving average of the square.
--
-- > sqma r = online (\x -> x * x) (* r)
--
-- Parallel-style exponentially-weighted standard deviation computation:
--
-- > std r = parWith (\s ss -> sqrt (ss - s ** 2)) (ma r) (sqma r)
online :: (Divisive b, Additive b) => (a -> b) -> (b -> b) -> Process a b
online :: forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Process a b
online a -> b
f b -> b
g = (a -> Averager b b)
-> (Averager b b -> a -> Averager b b)
-> (Averager b b -> b)
-> Process a b
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process 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) ([1..100])
-- 100.0
--
-- >>> fold' (ma 1) ([1..100])
-- 50.5
--
-- >>> fold' (ma 0.99) xs0
-- 9.713356299018187e-2
ma :: (Divisive a, Additive a) => a -> Process a a
ma :: forall a. (Divisive a, Additive a) => a -> Process a a
ma a
r = (a -> a) -> (a -> a) -> Process a a
forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Process a b
online a -> a
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE ma #-}

-- | absolute average
--
-- >>> fold' (absma 1) xs0
-- 0.8075705557429647
absma :: (Divisive a, Absolute a) => a -> Process a a
absma :: forall a. (Divisive a, Absolute a) => a -> Process a a
absma a
r = (a -> a) -> (a -> a) -> Process a a
forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Process a b
online a -> a
forall a. Absolute 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 -> Process a a
sqma :: forall a. (Divisive a, Additive a) => a -> Process a a
sqma a
r = (a -> a) -> (a -> a) -> Process a a
forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Process 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, combining 'ma' and 'sqma' in parallel:
--
-- > std r = parWith (\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
-- 1.0126438036262801
std :: (ExpField a) => a -> Process a a
std :: forall a. ExpField a => a -> Process a a
std a
r = (a -> a -> a) -> Process a a -> Process a a -> Process a a
forall x y z a.
(x -> y -> z) -> Process a x -> Process a y -> Process a z
parWith (\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 -> Process a a
forall a. (Divisive a, Additive a) => a -> Process a a
ma a
r) (a -> Process a a
forall a. (Divisive a, Additive a) => a -> Process a a
sqma a
r)
{-# INLINEABLE std #-}

-- | The covariance of a tuple given an underlying central tendency fold.
--
-- >>> fold' (cov (ma 1)) xsp
-- 0.7818936662586868
cov :: (Field a) => Process a a -> Process (a, a) a
cov :: forall a. Field a => Process a a -> Process (a, a) a
cov Process a a
m =
  (a -> a -> a -> a)
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
forall x y z w a.
(x -> y -> z -> w)
-> Process a x -> Process a y -> Process a z -> Process a w
parWith3
    (\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')
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
m ((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
(*)))
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
m (a, a) -> a
forall a b. (a, b) -> a
fst)
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
m (a, a) -> a
forall a b. (a, b) -> b
snd)
{-# INLINEABLE cov #-}

-- | correlation of a tuple, specialised to Guassian
--
-- >>> fold' (corrGauss 1) xsp
-- 0.7978347126677433
corrGauss :: (ExpField a) => a -> Process (a, a) a
corrGauss :: forall a. ExpField a => a -> Process (a, a) a
corrGauss a
r =
  (a -> a -> a -> a)
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
forall x y z w a.
(x -> y -> z -> w)
-> Process a x -> Process a y -> Process a z -> Process a w
parWith3
    (\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))
    (Process a a -> Process (a, a) a
forall a. Field a => Process a a -> Process (a, a) a
cov (a -> Process a a
forall a. (Divisive a, Additive a) => a -> Process a a
ma a
r))
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before (a -> Process a a
forall a. ExpField a => a -> Process a a
std a
r) (a, a) -> a
forall a b. (a, b) -> a
fst)
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before (a -> Process a a
forall a. ExpField a => a -> Process a a
std a
r) (a, a) -> a
forall a b. (a, b) -> b
snd)
{-# INLINEABLE corrGauss #-}

-- | a generalised version of correlation of a tuple
--
-- >>> fold' (corr (ma 1) (std 1)) xsp
-- 0.7978347126677433
--
-- > corr (ma r) (std r) == corrGauss r
corr :: (ExpField a) => Process a a -> Process a a -> Process (a, a) a
corr :: forall a.
ExpField a =>
Process a a -> Process a a -> Process (a, a) a
corr Process a a
central Process a a
deviation =
  (a -> a -> a -> a)
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
forall x y z w a.
(x -> y -> z -> w)
-> Process a x -> Process a y -> Process a z -> Process a w
parWith3
    (\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))
    (Process a a -> Process (a, a) a
forall a. Field a => Process a a -> Process (a, a) a
cov Process a a
central)
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
deviation (a, a) -> a
forall a b. (a, b) -> a
fst)
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
deviation (a, a) -> a
forall a b. (a, b) -> b
snd)
{-# 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 'Process' 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.999747321294513
beta1 :: (ExpField a) => Process a a -> Process (a, a) a
beta1 :: forall a. ExpField a => Process a a -> Process (a, a) a
beta1 Process a a
m =
  (a -> a -> a -> a -> a)
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
forall w x y z r a.
(w -> x -> y -> z -> r)
-> Process a w
-> Process a x
-> Process a y
-> Process a z
-> Process a r
parWith4
    (\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'))
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
m ((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
(*)))
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
m (a, a) -> a
forall a b. (a, b) -> a
fst)
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
m (a, a) -> a
forall a b. (a, b) -> b
snd)
    (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
m (\(a
x, a
_) -> a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x))
{-# 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.3680496627365146e-2
alpha1 :: (ExpField a) => Process a a -> Process (a, a) a
alpha1 :: forall a. ExpField a => Process a a -> Process (a, a) a
alpha1 Process a a
m = (a -> a -> a -> a)
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
-> Process (a, a) a
forall x y z w a.
(x -> y -> z -> w)
-> Process a x -> Process a y -> Process a z -> Process a w
parWith3 (\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) (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
m (a, a) -> a
forall a b. (a, b) -> a
fst) (Process a a -> Process (a, a) a
forall a. ExpField a => Process a a -> Process (a, a) a
beta1 Process a a
m) (Process a a -> ((a, a) -> a) -> Process (a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before Process a a
m (a, a) -> a
forall a b. (a, b) -> b
snd)
{-# 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.3680496627365146e-2,0.4997473212944953)
reg1 :: (ExpField a) => Process a a -> Process (a, a) (a, a)
reg1 :: forall a. ExpField a => Process a a -> Process (a, a) (a, a)
reg1 Process a a
m = (a -> a -> (a, a))
-> Process (a, a) a -> Process (a, a) a -> Process (a, a) (a, a)
forall x y z a.
(x -> y -> z) -> Process a x -> Process a y -> Process a z
parWith (,) (Process a a -> Process (a, a) a
forall a. ExpField a => Process a a -> Process (a, a) a
alpha1 Process a a
m) (Process a a -> Process (a, a) a
forall a. ExpField a => Process a a -> Process (a, a) a
beta1 Process a a
m)

data RegressionState (n :: Nat) a = RegressionState
  { forall (n :: Nat) a. RegressionState n a -> Array Vector '[n, n] a
_xx :: F.Array Vector '[n, n] a,
    forall (n :: Nat) a. RegressionState n a -> Array Vector '[n] a
_x :: F.Array Vector '[n] a,
    forall (n :: Nat) a. RegressionState n a -> Array Vector '[n] a
_xy :: F.Array Vector '[n] a,
    forall (n :: Nat) a. RegressionState n a -> a
_y :: a
  }
  deriving ((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 (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 a b. a -> RegressionState n b -> RegressionState n a
forall 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
$cfmap :: forall (n :: Nat) a b.
(a -> b) -> RegressionState n a -> RegressionState n b
fmap :: forall a b. (a -> b) -> RegressionState n a -> RegressionState n b
$c<$ :: forall (n :: Nat) a b.
a -> RegressionState n b -> RegressionState n a
<$ :: forall a b. a -> RegressionState n b -> RegressionState n a
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 -> F.array @Vector @'[2] [x,y]) xs1 xs2) ys
-- >>> fold' (beta 0.99) zs
-- [0.6228820021456606,0.8461936860075405]
beta :: (ExpField a, KnownNat n) => a -> Process (F.Array Vector '[n] a, a) (F.Array Vector '[n] a)
beta :: forall a (n :: Nat).
(ExpField a, KnownNat n) =>
a -> Process (Array Vector '[n] a, a) (Array Vector '[n] a)
beta a
r = ((Array Vector '[n] a, a) -> Averager (RegressionState n a) a)
-> (Averager (RegressionState n a) a
    -> (Array Vector '[n] a, a) -> Averager (RegressionState n a) a)
-> (Averager (RegressionState n a) a -> Array Vector '[n] a)
-> Process (Array Vector '[n] a, a) (Array Vector '[n] a)
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process (Array Vector '[n] a, a) -> Averager (RegressionState n a) a
forall {n :: Nat} {a} {b}.
(KnownNat n, Multiplicative a, Multiplicative b) =>
(Array Vector '[n] a, a) -> Averager (RegressionState n a) b
inject Averager (RegressionState n a) a
-> (Array Vector '[n] a, a) -> Averager (RegressionState n a) a
step Averager (RegressionState n a) a -> Array Vector '[n] a
forall {n :: Nat} {a}.
(KnownNat n, ExpField a) =>
Averager (RegressionState n a) a -> Array Vector '[n] a
extract
  where
    -- extract :: Averager (RegressionState n a) a -> (F.Array Vector '[n] a)
    extract :: Averager (RegressionState n a) a
-> Array
     Vector
     (Eval
        (Foldl'
           (Flip DeleteDim)
           '[n, n]
           (Eval (Rev (Eval (PreDeletePositionsGo '[1] '[])) '[])))
      <> Eval
           (Foldl'
              (Flip DeleteDim)
              '[n]
              (Eval (Rev (Eval (PreDeletePositionsGo '[0] '[])) '[]))))
     a
extract (A (RegressionState Array Vector '[n, n] a
xx Array Vector '[n] a
x Array Vector '[n] a
xy a
y) a
c) =
      let a :: Array Vector '[n, n] a
a = (a -> a -> a)
-> Array Vector '[n, n] a
-> Array Vector '[n, n] a
-> Array Vector '[n, n] a
forall (s :: [Nat]) (v :: * -> *) a b c.
(KnownNats s, Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Array v s a -> Array v s b -> Array v s c
F.zipWith (-) Array Vector '[n, n] a
xx ((a -> a -> a)
-> Array Vector '[n] a
-> Array Vector '[n] a
-> Array Vector '[n, n] a
forall (v :: * -> *) (sc :: [Nat]) (sa :: [Nat]) (sb :: [Nat]) a b
       c.
(KnownNats sa, KnownNats sb, KnownNats sc, sc ~ Eval (sa ++ sb),
 Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Array v sa a -> Array v sb b -> Array v sc c
F.expand a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*) Array Vector '[n] a
x Array Vector '[n] a
x) Array Vector '[n, n] a -> a -> Array Vector '[n, n] a
forall (f :: * -> *) a.
(Functor f, Multiplicative a) =>
f a -> a -> f a
|* (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
c)
          b :: Array Vector '[n] a
b = (a -> a -> a)
-> Array Vector '[n] a
-> Array Vector '[n] a
-> Array Vector '[n] a
forall (s :: [Nat]) (v :: * -> *) a b c.
(KnownNats s, Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Array v s a -> Array v s b -> Array v s c
F.zipWith (-) Array Vector '[n] a
xy (Array Vector '[n] a
x Array Vector '[n] a -> a -> Array Vector '[n] a
forall (f :: * -> *) a.
(Functor f, Multiplicative a) =>
f a -> a -> f a
|* a
y) Array Vector '[n] a -> a -> Array Vector '[n] a
forall (f :: * -> *) a.
(Functor f, Multiplicative a) =>
f a -> a -> f a
|* (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
c)
       in Array '[n, n] a -> Array Vector '[n, n] a
forall (s :: [Nat]) a. Array s a -> Array Vector s a
fromBox (Array '[n, n] a -> Array '[n, n] a
forall (n :: Nat) a.
(KnownNat n, KnownNats '[n, n], ExpField a) =>
MatrixM n a -> MatrixM n a
inverseM (Array Vector '[n, n] a -> Array '[n, n] a
forall (s :: [Nat]) a. Array Vector s a -> Array s a
toBox Array Vector '[n, n] a
a)) Array Vector '[n, n] a
-> Array Vector '[n] a
-> Array
     Vector
     (Eval
        (Foldl'
           (Flip DeleteDim)
           '[n, n]
           (Eval (Rev (Eval (PreDeletePositionsGo '[1] '[])) '[])))
      <> Eval
           (Foldl'
              (Flip DeleteDim)
              '[n]
              (Eval (Rev (Eval (PreDeletePositionsGo '[0] '[])) '[]))))
     a
forall (v :: * -> *) a (ds0 :: [Nat]) (ds1 :: [Nat]) (s0 :: [Nat])
       (s1 :: [Nat]) (so0 :: [Nat]) (so1 :: [Nat]) (st :: [Nat])
       (si :: [Nat]).
(Additive a, Multiplicative a, KnownNats s0, KnownNats s1,
 KnownNats ds0, KnownNats ds1, KnownNats so0, KnownNats so1,
 KnownNats st, KnownNats si, so0 ~ Eval (DeleteDims ds0 s0),
 so1 ~ Eval (DeleteDims ds1 s1), si ~ Eval (GetDims ds0 s0),
 si ~ Eval (GetDims ds1 s1), st ~ Eval (so0 ++ so1),
 ds0 ~ '[Eval (Eval (Rank s0) - 1)], ds1 ~ '[0], Vector v a) =>
Array v s0 a -> Array v s1 a -> Array v st a
`F.mult` Array Vector '[n] a
b
    step :: Averager (RegressionState n a) a
-> (Array Vector '[n] a, a) -> Averager (RegressionState n a) a
step Averager (RegressionState n a) a
x (Array Vector '[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 Vector '[n] a, a) -> Averager (RegressionState n a) a
forall {n :: Nat} {a} {b}.
(KnownNat n, Multiplicative a, Multiplicative b) =>
(Array Vector '[n] a, a) -> Averager (RegressionState n a) b
inject (Array Vector '[n] a
xs, a
y))
    -- inject :: (F.Array Vector '[n] a, a) -> Averager (RegressionState n a) a
    inject :: (Array Vector '[n] a, a) -> Averager (RegressionState n a) b
inject (Array Vector '[n] a
xs, a
y) =
      RegressionState n a -> b -> Averager (RegressionState n a) b
forall a b. a -> b -> Averager a b
A (Array Vector '[n, n] a
-> Array Vector '[n] a
-> Array Vector '[n] a
-> a
-> RegressionState n a
forall (n :: Nat) a.
Array Vector '[n, n] a
-> Array Vector '[n] a
-> Array Vector '[n] a
-> a
-> RegressionState n a
RegressionState ((a -> a -> a)
-> Array Vector '[n] a
-> Array Vector '[n] a
-> Array Vector '[n, n] a
forall (v :: * -> *) (sc :: [Nat]) (sa :: [Nat]) (sb :: [Nat]) a b
       c.
(KnownNats sa, KnownNats sb, KnownNats sc, sc ~ Eval (sa ++ sb),
 Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Array v sa a -> Array v sb b -> Array v sc c
F.expand a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*) Array Vector '[n] a
xs Array Vector '[n] a
xs) Array Vector '[n] a
xs (Array Vector '[n] a
xs Array Vector '[n] a -> a -> Array Vector '[n] a
forall (f :: * -> *) a.
(Functor f, Multiplicative a) =>
f a -> a -> f a
|* a
y) a
y) b
forall a. Multiplicative a => a
one
{-# INLINEABLE beta #-}

rsOnline :: (Field a, KnownNat n) => a -> Averager (RegressionState n a) a -> Averager (RegressionState n a) a -> Averager (RegressionState n a) a
rsOnline :: 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 (A (RegressionState Array Vector '[n, n] a
xx Array Vector '[n] a
x Array Vector '[n] a
xy a
y) a
c) (A (RegressionState Array Vector '[n, n] a
xx' Array Vector '[n] a
x' Array Vector '[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 Vector '[n, n] a
-> Array Vector '[n] a
-> Array Vector '[n] a
-> a
-> RegressionState n a
forall (n :: Nat) a.
Array Vector '[n, n] a
-> Array Vector '[n] a
-> Array Vector '[n] a
-> a
-> RegressionState n a
RegressionState ((a -> a -> a)
-> Array Vector '[n, n] a
-> Array Vector '[n, n] a
-> Array Vector '[n, n] a
forall (s :: [Nat]) (v :: * -> *) a b c.
(KnownNats s, Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Array v s a -> Array v s b -> Array v s c
F.zipWith a -> a -> a
d Array Vector '[n, n] a
xx Array Vector '[n, n] a
xx') ((a -> a -> a)
-> Array Vector '[n] a
-> Array Vector '[n] a
-> Array Vector '[n] a
forall (s :: [Nat]) (v :: * -> *) a b c.
(KnownNats s, Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Array v s a -> Array v s b -> Array v s c
F.zipWith a -> a -> a
d Array Vector '[n] a
x Array Vector '[n] a
x') ((a -> a -> a)
-> Array Vector '[n] a
-> Array Vector '[n] a
-> Array Vector '[n] a
forall (s :: [Nat]) (v :: * -> *) a b c.
(KnownNats s, Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Array v s a -> Array v s b -> Array v s c
F.zipWith a -> a -> a
d Array Vector '[n] a
xy Array Vector '[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) => a -> Process (F.Array Vector '[n] a, a) a
alpha :: forall a (n :: Nat).
(ExpField a, KnownNat n) =>
a -> Process (Array Vector '[n] a, a) a
alpha a
r =
  (Array Vector '[n] a -> Array Vector '[n] a -> a -> a)
-> Process (Array Vector '[n] a, a) (Array Vector '[n] a)
-> Process (Array Vector '[n] a, a) (Array Vector '[n] a)
-> Process (Array Vector '[n] a, a) a
-> Process (Array Vector '[n] a, a) a
forall x y z w a.
(x -> y -> z -> w)
-> Process a x -> Process a y -> Process a z -> Process a w
parWith3
    (\Array Vector '[n] a
xs Array Vector '[n] a
b a
y -> a
y a -> a -> a
forall a. Subtractive a => a -> a -> a
- Array Vector '[n] a -> a
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum ((a -> a -> a)
-> Array Vector '[n] a
-> Array Vector '[n] a
-> Array Vector '[n] a
forall (s :: [Nat]) (v :: * -> *) a b c.
(KnownNats s, Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Array v s a -> Array v s b -> Array v s c
F.zipWith a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*) Array Vector '[n] a
b Array Vector '[n] a
xs))
    (Process (Array Vector '[n] a) (Array Vector '[n] a)
-> ((Array Vector '[n] a, a) -> Array Vector '[n] a)
-> Process (Array Vector '[n] a, a) (Array Vector '[n] a)
forall b c a. Process b c -> (a -> b) -> Process a c
before (Process a a -> Process (Array Vector '[n] a) (Array Vector '[n] a)
forall (s :: [Nat]) a b.
KnownNats s =>
Process a b -> Process (Array Vector s a) (Array Vector s b)
arrayify (a -> Process a a
forall a. (Divisive a, Additive a) => a -> Process a a
ma a
r)) (Array Vector '[n] a, a) -> Array Vector '[n] a
forall a b. (a, b) -> a
fst)
    (a -> Process (Array Vector '[n] a, a) (Array Vector '[n] a)
forall a (n :: Nat).
(ExpField a, KnownNat n) =>
a -> Process (Array Vector '[n] a, a) (Array Vector '[n] a)
beta a
r)
    (Process a a
-> ((Array Vector '[n] a, a) -> a)
-> Process (Array Vector '[n] a, a) a
forall b c a. Process b c -> (a -> b) -> Process a c
before (a -> Process a a
forall a. (Divisive a, Additive a) => a -> Process a a
ma a
r) (Array Vector '[n] a, a) -> a
forall a b. (a, b) -> b
snd)
{-# INLINEABLE alpha #-}

arrayify :: (S.KnownNats s) => Process a b -> Process (F.Array Vector s a) (F.Array Vector s b)
arrayify :: forall (s :: [Nat]) a b.
KnownNats s =>
Process a b -> Process (Array Vector s a) (Array Vector s b)
arrayify (Process a -> s
sExtract s -> a -> s
sStep s -> b
sInject) = (Array Vector s a -> Array Vector s s)
-> (Array Vector s s -> Array Vector s a -> Array Vector s s)
-> (Array Vector s s -> Array Vector s b)
-> Process (Array Vector s a) (Array Vector s b)
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process Array Vector s a -> Array Vector s s
extract Array Vector s s -> Array Vector s a -> Array Vector s s
step Array Vector s s -> Array Vector s b
inject
  where
    extract :: Array Vector s a -> Array Vector s s
extract = (a -> s) -> Array Vector s a -> Array Vector s s
forall a b. (a -> b) -> Array Vector s a -> Array Vector s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> s
sExtract
    step :: Array Vector s s -> Array Vector s a -> Array Vector s s
step = (s -> a -> s)
-> Array Vector s s -> Array Vector s a -> Array Vector s s
forall (s :: [Nat]) (v :: * -> *) a b c.
(KnownNats s, Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Array v s a -> Array v s b -> Array v s c
F.zipWith s -> a -> s
sStep
    inject :: Array Vector s s -> Array Vector s b
inject = (s -> b) -> Array Vector s s -> Array Vector s b
forall a b. (a -> b) -> Array Vector s a -> Array Vector s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> 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 -> F.array @Vector @'[2] [x,y]) xs1 xs2) ys
-- >>> fold' (reg 0.99) zs
-- ([0.6228820021456606,0.8461936860075405],2.536775201287266e-2)
reg :: (ExpField a, KnownNat n) => a -> Process (F.Array Vector '[n] a, a) (F.Array Vector '[n] a, a)
reg :: forall a (n :: Nat).
(ExpField a, KnownNat n) =>
a -> Process (Array Vector '[n] a, a) (Array Vector '[n] a, a)
reg a
r = (Array Vector '[n] a -> a -> (Array Vector '[n] a, a))
-> Process (Array Vector '[n] a, a) (Array Vector '[n] a)
-> Process (Array Vector '[n] a, a) a
-> Process (Array Vector '[n] a, a) (Array Vector '[n] a, a)
forall x y z a.
(x -> y -> z) -> Process a x -> Process a y -> Process a z
parWith (,) (a -> Process (Array Vector '[n] a, a) (Array Vector '[n] a)
forall a (n :: Nat).
(ExpField a, KnownNat n) =>
a -> Process (Array Vector '[n] a, a) (Array Vector '[n] a)
beta a
r) (a -> Process (Array Vector '[n] a, a) a
forall a (n :: Nat).
(ExpField a, KnownNat n) =>
a -> Process (Array Vector '[n] a, a) a
alpha a
r)
{-# INLINEABLE reg #-}

-- | accumulated sum
asum :: (Additive a) => Process a a
asum :: forall a. Additive a => Process a a
asum = (a -> a) -> (a -> a -> a) -> (a -> a) -> Process a a
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process a -> a
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id a -> a -> a
forall a. Additive a => a -> a -> a
(+) a -> a
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id

-- | constant Process
aconst :: b -> Process a b
aconst :: forall b a. b -> Process a b
aconst b
b = (a -> ()) -> (() -> a -> ()) -> (() -> b) -> Process a b
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process (() -> a -> ()
forall a b. a -> b -> a
const ()) (\()
_ a
_ -> ()) (b -> () -> b
forall a b. a -> b -> a
const b
b)

-- | most recent value
last :: Process a a
last :: forall a. Process a a
last = (a -> a) -> (a -> a -> a) -> (a -> a) -> Process a a
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process a -> a
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id (\a
_ a
a -> a
a) a -> a
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id

-- | most recent value if it exists, previous value otherwise.
maybeLast :: a -> Process (Maybe a) a
maybeLast :: forall a. a -> Process (Maybe a) a
maybeLast a
def = (Maybe a -> a)
-> (a -> Maybe a -> a) -> (a -> a) -> Process (Maybe a) a
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def) a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a -> a
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id

-- | delay input values by 1
delay1 :: a -> Process a a
delay1 :: forall a. a -> Process a a
delay1 a
x0 = (a -> (a, a))
-> ((a, a) -> a -> (a, a)) -> ((a, a) -> a) -> Process a a
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process (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 (parWith (,) id (delay [0]) >>> beta (ma 0.99)) xs0
delay ::
  -- | initial statistical values, delay equals length
  [a] ->
  Process a a
delay :: forall a. [a] -> Process a a
delay [a]
x0 = (a -> Seq a)
-> (Seq a -> a -> Seq a) -> (Seq a -> a) -> Process a a
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process 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 :: forall a. Seq a -> a
extract Seq a
Seq.Empty = ProcessStatsError -> a
forall a e. (HasCallStack, Exception e) => e -> a
throw (Text -> ProcessStatsError
ProcessStatsError Text
"empty seq")
    extract (a
x Seq.:<| Seq a
_) = a
x
    step :: Seq a -> a -> Seq a
    step :: forall a. Seq a -> a -> Seq a
step Seq a
Seq.Empty a
_ = ProcessStatsError -> Seq a
forall a e. (HasCallStack, Exception e) => e -> a
throw (Text -> ProcessStatsError
ProcessStatsError Text
"empty seq")
    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

-- | a moving window of a's, most recent at the front of the sequence
window :: Int -> Process a (Seq.Seq a)
window :: forall a. Int -> Process a (Seq a)
window Int
n = (a -> Seq a)
-> (Seq a -> a -> Seq a) -> (Seq a -> Seq a) -> Process a (Seq a)
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process a -> Seq a
forall a. a -> Seq a
Seq.singleton (\Seq a
xs a
x -> Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.take Int
n (a
x a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Seq.<| Seq a
xs)) Seq a -> Seq a
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id
{-# INLINEABLE window #-}

-- | binomial operator applied to last and this value
diff :: (a -> a -> b) -> Process a b
diff :: forall a b. (a -> a -> b) -> Process a b
diff a -> a -> b
f = (a -> (a, a))
-> ((a, a) -> a -> (a, a)) -> ((a, a) -> b) -> Process a b
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process (\a
a -> (a
a, a
forall a. HasCallStack => a
undefined)) (\(a
_, a
prev) a
a -> (a
a, a
prev)) (\(a
curr, a
prev) -> a -> a -> b
f a
curr a
prev)

-- | generalised diff function.
gdiff :: (a -> b) -> (a -> a -> b) -> Process a b
gdiff :: forall a b. (a -> b) -> (a -> a -> b) -> Process a b
gdiff a -> b
d0 a -> a -> b
d = (a -> (b, a))
-> ((b, a) -> a -> (b, a)) -> ((b, a) -> b) -> Process a b
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process (\a
a -> (a -> b
d0 a
a, a
a)) (\(b
_, a
a') a
a -> (a -> a -> b
d a
a a
a', a
a)) (b, a) -> b
forall a b. (a, b) -> a
fst

-- | Unchanged since last time.
same :: (Eq b) => (a -> b) -> Process a Bool
same :: forall b a. Eq b => (a -> b) -> Process a Bool
same a -> b
b = (a -> (Bool, b))
-> ((Bool, b) -> a -> (Bool, b))
-> ((Bool, b) -> Bool)
-> Process a Bool
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process (\a
a -> (Bool
True, a -> b
b a
a)) (\(Bool
s, b
x) a
a -> (Bool
s Bool -> Bool -> Bool
&& a -> b
b a
a b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
x, b
x)) (Bool, b) -> Bool
forall a b. (a, b) -> a
fst

-- | Count observed values
countM :: (Ord a) => Process a (Map.Map a Int)
countM :: forall a. Ord a => Process a (Map a Int)
countM = (a -> Map a Int)
-> (Map a Int -> a -> Map a Int)
-> (Map a Int -> Map a Int)
-> Process a (Map a Int)
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process (a -> Int -> Map a Int
forall k a. k -> a -> Map k a
`Map.singleton` Int
1) (\Map a Int
m a
k -> (Int -> Int -> Int) -> a -> Int -> Map a Int -> Map a Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Additive a => a -> a -> a
(+) a
k Int
1 Map a Int
m) Map a Int -> Map a Int
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id

-- | Sum values of a key-value pair.
sumM :: (Ord a, Additive b) => Process (a, b) (Map.Map a b)
sumM :: forall a b. (Ord a, Additive b) => Process (a, b) (Map a b)
sumM = ((a, b) -> Map a b)
-> (Map a b -> (a, b) -> Map a b)
-> (Map a b -> Map a b)
-> Process (a, b) (Map a b)
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process ((a -> b -> Map a b) -> (a, b) -> Map a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> Map a b
forall k a. k -> a -> Map k a
Map.singleton) (\Map a b
m (a
k, b
v) -> (b -> b -> b) -> a -> b -> Map a b -> Map a b
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith b -> b -> b
forall a. Additive a => a -> a -> a
(+) a
k b
v Map a b
m) Map a b -> Map a b
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id

-- | Convert a Process to a Process operating on lists.
listify :: Process a b -> Process [a] [b]
listify :: forall a b. Process a b -> Process [a] [b]
listify (Process a -> s
sExtract s -> a -> s
sStep s -> b
sInject) = ([a] -> [s])
-> ([s] -> [a] -> [s]) -> ([s] -> [b]) -> Process [a] [b]
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process [a] -> [s]
extract [s] -> [a] -> [s]
step [s] -> [b]
inject
  where
    extract :: [a] -> [s]
extract = (a -> s) -> [a] -> [s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> s
sExtract
    step :: [s] -> [a] -> [s]
step = (s -> a -> s) -> [s] -> [a] -> [s]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith s -> a -> s
sStep
    inject :: [s] -> [b]
inject = (s -> b) -> [s] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> b
sInject

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

-- | onlineL1' takes a function and turns it into a `Process` where the step is an incremental update of an (isomorphic) median statistic.
onlineL1 ::
  (Ord b, Field b, Absolute b) => b -> b -> (a -> b) -> (b -> b) -> Process a b
onlineL1 :: forall b a.
(Ord b, Field b, Absolute b) =>
b -> b -> (a -> b) -> (b -> b) -> Process a 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)
-> Process a b
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process a -> Medianer b b
inject Medianer b b -> a -> Medianer b b
step Medianer b b -> b
forall a b. Medianer a b -> a
extract
  where
    inject :: a -> Medianer b b
inject a
a = let s :: b
s = b -> b
forall a. Absolute 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. Absolute 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 a b -> a
extract (Medianer a
_ b
_ a
m) = a
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 #-}

-- | moving median
maL1 :: (Ord a, Field a, Absolute a) => a -> a -> a -> Process a a
maL1 :: forall a.
(Ord a, Field a, Absolute a) =>
a -> a -> a -> Process a a
maL1 a
i a
d a
r = a -> a -> (a -> a) -> (a -> a) -> Process a a
forall b a.
(Ord b, Field b, Absolute b) =>
b -> b -> (a -> b) -> (b -> b) -> Process a b
onlineL1 a
i a
d a -> a
forall a. a -> a
forall k (arr :: k -> k -> *) (a :: k). Category arr => arr a a
id (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE maL1 #-}