R/combine_DataFiles.R

Defines functions Concat_DataFile combine_DataFiles

Documented in combine_DataFiles Concat_DataFile

#' @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))

  ##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

  # 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(...)

}

Try the BayLum package in your browser

Any scripts or data that you put into this service are public.

BayLum documentation built on April 14, 2023, 12:24 a.m.