[Pomp-commits] r628 - in pkg: . R

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

Author: kingaa
Date: 2012-03-21 20:52:13 +0100 (Wed, 21 Mar 2012)
New Revision: 628

Modified:
   pkg/DESCRIPTION
   pkg/R/simulate-pomp.R
Log:
- bug fix in simulate code (with as.data.frame argument)


Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2012-03-15 17:17:34 UTC (rev 627)
+++ pkg/DESCRIPTION	2012-03-21 19:52:13 UTC (rev 628)
@@ -1,8 +1,8 @@
 Package: pomp
 Type: Package
 Title: Statistical inference for partially observed Markov processes
-Version: 0.40-9
-Date: 2012-03-15
+Version: 0.40-10
+Date: 2012-03-21
 Revision: $Rev$
 Author: Aaron A. King, Edward L. Ionides, Carles Breto, Steve Ellner, Bruce Kendall, Helen Wearing, Matthew J. Ferrari, Michael Lavine, Daniel C. Reuman
 Maintainer: Aaron A. King <kingaa at umich.edu>

Modified: pkg/R/simulate-pomp.R
===================================================================
--- pkg/R/simulate-pomp.R	2012-03-15 17:17:34 UTC (rev 627)
+++ pkg/R/simulate-pomp.R	2012-03-21 19:52:13 UTC (rev 628)
@@ -58,44 +58,34 @@
 
   if (as.data.frame) {
     if (obs && states) {
-      nsim <- ncol(retval$obs)
-      retval <- lapply(
-                       seq_len(nsim),
-                       function (k) {
-                         nm <- rownames(retval$obs)
-                         dm <- dim(retval$obs)
-                         dim(retval$obs) <- c(dm[1],prod(dm[-1]))
-                         rownames(retval$obs) <- nm
-                         nm <- rownames(retval$states)
-                         dm <- dim(retval$states)
-                         dim(retval$states) <- c(dm[1],prod(dm[-1]))
-                         rownames(retval$states) <- nm
-                         cbind(
-                               time=times,
-                               as.data.frame(t(retval$obs)),
-                               as.data.frame(t(retval$states)),
-                               sim=as.integer(k)
-                               )
-                       }
-                       )
-      retval <- do.call(rbind,retval)
+      dm <- dim(retval$obs)
+      nsim <- dm[2]
+      ntimes <- dm[3]
+      nm <- rownames(retval$obs)
+      dim(retval$obs) <- c(dm[1],prod(dm[-1]))
+      rownames(retval$obs) <- nm
+      dm <- dim(retval$states)
+      nm <- rownames(retval$states)
+      dim(retval$states) <- c(dm[1],prod(dm[-1]))
+      rownames(retval$states) <- nm
+      retval <- cbind(
+                      as.data.frame(t(retval$obs)),
+                      as.data.frame(t(retval$states))
+                      )
+      retval$sim <- seq_len(nsim)
+      retval$time <- rep(times,each=nsim)
+      retval <- retval[order(retval$sim,retval$time),]
     } else if (obs || states) {
-      nsim <- ncol(retval)
-      retval <- lapply(
-                       seq_len(nsim),
-                       function (k) {
-                         nm <- rownames(retval)
-                         dm <- dim(retval)
-                         dim(retval) <- c(dm[1],prod(dm[-1]))
-                         rownames(retval) <- nm
-                         cbind(
-                               time=times,
-                               as.data.frame(t(retval)),
-                               sim=as.integer(k)
-                               )
-                       }
-                       )
-      retval <- do.call(rbind,retval)
+      dm <- dim(retval)
+      nsim <- dm[2]
+      ntimes <- dm[3]
+      nm <- rownames(retval)
+      dim(retval) <- c(dm[1],prod(dm[-1]))
+      rownames(retval) <- nm
+      retval <- as.data.frame(t(retval))
+      retval$sim <- seq_len(nsim)
+      retval$time <- rep(times,each=nsim)
+      retval <- retval[order(retval$sim,retval$time),]
     } else {
       nsim <- length(retval)
       if (nsim > 1) {