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

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

Author: ruckdeschel
Date: 2013-07-17 18:53:58 +0200 (Wed, 17 Jul 2013)
New Revision: 70

Added:
   branches/robKalman_2012/pkg/robKalman/R/updateinitSSPredOrFilterRet.R
Modified:
   branches/robKalman_2012/pkg/robKalman/R/recFilter4.R
Log:
Sitzung 17.7. abgelegt

Modified: branches/robKalman_2012/pkg/robKalman/R/recFilter4.R
===================================================================
--- branches/robKalman_2012/pkg/robKalman/R/recFilter4.R	2013-07-17 15:08:24 UTC (rev 69)
+++ branches/robKalman_2012/pkg/robKalman/R/recFilter4.R	2013-07-17 16:53:58 UTC (rev 70)
@@ -32,32 +32,74 @@
      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)
+     for(iStep in 1:nrStep){
+         psRet[[iStep]] <- initSSPredOrFiltRet(pdim = Model at pdim,
+                                   qdim = Model at qdim,
+                                   tfdim = sum(inX), tpdim = length(tt),
+                                   withuExo=!is.null(Model at SSstateEq@uExofct,
+                                   withwExo=!is.null(Model at SSobsEq@wExofct,
+                                   withdots.prop=(length(dots.propagated)>0),
+                                   withcontrol=(length(control)>0), ##?
+                                   withDiagnosticFilter=TRUE  ##?
+                                   )
+         csRet[[iStep]] <- initSSPredOrFiltRet(pdim = Model at pdim,
+                                   qdim = Model at qdim,
+                                   tfdim = sum(inX), tpdim = length(tt),
+                                   withuExo=!is.null(Model at SSstateEq@uExofct,
+                                   withwExo=!is.null(Model at SSobsEq@wExofct,
+                                   withdots.prop=(length(dots.propagated)>0),
+                                   withcontrol=(length(control)>0), ##?
+                                   withDiagnosticFilter=TRUE  ##?
+                                   )
 
-     ##  initialization:
+     }
+     ##  initialization:     iStep = index within different procedures
      for (iStep in 1:nrStep) {
-         ini[[iStep]] <- Steps[[iStep]]@initStep(initEq=initEq, ...)
+          cs[[iStep]] <- Steps[[iStep]]@initStep(initEq=initEq, ...)
      }
+     iniRet <- cs
      ### ab hier weiter wie oben!, 2013-07-16 ###
      ### Schleife über Zeitpunkte t mit entsprechendem Time-Management ###
 
+     iy <- 0
+     for(ix in loopIndex){
          ##  preparation: TBD!
-         if (prep) {
+         for (iStep in 1:nrStep) {
+              if (!is.null(Steps[[iStep]]@prepStep) {
+                  ### to be filled
+                  ##preps[[iStep]] <- Steps[[iStep]]@prepStep(i=ix, t=tt[ix],
+                  #                                   PredOrFilt=cs[[iStep]],
+                  #                                   stateEq=stateEq, ...)
+                  #prepsRet[[iStep]] <- updateSSPredOrFilt(prepsRet[[iStep]], preps[[iStep]],
+                  #                                 ix)
+                  #cs[[iStep]] <- preps[[iStep]]
+              }
          }
      
          ##  prediction:
-         ps <- predSc(i=i, t=t,
-                      PredOrFilt=ini,
-                      stateEq=stateEq, ...)
+         for (iStep in 1:nrStep) {
+              ps[[iStep]] <- Steps[[iStep]]@predStep(i=ix, t=tt[ix],
+                                                     PredOrFilt=cs[[iStep]],
+                                                     stateEq=stateEq, ...)
+              psRet[[iStep]] <- updateSSPredOrFilt(psRet[[iStep]], ps[[iStep]],
+                                                   ix)
+         }
 
          ##  correction:
-         cs <- corrSc(i=i, t=t,
-                      Obs=Obs,
-                      PredOrFilt=ps,
-                      obsEq=obsEq, ...)
-     
+         if(inX[ix]){ ## have an observation available
+            iy <- iy + 1
+            for (iStep in 1:nrStep) {
+                 cs[[iStep]] <- Steps[[iStep]]@corrStep(i=iy, t=tt[ix], Obs=Obs,
+                                                        PredOrFilt=ps[[iStep]],
+                                                        obsEq=obsEq, ...)
+                 csRet[[iStep]] <- updateSSPredOrFilt(csRet[[iStep]],
+                                                         cs[[iStep]], iy)
+            }
+         }else{
+            cs <- ps
+         }
+    }
\ No newline at end of file

Added: branches/robKalman_2012/pkg/robKalman/R/updateinitSSPredOrFilterRet.R
===================================================================
--- branches/robKalman_2012/pkg/robKalman/R/updateinitSSPredOrFilterRet.R	                        (rev 0)
+++ branches/robKalman_2012/pkg/robKalman/R/updateinitSSPredOrFilterRet.R	2013-07-17 16:53:58 UTC (rev 70)
@@ -0,0 +1,26 @@
+updateSSPredOrFiltRet <- function(old, new, i){
+  ### later: type checking
+  old at values[,i] <- new at values
+  if(!is.null(new at call)) old at call[[i]] <- new at call
+  old at variance[,,i] <- new at variance
+  if(!is.null(new at uExo)) old at uExo[,i] <- new at uExo
+  if(!is.null(new at wExo)) old at wExo[,i] <- new at wExo
+  if(!is.null(new at dots.propagated)) old at dots.propagated[[i]] <- new at dots.propagated
+  if(!is.null(new at control)&&i==1L) old at control <- new at control
+  if(!is.null(new at SSDiagnosticFilter)) old at SSDiagnosticFilter[[i]] <- new at SSDiagnosticFilter
+
+}
+
+initSSPredOrFiltRet <- function(pdim, qdim, tdim, withuExo, withwExo, withdots.prop,
+                                  withcontrol, withDiagnosticFilter){
+  v <- matrix(NA,pdim,tdim)
+  vm <- array(NA,dim=c(pdim,pdim,tdim))
+  uExo <- if(withuExo) matrix(NA,pdim,tdim) else NULL
+  wExo <- if(withwExo) matrix(NA,qdim,tdim) else NULL
+  dots.prop <- if(withdots.prop) vector("list", tdim) else NULL
+  control <- if(withcontrol) vector("list", tdim) else NULL
+  DiagnosticFilter <- if(DiagnosticFilter) vector("list",tdim) else NULL
+  new("SSPredOrFiltRet", value = v, variance = vm, uExo = uExo, wExo = wExo,
+              dot.propagated = dot.prop, control = control,
+              DiagnosticFilter = DiagnosticFilter)
+}
\ No newline at end of file