[Pomp-commits] r772 - branches/mif2/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Aug 13 18:34:17 CEST 2012


Author: nxdao2000
Date: 2012-08-13 18:34:16 +0200 (Mon, 13 Aug 2012)
New Revision: 772

Modified:
   branches/mif2/R/pfilter.R
Log:
clean the code for mif2 accordingly with mif.R

Modified: branches/mif2/R/pfilter.R
===================================================================
--- branches/mif2/R/pfilter.R	2012-08-13 16:33:29 UTC (rev 771)
+++ branches/mif2/R/pfilter.R	2012-08-13 16:34:16 UTC (rev 772)
@@ -151,7 +151,10 @@
 		)
 	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(
@@ -169,24 +172,26 @@
 			)
 	else
 		filt.m <- array(dim=c(0,0))
+	if (option=="mif2" && missing(cooling.fraction))
+		stop("pfilter error: ",sQuote("cooling.fraction")," must be specified for method mif2",call.=FALSE)
+	if (option=="mif2")
+		cooling.fraction <- as.numeric(cooling.fraction)
+	if (option=="mif2" && (missing(paramMatrix)))
+		stop("pfilter error: ",sQuote("paramMatrix")," must be specified for method mif2",call.=FALSE)
 	
-	if(missing(cooling.fraction))
-		cooling.fraction <-0.05
+
 	
-	if(missing(paramMatrix))
-		paramMatrix=array(dim=c(0,0))
-	
 	for (nt in seq_len(ntimes)) {
 		if (option=="mif2")
 		{	  
 			cool.sched <- try(mif.cooling2(cooling.fraction, nt , cooling.m+.ndone, ntimes), silent = FALSE)#nt+.ndone
 			if (inherits(cool.sched, "try-error")) 
 				stop("pfilter error: cooling schedule error", call. = FALSE)
-			sigma1=sigma*cool.sched$alpha
+			sigma1<-sigma*cool.sched$alpha
 			
 		}	  
 		else
-			sigma1=sigma
+			sigma1<-sigma
 		## transform the parameters if necessary
 		if (transform) tparams <- partrans(object,params,dir="forward")
 		
@@ -342,6 +347,11 @@
 				...) {
 			if (missing(params)) params <- coef(object)
 			if (missing(option)) option <- "mif"
+			if (option=="mif2" && missing(cooling.fraction))
+				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)
+			
 			pfilter.internal(
 					object=object,
 					params=params,
@@ -352,6 +362,8 @@
 					pred.var=pred.var,
 					filter.mean=filter.mean,
 					paramMatrix = paramMatrix,
+					cooling.fraction=cooling.fraction,
+					cooling.m=cooling.m,
 					option=option,
 					save.states=save.states,
 					save.params=save.params,
@@ -383,6 +395,10 @@
 			if (missing(Np)) Np <- object at Np
 			if (missing(tol)) tol <- object at tol
 			if (missing(option)) option <- object at option
+			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
 			pfilter.internal(
 					object=as(object,"pomp"),
@@ -394,6 +410,8 @@
 					pred.var=pred.var,
 					filter.mean=filter.mean,
 					paramMatrix = paramMatrix,
+					cooling.fraction=cooling.fraction,
+					cooling.m=cooling.m,
 					option=option,
 					save.states=save.states,
 					save.params=save.params,



More information about the pomp-commits mailing list