[Robkalman-commits] r39 - in branches/robKalman_bs/pkg/robKalman: . R chm demo inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 23 21:51:17 CEST 2009
Author: bspangl
Date: 2009-07-23 21:51:16 +0200 (Thu, 23 Jul 2009)
New Revision: 39
Added:
branches/robKalman_bs/pkg/robKalman/DESCRIPTION
branches/robKalman_bs/pkg/robKalman/NAMESPACE
branches/robKalman_bs/pkg/robKalman/R/
branches/robKalman_bs/pkg/robKalman/R/0AllClass.R
branches/robKalman_bs/pkg/robKalman/R/ACMfilt.R
branches/robKalman_bs/pkg/robKalman/R/ACMfilter.R
branches/robKalman_bs/pkg/robKalman/R/AllGeneric.R
branches/robKalman_bs/pkg/robKalman/R/AllGenerics.R
branches/robKalman_bs/pkg/robKalman/R/AllInitialize.R
branches/robKalman_bs/pkg/robKalman/R/AllPlot.R
branches/robKalman_bs/pkg/robKalman/R/AllShow.R
branches/robKalman_bs/pkg/robKalman/R/Psi.R
branches/robKalman_bs/pkg/robKalman/R/Util.R
branches/robKalman_bs/pkg/robKalman/R/arGM.R
branches/robKalman_bs/pkg/robKalman/R/arGMinternal.R
branches/robKalman_bs/pkg/robKalman/R/calibrateRLS.R
branches/robKalman_bs/pkg/robKalman/R/classKalman.R
branches/robKalman_bs/pkg/robKalman/R/mACMfilter.R
branches/robKalman_bs/pkg/robKalman/R/mACMinternal.R
branches/robKalman_bs/pkg/robKalman/R/rLSfilter.R
branches/robKalman_bs/pkg/robKalman/R/recFilter.R
branches/robKalman_bs/pkg/robKalman/R/recFilterInternal.R
branches/robKalman_bs/pkg/robKalman/R/simulateSScont.R
branches/robKalman_bs/pkg/robKalman/chm/
branches/robKalman_bs/pkg/robKalman/chm/00Index.html
branches/robKalman_bs/pkg/robKalman/chm/0robKalman-package.html
branches/robKalman_bs/pkg/robKalman/chm/ACMfilt.html
branches/robKalman_bs/pkg/robKalman/chm/Logo.jpg
branches/robKalman_bs/pkg/robKalman/chm/Rchm.css
branches/robKalman_bs/pkg/robKalman/chm/arGM.html
branches/robKalman_bs/pkg/robKalman/chm/calibrateRLS.html
branches/robKalman_bs/pkg/robKalman/chm/internalACM.html
branches/robKalman_bs/pkg/robKalman/chm/internalKalman.html
branches/robKalman_bs/pkg/robKalman/chm/internalarGM.html
branches/robKalman_bs/pkg/robKalman/chm/internalpsi.html
branches/robKalman_bs/pkg/robKalman/chm/internalrLS.html
branches/robKalman_bs/pkg/robKalman/chm/recFilter.html
branches/robKalman_bs/pkg/robKalman/chm/robKalman.chm
branches/robKalman_bs/pkg/robKalman/chm/robKalman.hhp
branches/robKalman_bs/pkg/robKalman/chm/robKalman.toc
branches/robKalman_bs/pkg/robKalman/chm/simulateSScont.html
branches/robKalman_bs/pkg/robKalman/chm/util.html
branches/robKalman_bs/pkg/robKalman/demo/
branches/robKalman_bs/pkg/robKalman/demo/00Index
branches/robKalman_bs/pkg/robKalman/demo/ACMdemo.R
branches/robKalman_bs/pkg/robKalman/demo/rLSdemo.R
branches/robKalman_bs/pkg/robKalman/inst/
branches/robKalman_bs/pkg/robKalman/inst/NEWS
branches/robKalman_bs/pkg/robKalman/man/
branches/robKalman_bs/pkg/robKalman/man/0robKalman-package.Rd
branches/robKalman_bs/pkg/robKalman/man/ACMfilt.Rd
branches/robKalman_bs/pkg/robKalman/man/arGM.Rd
branches/robKalman_bs/pkg/robKalman/man/calibrateRLS.Rd
branches/robKalman_bs/pkg/robKalman/man/internalACM.Rd
branches/robKalman_bs/pkg/robKalman/man/internalKalman.Rd
branches/robKalman_bs/pkg/robKalman/man/internalarGM.Rd
branches/robKalman_bs/pkg/robKalman/man/internalpsi.Rd
branches/robKalman_bs/pkg/robKalman/man/internalrLS.Rd
branches/robKalman_bs/pkg/robKalman/man/recFilter.Rd
branches/robKalman_bs/pkg/robKalman/man/simulateSScont.Rd
branches/robKalman_bs/pkg/robKalman/man/util.Rd
Removed:
branches/robKalman_bs/pkg/robKalman/DESCRIPTION
branches/robKalman_bs/pkg/robKalman/NAMESPACE
branches/robKalman_bs/pkg/robKalman/R/
branches/robKalman_bs/pkg/robKalman/R/0AllClass.R
branches/robKalman_bs/pkg/robKalman/R/ACMfilt.R
branches/robKalman_bs/pkg/robKalman/R/ACMfilter.R
branches/robKalman_bs/pkg/robKalman/R/AllGeneric.R
branches/robKalman_bs/pkg/robKalman/R/AllGenerics.R
branches/robKalman_bs/pkg/robKalman/R/AllInitialize.R
branches/robKalman_bs/pkg/robKalman/R/AllPlot.R
branches/robKalman_bs/pkg/robKalman/R/AllShow.R
branches/robKalman_bs/pkg/robKalman/R/Psi.R
branches/robKalman_bs/pkg/robKalman/R/Util.R
branches/robKalman_bs/pkg/robKalman/R/arGM.R
branches/robKalman_bs/pkg/robKalman/R/arGMinternal.R
branches/robKalman_bs/pkg/robKalman/R/calibrateRLS.R
branches/robKalman_bs/pkg/robKalman/R/classKalman.R
branches/robKalman_bs/pkg/robKalman/R/mACMfilter.R
branches/robKalman_bs/pkg/robKalman/R/mACMinternal.R
branches/robKalman_bs/pkg/robKalman/R/rLSfilter.R
branches/robKalman_bs/pkg/robKalman/R/recFilter.R
branches/robKalman_bs/pkg/robKalman/R/simulateSScont.R
branches/robKalman_bs/pkg/robKalman/chm/
branches/robKalman_bs/pkg/robKalman/chm/00Index.html
branches/robKalman_bs/pkg/robKalman/chm/0robKalman-package.html
branches/robKalman_bs/pkg/robKalman/chm/ACMfilt.html
branches/robKalman_bs/pkg/robKalman/chm/Logo.jpg
branches/robKalman_bs/pkg/robKalman/chm/Rchm.css
branches/robKalman_bs/pkg/robKalman/chm/arGM.html
branches/robKalman_bs/pkg/robKalman/chm/calibrateRLS.html
branches/robKalman_bs/pkg/robKalman/chm/internalACM.html
branches/robKalman_bs/pkg/robKalman/chm/internalKalman.html
branches/robKalman_bs/pkg/robKalman/chm/internalarGM.html
branches/robKalman_bs/pkg/robKalman/chm/internalpsi.html
branches/robKalman_bs/pkg/robKalman/chm/internalrLS.html
branches/robKalman_bs/pkg/robKalman/chm/recFilter.html
branches/robKalman_bs/pkg/robKalman/chm/robKalman.chm
branches/robKalman_bs/pkg/robKalman/chm/robKalman.hhp
branches/robKalman_bs/pkg/robKalman/chm/robKalman.toc
branches/robKalman_bs/pkg/robKalman/chm/simulateSScont.html
branches/robKalman_bs/pkg/robKalman/chm/util.html
branches/robKalman_bs/pkg/robKalman/demo/
branches/robKalman_bs/pkg/robKalman/demo/00Index
branches/robKalman_bs/pkg/robKalman/demo/ACMdemo.R
branches/robKalman_bs/pkg/robKalman/demo/rLSdemo.R
branches/robKalman_bs/pkg/robKalman/inst/
branches/robKalman_bs/pkg/robKalman/inst/NEWS
branches/robKalman_bs/pkg/robKalman/man/
branches/robKalman_bs/pkg/robKalman/man/0robKalman-package.Rd
branches/robKalman_bs/pkg/robKalman/man/ACMfilt.Rd
branches/robKalman_bs/pkg/robKalman/man/arGM.Rd
branches/robKalman_bs/pkg/robKalman/man/calibrateRLS.Rd
branches/robKalman_bs/pkg/robKalman/man/internalACM.Rd
branches/robKalman_bs/pkg/robKalman/man/internalKalman.Rd
branches/robKalman_bs/pkg/robKalman/man/internalarGM.Rd
branches/robKalman_bs/pkg/robKalman/man/internalpsi.Rd
branches/robKalman_bs/pkg/robKalman/man/internalrLS.Rd
branches/robKalman_bs/pkg/robKalman/man/recFilter.Rd
branches/robKalman_bs/pkg/robKalman/man/simulateSScont.Rd
branches/robKalman_bs/pkg/robKalman/man/util.Rd
Log:
updating my branch 'robKalman_bs'
(Bernhard Spangl, 2009-07-23)
Deleted: branches/robKalman_bs/pkg/robKalman/DESCRIPTION
===================================================================
--- branches/robKalman_bs/pkg/robKalman/DESCRIPTION 2009-07-23 15:42:12 UTC (rev 38)
+++ branches/robKalman_bs/pkg/robKalman/DESCRIPTION 2009-07-23 19:51:16 UTC (rev 39)
@@ -1,14 +0,0 @@
-Package: robKalman
-Version: 0.3
-Date: 2009-03-18
-Title: Robust Kalman Filtering
-Description: Routines for Robust Kalman Filtering --- the ACM- and rLS-filter
-Author: Peter Ruckdeschel, Bernhard Spangl, Irina Ursachi, Cezar Chirila
-Maintainer: Peter Ruckdeschel <Peter.Ruckdeschel at itwm.fraunhofer.de>
-Depends: R(>= 2.3.0), methods, graphics, startupmsg, dse1, dse2, MASS, limma, robustbase, numDeriv
-Imports: stats, MASS
-LazyLoad: yes
-License: LGPL-3
-URL: http://robkalman.r-forge.r-project.org/
-LastChangedDate: {$LastChangedDate: 2009-03-31 15:31:30 +0200 (Di, 31 Mrz 2009) $}
-LastChangedRevision: {$LastChangedRevision: 447 $}
Copied: branches/robKalman_bs/pkg/robKalman/DESCRIPTION (from rev 38, branches/robKalman_bs/pkg/robKalman/DESCRIPTION)
===================================================================
--- branches/robKalman_bs/pkg/robKalman/DESCRIPTION (rev 0)
+++ branches/robKalman_bs/pkg/robKalman/DESCRIPTION 2009-07-23 19:51:16 UTC (rev 39)
@@ -0,0 +1,14 @@
+Package: robKalman
+Version: 0.3
+Date: 2009-06-14
+Title: Robust Kalman Filtering
+Description: Routines for Robust Kalman Filtering --- the ACM- and rLS-filter
+Author: Peter Ruckdeschel, Bernhard Spangl
+Maintainer: Peter Ruckdeschel <Peter.Ruckdeschel at itwm.fraunhofer.de>
+Depends: R(>= 2.3.0), methods, graphics, startupmsg, dse1, dse2, MASS, limma, robustbase, numDeriv
+Imports: stats, MASS
+LazyLoad: yes
+License: LGPL-3
+URL: http://robkalman.r-forge.r-project.org/
+LastChangedDate: {$LastChangedDate: 2009-06-09 20:21:49 +0200 (Di, 09 Jun 2009) $}
+LastChangedRevision: {$LastChangedRevision: 30 $}
Deleted: branches/robKalman_bs/pkg/robKalman/NAMESPACE
===================================================================
--- branches/robKalman_bs/pkg/robKalman/NAMESPACE 2009-07-23 15:42:12 UTC (rev 38)
+++ branches/robKalman_bs/pkg/robKalman/NAMESPACE 2009-07-23 19:51:16 UTC (rev 39)
@@ -1,8 +0,0 @@
-import("methods")
-import("stats")
-import("startupmsg")
-
-export("ACMfilt", "ACMfilter", "arGM", "Euclidnorm",
- "simulateState", "simulateObs", "rcvmvnorm", "Huberize",
- "rLScalibrateB", "limitS", "rLSFilter", "KalmanFilter",
- "recursiveFilter")
Copied: branches/robKalman_bs/pkg/robKalman/NAMESPACE (from rev 38, branches/robKalman_bs/pkg/robKalman/NAMESPACE)
===================================================================
--- branches/robKalman_bs/pkg/robKalman/NAMESPACE (rev 0)
+++ branches/robKalman_bs/pkg/robKalman/NAMESPACE 2009-07-23 19:51:16 UTC (rev 39)
@@ -0,0 +1,13 @@
+import("methods")
+import("stats")
+import("MASS")
+import("startupmsg")
+import("limma")
+import("robustbase")
+import("numDeriv")
+
+export("ACMfilt", "ACMfilter", "arGM", "EuclideanNorm",
+ "simulateState", "simulateObs", "rcvmvnorm", "Huberize",
+ "rLScalibrateB", "limitS", "rLSFilter", "rLS.IO.Filter",
+ "rLS.AO.Filter", "KalmanFilter",
+ "recursiveFilter")
Copied: branches/robKalman_bs/pkg/robKalman/R (from rev 38, branches/robKalman_bs/pkg/robKalman/R)
Deleted: branches/robKalman_bs/pkg/robKalman/R/0AllClass.R
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/0AllClass.R 2009-07-23 15:42:12 UTC (rev 38)
+++ branches/robKalman_bs/pkg/robKalman/R/0AllClass.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -1,68 +0,0 @@
-.onLoad <- function(lib, pkg){
- require("methods", character = TRUE, quietly = TRUE)
-
-}
-
-
-.onAttach <- function(library, pkg)
-{
-buildStartupMessage(pkg="robKalman", library=library, packageHelp=TRUE #,
- #MANUAL=""
- )
- invisible()
-}
-
-#.onUnload <- function(libpath)
-#{
-# library.dynam.unload("distrEx", libpath)
-#}
-#
-#
-## register zoo as "S4"-class
-setOldClass("zoo")
-#
-setClassUnion("Hyperparamtype",
- c("NULL","matrix", "array", "zoo")
- )
-
-#
-#
-#
-#
-## positive definite, symmetric matrices with finite entries
-#setClass("ACMcontrol",representation())
-#setClass("rLScontrol",representation())
-#
-#
-#
-#
-# class SSM --- State space model
-setClass("SSM",
- representation = representation(
- name = "character", ## name of the ssm
- F = "Hyperparamtype", ## transition matrix/ces or NULL
- Z = "Hyperparamtype", ## observation matrix/ces or NULL
- Q = "Hyperparamtype", ## innovation covariance or NULL
- V = "Hyperparamtype", ## observation error covariance or NULL
- p = "numeric", ## state dimension
- q = "numeric"), ## observation dimension
- prototype = prototype(name = gettext("a state space"),
- F = NULL,
- Z = NULL,
- Q = NULL,
- V = NULL,
- p = 1,
- q = 1),
- contains = "VIRTUAL")
-
-# class TimeInvariantSSM
-setClass("TimeInvariantSSM",
- prototype = prototype(name = gettext("a time-invariant state space"),
- F = 1,
- Z = 1,
- Q = 1,
- V = 1,
- p = 1,
- q = 1),
- contains = "SSM")
-
\ No newline at end of file
Copied: branches/robKalman_bs/pkg/robKalman/R/0AllClass.R (from rev 38, branches/robKalman_bs/pkg/robKalman/R/0AllClass.R)
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/0AllClass.R (rev 0)
+++ branches/robKalman_bs/pkg/robKalman/R/0AllClass.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -0,0 +1,14 @@
+.onLoad <- function(lib, pkg){
+ require("methods", character = TRUE, quietly = TRUE)
+
+}
+
+
+.onAttach <- function(library, pkg)
+{
+buildStartupMessage(pkg="robKalman", library=library, packageHelp=TRUE #,
+ #MANUAL=""
+ )
+ invisible()
+}
+
Deleted: branches/robKalman_bs/pkg/robKalman/R/ACMfilt.R
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/ACMfilt.R 2009-07-23 15:42:12 UTC (rev 38)
+++ branches/robKalman_bs/pkg/robKalman/R/ACMfilt.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -1,78 +0,0 @@
-ACMfilt <- function (x, gm, s0=0,
- psi="Hampel", a=2.5, b=a, c=5.0,
- flag="weights", lagsmo=TRUE)
-{
-###########################################
-##
-## R-function: ACMfilt - approximate conditional-mean filtering (wrapper)
-## author: Bernhard Spangl
-## version: 1.1 (2007-08-13 and 2006-08-31)
-## References:
-## [Mart79c] R.D. Martin, Approximate Conditional-mean Type Smoothers
-## and Interpolators (1979)
-## [Mart81b] R.D. Martin, Robust Methods for Time Series (1981)
-## [MarT82b] R.D. Martin & D.J. Thomson, Robust-resistent Spectrum
-## Estimation (1982)
-##
-###########################################
-
-## Paramters:
-## x ... univariate time series (vector)
-## gm ... list as produced by function 'arGM' which includes components
-## 'ar' containing the AR(p) coefficient estimates, 'sinnov' containing
-## innovation scale estiamtes from AR(p) fits of orders 1 through p;
-## 'Cx' containing an estimate of the p by p autocovariance matrix,
-## and 'mu', the estimated mean of 'x'.
-## s0 ... scale of nominal Gaussian component of the additive noise
-## psi ... influence function to be used (default: "Hampel",
-## only Hampel's psi function available at the moment)
-## a, b, c ... tuning constants for Hampel's psi-function
-## (defaul: a=b=2.5, c=5.0)
-## flag ... character, if "weights" (default), use psi(t)/t to calculate
-## the weights; if "deriv", use psi'(t)
-## lagsmo ... logical, if TRUE (default) lag p-1 smoothing is performed;
-## if FALSE filtering from the top of ^X_t is performed
-
-## Variable definitions:
-
- N <- length(x)
- phi <- gm$ar
- p <- length(phi)
- si <- gm$sinnov[p]
- Cx <- gm$Cx
- Phi <- cbind(rbind(phi[-p], diag(rep(1, (p-1)))), c(phi[p], rep(0, (p-1))))
- Q <- matrix(0, p, p)
-## Q <- diag(rep(0, p))
- Q[1, 1] <- si^2
-
- m0 <- rep(0, p)
- H <- matrix(c(1, rep(0, (p-1))), 1, p)
- V <- matrix(s0^2)
- psi <- .psi(psi)
-
- ## Centering:
- x <- x - gm$mu
- ACMres <- ACMfilter(Y=matrix(x,1,N), a=m0, S=Cx, F=Phi, Q=Q, Z=H, V=V, s0=s0, psi=psi, apsi=a, bpsi=b, cpsi=c, flag=flag)
-
- X.ck <- ACMres$Xf; X.ck <- X.ck[,2:(N+1)]
- X <- ACMres$Xrf; X <- X[,2:(N+1)]
- st <- as.numeric(unlist(ACMres$rob1L))
-
-
- if (!lagsmo) {
- x.ck <- X.ck[1, ]
- x <- X[1, ]
- } else {
- x.ck <- c(X.ck[p, p:N], X.ck[(p-1):1, N])
- x <- c(X[p, p:N], X[(p-1):1, N])
- }
-
-## ARmodel <- .ARmodel(x, p)
-## y <- ARmodel$y
-## Z <- ARmodel$Z
-## r <- resid(lm.fit(Z, y))
-
- return(list(filt.ck=x.ck +gm$mu, filt=x + gm$mu, st=st)) #,
-## r=c(rep(NA, p), r)))
-
-}
Copied: branches/robKalman_bs/pkg/robKalman/R/ACMfilt.R (from rev 38, branches/robKalman_bs/pkg/robKalman/R/ACMfilt.R)
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/ACMfilt.R (rev 0)
+++ branches/robKalman_bs/pkg/robKalman/R/ACMfilt.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -0,0 +1,81 @@
+ACMfilt <- function (x, gm, s0=0,
+ psi="Hampel", a=2.5, b=a, c=5.0,
+ flag="weights", lagsmo=TRUE)
+{
+###########################################
+##
+## R-function: ACMfilt - approximate conditional-mean filtering (wrapper)
+## author: Bernhard Spangl
+## version: 1.1 (2007-08-13 and 2006-08-31)
+## References:
+## [Mart79c] R.D. Martin, Approximate Conditional-mean Type Smoothers
+## and Interpolators (1979)
+## [Mart81b] R.D. Martin, Robust Methods for Time Series (1981)
+## [MarT82b] R.D. Martin & D.J. Thomson, Robust-resistent Spectrum
+## Estimation (1982)
+##
+###########################################
+
+## Paramters:
+## x ... univariate time series (vector)
+## gm ... list as produced by function 'arGM' which includes components
+## 'ar' containing the AR(p) coefficient estimates, 'sinnov' containing
+## innovation scale estiamtes from AR(p) fits of orders 1 through p;
+## 'Cx' containing an estimate of the p by p autocovariance matrix,
+## and 'mu', the estimated mean of 'x'.
+## s0 ... scale of nominal Gaussian component of the additive noise
+## psi ... influence function to be used (default: "Hampel",
+## only Hampel's psi function available at the moment)
+## a, b, c ... tuning constants for Hampel's psi-function
+## (defaul: a=b=2.5, c=5.0)
+## flag ... character, if "weights" (default), use psi(t)/t to calculate
+## the weights; if "deriv", use psi'(t)
+## lagsmo ... logical, if TRUE (default) lag p-1 smoothing is performed;
+## if FALSE filtering from the top of ^X_t is performed
+
+## Variable definitions:
+
+ N <- length(x)
+ phi <- gm$ar
+ p <- length(phi)
+ si <- gm$sinnov[p]
+ Cx <- gm$Cx
+ Phi <- cbind(rbind(phi[-p], diag(rep(1, (p-1)))), c(phi[p], rep(0, (p-1))))
+ Q <- matrix(0, p, p)
+## Q <- diag(rep(0, p))
+ Q[1, 1] <- si^2
+
+ m0 <- rep(0, p)
+ H <- matrix(c(1, rep(0, (p-1))), 1, p)
+ V <- matrix(s0^2)
+ psi <- .psi(psi)
+
+ ## Centering:
+ x <- x - gm$mu
+ ACMres <- ACMfilter(Y=array(x,dim=c(1,1,N)), a=m0, S=Cx,
+ F=Phi, Q=Q, Z=H, V=V, s0=s0,
+ psi=psi, apsi=a, bpsi=b, cpsi=c,
+ flag=flag)
+
+ X.ck <- ACMres$Xf; X.ck <- X.ck[,2:(N+1)]
+ X <- ACMres$Xrf; X <- X[,2:(N+1)]
+ st <- as.numeric(unlist(ACMres$rob1L))
+
+
+ if (!lagsmo) {
+ x.ck <- X.ck[1, ]
+ x <- X[1, ]
+ } else {
+ x.ck <- c(X.ck[p, p:N], X.ck[(p-1):1, N])
+ x <- c(X[p, p:N], X[(p-1):1, N])
+ }
+
+## ARmodel <- .ARmodel(x, p)
+## y <- ARmodel$y
+## Z <- ARmodel$Z
+## r <- resid(lm.fit(Z, y))
+
+ return(list(filt.ck=x.ck +gm$mu, filt=x + gm$mu, st=st)) #,
+## r=c(rep(NA, p), r)))
+
+}
Deleted: branches/robKalman_bs/pkg/robKalman/R/ACMfilter.R
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/ACMfilter.R 2009-07-23 15:42:12 UTC (rev 38)
+++ branches/robKalman_bs/pkg/robKalman/R/ACMfilter.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -1,92 +0,0 @@
-.getcorrCovACM <- function (S1, K, Z, W=diag(nrow(Z)))
-{
-###########################################
-##
-## R-function: .corrCov - computes filtering error covarince matrix
-## (internal function)
-## author: Bernhard Spangl
-## version: 1.0 (2006-05-22)
-##
-###########################################
-
-## Paramters:
-## S1 ... prediction error covariance matrix
-## K ... Kalman gain
-## W ... weight matrix
-## Z ... observation matrix
-
- S1 - K %*% W %*% Z %*% S1
-}
-
-##steps for classical Kalman filter (cK)
-.ACMinitstep <- function(a, S, ...)
- {dots <- list(...)
- if(hasArg("s0"))
- s0<-dots$"s0"
- else
- s0<-NULL
- list( x0 = a, S0 = S, s0 = s0)}
-
-
-.ACMpredstep <- function (x0, S0, F, Q, rob0, s0, ...) ### S=P F= Phi
-{
-###########################################
-##
-## R-function: .ACMpredstep - prediction step (internal function)
-## author: Bernhard Spangl
-## version: 1.0 (2006-05-22)
-##
-###########################################
-
-## Paramters:
-## x0 ... state vector (filter estimate)
-## F=Phi ... design matrix of state equation
-## S0 ... filtering error covariance matrix
-## Q ... covariance matrix of state innovation process
-## rob0 ... general robust parameter --- here: scale s0 of nominal Gaussain component of additive noise
- S1 <- .getpredCov(S0, F, Q)
- return(list(x1 = F %*% x0, S1 = S1, rob1 = sqrt(S1[1, 1] + s0), Ind=1))
-}
-
-.ACMcorrstep <- function (y, x1, S1, Z, V, rob1, dum=NULL, psi, apsi, bpsi, cpsi, flag, ...)
-{
-###########################################
-##
-## R-function: .ACMcorrstep - correction step (internal function)
-## author: Bernhard Spangl
-## version: 1.0 (2006-05-22)
-##
-###########################################
-
-## Paramters:
-## y ... univariate time series
-## x1 ... state vector (one-step-ahead predictor)
-## rob1 ... general robust parameter --- here st ... time-dependent scale parameter
-## S1 ... prediction error covariance matrix
-## Z ... observation matrix
-## dum ... dummy variable for compatibility with ... argument of calling function
-## V ... covariance matrix of observation noise
-## psi ... influence function to be used
-## a, b, c ... tuning constants for Hampel's psi-function
-## (defaul: a=b=2.5, c=5.0)
-## flag ... character, if "weights" (default), use psi(t)/t to calculate
-## the weights; if "deriv", use psi'(t)
-
- st <- rob1
-
- K <- .getKG(S1, Z, V)
-
- rst <- (y - x1[1])/st
-
- ps <- psi(rst, apsi, bpsi, cpsi)
- dx <- K * st * ps
- x0 <- x1 + dx
-
- ind <- (abs(rst-ps)>10^-8)
-
- w <- psi(rst, apsi, bpsi, cpsi, flag)
-
- S0 <- .getcorrCovACM(S1, K, Z, W = w*diag(rep(1, nrow(Z))))
-
- return(list(x0 = x0, K = K, S0 = S0, Ind=ind, rob0=rob1))
-}
Copied: branches/robKalman_bs/pkg/robKalman/R/ACMfilter.R (from rev 38, branches/robKalman_bs/pkg/robKalman/R/ACMfilter.R)
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/ACMfilter.R (rev 0)
+++ branches/robKalman_bs/pkg/robKalman/R/ACMfilter.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -0,0 +1,91 @@
+.getcorrCovACM <- function (S1, K, Z, W=diag(nrow(Z)))
+{
+###########################################
+##
+## R-function: .corrCov - computes filtering error covarince matrix
+## (internal function)
+## author: Bernhard Spangl
+## version: 1.0 (2006-05-22)
+##
+###########################################
+
+## Paramters:
+## S1 ... prediction error covariance matrix
+## K ... Kalman gain
+## W ... weight matrix
+## Z ... observation matrix
+
+ S1 - K %*% W %*% Z %*% S1
+}
+
+##steps for classical Kalman filter (cK)
+.ACMinitstep <- function(a, S, ...)
+ {dots <- list(...)
+ if(hasArg("s0"))
+ s0<-dots$"s0"
+ else
+ s0<-NULL
+ list( x0 = a, S0 = S, s0 = s0)}
+
+.ACMpredstep <- function (x0, S0, F, Q, i, rob0, s0, ...) ### S=P F= Phi
+{
+###########################################
+##
+## R-function: .ACMpredstep - prediction step (internal function)
+## author: Bernhard Spangl
+## version: 1.0 (2006-05-22)
+##
+###########################################
+
+## Paramters:
+## x0 ... state vector (filter estimate)
+## F=Phi ... design matrix of state equation
+## S0 ... filtering error covariance matrix
+## Q ... covariance matrix of state innovation process
+## rob0 ... general robust parameter --- here: scale s0 of nominal Gaussain component of additive noise
+ S1 <- .getpredCov(S0, F, Q)
+ return(list(x1 = F %*% x0, S1 = S1, rob1 = sqrt(S1[1, 1] + s0), Ind=1))
+}
+
+.ACMcorrstep <- function (y, x1, S1, Z, V, i, rob1, dum=NULL, psi, apsi, bpsi, cpsi, flag, ...)
+{
+###########################################
+##
+## R-function: .ACMcorrstep - correction step (internal function)
+## author: Bernhard Spangl
+## version: 1.0 (2006-05-22)
+##
+###########################################
+
+## Paramters:
+## y ... univariate time series
+## x1 ... state vector (one-step-ahead predictor)
+## rob1 ... general robust parameter --- here st ... time-dependent scale parameter
+## S1 ... prediction error covariance matrix
+## Z ... observation matrix
+## dum ... dummy variable for compatibility with ... argument of calling function
+## V ... covariance matrix of observation noise
+## psi ... influence function to be used
+## a, b, c ... tuning constants for Hampel's psi-function
+## (defaul: a=b=2.5, c=5.0)
+## flag ... character, if "weights" (default), use psi(t)/t to calculate
+## the weights; if "deriv", use psi'(t)
+ st <- rob1
+
+ K <- .getKG(S1, Z, V)
+
+ rst <- (y - x1[1])/st
+
+ ps <- psi(rst, apsi, bpsi, cpsi)[1,1]
+ dx <- K * st * ps
+ x0 <- x1 + dx
+
+ ind <- (abs(rst-ps)>10^-8)
+
+ w <- psi(rst, apsi, bpsi, cpsi, flag)
+
+ S0 <- .getcorrCovACM(S1, K, Z, W = w*diag(rep(1, nrow(Z))))
+ Delta <- Z %*% S0 %*% t(Z) + V
+
+ return(list(x0 = x0, K = K, S0 = S0, Delta=Delta, Ind=ind, rob0=rob1, DeltaY = rst))
+}
Deleted: branches/robKalman_bs/pkg/robKalman/R/AllGeneric.R
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/AllGeneric.R 2009-07-23 15:42:12 UTC (rev 38)
+++ branches/robKalman_bs/pkg/robKalman/R/AllGeneric.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -1,10 +0,0 @@
-#if(!isGeneric("type")){
-# setGeneric("type", function(object) standardGeneric("type"))
-#}
-#if(!isGeneric("center")){
-# setGeneric("center", function(object) standardGeneric("center"))
-#}
-#if(!isGeneric("center<-")){
-# setGeneric("center<-", function(object, value) standardGeneric("center<-"))
-#}
-#
Copied: branches/robKalman_bs/pkg/robKalman/R/AllGeneric.R (from rev 38, branches/robKalman_bs/pkg/robKalman/R/AllGeneric.R)
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/AllGeneric.R (rev 0)
+++ branches/robKalman_bs/pkg/robKalman/R/AllGeneric.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -0,0 +1,10 @@
+#if(!isGeneric("type")){
+# setGeneric("type", function(object) standardGeneric("type"))
+#}
+#if(!isGeneric("center")){
+# setGeneric("center", function(object) standardGeneric("center"))
+#}
+#if(!isGeneric("center<-")){
+# setGeneric("center<-", function(object, value) standardGeneric("center<-"))
+#}
+#
Deleted: branches/robKalman_bs/pkg/robKalman/R/AllGenerics.R
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/AllGenerics.R 2009-07-23 15:42:12 UTC (rev 38)
+++ branches/robKalman_bs/pkg/robKalman/R/AllGenerics.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -1,61 +0,0 @@
-############################################################################
-# Access methods
-############################################################################
-
-if(!isGeneric("name"))
- setGeneric("name", function(object) standardGeneric("name"))
-
-if(!isGeneric("getp"))
- setGeneric("getp", function(object) standardGeneric("getp"))
-if(!isGeneric("getq"))
- setGeneric("getq", function(object) standardGeneric("getq"))
-
-if(!isGeneric("getF"))
- setGeneric("getF", function(object,t) standardGeneric("getF"))
-if(!isGeneric("getZ"))
- setGeneric("getZ", function(object,t) standardGeneric("getZ"))
-if(!isGeneric("getQ"))
- setGeneric("getQ", function(object,t) standardGeneric("getQ"))
-if(!isGeneric("getV"))
- setGeneric("getV", function(object,t) standardGeneric("getV"))
-
-
-############################################################################
-# Replacement methods
-############################################################################
-
-if(!isGeneric("name<-"))
- setGeneric("name<-",
- function(object, value) standardGeneric("name<-"))
-
-############################################################################
-# generics to "usual" methods
-############################################################################
-
-
-# general methods
-
-if(!isGeneric("isOldVersion"))
- setGeneric("isOldVersion", function(object) standardGeneric("isOldVersion"))
-
-if(!isGeneric("conv2NewVersion"))
- setGeneric("conv2NewVersion",
- function(object) standardGeneric("conv2NewVersion"))
-### setting gaps
-
-if(!isGeneric("setgaps"))
- setGeneric("setgaps", function(object, ...) standardGeneric("setgaps"))
-
-#### generics for log, log10, lgamma, gamma
-
-
-if(!isGeneric("log"))
- setGeneric("log") #, function(x, base) standardGeneric("log"))
-if(!isGeneric("log10"))
- setGeneric("log10")
-if(!isGeneric("lgamma"))
- setGeneric("lgamma")
-if(!isGeneric("gamma"))
- setGeneric("gamma")
-
-
Copied: branches/robKalman_bs/pkg/robKalman/R/AllGenerics.R (from rev 38, branches/robKalman_bs/pkg/robKalman/R/AllGenerics.R)
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/AllGenerics.R (rev 0)
+++ branches/robKalman_bs/pkg/robKalman/R/AllGenerics.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -0,0 +1,123 @@
+if(!isGeneric("solve")){
+ setGeneric("solve", function(a,b,...) standardGeneric("solve"))
+}
+############################################################################
+# Access methods
+############################################################################
+
+if(!isGeneric("name"))
+ setGeneric("name", function(object) standardGeneric("name"))
+
+if(!isGeneric("getp"))
+ setGeneric("getp", function(object) standardGeneric("getp"))
+if(!isGeneric("getq"))
+ setGeneric("getq", function(object) standardGeneric("getq"))
+
+if(!isGeneric("getF"))
+ setGeneric("getF", function(object) standardGeneric("getF"))
+if(!isGeneric("getZ"))
+ setGeneric("getZ", function(object) standardGeneric("getZ"))
+if(!isGeneric("getQ"))
+ setGeneric("getQ", function(object) standardGeneric("getQ"))
+if(!isGeneric("getV"))
+ setGeneric("getV", function(object) standardGeneric("getV"))
+if(!isGeneric("geta"))
+ setGeneric("geta", function(object) standardGeneric("geta"))
+if(!isGeneric("getS"))
+ setGeneric("getS", function(object) standardGeneric("getS"))
+if(!isGeneric("time"))
+ setGeneric("time", function(x,...) standardGeneric("time"))
+
+if(!isGeneric("SSM"))
+ setGeneric("SSM", function(object, ...) standardGeneric("SSM"))
+if(!isGeneric("Y"))
+ setGeneric("Y", function(object, ...) standardGeneric("Y"))
+if(!isGeneric("X.filtered"))
+ setGeneric("X.filtered", function(object, ...) standardGeneric("X.filtered"))
+if(!isGeneric("X.predicted"))
+ setGeneric("X.predicted", function(object, ...) standardGeneric("X.predicted"))
+if(!isGeneric("Cov.filtered"))
+ setGeneric("Cov.filtered", function(object, ...) standardGeneric("Cov.filtered"))
+if(!isGeneric("Cov.predicted"))
+ setGeneric("Cov.predicted", function(object, ...) standardGeneric("Cov.predicted"))
+if(!isGeneric("Kalman.Gain"))
+ setGeneric("Kalman.Gain", function(object, ...) standardGeneric("Kalman.Gain"))
+if(!isGeneric("X.rob.filtered"))
+ setGeneric("X.rob.filtered", function(object, ...) standardGeneric("X.rob.filtered"))
+if(!isGeneric("X.rob.predicted"))
+ setGeneric("X.rob.predicted", function(object, ...) standardGeneric("X.rob.predicted"))
+if(!isGeneric("Cov.rob.filtered"))
+ setGeneric("Cov.rob.filtered", function(object, ...) standardGeneric("Cov.rob.filtered"))
+if(!isGeneric("Cov.rob.predicted"))
+ setGeneric("Cov.rob.predicted", function(object, ...) standardGeneric("Cov.rob.predicted"))
+if(!isGeneric("Kalman.rob.Gain"))
+ setGeneric("Kalman.rob.Gain", function(object, ...) standardGeneric("Kalman.rob.Gain"))
+if(!isGeneric("rob.correction.ctrl"))
+ setGeneric("rob.correction.ctrl", function(object, ...) standardGeneric("rob.correction.ctrl"))
+if(!isGeneric("rob.prediction.ctrl"))
+ setGeneric("rob.prediction.ctrl", function(object, ...) standardGeneric("rob.prediction.ctrl"))
+if(!isGeneric("IndIO"))
+ setGeneric("IndIO", function(object, ...) standardGeneric("IndIO"))
+if(!isGeneric("IndAO"))
+ setGeneric("IndAO", function(object, ...) standardGeneric("IndAO"))
+if(!isGeneric("nsim"))
+ setGeneric("nsim", function(object, ...) standardGeneric("nsim"))
+if(!isGeneric("RNGstate"))
+ setGeneric("RNGstate", function(object, ...) standardGeneric("RNGstate"))
+if(!isGeneric("Cov.rob.filtered.sim"))
+ setGeneric("Cov.rob.filtered.sim", function(object, ...) standardGeneric("Cov.rob.filtered.sim"))
+if(!isGeneric("Cov.rob.predicted.sim"))
+ setGeneric("Cov.rob.predicted.sim", function(object, ...) standardGeneric("Cov.rob.predicted.sim"))
+if(!isGeneric("init"))
+ setGeneric("init", function(object, ...) standardGeneric("init"))
+if(!isGeneric("predict"))
+ setGeneric("predict", function(object, ...) standardGeneric("predict"))
+if(!isGeneric("correct"))
+ setGeneric("correct", function(object, ...) standardGeneric("correct"))
+if(!isGeneric("init.rob"))
+ setGeneric("init.rob", function(object, ...) standardGeneric("init.rob"))
+if(!isGeneric("name.rob"))
+ setGeneric("name.rob", function(object, ...) standardGeneric("name.rob"))
+if(!isGeneric("predict.rob"))
+ setGeneric("predict.rob", function(object, ...) standardGeneric("predict.rob"))
+if(!isGeneric("correct.rob"))
+ setGeneric("correct.rob", function(object, ...) standardGeneric("correct.rob"))
+if(!isGeneric("controls"))
+ setGeneric("controls", function(object, ...) standardGeneric("controls"))
+
+############################################################################
+# Replacement methods
+############################################################################
+
+if(!isGeneric("name<-"))
+ setGeneric("name<-",
+ function(object, value) standardGeneric("name<-"))
+
+if(!isGeneric("setp<-"))
+ setGeneric("setp<-", function(object, value) standardGeneric("setp<-"))
+if(!isGeneric("setq<-"))
+ setGeneric("setq<-", function(object, value) standardGeneric("setq<-"))
+
+if(!isGeneric("setF<-"))
+ setGeneric("setF<-", function(object, value) standardGeneric("setF<-"))
+if(!isGeneric("setZ<-"))
+ setGeneric("setZ<-", function(object, value) standardGeneric("setZ<-"))
+if(!isGeneric("setQ<-"))
+ setGeneric("setQ<-", function(object, value) standardGeneric("setQ<-"))
+if(!isGeneric("setV<-"))
+ setGeneric("setV<-", function(object, value) standardGeneric("setV<-"))
+if(!isGeneric("seta<-"))
+ setGeneric("seta<-", function(object, value) standardGeneric("seta<-"))
+if(!isGeneric("setS<-"))
+ setGeneric("setS<-", function(object, value) standardGeneric("setS<-"))
+if(!isGeneric("time<-"))
+ setGeneric("time<-", function(x, value) standardGeneric("time<-"))
+
+if(!isGeneric(".make.project"))
+setGeneric(".make.project",function(object, ...) standardGeneric(".make.project"))
+
+if(!isGeneric("kalman"))
+setGeneric("kalman",function(smooth, ...) standardGeneric("kalman"))
+
+if(!isGeneric("kalmanRob"))
+setGeneric("kalmanRob",function(method, smooth, ...) standardGeneric("kalmanRob"))
Deleted: branches/robKalman_bs/pkg/robKalman/R/AllInitialize.R
===================================================================
--- branches/robKalman_bs/pkg/robKalman/R/AllInitialize.R 2009-07-23 15:42:12 UTC (rev 38)
+++ branches/robKalman_bs/pkg/robKalman/R/AllInitialize.R 2009-07-23 19:51:16 UTC (rev 39)
@@ -1,1012 +0,0 @@
-#### as to whether to use Generating functions or to use initialize methods:
-#### http://tolstoy.newcastle.edu.au/R/e2/devel/07/01/1976.html
-
-################################################################################
-## SPACES
-################################################################################
-
-setMethod("initialize", "Reals",
- function(.Object) {
- .Object at dimension <- 1
- .Object at name <- gettext("Real Space")
- .Object
- })
-
-
-setMethod("initialize", "Naturals",
- function(.Object) {
- .Object at dimension <- 1
- .Object at name <- gettext("Grid of Naturals")
- .Object
- })
-
-
-################################################################################
-## PARAMETERS
-################################################################################
-
-setMethod("initialize", "GeomParameter",
- function(.Object, prob = .5) {
- .Deprecated(new = "new(\"NbinomParameter\"(size = 1, prob, name)",
- package = "distr",
- msg = gettext(
-"Class 'GeomParameter' is no longer needed and will be replaced by \nclass 'NbinomParameter' soon."
- ))
- .Object at prob <- prob
- .Object at name <- gettext("Parameter of a Geometric distribution")
- .Object
- })
-################################################################################
-## DISTRIBUTIONS
-################################################################################
-
-## Class: UnivariateDistribution
-###produces difficulties in coercing...:
-#
-#setMethod("initialize", "UnivariateDistribution",
-# function(.Object, r = NULL, d = NULL, p = NULL, q = NULL,
-# param = NULL, img = new("Reals"),
-# .withSim = FALSE, .withArith = FALSE) {
-# if(is.null(r)) {
-# stop("You have at least to give the slot r.")
-# return(invisible())}
-# ### Attention: no checking!!!
-# .Object at img <- img
-# .Object at param <- param
-# .Object at d <- d
-# .Object at p <- p
-# .Object at q <- q
-# .Object at r <- r
-# .Object at .withSim <- .withSim
-# .Object at .withArith <- .withArith
-# .Object })
-
-## class AbscontDistribution
-setMethod("initialize", "AbscontDistribution",
- function(.Object, r = NULL, d = NULL, p = NULL, q = NULL,
- gaps = NULL, param = NULL, img = new("Reals"),
- .withSim = FALSE, .withArith = FALSE) {
-
- ## don't use this if the call is new("AbscontDistribution")
- LL <- length(sys.calls())
- if(sys.calls()[[LL-3]] == "new(\"AbscontDistribution\")")
- {return(.Object)}
-
- if(is.null(r))
- warning("you have to specify slot r at least")
-
- ## TOBEDONE Errorkanal
-
- dpq.approx <- 0
-
- dfun <- d
- pfun <- p
- qfun <- q
-
- if(is.null(d)) {
- .withSim <- TRUE
- dpq <- RtoDPQ(r)
- dpq.approx <- 1
- dfun <- dpq$dfun}
-
- if(is.null(p)) {
- .withSim <- TRUE
- if(dpq.approx == 0) {dpq <- RtoDPQ(r)}
- dpq.approx <- 1
- pfun <- dpq$pfun}
-
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robkalman -r 39
More information about the Robkalman-commits
mailing list