[Robkalman-commits] r68 - branches/robKalman_2012/pkg/robKalman/R

[noreply at r-forge.r-project.org]

Author: bspangl
Date: 2013-07-16 10:27:04 +0200 (Tue, 16 Jul 2013)
New Revision: 68

Added:
   branches/robKalman_2012/pkg/robKalman/R/recFilter4.R
Modified:
   branches/robKalman_2012/pkg/robKalman/R/allClass.R
   branches/robKalman_2012/pkg/robKalman/R/classEKF4.R
Log:
recursiveFilter Funktion

Modified: branches/robKalman_2012/pkg/robKalman/R/allClass.R
===================================================================
--- branches/robKalman_2012/pkg/robKalman/R/allClass.R	2013-07-16 07:44:58 UTC (rev 67)
+++ branches/robKalman_2012/pkg/robKalman/R/allClass.R	2013-07-16 08:27:04 UTC (rev 68)
@@ -176,6 +176,7 @@
                                          uExo = "OptionalNumeric",
                                          wExo = "OptionalNumeric",
                                          dots.propagated = "OptionalList",
+                                         ctrl.prpgtd = "OptionalList",
                                          control = "OptionalList",
                                          diagnostics = "SSDiagnosticFilter"),
          contains = "VIRTUAL"

Modified: branches/robKalman_2012/pkg/robKalman/R/classEKF4.R
===================================================================
--- branches/robKalman_2012/pkg/robKalman/R/classEKF4.R	2013-07-16 07:44:58 UTC (rev 67)
+++ branches/robKalman_2012/pkg/robKalman/R/classEKF4.R	2013-07-16 08:27:04 UTC (rev 68)
@@ -51,6 +51,7 @@
                          uExo = NULL,
                          wExo = NULL,
                          dots.propagated = dots.propagated,
+                         crtl.prpgtd = NULL, 
                          control = controlInit,
                          diagnostics = new("SSDiagnosticFilter"))
     return(SSInitialized)
@@ -75,6 +76,7 @@
     S0 <- PredOrFilt at variance
     uExo <- PredOrFilt at uExo
     wExo <- PredOrFilt at wExo
+    ctrl.prpgtd <- PredOrFilt at ctrl.prpgtd
     Ffct <- stateEq at Ffct
     Qfct <- stateEq at Qfct
     uExofct <- stateEq at uExofct
@@ -99,6 +101,7 @@
                        uExo = uNew,
                        wExo = wExo,
                        dots.propagated = dots.propagated,
+                       crtl.prpgtd = crtl.prpgtd, 
                        control = controlPred,
                        diagnostics = new("SSDiagnosticFilter"))
     return(SSPredicted)
@@ -126,6 +129,7 @@
     S1 <- PredOrFilt at variance
     uExo <- PredOrFilt at uExo
     wExo <- PredOrFilt at wExo
+    ctrl.prpgtd <- PredOrFilt at ctrl.prpgtd
     Zfct <- obsEq at Zfct
     Vfct <- obsEq at Vfct
     wExofct <- obsEq at wExofct
@@ -158,6 +162,7 @@
                       CovObs = Delta,
                       DeltaY = DeltaY,
                       dots.propagated = dots.propagated,
+                      crtl.prpgtd = crtl.prpgtd, 
                       control = controlCorr,
                       diagnostics = new("SSDiagnosticFilter"))
     return(SSFiltered)

Added: branches/robKalman_2012/pkg/robKalman/R/recFilter4.R
===================================================================
--- branches/robKalman_2012/pkg/robKalman/R/recFilter4.R	                        (rev 0)
+++ branches/robKalman_2012/pkg/robKalman/R/recFilter4.R	2013-07-16 08:27:04 UTC (rev 68)
@@ -0,0 +1,63 @@
+#######################################################
+## 
+##  recursive filter algorithm for Kalman filter routines, S4
+##  author: Bernhard Spangl
+##  version: 0.2 (changed: 2013-07-16, created: 2013-05-08)
+##
+#######################################################
+
+recFilter <- function (Model,
+                       Obs,
+                       times,
+                       Steps,
+                       ...)
+{
+     ##  Model ... object of S4 class 'SSM'
+     ##  Obs ... object of S4 class 'SSObs'
+     ##  times ... object of S4 class 'SStimes'
+     ##  Steps ... object of S4 class 'SSFilterOrSmoother'
+     call <- match.call()
+     dots.propagated <- list(...)
+
+     ##  unwrapping:
+     initEq <- Model at initEq
+     stateEq <- Model at stateEq
+     obsEq <- Model at obsEq
+
+     ##  time management:
+     tt <- times at times
+     inX <- times at inX
+     loopIndex <- 1:length(tt)
+
+     nrSteps <- length(Steps)
+
+     ##  initialization of resulting objects:
+     ini <- vector("list", nrSteps)
+     ps <- vector("list", nrSteps)
+     cs <- vector("list", nrSteps)
+     iniRet <- vector("list", nrSteps)
+     psRet <- vector("list", nrSteps)
+     csRet <- vector("list", nrSteps)
+
+     ##  initialization:
+     for (iStep in 1:nrStep) {
+         ini[[iStep]] <- Steps[[iStep]]@initStep(initEq=initEq, ...)
+     }
+     ### ab hier weiter wie oben!, 2013-07-16 ###
+     ### Schleife über Zeitpunkte t mit entsprechendem Time-Management ###
+
+         ##  preparation: TBD!
+         if (prep) {
+         }
+     
+         ##  prediction:
+         ps <- predSc(i=i, t=t,
+                      PredOrFilt=ini,
+                      stateEq=stateEq, ...)
+
+         ##  correction:
+         cs <- corrSc(i=i, t=t,
+                      Obs=Obs,
+                      PredOrFilt=ps,
+                      obsEq=obsEq, ...)
+