energy_detector.R

#' @title Detects the start and end of sound events
#'
#' @description \code{energy_detector} detects the start and end of sound events based on energy and time attributes
#' @usage energy_detector(files = NULL, envelopes = NULL, path = ".", hop.size = 11.6, wl = NULL,
#' thinning = 1, bp = NULL, smooth = 5, threshold = 5, peak.amplitude = 0,
#' hold.time = 0, min.duration = 0, max.duration = Inf, cores = 1, pb = TRUE)
#' @param files Character vector indicating the sound files that will be analyzed. Optional. If 'files' and 'envelopes' are not supplied then the function will work on all supported format sound files in the working directory. Supported file formats:'.wav', '.mp3', '.flac' and '.wac'. If not supplied the function will work on all sound files (in the supported format) in 'path'.
#' @param envelopes An object of class 'envelopes' (generated by \code{\link{get_envelopes}}) containing the amplitude envelopes of the sound files to be analyzed. If 'files' and 'envelopes' are not supplied then the function will work on all supported format sound files in the working directory.
#' @param path Character string containing the directory path where the sound files are located.
#' The current working directory is used as default.
#' @param hop.size A numeric vector of length 1 specifying the time window duration (in ms). Default is 11.6 ms, which is equivalent to 512 wl for a 44.1 kHz sampling rate. Ignored if 'wl' is supplied.
#' @param wl A numeric vector of length 1 specifying the window length of the spectrogram. Default is \code{NULL}. If supplied, 'hop.size' is ignored. Used internally for bandpass filtering (so only applied when 'bp' is supplied).
#' @param thinning Numeric vector of length 1 in the range 0~1 indicating the proportional reduction of the number of
#' samples used to represent amplitude envelopes (i.e. the thinning of the envelopes). Usually amplitude envelopes have many more samples
#' than those needed to accurately represent amplitude variation in time, which affects the size of the
#' output (usually very large R objects / files). Default is \code{1} (no thinning). Higher sampling rates can afford higher size reduction (e.g. lower thinning values). Reduction is conducted by interpolation using \code{\link[stats]{approx}}. Note that thinning may decrease time precision, and the higher the thinning the less precise the time detection. This argument is used internally by \code{\link{get_envelopes}}. Not used if 'envelopes' are supplied.
#' @param bp Numeric vector of length 2 giving the lower and upper limits of a frequency bandpass filter (in kHz). Default is \code{NULL}. This argument is used internally by \code{\link{get_envelopes}}. Not used if 'envelopes' are supplied. Bandpass is done using the function \code{\link[seewave]{ffilter}}, which applies a short-term Fourier transformation to first create a spectrogram in which the target frequencies are filtered and then is back transformed into a wave object using a reverse Fourier transformation.
#' @param smooth A numeric vector of length 1 to smooth the amplitude envelope  with a sum smooth function. It controls the time 'neighborhood' (in ms) in which amplitude samples are smoothed (i.e. averaged with neighboring samples). Default is 5. 0 means no smoothing is applied. Note that smoothing is applied before thinning (see 'thinning' argument). The function  \code{\link[warbleR]{envelope}} is used internally which is analogous to sum smoothing in \code{\link[seewave]{env}}. This argument is used internally by \code{\link{get_envelopes}}. Not used if 'envelopes' are supplied.
#' @param threshold Numeric vector of length 1 with a value between 0 and 100 specifying the amplitude threshold for detecting sound event occurrences. Amplitude is represented as a percentage so 0 and 100 represent the lowest amplitude and highest amplitude respectively. Default is 5.
#' @param peak.amplitude Numeric vector of length 1 with the minimum peak amplitude value. Detections below that value are excluded. Peak amplitude is the maximum sound pressure level (in decibels) across the sound event (see \code{\link[warbleR]{sound_pressure_level}}). This can be useful when expecting higher peak amplitude in the target sound events compared to non-target sound events or when keeping only the best examples of the target sound events. Default is 0.
#' @param hold.time Numeric vector of length 1. Specifies the time range (in ms) at which selections will be merged (i.e. if 2 selections are separated by less than the specified 'hold.time' they will be merged in to a single selection). Default is \code{0} (no hold time applied).
#' @param min.duration Numeric vector of length 1 giving the shortest duration (in ms) of the sound events to be detected. It removes sound events below that threshold. If 'hold.time' is supplied sound events are first merged and then filtered by duration. Default is 0 (i.e. no filtering based on minimum duration).
#' @param max.duration Numeric vector of length 1 giving the longest duration (in
#'   ms) of the sound events to be detected. It removes sound events above that
#'   threshold. If 'hold.time' is supplied sound events are first merged and then filtered by duration.  Default is \code{Inf} (i.e. no filtering based on maximum duration).
#' @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 pb Logical argument to control progress bar. Default is \code{TRUE}.
#' @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) containing the start and end of each sound event by
#'   sound file. If no sound event was detected for a sound file it is not included in the output data frame.
#' @export
#' @name energy_detector
#' @details This function detects the time position of target sound events based on energy and time thresholds. It first detect all sound above a given energy threshold (argument 'energy'). If 'hold.time' is supplied then detected sounds are merged if necessary. Then the sounds detected are filtered based on duration attributes ('min.duration' and 'max.duration'). If 'peak.amplitude' is higher than 0 then only those sound events with higher peak amplitude are kept. Band pass filtering ('bp'), thinning ('thinning') and envelope smoothing ('smooth') are applied (if supplied) before threshold detection.
#'
#' @examples \donttest{
#' # Save example files into temporary working directory
#' data("lbh1", "lbh2", "lbh_reference")
#' tuneR::writeWave(lbh1, file.path(tempdir(), "lbh1.wav"))
#' tuneR::writeWave(lbh2, file.path(tempdir(), "lbh2.wav"))
#'
#' # using smoothing and minimum duration
#' detec <- energy_detector(files = c("lbh1.wav", "lbh2.wav"),
#' path = tempdir(), threshold = 6, smooth = 6.8,
#' bp = c(2, 9), hop.size = 3, min.duration = 0.05)
#'
#' # diagnose detection
#' diagnose_detection(reference = lbh_reference,
#' detection = detec)
#'
#' # without declaring 'files'
#' detec <- energy_detector(path = tempdir(), threshold = 60, smooth = 6.8,
#' bp = c(2, 9), hop.size = 6.8, min.duration = 90)
#'
#' # diagnose detection
#' diagnose_detection(reference = lbh_reference,
#' detection = detec)
#'
#' # using hold time
#' detec <- energy_detector(threshold = 10, hold.time = 150,
#' bp = c(2, 9), hop.size = 6.8, path = tempdir())
#'
#' # diagnose detection
#' diagnose_detection(reference = lbh_reference, detection = detec)
#'
#' # calculate envelopes first
#' envs <- get_envelopes(bp = c(2, 9), hop.size = 6.8, path = tempdir())
#'
#' # then run detection providing 'envelopes' (but no 'files')
#' detec <- energy_detector(envelopes = envs, threshold = 10, hold.time = 150, min.duration = 50)
#'
#' # diagnose detection
#' diagnose_detection(reference = lbh_reference, detection = detec, time.diagnostics = TRUE)
#'
#' # USIN OTHER SOUND FILE FORMAT (flac program must be installed)
#'  # fisrt convert files to flac
#'  warbleR::wav_2_flac(path = tempdir())
#'
#'  # change sound file extension to flac
#'  flac_reference <- lbh_reference
#'  flac_reference$sound.files <- gsub(".wav", ".flac", flac_reference$sound.files)
#'
#'  # run detection
#'  detec <- energy_detector(files = c("lbh1.flac", "lbh2.flac"), path = tempdir(), threshold = 60,
#'  smooth = 6.8, bp = c(2, 9), hop.size = 6.8, min.duration = 90)
#'
#'  # diagnose detection
#'  diagnose_detection(reference = flac_reference, detection = detec)
#' }
#'
#' @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
#' 
#' @seealso \code{\link{optimize_energy_detector}}
#' @author Marcelo Araya-Salas (\email{marcelo.araya@@ucr.ac.cr})

energy_detector <-
  function(files = NULL,
           envelopes = NULL,
           path = ".",
           hop.size = 11.6,
           wl = NULL,
           thinning = 1,
           bp = NULL,
           smooth = 5,
           threshold = 5,
           peak.amplitude = 0,
           hold.time = 0,
           min.duration = 0,
           max.duration = Inf,
           cores = 1,
           pb = TRUE) {

    
    # save start time
    start_time <- proc.time()

    # check arguments
    if (options("ohun_check_args")$ohun_check_args) {
      # check arguments
      arguments <- as.list(base::match.call())

      # 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)
    }

    # check path if not provided set to working directory
    path <- if (is.null(path)) {
      getwd()
    } else {
      normalizePath(path)
    }

    # if files and envelopes are not supplied
    if (is.null(files) & is.null(envelopes)) {
      files <- list.files(path = path, pattern = "\\.wav$|\\.wac$|\\.mp3$|\\.flac$", ignore.case = TRUE)

      if (length(files) == 0) {
        stop2("No files found in the working directory or 'path' supplied")
      }
    }

    # either files or envelopes must be supplied
    if (!is.null(files) & !is.null(envelopes)) {
      message2("'files' will be ignored as 'envelopes' has been supplied")
    }

    # get file names from envelopes
    if (is.null(files)) {
      files <- names(envelopes)[-length(envelopes)]
    }

    # Apply over each sound file
    # set clusters for windows OS
    if (Sys.info()[1] == "Windows" & cores > 1) {
      cl <- parallel::makeCluster(cores)
    } else {
      cl <- cores
    }

    # run function over sound files or selections in loop
    detections_l <- warbleR:::.pblapply(
      pbar = pb,
      X = files,
      cl = cl,
      message = "detecting sound events",
      total = 1,
      FUN = function(file) {
        out <- detect_FUN(file,
          wl,
          thres = threshold / 100,
          pa = peak.amplitude,
          min.dur = min.duration,
          max.dur = max.duration,
          pth = path,
          bpass = bp,
          thin = thinning,
          smth = smooth,
          envlp = envelopes,
          hop.siz = hop.size,
          cors = cores,
          pbar = pb,
          hold.t = hold.time
        )
        return(out)
      }
    )

    # put together in a single data frame
    detections <- do.call(rbind, detections_l)

    # remove NAs in detections
    detections <- detections[!is.na(detections$sound.files), ]

    # rename rows
    if (nrow(detections) > 0) {
      rownames(detections) <- seq_len(nrow(detections))
    }

    if (all(detections$sound.files %in% list.files(path = path)) & nrow(detections > 0)) {
      detections <- warbleR::selection_table(X = detections[!is.na(detections$start), ], path = path, parallel = cores, pb = FALSE, verbose = FALSE, fix.selec = TRUE)

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

      attributes(detections)$elapsed.time.s <- as.vector((proc.time() - start_time)[3])
    }

    return(detections)
  }