In [1]:
{-# LANGUAGE OverloadedLists #-}
import Math.FunctionalAnalysis.L2Function.R1
import qualified Data.Vector.Storable as UArr
import qualified Data.Vector as Arr
import Graphics.Dynamic.Plot.R2
import Data.Complex

In [2]:
smooth, smooth' :: UArr.Vector Int -> Arr.Vector (UnitL2 Int Double) -> UnitL2 Int Double
smooth scfs subdivs = UnitL2 1 (-1, 1) (UArr.map (:+0) scfs) OutlappingDFT subdivs
smooth' scfs subdivs = UnitL2 1 (-1, 1) (UArr.map (0:+) scfs) OutlappingDFT subdivs

In [3]:
unitL2Plot :: UnitL2 Int Double -> DynamicPlottable
unitL2Plot f = lineSegPlot . zip [h/2, 3*h/2 ..]
                   $ UArr.toList fUniform
 where fUniform = toUniformSampled n f
       n = 437
       h = 1/fromIntegral n

In [4]:
plotWindow
 [ unitL2Plot (smooth [0,0,0,2] -- [3,-2,-1,1]
                    [smooth [][], smooth [1,1] [], smooth [][], smooth [0,1,1,1][]])
 , xInterval (0,1) ]


GraphWindowSpecR2{lBound=-0.16666666666666663, rBound=1.166666666666667, bBound=-2.8812101070312206, tBound=5.601362332785447, xResolution=640, yResolution=480}

In [5]:
plotWindow
 [ unitL2Plot (smooth [] -- [3,-2,-1,1]
                    [smooth [0,0,0,1][], smooth' [0,0,0,1,0] [], smooth [0,0,0,-1,0,0,0,0,0][], smooth' [0,0,0,-1][]])
 , continFnPlot $ cos . (4*7*pi*) . subtract(1/16)
 , forceXRange (0,0.5) ]


GraphWindowSpecR2{lBound=0.0, rBound=0.5, bBound=-1.8696723365240018, tBound=1.8696705919319445, xResolution=640, yResolution=480}

In [6]:
f :: Double -> Double
f x = exp (-20*(x-0.5)^2)

In [7]:
onSubchunks :: (UnitL2 Int Double -> UnitL2 Int Double) -> UnitL2 Int Double -> UnitL2 Int Double
onSubchunks f (UnitL2 μ r lr tfm sc) = UnitL2 μ r lr tfm $ f<$>sc

sansLongrange, allZero :: UnitL2 Int Double -> UnitL2 Int Double
sansLongrange (UnitL2 μ r lr tfm sc) = UnitL2 μ r (UArr.map (const $ 0:+0) lr) tfm sc
allZero = sansLongrange . onSubchunks allZero

In [8]:
plotWindow $ [continFnPlot f]
          ++ [ legendName (rExpl++", nLocal="++show nLocal) . unitL2Plot $ range
               (fromUniformSampled SigSampleConfig { _maxFFTSize=256, _infoPerStage=16
                                                   , _maxLocalInfo=nLocal, _longrangeBandwidth=30
                                                   , _noiseFloorLevel=1e-6 }
                                   (UArr.fromList $ f<$>[h/2, 3*h/2 .. 1-h/2]) :: UnitL2 Int Double)
             | nLocal <- [17, 64]
             , h <- [1/48]
             , (range,rExpl) <- [(id,"all"), (sansLongrange,"local")] ]
          ++ [xInterval (0,1)]


GraphWindowSpecR2{lBound=-0.16666666666666666, rBound=1.1666666666666667, bBound=-0.3634501244113369, tBound=1.1902036459258292, xResolution=640, yResolution=480}

In [9]:
g :: Double -> Double
g x = tanh (f x * 3) * sin (40*x) + tanh (f (5*x - 3) * 3) * cos (53*x)
plotWindow $ [continFnPlot g]
          ++ [ legendName (rExpl++", nLocal="++show nLocal) . unitL2Plot $ range
                (fromUniformSampled (SigSampleConfig 256 16 nLocal 60 1e-6)
                                   (UArr.fromList $ g<$>[0.001, 0.002 .. 0.999]) :: UnitL2 Int Double )
             | nLocal <- [4]
             , (range,rExpl) <- [ (id,"all")
                                , (onSubchunks allZero ,"longrange")
                                , (sansLongrange . onSubchunks (onSubchunks allZero) ,"local")
                                , (sansLongrange . onSubchunks sansLongrange ,"local²") ] ]
          ++ [xInterval (0,1)]


GraphWindowSpecR2{lBound=0.5602681751910796, rBound=0.7439417583040417, bBound=-1.1755631480999977, tBound=1.2075062154241947, xResolution=640, yResolution=480}

In [ ]: