#' @title Subsample Detections
#' @description Extract a random subsample of detections for each event and
#' detector.
#'
#' @param data a detector data.frame or list of detector data.frames.
#' @param n a value giving the number (\code{n} >= 1) or
#' fraction (\code{n} between 0 and 1) of detections per event per detector
#' to select. Detections are randomly selected without replacement.
#' If \code{n} is greater than the number of detections in an event, all
#' detections for that event will be retained.
#'
#' @return a detector data.frame or list of detector data.frames with
#' no more than \code{n} detections per event per detector.
#'
#' @author Eric Archer \email{eric.archer@@noaa.gov}
#'
#' @references Rankin, S., Archer, F., Keating, J. L., Oswald, J. N.,
#' Oswald, M. , Curtis, A. and Barlow, J. (2017), Acoustic classification
#' of dolphins in the California Current using whistles, echolocation clicks,
#' and burst pulses. Marine Mammal Science 33:520-540. doi:10.1111/mms.12381
#'
#' @examples
#' data(train.data)
#'
#' # initial number of detections per event per detector
#' sapply(train.data$detectors, function(x) table(x$event.id))
#'
#' # select half of all detectors
#' detect.half <- subsampleDetections(train.data$detectors, 0.5)
#' sapply(detect.half, function(x) table(x$event.id))
#'
#' # select 20 detections
#' detect.20 <- subsampleDetections(train.data$detectors, 20)
#' sapply(detect.20, function(x) table(x$event.id))
#'
#' # select 10 detections fro 'ec' detector
#' ec.10 <- subsampleDetections(train.data$detectors$ec, 10)
#' table(ec.10$event.id)
#'
#' @export
#'
subsampleDetections <- function(data, n) {
.subsample <- function(x, n) {
if(!"event.id" %in% colnames(x)) {
stop("data.frame must have 'event.id' column.")
}
rows <- tapply(1:nrow(x), x$event.id, function(i, n) {
if(length(i) == 1) return(i) # because sample() with a scalar samples 1:i
n.i <- if(n < 1) ceiling(length(i) * n) else min(length(i), n)
sample(i, n.i, replace = FALSE)
}, n = n, simplify = FALSE)
x[sort(unlist(rows)), ]
}
if(is.numeric(n)) {
if(n <= 0) stop("'n' must be > 0.")
} else stop("'n' must be numeric.")
# If data is a list of detectors
if(methods::is(data, "list")) {
lapply(data, .subsample, n = n)
# If data is a data.frame
} else if(methods::is(data, "data.frame")) {
.subsample(data, n)
} else stop("'data' must be a list or data.frame.")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.