diff --git a/NEWS.md b/NEWS.md index e92fc1c..e6e66dc 100644 --- a/NEWS.md +++ b/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 diff --git a/R/get_pvol.R b/R/get_pvol.R index 1eb859c..f0dd6ff 100644 --- a/R/get_pvol.R +++ b/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 diff --git a/R/get_pvol_uk.R b/R/get_pvol_uk.R index ae70694..ef3a428 100644 --- a/R/get_pvol_uk.R +++ b/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) } - - - diff --git a/man/get_pvol.Rd b/man/get_pvol.Rd index 59bfdfa..42b7a2f 100644 --- a/man/get_pvol.Rd +++ b/man/get_pvol.Rd @@ -20,7 +20,10 @@ between which all data files are downloaded. }} \item{...}{Additional arguments passed on to reading functions, for example -\code{param = c("DBZH", "VRADH")} to the \code{\link[bioRad:read_pvolfile]{bioRad::read_pvolfile()}}.} +\code{param = c("DBZH", "VRADH")} to the \code{\link[bioRad:read_pvolfile]{bioRad::read_pvolfile()}}. For date +from the United Kingdom the option exist to select either short pulse or +long pulse data using \code{pulse_type = "sp"} or \code{pulse_type = "lp"}. By +default long pulse data is read.} } \value{ Either a polar volume or a list of polar volumes. See diff --git a/tests/testthat/test-get_pvol_uk.R b/tests/testthat/test-get_pvol_uk.R new file mode 100644 index 0000000..fff9c4d --- /dev/null +++ b/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" + ) +})