{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
module Data.Mealy
(
Mealy (..),
dipure,
pattern M,
scan,
fold,
Averager (..),
pattern A,
av,
av_,
online,
ma,
absma,
sqma,
std,
cov,
corrGauss,
corr,
beta1,
alpha1,
reg1,
beta,
alpha,
reg,
asum,
aconst,
last,
maybeLast,
delay1,
delay,
window,
Medianer (..),
onlineL1,
maL1,
)
where
import Control.Category
import Control.Exception
import Data.Functor.Rep
import Data.List (scanl')
import Data.Profunctor
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import Data.Typeable (Typeable)
import GHC.TypeLits
import NumHask.Array as F
import NumHask.Prelude hiding (L1, asum, fold, id, last, (.))
newtype MealyError = MealyError {MealyError -> Text
mealyErrorMessage :: Text}
deriving (Int -> MealyError -> ShowS
[MealyError] -> ShowS
MealyError -> String
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
data Mealy a b = forall c. Mealy (a -> c) (c -> a -> c) (c -> b)
data Pair' a b = Pair' !a !b deriving (Pair' a b -> Pair' a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall a b. (Eq a, Eq b) => Pair' a b -> Pair' a b -> Bool
Eq, Pair' a b -> Pair' a b -> Bool
Pair' a b -> Pair' a b -> Ordering
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
min :: 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
max :: Pair' a b -> Pair' a b -> Pair' a b
$cmax :: forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Pair' a b
>= :: 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
$c< :: forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Bool
compare :: Pair' a b -> Pair' a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => Pair' a b -> Pair' a b -> Ordering
Ord, Int -> Pair' a b -> ShowS
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
showList :: [Pair' a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Pair' a b] -> ShowS
show :: Pair' a b -> String
$cshow :: forall a b. (Show a, Show b) => Pair' a b -> String
showsPrec :: Int -> Pair' a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Pair' a b -> ShowS
Show, ReadPrec [Pair' a b]
ReadPrec (Pair' a b)
ReadS [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]
readListPrec :: ReadPrec [Pair' a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [Pair' a b]
readPrec :: ReadPrec (Pair' a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (Pair' a b)
readList :: ReadS [Pair' a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [Pair' a b]
readsPrec :: Int -> ReadS (Pair' a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (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 = forall a b. a -> b -> Pair' a b
Pair' (a
a forall a. Semigroup a => a -> a -> a
<> a
c) (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 = forall a b. a -> b -> Pair' a b
Pair' forall a. Monoid a => a
mempty 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) = 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 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 = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy (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 =
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy
(\a
a -> 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 -> 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 = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\a
_ a
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' = 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 = 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 = 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) = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy (b -> c
z 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 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 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) = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
Mealy (b -> c
z 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 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) = 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 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)
pattern M :: (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
pattern $bM :: forall a b c. (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)
-> ((# #) -> r)
-> r
M i s e = Mealy i s e
{-# COMPLETE M #-}
dipure :: (a -> a -> a) -> Mealy a a
dipure :: forall a. (a -> a -> a) -> Mealy a a
dipure a -> a -> a
f = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id a -> a -> a
f forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
fold :: Mealy a b -> [a] -> b
fold :: forall a b. Mealy a b -> [a] -> b
fold Mealy a 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 forall a b. (a -> 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
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) = forall l. IsList l => [Item l] -> l
fromList (c -> b
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' c -> a -> c
s (a -> c
i a
x) [a]
xs)
newtype Averager a b = Averager
{ forall a b. Averager a b -> (a, b)
sumCount :: (a, b)
}
deriving (Averager a b -> Averager a b -> Bool
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
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 A :: a -> b -> Averager a b
pattern $bA :: forall a b. a -> b -> Averager a b
$mA :: forall {r} {a} {b}.
Averager a b -> (a -> b -> r) -> ((# #) -> r) -> r
A s c = Averager (s, c)
{-# COMPLETE A #-}
instance (Additive a, Additive b) => Semigroup (Averager a b) where
<> :: Averager a b -> Averager a b -> Averager a b
(<>) (A a
s b
c) (A a
s' b
c') = forall a b. a -> b -> Averager a b
A (a
s forall a. Additive a => a -> a -> a
+ a
s') (b
c forall a. Additive a => a -> a -> a
+ b
c')
instance (Additive a, Additive b) => Monoid (Averager a b) where
mempty :: Averager a b
mempty = forall a b. a -> b -> Averager a b
A forall a. Additive a => a
zero forall a. Additive a => a
zero
mappend :: Averager a b -> Averager a b -> Averager a b
mappend = forall a. Semigroup a => a -> a -> a
(<>)
av :: (Divisive a) => Averager a a -> a
av :: forall a. Divisive a => Averager a a -> a
av (A a
s a
c) = a
s forall a. Divisive a => a -> a -> a
/ a
c
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 = forall a. a -> a -> Bool -> a
bool a
def (a
s forall a. Divisive a => a -> a -> a
/ a
c) (a
c forall a. Eq a => a -> a -> Bool
== forall a. Additive a => a
zero)
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 = 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 forall a. Divisive a => Averager a a -> a
av
where
intract :: a -> Averager b b
intract a
a = forall a b. a -> b -> Averager a b
A (a -> b
f a
a) 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 forall a b. a -> b -> Averager a b
A (b -> b
g b
s forall a. Additive a => a -> a -> a
+ b
s') (b -> b
g b
c forall a. Additive a => a -> a -> a
+ b
c')
ma :: (Divisive a, Additive a) => a -> Mealy a a
ma :: forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r = forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Mealy a b
online forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE ma #-}
absma :: (Divisive a, Signed a) => a -> Mealy a a
absma :: forall a. (Divisive a, Signed a) => a -> Mealy a a
absma a
r = forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Mealy a b
online forall a. Signed a => a -> a
abs (forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE absma #-}
sqma :: (Divisive a, Additive a) => a -> Mealy a a
sqma :: forall a. (Divisive a, Additive a) => a -> Mealy a a
sqma a
r = forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Mealy a b
online (\a
x -> a
x forall a. Multiplicative a => a -> a -> a
* a
x) (forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE sqma #-}
std :: (Divisive a, ExpField a) => a -> Mealy a a
std :: forall a. (Divisive a, ExpField a) => a -> Mealy a a
std a
r = (\a
s a
ss -> forall a. ExpField a => a -> a
sqrt (a
ss forall a. Subtractive a => a -> a -> a
- a
s forall a. ExpField a => a -> a -> a
** (forall a. Multiplicative a => a
one forall a. Additive a => a -> a -> a
+ forall a. Multiplicative a => a
one))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Divisive a, Additive a) => a -> Mealy a a
sqma a
r
{-# INLINEABLE std #-}
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 forall a. Subtractive a => a -> a -> a
- a
x' forall a. Multiplicative a => a -> a -> a
* a
y') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Multiplicative a => a -> a -> a
(*)) Mealy a a
m forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> a
fst Mealy a a
m forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> b
snd Mealy a a
m
{-# INLINEABLE cov #-}
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' forall a. Divisive a => a -> a -> a
/ (a
stdx forall a. Multiplicative a => a -> a -> a
* a
stdy))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Field a => Mealy a a -> Mealy (a, a) a
cov (forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> a
fst (forall a. (Divisive a, ExpField a) => a -> Mealy a a
std a
r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> b
snd (forall a. (Divisive a, ExpField a) => a -> Mealy a a
std a
r)
{-# INLINEABLE corrGauss #-}
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' forall a. Divisive a => a -> a -> a
/ (a
stdx forall a. Multiplicative a => a -> a -> a
* a
stdy))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Field a => Mealy a a -> Mealy (a, a) a
cov Mealy a a
central
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> a
fst Mealy a a
deviation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> b
snd Mealy a a
deviation
{-# INLINEABLE corr #-}
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 forall a. Subtractive a => a -> a -> a
- a
x' forall a. Multiplicative a => a -> a -> a
* a
y') forall a. Divisive a => a -> a -> a
/ (a
x2 forall a. Subtractive a => a -> a -> a
- a
x' forall a. Multiplicative a => a -> a -> a
* a
x'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Multiplicative a => a -> a -> a
(*)) Mealy a a
m
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> a
fst Mealy a a
m
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> b
snd Mealy a a
m
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (\(a
x, a
_) -> a
x forall a. Multiplicative a => a -> a -> a
* a
x) Mealy a a
m
{-# INLINEABLE beta1 #-}
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 forall a. Subtractive a => a -> a -> a
- a
b forall a. Multiplicative a => a -> a -> a
* a
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> a
fst Mealy a a
m forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ExpField a => Mealy a a -> Mealy (a, a) a
beta1 Mealy a a
m forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> b
snd Mealy a a
m
{-# INLINEABLE alpha1 #-}
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 = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ExpField a => Mealy a a -> Mealy (a, a) a
alpha1 Mealy a a
m forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 (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
<$ :: forall a b. a -> RegressionState n b -> RegressionState n a
$c<$ :: forall (n :: Nat) a b.
a -> RegressionState n b -> RegressionState n a
fmap :: forall a b. (a -> b) -> RegressionState n a -> RegressionState n b
$cfmap :: forall (n :: Nat) a b.
(a -> b) -> RegressionState n a -> RegressionState n b
Functor)
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 = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M 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 forall {n :: Nat} {a}.
(KnownNat n, Eq a, ExpField a) =>
Averager (RegressionState n a) a -> Array '[n] a
extract
where
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 -> forall a. Divisive a => a -> a
recip Array '[n, n] a
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)
((forall a. Multiplicative a => a
one forall a. Divisive a => a -> a -> a
/ a
c) forall m a. MultiplicativeAction m a => a -> m -> m
.* (Array '[n, n] a
xx forall a. Subtractive a => a -> a -> 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 forall a. Multiplicative a => a -> a -> a
(*) Array '[n] a
x Array '[n] a
x))
((Array '[n] a
xy forall a. Subtractive a => a -> a -> a
- (a
y forall m a. MultiplicativeAction m a => a -> m -> m
.* Array '[n] a
x)) forall m a. MultiplicativeAction m a => m -> a -> m
*. (forall a. Multiplicative a => a
one 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) = 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 (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 :: (Array '[n] a, a) -> Averager (RegressionState n a) b
inject (Array '[n] a
xs, a
y) =
forall a b. a -> b -> Averager a b
A (forall (n :: Nat) a.
Array '[n, n] a
-> Array '[n] a -> Array '[n] a -> a -> RegressionState n a
RegressionState (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 forall a. Multiplicative a => a -> a -> a
(*) Array '[n] a
xs Array '[n] a
xs) Array '[n] a
xs (a
y forall m a. MultiplicativeAction m a => a -> m -> m
.* Array '[n] a
xs) a
y) 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') =
forall a b. a -> b -> Averager a b
A (forall (n :: Nat) a.
Array '[n, n] a
-> Array '[n] a -> Array '[n] a -> a -> RegressionState n a
RegressionState (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') (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') (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 forall a. Multiplicative a => a -> a -> a
* a
s forall a. Additive a => a -> a -> a
+ a
s'
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 forall a. Subtractive a => a -> a -> a
- forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum (forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 forall a. Multiplicative a => a -> a -> a
(*) Array '[n] a
b Array '[n] a
xs)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> a
fst (forall (s :: [Nat]) a b.
HasShape s =>
Mealy a b -> Mealy (Array s a) (Array s b)
arrayify forall a b. (a -> b) -> a -> b
$ forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (n :: Nat).
(ExpField a, KnownNat n, Eq a) =>
a -> Mealy (Array '[n] a, a) (Array '[n] a)
beta a
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a b. (a, b) -> b
snd (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) = 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 = 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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> b
sInject
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 = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (n :: Nat).
(ExpField a, KnownNat n, Eq a) =>
a -> Mealy (Array '[n] a, a) (Array '[n] a)
beta a
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (n :: Nat).
(ExpField a, KnownNat n, Eq a) =>
a -> Mealy (Array '[n] a, a) a
alpha a
r
{-# INLINEABLE reg #-}
asum :: (Additive a) => Mealy a a
asum :: forall a. Additive a => Mealy a a
asum = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall a. Additive a => a -> a -> a
(+) forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
aconst :: b -> Mealy a b
aconst :: forall b a. b -> Mealy a b
aconst b
b = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M (forall a b. a -> b -> a
const ()) (\()
_ a
_ -> ()) (forall a b. a -> b -> a
const b
b)
last :: Mealy a a
last :: forall a. Mealy a a
last = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\a
_ a
a -> a
a) forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
maybeLast :: a -> Mealy (Maybe a) a
maybeLast :: forall a. a -> Mealy (Maybe a) a
maybeLast a
def = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M (forall a. a -> Maybe a -> a
fromMaybe a
def) forall a. a -> Maybe a -> a
fromMaybe forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
delay1 :: a -> Mealy a a
delay1 :: forall a. a -> Mealy a a
delay1 a
x0 = 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)) forall a b. (a, b) -> a
fst
delay ::
[a] ->
Mealy a a
delay :: forall a. [a] -> Mealy a a
delay [a]
x0 = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> Seq a
inject forall a. Seq a -> a -> Seq a
step forall a. Seq a -> a
extract
where
inject :: a -> Seq a
inject a
a = forall a. [a] -> Seq a
Seq.fromList [a]
x0 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 = 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
_ = 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 forall a. Seq a -> a -> Seq a
Seq.|> a
a
window :: Int -> Mealy a (Seq.Seq a)
window :: forall a. Int -> Mealy a (Seq a)
window Int
n = forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M forall a. a -> Seq a
Seq.singleton (\Seq a
xs a
x -> forall a. Int -> Seq a -> Seq a
Seq.take Int
n (a
x forall a. a -> Seq a -> Seq a
Seq.<| Seq a
xs)) forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# INLINEABLE window #-}
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 ::
(Ord b, Field b, Signed b) => b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 :: forall b a.
(Ord b, Field b, Signed b) =>
b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 b
i b
d a -> b
f b -> b
g = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall {b}. Divisive b => Medianer b b -> (b, b)
extract
where
inject :: a -> Medianer b b
inject a
a = let s :: b
s = forall a. Signed a => a -> a
abs (a -> b
f a
a) in forall a b. a -> b -> a -> Medianer a b
Medianer b
s forall a. Multiplicative a => a
one (b
i 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 =
forall a b. a -> b -> a -> Medianer a b
Medianer
(b -> b
g forall a b. (a -> b) -> a -> b
$ b
s forall a. Additive a => a -> a -> a
+ forall a. Signed a => a -> a
abs (a -> b
f a
a))
(b -> b
g forall a b. (a -> b) -> a -> b
$ b
c forall a. Additive a => a -> a -> a
+ forall a. Multiplicative a => a
one)
((forall a. Multiplicative a => a
one forall a. Subtractive a => a -> a -> a
- b
d) forall a. Multiplicative a => a -> a -> a
* (b
m forall a. Additive a => a -> a -> a
+ a -> b -> b
sign' a
a b
m forall a. Multiplicative a => a -> a -> a
* b
i forall a. Multiplicative a => a -> a -> a
* b
s forall a. Divisive a => a -> a -> a
/ b
c') forall a. Additive a => a -> a -> a
+ b
d forall a. Multiplicative a => a -> a -> a
* a -> b
f a
a)
where
c' :: b
c' =
if b
c forall a. Eq a => a -> a -> Bool
== forall a. Additive a => a
zero
then 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 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 forall a. Ord a => a -> a -> Bool
> b
m = forall a. Multiplicative a => a
one
| a -> b
f a
a forall a. Ord a => a -> a -> Bool
< b
m = forall a. Subtractive a => a -> a
negate forall a. Multiplicative a => a
one
| Bool
otherwise = forall a. Additive a => a
zero
{-# INLINEABLE onlineL1 #-}
maL1 :: (Ord a, Field a, Signed a) => a -> a -> a -> Mealy a a
maL1 :: forall a. (Ord a, Field a, Signed a) => a -> a -> a -> Mealy a a
maL1 a
i a
d a
r = forall b a.
(Ord b, Field b, Signed b) =>
b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 a
i a
d forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE maL1 #-}