{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | 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 (..),
    dipure,
    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,
    last,
    maybeLast,
    delay1,
    delay,
    window,
    diff,
    gdiff,
    same,
    countM,
    sumM,
    listify,

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

import Control.Category
import Control.Exception
import Data.Bifunctor
import Data.Functor.Rep
import Data.List (scanl')
import Data.Map qualified as Map
import Data.Profunctor
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (Text)
import Data.Typeable (Typeable)
import GHC.TypeLits
import NumHask.Array as F
import NumHask.Prelude hiding (asum, diff, fold, id, last, (.))

-- $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
$cshowsPrec :: Int -> MealyError -> ShowS
showsPrec :: Int -> MealyError -> ShowS
$cshow :: MealyError -> String
show :: MealyError -> String
$cshowList :: [MealyError] -> ShowS
showList :: [MealyError] -> ShowS
Show, Typeable)

instance Exception MealyError

-- | A 'Mealy' a b is a triple of functions
--
-- * (a -> s) __inject__ Convert an input into the state type.
-- * (s -> a -> s) __step__ Update state given prior state and (new) input.
-- * (s -> 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 covariant extraction.
--
-- __inject__ kicks off state on the initial element of the Foldable, but is otherwise  independent of __step__.
--
-- > scan (M i s e) (x : xs) = e <$> scanl' s (i x) xs
data Mealy a b = forall c. Mealy (a -> c) (c -> a -> c) (c -> b)

-- | Strict Pair
data Pair' a b = Pair' !a !b deriving (Pair' a b -> Pair' a b -> Bool
(Pair' a b -> Pair' a b -> Bool)
-> (Pair' a b -> Pair' a b -> Bool) -> Eq (Pair' a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Pair' a b -> Pair' a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Pair' a b -> Pair' a b -> Bool
== :: Pair' a b -> Pair' a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Pair' a b -> Pair' a b -> Bool
/= :: Pair' a b -> Pair' a b -> Bool
Eq, Eq (Pair' a b)
Eq (Pair' a b) =>
(Pair' a b -> Pair' a b -> Ordering)
-> (Pair' a b -> Pair' a b -> Bool)
-> (Pair' a b -> Pair' a b -> Bool)
-> (Pair' a b -> Pair' a b -> Bool)
-> (Pair' a b -> Pair' a b -> Bool)
-> (Pair' a b -> Pair' a b -> Pair' a b)
-> (Pair' a b -> Pair' a b -> Pair' a b)
-> Ord (Pair' a b)
Pair' a b -> Pair' a b -> Bool
Pair' a b -> Pair' a b -> Ordering
Pair' a b -> Pair' a b -> Pair' a b
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (Pair' a b)
forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Bool
forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Ordering
forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Pair' a b
$ccompare :: forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Ordering
compare :: Pair' a b -> Pair' a b -> Ordering
$c< :: forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Bool
< :: Pair' a b -> Pair' a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Bool
<= :: Pair' a b -> Pair' a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Bool
> :: Pair' a b -> Pair' a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Bool
>= :: Pair' a b -> Pair' a b -> Bool
$cmax :: forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Pair' a b
max :: Pair' a b -> Pair' a b -> Pair' a b
$cmin :: forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Pair' a b
min :: Pair' a b -> Pair' a b -> Pair' a b
Ord, Int -> Pair' a b -> ShowS
[Pair' a b] -> ShowS
Pair' a b -> String
(Int -> Pair' a b -> ShowS)
-> (Pair' a b -> String)
-> ([Pair' a b] -> ShowS)
-> Show (Pair' a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Pair' a b -> ShowS
forall a b. (Show a, Show b) => [Pair' a b] -> ShowS
forall a b. (Show a, Show b) => Pair' a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Pair' a b -> ShowS
showsPrec :: Int -> Pair' a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => Pair' a b -> String
show :: Pair' a b -> String
$cshowList :: forall a b. (Show a, Show b) => [Pair' a b] -> ShowS
showList :: [Pair' a b] -> ShowS
Show, ReadPrec [Pair' a b]
ReadPrec (Pair' a b)
Int -> ReadS (Pair' a b)
ReadS [Pair' a b]
(Int -> ReadS (Pair' a b))
-> ReadS [Pair' a b]
-> ReadPrec (Pair' a b)
-> ReadPrec [Pair' a b]
-> Read (Pair' a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [Pair' a b]
forall a b. (Read a, Read b) => ReadPrec (Pair' a b)
forall a b. (Read a, Read b) => Int -> ReadS (Pair' a b)
forall a b. (Read a, Read b) => ReadS [Pair' a b]
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (Pair' a b)
readsPrec :: Int -> ReadS (Pair' a b)
$creadList :: forall a b. (Read a, Read b) => ReadS [Pair' a b]
readList :: ReadS [Pair' a b]
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (Pair' a b)
readPrec :: ReadPrec (Pair' a b)
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [Pair' a b]
readListPrec :: ReadPrec [Pair' a b]
Read)

instance (Semigroup a, Semigroup b) => Semigroup (Pair' a b) where
  Pair' a
a b
b <> :: Pair' a b -> Pair' a b -> Pair' a b
<> Pair' a
c b
d = a -> b -> Pair' a b
forall a b. a -> b -> Pair' a b
Pair' (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
c) (b
b b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
d)
  {-# INLINE (<>) #-}

instance (Monoid a, Monoid b) => Monoid (Pair' a b) where
  mempty :: Pair' a b
mempty = a -> b -> Pair' a b
forall a b. a -> b -> Pair' a b
Pair' a
forall a. Monoid a => a
mempty b
forall a. Monoid a => a
mempty

instance Functor (Mealy a) where
  fmap :: forall a b. (a -> b) -> Mealy a a -> Mealy a b
fmap a -> b
f (Mealy a -> c
z c -> a -> c
h c -> a
k) = (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy a -> c
z c -> a -> c
h (a -> b
f (a -> b) -> (c -> a) -> c -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> a
k)

instance Applicative (Mealy a) where
  pure :: forall a. a -> Mealy a a
pure a
x = (a -> ()) -> (() -> a -> ()) -> (() -> a) -> Mealy a a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy (() -> a -> ()
forall a b. a -> b -> a
const ()) (\() a
_ -> ()) (\() -> a
x)
  Mealy a -> c
zf c -> a -> c
hf c -> a -> b
kf <*> :: forall a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
<*> Mealy a -> c
za c -> a -> c
ha c -> a
ka =
    (a -> Pair' c c)
-> (Pair' c c -> a -> Pair' c c) -> (Pair' c c -> b) -> Mealy a b
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy
      (\a
a -> c -> c -> Pair' c c
forall a b. a -> b -> Pair' a b
Pair' (a -> c
zf a
a) (a -> c
za a
a))
      (\(Pair' c
x c
y) a
a -> c -> c -> Pair' c c
forall a b. a -> b -> Pair' a b
Pair' (c -> a -> c
hf c
x a
a) (c -> a -> c
ha c
y a
a))
      (\(Pair' c
x c
y) -> c -> a -> b
kf c
x (c -> a
ka c
y))

instance Category Mealy where
  id :: forall a. Mealy a a
id = (a -> a) -> (a -> a -> a) -> (a -> a) -> Mealy a a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\a
_ a
a -> a
a) a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  Mealy b -> c
z c -> b -> c
h c -> c
k . :: forall b c a. Mealy b c -> Mealy a b -> Mealy a c
. Mealy a -> c
z' c -> a -> c
h' c -> b
k' = (a -> Pair' c c)
-> (Pair' c c -> a -> Pair' c c) -> (Pair' c c -> c) -> Mealy a c
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy a -> Pair' c c
z'' Pair' c c -> a -> Pair' c c
h'' (\(Pair' c
b c
_) -> c -> c
k c
b)
    where
      z'' :: a -> Pair' c c
z'' a
a = c -> c -> Pair' c c
forall a b. a -> b -> Pair' a b
Pair' (b -> c
z (c -> b
k' c
b)) c
b where b :: c
b = a -> c
z' a
a
      h'' :: Pair' c c -> a -> Pair' c c
h'' (Pair' c
c c
d) a
a = c -> c -> Pair' c c
forall a b. a -> b -> Pair' a b
Pair' (c -> b -> c
h c
c (c -> b
k' c
d')) c
d' where d' :: c
d' = c -> a -> c
h' c
d a
a

instance Profunctor Mealy where
  dimap :: forall a b c d. (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d
dimap a -> b
f c -> d
g (Mealy b -> c
z c -> b -> c
h c -> c
k) = (a -> c) -> (c -> a -> c) -> (c -> d) -> Mealy a d
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy (b -> c
z (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f) (\c
a -> c -> b -> c
h c
a (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f) (c -> d
g (c -> d) -> (c -> c) -> c -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> c
k)
  lmap :: forall a b c. (a -> b) -> Mealy b c -> Mealy a c
lmap a -> b
f (Mealy b -> c
z c -> b -> c
h c -> c
k) = (a -> c) -> (c -> a -> c) -> (c -> c) -> Mealy a c
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy (b -> c
z (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f) (\c
a -> c -> b -> c
h c
a (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f) c -> c
k
  rmap :: forall b c a. (b -> c) -> Mealy a b -> Mealy a c
rmap b -> c
g (Mealy a -> c
z c -> a -> c
h c -> b
k) = (a -> c) -> (c -> a -> c) -> (c -> c) -> Mealy a c
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy a -> c
z c -> a -> c
h (b -> c
g (b -> c) -> (c -> b) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> b
k)

instance Strong Mealy where
  first' :: forall a b c. Mealy a b -> Mealy (a, c) (b, c)
first' (M a -> c
i c -> a -> c
s c -> b
e) = ((a, c) -> (c, c))
-> ((c, c) -> (a, c) -> (c, c))
-> ((c, c) -> (b, c))
-> Mealy (a, c) (b, c)
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M ((a -> c) -> (a, c) -> (c, c)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> c
i) (\(c
cl, c
_) (a
al, c
ar) -> (c -> a -> c
s c
cl a
al, c
ar)) ((c -> b) -> (c, c) -> (b, c)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first c -> b
e)

-- The right type for Choice would be something like:
--
-- left' :: p a b -> p (Either a c) (These b c)

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

{-# COMPLETE M #-}

-- | Create a Mealy from a (pure) function
dipure :: (a -> a -> a) -> Mealy a a
dipure :: forall a. (a -> a -> a) -> Mealy a a
dipure a -> a -> a
f = (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 a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id a -> a -> a
f a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | Fold a list through a 'Mealy'.
--
-- > cosieve == fold
fold :: Mealy a b -> [a] -> b
fold :: forall a b. 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 b a. (b -> a -> b) -> b -> [a] -> b
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 :: forall a b. 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
  { forall a b. Averager a b -> (a, b)
sumCount :: (a, b)
  }
  deriving (Averager a b -> Averager a b -> Bool
(Averager a b -> Averager a b -> Bool)
-> (Averager a b -> Averager a b -> Bool) -> Eq (Averager a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Averager a b -> Averager a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Averager a b -> Averager a b -> Bool
== :: Averager a b -> Averager a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Averager a b -> Averager a b -> Bool
/= :: Averager a b -> Averager a b -> Bool
Eq, Int -> Averager a b -> ShowS
[Averager a b] -> ShowS
Averager a b -> String
(Int -> Averager a b -> ShowS)
-> (Averager a b -> String)
-> ([Averager a b] -> ShowS)
-> Show (Averager a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Averager a b -> ShowS
forall a b. (Show a, Show b) => [Averager a b] -> ShowS
forall a b. (Show a, Show b) => Averager a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Averager a b -> ShowS
showsPrec :: Int -> Averager a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => Averager a b -> String
show :: Averager a b -> String
$cshowList :: forall a b. (Show a, Show b) => [Averager a b] -> ShowS
showList :: [Averager a b] -> ShowS
Show)

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

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

-- | @online f g@ is a '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 :: forall b a.
(Divisive b, Additive b) =>
(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 :: forall a. (Divisive a, Additive a) => 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 a. 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, Absolute a) => a -> Mealy a a
absma :: forall a. (Divisive a, Absolute a) => 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. Absolute a => a -> a
abs (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE absma #-}

-- | average square
--
-- > fold (ma r) . fmap (**2) == fold (sqma r)
sqma :: (Divisive a, Additive a) => a -> Mealy a a
sqma :: forall a. (Divisive a, Additive a) => 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 :: (ExpField a) => a -> Mealy a a
std :: forall a. ExpField a => 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 a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
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 :: forall a. Field a => 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 a b c. (a -> b) -> Mealy b c -> Mealy a c
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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
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 :: forall a. ExpField a => 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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
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. ExpField a => a -> Mealy a a
std a
r)
    Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
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. 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 :: forall a. ExpField a => 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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
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 :: forall a. ExpField a => 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 a b c. (a -> b) -> Mealy b c -> Mealy a c
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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
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 :: forall a. ExpField a => 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 a b c. (a -> b) -> Mealy b c -> Mealy a c
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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
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 :: forall a. ExpField a => 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 a b.
Mealy (a, a) (a -> b) -> Mealy (a, a) a -> Mealy (a, a) b
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
  { forall (n :: Nat) a. RegressionState n a -> Array '[n, n] a
_xx :: F.Array '[n, n] a,
    forall (n :: Nat) a. RegressionState n a -> Array '[n] a
_x :: F.Array '[n] a,
    forall (n :: Nat) a. RegressionState n a -> Array '[n] a
_xy :: F.Array '[n] a,
    forall (n :: Nat) a. RegressionState n a -> a
_y :: a
  }
  deriving ((forall a b.
 (a -> b) -> RegressionState n a -> RegressionState n b)
-> (forall a b. a -> RegressionState n b -> RegressionState n a)
-> Functor (RegressionState n)
forall (n :: Nat) a b.
a -> RegressionState n b -> RegressionState n a
forall (n :: Nat) a b.
(a -> b) -> RegressionState n a -> RegressionState n b
forall a b. a -> RegressionState n b -> RegressionState n a
forall a b. (a -> b) -> RegressionState n a -> RegressionState n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (n :: Nat) a b.
(a -> b) -> RegressionState n a -> RegressionState n b
fmap :: forall a b. (a -> b) -> RegressionState n a -> RegressionState n b
$c<$ :: forall (n :: Nat) a b.
a -> RegressionState n b -> RegressionState n a
<$ :: forall a b. a -> RegressionState n b -> RegressionState n a
Functor)

-- | multiple regression
--
-- \[
-- \begin{align}
-- {\hat  {{\mathbf  {B}}}}=({\mathbf  {X}}^{{{\rm {T}}}}{\mathbf  {X}})^{{ -1}}{\mathbf  {X}}^{{{\rm {T}}}}{\mathbf  {Y}}
-- \end{align}
-- \]
--
-- \[
-- \begin{align}
-- {\mathbf  {X}}={\begin{bmatrix}{\mathbf  {x}}_{1}^{{{\rm {T}}}}\\{\mathbf  {x}}_{2}^{{{\rm {T}}}}\\\vdots \\{\mathbf  {x}}_{n}^{{{\rm {T}}}}\end{bmatrix}}={\begin{bmatrix}x_{{1,1}}&\cdots &x_{{1,k}}\\x_{{2,1}}&\cdots &x_{{2,k}}\\\vdots &\ddots &\vdots \\x_{{n,1}}&\cdots &x_{{n,k}}\end{bmatrix}}
-- \end{align}
-- \]
--
-- > let ys = zipWith3 (\x y z -> 0.1 * x + 0.5 * y + 1 * z) xs0 xs1 xs2
-- > let zs = zip (zipWith (\x y -> fromList [x,y] :: F.Array '[2] Double) xs1 xs2) ys
-- > fold (beta 0.99) zs
-- [0.4982692361226971, 1.038192474255091]
beta :: (ExpField a, KnownNat n, Eq a) => a -> Mealy (F.Array '[n] a, a) (F.Array '[n] a)
beta :: forall a (n :: Nat).
(ExpField a, KnownNat n, Eq a) =>
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 {a} {n :: Nat}.
(KnownNat n, Eq a, ExpField 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 a. Divisive a => a -> a
recip 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) Scalar (Array '[n, n] a) -> Array '[n, n] a -> Array '[n, n] a
forall m. MultiplicativeAction m => Scalar m -> 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
Scalar (Array '[n] a)
y Scalar (Array '[n] a) -> Array '[n] a -> Array '[n] a
forall m. MultiplicativeAction m => Scalar m -> m -> m
*| Array '[n] a
x)) Array '[n] a -> Scalar (Array '[n] a) -> Array '[n] a
forall m. MultiplicativeAction m => m -> Scalar m -> 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
Scalar (Array '[n] a)
y Scalar (Array '[n] a) -> Array '[n] a -> Array '[n] a
forall m. MultiplicativeAction m => Scalar m -> m -> m
*| Array '[n] a
xs) a
y) b
forall a. Multiplicative a => a
one
{-# INLINEABLE beta #-}

rsOnline :: (Field a, KnownNat n) => a -> Averager (RegressionState n a) a -> Averager (RegressionState n a) a -> Averager (RegressionState n a) a
rsOnline :: forall a (n :: Nat).
(Field a, KnownNat n) =>
a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
rsOnline a
r (A (RegressionState Array '[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, Eq a) => a -> Mealy (F.Array '[n] a, a) a
alpha :: forall a (n :: Nat).
(ExpField a, KnownNat n, Eq a) =>
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 a b c. (a -> b) -> Mealy b c -> Mealy a c
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 a b.
Mealy (Array '[n] a, a) (a -> b)
-> Mealy (Array '[n] a, a) a -> Mealy (Array '[n] a, a) b
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).
(ExpField a, KnownNat n, 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 a b.
Mealy (Array '[n] a, a) (a -> b)
-> Mealy (Array '[n] a, a) a -> Mealy (Array '[n] a, a) b
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 a b c. (a -> b) -> Mealy b c -> Mealy a c
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 :: forall (s :: [Nat]) a b.
HasShape s =>
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 a b. (a -> b) -> Array s a -> Array s b
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 a b. (a -> b) -> Array s a -> 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, Eq a) => a -> Mealy (F.Array '[n] a, a) (F.Array '[n] a, a)
reg :: forall a (n :: Nat).
(ExpField a, KnownNat n, Eq a) =>
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).
(ExpField a, KnownNat n, 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 a b.
Mealy (Array '[n] a, a) (a -> b)
-> Mealy (Array '[n] a, a) a -> Mealy (Array '[n] a, a) b
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, Eq a) =>
a -> Mealy (Array '[n] a, a) a
alpha a
r
{-# INLINEABLE reg #-}

-- | accumulated sum
asum :: (Additive a) => Mealy a a
asum :: forall a. Additive a => 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 a. 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 a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | constant Mealy
aconst :: b -> Mealy a b
aconst :: forall b a. 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)

-- | most recent value
last :: Mealy a a
last :: forall a. Mealy a a
last = (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 a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\a
_ a
a -> a
a) a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | most recent value if it exists, previous value otherwise.
maybeLast :: a -> Mealy (Maybe a) a
maybeLast :: forall a. a -> Mealy (Maybe a) a
maybeLast a
def = (Maybe a -> a)
-> (a -> Maybe a -> a) -> (a -> a) -> Mealy (Maybe a) a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def) a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | delay input values by 1
delay1 :: a -> Mealy a a
delay1 :: forall a. 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 :: forall a. [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 :: forall a. 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 :: forall a. 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

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

-- | binomial operator applied to last and this value
diff :: (a -> a -> b) -> Mealy a b
diff :: forall a b. (a -> a -> b) -> Mealy a b
diff a -> a -> b
f = a -> a -> b
f (a -> a -> b) -> Mealy a a -> Mealy a (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mealy a a
forall a. Mealy a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Mealy a (a -> b) -> Mealy a a -> Mealy a b
forall a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Mealy a a
forall a. a -> Mealy a a
delay1 a
forall a. HasCallStack => a
undefined

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

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

-- | Count observed values
countM :: (Ord a) => Mealy a (Map.Map a Int)
countM :: forall a. Ord a => Mealy a (Map a Int)
countM = (a -> Map a Int)
-> (Map a Int -> a -> Map a Int)
-> (Map a Int -> Map a Int)
-> Mealy a (Map a Int)
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M (a -> Int -> Map a Int
forall k a. k -> a -> Map k a
`Map.singleton` Int
1) (\Map a Int
m a
k -> (Int -> Int -> Int) -> a -> Int -> Map a Int -> Map a Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Additive a => a -> a -> a
(+) a
k Int
1 Map a Int
m) Map a Int -> Map a Int
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

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

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

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

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

-- | moving median
-- > L.fold (maL1 inc d r) [1..n]
-- 93.92822312742108
maL1 :: (Ord a, Field a, Absolute a) => a -> a -> a -> Mealy a a
maL1 :: forall a. (Ord a, Field a, Absolute a) => 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, Absolute b) =>
b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 a
i a
d a -> a
forall a. 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 #-}