[Pomp-commits] r988 - in www: content vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jun 27 21:50:35 CEST 2014
Author: kingaa
Date: 2014-06-27 21:50:35 +0200 (Fri, 27 Jun 2014)
New Revision: 988
Modified:
www/content/NEWS.html
www/vignettes/advanced_topics_in_pomp.pdf
www/vignettes/intro_to_pomp.R
www/vignettes/intro_to_pomp.Rnw
www/vignettes/intro_to_pomp.pdf
www/vignettes/nlf-block-boot.rda
www/vignettes/nlf-boot.rda
www/vignettes/nlf-fit-from-truth.rda
www/vignettes/nlf-fits.rda
www/vignettes/nlf-lag-tests.rda
www/vignettes/nlf-multi-short.rda
www/vignettes/pomp.pdf
Log:
- update the vignettes
Modified: www/content/NEWS.html
===================================================================
--- www/content/NEWS.html 2014-06-27 19:48:32 UTC (rev 987)
+++ www/content/NEWS.html 2014-06-27 19:50:35 UTC (rev 988)
@@ -8,6 +8,19 @@
<h2>News for package ‘pomp’</h2>
+<h3>Changes in <span class="pkg">pomp</span> version 0.53-1</h3>
+
+
+<ul>
+<li> <p><code>nlf</code> now returns an S4 object of class <code>nlfd.pomp</code> with a <code>logLik</code> method for extracting the log quasi likelihood and a <code>$</code> method for extracting arbitrary components.
+</p>
+</li>
+<li><p> The <code>transform</code> argument (for providing a function to transform the data) has been removed in favor of <code>transform.data</code>.
+</p>
+</li></ul>
+
+
+
<h3>Changes in <span class="pkg">pomp</span> version 0.52-1</h3>
Modified: www/vignettes/advanced_topics_in_pomp.pdf
===================================================================
(Binary files differ)
Modified: www/vignettes/intro_to_pomp.R
===================================================================
--- www/vignettes/intro_to_pomp.R 2014-06-27 19:48:32 UTC (rev 987)
+++ www/vignettes/intro_to_pomp.R 2014-06-27 19:50:35 UTC (rev 988)
@@ -854,7 +854,7 @@
## out[[j]] <- nlf(
## gompertz,
## start=starts[[j]],
-## transform=log,
+## transform.data=log,
## transform.params=TRUE,
## est=c("K","r"),
## lags=c(1,2),
@@ -865,42 +865,42 @@
## nasymp=5000
## )
## }
-## fits <- t(sapply(out,function(x)c(x$params[c("r","K")],value=x$value)))
+## fits <- t(sapply(out,function(x)c(coef(x,c("r","K")),value=logLik(x))))
## ----nlf-fits-eval,echo=F,eval=T,results='hide'--------------------------
binary.file <- "nlf-fits.rda"
if (file.exists(binary.file)) {
load(binary.file)
} else {
-# pick 5 random starting parameter values
-starts <- replicate(n=5,
- {
- p <- coef(gompertz)
- p[c("K","r")] <- rlnorm(n=2,meanlog=log(p[c("K","r")]),
- sdlog=0.1)
- p
- },
- simplify=FALSE
- )
-out <- list()
-## Do the fitting.
-## method, trace, and nasymp are explained below
-for (j in 1:5) {
- out[[j]] <- nlf(
- gompertz,
- start=starts[[j]],
- transform=log,
- transform.params=TRUE,
- est=c("K","r"),
- lags=c(1,2),
- seed=7639873L,
- method="Nelder-Mead",
- trace=4,
- skip.se=TRUE,
- nasymp=5000
- )
-}
-fits <- t(sapply(out,function(x)c(x$params[c("r","K")],value=x$value)))
+ # pick 5 random starting parameter values
+ starts <- replicate(n=5,
+ {
+ p <- coef(gompertz)
+ p[c("K","r")] <- rlnorm(n=2,meanlog=log(p[c("K","r")]),
+ sdlog=0.1)
+ p
+ },
+ simplify=FALSE
+ )
+ out <- list()
+ ## Do the fitting.
+ ## method, trace, and nasymp are explained below
+ for (j in 1:5) {
+ out[[j]] <- nlf(
+ gompertz,
+ start=starts[[j]],
+ transform.data=log,
+ transform.params=TRUE,
+ est=c("K","r"),
+ lags=c(1,2),
+ seed=7639873L,
+ method="Nelder-Mead",
+ trace=4,
+ skip.se=TRUE,
+ nasymp=5000
+ )
+ }
+ fits <- t(sapply(out,function(x)c(coef(x,c("r","K")),value=logLik(x))))
save(starts,out,fits,file=binary.file,compress="xz")
}
@@ -922,14 +922,14 @@
## pars <- theta
## pars["r"] <- r.vals[j]
## for(k in 1:4) {
-## fvals[j,k] <- nlf(
-## long.gomp,
-## start=pars,
-## nasymp=5000,
-## est=NULL,
-## lags=lags[[k]],
-## eval.only=TRUE
-## )
+## fit <- nlf(
+## long.gomp,
+## start=pars,
+## nasymp=5000,
+## lags=lags[[k]],
+## eval.only=TRUE
+## )
+## fvals[j,k] <- logLik(fit)
## }
## }
@@ -940,14 +940,14 @@
## pars <- theta
## pars["K"] <- pars["X.0"] <- K.vals[j]
## for(k in 1:4) {
-## fvals2[j,k] <- nlf(
-## long.gomp,
-## start=pars,
-## nasymp=5000,
-## est=NULL,
-## lags=lags[[k]],
-## eval.only=TRUE
-## )
+## fit <- nlf(
+## long.gomp,
+## start=pars,
+## nasymp=5000,
+## lags=lags[[k]],
+## eval.only=TRUE
+## )
+## fvals2[j,k] <- logLik(fit)
## }
## }
@@ -956,41 +956,41 @@
if (file.exists(binary.file)) {
load(binary.file)
} else {
-long.gomp <- simulate(gompertz,times=1:1000)
-theta <- coef(long.gomp)
-lags <- list(1,2,c(1,2),c(2,3))
-r.vals <- theta["r"]*exp(seq(-0.69,0.69,length=25))
-fvals <- matrix(nrow=25,ncol=4)
-for (j in 1:25) {
- pars <- theta
- pars["r"] <- r.vals[j]
- for(k in 1:4) {
- fvals[j,k] <- nlf(
- long.gomp,
- start=pars,
- nasymp=5000,
- est=NULL,
- lags=lags[[k]],
- eval.only=TRUE
- )
+ long.gomp <- simulate(gompertz,times=1:1000)
+ theta <- coef(long.gomp)
+ lags <- list(1,2,c(1,2),c(2,3))
+ r.vals <- theta["r"]*exp(seq(-0.69,0.69,length=25))
+ fvals <- matrix(nrow=25,ncol=4)
+ for (j in 1:25) {
+ pars <- theta
+ pars["r"] <- r.vals[j]
+ for(k in 1:4) {
+ fit <- nlf(
+ long.gomp,
+ start=pars,
+ nasymp=5000,
+ lags=lags[[k]],
+ eval.only=TRUE
+ )
+ fvals[j,k] <- logLik(fit)
+ }
}
-}
-K.vals <- theta["K"]*exp(seq(-0.15,0.15,length=25))
-fvals2 <- matrix(nrow=25,ncol=4)
-for (j in 1:25) {
- pars <- theta
- pars["K"] <- pars["X.0"] <- K.vals[j]
- for(k in 1:4) {
- fvals2[j,k] <- nlf(
- long.gomp,
- start=pars,
- nasymp=5000,
- est=NULL,
- lags=lags[[k]],
- eval.only=TRUE
- )
+ K.vals <- theta["K"]*exp(seq(-0.15,0.15,length=25))
+ fvals2 <- matrix(nrow=25,ncol=4)
+ for (j in 1:25) {
+ pars <- theta
+ pars["K"] <- pars["X.0"] <- K.vals[j]
+ for(k in 1:4) {
+ fit <- nlf(
+ long.gomp,
+ start=pars,
+ nasymp=5000,
+ lags=lags[[k]],
+ eval.only=TRUE
+ )
+ fvals2[j,k] <- logLik(fit)
+ }
}
-}
save(theta,lags,r.vals,K.vals,fvals,fvals2,file=binary.file,compress="xz")
}
@@ -1033,14 +1033,14 @@
## new.pomp <- simulate(gompertz,times=1:ndata,nsim=nreps,seed=NULL) # nreps simulated data sets
## for (j in 1:nreps) {
## for (k in seq_along(lags)) {
-## fvals[j,k] <- nlf(
-## new.pomp[[j]],
-## start=coef(gompertz),
-## nasymp=5000,
-## est=NULL,
-## lags=lags[[k]],
-## eval.only=TRUE
-## )
+## fit <- nlf(
+## new.pomp[[j]],
+## start=coef(gompertz),
+## nasymp=5000,
+## lags=lags[[k]],
+## eval.only=TRUE
+## )
+## fvals[j,k] <- logLik(fit)
## }
## }
## fvals <- exp(fvals/ndata)
@@ -1050,23 +1050,23 @@
if (file.exists(binary.file)) {
load(binary.file)
} else {
-nreps <- 100
-ndata <- 60
-fvals <- matrix(nrow=nreps,ncol=length(lags))
-new.pomp <- simulate(gompertz,times=1:ndata,nsim=nreps,seed=NULL) # nreps simulated data sets
-for (j in 1:nreps) {
- for (k in seq_along(lags)) {
- fvals[j,k] <- nlf(
- new.pomp[[j]],
- start=coef(gompertz),
- nasymp=5000,
- est=NULL,
- lags=lags[[k]],
- eval.only=TRUE
- )
+ nreps <- 100
+ ndata <- 60
+ fvals <- matrix(nrow=nreps,ncol=length(lags))
+ new.pomp <- simulate(gompertz,times=1:ndata,nsim=nreps,seed=NULL) # nreps simulated data sets
+ for (j in 1:nreps) {
+ for (k in seq_along(lags)) {
+ fit <- nlf(
+ new.pomp[[j]],
+ start=coef(gompertz),
+ nasymp=5000,
+ lags=lags[[k]],
+ eval.only=TRUE
+ )
+ fvals[j,k] <- logLik(fit)
+ }
}
-}
-fvals <- exp(fvals/ndata)
+ fvals <- exp(fvals/ndata)
save(lags,nreps,ndata,fvals,file=binary.file,compress="xz")
}
@@ -1092,16 +1092,16 @@
if (file.exists(binary.file)) {
load(binary.file)
} else {
-true.fit <- nlf(
- gompertz,
- transform.params=TRUE,
- est=c("K","r"),
- lags=2,
- seed=7639873,
- method="Nelder-Mead",
- trace=4,
- nasymp=5000
- )
+ true.fit <- nlf(
+ gompertz,
+ transform.params=TRUE,
+ est=c("K","r"),
+ lags=2,
+ seed=7639873,
+ method="Nelder-Mead",
+ trace=4,
+ nasymp=5000
+ )
save(true.fit,file=binary.file,compress="xz")
}
@@ -1131,7 +1131,7 @@
## trace=4,
## nasymp=5000
## )
-## pars[j,] <- fit$params[c("r","K")]
+## pars[j,] <- coef(fit,c("r","K"))
## }
## colnames(pars) <- c("r","K")
@@ -1140,30 +1140,30 @@
if (file.exists(binary.file)) {
load(binary.file)
} else {
-lags <- 2
-ndata <- length(obs(gompertz))
-nboot <- ndata-max(lags)
-nreps <- 100
-pars <- matrix(0,nreps,2)
-bootsamp <- replicate(n=nreps,sample(nboot,replace=TRUE))
-for (j in seq_len(nreps)) {
- fit <- nlf(
- gompertz,
- start=coef(gompertz),
- transform.params=TRUE,
- est=c("K","r"),
- lags=lags,
- seed=7639873,
- bootstrap=TRUE,
- bootsamp=bootsamp[,j],
- skip.se=TRUE,
- method="Nelder-Mead",
- trace=4,
- nasymp=5000
- )
- pars[j,] <- fit$params[c("r","K")]
-}
-colnames(pars) <- c("r","K")
+ lags <- 2
+ ndata <- length(obs(gompertz))
+ nboot <- ndata-max(lags)
+ nreps <- 100
+ pars <- matrix(0,nreps,2)
+ bootsamp <- replicate(n=nreps,sample(nboot,replace=TRUE))
+ for (j in seq_len(nreps)) {
+ fit <- nlf(
+ gompertz,
+ start=coef(gompertz),
+ transform.params=TRUE,
+ est=c("K","r"),
+ lags=lags,
+ seed=7639873,
+ bootstrap=TRUE,
+ bootsamp=bootsamp[,j],
+ skip.se=TRUE,
+ method="Nelder-Mead",
+ trace=4,
+ nasymp=5000
+ )
+ pars[j,] <- coef(fit,c("r","K"))
+ }
+ colnames(pars) <- c("r","K")
save(pars,file=binary.file,compress="xz")
}
@@ -1201,7 +1201,7 @@
## trace=4,
## nasymp=5000
## )
-## pars[j,] <- fit$params[c("r","K")]
+## pars[j,] <- coef(fit,c("r","K"))
## }
## colnames(pars) <- c("r","K")
@@ -1211,33 +1211,33 @@
if (file.exists(binary.file)) {
load(binary.file)
} else {
-lags <- 2
-ndata <- length(obs(gompertz))
-nboot <- ndata-max(lags)
-nreps <- 100
-pars <- matrix(0,nreps,2)
-bootsamp <- replicate(
- n=nreps,
- sample(nboot-2,size=floor(nboot/3),replace=TRUE)
- )
-bootsamp <- rbind(bootsamp,bootsamp+1,bootsamp+2)
-for (j in seq_len(nreps)) {
- fit <- nlf(
- gompertz,
- transform.params=TRUE,
- est=c("K","r"),
- lags=lags,
- seed=7639873L,
- bootstrap=TRUE,
- bootsamp=bootsamp[,j],
- skip.se=TRUE,
- method="Nelder-Mead",
- trace=4,
- nasymp=5000
- )
- pars[j,] <- fit$params[c("r","K")]
-}
-colnames(pars) <- c("r","K")
+ lags <- 2
+ ndata <- length(obs(gompertz))
+ nboot <- ndata-max(lags)
+ nreps <- 100
+ pars <- matrix(0,nreps,2)
+ bootsamp <- replicate(
+ n=nreps,
+ sample(nboot-2,size=floor(nboot/3),replace=TRUE)
+ )
+ bootsamp <- rbind(bootsamp,bootsamp+1,bootsamp+2)
+ for (j in seq_len(nreps)) {
+ fit <- nlf(
+ gompertz,
+ transform.params=TRUE,
+ est=c("K","r"),
+ lags=lags,
+ seed=7639873L,
+ bootstrap=TRUE,
+ bootsamp=bootsamp[,j],
+ skip.se=TRUE,
+ method="Nelder-Mead",
+ trace=4,
+ nasymp=5000
+ )
+ pars[j,] <- coef(fit,c("r","K"))
+ }
+ colnames(pars) <- c("r","K")
save(pars,file=binary.file,compress="xz")
}
Modified: www/vignettes/intro_to_pomp.Rnw
===================================================================
--- www/vignettes/intro_to_pomp.Rnw 2014-06-27 19:48:32 UTC (rev 987)
+++ www/vignettes/intro_to_pomp.Rnw 2014-06-27 19:50:35 UTC (rev 988)
@@ -1215,7 +1215,7 @@
out[[j]] <- nlf(
gompertz,
start=starts[[j]],
- transform=log,
+ transform.data=log,
transform.params=TRUE,
est=c("K","r"),
lags=c(1,2),
@@ -1226,15 +1226,15 @@
nasymp=5000
)
}
-fits <- t(sapply(out,function(x)c(x$params[c("r","K")],value=x$value)))
+fits <- t(sapply(out,function(x)c(coef(x,c("r","K")),value=logLik(x))))
@
<<nlf-fits-eval,echo=F,eval=T,results='hide'>>=
binary.file <- "nlf-fits.rda"
if (file.exists(binary.file)) {
load(binary.file)
} else {
-<<nlf-gompertz-starts>>
-<<nlf-gompertz-fits>>
+ <<nlf-gompertz-starts>>
+ <<nlf-gompertz-fits>>
save(starts,out,fits,file=binary.file,compress="xz")
}
@
@@ -1273,14 +1273,14 @@
pars <- theta
pars["r"] <- r.vals[j]
for(k in 1:4) {
- fvals[j,k] <- nlf(
- long.gomp,
- start=pars,
- nasymp=5000,
- est=NULL,
- lags=lags[[k]],
- eval.only=TRUE
- )
+ fit <- nlf(
+ long.gomp,
+ start=pars,
+ nasymp=5000,
+ lags=lags[[k]],
+ eval.only=TRUE
+ )
+ fvals[j,k] <- logLik(fit)
}
}
@
@@ -1291,14 +1291,14 @@
pars <- theta
pars["K"] <- pars["X.0"] <- K.vals[j]
for(k in 1:4) {
- fvals2[j,k] <- nlf(
- long.gomp,
- start=pars,
- nasymp=5000,
- est=NULL,
- lags=lags[[k]],
- eval.only=TRUE
- )
+ fit <- nlf(
+ long.gomp,
+ start=pars,
+ nasymp=5000,
+ lags=lags[[k]],
+ eval.only=TRUE
+ )
+ fvals2[j,k] <- logLik(fit)
}
}
@
@@ -1307,9 +1307,9 @@
if (file.exists(binary.file)) {
load(binary.file)
} else {
-<<nlf-my-pomp>>
-<<nlf-lag-test-log.r>>
-<<nlf-lag-test-log.K>>
+ <<nlf-my-pomp>>
+ <<nlf-lag-test-log.r>>
+ <<nlf-lag-test-log.K>>
save(theta,lags,r.vals,K.vals,fvals,fvals2,file=binary.file,compress="xz")
}
@
@@ -1362,14 +1362,14 @@
new.pomp <- simulate(gompertz,times=1:ndata,nsim=nreps,seed=NULL) # nreps simulated data sets
for (j in 1:nreps) {
for (k in seq_along(lags)) {
- fvals[j,k] <- nlf(
- new.pomp[[j]],
- start=coef(gompertz),
- nasymp=5000,
- est=NULL,
- lags=lags[[k]],
- eval.only=TRUE
- )
+ fit <- nlf(
+ new.pomp[[j]],
+ start=coef(gompertz),
+ nasymp=5000,
+ lags=lags[[k]],
+ eval.only=TRUE
+ )
+ fvals[j,k] <- logLik(fit)
}
}
fvals <- exp(fvals/ndata)
@@ -1379,7 +1379,7 @@
if (file.exists(binary.file)) {
load(binary.file)
} else {
-<<nlf-multi-short>>
+ <<nlf-multi-short>>
save(lags,nreps,ndata,fvals,file=binary.file,compress="xz")
}
@
@@ -1395,7 +1395,7 @@
transform.params=TRUE,
est=c("K","r"),
lags=2,
- seed=7639873,
+ seed=7639873,
method="Nelder-Mead",
trace=4,
nasymp=5000
@@ -1406,14 +1406,13 @@
if (file.exists(binary.file)) {
load(binary.file)
} else {
-<<nlf-fit-from-truth>>
+ <<nlf-fit-from-truth>>
save(true.fit,file=binary.file,compress="xz")
}
@
-From \verb+true.fit$params+ and \verb+true.fit$se+ we get the estimates ($\pm$ 1 standard error)
-${r}=$~\Sexpr{signif(true.fit$params["r"],2)}~$\pm$~\Sexpr{signif(true.fit$params["r"]*true.fit$se["r"],2)}
-and ${K}=$~\Sexpr{signif(true.fit$params["K"],2)}~$\pm$~\Sexpr{signif(true.fit$params["K"]*true.fit$se["K"],2)}.
-%%$\log K = 0.081 \pm 0.064$, $\log r = -2.2 \pm 0.51$
+From \verb+coef(true.fit)+ and \verb+true.fit$se+ we get the estimates ($\pm$ 1 standard error)
+${r}=$~\Sexpr{signif(coef(true.fit,"r"),2)}~$\pm$~\Sexpr{signif(coef(true.fit,"r")*true.fit$se["r"],2)}
+and ${K}=$~\Sexpr{signif(coef(true.fit,"K"),2)}~$\pm$~\Sexpr{signif(coef(true.fit,"K")*true.fit$se["K"],2)}.
The standard errors provided by \code{nlf} are based on a Newey-West estimate of the variance-covariance matrix that is generally
somewhat biased downward.
@@ -1449,7 +1448,7 @@
trace=4,
nasymp=5000
)
- pars[j,] <- fit$params[c("r","K")]
+ pars[j,] <- coef(fit,c("r","K"))
}
colnames(pars) <- c("r","K")
@
@@ -1458,7 +1457,7 @@
if (file.exists(binary.file)) {
load(binary.file)
} else {
-<<nlf-boot>>
+ <<nlf-boot>>
save(pars,file=binary.file,compress="xz")
}
@
@@ -1502,7 +1501,7 @@
trace=4,
nasymp=5000
)
- pars[j,] <- fit$params[c("r","K")]
+ pars[j,] <- coef(fit,c("r","K"))
}
colnames(pars) <- c("r","K")
@
@@ -1512,7 +1511,7 @@
if (file.exists(binary.file)) {
load(binary.file)
} else {
-<<nlf-block-boot>>
+ <<nlf-block-boot>>
save(pars,file=binary.file,compress="xz")
}
@
Modified: www/vignettes/intro_to_pomp.pdf
===================================================================
(Binary files differ)
Modified: www/vignettes/nlf-block-boot.rda
===================================================================
(Binary files differ)
Modified: www/vignettes/nlf-boot.rda
===================================================================
(Binary files differ)
Modified: www/vignettes/nlf-fit-from-truth.rda
===================================================================
(Binary files differ)
Modified: www/vignettes/nlf-fits.rda
===================================================================
(Binary files differ)
Modified: www/vignettes/nlf-lag-tests.rda
===================================================================
(Binary files differ)
Modified: www/vignettes/nlf-multi-short.rda
===================================================================
(Binary files differ)
Modified: www/vignettes/pomp.pdf
===================================================================
(Binary files differ)
More information about the pomp-commits
mailing list