Echolocation plasticity in Vespertilionidae

Author

Marcelo Araya-Salas

Published

May 1, 2024

Purpose

  • Make 3D plots of change in frequency by temperature and mic distance for 5 verpertilionidae speces

Load packages

Code 
# knitr is require for creating html/pdf/word reports formatR is
# used for soft-wrapping code

# install/ load packages
sketchy::load_packages(packages = c("knitr", "formatR", "lme4", "pbapply",
    "viridis", "plot3D"))

1 Prepare data

Code 
# Myotis oxyotus
df_vesp <- read.csv(file = "~/Descargas/DataforGLM.csv", header = T, sep = ",")


#Modelos
data_sets <- split(df_vesp, f = df_vesp$GS)

lo <- 30

plot_3d_data <- lapply(data_sets, function(x){
  
  #Peak frequency
  model <- lmer(PF_E12 ~ temp * distB2Mic + (temp|Ind), data=x, REML = F,
                  control = lmerControl(optimizer ="Nelder_Mead")) # random slope
  eg <-
    expand.grid(
      temp = seq(min(x$temp), max(x$temp), length.out = lo),
      distB2Mic = seq(min(x$distB2Mic), max(x$distB2Mic), length.out = lo),
      # bt = seq(min(x$bt), max(x$bt), length.out = lo),
      Ind = unique(x$Ind)
    )
  
  #predict
  eg$pred <-predict(model, eg, type="response")
  
  ## distB2Mic vs cognition
  eg$x <- with(eg, paste(temp, distB2Mic))
  
  resx <-pbapply::pblapply(unique(eg$x), cl = 2, function(x)
  {
    Y <- eg[eg$x == x, ]
    Y2 <- Y[1, c("temp", "distB2Mic")]
    Y2$pred <- mean(Y$pred)
    return(Y2)
  })
  
  resx <- do.call(rbind, resx)
  
  resx <- resx[order(resx$temp, resx$distB2Mic),]
  
  z1=matrix(resx$pred, ncol=lo, nrow=lo, byrow = T)
  
  output <- list(resx = resx, z1 = z1)  

  return(output)  
})


names(plot_3d_data) <- names(data_sets)

2 3D plots

3 Single species

Code 
par(mar = rep(1, 4))

spp <- names(plot_3d_data)
for (i in spp) {

    resx <- plot_3d_data[[i]]$resx
    z1 <- plot_3d_data[[i]]$z1

    # png(filename = paste0('~/Descargas/', i, '.png'), res =
    # 300, width = 1700, height = 1700)

    persp3D(x = sort(resx$temp[!duplicated(resx$temp)]), y = sort(resx$distB2Mic[!duplicated(resx$distB2Mic)]),
        z = z1, phi = 404, theta = -40 + 360, xlab = "Temperature",
        ylab = "Distance", zlab = "Frequency", main = i, resfac = 2,
        col = viridis::viridis(30), colvar = z1, border = adjustcolor("black",
            0.3), bty = "u")

    # dev.off()
}

3.1 All plots combined

Code 
par(mar = rep(1, 4), mfrow = c(2, 3))

# png(filename = '~/Descargas/all.png', res = 300, width = 1700
# * 3, height = 1700 * 2)

spp <- names(plot_3d_data)
for (i in spp) {

    resx <- plot_3d_data[[i]]$resx
    z1 <- plot_3d_data[[i]]$z1

    persp3D(x = sort(resx$temp[!duplicated(resx$temp)]), y = sort(resx$distB2Mic[!duplicated(resx$distB2Mic)]),
        z = z1, phi = 404, theta = -40 + 360, xlab = "Temperature",
        ylab = "Distance", zlab = "Frequency", main = i, resfac = 2,
        col = viridis::viridis(30), colvar = z1, border = adjustcolor("black",
            0.3), bty = "u")

}


# dev.off()

Session information

R version 4.3.2 (2023-10-31)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 22.04.2 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.10.0 
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.10.0

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
 [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
 [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

time zone: America/Costa_Rica
tzcode source: system (glibc)

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] plot3D_1.4.1      viridis_0.6.5     viridisLite_0.4.2 pbapply_1.7-2    
[5] lme4_1.1-35.1     Matrix_1.6-5      formatR_1.14      knitr_1.46       

loaded via a namespace (and not attached):
 [1] utf8_1.2.4          generics_0.1.3      tcltk_4.3.2        
 [4] stringi_1.8.3       lattice_0.20-45     digest_0.6.35      
 [7] magrittr_2.0.3      evaluate_0.23       grid_4.3.2         
[10] fastmap_1.1.1       sketchy_1.0.3       jsonlite_1.8.8     
[13] misc3d_0.9-1        gridExtra_2.3       fansi_1.0.6        
[16] scales_1.3.0        cli_3.6.2           rlang_1.1.3        
[19] crayon_1.5.2        munsell_0.5.0       splines_4.3.2      
[22] remotes_2.5.0       yaml_2.3.8          packrat_0.9.2      
[25] tools_4.3.2         parallel_4.3.2      nloptr_2.0.3       
[28] minqa_1.2.6         dplyr_1.1.4         colorspace_2.1-0   
[31] ggplot2_3.5.1       boot_1.3-28         vctrs_0.6.5        
[34] R6_2.5.1            lifecycle_1.0.4     htmlwidgets_1.6.4  
[37] MASS_7.3-55         pkgconfig_2.0.3     xaringanExtra_0.7.0
[40] pillar_1.9.0        gtable_0.3.4        glue_1.7.0         
[43] Rcpp_1.0.12         xfun_0.43           tibble_3.2.1       
[46] tidyselect_1.2.0    rstudioapi_0.15.0   htmltools_0.5.8.1  
[49] nlme_3.1-155        rmarkdown_2.26      compiler_4.3.2