-
Notifications
You must be signed in to change notification settings - Fork 2
/
energy_detector.R
executable file
·216 lines (195 loc) · 12 KB
/
energy_detector.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
#' @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)
}