R/set_collunit.R

In neotoma2: Working with the Neotoma Paleoecology Database

#' @title set Site Information for Fossil Sites
#' @author Socorro Dominguez \email{dominguezvid@wisc.edu}
#' @author Simon Goring \email{goring@wisc.edu}
#' @importFrom methods is new slot<-
#' @importFrom sf st_as_sf st_sfc
#' @importFrom uuid UUIDgenerate
#' @importFrom digest digest
#' @param x object to be set as collunit
#' @param collectionunitid collection unit identifier
#' @param notes notes
#' @param handle handle
#' @param colldate collection date
#' @param location location of the collection unit
#' @param waterdepth depth at where the sample is taken
#' @param gpslocation location with GPS
#' @param collunittype type of collection unit
#' @param collectiondevice device used to collect the sample
#' @param collectionunitname name of the collection unit
#' @param depositionalenvironment depositional environment
#' @param datasets datasets that the collection unit has
#' @param chronologies chronologies taken from the collection unit
#' @param defaultchronology best chronology model identifier to
#' be used with this collection unit
#' @param speleothems speleothems associated with the collection unit
#' @returns `collunit` object
#' @description Function to create new collection unit objects for
#' personal analysis.
#' The new object will not be uploaded to the database.
#' @export
#' @md
#' @examples {
#' # Create a collunit
#' my_collunit <- set_collunit(notes = "my lake")
#' }
set_collunit <- function(x = NA,
                         collectionunitid = NA_integer_,
                         notes = NA_character_,
                         handle = NA_character_,
                         colldate = as.Date(character(1)),
                         location = NA_character_,
                         waterdepth = NA_integer_,
                         gpslocation = st_as_sf(st_sfc()),
                         collunittype = NA_character_,
                         collectiondevice = NA_character_,
                         collectionunitname = NA_character_,
                         depositionalenvironment = NA_character_,
                         datasets = NULL,
                         chronologies = NULL,
                         defaultchronology = NA_integer_,
                         speleothems = NULL) {
  function_call <- match.call()
  if (suppressWarnings(is.na(x))) {
    x <- new("collunit")
    if (is.na(collectionunitid)) {
      hash <- digest(UUIDgenerate(), algo = "xxhash32", serialize = FALSE)
      x@collectionunitid <- as.integer(strtoi(substr(hash, 1, 7), base = 16L))
    } else {
      x@collectionunitid <- collectionunitid
    }
    x@notes <- notes
    x@handle <- handle
    x@colldate <- colldate
    x@location <- location
    x@waterdepth <- waterdepth
    x@gpslocation <- gpslocation
    x@collunittype <- collunittype
    x@collectiondevice <- collectiondevice
    x@collectionunitname <- collectionunitname
    x@depositionalenvironment <- depositionalenvironment
    x@datasets <- datasets
    x@chronologies <- chronologies
    x@defaultchronology <- defaultchronology
    x@speleothems <- speleothems
  } else {
    if (is(x, "collunit")) {
      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 collunit object if it is supplied.")
    }
  }
  return(x)
}