#' @title extract2
#----------------------------------------------------------------------------------------------------------------------------------#
#' @description Extract of values from multi-extent raster objects with a spatial object.
#' @param x A \emph{character} vector with the paths to \emph{RasterLayer} objects or a \emph{list} of \emph{RasterLayers}.
#' @param y An object of class \emph{SpatialPoints} or \emph{SpatialPolygons}.
#' @param x.date Object of class \emph{Date} with the acquisition dates of each element in \emph{x}.
#' @param out.date Object of class \emph{Date} with the desired output dates.
#' @param time.buffer Two-element, numeric vector.
#' @return A \emph{list} object.
#' @importFrom raster raster
#' @importFrom lubridate is.Date
#' @importFrom rsMove intime
#' @details {Creates a rectangular fishnet in a \emph{SpatialPolygons} format based on the
#' extent of \emph{x} and the value of \emph{y} which defines the spatial resolution.}
#' @export
#----------------------------------------------------------------------------------------------------------------------------------#
extract2 <- function(x, y, x.date, out.date, time.buffer=c(365,365)) {
#----------------------------------------------------------------------------------------------------------------------------------#
# 1. check input variables
#----------------------------------------------------------------------------------------------------------------------------------#
# is x composed of readble raster data?
if (!is.character(x) & !is.list(x)) {stop('"x" is not of a valid class')}
if (is.character(x)) {x <- lapply(x, function(i) {return(tryCatch(raster(i), error=function(e) return(NULL)))})}
if (is.list(x)) {x <- lapply(x, function(i) {if(class(i)=="RasterLayer") {return(i)} else {return(NULL)}})}
if (sum(sapply(x, function(i) {is.null(i)}) > 0)) {stop('one or more elements in "x" are not valid (check entries)')}
# is y a shapefile?
if (is.null(tryCatch(extent(y), error=function(e) return(NULL)))) {stop('"y" is not a valid spatial object')}
# is time information provided? (required for interpolation)
if (!missing(x.date)) {
# date information
if (!is.Date(x.date)) {stop('"x.date" provided but not a Date object')}
if (length(x.date) != length(x)) {stop('"x.date" and "x" should have the same lenght')}
if (!missing(out.date)) {
if (!is.Date(out.date)) {stop('"out.date" provided but not a Date object')}
c1 <- sum(x.date >= min(out.date) & x.date <= max(out.date))
c2 <- sum(out.date >= min(x.date) & out.date <= max(x.date))
if (c1 == 0 & c2 == 0) {stop('"out.date" is not contained by "x.date (cannot interpolate)')}
} else {out.date <- x.date}
int.time <- TRUE
# temporal buffer to search for dates to interpolate from
if (!is.numeric(time.buffer)) {stop('"time.buffer" is not numeric')}
if (length(time.buffer)==1) {time.buffer <- c(time.buffer, time.buffer)}
io <- order(x.date) # image order (by date)
x <- x[io] # sort imput images
x.date <- x.date[io] # sort input dates
out.date <- sort(out.date) # sort output dates
} else {
int.time <- FALSE
out.date <- NULL}
#----------------------------------------------------------------------------------------------------------------------------------#
# 2. extract raster values
#----------------------------------------------------------------------------------------------------------------------------------#
out.df <- do.call(cbind, lapply(x, function(i) {return(extract(i, y))}))
#----------------------------------------------------------------------------------------------------------------------------------#
# 3. interpolate missing values (when prompted)
#----------------------------------------------------------------------------------------------------------------------------------#
if (int.time) {out.df <- intime(as.matrix(out.df), as.numeric(x.date), as.numeric(out.date), time.buffer)}
#----------------------------------------------------------------------------------------------------------------------------------#
# 4. derive output
#----------------------------------------------------------------------------------------------------------------------------------#
return(list(values=out.df, dates=out.date))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.