R/time_raster.R

Defines functions time_raster.default time_raster.RasterBrick time_raster.RasterStack time_raster.character time_raster

Documented in time_raster

#' Time raster
#'
#' @export
#' @param x one of \code{\link[raster]{RasterStack-class}} or
#' \code{\link[raster]{RasterBrick-class}}
#' @param dates An object with dates, one of object of class
#' \code{\link[xts]{xts}}, or a \code{character} or \code{Date} class
#' vector of dates. If \code{character}, coerced internally to \code{Date}
#'
#' @return An object of class \code{\link{TimeRaster-class}}
#'
#' @details
#' This function creates \code{\link{TimeRaster-class}}, a subclass of
#' stack in the \pkg{raster} package. It adds an \code{xts} time series
#' (using only the index).
#'
#' You can create a \code{\link{TimeRaster-class}} in a variety of ways:
#' \itemize{
#'  \item \code{TimeRaster(stack, dates)} - Raster/Brick stack and date vector
#'  \item \code{TimeRaster(filelist, dates)} - List of files and date vector
#'  \item \code{TimeRaster(stack, xtsobj)} - Raster/Brick stack and xts object
#'  \item \code{TimeRaster(filelist, xtsobj)} - List of files and xts object
#' }
#'
#' Where \code{stack} is an already loaded Raster stack or filelist is a list of files.
#' A simple example to get a list of files from all geotifs in a directory would be
#' \code{files <- list.files(path= "/data/subdir", pattern=".tif$", all.files=T, full.names=T)}
#'
#' \code{dates} is a list of dates of the same length as \code{nlayers(stack)}. A simple
#' creation of a datelist for the 365 days in 2014 is \code{as.Date("2014-01-01")+0:364}
#'
#' If an \code{xts} object is already made you can pass that in, but only \code{index(xtsobj)}
#' is used
#'
#' The \code{dates} object need not be sequentially ordered although that would be an
#' intuitive way to store the data - however, the \code{dates} object must be in the same
#' order as the files or stack layers
#'
#' Once created, you can use all raster methods including plot, show, arithemetic, etc
#'
#' The layer subscripting as \code{tr[[3]]} works. However, the main feature is that the
#' layer subscripting has been greatly extended. If the \code{[[]]} index is a string then
#' time subscripting is invoked. The overall syntax for time subscripting is
#' \code{[daterange][aggregation][cycling]}, where:
#'
#' \itemize{
#'  \item daterange - \code{startdate [TO enddate]} - as with xts, dates can be higher level.
#'  So even if the data is daily an index of "2010" can be used for all days in 2010
#'  or "2010-10" for all days in October
#'  \item aggregation -
#'  \code{UPTO WEEKS|MONTHS|QUARTERS|YEARS [BY SUM|MIN|MAX|MEAN|SD|COUNT][KEEPNA]} -
#'  this will summarize a data set to a more aggregate time level default is to
#'  use sum with NA's omitted
#'  \item cycling - \code{ACROSS MONTH|YEAR [BY SUM|MIN|MAX|MEAN|MEDIAN|VAR|STD|COUNT][KEEPNA]} -
#'   this allows one to take say monthly averages across multiple years so if one
#'   starts with monthly date from Jan 2010 to Dec 2015 ACROSS YEAR would give
#'   stack with 12 layers (JAN-DEC) with each layer aggregated or averaged by month
#'   across the 6 years
#' }
#'
#' A full complex time subscript for daily data from 1980-2015 would be:
#' \code{tr[["2000 TO 2009 UPTO MONTH ACROSS YEAR BY MEAN"]]}. This would subscript the
#' data to one decade, aggregate daily up to monthly data then average all 10 January
#' data points together giving a stack with 12 layers for the 12 months each month
#' being an average across the years 2000-2009
#'
#' Two additional methods are supported to ensure that when a vector is extracted
#' across the layers it returns an \code{xts} object:
#' \itemize{
#'  \item \code{get_ts(tr, xcoord, ycoord)} - returns an \code{xts} object at (xcoord, ycoord)
#'  in the raster
#'  \item \code{cellStats(tr, func, ...)} - returns an \code{xts} object that has been
#'  summed/averaged, etc (depending on func) across the layers
#' }
#'
#' @examples \dontrun{
#' zip <- system.file("examples", "prismrain.zip", package = "timeraster")
#' dir <- paste0(tempdir(), "/prismrain")
#' dir <- "prismrain"
#' dir.create(dir)
#' unzip(zip, exdir = dir)
#' files <- list.files(dir, full.names = TRUE, pattern = ".tif$", all.files = TRUE)
#'
#' # Create raster stack from file paths
#' rf <- raster::stack(files)
#'
#' # Create a time series object
#' library("xts")
#' ts <- xts(1:365, as.Date("2014-01-01") + 0:364)
#'
#' # Create TimeRaster object
#' ## Using new()
#' res <- new("TimeRaster", rf, ts = ts)
#'
#' ## Use convenience function time_raster()
#' ### With list of files as input - & xts object
#' res <- time_raster(files, ts)
#' ### With RasterStack class as input - & xts object
#' res <- time_raster(rf, ts)
#' ### With RasterStack class as input - & Date class object
#' res <- time_raster(rf, as.Date("2014-01-01") + 0:364)
#'
#' # plot data
#' plot(res[["2014-10-01 TO 2014-10-03"]])
#' plot(res[["UPTO MONTHS"]])
#'
#' # Get data at a lat/long location
#' get_ts(res, -67, 45)
#'
#' # Get cell stats
#' cellStats(res, "mean")
#' }
time_raster <- function(x, dates = NULL) {
  UseMethod("time_raster")
}

#' @export
time_raster.character <- function(x, dates = NULL) {
  x <- raster::stack(x)
  if (!("xts" %in% class(dates))) {
    dates <- xts::xts(1:length(dates), dates)
  }
  #override content to be 1..n
  dates[] <- 1:length(dates)
  #midnight sometimes is previous day so put midday but still rounds down
  zoo::index(dates) <- trunc(zoo::index(dates)) + 0.4
  return(new("TimeRaster", x, ts = dates))
}

#' @export
time_raster.RasterStack <- function(x, dates = NULL) {
  if (!("xts" %in% class(dates))) {
    dates <- xts::xts(1:length(dates), dates)
  }
  #override content to be 1..n
  dates[] <- 1:length(dates)
  #midnight sometimes is previous day so put midday but still rounds down
  zoo::index(dates) <- trunc(zoo::index(dates)) + 0.4
  return(new("TimeRaster", x, ts = dates))
}

#' @export
time_raster.RasterBrick <- function(x, dates = NULL) {
  stop("RasterBrick not quite supported yet", call. = FALSE)
  # if (is.null(dates)) dates <- attr(x, "dates")
  # if (!is(dates, "Date")) dates <- as.Date(dates)
  # if (!("xts" %in% class(dates))) {
  #   dates <- xts::xts(1:length(dates), dates)
  # }
  # #override content to be 1..n
  # dates[] <- 1:length(dates)
  # #midnight sometimes is previous day so put midday but still rounds down
  # zoo::index(dates) <- trunc(zoo::index(dates)) + 0.4
  # return(new("TimeRaster", x, ts = dates))
}

#' @export
time_raster.default <- function(x, dates = NULL) {
  stop(sprintf("time_raster method not implemented for %s.", class(x)[1]))
}
ropenscilabs/timeraster documentation built on May 18, 2022, 8:33 p.m.