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

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

Author: bspangl
Date: 2013-05-18 14:53:49 +0200 (Sat, 18 May 2013)
New Revision: 66

Modified:
   branches/robKalman_2012/pkg/robKalman/R/allClass.R
   branches/robKalman_2012/pkg/robKalman/R/classEKF4.R
Log:
div. Zwischenschritte

Modified: branches/robKalman_2012/pkg/robKalman/R/allClass.R
===================================================================
--- branches/robKalman_2012/pkg/robKalman/R/allClass.R	2013-04-23 10:16:41 UTC (rev 65)
+++ branches/robKalman_2012/pkg/robKalman/R/allClass.R	2013-05-18 12:53:49 UTC (rev 66)
@@ -105,30 +105,36 @@
                                          predStep = "FunctionWithControl",
                                          corrStep = "FunctionWithControl")
          )
-setClass("SSrobFilter",
+setClassUnion("OptionalSSFilter",
+              c("SSFilter","NULL")
+              )
+setClass("SSRobFilter",
          representation = representation(classFilter = "SSFilter",
-                                         robFilter = "SSFilter")
+                                         robFilter = "OptionalSSFilter")
          )
 setClass("SSSmoother",
-         representation = representation(filt = "SSFilter",
-                                         smoothStep = "FunctionWithControl",
+         representation = representation(smoothStep = "FunctionWithControl",
                                          smoothCov = "FunctionWithControl",
-                                         lagoneCov = "FunctionWithControl")
+                                         lagoneCov = "FunctionWithControl"),
+         contains = "SSFilter"
          )
-setClass("SSrobSmoother",
+setClassUnion("OptionalSSSmoother",
+              c("SSSmoother","NULL")
+              )
+setClass("SSRobSmoother",
          representation = representation(classSmoother = "SSSmoother",
-                                         robSmoother = "SSSmoother")
+                                         robSmoother = "OptionalSSSmoother")
          )
 
-setClassUnion("SSClassOrRobFilter",
-              c("SSFilter", "SSrobFilter")
+## setClassUnion("SSClassOrRobFilter",
+##               c("SSFilter", "SSrobFilter")
+##               )
+## setClassUnion("SSClassOrRobSmoother",
+##               c("SSSmoother", "SSrobSmoother")
+##               )
+setClassUnion("SSFilterOrSmoother",
+              c("SSRobFilter", "SSRobSmoother")
               )
-setClassUnion("SSClassOrRobSmoother",
-              c("SSSmoother", "SSrobSmoother")
-              )
-setClassUnion("SSClassOrRobFilterOrSmoother",
-              c("SSClassOrRobFilter", "SSClassOrRobSmoother")
-              )
 
 setClass("SSDiagnostic",
          contains = c("VIRTUAL")
@@ -248,7 +254,7 @@
          representation = representation(model = "SSM",
                                          obs = "SSObs",
                                          times = "SStimes",
-                                         steps = "SSClassOrRobFilterOrSmoother")
+                                         steps = "SSFilterOrSmoother")
          )
 setClass("SSOutput",
          representation = representation(init.cl = "SSInitialized",

Modified: branches/robKalman_2012/pkg/robKalman/R/classEKF4.R
===================================================================
--- branches/robKalman_2012/pkg/robKalman/R/classEKF4.R	2013-04-23 10:16:41 UTC (rev 65)
+++ branches/robKalman_2012/pkg/robKalman/R/classEKF4.R	2013-05-18 12:53:49 UTC (rev 66)
@@ -2,7 +2,7 @@
 ## 
 ##  classical extended Kalman filter routines, S4
 ##  author: Bernhard Spangl
-##  version: 0.1 (changed: 2013-04-07, created: 2013-04-07)
+##  version: 0.3 (changed: 2013-05-08, created: 2013-04-07)
 ##
 #######################################################
 
@@ -32,6 +32,7 @@
     A %*% S0 %*% t(A) + B %*% Q %*% t(B)
 }
 
+new("FunctionWithControl", 
 cEKFinitS <- function (initEq,
                        controlInit = NULL, ...)
 {
@@ -54,13 +55,16 @@
                          diagnostics = new("SSDiagnosticFilter"))
     return(SSInitialized)
 }
+)
 
-cEKFpredS <- function (t,
+new("FunctionWithControl", 
+cEKFpredS <- function (i, t,
                        PredOrFilt,
                        stateEq,
                        controlPred = NULL, ...)
 {
-    ##  t ... time index
+    ##  i ... loop index
+    ##  t ... time, t[i]
     ##  PredOrFilt ... object of S4 class 'SSPredOrFilt'
     ##  stateEq ... object of S4 class 'SSstateEq'
     ##  controlPred ... control parameters, list
@@ -76,14 +80,14 @@
     uExofct <- stateEq at uExofct
     if (is.null(uExofct)) uExofct <- createuExo(0)
 
-    Freturn <- Ffct(t=t, x0=x0,
+    Freturn <- Ffct(i=i, t=t, x0=x0,
                     uFct=uExofct, uOld=uExo, wNew=wExo)
     x1 <- Freturn at x1
     A <- Freturn at FJcb
     B <- Freturn at RJcb
     uNew <- Freturn at uNew
 
-    Qreturn <- Qfct(t=t, x0=x0)
+    Qreturn <- Qfct(i=i, t=t, x0=x0)
     Q <- Qreturn at Q
 
     S1 <- .getpredCov(S0=S0, A=A, B=B, Q=Q)
@@ -99,7 +103,9 @@
                        diagnostics = new("SSDiagnosticFilter"))
     return(SSPredicted)
 }
+)
 
+new("FunctionWithControl", 
 cEKFcorrS <- function (i, t,
                        Obs,
                        PredOrFilt,
@@ -125,14 +131,14 @@
     wExofct <- obsEq at wExofct
     if (is.null(wExofct)) wExofct <- createwExo(0)
 
-    Zreturn <- Zfct(t=t, x1=x1,
+    Zreturn <- Zfct(i=i, t=t, x1=x1, y=y, 
                     wFct=wExofct, uNew=uExo, wOld=wExo)
     yhat <- Zreturn at y
     C <- Zreturn at ZJcb
     D <- Zreturn at TJcb
     wNew <- Zreturn at wNew
 
-    Vreturn <- Vfct(t=t, x1=x1)
+    Vreturn <- Vfct(i=i, t=t, x1=x1)
     V <- Vreturn at V
 
     Delta <- .getDelta(S1=S1, C=C, D=D, V=V)
@@ -156,4 +162,5 @@
                       diagnostics = new("SSDiagnosticFilter"))
     return(SSFiltered)
 }
+)