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

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

Author: bspangl
Date: 2013-04-08 06:35:58 +0200 (Mon, 08 Apr 2013)
New Revision: 62

Added:
   branches/robKalman_2012/pkg/robKalman/R/classEKF4.R
Modified:
   branches/robKalman_2012/pkg/robKalman/R/StepFunct.R
   branches/robKalman_2012/pkg/robKalman/R/allClass.R
Log:
classEKF4.R committed

Modified: branches/robKalman_2012/pkg/robKalman/R/StepFunct.R
===================================================================
--- branches/robKalman_2012/pkg/robKalman/R/StepFunct.R	2013-04-06 18:11:06 UTC (rev 61)
+++ branches/robKalman_2012/pkg/robKalman/R/StepFunct.R	2013-04-08 04:35:58 UTC (rev 62)
@@ -8,7 +8,7 @@
 ##        handle S4 oblects and will return the corresponding
 ##        S4 objects
 ##  author: Bernhard Spangl
-##  version: 0.1 (changed: 2013-02-09, created: 2013-02-09)
+##  version: 0.2 (changed: 2013-04-07, created: 2013-02-09)
 ##
 #######################################################
 

Modified: branches/robKalman_2012/pkg/robKalman/R/allClass.R
===================================================================
--- branches/robKalman_2012/pkg/robKalman/R/allClass.R	2013-04-06 18:11:06 UTC (rev 61)
+++ branches/robKalman_2012/pkg/robKalman/R/allClass.R	2013-04-08 04:35:58 UTC (rev 62)
@@ -20,6 +20,12 @@
 
 
 ### ClassUnion: 
+setClassUnion("OptionalNumeric",
+              c("NULL", "numeric")
+              )
+setClassUnion("OptionalMatrix",
+              c("NULL", "matrix")
+              )
 setClassUnion("OptionalList",
               c("list","NULL")
               )
@@ -128,10 +134,10 @@
          contains = c("VIRTUAL")
          )
 setClass("SSDiagnosticFilter",
-         contains = c("SSDiagnostic","list")
+         contains = c("SSDiagnostic","OptionalList")
          )
 setClass("SSDiagnosticRetValue",
-         contains = c("SSDiagnostic","list")
+         contains = c("SSDiagnostic","OptionalList")
          )
 setClass("SSVariances",
          contains = "array"
@@ -151,8 +157,10 @@
          representation = representation(values = "numeric",
                                          call = "OptionalCall",
                                          variance = "matrix",
-                                         dots.propagated = "list",
-                                         control = "list",
+                                         uExo = "OptionalNumeric",
+                                         wExo = "OptionalNumeric",
+                                         dots.propagated = "OptionalList",
+                                         control = "OptionalList",
                                          diagnostics = "SSDiagnosticFilter"),
          contains = "VIRTUAL"
          )
@@ -196,8 +204,10 @@
          representation = representation(values = "matrix",
                                          call = "OptionalListOfCalls",
                                          variances = "array",
-                                         dots.propagated = "list",
-                                         control = "list",
+                                         uExo = "OptionalMatrix",
+                                         wExo = "OptionalMatrix",
+                                         dots.propagated = "OptionalList",
+                                         control = "OptionalList",
                                          diagnostics = "SSDiagnosticFilter"),
          contains = "VIRTUAL"
          )

Added: branches/robKalman_2012/pkg/robKalman/R/classEKF4.R
===================================================================
--- branches/robKalman_2012/pkg/robKalman/R/classEKF4.R	                        (rev 0)
+++ branches/robKalman_2012/pkg/robKalman/R/classEKF4.R	2013-04-08 04:35:58 UTC (rev 62)
@@ -0,0 +1,61 @@
+#######################################################
+## 
+##  classical extended Kalman filter routines, S4
+##  author: Bernhard Spangl
+##  version: 0.1 (changed: 2013-04-07, created: 2013-04-07)
+##
+#######################################################
+
+.getDelta <-  function (S1, C, D, V)
+{
+##  calculates the Cov(Delta y_t)
+##      for S1 = S_{t|t-1}, C (=Z), D (=Id), V as above
+    H <- S1 %*% t(C)
+    ginv( C %*% H + D %*% V %*% t(D) )
+}
+
+.getKG <-  function (S1, Z, Delta)
+{
+##  calculates the Kalman Gain for S1 = S_{t|t-1}, Z, V as above
+    S1 %*% t(Z) %*% Delta 
+}
+
+.getcorrCov <-  function (S1, K, Z)
+{
+##  calculates S_{t|t} for S1 = S_{t|t-1}, K_t, Z as above
+    S1 - K %*% Z %*% S1 
+}
+
+.getpredCov <-  function (S0, A, B, Q)
+{
+##  calculates S_{t|t-1} for S0 = S_{t-1|t-1}, A (=F), B (=Id), Q as above
+    A %*% S0 %*% t(A) + B %*% Q %*% t(B)
+}
+
+
+
+cEKFpredS <- function (t,
+                       PredOrFilt,
+                       stateEq,
+                       controlPred = NULL, ...)
+{
+    ##  t ... time index
+    ##  PredOrFilt ... object of S4 class 'SSPredOrFilt'
+    ##  stateEq ... object of S4 class 'SSstateEq'
+    ##  controlPred ... control parameters, list
+    call <- match.call()
+    dots.propagated <- list(...)
+
+    
+
+    SSPredicted <- new("SSPredicted",
+                       values = x1,
+                       call = call,
+                       variance = S1,
+                       uExo = ,
+                       wExo = wOld,
+                       dots.propagated = dots.propagated,
+                       control = controlPred,
+                       diagnostics = new("SSDiagnosticFilter"))
+    return(SSPredicted)
+}