true
Objetive
- Curate and double check OH data
Load packages
## add 'developer/' to packages to install from github
x <- c(
"parallel",
"kableExtra",
"knitr",
"DT",
"viridis",
"ggplot2"
)
sketchy::load_packages(x)
opts_knit$set(root.dir = "..")
options(knitr.kable.NA = '')
print <- function(x) {
kb <- kable(x, row.names = FALSE, digits = 4, "html")
kb <- kable_styling(kb,
bootstrap_options = c("striped", "hover", "condensed", "responsive"))
scroll_box(kb, width = "100%")
}
theme_set(theme_classic())
options(
DT.options = list(
pageLength = 200,
scrollX = TRUE,
scrollY = "800px",
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel')
)
)
datatable2 <- function(x, ...) datatable(data = x, extensions = 'Buttons', height = 200, ...)Read data
# read bout 1
bout1_dat <- readRDS(
file.path(
"/home/m/Dropbox/Projects/rat_vocalization_alcohol/data/processed/",
"bout1_USV_counts_per_minute_and_detections.RDS"
)
)
# read bout 2
bout2_dat <- readRDS(
file.path(
"/home/m/Dropbox/Projects/rat_vocalization_alcohol/data/processed/",
"bout2_USV_counts_per_minute_and_detections.RDS"
)
)
# table(bout2_dat$wide_count_min$experiment)
# table(bout1_dat$wide_count_min$experiment)
obesidad_counts <- bout2_dat$wide_count_min[bout2_dat$wide_count_min$experiment == "Audios Obesidad 3", ]
oh_counts <- rbind(bout1_dat$wide_count_min, bout2_dat$wide_count_min[bout2_dat$wide_count_min$experiment != "Audios Obesidad 3", ])
oh_metadata <- rbind(bout1_dat$metadata, bout2_dat$metadata[grep("Obesidad 3", bout2_dat$metadata$original_dir, invert = TRUE), ])
# remove those shorter than 1 min
oh_counts <- oh_counts[oh_counts$sound.file.duration >= 60, ]
# table(oh_counts$experiment)Add metadata
Observations:
- bout 172 only has 2 cages
oh_counts$sound.file.duration.min <- round(oh_counts$sound.file.duration/ 60, 1)
oh_counts$date <- sapply(oh_counts$sound.files, function(x) {
# extract date
date <- strsplit(split = "202",
x = x,
fixed = TRUE)[[1]]
date <- ifelse(grepl("EXP2_OH", date[length(date)]), date[2], date[length(date)])
date <- paste0("202", substr(date, 1, 7))
date
})
# unique(oh_counts$date)
oh_counts$date <- as.Date(oh_counts$date)
oh_counts$time <- sapply(oh_counts$sound.files, function(x) {
# extract date
date <- strsplit(split = "202",
x = x,
fixed = TRUE)[[1]]
date <- ifelse(grepl("EXP2_OH", date[length(date)]), date[2], date[length(date)])
date <- substr(date, 9, 16)
date
})
# unique(oh_counts$time)
oh_counts <- oh_counts[order(oh_counts$date, oh_counts$time), ]
oh_counts$directory <- sapply(oh_counts$sound.files, function(x){
oh_metadata$original_dir[oh_metadata$new_name == x]
}
)
oh_counts$cage <- substr(oh_counts$sound.files, 1, 1)
oh_counts$cage[oh_counts$cage == "E"] <- NA
oh_counts$cage <- ifelse(oh_counts$cage == "2",substr(basename(oh_counts$directory),1, 1), oh_counts$cage)
oh_counts$cage <- ifelse(grepl("CT_PRUEBA",oh_counts$sound.files),substr(oh_counts$sound.files, 11, 11), oh_counts$cage)
# table(oh_counts$cage)
num_time <- as.numeric(gsub("-", "", oh_counts$time))
oh_counts$bout <- NA
oh_counts$bout[1] <- 1
for (i in 2:nrow(oh_counts)) {
if (!is.na(num_time[i])){
if (num_time[i] - num_time[i - 1] <= 41 & oh_counts$date[i] == oh_counts$date[i - 1]){
oh_counts$bout[i] <- oh_counts$bout[i - 1]
} else {
oh_counts$bout[i] <- oh_counts$bout[i - 1] + 1
}
} else{ oh_counts$bout[i] <- NA}
}
tab <- table(oh_counts$bout)
# all(tab == 4)
#
# which(tab < 4)
num_time <- as.numeric(gsub("-", "", oh_counts$time))
oh_counts$day.bout[1] <- NA
oh_counts$day.bout[1] <- 1
for (i in 2:nrow(oh_counts)) {
if (!is.na(oh_counts$date[i])){
if (oh_counts$date[i] != oh_counts$date[i - 1]) {
oh_counts$day.bout[i] <- 1
} else {
if (num_time[i] - num_time[i - 1] <= 41 & oh_counts$date[i] == oh_counts$date[i - 1]){
oh_counts$day.bout[i] <- oh_counts$day.bout[i - 1]
} else {
oh_counts$day.bout[i] <- oh_counts$day.bout[i - 1] + 1
}
}
} else{ oh_counts$day.bout[i] <- NA}
}
tab <- table(oh_counts$day.bout, oh_counts$date)
# all(tab <= 4)
oh_counts$period <- ifelse(oh_counts$sound.file.duration < 660, "pre", "post")
oh_counts$period <- ifelse(grepl("Día 0", oh_counts$day), "day 0", oh_counts$period)
# table(oh_counts$period)
min_cols <- paste("min", 1:30)
# order columns
oh_counts <- oh_counts[,c(
setdiff(names(oh_counts), min_cols),
min_cols
)]Graphs summarizing data
agg <- aggregate(total ~ period + day + experiment, data = oh_counts, length)
agg$day_num <- sapply(strsplit(x = gsub("Día ", "", agg$day), split = " ", fixed = TRUE), "[[", 1)
agg$day_num <- factor(agg$day_num, levels = sort(as.numeric(unique(agg$day_num))))
agg$period <- factor(agg$period, levels = c("day 0", "pre", "post"))
# bar graph colored by period
ggplot(agg, aes(x = day_num, y = total, fill = period)) +
geom_bar(stat = "identity", position = "dodge") +
labs(
title = "Total recordings per day",
x = "Day",
y = "Total USV counts"
) +
scale_fill_viridis_d(option = "G", alpha = 0.9) +
facet_wrap(~ experiment, ncol = 2)
agg <- aggregate(total ~ period + day + experiment, data = oh_counts, sum)
agg$day_num <- sapply(strsplit(x = gsub("Día ", "", agg$day), split = " ", fixed = TRUE), "[[", 1)
agg$day_num <- factor(agg$day_num, levels = sort(as.numeric(unique(agg$day_num))))
agg$period <- factor(agg$period, levels = c("day 0", "pre", "post"))
# bar graph colored by period
ggplot(agg, aes(x = day_num, y = total, fill = period)) +
geom_bar(stat = "identity", position = "dodge") +
labs(
title = "Total USV counts per day all minutes",
x = "Day",
y = "Total USV counts"
) +
scale_fill_viridis_d(option = "G", alpha = 0.9) +
facet_wrap(~ experiment, ncol = 2)
post_last15 <- oh_counts[oh_counts$period == "post", c("experiment", "day", paste("min", 15:30))]
post_last15$total <- rowSums(post_last15[, paste("min", 15:30)], na.rm = TRUE)
agg <- aggregate(total ~ day + experiment, data = post_last15, sum)
agg$day_num <- sapply(strsplit(x = gsub("Día ", "", agg$day), split = " ", fixed = TRUE), "[[", 1)
agg$day_num <- factor(agg$day_num, levels = sort(as.numeric(unique(agg$day_num))))
# bar graph colored by period
ggplot(agg, aes(x = day_num, y = total)) +
geom_bar(stat = "identity", position = "dodge", fill = "#54C9ADB3") +
labs(
title = "Total USV counts per day",
x = "Day",
y = "Total USV counts"
) +
facet_wrap(~ experiment, ncol = 2)
Data sets
All alcohol data in a single file:
Click to see data
By experiment
2020 OH3 M-SENS:
Click to see data
2022 OH4 M-INCUB:
Click to see data
2022 OH4 M-INCUB:
Click to see data
2022 OH5 H-SENS:
Click to see data
2023 OH6 H-INCUB:
Click to see data
Obesidad:
Click to see data
Session information
Click to see
## ─ Session info ───────────────────────────────────────────────────────────────
## setting value
## version R version 4.5.0 (2025-04-11)
## os Ubuntu 22.04.5 LTS
## system x86_64, linux-gnu
## ui X11
## language (EN)
## collate en_US.UTF-8
## ctype en_US.UTF-8
## tz America/Costa_Rica
## date 2025-11-13
## pandoc 3.2 @ /usr/lib/rstudio/resources/app/bin/quarto/bin/tools/x86_64/ (via rmarkdown)
## quarto 1.7.31 @ /usr/local/bin/quarto
##
## ─ Packages ───────────────────────────────────────────────────────────────────
## package * version date (UTC) lib source
## bslib 0.9.0 2025-01-30 [1] CRAN (R 4.5.0)
## cachem 1.1.0 2024-05-16 [1] CRAN (R 4.5.0)
## cli 3.6.5 2025-04-23 [1] CRAN (R 4.5.0)
## crayon 1.5.3 2024-06-20 [1] CRAN (R 4.5.0)
## crosstalk 1.2.1 2023-11-23 [3] CRAN (R 4.5.0)
## devtools 2.4.5 2022-10-11 [1] CRAN (R 4.5.0)
## digest 0.6.37 2024-08-19 [1] CRAN (R 4.5.0)
## dplyr 1.1.4 2023-11-17 [1] CRAN (R 4.5.0)
## DT * 0.33 2024-04-04 [3] CRAN (R 4.5.0)
## ellipsis 0.3.2 2021-04-29 [3] CRAN (R 4.1.1)
## evaluate 1.0.5 2025-08-27 [1] CRAN (R 4.5.0)
## farver 2.1.2 2024-05-13 [1] CRAN (R 4.5.0)
## fastmap 1.2.0 2024-05-15 [1] CRAN (R 4.5.0)
## fs 1.6.6 2025-04-12 [1] CRAN (R 4.5.0)
## generics 0.1.4 2025-05-09 [1] CRAN (R 4.5.0)
## ggplot2 * 4.0.0 2025-09-11 [1] CRAN (R 4.5.0)
## glue 1.8.0 2024-09-30 [1] CRAN (R 4.5.0)
## gridExtra 2.3 2017-09-09 [1] CRAN (R 4.5.0)
## gtable 0.3.6 2024-10-25 [1] CRAN (R 4.5.0)
## htmltools 0.5.8.1 2024-04-04 [1] CRAN (R 4.5.0)
## htmlwidgets 1.6.4 2023-12-06 [1] RSPM (R 4.5.0)
## httpuv 1.6.16 2025-04-16 [1] RSPM (R 4.5.0)
## jquerylib 0.1.4 2021-04-26 [1] CRAN (R 4.5.0)
## jsonlite 2.0.0 2025-03-27 [1] CRAN (R 4.5.0)
## kableExtra * 1.4.0 2024-01-24 [1] CRAN (R 4.5.0)
## knitr * 1.50 2025-03-16 [1] CRAN (R 4.5.0)
## labeling 0.4.3 2023-08-29 [1] CRAN (R 4.5.0)
## later 1.4.2 2025-04-08 [1] RSPM (R 4.5.0)
## lifecycle 1.0.4 2023-11-07 [1] CRAN (R 4.5.0)
## magrittr 2.0.4 2025-09-12 [1] CRAN (R 4.5.0)
## memoise 2.0.1 2021-11-26 [1] CRAN (R 4.5.0)
## mime 0.13 2025-03-17 [1] CRAN (R 4.5.0)
## miniUI 0.1.2 2025-04-17 [3] CRAN (R 4.5.0)
## packrat 0.7.0 2021-08-20 [3] CRAN (R 4.1.1)
## pillar 1.11.1 2025-09-17 [1] CRAN (R 4.5.0)
## pkgbuild 1.4.8 2025-05-26 [1] CRAN (R 4.5.0)
## pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 4.5.0)
## pkgload 1.4.1 2025-09-23 [1] CRAN (R 4.5.0)
## profvis 0.4.0 2024-09-20 [1] CRAN (R 4.5.0)
## promises 1.3.3 2025-05-29 [1] RSPM (R 4.5.0)
## purrr 1.2.0 2025-11-04 [1] CRAN (R 4.5.0)
## R6 2.6.1 2025-02-15 [1] CRAN (R 4.5.0)
## RColorBrewer 1.1-3 2022-04-03 [1] CRAN (R 4.5.0)
## Rcpp 1.1.0 2025-07-02 [1] CRAN (R 4.5.0)
## remotes 2.5.0 2024-03-17 [1] CRAN (R 4.5.0)
## rlang 1.1.6 2025-04-11 [1] CRAN (R 4.5.0)
## rmarkdown 2.30 2025-09-28 [1] CRAN (R 4.5.0)
## rstudioapi 0.17.1 2024-10-22 [1] CRAN (R 4.5.0)
## S7 0.2.0 2024-11-07 [1] CRAN (R 4.5.0)
## sass 0.4.10 2025-04-11 [1] CRAN (R 4.5.0)
## scales 1.4.0 2025-04-24 [1] CRAN (R 4.5.0)
## sessioninfo 1.2.3 2025-02-05 [3] CRAN (R 4.5.0)
## shiny 1.10.0 2024-12-14 [1] CRAN (R 4.5.0)
## sketchy 1.0.5 2025-08-20 [1] CRANs (R 4.5.0)
## stringi 1.8.7 2025-03-27 [1] CRAN (R 4.5.0)
## stringr 1.6.0 2025-11-04 [1] CRAN (R 4.5.0)
## svglite 2.2.2 2025-10-21 [1] CRAN (R 4.5.0)
## systemfonts 1.3.1 2025-10-01 [1] CRAN (R 4.5.0)
## textshaping 1.0.4 2025-10-10 [1] CRAN (R 4.5.0)
## tibble 3.3.0 2025-06-08 [1] RSPM (R 4.5.0)
## tidyselect 1.2.1 2024-03-11 [1] CRAN (R 4.5.0)
## urlchecker 1.0.1 2021-11-30 [1] CRAN (R 4.5.0)
## usethis 3.1.0 2024-11-26 [3] CRAN (R 4.5.0)
## vctrs 0.6.5 2023-12-01 [1] CRAN (R 4.5.0)
## viridis * 0.6.5 2024-01-29 [1] CRAN (R 4.5.0)
## viridisLite * 0.4.2 2023-05-02 [1] CRAN (R 4.5.0)
## withr 3.0.2 2024-10-28 [1] CRAN (R 4.5.0)
## xaringanExtra 0.8.0 2024-05-19 [1] CRAN (R 4.5.0)
## xfun 0.54 2025-10-30 [1] CRAN (R 4.5.0)
## xml2 1.4.1 2025-10-27 [1] CRAN (R 4.5.0)
## xtable 1.8-4 2019-04-21 [3] CRAN (R 4.0.1)
## yaml 2.3.10 2024-07-26 [1] CRAN (R 4.5.0)
##
## [1] /home/m/R/x86_64-pc-linux-gnu-library/4.5
## [2] /usr/local/lib/R/site-library
## [3] /usr/lib/R/site-library
## [4] /usr/lib/R/library
## * ── Packages attached to the search path.
##
## ──────────────────────────────────────────────────────────────────────────────