Plot results for manuscript

Primary Investigator: Althea ArchMiller

Collaborators: J. Fieberg, B. Dorazio, K. St. Clair

Description Create plots for the manuscript and for the appendices.

Preamble

# Documentation-related
library(devtools)
library(knitr)
library(ezknitr)

# Analysis-related
library(ggplot2)
library(ggthemes)
library(gridExtra)

# Remove environment and set seed
remove(list=ls())
set.seed(4587)

Load Files

Posteriors for Psi/Lambda

load("data/processed_results/psiPosts.Rdata")
load("data/processed_results/lambdaPosts.Rdata")

Population estimates

load("data/processed_results/popnEsts.Rdata")
load("data/processed_results/popnEstsJoint.Rdata")

Sightability curves for joint models and mHT

load("data/processed_results/sightCurve_Joint.Rdata")
load("data/processed_results/sightCurve_mHT.Rdata")

VOC posteriors for 2006

load("data/processed_results/vocPosts2006.Rdata")

Combined population estimates + log rate of change

Population estimates graph

pe11 <- ggplot(data = popn.ests[popn.ests$Method=="FE model"|
                                  popn.ests$Method=="TS model",], 
               aes(x = Year, y = tauhat, colour=Method, shape=Method))+
  geom_ribbon(data = popn.ests[popn.ests$Method=="mHT",], 
              aes(x = Year, ymin = tau.LL90, ymax = tau.UL90),
              fill="#e8e8e8")+
  geom_line(data = popn.ests[popn.ests$Method=="mHT",], 
            aes(y = tauhat), colour="#969696",size=1.1)+
  geom_pointrange(aes(ymin=tau.LL90, ymax=tau.UL90), 
                  position=position_dodge(0.2))+
  geom_line(position=position_dodge(0.2))+
  ylab(expression(hat(tau)[t]*" (90% CI)"))+
  scale_x_continuous(breaks=seq(2005,2016,1), limits = c(2004.8, 2016.2))+
  theme_tufte()+
  theme(legend.position = c(0.8,0.8),
        legend.title = element_blank())+
  scale_color_manual(values = c("#ae017e", "#e8e8e8", "#2ca25f"))+
  ggtitle("A")

Log change graph

lc <- ggplot(data = popn.ests[popn.ests$Method!="mHT",], 
             aes(x = Year, y = logdiff, colour=Method, shape=Method))+
  geom_ribbon(data = popn.ests[popn.ests$Method=="mHT",], 
              aes(x = Year, ymin = logdiff.LL90, ymax = logdiff.UL90),
              fill="#e8e8e8")+
  geom_line(data = popn.ests[popn.ests$Method=="mHT",], 
            aes(y = logdiff), colour="#969696", size=1.1)+
  geom_hline(aes(yintercept=0))+
  geom_pointrange(aes(ymin=logdiff.LL90, ymax=logdiff.UL90), 
                  position=position_dodge(0.2))+
  geom_line(position=position_dodge(0.2))+
  ylab(expression("log("*hat(tau)[t]*"/"*hat(tau)[t*-1]*") (90% CI)"))+
  scale_x_continuous(breaks=seq(2005,2016,1),limits = c(2004.8, 2016.2))+
  theme_tufte()+
  theme(legend.position="none")+
  scale_color_manual(values = c("#ae017e", "#e8e8e8", "#2ca25f"),
                     breaks = c("FEM", "TEM"))+
  ggtitle("B")

Combine together

grid.arrange(pe11, lc, ncol=1)
## Warning: Removed 1 rows containing missing values (geom_path).
## Warning: Removed 2 rows containing missing values (geom_pointrange).
## Warning: Removed 2 rows containing missing values (geom_path).

plot of chunk popnLog11

pdf("manuscript/figures/popnLog11-1.pdf", width = 6, height = 4.5)
grid.arrange(pe11, lc, ncol=1)
## Warning: Removed 1 rows containing missing values (geom_path).
## Warning: Removed 2 rows containing missing values (geom_pointrange).
## Warning: Removed 2 rows containing missing values (geom_path).
dev.off()
## RStudioGD 
##         2

Plot Psi Posteriors plot

ggplot(aes(x = as.factor(Year), y = Median, colour=Method, shape=Method), 
       data=psiPosteriors)+
  geom_linerange(aes(ymin=LL, ymax=UL), position = position_dodge(0.3))+
  geom_point(aes(y=Median), position = position_dodge(0.3))+
  facet_grid(Strata~.)+
  xlab("Year")+
  ylab(expression("Mean "*psi['h,t']))+
  scale_color_manual(breaks = c("FE model", "TS model"),
                     values = c("#ae017e", "#2ca25f"))+
  theme_minimal()+
  theme(legend.position = "bottom")

plot of chunk psiPosts

ggsave("manuscript/figures/psiPosts-1.png", width = 5, height = 5)
ggsave("manuscript/figures/psiPosts-1.pdf", width = 5, height = 5)

plot of chunk psiPosts


Plot lambda Posteriors plot

ggplot(aes(x = as.factor(Year), y = Median, colour=Method, shape=Method), 
       data=lambdaPosteriors)+
  geom_linerange(aes(ymin=LL, ymax=UL), position = position_dodge(0.3))+
  geom_point(aes(y=Median), position = position_dodge(0.3))+
  facet_grid(Strata~.)+
  xlab("Year")+
  ylab(expression(lambda['h,t']))+
  scale_color_manual(breaks = c("FE model", "TS model"),
                     values = c("#ae017e", "#2ca25f"))+
  theme_minimal()+
  theme(legend.position = "bottom")

plot of chunk lambdaPosts

ggsave("manuscript/figures/lambdaPosts-1.png", width = 5, height = 5)
ggsave("manuscript/figures/lambdaPosts-1.pdf", width = 5, height = 5)

plot of chunk lambdaPosts


Combined plots of detection model sensitivity

Function to get legend

get_legend<-function(myggplot){
  tmp <- ggplot_gtable(ggplot_build(myggplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)
}

Part 1: Sight model curves

sc <- ggplot(data = sightcurve.mHT,
             aes(x = voc, y = g, colour=Method))+
  geom_ribbon(aes(ymin = LL90, ymax = UL90), fill="#e8e8e8", color="#e8e8e8")+
  geom_line(color="#969696", size = 1.1)+
  geom_line(data = sightcurve.joint, aes(x=x, y=g, colour=Method))+
  theme_tufte()+
  theme(legend.position = "none")+
  scale_color_manual(values = c("#2166ac","#67a9cf", "#78c679",
                                "#fc8d59","#b2182b"),
                     labels = c("2yrs", "3yrs", "4yrs", "5yrs", "11yrs"))+
  ggtitle("A")+
  ylab(expression(hat(g)['h,i,j,t']))+
  xlab(expression(x['h,i,j,t']))

Part 2: Population estimates

pe <- ggplot(data = popn.ests[popn.ests$Method=="mHT"&popn.ests$Year>2005,], 
             aes(x = Year, y = tauhat))+
  geom_ribbon(aes(x = Year, ymin = tau.LL90, ymax = tau.UL90), 
              colour="#e8e8e8", fill="#e8e8e8")+
  geom_line(colour="#969696",size=1.1)+
  geom_pointrange(data = popn.ests.joint,
                  aes(ymin=tauhat.LL90, ymax=tauhat.UL90, y=tauhat.median,
                      colour=Method, shape=Method), 
                  position=position_dodge(0.2))+
  geom_line(data = popn.ests.joint,
            aes(y=tauhat.median, colour=Method), 
            position=position_dodge(0.2))+
  ylab(expression(hat(tau)[t]*" (90% CI)"))+
  scale_x_continuous(breaks=seq(2006,2016,2))+
  theme_tufte()+
  scale_color_manual(values = c("#2166ac","#67a9cf", "#78c679",
                                "#fc8d59","#b2182b"))+
  ggtitle("B")+
  theme(legend.position = c(0.8,0.8), 
      legend.justification = c(0.8,0.8),
      legend.title = element_blank())
legend.pe <- get_legend(pe)
pe2 <- ggplot(data = popn.ests[popn.ests$Method=="mHT"&popn.ests$Year>2005,], 
             aes(x = Year, y = tauhat))+
  geom_ribbon(aes(x = Year, ymin = tau.LL90, ymax = tau.UL90), 
              colour="#e8e8e8", fill="#e8e8e8")+
  geom_line(colour="#969696",size=1.1)+
  geom_pointrange(data = popn.ests.joint,
                  aes(ymin=tauhat.LL90, ymax=tauhat.UL90, y=tauhat.median,
                      colour=Method, shape=Method), 
                  position=position_dodge(0.2))+
  geom_line(data = popn.ests.joint,
            aes(y=tauhat.median, colour=Method), 
            position=position_dodge(0.2))+
  ylab(expression(hat(tau)[t]*" (90% CI)"))+
  scale_x_continuous(breaks=seq(2006,2016,2))+
  theme_tufte()+
  scale_color_manual(values = c("#2166ac","#67a9cf", "#78c679",
                                "#fc8d59","#b2182b"))+
  ggtitle("B")+
  theme(legend.position = "none")

Part 3: VOC posteriors

vp <- ggplot(aes(x = voc, colour = Method), 
             data=voc.posts.yr2006)+
  geom_density()+
  theme_tufte()+
  facet_grid(.~time)+
  scale_color_manual(values = c("#2166ac","#67a9cf", "#78c679",
                                "#fc8d59","#b2182b"))+
  ggtitle("C")+
  xlab(expression(mu[2006]^x))+
  theme(legend.position = "none")

Combine together

grid.arrange(sc, pe2, legend.pe, vp, ncol=3, 
             layout_matrix=rbind(c(1,2,3),c(4,4,4)), 
             widths=c(2.5,2.5,0.75))

plot of chunk detectSens

pdf("manuscript/figures/detectSens-1.pdf", width = 6, height = 4.5)
grid.arrange(sc, pe2, legend.pe, vp, ncol=3, 
             layout_matrix=rbind(c(1,2,3),c(4,4,4)), 
             widths=c(2.5,2.5,0.5))
dev.off()
## RStudioGD 
##         2

Calculations for paper

Mean precision (i.e., width of 90% CIs/CRIs) by method

popn.ests$range <- popn.ests$tau.UL90 - popn.ests$tau.LL90
summaryBy(range~Method, data=popn.ests, FUN = mean)
## Error in eval(expr, envir, enclos): could not find function "summaryBy"

Footer

Session Information

devtools::session_info()
## Session info -------------------------------------------------------------
##  setting  value                       
##  version  R version 3.3.2 (2016-10-31)
##  system   x86_64, darwin13.4.0        
##  ui       RStudio (1.0.143)           
##  language (EN)                        
##  collate  en_US.UTF-8                 
##  tz       America/Chicago             
##  date     2018-01-02
## Packages -----------------------------------------------------------------
##  package     * version date       source        
##  assertthat    0.2.0   2017-04-11 CRAN (R 3.3.2)
##  base        * 3.3.2   2016-10-31 local         
##  colorspace    1.3-2   2016-12-14 CRAN (R 3.3.2)
##  datasets    * 3.3.2   2016-10-31 local         
##  devtools    * 1.13.3  2017-08-02 CRAN (R 3.3.2)
##  digest        0.6.12  2017-01-27 CRAN (R 3.3.2)
##  evaluate      0.10.1  2017-06-24 CRAN (R 3.3.2)
##  ezknitr     * 0.6     2016-09-16 CRAN (R 3.3.0)
##  ggplot2     * 2.2.1   2016-12-30 CRAN (R 3.3.2)
##  ggthemes    * 3.4.0   2017-02-19 CRAN (R 3.3.2)
##  graphics    * 3.3.2   2016-10-31 local         
##  grDevices   * 3.3.2   2016-10-31 local         
##  grid          3.3.2   2016-10-31 local         
##  gridExtra   * 2.3     2017-09-09 CRAN (R 3.3.2)
##  gtable        0.2.0   2016-02-26 CRAN (R 3.3.0)
##  highr         0.6     2016-05-09 CRAN (R 3.3.0)
##  knitr       * 1.17    2017-08-10 CRAN (R 3.3.2)
##  labeling      0.3     2014-08-23 CRAN (R 3.3.0)
##  lazyeval      0.2.0   2016-06-12 CRAN (R 3.3.0)
##  magrittr      1.5     2014-11-22 CRAN (R 3.3.0)
##  markdown      0.8     2017-04-20 CRAN (R 3.3.2)
##  memoise       1.1.0   2017-04-21 CRAN (R 3.3.2)
##  methods     * 3.3.2   2016-10-31 local         
##  mime          0.5     2016-07-07 CRAN (R 3.3.0)
##  munsell       0.4.3   2016-02-13 CRAN (R 3.3.0)
##  plyr          1.8.4   2016-06-08 CRAN (R 3.3.0)
##  R.methodsS3   1.7.1   2016-02-16 CRAN (R 3.3.0)
##  R.oo          1.21.0  2016-11-01 CRAN (R 3.3.0)
##  R.utils       2.5.0   2016-11-07 CRAN (R 3.3.0)
##  Rcpp          0.12.13 2017-09-28 CRAN (R 3.3.2)
##  reshape2      1.4.2   2016-10-22 CRAN (R 3.3.0)
##  rlang         0.1.2   2017-08-09 CRAN (R 3.3.2)
##  rstudioapi    0.7     2017-09-07 CRAN (R 3.3.2)
##  scales        0.5.0   2017-08-24 CRAN (R 3.3.2)
##  stats       * 3.3.2   2016-10-31 local         
##  stringi       1.1.5   2017-04-07 CRAN (R 3.3.2)
##  stringr       1.2.0   2017-02-18 CRAN (R 3.3.2)
##  tibble        1.3.4   2017-08-22 CRAN (R 3.3.2)
##  tools         3.3.2   2016-10-31 local         
##  utils       * 3.3.2   2016-10-31 local         
##  withr         2.0.0   2017-07-28 CRAN (R 3.3.2)

spun with: ezknitr::ezspin(“programs/ms_programs/g_plot_results.R”, out_dir = “output”, fig_dir = “figures”, keep_md = F)