Calling activity
Group flight coordination in Thyroptera
Marcelo Araya-Salas, PhD & Gloriana Chaverri, PhD
07-10-2020
Exploratory graphs on calling rate
Calls per experiment
ggplot(agg_cnt, aes(x = exp.type, y = call_cnt)) +
geom_violin(fill = viridis(10, alpha = 0.5)[3]) +
scale_fill_viridis_d(alpha = 0.4) +
geom_point(data = mean_cnt, size = 3) +
labs(x = "Experiment", y = "Call counts per time window") +
theme_classic() + ggtitle("Raw counts")
ggplot(agg_cnt, aes(x = exp.type, y = stand_count)) +
geom_violin(fill = viridis(10, alpha = 0.5)[3]) +
scale_fill_viridis_d(alpha = 0.4) +
geom_point(data = mean_std_cnt, size = 3) +
labs(x = "Experiment", y = "Call counts per time window / group size") +
theme_classic() + ggtitle("Standardize counts")
Calls per experiment by time window
- Time windows after 140 s were excluded
agg_cnt_sgmt$sgmts <- as.factor(agg_cnt_sgmt$sgmts)
# View(agg_cnt_sgmt)
mean_cnt_sgmt <- aggregate(stand_count ~ sgmts + exp.type, data = agg_cnt_sgmt[as.numeric(as.character(agg_cnt_sgmt$sgmts)) < 140, ], FUN = mean)
mean_cnt_sgmt$sd <- aggregate(stand_count ~ sgmts + exp.type, data = agg_cnt_sgmt[as.numeric(as.character(agg_cnt_sgmt$sgmts)) < 140, ], FUN = sd)[, 3]
mean_cnt_sgmt$se <- aggregate(stand_count ~ sgmts + exp.type, data = agg_cnt_sgmt[as.numeric(as.character(agg_cnt_sgmt$sgmts)) < 140, ], FUN = function(x) sd(x) / sqrt(length(x)))[, 3]
# ggplot(agg_cnt_sgmt[as.numeric(as.character(agg_cnt_sgmt$sgmts)) < 140, ], aes(x = sgmts, y = stand_count)) + geom_violin(fill = viridis(10, alpha = 0.5)[3]) +
# scale_fill_viridis_d(alpha = 0.4) +
# facet_wrap(~ exp.type, nrow = 2) +
# geom_point(data = mean_cnt_sgmt[as.numeric(as.character(mean_cnt_sgmt$sgmts)) < 140, ], size = 2) +
# theme_classic()
pd <- position_dodge(0.2)
ggplot(mean_cnt_sgmt, aes(x = sgmts, y = stand_count, col = exp.type, group = exp.type)) +
# scale_fill_viridis_d(alpha = 0.4) +
scale_color_manual(values = viridis(10)[c(1, 4, 10, 7)]) +
geom_point( size = 2) +
geom_line() +
labs(x = "Time (s)",y = "Call count / group size") +
geom_errorbar(aes(ymin = stand_count - se, ymax = stand_count + se, col = exp.type), width = .1, position = pd) +
theme_classic() +
theme(legend.position = c(0.2, 0.8))
ggplot(mean_cnt_sgmt[!grepl("obsta", mean_cnt_sgmt$exp.type), ], aes(x = sgmts, y = stand_count, col = exp.type, group = exp.type)) +
scale_color_manual(values = viridis(10)[c(1, 4, 7)]) +
geom_point(size = 2) +
geom_line() +
labs(x = "Time (s)",y = "Call count / group size") +
geom_errorbar(aes(ymin = stand_count - se, ymax = stand_count + se, col = exp.type), width = .1, position = pd) +
theme_classic() + guides(color = FALSE) 
Calling activity per individual
caps <- as.data.frame(read_excel("./data/raw/Proyecto MPI enero 2020_2.xlsx", sheet = "Capturas"))
agg_cnt_sgmt$sex <- sapply(agg_cnt_sgmt$indiv, function(x) na.exclude(caps$Sexo[caps$Murci == x])[1], USE.NAMES = FALSE)
agg_cnt_sgmt$sex <- ifelse(agg_cnt_sgmt$sex == "m", "Male", "Female")
agg_cnt_sgmt$sex[agg_cnt_sgmt$indiv == "group"] <- "group"
agg_cnt_sgmt$age <- sapply(agg_cnt_sgmt$indiv, function(x) na.exclude(caps$Edad[caps$Murci == x])[1], USE.NAMES = FALSE)
agg_cnt_sgmt$age <- ifelse(agg_cnt_sgmt$age == "sa", "Sub-adult", "Adult")
agg_cnt_sgmt$age[agg_cnt_sgmt$indiv == "group"] <- "group"
agg_cnt_sgmt$reprod.stg <- sapply(agg_cnt_sgmt$indiv, function(x) na.exclude(caps$`Estado reproductivo`[caps$Murci == x])[1], USE.NAMES = FALSE)
agg_cnt_sgmt$reprod.stg[agg_cnt_sgmt$reprod.stg == "p?"] <- "p"
agg_cnt_sgmt$reprod.stg[agg_cnt_sgmt$reprod.stg == "ne"] <- "in"
agg_cnt_sgmt$reprod.stg[agg_cnt_sgmt$indiv == "group"] <- "group"
grp_cnt_sgmt <- aggregate(stand_count ~ sgmts + exp.type + indiv + group + sex, data = agg_cnt_sgmt, FUN = mean)
ggs <- lapply(unique(grp_cnt_sgmt$group), function(x){
grp <- grp_cnt_sgmt[grp_cnt_sgmt$group == x, ]
nind <- length(unique(grp$indiv)) - 1
gg <- ggplot(grp, aes(x = sgmts, y = stand_count, col = sex, group = indiv)) +
# scale_color_manual(values = c(rep(viridis(10)[8], nind), "black")) +
geom_point(size = 1) +
geom_line(aes(linetype = indiv)) +
scale_linetype_manual(values = c(rep(1, nind), 2)) +
labs(x = "Time (s)",y = "Call count / group size") +
theme_classic() +
ggtitle(x) +
theme(
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank()
)
gg <- #if (x != 1) gg + guides(color = FALSE, linetype = FALSE) else
gg + guides(linetype = FALSE) +
theme(legend.position = c(0.2, 0.8))
return(gg)
})
# ggs[[1]]
plot_grid(plotlist = ggs, ncol = 2)
##### by age
grp_cnt_sgmt2 <- aggregate(stand_count ~ sgmts + exp.type + indiv + group + age, data = agg_cnt_sgmt, FUN = mean)
ggs2 <- lapply(unique(grp_cnt_sgmt2$group), function(x){
grp <- grp_cnt_sgmt2[grp_cnt_sgmt2$group == x, ]
nind <- length(unique(grp$indiv)) - 1
gg <- ggplot(grp, aes(x = sgmts, y = stand_count, col = age, group = indiv)) +
# scale_color_manual(values = c(rep(viridis(10)[8], nind), "black")) +
geom_point(size = 1) +
geom_line(aes(linetype = indiv)) +
scale_linetype_manual(values = c(rep(1, nind), 2)) +
labs(x = "Time (s)",y = "Call count / group size") +
theme_classic() +
ggtitle(x) +
theme(
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank()
)
gg <- #if (x != 1) gg + guides(color = FALSE, linetype = FALSE) else
gg + guides(linetype = FALSE) +
theme(legend.position = c(0.2, 0.8))
return(gg)
})
# ggs2[[1]]
plot_grid(plotlist = ggs2, ncol = 2)
##### by repr stage
grp_cnt_sgmt3 <- aggregate(stand_count ~ sgmts + exp.type + indiv + group + reprod.stg, data = agg_cnt_sgmt, FUN = mean)
ggs3 <- lapply(unique(grp_cnt_sgmt3$group), function(x){
grp <- grp_cnt_sgmt3[grp_cnt_sgmt3$group == x, ]
nind <- length(unique(grp$indiv)) - 1
gg <- ggplot(grp, aes(x = sgmts, y = stand_count, col = reprod.stg, group = indiv)) +
# scale_color_manual(values = c(rep(viridis(10)[8], nind), "black")) +
geom_point(size = 1) +
geom_line(aes(linetype = indiv)) +
scale_linetype_manual(values = c(rep(1, nind), 2)) +
labs(x = "Time (s)",y = "Call count / group size") +
theme_classic() +
ggtitle(x) +
theme(
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank()
)
gg <- #if (x != 1) gg + guides(color = FALSE, linetype = FALSE) else
gg + guides(linetype = FALSE) +
theme(legend.position = c(0.2, 0.8))
return(gg)
})
# ggs3[[1]]
plot_grid(plotlist = ggs3, ncol = 2)
Session information
## R version 4.0.2 (2020-06-22)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
##
## locale:
## [1] LC_CTYPE=pt_BR.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=es_CR.UTF-8 LC_COLLATE=pt_BR.UTF-8
## [5] LC_MONETARY=es_CR.UTF-8 LC_MESSAGES=pt_BR.UTF-8
## [7] LC_PAPER=es_CR.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=es_CR.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] parallel stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] cowplot_1.1.0 ggplot2_3.3.2 readxl_1.3.1
## [4] Sim.DiffProc_4.7 ranger_0.12.1 rfigshare_0.3.7.100
## [7] RJSONIO_1.3-1.4 viridis_0.5.1 viridisLite_0.3.0
## [10] Rraven_1.0.10 pbapply_1.4-3 bioacoustics_0.2.4
## [13] warbleR_1.1.25 NatureSounds_1.0.3 knitr_1.30
## [16] seewave_2.1.6 tuneR_1.3.3 devtools_2.3.2
## [19] usethis_1.6.3
##
## loaded via a namespace (and not attached):
## [1] httr_1.4.2 pkgload_1.1.0 moments_0.14 assertthat_0.2.1
## [5] cellranger_1.1.0 yaml_2.2.1 remotes_2.2.0 sessioninfo_1.1.1
## [9] pillar_1.4.6 backports_1.1.10 lattice_0.20-41 glue_1.4.2
## [13] digest_0.6.25 promises_1.1.1 colorspace_1.4-1 htmltools_0.5.0
## [17] httpuv_1.5.4 Matrix_1.2-18 XML_3.99-0.5 pkgconfig_2.0.3
## [21] purrr_0.3.4 scales_1.1.1 processx_3.4.4 later_1.1.0.1
## [25] dtw_1.22-3 tibble_3.0.3 proxy_0.4-24 farver_2.0.3
## [29] generics_0.0.2 ellipsis_0.3.1 withr_2.3.0 cli_2.0.2
## [33] magrittr_1.5 crayon_1.3.4 memoise_1.1.0 evaluate_0.14
## [37] ps_1.3.4 fs_1.5.0 fansi_0.4.1 MASS_7.3-51.6
## [41] pkgbuild_1.1.0 tools_4.0.2 prettyunits_1.1.1 lifecycle_0.2.0
## [45] stringr_1.4.0 fftw_1.0-6 munsell_0.5.0 callr_3.4.4
## [49] Deriv_4.1.0 compiler_4.0.2 signal_0.7-6 rlang_0.4.7
## [53] grid_4.0.2 RCurl_1.98-1.2 rjson_0.2.20 labeling_0.3
## [57] bitops_1.0-6 rmarkdown_2.4 testthat_2.3.2 gtable_0.3.0
## [61] R6_2.4.1 gridExtra_2.3 dplyr_1.0.2 rprojroot_1.3-2
## [65] desc_1.2.0 stringi_1.5.3 Rcpp_1.0.5 vctrs_0.3.4
## [69] tidyselect_1.1.0 xfun_0.17