Nothing
#' Filter dimensions, limiting to arbitrary lon/lat/Z/time ranges
#'
#' We frequently want to filter CMIP5 data according to some predetermined
#' criteria: only high-latitude cells, for example, or certain years, months,
#' Zs, etc. This function provides convenient one-stop service
#' for such tasks.
#'
#' @param x A \code{\link{cmip5data}} object
#' @param lonRange Longitude values (min, max) to filter data against
#' @param latRange Latitude values (min, max) to filter data against
#' @param ZRange Z values (min, max) to filter data against
#' @param yearRange Years (min, max) to filter data against
#' @param monthRange Months (min, max) to filter data against
#' @param verbose logical. Print info as we go?
#' @return The filtered \code{\link{cmip5data}} object.
#' @note If a filter is requested but no relevant data are present,
#' a \code{\link{warning}} will be produced.
#' @examples
#' d <- cmip5data(1970:2014) # sample data
#' filterDimensions(d, yearRange=c(1980, 1985))
#' filterDimensions(d, monthRange=c(6, 8)) # summer
#' filterDimensions(d, latRange=c(-20, 20)) # the tropics
#' filterDimensions(d, latRange=c(-20, 20), monthRange=c(6, 8)) # tropical summer
#' @export
filterDimensions <- function(x, lonRange=NULL, latRange=NULL, ZRange=NULL,
yearRange=NULL, monthRange=NULL, verbose=FALSE) {
# Sanity checks
assert_that(class(x)=="cmip5data")
assert_that(is.flag(verbose))
# Other parameters checked in their respective functions
x <- filterDimensionLon(x, lonRange, verbose)
x <- filterDimensionLat(x, latRange, verbose)
x <- filterDimensionZ(x, ZRange, verbose)
x <- filterDimensionTimeYears(x, yearRange, verbose)
x <- filterDimensionTimeMonths(x, monthRange, verbose)
x
} # filterDimensions
#' Filter longitude dimension.
#'
#' @param x cmip5data A \code{\link{cmip5data}} object.
#' @param lonRange Longitude values (min, max) to filter data against
#' @param verbose logical. Print info as we go?
#' @return A \code{\link{cmip5data}} object.
#' @note This is an internal RCMIP5 function and not exported.
#' @keywords internal
filterDimensionLon <- function(x, lonRange=NULL, verbose=FALSE) {
if(!is.null(lonRange)) {
# Sanity checks
assert_that(is.numeric(lonRange) & length(lonRange) == 2)
# Filter longitude dimension
if(is.null(x[["lon"]])) {
warning("No lon data found")
} else {
lonRowsInRange <- apply(x$lon, 1, function(x) any(x >= min(lonRange) & x <= max(lonRange)))
if(is.array(x$val)) { # array code
# 'punch' NA holes (in case of irregular grid)
x$val[x$lon < min(lonRange) | x$lon > max(lonRange)] <- NA
x$val <- x$val[lonRowsInRange,,,, drop=FALSE] # trim grid
} else if(is.data.frame(x$val)) { # data frame code
lon <- NULL # Suppress stupid NOTEs from R CMD CHECK
x$val <- filter(x$val, lon >= min(lonRange) & lon <= max(lonRange))
} else
stop("Unknown data type")
# Trim any rows (longitude) completely outside of filter range
x$lon <- x$lon[lonRowsInRange,, drop=FALSE]
x$lat <- x$lat[lonRowsInRange,, drop=FALSE]
x <- addProvenance(x, paste("Filtered for lons in range [",
paste(lonRange, collapse=', '), "]"))
x$filtered <- TRUE
if(verbose) cat("Filtered by lon\n")
}
}
x
} # filterDimensionLon
#' Filter latitude dimension.
#'
#' @param x cmip5data A \code{\link{cmip5data}} object.
#' @param latRange Latitude values (min, max) to filter data against
#' @param verbose logical. Print info as we go?
#' @return A \code{\link{cmip5data}} object.
#' @note This is an internal RCMIP5 function and not exported.
#' @keywords internal
filterDimensionLat <- function(x, latRange=NULL, verbose=FALSE) {
if(!is.null(latRange)) {
# Sanity checks
assert_that(is.numeric(latRange) & length(latRange) == 2)
# Filter latitude dimension
if(is.null(x[["lat"]])) {
warning("No lat data found")
} else {
latColsInRange <- apply(x$lat, 2, function(x) any(x >= min(latRange) & x <= max(latRange)))
if(is.array(x$val)) { # array code
# 'punch' NA holes (in case of irregular grid)
x$val[x$lat < min(latRange) | x$lat > max(latRange)] <- NA
x$val <- x$val[,latColsInRange,,, drop=FALSE] # trim grid
} else if(is.data.frame(x$val)) { # data frame code
lat <- NULL # Suppress stupid NOTEs from R CMD CHECK
x$val <- filter(x$val, lat >= min(latRange) & lat <= max(latRange))
} else
stop("Unknown data type")
# Trim any columns (latitude) completely outside of filter range
x$lon <- x$lon[,latColsInRange, drop=FALSE]
x$lat <- x$lat[,latColsInRange, drop=FALSE]
x <- addProvenance(x, paste("Filtered for lats in range [",
paste(latRange, collapse=', '), "]"))
x$filtered <- TRUE
if(verbose) cat("Filtered by lat\n")
}
}
x
} # filterDimensionLat
#' Filter Z dimension.
#'
#' @param x cmip5data A \code{\link{cmip5data}} object.
#' @param ZRange Z values (min, max) to filter data against
#' @param verbose logical. Print info as we go?
#' @return A \code{\link{cmip5data}} object.
#' @note This is an internal RCMIP5 function and not exported.
#' @keywords internal
filterDimensionZ <- function(x, ZRange=NULL, verbose=FALSE) {
if(!is.null(ZRange)) {
# Sanity checks
assert_that(is.numeric(ZRange) & length(ZRange) == 2)
if(is.null(x[["Z"]])) {
warning("No Z data found")
} else {
ZsInRange <- which(x$Z >= min(ZRange) & x$Z <= max(ZRange))
if(is.array(x$val)) { # array code
x$val <- x$val[,,ZsInRange,]
} else if(is.data.frame(x$val)) { # data frame code
Z <- NULL # Suppress stupid NOTEs from R CMD CHECK
x$val <- filter(x$val, Z >= min(ZRange) & Z <= max(ZRange))
} else
stop("Unknown data type")
x$Z <- x$Z[ZsInRange]
x <- addProvenance(x, paste("Filtered for Zs in range [",
paste(ZRange, collapse=', '), "]"))
x$filtered <- TRUE
if(verbose) cat("Filtered by Z\n")
}
}
x
} # filterDimensionZ
#' Filter time (years) dimension.
#'
#' @param x cmip5data A \code{\link{cmip5data}} object.
#' @param yearRange Years (min, max) to filter data against
#' @param verbose logical. Print info as we go?
#' @return A \code{\link{cmip5data}} object.
#' @note This is an internal RCMIP5 function and not exported.
#' @keywords internal
filterDimensionTimeYears <- function(x, yearRange=NULL, verbose=FALSE) {
if(!is.null(yearRange)) {
# Sanity checks
assert_that(is.numeric(yearRange) & length(yearRange) == 2)
yearRange <- floor(yearRange)
if(is.null(x[["time"]])) {
warning("No time data found")
} else {
yearsInRange <- floor(x$time) >= min(yearRange) & floor(x$time) <= max(yearRange)
if(is.array(x$val)) { # array code
x$val <- x$val[,,,yearsInRange, drop = FALSE]
} else if(is.data.frame(x$val)) { # data frame code
time <- NULL # Suppress stupid NOTEs from R CMD CHECK
x$val <- filter(x$val, floor(time) >= min(yearRange) & floor(time) <= max(yearRange))
} else
stop("Unknown data type")
x$time <- x$time[yearsInRange]
x <- addProvenance(x, paste("Filtered for years in range [",
paste(yearRange, collapse=', '), "]"))
x$filtered <- TRUE
if(verbose) cat("Filtered by year\n")
}
}
x
} # filterDimensionTimeYears
#' Filter time (months) dimension.
#'
#' @param x cmip5data A \code{\link{cmip5data}} object.
#' @param monthRange Months (min, max) to filter data against
#' @param verbose logical. Print info as we go?
#' @return A \code{\link{cmip5data}} object.
#' @note This is an internal RCMIP5 function and not exported.
#' @keywords internal
filterDimensionTimeMonths <- function(x, monthRange=NULL, verbose=FALSE) {
if(!is.null(monthRange)) {
# Sanity checks
assert_that(is.numeric(monthRange) & length(monthRange) == 2)
assert_that(all(monthRange %in% 1:12))
if(is.null(x[["time"]])) {
warning("No time data found")
} else if(x$debug$timeFreqStr != "mon") {
warning("A monthly filter can only be applied to monthly data")
}
else {
fracmonths <- round((monthRange-0.5) / 12, 2) # From Jan=1, Feb=2 to Jan 15=0.042, Feb15=0.123, etc.
monthfilter <- round(x$time %% 1, 2) >= min(fracmonths) & round(x$time %% 1, 2) <= max(fracmonths)
if(is.array(x$val)) { # array code
x$val <- x$val[,,,monthfilter, drop = FALSE]
} else if(is.data.frame(x$val)) { # data frame code
time <- NULL # Suppress stupid NOTEs from R CMD CHECK
x$val <- filter(x$val, round(time %% 1, 2) %in% fracmonths)
} else
stop("Unknown data type")
x$time <- x$time[monthfilter]
x <- addProvenance(x, paste("Filtered for months in range [",
paste(monthRange, collapse=', '), "]"))
x$filtered <- TRUE
if(verbose) cat("Filtered by month\n")
}
}
x
} # filterDimensionTimeMonths
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.