# io.R
#' Read GOM rasters
#'
#' @export
#' @param x a tibble of the gom/DAY database. This is split by parameter.
#' @return list of RasterStacks (even if only on param specified)
#' @examples
#' \dontrun{
#' library(tidyverse)
#' x <- read_database_gom()
#' sst <- read_obpg_gom(x %>% dplyr::filter(param == 'sst'))[[1]]
#' }
read_obpg_gom <- function(x = read_database_gom(interval = 'DAY')){
x$file <- file.path(obpg_path("gom", "DAY"), x$param, paste0(x$file, ".grd"))
xx <- split(x, x$param)
RR <- lapply(xx,
function(x) {
R <- raster::stack(x$file)
names(R) <- x$id
R
})
RR
}
#' Read NWA rasters
#'
#' @export
#' @param x a tibble of the nwa/DAY database. This is split by parameter.
#' @return list of RasterStacks (even if only on param specified)
#' @examples
#' \dontrun{
#' library(tidyverse)
#' x <- read_database_nwa()
#' sst <- read_obpg_nwa(x %>% dplyr::filter(param == 'sst'))[[1]]
#' }
read_obpg_nwa <- function(x = read_database(path = obpg_path("nwa"))){
x$file <- file.path(obpg_path("nwa", "DAY"), x$param, paste0(x$file, ".grd"))
xx <- split(x, x$param)
RR <- lapply(xx,
function(x) {
R <- raster::stack(x$file)
names(R) <- x$id
R
})
RR
}
#' Read a Raster formatted OBPG file(s).
#'
#' Masking of 'non-data' is done by guessing. Layers are named according to the name(s) of the files.
#'
#' @export
#' @param x a character vector of filenames or a tibble database
#' @param path character path when x is a database, otherwise NULL
#' @param filter_missing logical, if TRUE data beyond \code{suggested_range} is
#' forced to be NA
#' @param fun function or NULL. If not NULL then transform the data
#' using the specified function, typically `log10` for CHL
#' @param ... any arguments for \code{fun}
#' @return RasterStack, possibly with one layer
read_obpg <- function(x, path = NULL, filter_missing = TRUE, fun = NULL, ...){
if (inherits(x, 'data.frame')){
if (is.null(path)) stop("if x is a database then path must be provided")
filename <- compose_obpg(x, path)
S <- raster::stack(filename)
names(S) <- basename(filename)
params <- x$param
} else {
info <- OBPGInfo(filename)
isnull <- sapply(info, is.null)
if (any(isnull)) {
cat(sprintf("The following do not adhere to naming convention %s",
paste(filename[isnull], collapse = " ")), "\n")
return(NULL)
}
S <- raster::stack(filename)
names(S) <- names(info)
params <- sapply(info, function(x) x$param)
}
if (filter_missing){
uparams <- unique(params)
if (length(uparams) > 1){
# uggg! iterate through each slice! yuck.
names(params) <- names(x)
for (n in names(x)){
r <- suggested_range(params[[n]])
S[[n]] <- S[[n]][(S[[n]] < r[1]) | (S[[n]] > r[2]) ] <- NA
}
} else {
r <- suggested_range(uparams[1])
S[ (S < r[1]) | (S > r[2]) ] <- NA
} # more than one param
} # filter
if (!is.null(fun)) S <- fun(S,...)
S
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.