[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