R/io.R

In btupper/obpgtools: obpgtools for Ocean Biology Processing Group

# 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
}