[Pomp-commits] r691 - in pkg/pomp: R tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue May 1 02:41:59 CEST 2012
Author: kingaa
Date: 2012-05-01 02:41:57 +0200 (Tue, 01 May 2012)
New Revision: 691
Modified:
pkg/pomp/R/simulate-pomp.R
pkg/pomp/R/trajectory-pomp.R
pkg/pomp/tests/ricker.R
pkg/pomp/tests/ricker.Rout.save
Log:
- make 'sim' and 'traj' into factors when 'simulate' or 'trajectory' are called with 'as.data.frame=TRUE'
Modified: pkg/pomp/R/simulate-pomp.R
===================================================================
--- pkg/pomp/R/simulate-pomp.R 2012-04-30 19:14:40 UTC (rev 690)
+++ pkg/pomp/R/simulate-pomp.R 2012-05-01 00:41:57 UTC (rev 691)
@@ -72,7 +72,7 @@
as.data.frame(t(retval$obs)),
as.data.frame(t(retval$states))
)
- retval$sim <- seq_len(nsim)
+ retval$sim <- factor(seq_len(nsim))
retval$time <- rep(times,each=nsim)
retval <- retval[order(retval$sim,retval$time),]
} else if (obs || states) {
@@ -83,7 +83,7 @@
dim(retval) <- c(dm[1],prod(dm[-1]))
rownames(retval) <- nm
retval <- as.data.frame(t(retval))
- retval$sim <- seq_len(nsim)
+ retval$sim <- factor(seq_len(nsim))
retval$time <- rep(times,each=nsim)
retval <- retval[order(retval$sim,retval$time),]
} else {
@@ -98,9 +98,10 @@
}
)
retval <- do.call(rbind,retval)
+ retval$sim <- factor(retval$sim)
} else {
retval <- as.data.frame(retval)
- retval$sim <- 1
+ retval$sim <- factor(1)
}
}
Modified: pkg/pomp/R/trajectory-pomp.R
===================================================================
--- pkg/pomp/R/trajectory-pomp.R 2012-04-30 19:14:40 UTC (rev 690)
+++ pkg/pomp/R/trajectory-pomp.R 2012-05-01 00:41:57 UTC (rev 691)
@@ -109,6 +109,7 @@
}
)
x <- do.call(rbind,x)
+ x$traj <- factor(x$traj)
}
x
Modified: pkg/pomp/tests/ricker.R
===================================================================
--- pkg/pomp/tests/ricker.R 2012-04-30 19:14:40 UTC (rev 690)
+++ pkg/pomp/tests/ricker.R 2012-05-01 00:41:57 UTC (rev 691)
@@ -15,35 +15,26 @@
tj.3 <- trajectory(ricker,as.data.frame=TRUE,params=parmat(coef(ricker),3),times=1:100)
plot(N~time,data=tj.3,subset=traj==3,type='l')
-sm <- simulate(ricker,seed=343995,as.data.frame=TRUE)
-sm1 <- as.data.frame(simulate(ricker,seed=343995))
-stopifnot(max(abs(as.matrix(sm[names(sm1)])-as.matrix(sm1)))==0)
+sm <- as.data.frame(simulate(ricker,seed=343995))
+sm1 <- simulate(ricker,seed=343995,as.data.frame=TRUE)
+stopifnot(max(abs(as.matrix(sm1[names(sm)])-as.matrix(sm)))==0)
+sm1 <- simulate(ricker,seed=343995,states=TRUE,obs=TRUE,as.data.frame=TRUE)
+stopifnot(max(abs(as.matrix(sm1[names(sm)])-as.matrix(sm)))==0)
-sm <- simulate(ricker,nsim=3,seed=343995,as.data.frame=TRUE)
-print(names(sm))
-print(dim(sm))
-
-sm1 <- simulate(ricker,nsim=3,obs=T,seed=343995,as.data.frame=TRUE)
+sm1 <- simulate(ricker,nsim=3,seed=343995,as.data.frame=TRUE)
print(names(sm1))
print(dim(sm1))
-stopifnot(max(abs(as.matrix(sm[names(sm1)])-as.matrix(sm1)))==0)
sm1 <- simulate(ricker,nsim=3,states=T,seed=343995,as.data.frame=TRUE)
print(names(sm1))
print(dim(sm1))
-stopifnot(max(abs(as.matrix(sm[names(sm1)])-as.matrix(sm1)))==0)
+print(tail(sm1))
-sm1 <- simulate(ricker,nsim=3,states=T,obs=T,seed=343995,as.data.frame=TRUE)
+sm1 <- simulate(ricker,nsim=3,obs=T,seed=343995,as.data.frame=TRUE)
print(names(sm1))
print(dim(sm1))
-stopifnot(max(abs(as.matrix(sm[names(sm1)])-as.matrix(sm1)))==0)
+print(tail(sm1))
-sm <- simulate(ricker,nsim=1,states=T,obs=T,seed=343995,as.data.frame=TRUE)
-sm1 <- as.data.frame(simulate(ricker,seed=343995))
-print(names(sm))
-print(dim(sm))
-stopifnot(max(abs(as.matrix(sm[names(sm1)])-as.matrix(sm1)))==0)
-
po <- ricker
try(
coef(po,"log.r")
Modified: pkg/pomp/tests/ricker.Rout.save
===================================================================
--- pkg/pomp/tests/ricker.Rout.save 2012-04-30 19:14:40 UTC (rev 690)
+++ pkg/pomp/tests/ricker.Rout.save 2012-05-01 00:41:57 UTC (rev 691)
@@ -37,45 +37,46 @@
> tj.3 <- trajectory(ricker,as.data.frame=TRUE,params=parmat(coef(ricker),3),times=1:100)
> plot(N~time,data=tj.3,subset=traj==3,type='l')
>
-> sm <- simulate(ricker,seed=343995,as.data.frame=TRUE)
-> sm1 <- as.data.frame(simulate(ricker,seed=343995))
-> stopifnot(max(abs(as.matrix(sm[names(sm1)])-as.matrix(sm1)))==0)
+> sm <- as.data.frame(simulate(ricker,seed=343995))
+> sm1 <- simulate(ricker,seed=343995,as.data.frame=TRUE)
+> stopifnot(max(abs(as.matrix(sm1[names(sm)])-as.matrix(sm)))==0)
+> sm1 <- simulate(ricker,seed=343995,states=TRUE,obs=TRUE,as.data.frame=TRUE)
+> stopifnot(max(abs(as.matrix(sm1[names(sm)])-as.matrix(sm)))==0)
>
-> sm <- simulate(ricker,nsim=3,seed=343995,as.data.frame=TRUE)
-> print(names(sm))
+> sm1 <- simulate(ricker,nsim=3,seed=343995,as.data.frame=TRUE)
+> print(names(sm1))
[1] "time" "y" "N" "e" "sim"
-> print(dim(sm))
+> print(dim(sm1))
[1] 153 5
>
-> sm1 <- simulate(ricker,nsim=3,obs=T,seed=343995,as.data.frame=TRUE)
-> print(names(sm1))
-[1] "y" "sim" "time"
-> print(dim(sm1))
-[1] 153 3
-> stopifnot(max(abs(as.matrix(sm[names(sm1)])-as.matrix(sm1)))==0)
->
> sm1 <- simulate(ricker,nsim=3,states=T,seed=343995,as.data.frame=TRUE)
> print(names(sm1))
[1] "N" "e" "sim" "time"
> print(dim(sm1))
[1] 153 4
-> stopifnot(max(abs(as.matrix(sm[names(sm1)])-as.matrix(sm1)))==0)
+> print(tail(sm1))
+ N e sim time
+138 4.0116869 0.05723792 3 45
+141 4.2497654 0.26933885 3 46
+144 2.9300053 0.07790589 3 47
+147 7.1162605 0.01738347 3 48
+150 0.2366483 -0.08730222 3 49
+153 18.9946973 0.82198849 3 50
>
-> sm1 <- simulate(ricker,nsim=3,states=T,obs=T,seed=343995,as.data.frame=TRUE)
+> sm1 <- simulate(ricker,nsim=3,obs=T,seed=343995,as.data.frame=TRUE)
> print(names(sm1))
-[1] "y" "N" "e" "sim" "time"
+[1] "y" "sim" "time"
> print(dim(sm1))
-[1] 153 5
-> stopifnot(max(abs(as.matrix(sm[names(sm1)])-as.matrix(sm1)))==0)
+[1] 153 3
+> print(tail(sm1))
+ y sim time
+138 36 3 45
+141 44 3 46
+144 27 3 47
+147 73 3 48
+150 1 3 49
+153 218 3 50
>
-> sm <- simulate(ricker,nsim=1,states=T,obs=T,seed=343995,as.data.frame=TRUE)
-> sm1 <- as.data.frame(simulate(ricker,seed=343995))
-> print(names(sm))
-[1] "y" "N" "e" "sim" "time"
-> print(dim(sm))
-[1] 51 5
-> stopifnot(max(abs(as.matrix(sm[names(sm1)])-as.matrix(sm1)))==0)
->
> po <- ricker
> try(
+ coef(po,"log.r")
@@ -105,4 +106,4 @@
>
> proc.time()
user system elapsed
- 0.532 0.028 0.676
+ 0.552 0.032 0.678
More information about the pomp-commits
mailing list