{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Causal.Analysis where

import qualified Synthesizer.Causal.Filter.Recursive.Integration as Integration

import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Plain.Analysis as Ana

import qualified Algebra.RealRing              as RealRing

import Control.Arrow (second, (^<<), (<<^), )

import qualified Data.Map as Map

import NumericPrelude.Numeric
import NumericPrelude.Base


flipFlopHysteresis ::
   (Ord y) => (y,y) -> Ana.BinaryLevel -> Causal.T y Ana.BinaryLevel
flipFlopHysteresis :: forall y. Ord y => (y, y) -> BinaryLevel -> T y BinaryLevel
flipFlopHysteresis (y, y)
bnds = forall acc x. (acc -> x -> acc) -> acc -> T x acc
Causal.scanL (forall a. Ord a => (a, a) -> BinaryLevel -> a -> BinaryLevel
Ana.flipFlopHysteresisStep (y, y)
bnds)

deltaSigmaModulation ::
   RealRing.C y => Causal.T y Ana.BinaryLevel
deltaSigmaModulation :: forall y. C y => T y BinaryLevel
deltaSigmaModulation =
   forall a c b. T (a, c) b -> T b c -> T a b
Causal.feedback
      ((Bool -> BinaryLevel
Ana.binaryLevelFromBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. C a => a
zero forall a. Ord a => a -> a -> Bool
<=)) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
       forall v. C v => T v v
Integration.run forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
       forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-))
      (forall x. x -> T x x
Causal.consInit forall a. C a => a
zero forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ forall a. C a => BinaryLevel -> a
Ana.binaryLevelToNumber)

deltaSigmaModulationPositive ::
   RealRing.C y => Causal.T (y, y) y
deltaSigmaModulationPositive :: forall y. C y => T (y, y) y
deltaSigmaModulationPositive =
   forall a c b. T (a, c) b -> T b c -> T a b
Causal.feedback
      ((\(y
threshold,y
xi) -> if y
thresholdforall a. Ord a => a -> a -> Bool
<=y
xi then y
threshold else forall a. C a => a
zero) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
       forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall v. C v => T v v
Integration.run forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
       (\((y
threshold,y
xi),y
cum) -> (y
threshold,y
xiforall a. C a => a -> a -> a
-y
cum)))
      (forall x. x -> T x x
Causal.consInit forall a. C a => a
zero)


{-
Abuse (Map a ()) as (Set a),
because in GHC-7.4.2 there is no Set.elemAt function.
-}
movingMedian :: (Ord a) => Int -> Causal.T a a
movingMedian :: forall a. Ord a => Int -> T a a
movingMedian Int
n =
   forall x acc y. (x -> acc -> (y, acc)) -> acc -> T x y
Causal.mapAccumL
      (\a
new (Int
k,Map Int a
queue,Map (a, Int) ()
oldSet) ->
         let set :: Map (a, Int) ()
set =
               forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a
new,Int
k) () forall a b. (a -> b) -> a -> b
$
               forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\a
old -> forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (a
old,Int
k)) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
k Map Int a
queue) Map (a, Int) ()
oldSet
         in  (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall k a. Int -> Map k a -> (k, a)
Map.elemAt (forall a. C a => a -> a -> a
div (forall k a. Map k a -> Int
Map.size Map (a, Int) ()
set) Int
2) Map (a, Int) ()
set,
              (forall a. C a => a -> a -> a
mod (Int
kforall a. C a => a -> a -> a
+Int
1) Int
n, forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
k a
new Map Int a
queue, Map (a, Int) ()
set)))
      (Int
0, forall k a. Map k a
Map.empty, forall k a. Map k a
Map.empty)