R/importObs.R

Defines functions importObs

Documented in importObs

#' Import Zoo Observations
#'
#' Import function for list of single-line observational data
#' @param path List of filenames of objects to import.  Required if zoo.all is NULL.
#' @export
#' @return Numeric vector.
#' @examples
#' importObs()

importObs <- function(path,
                      timeStep3.,
                      verbose = FALSE){
  # Make sure files exist and eliminate those that don't
  existence <- file.exists(path)
  if (sum(existence) == 0){
    path <- NULL
  }else{
    rmNames <- path[!existence]
    path <- path[existence]
    if (length(rmNames) > 0){
      warning(paste0('Files missing...\n', paste0(rmNames, collapse = '\n')))
    }
  }
  
  if (!is.null(path)){
    # Load in all files (depends on zoo.all or path)
    imFun <- function(subPath){
      if (file.exists(subPath)){
        y <- zoo::read.zoo(file = subPath)
        # if not zoo obj already...
        if ((sum(y, na.rm = T) == 0) && (sum(is.na(y)) != length(y))){
          y <- read.csv(subPath,
                        header = F,
                        stringsAsFactors = F)
          yy <- zoo::as.zoo(y[,2])
          zoo::index(yy) <- as.Date(y[,1])
          y <- yy
        }
        # fill in missing sequences with NAs
        fD <- seq.Date(from = min(zoo::index(y)),
                       to = max(zoo::index(y)),
                       by = timeStep3.)
        fS <- rep(NA, length(fD))
        fS <- zoo::as.zoo(fS)
        zoo::index(fS) <- as.Date(fD)
        # merge
        yM <- merge(y, fS)
        yM <- yM[,1]
        
        #return
        return(yM)
      }else{
        return()
      }
      
    }
    z <- do.call("merge.zoo", lapply(X = path,
                                     FUN = imFun))
    
    if (!is.null(dim(z))){
      colnames(z) <- basename(path)
    }
  }else{
    z <- NULL
  }
  return(z)
}
ssaxe-usgs/METsteps documentation built on May 5, 2019, 5:54 p.m.