R/DropRainyDays.R

In bmcnellis/sapflux: Analyze Sapflux Traces

#' @title Uses met data to avoid wet-probe data anomalies
#'
#' @description
#'
#' Wet TDP probes/probe assemblies have unreasonably low dTs relative
#' to their normal transpiration rates - dropping rainy days can remove
#' these anomalies
#'
#' @param flux         Object of class 'flux'
#' @param met          Dataframe of met data
#' @param rain         Name or number of 'rain' column
#' @param time         Name or number of 'time' column.
#' @param time.format  Format of time vector
#' @param cutoff       Minimum amount of 24-hour rainfall to drop a day.
#'
#' @return Returns the modified flux object.
#'
#' @details
#'
#' Rain data must be in millimeters.
#'
#' @export
#' @family preprocess
#' @examples
#' rain <- read.csv("SITE_rain_events.csv", stringsAsFactors = FALSE)
#' colnames(rain) <- c("time", "rain")
#' rain[, 2] <- rain[, 2] * 10
#' flux.data <- DropRainyDays(flux = flux.data, met = rain)
#' # Check log:
#' print(flux.data@log[length(flux.data@log)])
DropRainyDays <- function(flux, met,
                          rain = "rain", time = "time",
                          time.format = "%m/%d/%Y", cutoff = 5) {
  # This could eventually go into an ImportRainData function that
  # lumps the rain data in with the flux object
  CheckFluxObject(flux)
  stopifnot(
    length(rain) & length(time) == 1,
    class(time.format) == "character",
    class(met) == "data.frame",
    rain %in% colnames(met),
    time %in% colnames(met)
  )
  # Format met data
  mettime <- met$time
  if (inherits(mettime, "character")) {
    mettime <- strptime(mettime, format = time.format)
  }
  if (inherits(mettime, "Date") == FALSE) {
    mettime <- as.Date(mettime)
  }
  stopifnot(class(mettime) == "Date")
  rain <- met$rain
  mettime <- mettime[which(rain > cutoff)]
  message("Dropping rainy days from dataset...")
  # Pull slots
  data <- slot(flux, "data")
  fluxtime <- slot(flux, "time")
  fluxtime <- as.Date(fluxtime)
  drops <- which(fluxtime %in% mettime)
  ndrops <- length(drops)
  if (length(drops) < 1) {
    return(cat("No rainy days!"))
  }
  data <- data[-drops, ]
  slot(flux, "data") <- data
  fluxtime <- slot(flux, "time")
  fluxtime <- fluxtime[-drops]
  slot(flux, "time") <- fluxtime
  log.message <- paste("Daily rain cutoff of", cutoff, "mm",
                       "dropped", ndrops, "data points, corresponding to",
                       length(mettime), "rainy days",
                       "in order to account for wet-probe effect.")
  slot(flux, "log") <- c(slot(flux, "log"), log.message)
  return(flux)
}