R/set_sample.R

In neotoma2: Working with the Neotoma Paleoecology Database

#' @title set Sample Information
#' @import lubridate
#' @import sf
#' @importFrom methods new
#' @importFrom methods slot<-
#' @param x Object to be set as a sample
#' @param ages ages
#' @param igsn IGSN character
#' @param datum dataframe of datum
#' @param depth integer representing depth
#' @param sampleid ID for sample
#' @param thickness thickness of core
#' @param samplename sample's name
#' @param sampleanalyst Analyst's contact name
#' @param analysisunitid Which analysis unit it is
#' @param analysisunitname Analysis Unit's name
#' @description Function to create new samples objects for analysis. 
#' The new object will not be uploaded to the database.
#' @export
#' @returns `sample` object
#' @examples {
#' # Set an empty sample
#' my_sample <- set_sample()
#' }
set_sample <- function(x=NA,
                       ages = list(),
                       igsn = NA_character_,
                       datum = data.frame(),
                       depth = NA_integer_,
                       sampleid = NA_integer_,
                       thickness = NA_integer_,
                       samplename = NA_character_,
                       sampleanalyst = list(),
                       analysisunitid = NA_integer_,
                       analysisunitname = NA_character_){
  
  function_call <- match.call()
  
  if (suppressWarnings(is.na(x))) {
    x <- new("sample")
    if (is.na(sampleid)) {
      x@sampleid <- uuid::UUIDgenerate()
    } else {
      x@sampleid <- sampleid
    }
    x@ages <- ages
    x@igsn <- igsn
    x@datum <- datum
    x@depth <- depth
    x@thickness <- thickness
    x@samplename <- samplename
    x@sampleanalyst <- sampleanalyst
    x@analysisunitid <- analysisunitid
    x@analysisunitname <- analysisunitname
  } else {
    if (is(x, "sample")) {
      if(length(function_call)>2){
        for (i in 3:length(function_call)) {
          slot(x, names(function_call)[[i]]) <- eval(function_call[[i]])
        }
        return(x)
      } else {
        return(x)
      }
    } else {
      stop("`x` must be a sample object if it is supplied.")
    }
  }
  return(x)
}