Nothing
#' @title Combine AcousticStudy Objects
#'
#' @details All events will be combined into one large list of events. Files,
#' settings, effort, models, GPS, and ancillary fields will be combined
#' using the \link[PAMmisc]{squishList} function from the PAMmisc package
#' (dataframes are combined, vectors are appended). The id is changed by
#' pasting all IDs together along with a note that they have been combined.
#' Note that the \linkS4class{PAMpalSettings} object in the pps slot is just
#' left as the \code{pps} in the first AcousticStudy to be combined, and thus
#' is not representative of the new combined AcousticStudy
#'
#' @description Combines multiple AcousticStudy objects (or lists of these)
#' into a single object
#'
#' @param \dots AcousticStudy objects, or a list of AcousticStudy objects
#'
#' @return A single AcousticStudy object
#'
#' @author Taiki Sakai \email{taiki.sakai@@noaa.gov}
#'
#' @importFrom rlang list2
#' @importFrom purrr discard
#'
#' @export
#'
bindStudies <- function(...) {
dots <- rlang::list2(...)
if(is.list(dots)) {
dots <- unlist(dots, recursive = FALSE)
}
dots <- lapply(dots, function(x) {
if(is.AcousticStudy(x)) {
return(x)
}
if(is.list(x)) {
return(unlist(x, recursive = FALSE))
}
NULL
})
dots <- purrr::discard(dots, is.null)
if(!all(sapply(dots, is.AcousticStudy))) {
stop('Inputs must all be AcousticStudy objects or lists of AcousticStudy objects.')
}
newAc <- dots[[1]]
newEv <- unlist(lapply(dots, events), recursive = FALSE)
evNames <- unique(names(newEv))
if(length(evNames) < length(newEv)) {
newNames <- c()
for(e in seq_along(evNames)) {
whichThis <- which(names(newEv) == evNames[e])
if(length(whichThis) == 1) {
next
}
for(w in seq_along(whichThis)) {
id(newEv[[whichThis[w]]]) <- paste0(names(newEv)[whichThis[w]], '_', w)
names(newEv)[whichThis[w]] <- id(newEv[[whichThis[w]]])
newNames <- c(newNames, id(newEv[[whichThis[w]]]))
}
}
pamWarning('Duplicate names found in combined study, numbers have been added to the end ',
'to create new names. New names are ', newNames)
}
events(newAc) <- newEv
newGps <- doAcCombine(dots, gps, unique=TRUE, df=TRUE)
if(is.list(newGps) && length(newGps) == 0) {
newGps <- data.frame()
}
gps(newAc) <- newGps
files(newAc) <- doAcCombine(dots, files, unique=TRUE)
settings(newAc) <- doAcCombine(dots, settings, unique=TRUE)
newEffort <- doAcCombine(dots, effort, df=TRUE)
if(is.list(newEffort) && length(newEffort) == 0) {
newEffort <- data.frame()
}
effort(newAc) <- newEffort
models(newAc) <- doAcCombine(dots, models)
ancillary(newAc) <- doAcCombine(dots, ancillary)
ancillary(newAc)$processDate <- as.POSIXct(ancillary(newAc)$processDate, origin='1970-01-01 00:00:00', tz='UTC')
id(newAc) <- paste0('COMBINED: ', paste0(sapply(dots, id), collapse=', '))
newAc <- .addPamWarning(newAc)
newAc
}
#' @importFrom PAMmisc squishList
#'
doAcCombine <- function(dots, FUN, unique=FALSE, df=FALSE) {
data <- lapply(dots, FUN)
if(df) {
if(unique) {
return(distinct(bind_rows(data)))
}
return(bind_rows(data))
}
squishList(unlist(data, recursive = FALSE), unique=unique)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.