Geek Answers Handbook

Realization of recurrence relations on state monads (in Haskell or Scala)

I am working on a new implementation of the operators at http://www.thalesians.com/archive/public/academic/finance/papers/Zumbach_2000.pdf EDIT: a clearer explanation here: https://www.olseninvest.com/customer/pdf /paper/001207-emaOfEma.pdf

In short, this is a whole bunch of cool time series operators, based on a recurrence relation of the exponential moving average, where each application of the ema () operator takes a new value and the previous ema result. I cannot make latex in this stack exchange, but in any case, my problem now is the software problem.

I implemented this in Scala by hiding the var deep inside the thunks that create the EMA functions. It all works, but it's super complicated, because calling ema (5) and then ema (5) again naturally leads to a different result. I would like to try redoing all this using State Monads, but I quickly get lost in the weeds.

For example, I have the following simplified EMA State monad in Haskell:

import Control.Monad.State

type EMAState = Double
type Tau = Double

ema :: Tau -> Double -> State EMAState Double
ema tau x = state $ \y ->
  let alpha = 1 / tau
      mu = exp(-alpha)
      mu' = 1 - mu
      y' = (mu * y) + (mu' * x)
  in (y', y')

which I can easily check in GHCI:

*Main Control.Monad.State> runState (ema 5 10) 0
(1.8126924692201818,1.8126924692201818)

applying input 10 to a 5-period EMA initialized to 0. This is all well and good using forM. I can apply multiple input values, etc. Now the next step is to implement a “repeated EMA,” which EMA is applied to itself N times.

iEMA[n](x) = EMA(iEMA[n-1](x))

EMA , , EMA. , , - ( ):

iema :: Int -> Tau -> Double -> State [EMAState] [Double]

EMA:

iEMA[3](x) = EMA(EMA(EMA(x,s1),s2),s3) = (x, [s1,s2,s3]) -> ([y1,y2,y3], [s1',s2',s3'])

, , EMA...

... -> (y3, [s1', s2', s3'])

, , EMA .., , , .

, , , , , . - ?

EDIT:

ema , . ema . :

tau 5               
mu  0.818730753             
muprime 0.181269247             
        ema1    ema2    ema3     
    x   0       0       0       <- States_0
    1   0.1812  0.03285 0.00595 <- States_1
    5   1.0547  0.21809 0.04441 <- States_2

x , ema1 , /. ema2 ( x!), . ema (ema (x)). ema3 = ema (ema (ema (x))). , , , , , ema, ema3 , , [ema] ema, .

+4
4

...

:

combine :: [ a -> State s a ] -> a -> State [s] a
combine fs a = state $ \ys ->
  let zs = zipWith (\f y a -> runState (f a) y) fs ys
      pairs = chain a zs
      as' = map fst pairs
      a' = last as'         -- we are only returning one result in this case
      ys' = map snd pairs
  in (a', ys')

chain :: a -> [ a -> (a,s) ] -> [ (a,s) ]
chain a [] = []
chain a (f:fs) = let (a',s) = f a
                 in (a',s) : chain a' fs

ema3 t = combine $ replicate 3 (ema t)

ghci> runState (ema3 5 1) [0,0,0]
(5.956242778945897e-3,[0.18126924692201818,3.2858539879675595e-2,5.956242778945897e-3])

ghci> runState (do ema3 5 1; ema3 5 5) [0,0,0]
(4.441089130249448e-2,[1.0547569416524334,0.21809729359983737,4.441089130249448e-2])

combine , - as' a'.

:

 combine :: (a -> State s b) -> (b -> State t c) -> (a -> State (s,t) c)
 combine f g a = state $ \(s,t) ->
   let (b,s') = runState (f a) s
       (c,t') = runState (g b) t
   in (c,(s',t'))

:

ema3 tau = ema tau `combine` ema tau `combine` ema tau

em3 :

ema3 :: Tau -> Double -> State ((EMAState, EMAState), EMAState) Double

:

ghci> runState (ema3 5 1) ((0,0),0)
(5.956242778945897e-3,((0.18126924692201818,3.2858539879675595e-2),5.956242778945897e-3))

, ema3 - ((Double,Double),Double), 3- .

(ema3 5) x = 1, x = 5 ((0,0),0):

ghci> runState (do ema3 5 1; ema3 5 5) ((0,0),0)
(4.441089130249448e-2,((1.0547569416524334,0.21809729359983737),4.441089130249448e-2))

.

+1

Mealy

data Mealy i o where
  Mealy :: (i -> s -> (i, s)) -> s -> Mealy i o


instance Arrow Mealy
instance ArrowChoice Mealy
instance ArrowApply Mealy
instance Strong Mealy
instance Choice Mealy
instance Profunctor Mealy
instance Category * Mealy
instance Monad (Mealy a)
instance Functor (Mealy a)
instance Applicative (Mealy a)
instance Pointed (Mealy a)


recur :: (a -> a -> a) -> a -> Mealy a a
recur f a0 = Mealy (\inp prior -> let post = f inp prior in (post, post)) a0

Category

iter :: Int -> Mealy a a -> Mealy a a
iter 0 _ = id
iter 1 m = m
iter n m = m >>> iter (n-1) m


data Stream a = Stream a (Stream a) deriving Functor

instance Functor Stream
instance Applicative Stream
instance Foldable Stream
instance Traversable Stream

ints :: Stream Int
ints = go 0 where go n = Stream n (go $ n + 1)

jet :: Mealy a a -> Stream (Mealy a a)
jet m = fmap (`iter` m) ints

, , . . ,

newtype MealyJet i o = MealyJet { runMealyJet :: Stream (Mealy i o) }

instance Profunctor MealyJet
instance Applicative (MealyJet i)

instance Category MealyJet where
  id = MealyJet (pure id) -- technically this should be `jet id`, but it equal to pure
  MealyJet f . MealyJet g = MealyJet (liftA2 (.) f g)

viewMealyJet :: MealyJet i o -> Mealy i (Stream o)
viewMealyJet (MealyJet m) = sequenceA m

EMA

type Tau = Double

ema :: Tau -> Mealy Double Double
ema tau = recur $ \fresh prior -> 
  let alpha = 1 / tau
      mu    = exp (negate alpha)
      mu'   = 1 - mu
   in (mu * y) + (mu' * x)

emaJet :: Tau -> MealyJet Double Double
emaJet = MealyJet . jet . ema

emaComp :: MealyJet Double Double
emaComp = emaJet 1 >>> emaJet 2 >>> emaJet 3 >>> emaJet 4 >>> emaJet 5

fiveStack :: Mealy Double (Stream Double)
fiveStack = viewMealyJet emaComp
+2

, , , , - :

ema' _ [] = get >>= return
ema' tau (x:xs) = do
  y <- get
  let alpha = 1 / tau
      mu = exp $ negate alpha
      mu' = 1 - mu
      y' = (mu * y) + (mu' * x)
  put y'
  ema' tau xs

, , x, , y. , y .

:

*Main> evalState (ema' 5 [10]) 0
1.8126924692201818
*Main> evalState (ema' 5 [10, 10]) 0
3.2967995396436076
*Main> evalState (ema' 5 [10, 10, 10]) 0
4.511883639059737

State state $ \y -> .... do put get . y get, put .

, State, ( put get).

, State ; , x.

+1

...

ema >>= :

ema3 tau x = ema tau x >>= ema tau >>= ema tau

:

ema3 tau = ema tau >=> ema tau >=> ema tau

:

          y1          /---------\
           |          |         |
           v          |         v
  x  -->  EMA   -->  EMA  -->  EMA  -->  x' = y3'
          tau        tau       tau 
           |          ^         |
           |          |         v
           \----------/         y3'

( )

, , , OP , .

, :

          y1         y2        y3
           |          |         |
           v          v         v
  x  -->  EMA   -->  EMA  -->  EMA  -->  x'
          tau1       tau2      tau3
           |          |         |
           v          v         v
          y1'        y2'       y3'

, EMA, . - :

ema tau1 >o> ema tau2 >o> ema tau3

>o>.

+1

More articles:


All Articles