Vectors ghcnd

R/ghcnd.R

@@ -6,8 +6,8 @@
 #' entire weather dataset for the site.
 #'
 #' @export
-#' @param stationid (character) A character string giving the identification of
-#' the weather station for which the user would like to pull data. To get a full
+#' @param stationid (character) A character vector giving the identification of
+#' the weather stations for which the user would like to pull data. To get a full
 #' and current list of stations, the user can use the [ghcnd_stations()]
 #' function. To identify stations within a certain radius of a location, the
 #' user can use the [meteo_nearby_stations()] function.
@@ -100,22 +100,30 @@
 #' # ghcnd(stations$id[58], verbose = TRUE)
 #' }
 ghcnd <- function(stationid, refresh = FALSE, ...) {
-  csvpath <- ghcnd_local(stationid)
-  if (!is_ghcnd(x = csvpath) || refresh) {
-    res <- ghcnd_GET(stationid, ...)
-  } else {
-    cache_mssg(csvpath)
-    res <- read.csv(csvpath, stringsAsFactors = FALSE,
-                    colClasses = ghcnd_col_classes)
-  }
-  fi <- file.info(csvpath)
-  res <- remove_na_row(res) # remove trailing row of NA's
-  res <- tibble::as_tibble(res)
-  attr(res, 'source') <- csvpath
-  attr(res, 'file_modified') <- fi[['mtime']]
-  return(res)
+  out <- lapply(stationid, function(this_station) {
+    csvpath <- ghcnd_local(this_station)
+    if (!is_ghcnd(x = csvpath) || refresh) {
+      res <- ghcnd_GET(this_station, ...)
+    } else {
+      cache_mssg(csvpath)
+      res <- read.csv(csvpath, stringsAsFactors = FALSE,
+                      colClasses = ghcnd_col_classes)
+    }
+    fi <- file.info(csvpath)
+    res <- remove_na_row(res) # remove trailing row of NA's
+    res <- tibble::as_tibble(res)
+    attr(res, 'source') <- csvpath
+    attr(res, 'file_modified') <- fi[['mtime']]
+    return(res)
+  })
+
+  res <- tibble::as_tibble(data.table::rbindlist(out))
+  attr(res, 'source') <- unlist(lapply(out, function(x) attr(x, "source")))
+  attr(res, 'file_modified') <- unlist(lapply(out, function(x) attr(x, "file_modified")))
+  res
 }
 
+
 #' @export
 #' @rdname ghcnd
 ghcnd_read <- function(path, ...) {

tests/testthat/test-ghcnd.R

@@ -37,12 +37,15 @@ test_that("search for data", {
   skip_on_cran()
   skip_on_ci()
   skip_if_government_down()
-
+
+  stations <- sort(c("ACW00011604", "ACW00011647", "AE000041196", "AGE00147704"))
+
   search_a <- ghcnd_search("AGE00147704", var = "PRCP")
   search_b <- ghcnd_search("AGE00147704", var = "PRCP", date_min = "1920-01-01")
   search_c <- ghcnd_search("AGE00147704", var = "PRCP", date_min = "1920-01-01", date_max = "1925-01-01")
   search_d <- ghcnd_search("AGE00147704", var = c("PRCP","TMIN"), date_min = "1920-01-01")
-
+  search_vector <- ghcnd_search(stations, var = "PRCP")
+
   expect_is(search_a, "list")
   expect_is(search_a$prcp, "tbl_df")
   expect_is(search_b$prcp, "data.frame")
@@ -55,8 +58,13 @@ test_that("search for data", {
   expect_named(search_d, c("prcp", "tmin"))
 
   expect_lt(NROW(search_b$prcp), NROW(search_a$prcp))
+
+  expect_equal(sort(unique(search_vector$prcp$id)), stations)
+  expect_equal(search_a$prcp, search_vector$prcp[search_vector$prcp$id == "AGE00147704", ])
 })
 
+
+
 test_that("get data", {
   skip_on_cran()
   skip_on_ci()
@@ -66,6 +74,7 @@ test_that("get data", {
   bb <- ghcnd(stationid = "AGE00135039")
   cc <- ghcnd(stationid = "ASN00008264")
 
+
   expect_is(aa, "tbl_df")
   expect_is(bb, "tbl_df")
   expect_is(cc, "tbl_df")
@@ -88,6 +97,32 @@ test_that("get data", {
   expect_lt(NROW(cc), NROW(bb))
 })
 
+
+
+test_that("ghnc accepts vector input", {
+  skip_on_cran()
+  skip_on_ci()
+  skip_if_government_down()
+
+  stations <- c("ACW00011604", "ACW00011647", "AE000041196")
+  data <- ghcnd(stations)
+
+  expect_is(data, "tbl_df")
+  expect_equal(unique(data$id), stations)
+
+})
+
+test_that("meteo_tidy_ghcnd accepts vector input", {
+  stations <- c("ACW00011604", "ACW00011647", "AE000041196")
+  data <- meteo_tidy_ghcnd(stations)
+
+  expect_is(data, "tbl_df")
+  expect_is(data, "data.frame")
+  expect_equal(unique(data$id), stations)
+})
+
+
+
 test_that("alternative base urls", {
   expect_equal(Sys.getenv("RNOAA_GHCND_BASE_URL"), "")
 
@@ -96,3 +131,6 @@ test_that("alternative base urls", {
 
   Sys.unsetenv("RNOAA_GHCND_BASE_URL")
 })
+
+
+