#' Align test sound files
#'
#' \code{align_test_files} aligns test (re-recorded) sound files.
#' @inheritParams template_params
#' @param X object of class 'data.frame', 'selection_table' or 'extended_selection_table' (the last 2 classes are created by the function \code{\link[warbleR]{selection_table}} from the warbleR package). This should be the same data than that was used for finding the position of markers in \code{\link{find_markers}}. It should also contain a 'sound.id' column that will be used to label re-recorded sounds according to their counterpart in the master sound file.
#' @param Y object of class 'data.frame' with the output of \code{\link{find_markers}}. This object contains the position of markers in the re-recorded sound files. If more than one marker is supplied for a sound file only the one with the highest correlation score ('scores' column in 'X') is used.
#' @param path Character string containing the directory path where test (re-recorded) sound files are found.
#' @param by.song Logical argument to indicate if the extended selection table should be created by song (see 'by.song' \code{\link[warbleR]{selection_table}} argument). Default is \code{TRUE}.
#' @param marker Character string to define whether a "start" or "end" marker would be used for aligning re-recorded sound files. Default is \code{NULL}. DEPRECATED.
#' @param ... Additional arguments to be passed to \code{\link[warbleR]{selection_table}} for customizing extended selection table.
#' @return An object of the same class than 'X' with the aligned sounds from test (re-recorded) sound files.
#' @export
#' @name align_test_files
#' @details The function aligns sounds found in re-recorded sound files (referenced in 'Y') according to a master sound file (referenced in 'X'). If more than one marker is supplied for a sound file only the one with the highest correlation score ('scores' column in 'X') is used. The function outputs an 'extended selection table' by default.
#' @family test sound alignment
#' @seealso \code{\link{manual_realign}}; \code{\link{find_markers}}; \code{\link{plot_aligned_sounds}}
#' @examples
#' {
#' # load example data
#' data(list = c("master_est", "test_sounds_est"))
#'
#' # save example files in working director to recreate a case in which working
#' # with sound files instead of extended selection tables.
#' # This doesn't have to be done with your own data as you will
#' # have them as sound files already.
#' for (i in unique(test_sounds_est$sound.files)[1:2]) {
#' writeWave(object = attr(test_sounds_est, "wave.objects")[[i]],
#' file.path(tempdir(), i))
#' }
#'
#' # save master file
#' writeWave(object = attr(master_est, "wave.objects")[[1]],
#' file.path(tempdir(), "master.wav"))
#'
#' # get marker position for the first test file
#' markers <- find_markers(X = master_est,
#' test.files = unique(test_sounds_est$sound.files)[1],
#' path = tempdir())
#'
#' # align all test sounds
#' alg.tests <- align_test_files(X = master_est, Y = markers,
#' path = tempdir())
#' }
#' @author Marcelo Araya-Salas (\email{marcelo.araya@@ucr.ac.cr})
#' @references {
#' Araya-Salas M., E. Grabarczyk, M. Quiroz-Oliva, A. Garcia-Rodriguez, A. Rico-Guevara. (2023), baRulho: an R package to quantify degradation in animal acoustic signals .bioRxiv 2023.11.22.568305.
#' }
align_test_files <-
function(X,
Y,
path = getOption("sound.files.path", "."),
by.song = TRUE,
marker = NULL,
cores = getOption("mc.cores", 1),
pb = getOption("pb", TRUE),
...) {
# check arguments
arguments <- as.list(base::match.call())
# add objects to argument names
for (i in names(arguments)[-1]) {
# use try to avoid errors with argumets from dots (...)
try(arguments[[i]] <- get(i), silent = TRUE)
}
# check each arguments
check_results <-
.check_arguments(fun = arguments[[1]], args = arguments)
# report errors
.report_assertions(check_results)
# if more than one marker per test files then keep only the marker with the highest score
if (any(table(Y$sound.files) > 1)) {
Y <-
Y[stats::ave(x = -Y$scores,
as.factor(Y$sound.files),
FUN = rank) <= 1,]
}
# set clusters for windows OS
if (Sys.info()[1] == "Windows" & cores > 1) {
cl <- parallel::makePSOCKcluster(cores)
} else {
cl <- cores
}
# align each file
out <-
warbleR:::.pblapply(
pbar = pb,
X = seq_len(nrow(Y)),
cl = cl,
message = "aligning test sounds",
current = 1,
total = if (warbleR::is_extended_selection_table(X)) 3 else 1,
FUN = function(y) {
# compute start and end as the difference in relation to the marker position in the master sound file
start <-
X$start + (Y$start[y] - X$start[X$sound.id == Y$marker[y]])
end <-
X$end + (Y$start[y] - X$start[X$sound.id == Y$marker[y]])
# make data frame
W <-
data.frame(
sound.files = Y$sound.files[y],
selec = seq_along(start),
start,
end,
bottom.freq = X$bottom.freq,
top.freq = X$top.freq,
sound.id = X$sound.id,
marker = Y$marker[y]
)
# re set rownames
rownames(W) <- seq_len(nrow(W))
return(W)
}
)
# put data frames togheter
sync.sls <- do.call(rbind, out)
# check if any selection exceeds length of recordings
wvdr <-
duration_sound_files(path = path, files = unique(sync.sls$sound.files))
# add duration to data frame
sync.sls <- merge(sync.sls, wvdr)
# start empty vector to add name of problematic files
problematic_files <- character()
if (any(sync.sls$end > sync.sls$duration)) {
.warning(
x = paste(
sum(sync.sls$end > sync.sls$duration),
"selection(s) exceeded sound file length and were removed (run getOption('baRulho')$files_to_check_align_test_files to see which test files were involved)"
)
)
problematic_files <-
append(problematic_files, unique(sync.sls$sound.files[sync.sls$end > sync.sls$duration]))
# remove exceeding selections
sync.sls <- sync.sls[!sync.sls$end > sync.sls$duration,]
}
if (any(sync.sls$start < 0)) {
.warning(
x = paste(
sum(sync.sls$start < 0),
"selection(s) were absent at the start of the files (negative start values) and were removed (run getOption('baRulho')$files_to_check_align_test_files to see which test files were involved)"
)
)
problematic_files <-
append(problematic_files, unique(sync.sls$sound.files[sync.sls$start < 0]))
# remove exceeding selections
sync.sls <- sync.sls[sync.sls$start >= 0,]
}
on.exit(options(baRulho = list(
files_to_check_align_test_files = unique(problematic_files)
)))
# remove duration column and marker
sync.sls$duration <- NULL
if (warbleR::is_extended_selection_table(X)) {
if (by.song)
# if by song add a numeric column to represent sound files
{
sync.sls$song <- as.numeric(as.factor(sync.sls$sound.files))
by.song <- "song"
} else {
by.song <- NULL
} # rewrite by song as null
warbleR:::.update_progress(current = 1, total = 3)
sync.sls <-
selection_table(
sync.sls,
extended = TRUE,
path = path,
by.song = by.song,
pb = pb,
verbose = pb,
...
)
# remove song column
sync.sls$song <- NULL
# fix call attribute
attributes(sync.sls)$call <- base::match.call()
}
return(sync.sls)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.