{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# 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,
asum,
aconst,
last,
maybeLast,
delay1,
delay,
Medianer (..),
onlineL1,
maL1,
window,
)
where
import Control.Category
import Control.Exception
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 NumHask.Prelude hiding (L1, asum, fold, id, last, (.))
newtype MealyError = MealyError {MealyError -> Text
mealyErrorMessage :: Text}
deriving (Int -> MealyError -> ShowS
[MealyError] -> ShowS
MealyError -> String
(Int -> MealyError -> ShowS)
-> (MealyError -> String)
-> ([MealyError] -> ShowS)
-> Show MealyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MealyError] -> ShowS
$cshowList :: [MealyError] -> ShowS
show :: MealyError -> String
$cshow :: MealyError -> String
showsPrec :: Int -> MealyError -> ShowS
$cshowsPrec :: Int -> MealyError -> ShowS
Show, Typeable)
instance Exception MealyError
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
(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
/= :: 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, 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
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
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (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
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)
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]
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 = 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 :: (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 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 :: 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 <*> :: 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 :: 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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\a
_ a
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 . :: 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 :: (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 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 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 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 :: (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 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 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 :: (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 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 :: (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
$mM :: forall r a b.
Mealy a b
-> (forall c. (a -> c) -> (c -> a -> c) -> (c -> b) -> r)
-> (Void# -> r)
-> r
M i s e = Mealy i s e
{-# COMPLETE M #-}
dipure :: (a -> a -> a) -> Mealy a a
dipure :: (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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id a -> a -> a
f a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
fold :: Mealy a b -> [a] -> b
fold :: Mealy a b -> [a] -> b
fold Mealy a b
_ [] = MealyError -> b
forall a e. Exception e => e -> a
throw (Text -> MealyError
MealyError Text
"empty list")
fold (M a -> c
i c -> a -> c
s c -> b
e) (a
x : [a]
xs) = c -> b
e (c -> b) -> c -> b
forall a b. (a -> b) -> a -> b
$ (c -> a -> c) -> c -> [a] -> c
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' c -> a -> c
s (a -> c
i a
x) [a]
xs
scan :: Mealy a b -> [a] -> [b]
scan :: Mealy a b -> [a] -> [b]
scan Mealy a b
_ [] = []
scan (M a -> c
i c -> a -> c
s c -> b
e) (a
x : [a]
xs) = [Item [b]] -> [b]
forall l. IsList l => [Item l] -> l
fromList (c -> b
e (c -> b) -> [c] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> a -> c) -> c -> [a] -> [c]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' c -> a -> c
s (a -> c
i a
x) [a]
xs)
newtype Averager a b = Averager
{ Averager a b -> (a, b)
sumCount :: (a, b)
}
deriving (Averager a b -> Averager a b -> Bool
(Averager a b -> Averager a b -> Bool)
-> (Averager a b -> Averager a b -> Bool) -> Eq (Averager a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Averager a b -> Averager a b -> Bool
/= :: Averager a b -> Averager a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Averager a b -> Averager a b -> Bool
== :: Averager a b -> Averager a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Averager a b -> Averager a b -> Bool
Eq, Int -> Averager a b -> ShowS
[Averager a b] -> ShowS
Averager a b -> String
(Int -> Averager a b -> ShowS)
-> (Averager a b -> String)
-> ([Averager a b] -> ShowS)
-> Show (Averager a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Averager a b -> ShowS
forall a b. (Show a, Show b) => [Averager a b] -> ShowS
forall a b. (Show a, Show b) => Averager a b -> String
showList :: [Averager a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Averager a b] -> ShowS
show :: Averager a b -> String
$cshow :: forall a b. (Show a, Show b) => Averager a b -> String
showsPrec :: Int -> Averager a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Averager a b -> ShowS
Show)
pattern A :: a -> b -> Averager a b
pattern $bA :: a -> b -> Averager a b
$mA :: forall r a b. Averager a b -> (a -> b -> r) -> (Void# -> r) -> r
A s c = Averager (s, c)
{-# COMPLETE A #-}
instance (Additive a, Additive b) => Semigroup (Averager a b) where
<> :: Averager a b -> Averager a b -> Averager a b
(<>) (A a
s b
c) (A a
s' b
c') = a -> b -> Averager a b
forall a b. a -> b -> Averager a b
A (a
s a -> a -> a
forall a. Additive a => a -> a -> a
+ a
s') (b
c b -> b -> b
forall a. Additive a => a -> a -> a
+ b
c')
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
(<>)
av :: (Divisive a) => Averager a a -> a
av :: Averager a a -> a
av (A a
s a
c) = a
s a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
c
av_ :: (Eq a, Additive a, Divisive a) => Averager a a -> a -> a
av_ :: Averager a a -> a -> a
av_ (A a
s a
c) a
def = a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
def (a
s a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
c) (a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Additive a => a
zero)
online :: (Divisive b, Additive b) => (a -> b) -> (b -> b) -> Mealy a b
online :: (a -> b) -> (b -> b) -> Mealy a b
online a -> b
f b -> b
g = (a -> Averager b b)
-> (Averager b b -> a -> Averager b b)
-> (Averager b b -> b)
-> Mealy a b
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> Averager b b
intract Averager b b -> a -> Averager b b
step Averager b b -> b
forall a. Divisive a => Averager a a -> a
av
where
intract :: a -> Averager b b
intract a
a = b -> b -> Averager b b
forall a b. a -> b -> Averager a b
A (a -> b
f a
a) b
forall a. Multiplicative a => a
one
step :: Averager b b -> a -> Averager b b
step (A b
s b
c) a
a =
let (A b
s' b
c') = a -> Averager b b
intract a
a
in b -> b -> Averager b b
forall a b. a -> b -> Averager a b
A (b -> b
g b
s b -> b -> b
forall a. Additive a => a -> a -> a
+ b
s') (b -> b
g b
c b -> b -> b
forall a. Additive a => a -> a -> a
+ b
c')
ma :: (Divisive a, Additive a) => a -> Mealy a a
ma :: a -> Mealy a a
ma a
r = (a -> a) -> (a -> a) -> Mealy a a
forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Mealy a b
online a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE ma #-}
absma :: (Divisive a, Signed a) => a -> Mealy a a
absma :: a -> Mealy a a
absma a
r = (a -> a) -> (a -> a) -> Mealy a a
forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Mealy a b
online a -> a
forall a. Signed a => a -> a
abs (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE absma #-}
sqma :: (Divisive a, Additive a) => a -> Mealy a a
sqma :: a -> Mealy a a
sqma a
r = (a -> a) -> (a -> a) -> Mealy a a
forall b a.
(Divisive b, Additive b) =>
(a -> b) -> (b -> b) -> Mealy a b
online (\a
x -> a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x) (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE sqma #-}
std :: (Divisive a, ExpField a) => a -> Mealy a a
std :: a -> Mealy a a
std a
r = (\a
s a
ss -> a -> a
forall a. ExpField a => a -> a
sqrt (a
ss a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
s a -> a -> a
forall a. ExpField a => a -> a -> a
** (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
forall a. Multiplicative a => a
one))) (a -> a -> a) -> Mealy a a -> Mealy a (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Mealy a a
forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r Mealy a (a -> a) -> Mealy a a -> Mealy a a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Mealy a a
forall a. (Divisive a, Additive a) => a -> Mealy a a
sqma a
r
{-# INLINEABLE std #-}
cov :: (Field a) => Mealy a a -> Mealy (a, a) a
cov :: Mealy a a -> Mealy (a, a) a
cov Mealy a a
m =
(\a
xy a
x' a
y' -> a
xy a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
x' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y') (a -> a -> a -> a) -> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*)) Mealy a a
m Mealy (a, a) (a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> a
fst Mealy a a
m Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> b
snd Mealy a a
m
{-# INLINEABLE cov #-}
corrGauss :: (ExpField a) => a -> Mealy (a, a) a
corrGauss :: a -> Mealy (a, a) a
corrGauss a
r =
(\a
cov' a
stdx a
stdy -> a
cov' a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
stdx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
stdy))
(a -> a -> a -> a) -> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mealy a a -> Mealy (a, a) a
forall a. Field a => Mealy a a -> Mealy (a, a) a
cov (a -> Mealy a a
forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r)
Mealy (a, a) (a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> a
fst (a -> Mealy a a
forall a. (Divisive a, ExpField a) => a -> Mealy a a
std a
r)
Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> b
snd (a -> Mealy a a
forall a. (Divisive a, ExpField a) => a -> Mealy a a
std a
r)
{-# INLINEABLE corrGauss #-}
corr :: (ExpField a) => Mealy a a -> Mealy a a -> Mealy (a, a) a
corr :: Mealy a a -> Mealy a a -> Mealy (a, a) a
corr Mealy a a
central Mealy a a
deviation =
(\a
cov' a
stdx a
stdy -> a
cov' a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
stdx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
stdy))
(a -> a -> a -> a) -> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mealy a a -> Mealy (a, a) a
forall a. Field a => Mealy a a -> Mealy (a, a) a
cov Mealy a a
central
Mealy (a, a) (a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> a
fst Mealy a a
deviation
Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> b
snd Mealy a a
deviation
{-# INLINEABLE corr #-}
beta1 :: (ExpField a) => Mealy a a -> Mealy (a, a) a
beta1 :: Mealy a a -> Mealy (a, a) a
beta1 Mealy a a
m =
(\a
xy a
x' a
y' a
x2 -> (a
xy a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
x' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y') a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
x2 a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
x' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x'))
(a -> a -> a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*)) Mealy a a
m
Mealy (a, a) (a -> a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> a
fst Mealy a a
m
Mealy (a, a) (a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> b
snd Mealy a a
m
Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (\(a
x, a
_) -> a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x) Mealy a a
m
{-# INLINEABLE beta1 #-}
alpha1 :: (ExpField a) => Mealy a a -> Mealy (a, a) a
alpha1 :: Mealy a a -> Mealy (a, a) a
alpha1 Mealy a a
m = (\a
x a
b a
y -> a
y a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
b a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x) (a -> a -> a -> a) -> Mealy (a, a) a -> Mealy (a, a) (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> a
fst Mealy a a
m Mealy (a, a) (a -> a -> a)
-> Mealy (a, a) a -> Mealy (a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mealy a a -> Mealy (a, a) a
forall a. ExpField a => Mealy a a -> Mealy (a, a) a
beta1 Mealy a a
m Mealy (a, a) (a -> a) -> Mealy (a, a) a -> Mealy (a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, a) -> a) -> Mealy a a -> Mealy (a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a, a) -> a
forall a b. (a, b) -> b
snd Mealy a a
m
{-# INLINEABLE alpha1 #-}
reg1 :: (ExpField a) => Mealy a a -> Mealy (a, a) (a, a)
reg1 :: Mealy a a -> Mealy (a, a) (a, a)
reg1 Mealy a a
m = (,) (a -> a -> (a, a)) -> Mealy (a, a) a -> Mealy (a, a) (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mealy a a -> Mealy (a, a) a
forall a. ExpField a => Mealy a a -> Mealy (a, a) a
alpha1 Mealy a a
m Mealy (a, a) (a -> (a, a)) -> Mealy (a, a) a -> Mealy (a, a) (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mealy a a -> Mealy (a, a) a
forall a. ExpField a => Mealy a a -> Mealy (a, a) a
beta1 Mealy a a
m
asum :: (Additive a) => Mealy a a
asum :: Mealy a a
asum = (a -> a) -> (a -> a -> a) -> (a -> a) -> Mealy a a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id a -> a -> a
forall a. Additive a => a -> a -> a
(+) a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
aconst :: b -> Mealy a b
aconst :: b -> Mealy a b
aconst b
b = (a -> ()) -> (() -> a -> ()) -> (() -> b) -> Mealy a b
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M (() -> a -> ()
forall a b. a -> b -> a
const ()) (\()
_ a
_ -> ()) (b -> () -> b
forall a b. a -> b -> a
const b
b)
last :: Mealy a a
last :: 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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\a
_ a
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 :: 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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
delay1 :: a -> Mealy a a
delay1 :: a -> Mealy a a
delay1 a
x0 = (a -> (a, a))
-> ((a, a) -> a -> (a, a)) -> ((a, a) -> a) -> Mealy a a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M (a
x0,) (\(a
_, a
x) a
a -> (a
x, a
a)) (a, a) -> a
forall a b. (a, b) -> a
fst
delay ::
[a] ->
Mealy a a
delay :: [a] -> Mealy a a
delay [a]
x0 = (a -> Seq a) -> (Seq a -> a -> Seq a) -> (Seq a -> a) -> Mealy a a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> Seq a
inject Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
step Seq a -> a
forall a. Seq a -> a
extract
where
inject :: a -> Seq a
inject a
a = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a]
x0 Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
a
extract :: Seq a -> a
extract :: Seq a -> a
extract Seq a
Seq.Empty = MealyError -> a
forall a e. Exception e => e -> a
throw (Text -> MealyError
MealyError Text
"empty seq")
extract (a
x Seq.:<| Seq a
_) = a
x
step :: Seq a -> a -> Seq a
step :: Seq a -> a -> Seq a
step Seq a
Seq.Empty a
_ = MealyError -> Seq a
forall a e. Exception e => e -> a
throw (Text -> MealyError
MealyError Text
"empty seq")
step (a
_ Seq.:<| Seq a
xs) a
a = Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
a
data Medianer a b = Medianer
{ Medianer a b -> a
medAbsSum :: a,
Medianer a b -> b
medCount :: b,
Medianer a b -> a
medianEst :: a
}
onlineL1 ::
(Ord b, Field b, Signed b) => b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 :: b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 b
i b
d a -> b
f b -> b
g = (b, b) -> b
forall a b. (a, b) -> b
snd ((b, b) -> b) -> Mealy a (b, b) -> Mealy a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Medianer b b)
-> (Medianer b b -> a -> Medianer b b)
-> (Medianer b b -> (b, b))
-> Mealy a (b, b)
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> Medianer b b
inject Medianer b b -> a -> Medianer b b
step Medianer b b -> (b, b)
forall b. Divisive b => Medianer b b -> (b, b)
extract
where
inject :: a -> Medianer b b
inject a
a = let s :: b
s = b -> b
forall a. Signed a => a -> a
abs (a -> b
f a
a) in b -> b -> b -> Medianer b b
forall a b. a -> b -> a -> Medianer a b
Medianer b
s b
forall a. Multiplicative a => a
one (b
i b -> b -> b
forall a. Multiplicative a => a -> a -> a
* b
s)
step :: Medianer b b -> a -> Medianer b b
step (Medianer b
s b
c b
m) a
a =
b -> b -> b -> Medianer b b
forall a b. a -> b -> a -> Medianer a b
Medianer
(b -> b
g (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
s b -> b -> b
forall a. Additive a => a -> a -> a
+ b -> b
forall a. Signed a => a -> a
abs (a -> b
f a
a))
(b -> b
g (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
c b -> b -> b
forall a. Additive a => a -> a -> a
+ b
forall a. Multiplicative a => a
one)
((b
forall a. Multiplicative a => a
one b -> b -> b
forall a. Subtractive a => a -> a -> a
- b
d) b -> b -> b
forall a. Multiplicative a => a -> a -> a
* (b
m b -> b -> b
forall a. Additive a => a -> a -> a
+ a -> b -> b
sign' a
a b
m b -> b -> b
forall a. Multiplicative a => a -> a -> a
* b
i b -> b -> b
forall a. Multiplicative a => a -> a -> a
* b
s b -> b -> b
forall a. Divisive a => a -> a -> a
/ b
c') b -> b -> b
forall a. Additive a => a -> a -> a
+ b
d b -> b -> b
forall a. Multiplicative a => a -> a -> a
* a -> b
f a
a)
where
c' :: b
c' =
if b
c b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
forall a. Additive a => a
zero
then b
forall a. Multiplicative a => a
one
else b
c
extract :: Medianer b b -> (b, b)
extract (Medianer b
s b
c b
m) = (b
s b -> b -> b
forall a. Divisive a => a -> a -> a
/ b
c, b
m)
sign' :: a -> b -> b
sign' a
a b
m
| a -> b
f a
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
m = b
forall a. Multiplicative a => a
one
| a -> b
f a
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
m = b -> b
forall a. Subtractive a => a -> a
negate b
forall a. Multiplicative a => a
one
| Bool
otherwise = b
forall a. Additive a => a
zero
{-# INLINEABLE onlineL1 #-}
maL1 :: (Ord a, Field a, Signed a) => a -> a -> a -> Mealy a a
maL1 :: a -> a -> a -> Mealy a a
maL1 a
i a
d a
r = a -> a -> (a -> a) -> (a -> a) -> Mealy a a
forall b a.
(Ord b, Field b, Signed b) =>
b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 a
i a
d a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE maL1 #-}
window :: Int -> Mealy a [a]
window :: Int -> Mealy a [a]
window Int
n = (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
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)) ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (Seq a -> [a]) -> Seq a -> [a]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
{-# INLINEABLE window #-}