{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
module Data.Mealy
(
Mealy (..),
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,
delay1,
delay,
depState,
Model1 (..),
zeroModel1,
depModel1,
Medianer (..),
onlineL1,
onlineL1',
maL1,
absmaL1,
)
where
import Control.Lens hiding (Empty, Unwrapped, Wrapped, index, (:>), (|>))
import Data.Fold hiding (M)
import Data.Functor.Rep
import Data.Generics.Labels ()
import qualified Data.Matrix as M
import qualified Data.Sequence as Seq
import qualified NumHask.Array.Fixed as F
import NumHask.Array.Shape (HasShape)
import NumHask.Prelude hiding (L1, State, StateT, asum, fold, get, replace, runState, runStateT, state)
newtype Mealy a b = Mealy {Mealy a b -> L1 a b
l1 :: L1 a b}
deriving (q b c -> Mealy a b -> Mealy a c
Mealy b c -> q a b -> Mealy a c
(a -> b) -> (c -> d) -> Mealy b c -> Mealy a d
(a -> b) -> Mealy b c -> Mealy a c
(b -> c) -> Mealy a b -> Mealy a c
(forall a b c d. (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d)
-> (forall a b c. (a -> b) -> Mealy b c -> Mealy a c)
-> (forall b c a. (b -> c) -> Mealy a b -> Mealy a c)
-> (forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Mealy a b -> Mealy a c)
-> (forall a b c (q :: * -> * -> *).
Coercible b a =>
Mealy b c -> q a b -> Mealy a c)
-> Profunctor Mealy
forall a b c. (a -> b) -> Mealy b c -> Mealy a c
forall b c a. (b -> c) -> Mealy a b -> Mealy a c
forall a b c d. (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d
forall a b c (q :: * -> * -> *).
Coercible b a =>
Mealy b c -> q a b -> Mealy a c
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Mealy a b -> Mealy a c
forall (p :: * -> * -> *).
(forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d)
-> (forall a b c. (a -> b) -> p b c -> p a c)
-> (forall b c a. (b -> c) -> p a b -> p a c)
-> (forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> p a b -> p a c)
-> (forall a b c (q :: * -> * -> *).
Coercible b a =>
p b c -> q a b -> p a c)
-> Profunctor p
.# :: Mealy b c -> q a b -> Mealy a c
$c.# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
Mealy b c -> q a b -> Mealy a c
#. :: q b c -> Mealy a b -> Mealy a c
$c#. :: forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Mealy a b -> Mealy a c
rmap :: (b -> c) -> Mealy a b -> Mealy a c
$crmap :: forall b c a. (b -> c) -> Mealy a b -> Mealy a c
lmap :: (a -> b) -> Mealy b c -> Mealy a c
$clmap :: forall a b c. (a -> b) -> Mealy b c -> Mealy a c
dimap :: (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d
$cdimap :: forall a b c d. (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d
Profunctor, Mealy a a
Mealy b c -> Mealy a b -> Mealy a c
(forall a. Mealy a a)
-> (forall b c a. Mealy b c -> Mealy a b -> Mealy a c)
-> Category Mealy
forall a. Mealy a a
forall b c a. Mealy b c -> Mealy a b -> Mealy a c
forall k (cat :: k -> k -> *).
(forall (a :: k). cat a a)
-> (forall (b :: k) (c :: k) (a :: k).
cat b c -> cat a b -> cat a c)
-> Category cat
. :: Mealy b c -> Mealy a b -> Mealy a c
$c. :: forall b c a. Mealy b c -> Mealy a b -> Mealy a c
id :: Mealy a a
$cid :: forall a. Mealy a a
Category) via L1
deriving (a -> Mealy a b -> Mealy a a
(a -> b) -> Mealy a a -> Mealy a b
(forall a b. (a -> b) -> Mealy a a -> Mealy a b)
-> (forall a b. a -> Mealy a b -> Mealy a a) -> Functor (Mealy a)
forall a b. a -> Mealy a b -> Mealy a a
forall a b. (a -> b) -> Mealy a a -> Mealy a b
forall a a b. a -> Mealy a b -> Mealy a a
forall a a b. (a -> b) -> Mealy a a -> Mealy a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Mealy a b -> Mealy a a
$c<$ :: forall a a b. a -> Mealy a b -> Mealy a a
fmap :: (a -> b) -> Mealy a a -> Mealy a b
$cfmap :: forall a a b. (a -> b) -> Mealy a a -> Mealy a b
Functor, Functor (Mealy a)
a -> Mealy a a
Functor (Mealy a)
-> (forall a. a -> Mealy a a)
-> (forall a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b)
-> (forall a b c.
(a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c)
-> (forall a b. Mealy a a -> Mealy a b -> Mealy a b)
-> (forall a b. Mealy a a -> Mealy a b -> Mealy a a)
-> Applicative (Mealy a)
Mealy a a -> Mealy a b -> Mealy a b
Mealy a a -> Mealy a b -> Mealy a a
Mealy a (a -> b) -> Mealy a a -> Mealy a b
(a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c
forall a. Functor (Mealy a)
forall a. a -> Mealy a a
forall a a. a -> Mealy a a
forall a b. Mealy a a -> Mealy a b -> Mealy a a
forall a b. Mealy a a -> Mealy a b -> Mealy a b
forall a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
forall a a b. Mealy a a -> Mealy a b -> Mealy a a
forall a a b. Mealy a a -> Mealy a b -> Mealy a b
forall a a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
forall a b c. (a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c
forall a a b c.
(a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Mealy a a -> Mealy a b -> Mealy a a
$c<* :: forall a a b. Mealy a a -> Mealy a b -> Mealy a a
*> :: Mealy a a -> Mealy a b -> Mealy a b
$c*> :: forall a a b. Mealy a a -> Mealy a b -> Mealy a b
liftA2 :: (a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c
$cliftA2 :: forall a a b c.
(a -> b -> c) -> Mealy a a -> Mealy a b -> Mealy a c
<*> :: Mealy a (a -> b) -> Mealy a a -> Mealy a b
$c<*> :: forall a a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
pure :: a -> Mealy a a
$cpure :: forall a a. a -> Mealy a a
$cp1Applicative :: forall a. Functor (Mealy a)
Applicative) via L1 a
pattern M :: (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
pattern $bM :: (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
$mM :: forall r a b.
Mealy a b
-> (forall c. (a -> c) -> (c -> a -> c) -> (c -> b) -> r)
-> (Void# -> r)
-> r
M i s e = Mealy (L1 e s i)
{-# COMPLETE M #-}
fold :: Mealy a b -> [a] -> b
fold :: Mealy a b -> [a] -> b
fold Mealy a b
_ [] = Text -> b
forall a. HasCallStack => Text -> a
panic Text
"on the streets of Birmingham."
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
data RegressionState (n :: Nat) a = RegressionState
{ RegressionState n a -> Array '[n, n] a
_xx :: F.Array '[n, n] a,
RegressionState n a -> Array '[n] a
_x :: F.Array '[n] a,
RegressionState n a -> Array '[n] a
_xy :: F.Array '[n] a,
RegressionState n a -> a
_y :: a
}
deriving (a -> RegressionState n b -> RegressionState n a
(a -> b) -> RegressionState n a -> RegressionState n b
(forall a b.
(a -> b) -> RegressionState n a -> RegressionState n b)
-> (forall a b. a -> RegressionState n b -> RegressionState n a)
-> Functor (RegressionState n)
forall a b. a -> RegressionState n b -> RegressionState n a
forall a b. (a -> b) -> RegressionState n a -> RegressionState n b
forall (n :: Nat) a b.
a -> RegressionState n b -> RegressionState n a
forall (n :: Nat) a b.
(a -> b) -> RegressionState n a -> RegressionState n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RegressionState n b -> RegressionState n a
$c<$ :: forall (n :: Nat) a b.
a -> RegressionState n b -> RegressionState n a
fmap :: (a -> b) -> RegressionState n a -> RegressionState n b
$cfmap :: forall (n :: Nat) a b.
(a -> b) -> RegressionState n a -> RegressionState n b
Functor)
beta :: (Field a, KnownNat n, Fractional a, Eq a) => a -> Mealy (F.Array '[n] a, a) (F.Array '[n] a)
beta :: a -> Mealy (Array '[n] a, a) (Array '[n] a)
beta a
r = ((Array '[n] a, a) -> Averager (RegressionState n a) a)
-> (Averager (RegressionState n a) a
-> (Array '[n] a, a) -> Averager (RegressionState n a) a)
-> (Averager (RegressionState n a) a -> Array '[n] a)
-> Mealy (Array '[n] a, a) (Array '[n] a)
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M (Array '[n] a, a) -> Averager (RegressionState n a) a
forall (n :: Nat) a b.
(KnownNat n, Multiplicative a, Multiplicative b) =>
(Array '[n] a, a) -> Averager (RegressionState n a) b
inject Averager (RegressionState n a) a
-> (Array '[n] a, a) -> Averager (RegressionState n a) a
step Averager (RegressionState n a) a -> Array '[n] a
forall (n :: Nat) a.
(KnownNat n, Fractional a, Eq a, Divisive a, Subtractive a) =>
Averager (RegressionState n a) a -> Array '[n] a
extract
where
extract :: Averager (RegressionState n a) a -> Array '[n] a
extract (A (RegressionState Array '[n, n] a
xx Array '[n] a
x Array '[n] a
xy a
y) a
c) =
(\Array '[n, n] a
a Array '[n] a
b -> Array '[n, n] a -> Array '[n, n] a
forall (n :: Nat) a.
(KnownNat n, Fractional a, Eq a) =>
Array '[n, n] a -> Array '[n, n] a
inverse Array '[n, n] a
a Array '[n, n] a -> Array '[n] a -> Array '[n] a
forall a (sa :: [Nat]) (sb :: [Nat]) (s' :: [Nat]) (ss :: [Nat])
(se :: [Nat]).
(Additive a, Multiplicative a, HasShape sa, HasShape sb,
HasShape (sa ++ sb),
se ~ TakeIndexes (sa ++ sb) '[Rank sa - 1, Rank sa], HasShape se,
KnownNat (Minimum se), KnownNat (Rank sa - 1), KnownNat (Rank sa),
ss ~ '[Minimum se], HasShape ss,
s' ~ DropIndexes (sa ++ sb) '[Rank sa - 1, Rank sa],
HasShape s') =>
Array sa a -> Array sb a -> Array s' a
`F.mult` Array '[n] a
b)
((a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
c) a -> Array '[n, n] a -> Array '[n, n] a
forall m a. MultiplicativeAction m a => a -> m -> m
.* (Array '[n, n] a
xx Array '[n, n] a -> Array '[n, n] a -> Array '[n, n] a
forall a. Subtractive a => a -> a -> a
- (a -> a -> a)
-> Array '[n] a -> Array '[n] a -> Array ('[n] ++ '[n]) a
forall (s :: [Nat]) (s' :: [Nat]) a b c.
(HasShape s, HasShape s', HasShape (s ++ s')) =>
(a -> b -> c) -> Array s a -> Array s' b -> Array (s ++ s') c
F.expand a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*) Array '[n] a
x Array '[n] a
x))
((Array '[n] a
xy Array '[n] a -> Array '[n] a -> Array '[n] a
forall a. Subtractive a => a -> a -> a
- (a
y a -> Array '[n] a -> Array '[n] a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Array '[n] a
x)) Array '[n] a -> a -> Array '[n] a
forall m a. MultiplicativeAction m a => m -> a -> m
*. (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
c))
step :: Averager (RegressionState n a) a
-> (Array '[n] a, a) -> Averager (RegressionState n a) a
step Averager (RegressionState n a) a
x (Array '[n] a
xs, a
y) = a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
forall a (n :: Nat).
(Field a, KnownNat n) =>
a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
rsOnline a
r Averager (RegressionState n a) a
x ((Array '[n] a, a) -> Averager (RegressionState n a) a
forall (n :: Nat) a b.
(KnownNat n, Multiplicative a, Multiplicative b) =>
(Array '[n] a, a) -> Averager (RegressionState n a) b
inject (Array '[n] a
xs, a
y))
inject :: (Array '[n] a, a) -> Averager (RegressionState n a) b
inject (Array '[n] a
xs, a
y) =
RegressionState n a -> b -> Averager (RegressionState n a) b
forall a b. a -> b -> Averager a b
A (Array '[n, n] a
-> Array '[n] a -> Array '[n] a -> a -> RegressionState n a
forall (n :: Nat) a.
Array '[n, n] a
-> Array '[n] a -> Array '[n] a -> a -> RegressionState n a
RegressionState ((a -> a -> a)
-> Array '[n] a -> Array '[n] a -> Array ('[n] ++ '[n]) a
forall (s :: [Nat]) (s' :: [Nat]) a b c.
(HasShape s, HasShape s', HasShape (s ++ s')) =>
(a -> b -> c) -> Array s a -> Array s' b -> Array (s ++ s') c
F.expand a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*) Array '[n] a
xs Array '[n] a
xs) Array '[n] a
xs (a
y a -> Array '[n] a -> Array '[n] a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Array '[n] a
xs) a
y) b
forall a. Multiplicative a => a
one
{-# INLINEABLE beta #-}
toMatrix :: (KnownNat n, KnownNat m) => F.Array [m, n] a -> M.Matrix a
toMatrix :: Array '[m, n] a -> Matrix a
toMatrix Array '[m, n] a
a = Int -> Int -> ((Int, Int) -> a) -> Matrix a
forall a. Int -> Int -> ((Int, Int) -> a) -> Matrix a
M.matrix Int
m Int
n (Array '[m, n] a -> Rep (Array '[m, n]) -> a
forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index Array '[m, n] a
a ([Int] -> a) -> ((Int, Int) -> [Int]) -> (Int, Int) -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\(Int
i, Int
j) -> [Int
i, Int
j]))
where
(Int
m : Int
n : [Int]
_) = Array '[m, n] a -> [Int]
forall a (s :: [Nat]). HasShape s => Array s a -> [Int]
F.shape Array '[m, n] a
a
fromMatrix :: (KnownNat n, KnownNat m) => M.Matrix a -> F.Array [m, n] a
fromMatrix :: Matrix a -> Array '[m, n] a
fromMatrix = [a] -> Array '[m, n] a
forall l. IsList l => [Item l] -> l
fromList ([a] -> Array '[m, n] a)
-> (Matrix a -> [a]) -> Matrix a -> Array '[m, n] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Matrix a -> [a]
forall a. Matrix a -> [a]
M.toList
data MatrixException = MatrixException
deriving (Int -> MatrixException -> ShowS
[MatrixException] -> ShowS
MatrixException -> String
(Int -> MatrixException -> ShowS)
-> (MatrixException -> String)
-> ([MatrixException] -> ShowS)
-> Show MatrixException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatrixException] -> ShowS
$cshowList :: [MatrixException] -> ShowS
show :: MatrixException -> String
$cshow :: MatrixException -> String
showsPrec :: Int -> MatrixException -> ShowS
$cshowsPrec :: Int -> MatrixException -> ShowS
Show)
instance Exception MatrixException
inverse :: (KnownNat n, Fractional a, Eq a) => F.Array [n, n] a -> F.Array [n, n] a
inverse :: Array '[n, n] a -> Array '[n, n] a
inverse = (String -> Array '[n, n] a)
-> (Matrix a -> Array '[n, n] a)
-> Either String (Matrix a)
-> Array '[n, n] a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Array '[n, n] a -> String -> Array '[n, n] a
forall a b. a -> b -> a
const (Array '[n, n] a -> String -> Array '[n, n] a)
-> Array '[n, n] a -> String -> Array '[n, n] a
forall a b. (a -> b) -> a -> b
$ MatrixException -> Array '[n, n] a
forall a e. Exception e => e -> a
throw MatrixException
MatrixException) Matrix a -> Array '[n, n] a
forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
Matrix a -> Array '[m, n] a
fromMatrix (Either String (Matrix a) -> Array '[n, n] a)
-> (Array '[n, n] a -> Either String (Matrix a))
-> Array '[n, n] a
-> Array '[n, n] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Matrix a -> Either String (Matrix a)
forall a.
(Fractional a, Eq a) =>
Matrix a -> Either String (Matrix a)
M.inverse (Matrix a -> Either String (Matrix a))
-> (Array '[n, n] a -> Matrix a)
-> Array '[n, n] a
-> Either String (Matrix a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Array '[n, n] a -> Matrix a
forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
Array '[m, n] a -> Matrix a
toMatrix
rsOnline :: (Field a, KnownNat n) => a -> Averager (RegressionState n a) a -> Averager (RegressionState n a) a -> Averager (RegressionState n a) a
rsOnline :: a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
-> Averager (RegressionState n a) a
rsOnline a
r (A (RegressionState Array '[n, n] a
xx Array '[n] a
x Array '[n] a
xy a
y) a
c) (A (RegressionState Array '[n, n] a
xx' Array '[n] a
x' Array '[n] a
xy' a
y') a
c') =
RegressionState n a -> a -> Averager (RegressionState n a) a
forall a b. a -> b -> Averager a b
A (Array '[n, n] a
-> Array '[n] a -> Array '[n] a -> a -> RegressionState n a
forall (n :: Nat) a.
Array '[n, n] a
-> Array '[n] a -> Array '[n] a -> a -> RegressionState n a
RegressionState ((a -> a -> a)
-> Array '[n, n] a -> Array '[n, n] a -> Array '[n, n] a
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 a -> a -> a
d Array '[n, n] a
xx Array '[n, n] a
xx') ((a -> a -> a) -> Array '[n] a -> Array '[n] a -> Array '[n] a
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 a -> a -> a
d Array '[n] a
x Array '[n] a
x') ((a -> a -> a) -> Array '[n] a -> Array '[n] a -> Array '[n] a
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 a -> a -> a
d Array '[n] a
xy Array '[n] a
xy') (a -> a -> a
d a
y a
y')) (a -> a -> a
d a
c a
c')
where
d :: a -> a -> a
d a
s a
s' = a
r a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
s a -> a -> a
forall a. Additive a => a -> a -> a
+ a
s'
alpha :: (ExpField a, KnownNat n, Fractional a, Eq a) => a -> Mealy (F.Array '[n] a, a) a
alpha :: a -> Mealy (Array '[n] a, a) a
alpha a
r = (\Array '[n] a
xs Array '[n] a
b a
y -> a
y a -> a -> a
forall a. Subtractive a => a -> a -> a
- Array '[n] a -> a
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum ((a -> a -> a) -> Array '[n] a -> Array '[n] a -> Array '[n] a
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 a -> a -> a
forall a. Multiplicative a => a -> a -> a
(*) Array '[n] a
b Array '[n] a
xs)) (Array '[n] a -> Array '[n] a -> a -> a)
-> Mealy (Array '[n] a, a) (Array '[n] a)
-> Mealy (Array '[n] a, a) (Array '[n] a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Array '[n] a, a) -> Array '[n] a)
-> Mealy (Array '[n] a) (Array '[n] a)
-> Mealy (Array '[n] a, a) (Array '[n] a)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Array '[n] a, a) -> Array '[n] a
forall a b. (a, b) -> a
fst (Mealy a a -> Mealy (Array '[n] a) (Array '[n] a)
forall (s :: [Nat]) a b.
HasShape s =>
Mealy a b -> Mealy (Array s a) (Array s b)
arrayify (Mealy a a -> Mealy (Array '[n] a) (Array '[n] a))
-> Mealy a a -> Mealy (Array '[n] a) (Array '[n] a)
forall a b. (a -> b) -> a -> b
$ a -> Mealy a a
forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r) Mealy (Array '[n] a, a) (Array '[n] a -> a -> a)
-> Mealy (Array '[n] a, a) (Array '[n] a)
-> Mealy (Array '[n] a, a) (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Mealy (Array '[n] a, a) (Array '[n] a)
forall a (n :: Nat).
(Field a, KnownNat n, Fractional a, Eq a) =>
a -> Mealy (Array '[n] a, a) (Array '[n] a)
beta a
r Mealy (Array '[n] a, a) (a -> a)
-> Mealy (Array '[n] a, a) a -> Mealy (Array '[n] a, a) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Array '[n] a, a) -> a) -> Mealy a a -> Mealy (Array '[n] a, a) a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Array '[n] a, a) -> a
forall a b. (a, b) -> b
snd (a -> Mealy a a
forall a. (Divisive a, Additive a) => a -> Mealy a a
ma a
r)
{-# INLINEABLE alpha #-}
arrayify :: (HasShape s) => Mealy a b -> Mealy (F.Array s a) (F.Array s b)
arrayify :: Mealy a b -> Mealy (Array s a) (Array s b)
arrayify (M a -> c
sExtract c -> a -> c
sStep c -> b
sInject) = (Array s a -> Array s c)
-> (Array s c -> Array s a -> Array s c)
-> (Array s c -> Array s b)
-> Mealy (Array s a) (Array s b)
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M Array s a -> Array s c
extract Array s c -> Array s a -> Array s c
step Array s c -> Array s b
inject
where
extract :: Array s a -> Array s c
extract = (a -> c) -> Array s a -> Array s c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> c
sExtract
step :: Array s c -> Array s a -> Array s c
step = (c -> a -> c) -> Array s c -> Array s a -> Array s c
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
liftR2 c -> a -> c
sStep
inject :: Array s c -> Array s b
inject = (c -> b) -> Array s c -> Array s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> b
sInject
reg :: (ExpField a, KnownNat n, Fractional a, Eq a) => a -> Mealy (F.Array '[n] a, a) (F.Array '[n] a, a)
reg :: a -> Mealy (Array '[n] a, a) (Array '[n] a, a)
reg a
r = (,) (Array '[n] a -> a -> (Array '[n] a, a))
-> Mealy (Array '[n] a, a) (Array '[n] a)
-> Mealy (Array '[n] a, a) (a -> (Array '[n] a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Mealy (Array '[n] a, a) (Array '[n] a)
forall a (n :: Nat).
(Field a, KnownNat n, Fractional a, Eq a) =>
a -> Mealy (Array '[n] a, a) (Array '[n] a)
beta a
r Mealy (Array '[n] a, a) (a -> (Array '[n] a, a))
-> Mealy (Array '[n] a, a) a
-> Mealy (Array '[n] a, a) (Array '[n] a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Mealy (Array '[n] a, a) a
forall a (n :: Nat).
(ExpField a, KnownNat n, Fractional a, Eq a) =>
a -> Mealy (Array '[n] a, a) a
alpha a
r
{-# INLINEABLE reg #-}
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)
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 = Text -> a
forall a. HasCallStack => Text -> a
panic Text
"ACAB"
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
_ = Text -> Seq a
forall a. HasCallStack => Text -> a
panic Text
"ACAB"
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
depState :: (a -> b -> a) -> Mealy a b -> Mealy a a
depState :: (a -> b -> a) -> Mealy a b -> Mealy a a
depState a -> b -> a
f (M a -> c
sInject c -> a -> c
sStep c -> b
sExtract) = (a -> (a, c))
-> ((a, c) -> a -> (a, c)) -> ((a, c) -> a) -> Mealy a a
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> (a, c)
inject (a, c) -> a -> (a, c)
step (a, c) -> a
forall a b. (a, b) -> a
extract
where
inject :: a -> (a, c)
inject a
a = (a
a, a -> c
sInject a
a)
step :: (a, c) -> a -> (a, c)
step (a
_, c
x) a
a = let a' :: a
a' = a -> b -> a
f a
a (c -> b
sExtract c
x) in (a
a', c -> a -> c
sStep c
x a
a')
extract :: (a, b) -> a
extract (a
a, b
_) = a
a
data Model1 = Model1
{ Model1 -> Double
alphaX :: Double,
Model1 -> Double
alphaS :: Double,
Model1 -> Double
betaMa2X :: Double,
Model1 -> Double
betaMa2S :: Double,
Model1 -> Double
betaStd2X :: Double,
Model1 -> Double
betaStd2S :: Double
}
deriving (Model1 -> Model1 -> Bool
(Model1 -> Model1 -> Bool)
-> (Model1 -> Model1 -> Bool) -> Eq Model1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Model1 -> Model1 -> Bool
$c/= :: Model1 -> Model1 -> Bool
== :: Model1 -> Model1 -> Bool
$c== :: Model1 -> Model1 -> Bool
Eq, Int -> Model1 -> ShowS
[Model1] -> ShowS
Model1 -> String
(Int -> Model1 -> ShowS)
-> (Model1 -> String) -> ([Model1] -> ShowS) -> Show Model1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Model1] -> ShowS
$cshowList :: [Model1] -> ShowS
show :: Model1 -> String
$cshow :: Model1 -> String
showsPrec :: Int -> Model1 -> ShowS
$cshowsPrec :: Int -> Model1 -> ShowS
Show, (forall x. Model1 -> Rep Model1 x)
-> (forall x. Rep Model1 x -> Model1) -> Generic Model1
forall x. Rep Model1 x -> Model1
forall x. Model1 -> Rep Model1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Model1 x -> Model1
$cfrom :: forall x. Model1 -> Rep Model1 x
Generic)
zeroModel1 :: Model1
zeroModel1 :: Model1
zeroModel1 = Double -> Double -> Double -> Double -> Double -> Double -> Model1
Model1 Double
0 Double
0 Double
0 Double
0 Double
0 Double
0
depModel1 :: Double -> Model1 -> Mealy Double Double
depModel1 :: Double -> Model1 -> Mealy Double Double
depModel1 Double
r Model1
m1 =
(Double -> (Double, Double) -> Double)
-> Mealy Double (Double, Double) -> Mealy Double Double
forall a b. (a -> b -> a) -> Mealy a b -> Mealy a a
depState Double -> (Double, Double) -> Double
fX Mealy Double (Double, Double)
st
where
st :: Mealy Double (Double, Double)
st = (,) (Double -> Double -> (Double, Double))
-> Mealy Double Double -> Mealy Double (Double -> (Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Mealy Double Double
forall a. (Divisive a, Additive a) => a -> Mealy a a
ma (Double
1 Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
r) Mealy Double (Double -> (Double, Double))
-> Mealy Double Double -> Mealy Double (Double, Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Double -> Mealy Double Double
forall a. (Divisive a, ExpField a) => a -> Mealy a a
std (Double
1 Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
r)
fX :: Double -> (Double, Double) -> Double
fX Double
a (Double
m, Double
s) =
Double
a
Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* ( (Double
1 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "alphaS" (Getting Double Model1 Double)
Getting Double Model1 Double
#alphaS)
Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "betaMa2S" (Getting Double Model1 Double)
Getting Double Model1 Double
#betaMa2S) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
m
Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "betaStd2S" (Getting Double Model1 Double)
Getting Double Model1 Double
#betaStd2S) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Double
s Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
1)
)
Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "alphaX" (Getting Double Model1 Double)
Getting Double Model1 Double
#alphaX
Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "betaMa2X" (Getting Double Model1 Double)
Getting Double Model1 Double
#betaMa2X)
Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
m
Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Model1
m1 Model1 -> Getting Double Model1 Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "betaStd2X" (Getting Double Model1 Double)
Getting Double Model1 Double
#betaStd2X)
Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Double
s Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
1)
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, b)
onlineL1' :: b -> b -> (a -> b) -> (b -> b) -> Mealy a (b, b)
onlineL1' b
i b
d a -> b
f b -> b
g = (a -> Medianer b b)
-> (Medianer b b -> a -> Medianer b b)
-> (Medianer b b -> (b, b))
-> Mealy a (b, b)
forall a b c. (a -> c) -> (c -> a -> c) -> (c -> b) -> Mealy a b
M a -> Medianer b b
inject Medianer b b -> a -> Medianer b b
step Medianer b b -> (b, b)
forall b. Divisive b => Medianer b b -> (b, b)
extract
where
inject :: a -> Medianer b b
inject a
a = let s :: b
s = b -> b
forall a. Signed a => a -> a
abs (a -> b
f a
a) in b -> b -> b -> Medianer b b
forall a b. a -> b -> a -> Medianer a b
Medianer b
s b
forall a. Multiplicative a => a
one (b
i b -> b -> b
forall a. Multiplicative a => a -> a -> a
* b
s)
step :: Medianer b b -> a -> Medianer b b
step (Medianer b
s b
c b
m) a
a =
b -> b -> b -> Medianer b b
forall a b. a -> b -> a -> Medianer a b
Medianer
(b -> b
g (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
s b -> b -> b
forall a. Additive a => a -> a -> a
+ b -> b
forall a. Signed a => a -> a
abs (a -> b
f a
a))
(b -> b
g (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
c b -> b -> b
forall a. Additive a => a -> a -> a
+ b
forall a. Multiplicative a => a
one)
((b
forall a. Multiplicative a => a
one b -> b -> b
forall a. Subtractive a => a -> a -> a
- b
d) b -> b -> b
forall a. Multiplicative a => a -> a -> a
* (b
m b -> b -> b
forall a. Additive a => a -> a -> a
+ a -> b -> b
sign' a
a b
m b -> b -> b
forall a. Multiplicative a => a -> a -> a
* b
i b -> b -> b
forall a. Multiplicative a => a -> a -> a
* b
s b -> b -> b
forall a. Divisive a => a -> a -> a
/ b
c') b -> b -> b
forall a. Additive a => a -> a -> a
+ b
d b -> b -> b
forall a. Multiplicative a => a -> a -> a
* a -> b
f a
a)
where
c' :: b
c' =
if b
c b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
forall a. Additive a => a
zero
then b
forall a. Multiplicative a => a
one
else b
c
extract :: Medianer b b -> (b, b)
extract (Medianer b
s b
c b
m) = (b
s b -> b -> b
forall a. Divisive a => a -> a -> a
/ b
c, b
m)
sign' :: a -> b -> b
sign' a
a b
m
| a -> b
f a
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
m = b
forall a. Multiplicative a => a
one
| a -> b
f a
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
m = b -> b
forall a. Subtractive a => a -> a
negate b
forall a. Multiplicative a => a
one
| Bool
otherwise = b
forall a. Additive a => a
zero
{-# INLINEABLE onlineL1' #-}
onlineL1 :: (Ord b, Field b, Signed b) => b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 :: b -> b -> (a -> b) -> (b -> b) -> Mealy a b
onlineL1 b
i b
d a -> b
f b -> b
g = (b, b) -> b
forall a b. (a, b) -> b
snd ((b, b) -> b) -> Mealy a (b, b) -> Mealy a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> b -> (a -> b) -> (b -> b) -> Mealy a (b, b)
forall b a.
(Ord b, Field b, Signed b) =>
b -> b -> (a -> b) -> (b -> b) -> Mealy a (b, b)
onlineL1' b
i b
d a -> b
f b -> b
g
{-# INLINEABLE onlineL1 #-}
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 #-}
absmaL1 :: (Ord a, Field a, Signed a) => a -> a -> a -> Mealy a a
absmaL1 :: a -> a -> a -> Mealy a a
absmaL1 a
i a
d a
r = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> Mealy a (a, a) -> Mealy a a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> (a -> a) -> (a -> a) -> Mealy a (a, a)
forall b a.
(Ord b, Field b, Signed b) =>
b -> b -> (a -> b) -> (b -> b) -> Mealy a (b, b)
onlineL1' a
i a
d a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
r)
{-# INLINEABLE absmaL1 #-}