R/ImportMeta.R

In bmcnellis/sapflux: Analyze Sapflux Traces

#' @title Flux metadata import/integrity check function
#'
#' @description
#'
#' TODO: Fill this out.
#'
#' @param meta        Filename of metadata OR data frame
#' @param flux        Optional flux object to save metadata in.
#' @param diam_fill   If missing diameters, fill with within-treatment averages.
#' @param time_format Optional format for start/end dates.
#'
#' @details
#'
#' @family preprocess
#' @export
#' @examples
#' new_flux <- ImportMeta(met = foo.csv, flux = old_flux)
ImportMeta <- function(meta, flux = NULL, diam_fill = FALSE,
                           time_format = '%Y-%m-%d') {
  # Input integrity checks:
  stopifnot(
    class(meta) %in% c('data.frame', 'character') && length(meta) == 1,
    class(diam_fill) == 'logical' && length(diam_fill) == 1,
    class(time_format) == 'character'&& length(time_format) == 1
  )
  if (class(meta) == 'character') {
    meta <- read.csv(meta, stringsAsFactors = F)
  } else {
    # TODO: check to make sure this jives with GenerateMetaTemplate.R
    stop('check TODO')
  }
  # TODO: Check to make sure there's no duplicates of samples, sub-samples, etc.
  vc <- c('INCLUDE', 'SAMPLE', 'SUB_SAMPLE', 'SUB_SAMPLE_REPLICATE',
          'FILE', 'COLUMN_NAME', 'DBH',
          'DATE_INSTALLED', 'DATE_REMOVED')
  stopifnot(vc %in% colnames(meta))
  if (anyDuplicated(colnames(meta))) stop('Metadata has duplicate columns.')
  # Drop non-included. This should be reserved for UpdateMeta function later.
  #meta <- meta[which(meta$INCLUDE == T), ]
  # Diameters:
  diam <- meta[, 'DBH']
  if (max(diam, na.rm = T) > 200) stop('Diams in mm?')
  if (diam_fill) diam <- ifelse(is.na(diam), mean(diam, na.rm = T), diam)
  # Convert dates:
  inst <- meta[, c('DATE_INSTALLED', 'DATE_REMOVED')]
  if (!all(is.na(inst))) {
    inst <- lapply(test, function(x) as.POSIXct(x, format = "%Y-%m-%d"))
    meta[, 'DATE_INSTALLED'] <- inst[[1]]
    meta[, 'DATE_REMOVED'] <- inst[[2]]
  }
  if (length(flux) > 0) {
    CheckFluxObject(flux)
    flux@metadata <- meta
    return(flux)
  }
  return(meta)
}