202 open pvol data for the uk

NEWS.md

@@ -2,6 +2,7 @@
 
 * Use options for urls so they can be changes without a package update (#120).
 * Add `getRad.progress` option to silence progress.
+* Support reading data from the United Kingdom (#202).
 
 # getRad 0.3.0
 

R/get_pvol.R

@@ -24,7 +24,10 @@
 #'   - A [lubridate::interval()] or two [`POSIXct`][base::DateTimeClasses],
 #'   between which all data files are downloaded.
 #' @param ... Additional arguments passed on to reading functions, for example
-#'   `param = c("DBZH", "VRADH")` to the [bioRad::read_pvolfile()].
+#'   `param = c("DBZH", "VRADH")` to the [bioRad::read_pvolfile()]. For date
+#'   from the United Kingdom the option exist to select either short pulse or
+#'   long pulse data using `pulse_type = "sp"` or `pulse_type = "lp"`. By
+#'   default long pulse data is read.
 #' @returns Either a polar volume or a list of polar volumes. See
 #'   [bioRad::summary.pvol()] for details.
 #' @export

R/get_pvol_uk.R

@@ -1,48 +1,85 @@
-get_pvol_uk <- function(radar, time, pulse_type=c("lp", "sp"), ..., call = rlang::caller_env()) {
-  uk_odim_map<-c(ukcle = "clee-hill",
-                 ukham = "hameldon-hill",
-                 ukche = "chenies",
-                 ukcas = "castor-bay",
-                 ukpre = "predannack",
-                 uking = "ingham",
-                 ukcyg = "crug-y-gorrllwyn",
-                 ukhhd = "holehead",
-                 ukjer = "jersey",
-                 ukdud = "dudwick",
-                 uklew = "druima-starraig",
-                 ukcob = "cobbacombe",
-                 ukdea = "deanhill",
-                 ukthu = "thurnham",
-                 ukmun = "munduff-hill",
-                 ukhmy = "high-moorsley")
-  uk_odim_map_radar_number<-c(ukcle = 3,
-                 ukham = 4,
-                 ukche = 5,
-                 ukcas = 7,
-                 ukpre = 8,
-                 uking = 9,
-                 ukcyg = 10,
-                 ukhhd = 18,
-                 ukjer = 12,
-                 ukdud = 14,
-                 uklew = 15,
-                 ukcob = 16,
-                 ukdea = 21,
-                 ukthu = 20,
-                 ukmun = 19,
-                 ukhmy = 23)
-  pulse_type<- rlang::arg_match(pulse_type)
-  # TODO wardon-hill code 11 no odim coe
+get_pvol_uk <- function(
+  radar,
+  time,
+  pulse_type = c("lp", "sp"),
+  ...,
+  call = rlang::caller_env()
+) {
+  radar_name <- radar_recode(
+    radar,
+    call = call,
+    ukcle = "clee-hill",
+    ukham = "hameldon-hill",
+    ukche = "chenies",
+    ukcas = "castor-bay",
+    ukpre = "predannack",
+    uking = "ingham",
+    ukcyg = "crug-y-gorrllwyn",
+    ukhhd = "holehead",
+    ukjer = "jersey",
+    ukdud = "dudwick",
+    uklew = "druima-starraig",
+    ukcob = "cobbacombe",
+    ukdea = "deanhill",
+    ukthu = "thurnham",
+    ukmun = "munduff-hill",
+    ukhmy = "high-moorsley"
+  )
+  radar_number <- radar_recode(
+    radar,
+    call = call,
+    ukcle = 3,
+    ukham = 4,
+    ukche = 5,
+    ukcas = 7,
+    ukpre = 8,
+    uking = 9,
+    ukcyg = 10,
+    ukhhd = 18,
+    ukjer = 12,
+    ukdud = 14,
+    uklew = 15,
+    ukcob = 16,
+    ukdea = 21,
+    ukthu = 20,
+    ukmun = 19,
+    ukhmy = 23
+  )
+  pulse_type <- rlang::arg_match(pulse_type, error_call = call)
+  time <- lubridate::with_tz(time, "UTC")
+  # TODO wardon-hill code 11 no odim code
+  if (pulse_type == "sp" && time != lubridate::floor_date(time, "10 mins")) {
+    cli::cli_abort(
+      call = call,
+      c(
+        x = "Short pulse data is only available every ten minutes.",
+        i = "To resolve round the {.arg time} to the nearest 10 minutes."
+      ),
+      class = "getRad_error_uk_no_sp_data"
+    )
+  }
   withr::with_file("file.h5", {
-    req <- httr2::request(glue::glue(
-      "https://ncas-radar-o.s3-ext.jc.rl.ac.uk/uk-wsr-visualizer-public/ukmo-nimrod/pvol/{uk_odim_map[radar]}/{format(time,'%Y/%m/%d')}/{pulse_type}/{format(time,'%Y%m%d')}_polar_pl_radar{sprintf('%02d', uk_odim_map_radar_number[radar])}_aggregate_{pulse_type}_{format(time,'%H%M')}.h5"
-    )) |>
-      req_user_agent_getrad() |>
-      httr2::req_perform(path = "file.h5", error_call = call)
+    url <- glue::glue(getOption(
+      "getRad.uk_url",
+      "https://ncas-radar-o.s3-ext.jc.rl.ac.uk/uk-wsr-visualizer-public/ukmo-nimrod/pvol/{radar_name}/{format(time,'%Y/%m/%d')}/{pulse_type}/{format(time,'%Y%m%d')}_polar_pl_radar{sprintf('%02d', radar_number)}_aggregate_{pulse_type}_{format(time,'%H%M')}.h5"
+    ))
+    req <- tryCatch(
+      httr2::request(url) |>
+        req_user_agent_getrad() |>
+        httr2::req_perform(path = "file.h5", error_call = call),
+      httr2_http_404 = function(cnd) {
+        cli::cli_abort(
+          c(
+            x = "No data was found for this radar ({.val {radar}}) at the specified search time ({.val {time}})",
+            i = "The url constructed was: {.url {url}}."
+          ),
+          call = call,
+          cnd = cnd,
+          class = "getRad_error_uk_no_data_404"
+        )
+      }
+    )
     pvol <- bioRad::read_pvolfile(req$body, ...)
   })
   return(pvol)
 }
-
-
-

tests/testthat/test-get_pvol_uk.R

@@ -0,0 +1,47 @@
+test_that("Pvol for uk can be downloaded", {
+  skip_if_offline("ncas-radar-o.s3-ext.jc.rl.ac.uk")
+  time <-
+    as.POSIXct("2022-4-1 10:00:00", tz = "Europe/Helsinki")
+  pvol <- expect_s3_class(get_pvol("ukjer", time, param = "all"), "pvol")
+  expect_true(bioRad::is.pvol(pvol))
+  expect_identical(
+    lubridate::floor_date(pvol$datetime, "5 mins"),
+    lubridate::with_tz(time, "UTC")
+  )
+  pvolsp <- expect_s3_class(
+    get_pvol("ukjer", pulse_type = "sp", time, param = "all"),
+    "pvol"
+  )
+  expect_true(bioRad::is.pvol(pvolsp))
+  expect_identical(
+    lubridate::floor_date(pvolsp$datetime, "5 mins"),
+    lubridate::with_tz(time, "UTC")
+  )
+  expect_false(identical(pvol, pvolsp))
+})
+
+test_that("plusetype argument", {
+  expect_error(get_pvol("ukcas", Sys.time(), pulse_type = "ll"), "pulse_type")
+  expect_error(get_pvol("ukcas", Sys.time(), pulse_type = 1), "pulse_type")
+})
+test_that("404 no data", {
+  skip_if_offline("ncas-radar-o.s3-ext.jc.rl.ac.uk")
+  expect_error(
+    get_pvol("ukcas", as.POSIXct("2012-4-1 10:00:10")),
+    class = "getRad_error_uk_no_data_404"
+  )
+  expect_error(
+    get_pvol("ukcos", as.POSIXct("2012-4-1 10:00:10")),
+    class = "getRad_error_radar_not_found"
+  )
+})
+
+test_that("no sp data", {
+  skip_if_offline("ncas-radar-o.s3-ext.jc.rl.ac.uk")
+  time <-
+    as.POSIXct("2022-4-1 10:05:10", tz = "Europe/Helsinki")
+  expect_error(
+    get_pvol("ukcas", time, pulse_type = "sp"),
+    class = "getRad_error_uk_no_sp_data"
+  )
+})