Prepare for new normals

ropensci · Nov 12, 2024 · 2b8f404 · 2b8f404
1 parent 47f9fe0
commit 2b8f404
Show file tree

Hide file tree

Showing 4 changed files with 61 additions and 14 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,7 @@
 
 # weathercan 0.7.2
 - Fix normals to work with new ECCC data format
+- Prepare `normals_dl()` and family for new 1991-2020 normals
 
 # weathercan 0.7.1
 - `stations()` now uses the most recent version of the data even if it hasn't changed

diff --git a/R/stations.R b/R/stations.R
@@ -28,23 +28,24 @@
 #'   \item{interval}{Interval of the data measurements ('hour', 'day', 'month')}
 #'   \item{start}{Starting year of data record}
 #'   \item{end}{Ending year of data record}
-#'   \item{normals}{Whether current climate normals are available for that station}
+#'   \item{normals}{Whether *any* climate normals are available for that station (new behaivour)}
+#'   \item{normals_1991_2020}{Whether 1991-2020 climate normals are available for that station. **Note** that even if available, these are not yet downloadable via weathercan.}
 #'   \item{normals_1981_2010}{Whether 1981-2010 climate normals are available for that station}
-#'   \item{normals_1971_2000}{Whether 1981-2010 climate normals are available for that station}
+#'   \item{normals_1971_2000}{Whether 1971-2000 climate normals are available for that station}
 #' }
 #' @source \url{https://climate.weather.gc.ca/index_e.html}
 #'
 #' @export
 #'
 #' @examplesIf check_eccc()
-#'
 #' stations()
 #' stations_meta()
 #'
+#' # Which Manitoba stations have *any* climate normals?
+#'
 #' library(dplyr)
 #' filter(stations(), interval == "hour", normals == TRUE, prov == "MB")
-#'
-#'
+
 stations <- function() {
 
   if(abs(difftime(stations_meta()$weathercan_modified,
@@ -79,7 +80,7 @@ stations_read <- function() {
     local_file <- stations_file() %>%
       readr::read_rds()
     # If pkg version is newer than local, use pkg else use local
-    if(pkg_file$meta$ECCC_modified > local_file$meta$ECCC_modified) {
+    if(pkg_file$meta$weathercan_modified > local_file$meta$weathercan_modified) {
       r <- pkg_file
     } else {
       r <- local_file
@@ -300,7 +301,8 @@ stations_dl_internal <- function(skip = NULL, verbose = FALSE, quiet = FALSE,
     dplyr::left_join(normals, by = c("station_name", "climate_id")) %>%
     dplyr::mutate(dplyr::across(dplyr::contains("normals"),
                                 ~tidyr::replace_na(., FALSE)),
-                  normals = .data$normals_1981_2010) %>%
+                  normals = purrr::pmap_lgl(dplyr::pick(dplyr::starts_with("normals_")),
+                                           any)) %>%
     dplyr::relocate(dplyr::contains("normals_"), .after = dplyr::last_col())
 
 
@@ -530,13 +532,13 @@ normals_stn_list <- function(yr) {
   get_check(getOption("weathercan.urls.stations.normals"),
             query = list(yr = yr)) %>%
     httr::content(type = "text/csv", col_types = readr::cols(),
-                  encoding = "Latin1") %>%
+                  encoding = "Latin1", progress = FALSE) %>%
     dplyr::rename_with(tolower) %>%
     dplyr::select(dplyr::any_of(c("station_name", "climate_id")))
 }
 
 stations_normals <- function() {
-  dplyr::tibble(years = c("1981-2010", "1971-2000")) %>%
+  dplyr::tibble(years = c("1991-2020", "1981-2010", "1971-2000")) %>%
     dplyr::mutate(yr = stringr::str_extract(.data$years, "^[0-9]{4}"),
                   stns = purrr::map(.data$yr, normals_stn_list)) %>%
     tidyr::unnest("stns") %>%

diff --git a/tests/testthat/test_03_station_dl.R b/tests/testthat/test_03_station_dl.R
@@ -36,7 +36,9 @@ vcr::use_cassette("stations_normals", {
 
     expect_gt(nrow(n), 1500)
     expect_named(n, c("station_name", "climate_id",
-                      "normals_1981_2010", "normals_1971_2000"))
+                      "normals_1991_2020",
+                      "normals_1981_2010",
+                      "normals_1971_2000"))
   })
 })
 

diff --git a/tests/testthat/test_08_normals.R b/tests/testthat/test_08_normals.R
@@ -1,6 +1,19 @@
 
 # normals_html() ------------------------------------------------------------
 
+test_that("normals_html() correctly retrieves request 1991-2020", {
+  skip("New normals not ready yet")
+  skip_on_cran()
+  skip_if_offline()
+
+  expect_silent(nd <- normals_html(station_id = 3471, climate_id = "5010480",
+                                   normals_years = "1991-2020", prov = "MB"))
+
+  expect_s3_class(nd, "response")
+  expect_false(httr::http_error(nd))
+  expect_gt(length(nd$content), 10000)
+})
+
 test_that("normals_html() correctly retrieves request 1981-2010", {
   skip_on_cran()
   skip_if_offline()
@@ -190,24 +203,54 @@ test_that("normals_dl() downloads normals/frost dates as tibble - single", {
   memoise::forget(normals_html) # Reset cache so we can test fully
 
   # 1981-2010
-  expect_silent(nd1 <- normals_dl(climate_id = "5010480")) %>%
+  expect_silent(nd1 <- normals_dl(climate_id = "5010480",
+                                  normals_years = "1981-2010")) %>%
     expect_s3_class("tbl_df")
 
   # 1971-2000
   expect_silent(nd2 <- normals_dl(climate_id = "5010480",
-                                 normals_years = "1971-2000")) %>%
+                                  normals_years = "1971-2000")) %>%
     expect_s3_class("tbl_df")
 
   expect_snapshot_value(nd1, style = "json2", tolerance = 0.001)
   expect_snapshot_value(nd2, style = "json2", tolerance = 0.001)
+
+
+  skip("New normals not ready yet")
+  # 1991-2020
+  expect_silent(nd1 <- normals_dl(climate_id = "5010480",
+                                  normals_years = "1991-2020")) %>%
+    expect_s3_class("tbl_df")
+})
+
+test_that("normals_dl() downloads normals/frost dates as tibble - multi 1991", {
+  skip("New normals not ready yet")
+  skip_on_cran()
+  skip_if_offline()
+
+  expect_silent(nd <- normals_dl(climate_id = c("2403500", "5010480",
+                                                "1096450"),
+                                 normals_years = "1991-2020")) %>%
+    expect_s3_class("tbl_df")
+
+  expect_equal(nrow(nd), 3)
+  expect_s3_class(tidyr::unnest(nd, normals), "data.frame")
+  expect_s3_class(tidyr::unnest(nd, frost), "data.frame")
+  expect_length(tidyr::unnest(nd, normals) %>%
+                  dplyr::pull(climate_id) %>%
+                  unique(), 3)
+  expect_length(tidyr::unnest(nd, frost) %>%
+                  dplyr::pull(climate_id) %>%
+                  unique(), 0)
 })
 
 test_that("normals_dl() downloads normals/frost dates as tibble - multi 1981", {
   skip_on_cran()
   skip_if_offline()
 
   expect_silent(nd <- normals_dl(climate_id = c("2403500", "5010480",
-                                                "1096450"))) %>%
+                                                "1096450"),
+                                 normals_years = "1981-2010")) %>%
     expect_s3_class("tbl_df")
 
   expect_equal(nrow(nd), 3)
@@ -221,7 +264,6 @@ test_that("normals_dl() downloads normals/frost dates as tibble - multi 1981", {
                   unique(), 3)
 })
 
-
 test_that("normals_dl() downloads normals/frost dates as tibble - multi 1971", {
   skip_on_cran()
   skip_if_offline()