R/UpdateMeta.R

#' @title Updates flux-object metadata.
#'
#' @description
#'
#' This function updates metadata in a flux-class object. How it does this
#' depends on the condition of the flux object - check details.
#'
#' @param flux    Object of class 'flux'.
#' @param n_treat Number of treatment levels in the experiment.
#' @param write   T/F write the result to .csv?
#'
#' @details
#'
#' If the metadata slot on the flux object is empty, it will be initialized:
#'
#' Initiialization using raw data: `FILE` and `COLUMN_NAME` columns filled
#' in with information taken from the `raw_data` slot of the flux object. If
#' the `raw_data` slot is empty, `FILE` is ignored and `COLUMN_NAME` is taken
#' from column names in the data. If neither are present, metadata is
#' initialized as a dataframe with the appropriate columns but zero rows.
#'
#' `n_treat`` will specify the number of treatment levels to associate
#' with the flux data. 'Treatment level' here is used in the statistical
#' sense, to refer to e.g. species identity, plot replicate, or site name
#' when SAMPLE is used to refer to individual trees, 'SUB_SAMPLE' to stems
#' on each tree, and 'SUB_SAMPLE_REPLICATE' to probe IDs that are on the
#' same stem on the same tree.
#'
#' @return
#'
#' If `write = T`, writes a .csv file to the directory specified by
#' `dir`. Otherwise, returns the flux object with the metadata slot filled.
#'
#' @family preprocess
#' @examples
UpdateMeta <- function(flux, n_treat = 0, write = FALSE) {
  stop('Not implemented yet.')
  # Input checks:
  stopifnot(
    class(n_treat) == 'numeric' && length(n_treat) == 1,
    class(write) == 'logical' && length(write) == 1
  )
  validObject(flux)
  meta <- flux@metadata
  vc <- c('INCLUDE', paste('TREATMENT_', 1:n_treat, sep = ''),
          'SAMPLE', 'SUB_SAMPLE', 'SUB_SAMPLE_REPLICATE',
          'FILE', 'COLUMN_NAME', 'DBH',
          'DATE_INSTALLED', 'DATE_REMOVED')
  if (length(meta) < 1) {
    meta <- data.frame(matrix(ncol = length(vc), nrow = 0), stringsAsFactors = F)
    colnames(meta) <- vc
  }
  if (length(flux@raw_data) > 0) {
    fl <- flux@source_files
    nc <- unlist(lapply(flux@raw_data, function(x) length(colnames(x))))
    FILE <- rep(fl, nc)
    COLUMN_NAME <- unlist(lapply(flux@raw_data, colnames))
    stopifnot(length(FILE) == length(COLUMN_NAME))
    INCLUDE <- rep('TRUE', length(FILE))
    meta <- merge(data.frame(INCLUDE, FILE, COLUMN_NAME), meta, all = T)
  }
  # Trim metadata by data column names
  if (length(flux@data) > 0) {
    meta <- meta[which(meta['COLUMN_NAME'] %in% colnames(flux@data)), ]
  }


  # Return:
  if (write) {
    rwd <- getwd()
    BadSetDir <- function(err) {
      setwd(rwd)
      cat('Bad `dir` input.\n')
      stop(err)
    }
    tryCatch(expr = { setwd(dir) },
             error = BadSetDir,
             warning = BadSetDir,
             finally = { invisible() })
    cat(paste('Writing', title, 'to:\n'), dir, '\n')
    write.csv(x = meta, file = paste(title, '.csv', sep = ""), row.names = F)
  }
  cat('Returning meta as dataframe.\n')
  setwd(rwd)
  return(meta)
  # Aliases:
  # Generate template:
  if (length(flux) < 1) {
  }
}
bmcnellis/sapflux documentation built on May 12, 2019, 10:27 p.m.