sels <- read.csv("./data/processed/split_manual_annotations_5min_bedding.csv", stringsAsFactors = FALSE)
sels_22 <- sels[sels$peak.freq > 20 & sels$peak.freq < 30, ]
table(sels_22$sound.files)
sels_22 <- sels[sels$sound.files == "TH-09.wav", ]
oed <- optimize_energy_detector(reference = sels_22, threshold = c(0.008, 0.01), min.duration = c(0.001, 0.005, 0.01, 0.02, 0.03), ssmooth = c(10), hold.time = c(0.005, 0.01, 0.025), path = .Options$warbleR$path, thinning = 0.5, parallel = 15, bp = c(20, 30), max.duration = c(1, 1.5, 2, 3), previous.output = oed)
# View(optim_ad[optim_ad$sensitivity == 1 & optim_ad$specificity == 1, ])
saveRDS(oed, "./data/processed/optimization_22kHz_with_bedding.RDS")optim_ad <- readRDS("./data/processed/optimization_22kHz.RDS")
# print dynamic table
oa_DT <- datatable(optim_ad, editable = list(
target = 'row'
), rownames = FALSE, style = "bootstrap", filter = 'top', options = list(
pageLength = 100, autoWidth = TRUE, dom = 'ft'
), autoHideNavigation = TRUE, escape = FALSE)
formatRound(table = oa_DT, columns = sapply(optim_ad, is.numeric), 3)sels <- read.csv("./data/processed/split_manual_annotations_5min_bedding.csv")
sels_22 <- sels[sels$peak.freq > 20 & sels$peak.freq < 30, ]
tab <- table(sels_22$sound.files)
sels_22 <- sels_22[sels_22$sound.files %in% names(tab)[sort(tab,decreasing = TRUE)][1:4], ]
# best tuning parameters
oed4 <- optimize_energy_detector(reference = sels_22, threshold = c(0.008, 0.01), min.duration = c(0.001, 0.005, 0.01, 0.02, 0.03), ssmooth = c(10), hold.time = c(0.005, 0.01, 0.025), path = .Options$warbleR$path, thinning = 0.5, parallel = 2, bp = c(20, 30), max.duration = c(1, 1.5, 2, 3))
saveRDS(oed4, "./data/processed/optimization_22kHz_4_cuts_with_bedding.RDS")optim_ad <- readRDS("./data/processed/optimization_22kHz_4_cuts_with_bedding.RDS")
# optim_ad <- optim_ad[optim_ad$sound.files == "T0000011-1.wav", ]
optim_ad <- summarize_diagnostic(optim_ad,time.diagnostics = TRUE)
oa_DT <- datatable(optim_ad, editable = list(
target = 'row'
), rownames = FALSE, style = "bootstrap", filter = 'top', options = list(
pageLength = 100, autoWidth = TRUE, dom = 'ft'
), autoHideNavigation = TRUE, escape = FALSE)
formatRound(table = oa_DT, columns = sapply(optim_ad, is.numeric), 3)sels <- read.csv("./data/processed/split_manual_annotations_5min_bedding.csv")
sels_22 <- sels[sels$peak.freq > 20 & sels$peak.freq < 30, ]
tab <- table(sels_22$sound.files)
sels_22 <- sels_22[sels_22$sound.files %in% names(tab)[sort(tab,decreasing = TRUE)][1:4], ]
# best tuning parameters
ed4 <- energy_detector(files = unique(sels_22$sound.files), threshold = 0.008, min.duration = 0.01, ssmooth = 10, hold.time = 0.025, path = .Options$warbleR$path, thinning = 0.5, parallel = 1, bp = c(20, 30), max.duration = 1)
# fed4
saveRDS(ed4, "./data/processed/optimal_detection_22kHz_4_cuts_with_bedding.RDS")ed4 <- readRDS("./data/processed/optimal_detection_22kHz_4_cuts.RDS")
sels <- read.csv("./data/processed/split_manual_annotations_5min_no_bedding.csv")
sels_22 <- sels[sels$peak.freq > 20 & sels$peak.freq < 30, ]
tab <- table(sels_22$sound.files)
sels_22 <- sels_22[sels_22$sound.files %in% names(tab)[tab > 20], ]
led4 <- label_detection(reference = sels_22, detection = ed4, parallel = 10, pb = FALSE)
led4 <- filter_detection(detection = led4, parallel = 10, pb = FALSE)
attributes(ed4)$call## energy_detector(files = unique(sels_22$sound.files), path = .Options$warbleR$path,
## thinning = 0.5, bp = c(20, 30), ssmooth = 17, threshold = 0.02,
## hold.time = 0.025, min.duration = 0.002, max.duration = 3,
## parallel = 8)optim_ad_bs <- diagnose_detection(reference = sels_22, detection = led4, by.sound.file = TRUE)
oa_DT <- datatable(optim_ad_bs, editable = list(
target = 'row'
), rownames = FALSE, style = "bootstrap", filter = 'top', options = list(
pageLength = 100, autoWidth = TRUE, dom = 'ft'
), autoHideNavigation = TRUE, escape = FALSE)
formatRound(table = oa_DT, columns = sapply(optim_ad_bs, is.numeric), 3)optim_ad <- diagnose_detection(reference = sels_22, detection = led4)
oa_DT <- datatable(optim_ad, editable = list(
target = 'row'
), rownames = FALSE, style = "bootstrap", filter = 'top', options = list(
pageLength = 100, autoWidth = TRUE, dom = 'ft'
), autoHideNavigation = TRUE, escape = FALSE)
formatRound(table = oa_DT, columns = sapply(optim_ad, is.numeric), 3)sels <- read.csv("./data/processed/split_manual_annotations_5min_bedding.csv")
sels_22 <- sels[sels$peak.freq > 20 & sels$peak.freq < 30, ]
# best tuning parameters
oed_all <- optimize_energy_detector(reference = sels_22, files = unique(sels_22$sound.files), threshold = c(0.008, 0.01), min.duration = c(0.001, 0.005, 0.01, 0.02, 0.03), ssmooth = c(10), hold.time = c(0.005, 0.01, 0.025), path = .Options$warbleR$path, thinning = 0.5, parallel = 1, bp = c(20, 30), max.duration = c(1, 1.5, 2, 3))
saveRDS(oed_all, "./data/processed/optimization_22kHz_all_cuts_with_bedding.RDS")oed_all <- readRDS("./data/processed/optimization_22kHz_all_cuts_with_bedding.RDS")
oa_DT <- datatable(oed_all, editable = list(
target = 'row'
), rownames = FALSE, style = "bootstrap", filter = 'top', options = list(
pageLength = 100, autoWidth = TRUE, dom = 'ft'
), autoHideNavigation = TRUE, escape = FALSE)
formatRound(table = oa_DT, columns = sapply(oed_all, is.numeric), 3)sels <- read.csv("./data/processed/split_manual_annotations_5min_bedding.csv")
# best tuning parameters
ed_all <- energy_detector(files = unique(sels$sound.files), threshold = 0.01, min.duration = 0.01, ssmooth = 10, hold.time = 0.005, path = .Options$warbleR$path, thinning = 0.5, parallel = 1, bp = c(20, 30), max.duration = 3)
saveRDS(ed_all, "./data/processed/optimal_detection_22kHz_all_cuts_with_bedding.RDS")ed_all <- readRDS("./data/processed/optimal_detection_22kHz_all_cuts_with_bedding.RDS")
sels <- read.csv("./data/processed/split_manual_annotations_5min_bedding.csv")
sels_22 <- sels[sels$peak.freq > 20 & sels$peak.freq < 30, ]
label_ed_all <- label_detection(reference = sels_22, detection = ed_all, parallel = 10, pb = FALSE)
filter_ed_all <- filter_detection(label_ed_all, parallel = 10, pb = FALSE)
optim_ad_bs_all <- diagnose_detection(reference = sels_22, detection = filter_ed_all, by.sound.file = TRUE, pb = FALSE)
attributes(ed_all)$call## energy_detector(files = unique(sels$sound.files), path = .Options$warbleR$path,
## thinning = 0.5, bp = c(20, 30), ssmooth = 10, threshold = 0.01,
## hold.time = 0.005, min.duration = 0.01, max.duration = 3,
## parallel = 1)oa_DT <- datatable(optim_ad_bs_all, editable = list(
target = 'row'
), rownames = FALSE, style = "bootstrap", filter = 'top', options = list(
pageLength = 100, autoWidth = TRUE, dom = 'ft'
), autoHideNavigation = TRUE, escape = FALSE)
formatRound(table = oa_DT, columns = sapply(optim_ad_bs, is.numeric), 3)optim_ad_all <- diagnose_detection(reference = sels_22, detection = ed_all, pb = FALSE)
oa_DT <- datatable(optim_ad_all, editable = list(
target = 'row'
), rownames = FALSE, style = "bootstrap", filter = 'top', options = list(
pageLength = 100, autoWidth = TRUE, dom = 'ft'
), autoHideNavigation = TRUE, escape = FALSE)
formatRound(table = oa_DT, columns = sapply(optim_ad, is.numeric), 3)ed_all <- readRDS("./data/processed/optimal_detection_22kHz_all_cuts_with_bedding.RDS")
ed_all <- label_detection(reference = sels_22, detection = ed_all, parallel = 10, pb = FALSE)
ed_all <- filter_detection(ed_all, parallel = 10, pb = FALSE)
# measure spectrographic parameters
spectral_parameters <- spectro_analysis(ed_all, bp = c(20, 30), fast = TRUE, ovlp = 70, parallel = 10)
spectral_parameters$class <- ed_all$detection.class
spectral_parameters$class[spectral_parameters$class != "false.positive"] <- "true.positive"
# make it a factor for ranger to work
spectral_parameters$class <- as.factor(spectral_parameters$class)
# run RF model spectral and cepstral parameters
rfm <-
ranger(
class ~ .,
data = spectral_parameters[, !names(spectral_parameters) %in% c("sound.files", "selec")],
num.trees = 10000,
importance = "impurity",
seed = 10
)
# balanced random forest
# run RF model spectral and cepstral parameters
brfm <-
ranger(
class ~ .,
data = spectral_parameters[, !names(spectral_parameters) %in% c("sound.files", "selec")],
case.weights = ifelse(spectral_parameters$class == "true.positive", 1842, 1),
num.trees = 10000,
importance = "impurity",
seed = 10
)
saveRDS(list(rfm = rfm, brfm = brfm, detection = ed_all), "./data/processed/data_and_model_random_forest_22kHz_cuts_with_bedding.RDS") attach(readRDS("./data/processed/data_and_model_random_forest_22kHz_cuts_with_bedding.RDS"))
brfm## Ranger result
##
## Call:
## ranger(class ~ ., data = spectral_parameters[, !names(spectral_parameters) %in% c("sound.files", "selec")], case.weights = ifelse(spectral_parameters$class == "true.positive", 1842, 1), num.trees = 10000, importance = "impurity", seed = 10)
##
## Type: Classification
## Number of trees: 10000
## Sample size: 61555
## Number of independent variables: 26
## Mtry: 5
## Target node size: 1
## Variable importance mode: impurity
## Splitrule: gini
## OOB prediction error: 0.07 %# Final results
# Diagnostic after random forest classification:
# table(lab_detec$detection.class)
detection$pred.class <- as.character(brfm$predictions)
positive_detec <- detection[detection$pred.class == "true.positive", ]
temp_detec <- positive_detec
temp_detec$detection.class <- "true.positive"
sels <- read.csv("./data/processed/split_manual_annotations_5min_bedding.csv")
sels_22 <- sels[sels$peak.freq > 20 & sels$peak.freq < 30, ]
diag <- diagnose_detection(reference = sels_22, detection = temp_detec, pb = FALSE)
# print dynamic table
oa_DT <- datatable(diag, editable = list(
target = 'row'
), rownames = FALSE, style = "bootstrap", filter = 'top', options = list(
pageLength = 100, autoWidth = TRUE, dom = 'ft'
), autoHideNavigation = TRUE, escape = FALSE)
formatRound(table = oa_DT, columns = sapply(diag, is.numeric), 3) # Black line = 1:1
# gray line = model slope
obs_count <- tapply(sels_22$sound.files, sels_22$sound.files, length)
pred_count <- tapply(positive_detec$sound.files, positive_detec$sound.files, length)
sound_files <- unique(sels$sound.files)
# add those missing in predicted
names_pred_0 <- setdiff(c(names(obs_count),sound_files), names(pred_count))
pred_0 <- rep(0, length(names_pred_0))
names(pred_0) <- names_pred_0
pred_count <- c(pred_count, pred_0)
# add those missing in observed
names_obs_0 <- setdiff(c(names(pred_count), sound_files), names(obs_count))
obs_0 <- rep(0, length(names_obs_0))
names(obs_0) <- names_obs_0
obs_count <- c(obs_count, obs_0)
# order by name
pred_count <- pred_count[order(names(pred_count))]
obs_count <- obs_count[order(names(obs_count))]
# put both in a single data frame
df <- data.frame(sound.files = names(obs_count), observed = obs_count, predicted = pred_count)
# plot
ggplot(df, aes(x = observed, y = predicted)) +
geom_point(color = viridis(10, alpha = 0.4)[2], size = 3) +
geom_abline(slope = 1, intercept = 0) +
annotate("text", x = 50, y = 150, label = paste("r =", round(cor(obs_count, pred_count), 3)), size = 8) +
geom_smooth(method = "lm", se = FALSE, col = "gray") +
theme_classic(base_size = 20)
# print best fit lm model
(lm(pred_count ~ obs_count))# split
split_obs <- split_sound_files(path = .Options$warbleR$path, X = sels_22, only.sels = TRUE, sgmt.dur = 60, pb = FALSE, parallel = 10)
split_pred <- split_sound_files(path = .Options$warbleR$path, X = as.data.frame(positive_detec), only.sels = TRUE, sgmt.dur = 60, pb = FALSE, parallel = 10)
obs_count <- tapply(split_obs$sound.files, split_obs$sound.files, length)
pred_count <- tapply(split_pred$sound.files, split_pred$sound.files, length)
sound_files <- unique(sels$sound.files)
# add those missing in predicted
names_pred_0 <- setdiff(c(names(obs_count),sound_files), names(pred_count))
pred_0 <- rep(0, length(names_pred_0))
names(pred_0) <- names_pred_0
pred_count <- c(pred_count, pred_0)
# add those missing in observed
names_obs_0 <- setdiff(c(names(pred_count), sound_files), names(obs_count))
obs_0 <- rep(0, length(names_obs_0))
names(obs_0) <- names_obs_0
obs_count <- c(obs_count, obs_0)
# order by name
pred_count <- pred_count[order(names(pred_count))]
obs_count <- obs_count[order(names(obs_count))]
# put both in a single data frame
df <- data.frame(sound.files = names(obs_count), observed = obs_count, predicted = pred_count)
df$sum <- df$observed + df$predicted
# plot
ggplot(df[df$sum > 0, ], aes(x = observed, y = predicted)) +
geom_point(color = viridis(10, alpha = 0.4)[2], size = 3) +
geom_abline(slope = 1, intercept = 0) +
annotate("text", x = 20, y = 50, label = paste("r =", round(cor(obs_count, pred_count), 3)), size = 8) +
geom_smooth(method = "lm", se = FALSE, col = "gray") +
theme_classic(base_size = 20)
# print best fit lm model
(lm(pred_count ~ obs_count))Session information
## R version 4.1.0 (2021-05-18)
## 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/atlas/libblas.so.3.10.3
## LAPACK: /usr/lib/x86_64-linux-gnu/atlas/liblapack.so.3.10.3
##
## 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] ggplot2_3.3.5 ohun_0.1.0 DT_0.18 kableExtra_1.3.4
## [5] ranger_0.13.1 readxl_1.3.1 svMisc_1.1.4 rfigshare_0.3.7
## [9] viridis_0.6.1 viridisLite_0.4.0 Rraven_1.0.13 pbapply_1.4-3
## [13] bioacoustics_0.2.5 warbleR_1.1.27 NatureSounds_1.0.4 knitr_1.33
## [17] seewave_2.1.8 tuneR_1.3.3.1 devtools_2.4.2 usethis_2.0.1
##
## loaded via a namespace (and not attached):
## [1] bitops_1.0-7 fs_1.5.0 webshot_0.5.2 httr_1.4.2
## [5] rprojroot_2.0.2 tools_4.1.0 bslib_0.2.5.1 utf8_1.2.1
## [9] R6_2.5.0 DBI_1.1.1 colorspace_2.0-2 withr_2.4.2
## [13] tidyselect_1.1.1 gridExtra_2.3 prettyunits_1.1.1 processx_3.5.2
## [17] moments_0.14 compiler_4.1.0 rvest_1.0.1 cli_3.0.1
## [21] xml2_1.3.2 desc_1.3.0 sass_0.4.0 scales_1.1.1
## [25] callr_3.7.0 proxy_0.4-26 dtw_1.22-3 systemfonts_1.0.2
## [29] stringr_1.4.0 digest_0.6.27 svglite_2.0.0 rmarkdown_2.10
## [33] pkgconfig_2.0.3 htmltools_0.5.2 sessioninfo_1.1.1 fastmap_1.1.0
## [37] htmlwidgets_1.5.3 rlang_0.4.11 rstudioapi_0.13 jquerylib_0.1.4
## [41] generics_0.1.0 jsonlite_1.7.2 crosstalk_1.1.1 dplyr_1.0.7
## [45] RCurl_1.98-1.4 magrittr_2.0.1 Matrix_1.3-4 Rcpp_1.0.7
## [49] munsell_0.5.0 fansi_0.5.0 lifecycle_1.0.0 stringi_1.7.4
## [53] yaml_2.2.1 MASS_7.3-54 RJSONIO_1.3-1.4 pkgbuild_1.2.0
## [57] plyr_1.8.6 grid_4.1.0 promises_1.2.0.1 crayon_1.4.1
## [61] lattice_0.20-44 ps_1.6.0 pillar_1.6.1 rjson_0.2.20
## [65] fftw_1.0-6 pkgload_1.2.1 XML_3.99-0.6 glue_1.4.2
## [69] evaluate_0.14 remotes_2.4.0 vctrs_0.3.8 httpuv_1.6.1
## [73] testthat_3.0.4 cellranger_1.1.0 gtable_0.3.0 purrr_0.3.4
## [77] assertthat_0.2.1 cachem_1.0.5 xfun_0.25 later_1.2.0
## [81] signal_0.7-7 tibble_3.1.2 memoise_2.0.0 ellipsis_0.3.2