ohun: Optimizing Acoustic Signal Detection

Documented in template_detector

#' @title Acoustic template detection from time-frequency cross-correlations
#'
#' @description \code{template_detector} find sound event occurrences in cross-correlation vectors from \code{\link{template_correlator}}
#' @usage template_detector(template.correlations, cores = 1, threshold, pb = TRUE,
#'  verbose = TRUE)
#' @param template.correlations object of class 'template_correlations' generated by \code{\link{template_correlator}} containing the correlation score vectors.
#' @param cores Numeric. Controls whether parallel computing is applied.
#' It specifies the number of cores to be used. Default is 1 (i.e. no parallel computing).
#' @param threshold Numeric vector of length 1 with a value between 0 and 1 specifying the correlation threshold for detecting sound event occurrences (i.e. correlation peaks). Must be supplied. Correlation scores are forced to between 0 and 1 (by converting negative scores to 0). 0 and 1 represent the lowest and highest similarity to the template respectively.
#' @param pb Logical argument to control progress bar. Default is \code{TRUE}.
#' @param verbose Logical argument to control if some summary messages are printed to the console.
#' @return The function returns a 'selection_table' (warbleR package's formats, see \code{\link[warbleR]{selection_table}}) or data frame (if sound files can't be found) with the start and end and correlation score for the
#' detected sound events.
#' @export
#' @name template_detector
#' @details This function infers sound events occurrences from cross-correlation scores along sound files. Correlation scores must be generated first using \code{\link{template_correlator}}. The output is a data frame (or selection table if sound files are still found in the original path supplied to \code{\link{template_correlator}}, using the warbleR package's format, see \code{\link[warbleR]{selection_table}}) containing the start and end of the detected sound events as well as the cross-correlation score ('scores' column) for each detection. \strong{Note that the detected sounds are assumed to have the same duration as the template, so their start and end correspond to the correlation peak position +/- half the template duration}.
#' @examples
#' {
#'   # load example data
#'   data("lbh1", "lbh2", "lbh_reference")
#'
#'   # save sound files
#'   tuneR::writeWave(lbh1, file.path(tempdir(), "lbh1.wav"))
#'   tuneR::writeWave(lbh2, file.path(tempdir(), "lbh2.wav"))
#'
#'   # template for the first sound file in 'lbh_reference'
#'   templ1 <- lbh_reference[1, ]
#'
#'   # generate template correlations
#'   tc <- template_correlator(templates = templ1, path = tempdir(), files = "lbh1.wav")
#'
#'   # template detection
#'   td <- template_detector(template.correlations = tc, threshold = 0.4)
#'
#'   # diagnose detection
#'   diagnose_detection(
#'     reference =
#'       lbh_reference[lbh_reference$sound.files == "lbh1.wav", ],
#'     detection = td
#'   )
#'
#'   # template for the second and third sound file in 'lbh_reference'
#'   # which have similar song types
#'   templ2 <- lbh_reference[4, ]
#'
#'   # generate template correlations
#'   tc <- template_correlator(
#'     templates = templ2, path = tempdir(),
#'     files = c("lbh1.wav", "lbh2.wav")
#'   )
#'
#'   # template detection
#'   td <- template_detector(template.correlations = tc, threshold = 0.3)
#'
#'   # diagnose detection
#'   diagnose_detection(reference = lbh_reference, detection = td)
#' }
#' @seealso \code{\link{energy_detector}}, \code{\link{template_correlator}}, \code{\link{optimize_template_detector}}
#' @author Marcelo Araya-Salas \email{marcelo.araya@@ucr.ac.cr})
#'
#' @references 
#' Araya-Salas, M., Smith-Vidaurre, G., Chaverri, G., Brenes, J. C., Chirino, F., Elizondo-Calvo, J., & Rico-Guevara, A. 2022. ohun: an R package for diagnosing and optimizing automatic sound event detection. BioRxiv, 2022.12.13.520253. https://doi.org/10.1101/2022.12.13.520253
#' 

template_detector <-
  function(template.correlations,
           cores = 1,
           threshold,
           pb = TRUE,
           verbose = TRUE) {
    # save start time
    start_time <- proc.time()

    # check arguments
    arguments <- as.list(base::match.call(expand.dots = FALSE))

    # do not check ... arguments
    arguments <- arguments[grep("...", names(arguments), fixed = TRUE, invert = TRUE)]

    # add objects to argument names
    for (i in names(arguments)[-1]) {
      arguments[[i]] <- get(i)
    }

    # check each arguments
    check_results <- check_arguments(fun = arguments[[1]], args = arguments)

    # report errors
    checkmate::reportAssertions(check_results)

    # set clusters for windows OS or more decent OSs
    if (Sys.info()[1] == "Windows" & cores > 1) {
      cl <-
        parallel::makePSOCKcluster(getOption("cl.cores", cores))
    } else {
      cl <- cores
    }

    # loop over scores of each dyad
    sel_table_list <-
      warbleR:::.pblapply(
        pbar = pb,
        X = 1:(length(template.correlations) - 1),
        cl = cl,
        message = "detecting templates",
        total = 1,
        FUN = function(i) {
          # extract data for a dyad
          temp_cor <- template.correlations[[i]]

          ## get peaks as the ones higher than previous and following scores
          peak_position <-
            which(c(FALSE, diff(temp_cor$correlation.scores) > 0) &
              c(rev(diff(
                rev(temp_cor$correlation.scores)
              ) > 0), FALSE) & temp_cor$correlation.scores > threshold)

          # get peaks and their scores
          scores <- temp_cor$correlation.scores[peak_position]
          peak_time <-
            seq(0,
              temp_cor$file.duration,
              length.out = length(temp_cor$correlation.scores)
            )[peak_position]

          # get peak position fixing by removing half the duration of the sound event at the start and end of the sound file
          peak_time <-
            seq(
              temp_cor$template.duration / 2,
              temp_cor$file.duration - temp_cor$template.duration / 2,
              length.out = length(temp_cor$correlation.scores)
            )[peak_position]

          # get file and template names
          file_template <-
            strsplit(names(template.correlations)[i], "/")[[1]]

          # calculate starts as the peak location minus half the template duration
          starts <-
            if (length(peak_time) > 0) {
              peak_time - (temp_cor$template.duration / 2)
            } else {
              NA
            }
          # cannot be negative
          starts[starts < 0] <- 0

          # calculate starts as the peak location minus half the template duration
          ends <-
            if (length(peak_time) > 0) {
              peak_time + (temp_cor$template.duration / 2)
            } else {
              NA
            }

          # cannot be higher than file duration
          ends[ends > temp_cor$file.duration] <- temp_cor$file.duration

          # put results in an extended selection table
          sel_table <-
            data.frame(
              sound.files = file_template[2],
              selec = if (length(scores) > 0) {
                seq_len(length(scores))
              } else {
                1
              },
              start = starts,
              end = ends,
              template = file_template[1],
              scores = if (length(scores) > 0) {
                scores
              } else {
                NA
              }
            )

          return(sel_table)
        }
      )

    # put results in a data frame
    sel_table_df <- do.call(rbind, sel_table_list)

    # relabel rows
    rownames(sel_table_df) <- seq_len(nrow(sel_table_df))

    # get path from corrrelation call
    corr_call_path <-
      try(eval(rlang::call_args(template.correlations$call_info$call)$path), silent = TRUE)

    if (is(corr_call_path, "try-error") |
      is.null(corr_call_path)) {
      corr_call_path <- getwd()
    }

    #  let user know if no detections are found
    if (all(is.na(sel_table_df$start)) & verbose) {
      print(x = "no sound events above threshold were detected")
    } else if (all(sel_table_df$sound.files %in% list.files(path = corr_call_path)) &
      any(!is.na(sel_table_df$start))) {
      sel_table_df <-
        warbleR::selection_table(
          X = sel_table_df[!is.na(sel_table_df$start), ],
          path = corr_call_path,
          parallel = cores,
          pb = FALSE,
          verbose = FALSE,
          fix.selec = TRUE
        )

      attributes(sel_table_df)$call <- base::match.call()

      # add elapsed time
      attributes(sel_table_df)$elapsed.time.s <-
        as.vector((proc.time() - start_time)[3])
    }
    return(sel_table_df)
  }