[Pomp-commits] r705 - pkg/pomp/R

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

Author: kingaa
Date: 2012-05-03 22:59:49 +0200 (Thu, 03 May 2012)
New Revision: 705

Modified:
   pkg/pomp/R/trajectory-pomp.R
Log:
- really fix bug in 'trajectory' that occurs when 'zeronames' has length > 1


Modified: pkg/pomp/R/trajectory-pomp.R
===================================================================
--- pkg/pomp/R/trajectory-pomp.R	2012-05-03 19:52:05 UTC (rev 704)
+++ pkg/pomp/R/trajectory-pomp.R	2012-05-03 20:59:49 UTC (rev 705)
@@ -45,9 +45,6 @@
   dim(x0) <- c(nvar,nrep,1)
   dimnames(x0) <- list(statenames,NULL,NULL)
   
-  znames <- object at zeronames
-  if (length(znames)>0) x0[znames,,] <- 0
-
   type <- object at skeleton.type          # map or vectorfield?
   
   if (is.na(type))
@@ -59,6 +56,9 @@
     
   } else if (type=="vectorfield") {
 
+    znames <- object at zeronames
+    if (length(znames)>0) x0[znames,,] <- 0
+
     ## the 'savelist' contains C-level internals that are needed by 'pomp_vf_eval'
     ## it prevents garbage collection of these data
     savelist <- .Call(pomp_desolve_setup,object,x0,params)
@@ -86,15 +86,16 @@
 
     x <- array(data=t(X[-1,-1]),dim=c(nvar,nrep,ntimes),dimnames=list(statenames,NULL,NULL))
     
+    for (z in znames)
+      for (r in seq_len(ncol(x)))
+        x[z,r,-1] <- diff(x[z,r,])
+    
   } else {
     
     stop("deterministic skeleton not specified")
 
   }
 
-  for (z in znames)
-    x[z,,-1] <- apply(x[z,,,drop=FALSE],c(1,2),diff)
-    
   if (as.data.frame) {
     x <- lapply(
                 seq_len(ncol(x)),