{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# 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-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.
(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.
(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.
(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] -> ShowScshowList :: [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 -> Boolc/= :: 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.
--
-- >>> 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 #-}