Merge pull request #179 from ropensci/dev

Author: steffilazerte

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: weathercan
 Type: Package
 Title: Download Weather Data from Environment and Climate Change Canada
-Version: 0.7.5
+Version: 0.7.6
 Authors@R: c(
      person("Steffi", "LaZerte", email = "sel@steffilazerte.ca", role = c("aut","cre"), comment = c(ORCID = "0000-0002-7690-8360")),
      person("Sam", "Albers", email = "sam.albers@gmail.com", role = c("ctb"), comment = c(ORCID = "0000-0002-9270-7884")),

NEWS.md

@@ -1,3 +1,8 @@
+# weathercan 0.7.6
+- Standardize normals year range and checks
+- Fix bug in `stations_search()` that precluded doing normals and years searches at the same time
+- Change `stations_search()` output to include interval, start and end years
+
 # weathercan 0.7.5
 - Fix province names for stations data frame (#175)
 - Don't allow start times earlier than 1840 (earliest API will return; #174)

R/normals.R

@@ -10,8 +10,10 @@
 #'   data frame or the \code{\link{stations_search}} function to find Climate
 #'   IDs.
 #' @param normals_years Character. The year range for which you want climate
-#'   normals. Default "1981-2010". One of "1971-2000", "1981-2010", "1991-2020".
-#'   Note: Some "1991-2020" are available online, but are not yet downloadable
+#'   normals. Default `1981-2010`. One of `current`,
+#'   `1981-2010`, or `1971-2000`. `current` returns only stations
+#'   from the most recent *complete* normals year range (i.e. `1981-2010`).
+#'   Note: Some `1991-2020` are available online, but are not yet downloadable
 #'   via weathercan.
 #' @param format Logical. If TRUE (default) formats measurements to numeric and
 #'   date accordingly. Unlike `weather_dl()`, `normals_dl()` will always format
@@ -79,7 +81,7 @@
 #'   unnest(frost)
 #' @export
 
-normals_dl <- function(climate_ids, normals_years = "1981-2010",
+normals_dl <- function(climate_ids, normals_years = "current",
                        format = TRUE, stn = NULL,
                        verbose = FALSE, quiet = FALSE) {
 
@@ -91,13 +93,8 @@ normals_dl <- function(climate_ids, normals_years = "1981-2010",
   }
   stn <- stations()
 
-  if(normals_years == "1991-2020") {
-    stop("The new normals for 1991-2020 are not yet available via weathercan",
-         call. = FALSE)
-  }
-
   check_ids(climate_ids, stn, type = "climate_id")
-  check_normals(normals_years)
+  normals_years <- check_normals(normals_years)
 
   yrs <- paste0("normals_", stringr::str_replace(normals_years, "-", "_"))
 

R/stations.R

@@ -423,47 +423,35 @@ stations_search <- function(name = NULL,
   }
 
   check_int(interval)
-
   stn <- dplyr::filter(stations(),
                        .data$interval %in% !! interval, !is.na(.data$start))
 
+  normals_years <- check_normals(normals_years, null_ok = TRUE)
   if(!is.null(normals_years)) {
-
-    if(normals_years == "1991-2020") {
-      message(
-        "You can find out which stations have normals for 1991-2020, ",
-        "but be aware that they are not yet available for download via weathercan")
-    }
-
-    if(normals_years == "current") {
-      yr <- "normals_1981_2010"  # Currently set Normals
-    } else {
-      yr <- paste0("normals_", stringr::str_replace(normals_years, "-", "_"))
-    }
+    yr <- paste0("normals_", stringr::str_replace(normals_years, "-", "_"))
     stn <- dplyr::filter(stn, .data[[yr]])
-  } else {
-
-    if (!is.null(starts_latest)){
-      suppressWarnings({
-        starts_latest <- try(as.numeric(as.character(starts_latest)),
-                             silent = TRUE)
-      })
-      if (is.na(starts_latest) | inherits(starts_latest, "try-error")){
-        stop("'starts_latest' needs to be coercible into numeric", call. = FALSE)
-      }
-      stn <- dplyr::filter(stn, .data$start <= starts_latest)
+  }
+  
+  if (!is.null(starts_latest)){
+    suppressWarnings({
+      starts_latest <- try(as.numeric(as.character(starts_latest)),
+      silent = TRUE)
+    })
+    if (is.na(starts_latest) | inherits(starts_latest, "try-error")){
+      stop("'starts_latest' needs to be a year (YYYY)", call. = FALSE)
     }
-
-    if (!is.null(ends_earliest)){
-      suppressWarnings({
-        ends_earliest <- try(as.numeric(as.character(ends_earliest)),
-                             silent = TRUE)
-      })
-      if (is.na(ends_earliest) | inherits(ends_earliest, "try-error")){
-        stop("'ends_earliest' needs to be coercible into numeric", call. = FALSE)
-      }
-      stn <- dplyr::filter(stn, .data$end >= ends_earliest)
+    stn <- dplyr::filter(stn, .data$start <= starts_latest)
+  }
+  
+  if (!is.null(ends_earliest)){
+    suppressWarnings({
+      ends_earliest <- try(as.numeric(as.character(ends_earliest)),
+      silent = TRUE)
+    })
+    if (is.na(ends_earliest) | inherits(ends_earliest, "try-error")){
+      stop("'ends_earliest' needs to be a year (YYYY)", call. = FALSE)
     }
+    stn <- dplyr::filter(stn, .data$end >= ends_earliest)
   }
 
   if(!is.null(name)) {
@@ -519,10 +507,7 @@ stations_search <- function(name = NULL,
                                              .data$station_name,
                                              .data$station_id,
                                              .data$interval)
-  if(!is.null(normals_years)) {
-    stn <- dplyr::select(stn, -"interval", -"start", -"end") %>%
-      dplyr::distinct()
-  }
+
   stn
 }
 

R/utils.R

@@ -32,12 +32,31 @@ check_ids <- function(ids, stn, type){
   }
 }
 
-check_normals <- function(normals_years) {
- if(!is.character(normals_years) ||
-    !stringr::str_detect(normals_years, "^[0-9]{4}-[0-9]{4}$")) {
-   stop("'normals_years' must be a text string in the format YYYY-YYYY e.g., '1981-2010'",
-        call. = FALSE)
- }
+check_normals <- function(normals_years, null_ok = FALSE) {
+
+  if(null_ok && is.null(normals_years)) return(normals_years)
+
+  if(normals_years == "current") {
+    message("The most current normals available for download by weathercan are '1981-2010'")
+    normals_years <- "1981-2010"
+  }
+
+  if(!null_ok) new_message <- stop else new_message <- message
+
+  if(normals_years == "1991-2020") {
+    new_message(
+      "You use `stations_search()` to see which stations have normals for 1991-2020, ",
+      "but be aware that they are not yet available for download via weathercan")
+  }
+  
+  if(is.null(normals_years) || 
+    !is.character(normals_years) ||
+    !stringr::str_detect(normals_years, "^[0-9]{4}-[0-9]{4}$")
+  ) {
+    stop("'normals_years' must be either 'current' or a text string in the format YYYY-YYYY e.g., '1981-2010'",
+    call. = FALSE)
+  }
+  normals_years
 }
 
 find_line <- function(headings, cols) {

man/normals_dl.Rd

@@ -256,10 +256,12 @@ test_that("stations_search 'starts_latest' and 'ends_earliest' together", {
 test_that("stations_search returns normals only", {
   expect_warning(s <- stations_search("Brandon", normals_only = TRUE),
                  "`normals_only` is deprecated")
-  expect_silent(s <- stations_search("Brandon", normals_years = "current"))
+  expect_message(
+    s <- stations_search("Brandon", normals_years = "current"),
+    "The most current normals available for download by weathercan are"
+  )
   expect_gt(nrow(stations()), nrow(s))
   expect_true(all(s$normals))
-  expect_equal(unique(s$station_id), s$station_id)
 
   expect_silent(s1 <- stations_search("Brandon", normals_years = "1981-2010"))
   expect_gt(nrow(stations()), nrow(s1))

tests/testthat/test_03_station_dl.R

@@ -309,14 +309,14 @@ test_that("normals_dl() gets extreme wind chill correctly", {
   skip_on_cran()
   skip_if_offline()
 
-  expect_silent(nd <- normals_dl(climate_id = "2100517")) %>%
-    expect_s3_class("tbl_df")
+  expect_message(nd <- normals_dl(climate_id = "2100517"), "current normals")
+  expect_s3_class(nd, "tbl_df")
 })
 
 test_that("normals_dl() multiple weird stations", {
   skip_on_cran()
   skip_if_offline()
-  expect_silent(nd <- normals_dl(climate_ids = c("301C3D4", "301FFNJ", "301N49A")))
+  expect_message(nd <- normals_dl(climate_ids = c("301C3D4", "301FFNJ", "301N49A")), "current normals")
 
   expect_snapshot_value(nd, style = "json2", tolerance = 0.001)
 })