Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix for issue #327, adjust data request date and fix column name #328

Merged
merged 8 commits into from
Nov 6, 2019
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -39,8 +39,10 @@ export(ersst)
export(gefs)
export(gefs_dimension_values)
export(gefs_dimensions)
export(gefs_ensembles)
export(gefs_latitudes)
export(gefs_longitudes)
export(gefs_times)
export(gefs_variables)
export(ghcnd)
export(ghcnd_clear_cache)
Expand Down
103 changes: 75 additions & 28 deletions R/gefs.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
#' @export
#'
#' @param var the variable to get. Must be one of the variables listed in
#' `gefs_variables()`
#' `gefs_variables()`.
#' @param lat the latitude. Values must be sequential and are rounded to the
#' nearest GEFS available latitude.
#' @param lon the longitude. Values must be sequential and are rounded to the
Expand All @@ -25,7 +25,7 @@
#' included between lat, lon, ens, and time.
#' @param raw logical to indicate whether to return raw data matrix or
#' reshaped data frame.
#' @param ... additional parameters passed to `ncvar_get`
#' @param ... additional parameters passed to the connection.
#' @return a list containing metadata and accompanying data frame of
#' forecast values. If lat/lon are not specified, the $data is an
#' unprocessed matrix.
Expand Down Expand Up @@ -102,7 +102,6 @@ gefs_CONNECT <- function(date = format(Sys.time(), "%Y%m%d"),
gefs_url <- paste0(gefs_url_pre, date, "_", forecast_time, gefs_url_suf)

#open the connection
#nc_open(gefs_url) #ncdf4 version
ncdf4::nc_open(gefs_url)
}

Expand Down Expand Up @@ -133,7 +132,8 @@ gefs_GET <- function(var, lat = NULL, lon = NULL, ens = NULL, time = NULL,
con <- gefs_CONNECT(date, forecast_time)

# Rename extra dimensions, to be changed later
if (!is.null(dims)) { warning("Can't select additional dimensions yet.",
if (!is.null(dims)) {
warning("Can't select additional dimensions yet.",
.call = FALSE)
} else {
additional_dims <- dims
Expand Down Expand Up @@ -171,14 +171,20 @@ gefs_GET <- function(var, lat = NULL, lon = NULL, ens = NULL, time = NULL,
if(!is.null(ens_idx)) {
d_idx <- which(dim_names == "ens")
if(!is.null(ens_idx)) message("'ens_idx' is deprecated and will be removed in future versions, please specify values (not indices) in 'ens' instead.")
if(!any(ens_idx %in% 1:v$dim[[d_idx]]$len)) stop("'ens_idx' is out of bounds, check the dimension values with 'gefs_dimension_values(dim = 'ens').")
if(!any(ens_idx %in% 1:v$dim[[d_idx]]$len)) {
ncdf4::nc_close(con)
stop("'ens_idx' is out of bounds, check the dimension values with 'gefs_dimension_values(dim = 'ens').")
}
dim_idxs[['ens']] <- ens_idx
}
if(!is.null(time_idx)) {
time_name <- grep("time", dim_names, value = TRUE)
d_idx <- which(dim_names %in% time_name)
if(!is.null(time_idx)) message("'time_idx' is deprecated and will be removed in future versions, please specify values (not indices) in 'time' instead.")
if(!any(time_idx %in% 1:v$dim[[d_idx]]$len)) stop("'time_idx' is out of bounds, check the dimension values with 'gefs_dimension_values(dim = 'time').")
if(!any(time_idx %in% 1:v$dim[[d_idx]]$len)) {
ncdf4::nc_close(con)
stop("'time_idx' is out of bounds, check the dimension values with 'gefs_dimension_values(dim = 'time').")
}
dim_idxs[[time_name]] <- time_idx
}

Expand All @@ -190,6 +196,7 @@ gefs_GET <- function(var, lat = NULL, lon = NULL, ens = NULL, time = NULL,

##ncdf4 version
d_raw <- ncdf4::ncvar_get(con, v, start = start, count = count_n, ...)
ncdf4::nc_close(con)

#create the data frame
#For now, if lat/lon are not specified, just return a matrix.
Expand All @@ -216,61 +223,101 @@ gefs_GET <- function(var, lat = NULL, lon = NULL, ens = NULL, time = NULL,

#' @export
#'
#' @param con an ncdf4 connection.
#' @param ... connection parameters passed to \code{gefs_dimension_values()}.
#' @rdname gefs
gefs_latitudes <- function(...) {
gefs_dimension_values(dim = "lat", ...)
}

#' @export
#'
#' @param ... connection parameters passed to \code{gefs_dimension_values()}.
#' @rdname gefs
gefs_latitudes <- function(con = NULL, ...) {
gefs_dimension_values("lat", con)
gefs_longitudes <- function(...) {
gefs_dimension_values(dim = "lon", ...)
}

#' @export
#'
#' @param ... connection parameters passed to \code{gefs_dimension_values()}.
#' @rdname gefs
gefs_longitudes <- function(con = NULL, ...) {
gefs_dimension_values("lon", con)
gefs_ensembles <- function(...) {
gefs_dimension_values(dim = "ens", ...)
}

#' @export
#'
#' @param ... connection parameters passed to \code{gefs_dimension_values()}.
#' @rdname gefs
gefs_variables <- function(con = NULL, ...) {
if (is.null(con)) con = gefs_CONNECT(...)
names(con$var)
gefs_times <- function(...) {
gefs_dimension_values(dim = "time", ...)
}

#' @export
#'
#' @param ... connection parameters passed to \code{gefs_dimension_values()}.
#' @rdname gefs
gefs_dimensions <- function(con = NULL, ...) {
if (is.null(con)) con = gefs_CONNECT(...)
names(con$dim)
gefs_variables <- function(...) {
con = gefs_CONNECT(...)
vars <- names(con$var)
ncdf4::nc_close(con)
vars
}

#' @export
#'
#' @param dim (character) the dimension.
#' @param var (character) the variable for which to get dimensions.
#' @rdname gefs
gefs_dimension_values <- function(dim, var = NULL, con = NULL, ...) {
gefs_dimensions <- function(var = NULL, ...) {

con = gefs_CONNECT(...)
if(is.null(var)) {
dims <- names(con$dim)
} else {
v <- con$var[[var]]
dims <- sapply(v$dim, function(d) { d$name })
}
ncdf4::nc_close(con)
dims

}

#' @export
#'
#' @param dim (character) the dimension to fetch values for.
#' @param var (character) the variable for which to get dimension values for.
#' @param ... additional parameters.
#' @rdname gefs
gefs_dimension_values <- function(dim, var = NULL, ...) {
if (missing(dim)) stop("dim cannot be NULL or missing.")
if (is.null(con)) con = gefs_CONNECT(...)

con = gefs_CONNECT(...)

if (!(dim %in% names(con$dim))) {
stop(paste0(dim, " is not a valid GEFS dimension. Check with 'gefs_dimensions()'."))
ncdf4::nc_close(con)
stop(paste0(dim, " is not a valid GEFS dimension. Get valid dimensions with 'gefs_dimensions()'."))
}

if (!is.null(var)) {
v <- con$var[[var]]
dim_names <- sapply(v$dim, function(d) { d$name })

# there are multiple "time" dimensions, so get the one for this variable
if(dim == "time") dim <- grep("time", dim_names, value = TRUE)

if(!(dim %in% dim_names)) stop(paste0(dim,
" is not in variable dimensions: ",
paste0(dim_names, collapse = ", "),
"."))

if(grepl("time", dim)) dim <- grep("time", dim_names, value = TRUE)
if(!(dim %in% dim_names)) {
ncdf4::nc_close(con)
stop(paste0(dim,
" is not in variable dimensions: ",
paste0(dim_names, collapse = ", "),
"."))
}

dim_idx <- which(dim_names == dim)
res = con$var[[var]]$dim[[dim_idx]]$vals
} else {
res <- con$dim[[dim]]$vals
}
ncdf4::nc_close(con)
res
}

38 changes: 29 additions & 9 deletions man/gefs.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading