Analysis.hs

{-# 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


{- $setup
>>> import qualified Synthesizer.Causal.Analysis as AnaC
>>> import qualified Synthesizer.Causal.Process as Causal
>>> import qualified Synthesizer.Plain.Analysis as Ana
>>>
>>> import Control.Arrow ((<<<))
>>>
>>> import qualified Data.NonEmpty.Class as NonEmptyC
>>> import qualified Data.NonEmpty as NonEmpty
>>> import qualified Data.List.Match as Match
>>> import qualified Data.List as List
>>>
>>> import qualified Test.QuickCheck as QC
>>>
>>> import NumericPrelude.Numeric
>>> import NumericPrelude.Base
>>> import Prelude ()
-}


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

{- |
prop> :{
   \xs ->
      Match.take xs (Ana.deltaSigmaModulation xs)
      ==
      Causal.apply AnaC.deltaSigmaModulation (xs::[Rational])
:}
-}
deltaSigmaModulation ::
   RealRing.C y => Causal.T y Ana.BinaryLevel
deltaSigmaModulation =
   Causal.feedback
      ((Ana.binaryLevelFromBool . (zero <=)) ^<<
       Integration.run <<^
       uncurry (-))
      (Causal.consInit zero <<^ Ana.binaryLevelToNumber)

{- |
prop> :{
   \threshold xs ->
      Match.take xs (Ana.deltaSigmaModulationPositive threshold xs)
      ==
      Causal.apply
         (AnaC.deltaSigmaModulationPositive <<<
          Causal.feedConstFst threshold)
         (xs::[Rational])
:}
-}
deltaSigmaModulationPositive ::
   RealRing.C y => Causal.T (y, y) y
deltaSigmaModulationPositive =
   Causal.feedback
      ((\(threshold,xi) -> if threshold<=xi then threshold else zero) ^<<
       second Integration.run <<^
       (\((threshold,xi),cum) -> (threshold,xi-cum)))
      (Causal.consInit zero)


{-
Abuse (Map a ()) as (Set a),
because in GHC-7.4.2 there is no Set.elemAt function.
-}
{- |
prop> :{
   let movingMedian :: (Ord a) => Int -> [a] -> [a]
       movingMedian n =
         map (\xs -> List.sort xs !! div (length xs) 2) . NonEmpty.tail .
         NonEmptyC.zipWith (drop . max 0) (NonEmptyC.iterate succ (negate n)) .
         NonEmpty.inits

   in QC.forAll (QC.choose (1,20)) $ \n xs ->
         movingMedian n xs
         ==
         Causal.apply (AnaC.movingMedian n) (xs::[Char])
:}
-}
movingMedian :: (Ord a) => Int -> Causal.T a a
movingMedian n =
   Causal.mapAccumL
      (\new (k,queue,oldSet) ->
         let set =
               Map.insert (new,k) () $
               maybe id (\old -> Map.delete (old,k)) (Map.lookup k queue) oldSet
         in  (fst $ fst $ Map.elemAt (div (Map.size set) 2) set,
              (mod (k+1) n, Map.insert k new queue, set)))
      (0, Map.empty, Map.empty)