#Libraries used (Packages)
library(ggplot2) # Used for data visualisation (i.e barcharts)
library(reshape2) # Manipulation of data frame
library(RColorBrewer) # Colours in bar charts
library(knitr) # Complies this dynamic report

library (readxl) # read excel data
library (tidyverse) # Data handling
library (plyr)
library (hrbrthemes)
# library(dplyr)
# library(tidyr)
library (viridis)

library (unmarked) # occu analitics
# library (ggcorrplot) # corplot in ggplot
library (raster)
library (rasterVis)
library (kableExtra) # nice tables

library (stringr)
library (lubridate)
library (ggeffects) # test and plot glm
library (bayesplot)

Introduction

This document gives an introduction to the statistical analysis of insect data gathered by exclosure experiments.

include_url("https://www.gaiagps.com/public/4UcmM8lScsTnQxxG8OyZ8MPV/?slideshow=true&layer=GaiaTopoRasterFeet", height = "600px")

The data was analized by an N Mixture model.

Fitting the multinomial-Poisson mixture model to data collected using survey methods such as removal sampling.

Load data

bat_exclusure <- read_excel("C:/Users/diego.lizcano/Box Sync/CodigoR/Unillanos-Bat2019/data/Datos_Bat_exclusion_12dic2019_tydy_fix_unmarked_no_na.xlsx", 
    sheet = "Full_plagas")

luna <- read_excel("C:/Users/diego.lizcano/Box Sync/CodigoR/Unillanos-Bat2019/data/Datos_Bat_exclusion_12dic2019_tydy_fix_unmarked_no_na.xlsx", 
    sheet = "luna")

Fit the N-mixture model of Royle (2004) in unmarked.

Multinomial-Poisson mixture model of Royle (2004) fit by multinomPois.

# Organize data
CountMat <- as.matrix(bat_exclusure[,7:11])

umf <- unmarkedFrameMPois(y=CountMat, siteCovs=data.frame(bat_exclusure[,1:5]) 
          , obsCovs=list(luna=as.matrix(luna[,8:12])),
          type = "removal"
    )
summary(umf)
## unmarkedFrame Object
## 
## 88 sites
## Maximum number of observations per site: 5 
## Mean number of observations per site: 5 
## Sites with at least one detection: 88 
## 
## Tabulation of y observations:
##   0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  30 
## 101  59  69  54  36  23  23  23  12  13   2   6   7   1   4   3   1   2   1 
## 
## Site-level covariates:
##       dia                         Finca             Sistema         
##  Min.   :2019-11-10 00:00:00   Length:88          Length:88         
##  1st Qu.:2019-11-10 00:00:00   Class :character   Class :character  
##  Median :2019-11-17 00:00:00   Mode  :character   Mode  :character  
##  Mean   :2019-11-16 05:27:16                                        
##  3rd Qu.:2019-11-18 00:00:00                                        
##  Max.   :2019-11-23 00:00:00                                        
##  Tratamiento           Trampa_n    
##  Length:88          Min.   :1.000  
##  Class :character   1st Qu.:1.000  
##  Mode  :character   Median :2.000  
##                     Mean   :2.455  
##                     3rd Qu.:3.000  
##                     Max.   :5.000  
## 
## Observation-level covariates:
##       luna       
##  Min.   :0.0000  
##  1st Qu.:0.3180  
##  Median :0.6075  
##  Mean   :0.5715  
##  3rd Qu.:0.9790  
##  Max.   :1.0000
# Fit a models, multinomPois order of formulas: detection, abundance
fm0 <- multinomPois(~1 ~ 1, umf, se = TRUE)
fm1 <- multinomPois(~luna ~ 1, umf, se = TRUE)
fm2 <- multinomPois(~luna + I(luna^2) ~ 1, umf, se = TRUE)
fm3 <- multinomPois(~luna + I(luna^2) ~ Sistema, umf, se = TRUE)
fm4 <- multinomPois(~luna + I(luna^2) ~ Tratamiento, umf, se = TRUE)
fm5 <- multinomPois(~luna + I(luna^2) ~ Sistema+Tratamiento, umf, se = TRUE)
fm5 <- multinomPois(~luna + I(luna^2) ~ Sistema+Tratamiento, umf, se = TRUE)


fmList <- fitList("p(.) lamdba(.)"=fm0, 
                  "p(luna) lamdba(.)"=fm1,
                  "p(luna + I(luna^2)) lamdba(.)"=fm2,
                  "p(luna + I(luna^2)) lamdba(Sistema)"=fm3,
                  "p(luna + I(luna^2)) lamdba(Tratamiento)"=fm4,
                  "p(luna + I(luna^2)) lamdba(Sistema+Tratamiento)"=fm5
                    )

# Model selection
modSel(fmList)
##                                                 nPars     AIC delta   AICwt
## p(luna + I(luna^2)) lamdba(Sistema+Tratamiento)     6 2598.78  0.00 1.0e+00
## p(luna + I(luna^2)) lamdba(Tratamiento)             5 2619.81 21.03 2.7e-05
## p(luna + I(luna^2)) lamdba(Sistema)                 5 2628.66 29.88 3.3e-07
## p(luna + I(luna^2)) lamdba(.)                       4 2649.75 50.97 8.5e-12
## p(luna) lamdba(.)                                   3 2668.60 69.82 6.9e-16
## p(.) lamdba(.)                                      2 2668.71 69.93 6.5e-16
##                                                 cumltvWt
## p(luna + I(luna^2)) lamdba(Sistema+Tratamiento)     1.00
## p(luna + I(luna^2)) lamdba(Tratamiento)             1.00
## p(luna + I(luna^2)) lamdba(Sistema)                 1.00
## p(luna + I(luna^2)) lamdba(.)                       1.00
## p(luna) lamdba(.)                                   1.00
## p(.) lamdba(.)                                      1.00
# Detection probability after 5 removal passes
rowSums(getP(fm5))
##  [1] 0.0003200154 0.0003200154 0.0003200154 0.0003200154 0.0003200154
##  [6] 0.0003200154 0.0003200154 0.0003200154 0.0003200154 0.0003200154
## [11] 0.0003200154 0.0003200154 0.0003200154 0.0003200154 0.0003877568
## [16] 0.0003877568 0.0003877568 0.0003877568 0.0003877568 0.0003877568
## [21] 0.0003877568 0.0003877568 0.0003877568 0.0003877568 0.0002802511
## [26] 0.0002802511 0.0002802511 0.0002802511 0.0002802511 0.0002802511
## [31] 0.0002802511 0.0002802511 0.0002802511 0.0002802511 0.0003877568
## [36] 0.0003877568 0.0003877568 0.0003877568 0.0003877568 0.0003877568
## [41] 0.0003877568 0.0003877568 0.0003877568 0.0003877568 0.0003200154
## [46] 0.0003200154 0.0003200154 0.0003200154 0.0003200154 0.0003200154
## [51] 0.0003200154 0.0003200154 0.0003200154 0.0003200154 0.0003200154
## [56] 0.0003200154 0.0003200154 0.0003200154 0.0003877568 0.0003877568
## [61] 0.0003877568 0.0003877568 0.0003877568 0.0003877568 0.0003877568
## [66] 0.0003877568 0.0003877568 0.0003877568 0.0002802511 0.0002802511
## [71] 0.0002802511 0.0002802511 0.0002802511 0.0002802511 0.0002802511
## [76] 0.0002802511 0.0002802511 0.0002802511 0.0003877568 0.0003877568
## [81] 0.0003877568 0.0003877568 0.0003877568 0.0003877568 0.0003877568
## [86] 0.0003877568 0.0003877568 0.0003877568
# Empirical Bayes estimation of random effects
fm5re <- ranef(fm5, K=80)
# plot(fm5re, subset=site %in% 1:25)
sum(bup(fm5re))         # Estimated population size
## [1] NaN
#parametric bootstrap
bt <- parboot(fm5,nsim=100)
plot(bt)

# Estimates of fixed effects
e <- coef(fm5)
exp(e[1])
## lambda(Int) 
##    50493.32
plogis(e[2:3])
##    lambda(SistemaSilvopastoril) lambda(TratamientoSin_Encierro) 
##                       0.5621364                       0.4271014
# Estimates of random effects
re <- ranef(fm5, K=80)
#ltheme <- canonical.theme(color = FALSE)
#lattice.options(default.theme = ltheme)
plot(re, subset=site %in% 1:25)

newdat1 <- cbind(luna=as.numeric(seq(0,1, length=100)), Sistema="Silvopastoril", Tratamiento="Encierro")

newdat2 <- cbind(luna=as.numeric(seq(0,1, length=100)), Sistema="Silvopastoril", Tratamiento="Sin_Encierro")

newdat3 <- cbind(luna=as.numeric(seq(0,1, length=100)), Sistema="Convencional", Tratamiento="Encierro")

newdat4 <- cbind(luna=as.numeric(seq(0,1, length=100)), Sistema="Convencional", Tratamiento="Sin_Encierro")

newdat <- as.data.frame(rbind(newdat1, newdat2, newdat3, newdat4))
newdat$luna <- rep(as.numeric(seq(0,1, length=100)),4)

pred_lambda <-predict(fm5,type="state",newdata=newdat,appendData=TRUE)
pred_lambda$Predicted <- log(pred_lambda$Predicted)

pred_p <-predict(fm5,type="det",newdata=newdat,appendData=TRUE)
pred_p$Predicted <- plogis(pred_p$Predicted)

ggplot(pred_lambda, aes(x=Sistema, y=Predicted)) +
  geom_boxplot(fill='#A4A4A4', color="black") + geom_jitter()

ggplot(pred_lambda, aes(x=Tratamiento, y=Predicted)) +
  geom_boxplot(fill='#A4A4A4', color="black") + geom_jitter()

ggplot(pred_p, aes(x=luna, y=Predicted)) +
  geom_line() 

umf2 <- unmarkedFrameGMM(y=CountMat, siteCovs=data.frame(bat_exclusure[,1:5]) 
          , obsCovs=list(luna=as.matrix(luna[,8:12])),
          numPrimary=1,
          type = "removal")


fm0 <- gmultmix(lambdaformula = ~1, phiformula = ~1, pformula = ~1,
data=umf2)

# Fit Poisson models
fm1 <- gmultmix(~ Sistema, ~ 1, ~  1, data = umf2)
fm2 <- gmultmix(~ Tratamiento, ~ 1, ~ 1, data = umf2)
fm3 <- gmultmix(~ Sistema + Tratamiento, ~ 1, ~ 1, data = umf2)

# Maybe p also depends on luna?
fm5 <- gmultmix(~ Sistema + Tratamiento, ~ 1, ~ luna, data = umf2)



# Fit analogous NegBin models
fm0nb <- gmultmix(~ 1, ~ 1, ~ 1, mixture = "NB", data = umf2)
fm1nb <- gmultmix(~ Sistema, ~ 1, ~ 1, mixture = "NB", data = umf2)
fm2nb <- gmultmix(~ Tratamiento, ~ 1, ~ 1, mixture = "NB", data = umf2)
fm3nb <- gmultmix(~ Sistema + Tratamiento , ~ 1, ~ 1, mixture = "NB", data = umf2)


# maybe p also depends on luna?
fm5nb <- gmultmix(~ Sistema + Tratamiento, ~ 1, ~ luna, mixture = "NB",
data = umf2)



# Rank models by AIC
gms <- fitList(
"lam(.)p(.)"                                = fm0,
"lam(Sistema)p(.)"                              = fm1,
"lam(Tratamiento)p(.)"                             = fm2,
"lam(Sistema+Tratamiento)p(.)"                         = fm3,
"lam(Sistema+Tratamiento)p(luna)"                       = fm5,
"NB,lam(.)p(.)"                             = fm0nb,
"NB,lam(Sistema)p(.)"                           = fm1nb,
"NB,lam(Tratamiento)p(.)"                          = fm2nb,
"NB,lam(Sistema+Tratamiento)p(.)"                      = fm3nb,
"NB,lam(Sistema+Tratamiento)p(luna)"                    = fm5nb
)


gms1 <- modSel(gms)
gms1
##                                    nPars     AIC  delta   AICwt cumltvWt
## NB,lam(Sistema+Tratamiento)p(luna)     6 -765.33   0.00 6.8e-01     0.68
## NB,lam(Sistema+Tratamiento)p(.)        5 -762.88   2.45 2.0e-01     0.87
## NB,lam(Tratamiento)p(.)                4 -761.42   3.91 9.6e-02     0.97
## NB,lam(Sistema)p(.)                    4 -758.42   6.91 2.1e-02     0.99
## NB,lam(.)p(.)                          3 -756.93   8.40 1.0e-02     1.00
## lam(Sistema+Tratamiento)p(.)           4 -665.33 100.00 1.3e-22     1.00
## lam(Sistema+Tratamiento)p(luna)        5 -663.41 101.92 5.0e-23     1.00
## lam(Tratamiento)p(.)                   3 -652.36 112.97 2.0e-25     1.00
## lam(Sistema)p(.)                       3 -640.24 125.09 4.6e-28     1.00
## lam(.)p(.)                             2 -626.85 138.48 5.7e-31     1.00
# Detection probability after 5 removal passes
rowSums(getP(fm5nb))
##  [1] 0.2565724 0.2565724 0.2565724 0.2565724 0.2565724 0.2565724 0.2565724
##  [8] 0.2565724 0.2565724 0.2565724 0.2565724 0.2565724 0.2565724 0.2565724
## [15] 0.2849550 0.2849550 0.2849550 0.2849550 0.2849550 0.2849550 0.2849550
## [22] 0.2849550 0.2849550 0.2849550 0.3199744 0.3199744 0.3199744 0.3199744
## [29] 0.3199744 0.3199744 0.3199744 0.3199744 0.3199744 0.3199744 0.2849550
## [36] 0.2849550 0.2849550 0.2849550 0.2849550 0.2849550 0.2849550 0.2849550
## [43] 0.2849550 0.2849550 0.2565724 0.2565724 0.2565724 0.2565724 0.2565724
## [50] 0.2565724 0.2565724 0.2565724 0.2565724 0.2565724 0.2565724 0.2565724
## [57] 0.2565724 0.2565724 0.2849550 0.2849550 0.2849550 0.2849550 0.2849550
## [64] 0.2849550 0.2849550 0.2849550 0.2849550 0.2849550 0.3199744 0.3199744
## [71] 0.3199744 0.3199744 0.3199744 0.3199744 0.3199744 0.3199744 0.3199744
## [78] 0.3199744 0.2849550 0.2849550 0.2849550 0.2849550 0.2849550 0.2849550
## [85] 0.2849550 0.2849550 0.2849550 0.2849550
# Empirical Bayes estimation of random effects
fm5nbre <- ranef(fm5nb, K=80)
# plot(fm5re, subset=site %in% 1:25)
sum(bup(fm5nbre))         # Estimated population size
## [1] 5206.467
#parametric bootstrap
bt <- parboot(fm5nb,nsim=100)
plot(bt)

# Estimates of fixed effects
e <- coef(fm5nb)
exp(e[1])
## lambda(Int) 
##    61.04965
plogis(e[2:3])
##    lambda(SistemaSilvopastoril) lambda(TratamientoSin_Encierro) 
##                       0.5459331                       0.4364225
# Estimates of random effects
re <- ranef(fm5nb, K=80)
#ltheme <- canonical.theme(color = FALSE)
#lattice.options(default.theme = ltheme)
plot(re, subset=site %in% 1:25)

plot(re, subset=site %in% 26:50)

pred_lambda_nb <-predict(fm5nb,type="lambda",newdata=newdat,appendData=TRUE)
pred_lambda_nb$Predicted <- log(pred_lambda$Predicted)

pred_p_nb <-predict(fm5nb,type="det",newdata=newdat,appendData=TRUE)
#pred_p_nb$Predicted <- plogis(pred_p$Predicted)
#pred_p_nb$lower <- plogis(pred_p$lower)
#pred_p_nb$upper <- plogis(pred_p$upper)


ggplot(pred_lambda_nb, aes(x=Sistema, y=Predicted)) +
  geom_boxplot(fill='#A4A4A4', color="black") + geom_jitter()

ggplot(pred_lambda_nb, aes(x=Tratamiento, y=Predicted)) +
  geom_boxplot(fill='#A4A4A4', color="black") + geom_jitter()

ggplot(pred_p_nb) +
  geom_line( aes(x=luna, y=Predicted), color="black") + 
 geom_line(aes(x=luna, y=Predicted + SE), colour="blue", linetype="dotted") +
  geom_line(aes(x=luna, y=Predicted - SE), colour="blue", linetype="dotted") # + ylim(0.6, 0.65)

Session Info

Details and pakages used

print(sessionInfo(), locale = FALSE)
## R version 3.5.3 (2019-03-11)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 18362)
## 
## Matrix products: default
## 
## attached base packages:
## [1] parallel  stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] bayesplot_1.7.1     ggeffects_0.14.0    lubridate_1.7.4    
##  [4] kableExtra_1.1.0    rasterVis_0.46      latticeExtra_0.6-28
##  [7] raster_3.0-7        sp_1.3-2            unmarked_0.13-1    
## [10] Rcpp_1.0.3          lattice_0.20-38     viridis_0.5.1      
## [13] viridisLite_0.3.0   hrbrthemes_0.6.0    plyr_1.8.5         
## [16] forcats_0.4.0       stringr_1.4.0       dplyr_0.8.3        
## [19] purrr_0.3.3         readr_1.3.1         tidyr_1.0.0.9000   
## [22] tibble_2.1.3        tidyverse_1.3.0     readxl_1.3.1       
## [25] knitr_1.26          RColorBrewer_1.1-2  reshape2_1.4.3     
## [28] ggplot2_3.2.1      
## 
## loaded via a namespace (and not attached):
##  [1] httr_1.4.1       jsonlite_1.6     modelr_0.1.5     assertthat_0.2.1
##  [5] highr_0.8        cellranger_1.1.0 yaml_2.2.0       gdtools_0.1.8   
##  [9] Rttf2pt1_1.3.7   pillar_1.4.2     backports_1.1.5  glue_1.3.1      
## [13] extrafontdb_1.0  digest_0.6.21    rvest_0.3.5      colorspace_1.4-1
## [17] htmltools_0.4.0  Matrix_1.2-17    pkgconfig_2.0.3  broom_0.5.3     
## [21] haven_2.2.0      webshot_0.5.1    scales_1.0.0     generics_0.0.2  
## [25] sjlabelled_1.1.1 withr_2.1.2      hexbin_1.27.3    lazyeval_0.2.2  
## [29] cli_1.1.0        magrittr_1.5     crayon_1.3.4     evaluate_0.14   
## [33] fs_1.3.1         nlme_3.1-140     MASS_7.3-51.1    xml2_1.2.2      
## [37] tools_3.5.3      hms_0.5.2        lifecycle_0.1.0  munsell_0.5.0   
## [41] reprex_0.3.0     compiler_3.5.3   rlang_0.4.2      ggridges_0.5.1  
## [45] grid_3.5.3       rstudioapi_0.10  labeling_0.3     rmarkdown_1.17  
## [49] gtable_0.3.0     codetools_0.2-16 DBI_1.0.0        sjmisc_2.8.2    
## [53] R6_2.4.0         gridExtra_2.3    zoo_1.8-5        extrafont_0.17  
## [57] zeallot_0.1.0    insight_0.7.1    stringi_1.4.3    vctrs_0.2.0     
## [61] dbplyr_1.4.2     tidyselect_0.2.5 xfun_0.11

Cited Literature