Purpose

Explore SIGPRO output
Compare measurements between SIGPRO and baRulho

Report overview

Compare SIGPRO and baRulho
- Takeaways

Explore SIGPRO data

Clips: measurements on cuts right at the start of the re-recorded sounds. More precise.
Full recordings: measurements taken on the original re-recored files, so start of sounds was foud manually. Less precise. This is the default method when using SIGPRO.

# sigpro_data <-
# as.data.frame(read_excel('./data/raw/sigpro_measurements_V02.xlsx'))
sigpro_data <- as.data.frame(read_excel("./data/raw/sigpro_measurements.xlsx"))

sigpro_data$SNR <- as.numeric(sigpro_data$SNR)
sigpro_data$TSR <- as.numeric(sigpro_data$TSR)

# exclude measurements on the first round for clips (did not
# include TSR)
sigpro_data <- sigpro_data[sigpro_data$format != "Clips 1st round",
    ]

names(sigpro_data)[names(sigpro_data) %in% c("Blur ratio (E-blur)",
    "E-Match k")] <- c("blur_ratio", "k")

# fix outliers
sigpro_data$blur_ratio[sigpro_data$blur_ratio > 20] <- NA

sigpro_data$k[sigpro_data$k > 20] <- NA

# fix labels
sigpro_data$format <- ifelse(sigpro_data$format == "Completo", "Full recording",
    "Clips")


# excess attenuation no extra dB adding chirras
sigpro_data$excess_attenuation <- (-20 * log(sigpro_data$k)) - (6/(2 *
    (sigpro_data$distance - 1)))

# Darden sigpro_data$excess_attenuation <- (-20 *
# log(sigpro_data$k)) - (20 * log(sigpro_data$distance / 10))


# Maad att_geo_fac <- 1 / 20 -20*log10(att_geo_fac)
# sigpro_data$excess_attenuation.maad <- (-20 *
# log10(sigpro_data$k)) - (20 * log10(1 / sigpro_data$distance))
# sigpro_data$excess_attenuation.luis <- (-20 *
# log(sigpro_data$k)) - (6 / (2 * (sigpro_data$distance - 1)))

sigpro_data$excess_attenuation[is.infinite(sigpro_data$excess_attenuation) |
    is.nan(sigpro_data$excess_attenuation)] <- NA
# sigpro_data$excess_attenuation.luis[is.infinite(sigpro_data$excess_attenuation.luis)]
# <- NA

degrad_params <- c("SNR", "TSR", "blur_ratio", "k", "excess_attenuation")

Compare SIGPRO and baRulho

Re-measuring transmission parameters:

Dotted lines show x = y

comb_data_cols <- read.csv("./data/processed/combined_sigpro_barulho.csv")

for (i in c("TSR", "SNR", "blur_ratio", "excess_attenuation")) {

    cat("<br>")
    cat(i)
    cat("<br>")
    # print(paste('Pearson correlation clips:',
    # round(cor(comb_data_cols[comb_data_cols$format == 'Clips',
    # i], comb_data_cols[comb_data_cols$format == 'Clips',
    # paste(i, 'bRlho', sep = '-')], use =
    # 'pairwise.complete.obs'), 2)))

    # clips
    x <- comb_data_cols[comb_data_cols$format == "Clips", i]
    y <- comb_data_cols[comb_data_cols$format == "Clips", paste(i,
        "bRlho", sep = ".")]

    cr.clps <- cor.test(x, y, use = "pairwise.complete.obs")
    p <- round(cr.clps$p.value, 3)
    if (p < 0.001)
        p <- "p < 0.001"
    print(paste("Pearson correlation clips: r=", round(cr.clps$estimate,
        2), "; p =", p))

    cat("<br>")

    # complete recordings
    x <- comb_data_cols[comb_data_cols$format == "Full recording",
        i]
    y <- comb_data_cols[comb_data_cols$format == "Full recording",
        paste(i, "bRlho", sep = ".")]

    cr.fr <- cor.test(x, y, use = "pairwise.complete.obs")
    p <- round(cr.fr$p.value, 3)
    if (p < 0.001)
        p <- "p < 0.001"
    print(paste("Pearson correlation full recordings: r=", round(cr.fr$estimate,
        2), "; p =", p))

    xy_ranges <- range(c(comb_data_cols[, i], comb_data_cols[, paste(i,
        "bRlho", sep = ".")]), na.rm = TRUE)

    plt <- ggplot(comb_data_cols, aes(x = get(i), y = get(paste(i,
        "bRlho", sep = ".")))) + geom_point(color = viridis(10, alpha = 0.7)[7]) +
        xlim(xy_ranges) + ylim(xy_ranges) + labs(x = paste(i, "SIGPRO"),
        y = paste(i, "baRulho")) + facet_wrap(~format, scales = "free_x") +
        geom_abline(slope = 1, intercept = 0, lty = 3) + theme_classic()

    cat("<br>")

    print(plt)
}

TSR
[1] “Pearson correlation clips: r= 0.8 ; p = p < 0.001”
[1] “Pearson correlation full recordings: r= 0.61 ; p = p < 0.001”

SNR
[1] “Pearson correlation clips: r= 0.94 ; p = p < 0.001”
[1] “Pearson correlation full recordings: r= 0.79 ; p = p < 0.001”

blur_ratio
[1] “Pearson correlation clips: r= 0.8 ; p = p < 0.001”
[1] “Pearson correlation full recordings: r= 0.5 ; p = p < 0.001”

excess_attenuation
[1] “Pearson correlation clips: r= 0.97 ; p = p < 0.001”
[1] “Pearson correlation full recordings: r= 0.75 ; p = p < 0.001”

Removing 100 m test data

comb_data_cols <- read.csv("./data/processed/combined_sigpro_barulho.csv")
comb_data_cols <- comb_data_cols[comb_data_cols$distance != 100, ]
for (i in c("TSR", "SNR", "blur_ratio", "excess_attenuation")) {

    cat("<br>")
    cat(i)
    cat("<br>")
    # print(paste('Pearson correlation clips:',
    # round(cor(comb_data_cols[comb_data_cols$format == 'Clips',
    # i], comb_data_cols[comb_data_cols$format == 'Clips',
    # paste(i, 'bRlho', sep = '-')], use =
    # 'pairwise.complete.obs'), 2)))

    # clips
    x <- comb_data_cols[comb_data_cols$format == "Clips", i]
    y <- comb_data_cols[comb_data_cols$format == "Clips", paste(i,
        "bRlho", sep = ".")]

    cr.clps <- cor.test(x, y, use = "pairwise.complete.obs")
    p <- round(cr.clps$p.value, 3)
    if (p < 0.001)
        p <- "p < 0.001"
    print(paste("Pearson correlation clips: r=", round(cr.clps$estimate,
        2), "; p =", p))

    cat("<br>")

    # complete recordings
    x <- comb_data_cols[comb_data_cols$format == "Full recording",
        i]
    y <- comb_data_cols[comb_data_cols$format == "Full recording",
        paste(i, "bRlho", sep = ".")]

    cr.fr <- cor.test(x, y, use = "pairwise.complete.obs")
    p <- round(cr.fr$p.value, 3)
    if (p < 0.001)
        p <- "p < 0.001"
    print(paste("Pearson correlation full recordings: r=", round(cr.fr$estimate,
        2), "; p =", p))

    xy_ranges <- range(c(comb_data_cols[, i], comb_data_cols[, paste(i,
        "bRlho", sep = ".")]), na.rm = TRUE)

    plt <- ggplot(comb_data_cols, aes(x = get(i), y = get(paste(i,
        "bRlho", sep = ".")))) + geom_point(color = viridis(10, alpha = 0.7)[7]) +
        xlim(xy_ranges) + ylim(xy_ranges) + labs(x = paste(i, "SIGPRO"),
        y = paste(i, "baRulho")) + facet_wrap(~format, scales = "free_x") +
        geom_abline(slope = 1, intercept = 0, lty = 3) + theme_classic()

    cat("<br>")

    print(plt)
}

TSR
[1] “Pearson correlation clips: r= 0.81 ; p = p < 0.001”
[1] “Pearson correlation full recordings: r= 0.59 ; p = p < 0.001”

SNR
[1] “Pearson correlation clips: r= 0.95 ; p = p < 0.001”
[1] “Pearson correlation full recordings: r= 0.85 ; p = p < 0.001”

blur_ratio
[1] “Pearson correlation clips: r= 0.84 ; p = p < 0.001”
[1] “Pearson correlation full recordings: r= 0.42 ; p = 0.001”

excess_attenuation
[1] “Pearson correlation clips: r= 0.98 ; p = p < 0.001”
[1] “Pearson correlation full recordings: r= 0.74 ; p = p < 0.001”

Takeaways

Similar results between SIGPRO and baRulho

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] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] irr_0.84.1         lpSolve_5.6.15     baRulho_1.0.7      warbleR_1.1.27    
##  [5] NatureSounds_1.0.4 seewave_2.2.0      tuneR_1.4.0        corrplot_0.92     
##  [9] viridis_0.6.2      viridisLite_0.4.1  ggplot2_3.3.6      readxl_1.4.0      
## [13] rprojroot_2.0.3    formatR_1.12       knitr_1.40         kableExtra_1.3.4  
## [17] klippy_0.0.0.9500 
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.9        svglite_2.1.0     fftw_1.0-7        assertthat_0.2.1 
##  [5] digest_0.6.29     utf8_1.2.2        R6_2.5.1          cellranger_1.1.0 
##  [9] signal_0.7-7      evaluate_0.16     highr_0.9         httr_1.4.3       
## [13] pillar_1.8.1      rlang_1.0.4       rstudioapi_0.13   jquerylib_0.1.4  
## [17] rmarkdown_2.14    labeling_0.4.2    webshot_0.5.3     stringr_1.4.1    
## [21] RCurl_1.98-1.8    munsell_0.5.0     proxy_0.4-27      compiler_4.1.0   
## [25] xfun_0.32         pkgconfig_2.0.3   systemfonts_1.0.4 htmltools_0.5.3  
## [29] tidyselect_1.1.2  tibble_3.1.8      gridExtra_2.3     dtw_1.22-3       
## [33] fansi_1.0.3       dplyr_1.0.9       withr_2.5.0       MASS_7.3-54      
## [37] bitops_1.0-7      grid_4.1.0        jsonlite_1.8.0    gtable_0.3.0     
## [41] lifecycle_1.0.1   DBI_1.1.1         magrittr_2.0.3    scales_1.2.1     
## [45] cli_3.3.0         stringi_1.7.8     pbapply_1.5-0     farver_2.1.1     
## [49] xml2_1.3.3        bslib_0.3.1       generics_0.1.3    vctrs_0.4.1      
## [53] rjson_0.2.21      tools_4.1.0       glue_1.6.2        purrr_0.3.4      
## [57] parallel_4.1.0    fastmap_1.1.0     yaml_2.3.5        colorspace_2.0-3 
## [61] rvest_1.0.2       sass_0.4.1

Compare baRulho SIGPRO measurements

baRulho paper
Universidad de Costa Rica

Marcelo Araya-Salas

“2022-11-15”

Purpose

Report overview

Explore SIGPRO data

Compare SIGPRO and baRulho

Takeaways

Compare baRulho SIGPRO measurements

baRulho paper Universidad de Costa Rica

Marcelo Araya-Salas

“2022-11-15”

Purpose

Report overview

Explore SIGPRO data

Compare SIGPRO and baRulho

Takeaways

baRulho paper
Universidad de Costa Rica