remove leftover connection files from errors and add dimension conven…

…ience functions.
ropensci · Oct 31, 2019 · b73b306 · b73b306
1 parent 3df65df
commit b73b306
Show file tree

Hide file tree

Showing 4 changed files with 157 additions and 56 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -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)

diff --git a/R/gefs.R b/R/gefs.R
@@ -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
@@ -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.
@@ -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)
 }
 
@@ -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
@@ -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
   }
 
@@ -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.
@@ -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
 }
 
diff --git a/man/gefs.Rd b/man/gefs.Rd
diff --git a/tests/testthat/test-gefs.R b/tests/testthat/test-gefs.R
@@ -1,11 +1,16 @@
 context("gefs")
 
+# Get the temporary directory
+temp_dir <- dirname(tempdir())
+nc_temp_files <- list.files(temp_dir, pattern = "^occookie")
+
+
 #set a location
 lons <- c(-1.1, 0, 0.8, 2)
 lats <- c(50.1, 51, 51.9, 53, 54)
 
 #variable
-temp = "Temperature_height_above_ground_ens"
+temp <- "Temperature_height_above_ground_ens"
 
 test_that("gefs errors", {
   skip_on_cran()
@@ -116,59 +121,86 @@ test_that("gefs_variables returns characters.", {
   expect_is(vars[1], "character")
 })
 
-test_that("gefs_latitudes returns numeric.", {
+test_that("gefs_latitudes, gefs_longitudes, gefs_ensembless, gefs_times", {
   skip_on_cran()
   skip_on_travis()
   skip_on_appveyor()
   skip_on_os("windows")
 
-  lats = gefs_latitudes()
+  lats <-  gefs_latitudes()
   expect_is(lats, "array")
   expect_is(lats[1], "numeric")
-})
-
-test_that("gefs_longitudes returns numeric.", {
-  skip_on_cran()
-  skip_on_travis()
-  skip_on_appveyor()
-  skip_on_os("windows")
+  expect_equal(lats, array(90:-90))
 
-  lons = gefs_longitudes()
+  #vlats <- gefs_latitudes(var = temp)
+
+  lons <-  gefs_longitudes()
   expect_is(lons, "array")
   expect_is(lons[1], "numeric")
+  expect_equal(lons, array(0:359))
+
+  #vlons <- gefs_longitudes(var = temp)
+
+  enss <-  gefs_ensembles()
+  expect_is(enss, "array")
+  expect_is(enss[1], "integer")
+  expect_equal(enss, array(0:20))
+
+  #venss <- gefs_ensembles(var = temp)
+
+  times <-  gefs_times()
+  expect_is(times, "array")
+  expect_is(times[1], "numeric")
+  expect_equal(times, array(seq(0,384, by = 6)))
+
+  #vlons <- gefs_times(var = temp)
 })
 
-test_that("gefs_dimensions returns character list.", {
+test_that("gefs_dimensions", {
   skip_on_cran()
   skip_on_travis()
   skip_on_appveyor()
   skip_on_os("windows")
 
-  dims = gefs_dimensions()
+  dims <- gefs_dimensions()
   expect_is(dims, "character")
   expect_is(dims[1], "character")
+
+  vdims <- gefs_dimensions(var = temp)
+  expect_true(all(vdims %in% c("lon", "lat", "height_above_ground", "ens",
+                               "time", "time1", "time2")))
 })
 
 test_that("gefs_dimension_values errors", {
   skip_on_os("windows")
+
 
-  expect_error(gefs_dimension_values(dim = "time2", var = temp),
-    "time2 is not in variable dimensions: lon, lat, height_above_ground, ens, time1.",
-    fixed = TRUE)
   expect_error(gefs_dimension_values(),
     "dim cannot be NULL or missing.", fixed = TRUE)
   expect_error(gefs_dimension_values(dim = "ens1"),
-    "ens1 is not a valid GEFS dimension. Check with 'gefs_dimensions()'.",
+    "ens1 is not a valid GEFS dimension. Get valid dimensions with 'gefs_dimensions()'.",
     fixed = TRUE)
+
+  tempdims <- gefs_dimensions(var = temp)
+  expect_error(gefs_dimension_values(dim = "isobaric3", var = temp),
+               paste0("isobaric3 is not in variable dimensions: ",
+                      paste0(tempdims, collapse = ", "),
+                      "."),
+               fixed = TRUE)
 })
 
-test_that("gefs_dimension_values returns numeric array.", {
+test_that("gefs_dimension_values", {
   skip_on_cran()
   skip_on_travis()
   skip_on_appveyor()
   skip_on_os("windows")
 
-  vals = gefs_dimension_values("lat")
+  vals <- gefs_dimension_values("lat")
   expect_is(vals, "array")
   expect_is(vals[1], "numeric")
 })
+
+test_that("no remaining connection temp files exist", {
+  nc_temp_files2 <- list.files(temp_dir, pattern = "^occookie")
+  expect_equal(nc_temp_files, nc_temp_files2)
+})