R/zooEnvParameters.R

In ssaxe-usgs/METsteps: Aggregate Data to the HUC 2-10 Levels (one line, title case)

#' Zoo Envelope Parameters
#'
#' Merge time-series and produces parameters required for zoo envelope plots:  time-series
#' of min/max, 25th/75th percentiles, mean, and median.
#' @param zoo.fnames List of filenames of objects to import.  Required if zoo.all is NULL.
#' @param timeStep2. Time step of observational data.
#' @param returnObs Return observational data (in zoo)?
#' @export
#' @return Numeric vector.
#' @examples
#' zooEnvParameters()

zooEnvParameters <- function(zoo.fnames,
                             timeStep2,
                             returnObs = FALSE
                             ){
    #zoo.fnames = paste0("C:/Users/ssaxe/Documents/Projects/Model Evaluation/RShiny/PointData/ET/New2/",ptSP.trim@data$OurID, '.csv')
  z <- METsteps::importObs(path = zoo.fnames,
                           timeStep3. = timeStep2)
  
  if (!is.null(z)){
    ########  Calc ts ranges
    # Define full date sequence as NAs
    indMer <- seq.Date(min(index(z)), max(index(z)), by = timeStep2)
    indMer2 <- zoo::as.zoo(rep(NA, length(indMer)))
    
    # Identify min/max for full sequence
    zoo::index(indMer2) <- indMer
    zRange <- suppressWarnings(apply(z, MARGIN = 1, FUN = range, na.rm = T))
    zRange[is.infinite(zRange)] <- NA
    
    envMax <- as.zoo(zRange[2,])
    zoo::index(envMax) <- as.Date(colnames(zRange))
    envMax <- merge(envMax, indMer2)[,1]
    
    envMin <- as.zoo(zRange[1,])
    zoo::index(envMin) <- as.Date(colnames(zRange))
    envMin <- merge(envMin, indMer2)[,1]
    
    # Identify quantiles when there are > 2 measurements per date
    quant.25.75 <- function(x){
      x <- as.numeric(x)
      if (sum(!is.na(x)) > 2){
        return(as.numeric(stats::quantile(x, probs = c(0.25, 0.75), na.rm = T)))
      }else{
        return(c(NA, NA))
      }
    }
    
    envQuant <- apply(z, MARGIN = 1, FUN = quant.25.75)
    env75 <- as.zoo(envQuant[2,])
    zoo::index(env75) <- as.Date(colnames(envQuant))
    env75 <- merge(env75, indMer2)[,1]
    
    env25 <- as.zoo(envQuant[1,])
    zoo::index(env25) <- as.Date(colnames(envQuant))
    env25 <- merge(env25, indMer2)[,1]
    
    # Trim NAs
    env75 <- zoo::na.trim(env75)
    env25 <- zoo::na.trim(env25)
    
    #Calculate means of obs
    envMean <- as.zoo(rowMeans(z, na.rm = T))
    zoo::index(envMean) <- as.Date(colnames(envQuant))
    envMean <- merge(envMean, indMer2)[,1]
    #Calculate medians of obs
    envMedian <- as.zoo(apply(z, MARGIN = 1, FUN = median, na.rm = T))
    zoo::index(envMedian) <- as.Date(colnames(envQuant))
    envMedian <- merge(envMedian, indMer2)[,1]
    
    # if return all obs is false, delete them
    if (!returnObs){
      z <- NULL
    }
    
    
    return(list(
      envInput = list(
        xMinMax = as.Date(zoo::index(envMax)),
        yMin = as.numeric(envMin),
        yMax = as.numeric(envMax),
        x2575 = as.Date(zoo::index(env25)),
        y25 = as.numeric(env25),
        y75 = as.numeric(env75)),
      envZoo = list(
        envMin    = envMin,
        envMax    = envMax,
        env25     = env25,
        env75     = env75,
        envMedian = envMedian,
        envMean   = envMean),
      allZoo = z
    ))
  }else{
    return(NULL)
  }
}