inst/doc/ubms.R

In ubms: Bayesian Models for Data from Unmarked Animals using 'Stan'

## ----echo=FALSE---------------------------------------------------------------
knitr::knit_hooks$set(time_it = local({
  now <- NULL
  function(before, options) {
    if (before) {
      # record the current time before each chunk
      now <<- Sys.time()
    } else {
      # calculate the time difference after a chunk
      res <- difftime(Sys.time(), now)
      # return a character string to show the time
      paste("Time for this code chunk to run:", res)
    }
  }
}))
knitr::opts_chunk$set(message=FALSE, warning=FALSE)

## -----------------------------------------------------------------------------
library(unmarked)
data(crossbill)

## -----------------------------------------------------------------------------
dim(crossbill)
names(crossbill)

## -----------------------------------------------------------------------------
site_covs <- crossbill[,c("id", "ele", "forest")]

## -----------------------------------------------------------------------------
y <- crossbill[,c("det991","det992","det993")]
head(y)

## -----------------------------------------------------------------------------
date <- crossbill[,c("date991","date992","date993")]

## -----------------------------------------------------------------------------
umf <- unmarkedFrameOccu(y=y, siteCovs=site_covs, obsCovs=list(date=date))
head(umf)

## -----------------------------------------------------------------------------
(fit_unm <- occu(~1~1, data=umf))

## ----eval=FALSE---------------------------------------------------------------
#  library(ubms)
#  
#  (fit_stan <- stan_occu(~1~1, data=umf, chains=3, iter=500, cores=3, seed=123))

## ----echo=FALSE---------------------------------------------------------------
library(ubms)
(fit_stan <- stan_occu(~1~1, data=umf, chains=3, iter=500, refresh=0, seed=123))

## -----------------------------------------------------------------------------
cbind(unmarked=coef(fit_unm), stan=coef(fit_stan))

## -----------------------------------------------------------------------------
fit_stan

## -----------------------------------------------------------------------------
sum_tab <- summary(fit_stan, "state")
sum_tab$mean[1]

## -----------------------------------------------------------------------------
names(fit_stan)
occ_intercept <- extract(fit_stan, "beta_state[(Intercept)]")[[1]]
hist(occ_intercept, freq=FALSE)
lines(density(occ_intercept), col='red', lwd=2)

## ----eval=FALSE---------------------------------------------------------------
#  fit_null <- fit_stan
#  
#  fit_global <- stan_occu(~scale(date)~scale(forest)+scale(ele), data=umf,
#                          chains=3, iter=500, seed=123)

## ----echo=FALSE---------------------------------------------------------------
fit_null <- fit_stan

## ----warning=TRUE, echo=FALSE-------------------------------------------------
fit_global <- stan_occu(~scale(date)~scale(forest)+scale(ele), data=umf,
                        chains=3, iter=500, refresh=0, seed=123)

## -----------------------------------------------------------------------------
mods <- fitList(fit_null, fit_global)

## -----------------------------------------------------------------------------
round(modSel(mods), 3)

## -----------------------------------------------------------------------------
loo(fit_global)

## -----------------------------------------------------------------------------
waic(fit_global)

## -----------------------------------------------------------------------------
fit_top <- fit_global
fit_top

## -----------------------------------------------------------------------------
traceplot(fit_top, pars=c("beta_state", "beta_det"))

## -----------------------------------------------------------------------------
plot_residuals(fit_top, submodel="state")

## -----------------------------------------------------------------------------
plot_residuals(fit_top, submodel="state", covariate="forest")

## -----------------------------------------------------------------------------
(fit_top_gof <- gof(fit_top, draws=100, quiet=TRUE))
plot(fit_top_gof)

## -----------------------------------------------------------------------------
sim_y <- posterior_predict(fit_top, "y", draws=100)
dim(sim_y)

## -----------------------------------------------------------------------------
prop0 <- apply(sim_y, 1, function(x) mean(x==0, na.rm=TRUE))

## -----------------------------------------------------------------------------
actual_prop0 <- mean(getY(fit_top) == 0, na.rm=TRUE)

#Compare
hist(prop0, col='gray')
abline(v=actual_prop0, col='red', lwd=2)

## -----------------------------------------------------------------------------
plot_effects(fit_top, "state")
plot_effects(fit_top, "det")

## -----------------------------------------------------------------------------
head(predict(fit_top, submodel="state"))

## -----------------------------------------------------------------------------
nd <- data.frame(ele=100, forest=25)
predict(fit_top, submodel="state", newdata=nd)

## -----------------------------------------------------------------------------
zpost <- posterior_predict(fit_top, "z", draws=100)
dim(zpost)

## -----------------------------------------------------------------------------
group1 <- rowMeans(zpost[,1:50], na.rm=TRUE)
group2 <- rowMeans(zpost[,51:100], na.rm=TRUE)

plot_dat <- rbind(data.frame(group="group1", occ=mean(group1),
                             lower=quantile(group1, 0.025),
                             upper=quantile(group1, 0.975)),
                  data.frame(group="group2", occ=mean(group2),
                             lower=quantile(group2, 0.025),
                             upper=quantile(group2, 0.975)))


## -----------------------------------------------------------------------------
library(ggplot2)

ggplot(plot_dat, aes(x=group, y=occ)) +
  geom_errorbar(aes(ymin=lower, ymax=upper), width=0.2) +
  geom_point(size=3) +
  ylim(0,1) +
  labs(x="Group", y="Occupancy + 95% UI") +
  theme_bw() +
  theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank(),
        axis.text=element_text(size=12), axis.title=element_text(size=14))