[Pomp-commits] r786 - branches/mif2/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Oct 9 15:27:10 CEST 2012
Author: nxdao2000
Date: 2012-10-09 15:27:10 +0200 (Tue, 09 Oct 2012)
New Revision: 786
Modified:
branches/mif2/R/pfilter.R
Log:
working mif2
Modified: branches/mif2/R/pfilter.R
===================================================================
--- branches/mif2/R/pfilter.R 2012-09-25 21:31:34 UTC (rev 785)
+++ branches/mif2/R/pfilter.R 2012-10-09 13:27:10 UTC (rev 786)
@@ -7,8 +7,7 @@
pred.mean="array",
pred.var="array",
filter.mean="array",
- paramMatrix = "array",
- option="character",
+ paramMatrix = "list",
eff.sample.size="numeric",
cond.loglik="numeric",
saved.states="list",
@@ -29,7 +28,10 @@
.rw.sd, seed, verbose,
save.states, save.params,
transform,.ndone) {
-
+ if (missing(option))
+ option<-'mif'
+ if(missing(paramMatrix))
+ paramMatrix <- array(dim=c(0,0))
transform <- as.logical(transform)
if (missing(seed)) seed <- NULL
@@ -151,10 +153,9 @@
)
else
pred.v <- array(dim=c(0,0))
- if(missing(paramMatrix))
- paramMatrix <- array(dim=c(0,0))
+
if (filter.mean)
if (random.walk)
filt.m <- matrix(
@@ -305,7 +306,12 @@
seed <- save.seed
}
if(option=="mif2")
- paramMatrix <- params
+ { paramMatrix <-vector(mode="list", length=1)
+ paramMatrix[[1]] <- params
+
+ }
+ else
+ paramMatrix <-list()
new(
"pfilterd.pomp",
object,
@@ -313,7 +319,6 @@
pred.var=pred.v,
filter.mean=filt.m,
paramMatrix = paramMatrix,
- option=option,
eff.sample.size=eff.sample.size,
cond.loglik=loglik,
saved.states=xparticles,
@@ -351,7 +356,8 @@
stop("pfilter error: ",sQuote("cooling.fraction")," must be specified for method mif2",call.=FALSE)
if (option=="mif2" && missing(cooling.m))
stop("pfilter error: ",sQuote("cooling.m")," must be specified for method mif2",call.=FALSE)
-
+ if(option=='mif2' && missing(paramMatrix))
+ paramMatrix <- list()
pfilter.internal(
object=object,
params=params,
@@ -394,12 +400,13 @@
if (missing(params)) params <- coef(object)
if (missing(Np)) Np <- object at Np
if (missing(tol)) tol <- object at tol
- if (missing(option)) option <- object at option
+ if (missing(option)) option <- 'mif'
if (option=="mif2" && missing(cooling.fraction))
cooling.fraction<-object at cooling.fraction
if (option=="mif2" && missing(cooling.m))
cooling.m<-object at cooling.m
- if (missing(paramMatrix)) paramMatrix <- object at paramMatrix
+ if (option=='mif2' && missing(paramMatrix))
+ paramMatrix <- object at paramMatrix
pfilter.internal(
object=as(object,"pomp"),
params=params,
More information about the pomp-commits
mailing list