Nothing
#' @title Combine objects
#'
#' @description Combine objects generated by [Generate_DataFile] and [Generate_DataFile_MG]
#'
#' @details
#'
#' The function allows to combine data already generated by [Generate_DataFile] or
#' [Generate_DataFile_MG]. The number of input objects is not limited and the function
#' works similar to the standard base R function `c()`, but preserves the particular structure of the
#' objects imported and generated by 'BayLum'. The elements are combined by list
#' element names.
#'
#' Combining such data is rather useful in two scenarios:
#'
#' \itemize{
#' \item The data have been already imported and treated and then stored in RData-files. Using the function
#' `combine_DataFiles()` will significantly speed up the processing time,
#' \item simultaneous analysis of single and multi-grain OSL measurements.
#' }
#'
#'
#' @param ... list objects generated by [Generate_DataFile] or [Generate_DataFile_MG]
#'
#' @return A nested list combining the input objects.
#'
#' @section Function version: 0.1.1
#'
#' @author Sebastian Kreutzer, IRAMAT-CRP2A, UMR 5060, CNRS - Université Bordeaux Montaigne (France), adapting
#' the idea from the function 'Concat_DataFile()' by Claire Christophe.
#'
#' @seealso [Generate_DataFile], [Generate_DataFile_MG]
#'
#' @examples
#' # load data files
#' data(DATA1,envir = environment())
#' data(DATA2,envir = environment())
#'
#' #combine objects
#' DATA3 <- combine_DataFiles(DATA1, DATA2)
#' str(DATA3)
#' @md
#' @export
combine_DataFiles <- function(...) {
## fix problem with R version 3.4.0 and lower
if(as.numeric(R.version$major) == 3 && as.numeric(R.version$minor) < 5){
...length <- function(x = list(...)) length(x)
...elt <- function(n) switch(n, ...)
}
# Integrity checks ----------------------------------------------------------------------------
##check for zero input
if(...length() == 0)
return(NULL)
##test if everything is a list input
if(!all(vapply(1:...length(),function(x){class(...elt(x)) == "list"}, logical(1))))
stop(paste0("[combine_DataFiles()] This function only accepts 'list' objects as input!"), call. = FALSE)
##get names from the first objects
names <- names(...elt(1))
## extract attributes
attr_ <- unique(unlist(lapply(list(...), attr, which = "originator")))
##test elements
if(!all(vapply(1:...length(),function(x){all(names %in% names(...elt(x)))}, logical(1))))
stop(paste0("[combine_DataFiles()] The input objects are not compatible and cannot be combined!"), call. = FALSE)
# Helper function -----------------------------------------------------------------------------
##define helper function
.extract <- function(pattern){
temp <- lapply(1:...length(), function(x){
...elt(x)[pattern]
})
##now we have the check what kind of pattern we have, since the other functions are very
##sensitive to the data structure
if(pattern == "dLab" || pattern == "ddot_env"){
temp <- unlist(temp, recursive = FALSE)
return(do.call(cbind, temp))
}else {
return(unlist(
unlist(temp,recursive = FALSE),
use.names = FALSE, recursive = FALSE))
}
}
# concatenate ---------------------------------------------------------------------------------
##extract elements
temp <- lapply(names, .extract)
##restore names
names(temp) <- names
## correct Nb_sample
temp$Nb_sample <- sum(temp$Nb_sample)
##restore originator attribute
attr(temp, "originator") <- attr_
# Return --------------------------------------------------------------------------------------
return(temp)
}
#TODO
#'Old function Concat_DataFile()
#'@rdname combine_DataFiles
#'@md
#'@export
Concat_DataFile <- function(...){
.Deprecated(
new = "combine_DataFiles()",
package = "BayLum",
old = "Concat_DataFile()"
)
combine_DataFiles(...)
}
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.