{-# 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
    -- $example-set
    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.Category
import Control.Exception
import Control.Lens hiding (Empty, Unwrapped, Wrapped, index, (:>), (|>))
import Data.Fold hiding (M)
import Data.Functor.Rep
import Data.Generics.Labels ()
import Data.List (scanl')
import qualified Data.Matrix as M
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import Data.Typeable (Typeable)
import GHC.TypeLits
import qualified NumHask.Array.Fixed as F
import NumHask.Array.Shape (HasShape)
import NumHask.Prelude hiding (L1, asum, fold, id, (.))

-- $setup
--
-- >>> :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

-- $example-set
-- The doctest examples are composed from some random series generated with Data.Mealy.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.Mealy.Simulate
-- >>> g <- create
-- >>> xs0 <- rvs g 10000
-- >>> xs1 <- rvs g 10000
-- >>> xs2 <- rvs g 10000
-- >>> xsp <- rvsp g 10000 0.8

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

instance Exception MealyError

-- | 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
_ [] = MealyError -> b
forall a e. Exception e => e -> a
throw (Text -> MealyError
MealyError Text
"empty list")
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 (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)
--
-- Applicative-style exponentially-weighted standard deviation computation:
--
-- > std r = (\s ss -> sqrt (ss - s ** 2)) <$> ma r <*> sqma r
--
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) ([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 -> 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.8075705557429647
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
-- 1.0126438036262801
--
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.7818936662586868
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.7978347126677433
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.7978347126677433
--
-- > 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.999747321294513
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.3680496627365146e-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.3680496627365146e-2,0.4997473212944953)
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 = MealyError -> a
forall a e. Exception e => e -> a
throw (Text -> MealyError
MealyError Text
"empty seq")
    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
_ = MealyError -> Seq a
forall a e. Exception e => e -> a
throw (Text -> MealyError
MealyError 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

-- | 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
-- 0.10000000000000009
--
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)

-- | zeroised Model1
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
-- >>> import Control.Lens
-- >>> fold (depModel1 0.01 (zeroModel1 & #betaMa2X .~ 0.1)) xs0
-- -0.4591515493154126
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 #-}