Load packages
## vector with package names
x <- c( "pbapply", "parallel", "ggplot2", "readxl", "knitr", "kableExtra", "viridis", "baRulho", "ggplot2")
aa <- lapply(x, function(y) {
# check if installed, if not then install
if (!y %in% installed.packages()[,"Package"])
if (y != "Biostrings")
install.packages(y) else
BiocManager::install("Biostrings")
# load package
try(require(y, character.only = T), silent = T)
})
Functions and parameters
#functions and parameters
knitr::opts_knit$set(root.dir = normalizePath(".."))
knitr::opts_chunk$set(dpi = 200)
options(knitr.kable.NA = '-')
# ggplot2 theme
theme_set(theme_classic(base_size = 90))
strReverse <- function(x) sapply(lapply(strsplit(x, NULL), rev), paste, collapse="")
shorten_name <- function(x, minlength) as.vector(strReverse(abbreviate(strReverse(x), minlength)))
read_excel_df <- function(...) data.frame(read_excel(...))
Load data
# read data
grp <- read_excel_df("./data/raw/GC_lab_thyroptera_database.xlsx", sheet = "group_capture_data")
grp$date <- as.Date(grp$date, format = "%m/%d/%Y")
ind <- read_excel_df("./data/raw/GC_lab_thyroptera_database.xlsx", sheet = "individual_capture data")
ind$short.name <- shorten_name(ind$transponder_ID, 4)
ind <- ind[!is.na(ind$transponder_ID), ]
adult_ind <- ind[ind$age == "adult", ]
dyad_vocal_exp <- read_excel_df("./data/raw/pairwise_vocal_response_experiment.xlsx")
dyad_vocal_exp <- dyad_vocal_exp[!is.na(dyad_vocal_exp$Group), ]
dyad_vocal_exp$short_dyad <- paste(shorten_name(dyad_vocal_exp$ID_flying, 4), shorten_name(dyad_vocal_exp$ID_leaf, 4), sep = "-")
dyad_vocal_exp$replicate <- ifelse(duplicated(dyad_vocal_exp$dyad), 2, 1)
dyad_vocal_exp$dyad.replicate <- paste(dyad_vocal_exp$dyad, dyad_vocal_exp$replicate, sep = "-")
# remove those than need to be repeated
dyad_vocal_exp <- dyad_vocal_exp[dyad_vocal_exp$Status == "done", ]
Last day recorded is 2021-07-02
Group info
Number of individuals by group and age:
agg_cnt <- aggregate(ind$transponder_ID ~ age + group_ID, data = ind, function(x) length(unique(x)))
agg_cnt <- agg_cnt[order(agg_cnt$group_ID),]
names(agg_cnt)[3] <- "count"
kb <- kable(agg_cnt[, c("age", "count")], row.names = FALSE)
tb <- table(agg_cnt$group_ID)
names(tb) <- paste("group", names(tb))
kb <- pack_rows(kable_input = kb, index = tb)
kb <- column_spec(kb, 2, color = "black",
background = ifelse(agg_cnt$age != "adult", "white", viridis(10, alpha = 0.4)[10]))
kb <- kable_styling(kb, bootstrap_options = c("striped", "hover", "condensed", "responsive"))
print(kb)
|
age
|
count
|
|
group 1
|
|
adult
|
4
|
|
juvenile
|
3
|
|
group 2
|
|
adult
|
6
|
|
juvenile
|
2
|
|
group 3
|
|
adult
|
4
|
|
juvenile
|
2
|
|
group 4
|
|
adult
|
2
|
|
juvenile
|
2
|
|
group 5
|
|
adult
|
3
|
|
juvenile
|
2
|
|
group 6
|
|
adult
|
6
|
|
juvenile
|
1
|
|
group 7
|
|
adult
|
7
|
|
juvenile
|
1
|
|
group 8
|
|
adult
|
2
|
|
juvenile
|
1
|
|
group 9
|
|
adult
|
4
|
|
juvenile
|
2
|
|
group 10
|
|
adult
|
6
|
|
juvenile
|
3
|
|
group 11
|
|
adult
|
2
|
|
juvenile
|
1
|
Progress so far
dyads <- lapply(unique(adult_ind$group_ID), function(i){
# print(i)
indvs <- adult_ind$transponder_ID[adult_ind$group_ID == i]
indvs <- unique(indvs[!is.na(indvs)])
combs <- combn(indvs, 2)
df1 <- data.frame(t(combs))
df2 <- df1[, 2:1]
names(df1) <- names(df2) <- c("fly", "leaf")
dfrep1 <- rbind(df1, df2)
dfrep1$replicate <- 2
dfrep1 <- dfrep1[sample(1:nrow(dfrep1)), ]
dfrep2 <- dfrep1
dfrep2$replicate <- 1
df <- rbind(dfrep2, dfrep1)
df$group <- i
# df <- df[, c(3, 1, 2)]
df$dyad <- paste(df$fly, df$leaf, sep = "-")
df$short_dyad <- paste(shorten_name(df$fly, 4), shorten_name(df$leaf, 4), sep = "-")
df$dyad.rep <- paste(df$dyad, df$replicate, sep = "-")
donegrp <- dyad_vocal_exp[dyad_vocal_exp$Group == i, ]
df$status <- ifelse(df$dyad.rep %in% donegrp$dyad.replicate, "done", "not done")
df <- df[order(df$status), ]
rownames(df) <- 1:nrow(df)
return(df)
# print(df3)
})
names(dyads) <- unique(adult_ind$group_ID)
dyad_prog <- do.call(rbind, dyads)
agg_prog <- aggregate(fly ~ replicate + group + status, data = dyad_prog, length)
agg_prog$labs <- as.character(agg_prog$fly)
agg_prog$group.lab <- paste("Group", agg_prog$group)
agg_prog$group.lab <- factor(agg_prog$group.lab, levels = paste("Group", sort(unique(agg_prog$group))))
agg_prog$replicate <- factor(agg_prog$replicate, levels = c("2", "1"))
ggplot(data=agg_prog, aes(x = replicate, y = fly, fill = status)) +
geom_bar(stat="identity")+
scale_fill_viridis_d(begin = 0.2, end = 0.8)+
coord_flip() +
facet_wrap(~ group.lab, ncol = 2) +
labs(y = "Number of experiments", x = "Replicate (1 or 2)") +
theme_classic(base_size = 30)
out <- lapply(unique(dyad_prog$group), function(x){
Y <- dyad_prog[dyad_prog$group == x, ]
done_by_rep <- as.data.frame.matrix(table(Y$replicate, Y$status))[, 1]
n_dyads <- length(unique(Y$dyad))
data.frame(group = x, replicate = 1:2, progress = paste(done_by_rep, "out of", n_dyads), experiments_left = ifelse(done_by_rep == n_dyads, "done", n_dyads - done_by_rep))
})
agg_prog <- do.call(rbind, out)
kb <- kbl(agg_prog, row.names = FALSE, align = "c")
kb <- column_spec(kb, which(names(agg_prog) == "experiments_left"), color = "black",
background = ifelse(agg_prog$experiments_left != "done", adjustcolor("white", alpha.f = 0), viridis(10, alpha = 0.4)[10]))
kb <- kable_styling(kb, bootstrap_options = c("striped", "hover", "condensed", "responsive"))
print(kb)
|
group
|
replicate
|
progress
|
experiments_left
|
|
8
|
1
|
2 out of 2
|
done
|
|
8
|
2
|
2 out of 2
|
done
|
|
9
|
1
|
10 out of 12
|
2
|
|
9
|
2
|
8 out of 12
|
4
|
|
10
|
1
|
20 out of 30
|
10
|
|
10
|
2
|
2 out of 30
|
28
|
|
6
|
1
|
22 out of 30
|
8
|
|
6
|
2
|
4 out of 30
|
26
|
|
4
|
1
|
1 out of 2
|
1
|
|
4
|
2
|
2 out of 2
|
done
|
|
7
|
1
|
22 out of 42
|
20
|
|
7
|
2
|
4 out of 42
|
38
|
|
3
|
1
|
11 out of 12
|
1
|
|
3
|
2
|
10 out of 12
|
2
|
|
1
|
1
|
9 out of 12
|
3
|
|
1
|
2
|
3 out of 12
|
9
|
|
5
|
1
|
5 out of 6
|
1
|
|
5
|
2
|
2 out of 6
|
4
|
|
2
|
1
|
16 out of 30
|
14
|
|
2
|
2
|
2 out of 30
|
28
|
|
11
|
1
|
2 out of 2
|
done
|
|
11
|
2
|
2 out of 2
|
done
|
- 60 experiments left for the first replicate
- 139 experiments left for the second replicate
Triangular matrices
- Flying individuals in columns and leaf individuals in rows
- Only the last 4 numbers are shown
for(i in unique(dyad_prog$group)) {
Y <- dyad_prog[dyad_prog$group == i , ]
possible_dyads <- unique(Y$dyad)
df <- data.frame(dyad = possible_dyads, id1 = sapply(strsplit(possible_dyads, "-"), "[[", 1), id2 = sapply(strsplit(possible_dyads, "-"), "[[", 2))
df$count <- sapply(possible_dyads, function(x) sum(Y$dyad == x & Y$status == "done"))
mat <- matrix(nrow = length(unique(Y$fly)), ncol = length(unique(Y$fly)))
mat[] <- NA
# colnames(mat) <- rownames(mat) <- unique(shorten_name(Y$fly, 4))
colnames(mat) <- rownames(mat) <- unique(Y$fly)
for(e in 1:ncol(mat)){
for(u in 1:nrow(mat))
if (u != e)
mat[u, e] <- df$count[df$id1 == colnames(mat)[u] & df$id2 == rownames(mat)[e]]
}
kb <- kbl(mat, row.names = TRUE, align = "c")
kb <- kable_styling(kb, bootstrap_options = c("striped", "hover", "condensed", "responsive"), )
print(paste("Group", i))
print(kb)
}
[1] “Group 8”
|
|
982126051278475
|
900200000279820
|
|
982126051278475
|
|
2
|
|
900200000279820
|
2
|
|
[1] “Group 9”
|
|
982126058484263
|
982126051278521
|
982126058484300
|
982126058484315
|
|
982126058484263
|
|
2
|
2
|
2
|
|
982126051278521
|
2
|
|
1
|
2
|
|
982126058484300
|
1
|
0
|
|
1
|
|
982126058484315
|
1
|
2
|
2
|
|
[1] “Group 10”
|
|
900200000206430
|
982126052945921
|
982126057845238
|
982200000206430
|
982126051278540
|
982126058484318
|
|
900200000206430
|
|
1
|
0
|
0
|
1
|
0
|
|
982126052945921
|
1
|
|
1
|
1
|
0
|
1
|
|
982126057845238
|
1
|
2
|
|
1
|
1
|
1
|
|
982200000206430
|
0
|
1
|
0
|
|
0
|
1
|
|
982126051278540
|
0
|
1
|
2
|
0
|
|
1
|
|
982126058484318
|
0
|
1
|
1
|
1
|
1
|
|
[1] “Group 6”
|
|
982126057845067
|
982126051278470
|
900200000279506
|
900200000279470
|
900200000279517
|
982126057845225
|
|
982126057845067
|
|
1
|
0
|
1
|
0
|
1
|
|
982126051278470
|
1
|
|
1
|
1
|
1
|
1
|
|
900200000279506
|
2
|
0
|
|
1
|
1
|
1
|
|
900200000279470
|
0
|
1
|
2
|
|
0
|
1
|
|
900200000279517
|
0
|
1
|
2
|
1
|
|
1
|
|
982126057845225
|
1
|
1
|
0
|
1
|
1
|
|
[1] “Group 4”
|
|
900200000279422
|
982126051278491
|
|
900200000279422
|
|
2
|
|
982126051278491
|
1
|
|
[1] “Group 7”
|
|
982000359237615
|
982126051278504
|
982126051278564
|
982126052945896
|
902126052945896
|
908126058484305
|
982126058484305
|
|
982000359237615
|
|
1
|
1
|
2
|
0
|
1
|
0
|
|
982126051278504
|
1
|
|
1
|
1
|
1
|
0
|
1
|
|
982126051278564
|
2
|
1
|
|
0
|
1
|
0
|
1
|
|
982126052945896
|
1
|
0
|
2
|
|
0
|
0
|
1
|
|
902126052945896
|
0
|
0
|
1
|
0
|
|
0
|
0
|
|
908126058484305
|
1
|
0
|
0
|
0
|
0
|
|
0
|
|
982126058484305
|
2
|
1
|
1
|
1
|
0
|
0
|
|
[1] “Group 3”
|
|
982126058484334
|
982126058484346
|
982126058484312
|
900200000279490
|
|
982126058484334
|
|
2
|
1
|
1
|
|
982126058484346
|
1
|
|
2
|
2
|
|
982126058484312
|
2
|
2
|
|
2
|
|
900200000279490
|
2
|
2
|
2
|
|
[1] “Group 1”
|
|
900200000279533
|
982126058484291
|
982126058484337
|
982126058484331
|
|
900200000279533
|
|
2
|
1
|
2
|
|
982126058484291
|
1
|
|
0
|
0
|
|
982126058484337
|
2
|
0
|
|
1
|
|
982126058484331
|
1
|
1
|
1
|
|
[1] “Group 5”
|
|
982126058484290
|
982126051278549
|
900200000279415
|
|
982126058484290
|
|
1
|
2
|
|
982126051278549
|
2
|
|
1
|
|
900200000279415
|
1
|
0
|
|
[1] “Group 2”
|
|
900200000206691
|
982126057845162
|
982126057845205
|
982126058484254
|
982126058484287
|
982126057845204
|
|
900200000206691
|
|
0
|
0
|
1
|
1
|
0
|
|
982126057845162
|
1
|
|
1
|
0
|
1
|
1
|
|
982126057845205
|
0
|
1
|
|
0
|
0
|
1
|
|
982126058484254
|
1
|
1
|
0
|
|
2
|
0
|
|
982126058484287
|
2
|
1
|
0
|
1
|
|
0
|
|
982126057845204
|
0
|
1
|
1
|
0
|
0
|
|
[1] “Group 11”
|
|
982126058484302
|
982126058484299
|
|
982126058484302
|
|
2
|
|
982126058484299
|
2
|
|
R session information
## R version 4.0.5 (2021-03-31)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.2 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] baRulho_1.0.5 warbleR_1.1.27 NatureSounds_1.0.4 seewave_2.1.6
## [5] tuneR_1.3.3 viridis_0.6.1 viridisLite_0.4.0 kableExtra_1.3.4
## [9] knitr_1.33 readxl_1.3.1 ggplot2_3.3.3 pbapply_1.4-3
##
## loaded via a namespace (and not attached):
## [1] Rcpp_1.0.6 svglite_2.0.0 fftw_1.0-6 assertthat_0.2.1
## [5] digest_0.6.27 utf8_1.2.1 R6_2.5.0 cellranger_1.1.0
## [9] signal_0.7-7 evaluate_0.14 httr_1.4.2 highr_0.9
## [13] pillar_1.6.1 rlang_0.4.11 rstudioapi_0.13 jquerylib_0.1.4
## [17] rmarkdown_2.8 labeling_0.4.2 webshot_0.5.2 stringr_1.4.0
## [21] RCurl_1.98-1.3 munsell_0.5.0 proxy_0.4-26 compiler_4.0.5
## [25] xfun_0.24 pkgconfig_2.0.3 systemfonts_1.0.2 htmltools_0.5.1.1
## [29] tidyselect_1.1.1 tibble_3.1.2 gridExtra_2.3 dtw_1.22-3
## [33] fansi_0.4.2 crayon_1.4.1 dplyr_1.0.6 withr_2.4.2
## [37] MASS_7.3-54 bitops_1.0-7 grid_4.0.5 jsonlite_1.7.2
## [41] gtable_0.3.0 lifecycle_1.0.0 DBI_1.1.1 magrittr_2.0.1
## [45] scales_1.1.1 stringi_1.6.2 farver_2.1.0 xml2_1.3.2
## [49] bslib_0.2.5.1 ellipsis_0.3.2 generics_0.1.0 vctrs_0.3.8
## [53] rjson_0.2.20 tools_4.0.5 glue_1.4.2 purrr_0.3.4
## [57] yaml_2.2.1 colorspace_2.0-1 rvest_1.0.0 sass_0.4.0