update main

DESCRIPTION

@@ -65,8 +65,8 @@ VignetteBuilder:
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
 Config/Needs/website: 
     rmarkdown,
     leafpop,
     htmltools
+Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -8,3 +8,4 @@ export(get_weather_radars)
 export(set_secret)
 importFrom(dplyr,.data)
 importFrom(lubridate,"%within%")
+importFrom(rlang,.env)

NEWS.md

@@ -1,7 +1,12 @@
 # getRad (development version)
 
+* Implement download of `vpts` data from birdcast by Alexander Tedeschi. 
 * Implement reading `vpts` data from a local directory (#135).
 * Clarify HTTP 429 error for the Netherlands (#165).
+* Clarify error for Estonia and propagate call (#173).
+* Include the hochficht radar in Austria (#169).
+* For Romania match deviating file format (thanks to Sorin Burcea, #167).
+* Fix download for Czechia as multiple scans were found (#183).
 
 # getRad 0.2.4
 

R/getRad-package.R

@@ -3,6 +3,7 @@
 
 ## usethis namespace: start
 #' @importFrom dplyr .data
+#' @importFrom rlang .env
 #' @importFrom lubridate %within%
 ## usethis namespace: end
 NULL

R/get_pvol.R

@@ -38,7 +38,9 @@
 #'   as.POSIXct(Sys.Date())
 #' )
 get_pvol <- function(radar = NULL, datetime = NULL, ...) {
-  check_odim_nexrad(radar)
+  if (!identical(radar, "hochficht")) {
+    check_odim_nexrad(setdiff(radar, 'hochficht'))
+  }
   if (anyDuplicated(radar)) {
     cli::cli_abort(
       "{.arg radar} contains duplications that must be removed.",
@@ -129,9 +131,13 @@ get_pvol <- function(radar = NULL, datetime = NULL, ...) {
 # Helper function to find the function for a specific radar
 # This function is only helpful in get_pvol and therefor not in a utils file
 select_get_pvol_function <- function(radar, ..., call = rlang::caller_env()) {
+  if (radar == "hochficht") {
+    return("get_pvol_hochficht")
+  }
   if (is_nexrad(radar)) {
     return("get_pvol_us")
   }
+
   cntry_code <- substr(radar, 1, 2) # nolint
   fun <- (dplyr::case_when(
     cntry_code == "nl" ~ "get_pvol_nl",

R/get_pvol_at.R

@@ -0,0 +1,29 @@
+get_pvol_hochficht <- function(radar, time, ..., call = rlang::caller_env()) {
+  url <- glue::glue(
+    getOption(
+      "getRad.at_hochficht_url",
+      default = "https://public.hub.geosphere.at/datahub/resources/radar_volumen_hochficht-v1-5min/filelisting/WXRHOF_{strftime(time,'%Y%m%d%H%M', tz='UTC')}.hdf"
+    )
+  )
+  pvol <- withr::with_tempfile("file", fileext = ".h5", {
+    tryCatch(
+      req <-
+        httr2::request(url) |>
+        req_user_agent_getrad() |>
+        httr2::req_perform(path = file, error_call = call),
+      httr2_http_403 = function(cnd) {
+        cli::cli_abort(
+          c(
+            "There is data found for download.",
+            "i" = "Data for the Hochficht radar is only available for the last three days."
+          ),
+          cnd = cnd,
+          class = "getRad_error_get_pvol_at_no_data",
+          call = call
+        )
+      }
+    )
+    bioRad::read_pvolfile(file, ...)
+  })
+  return(pvol)
+}

R/get_pvol_cz.R

@@ -1,7 +1,7 @@
 # http://opendata.chmi.cz/meteorology/weather/radar/sites/ska/vol_z/hdf5/
 
 get_pvol_cz <- function(radar, time, ..., call = rlang::caller_env()) {
-  time_chr <- time_pos <- base <- resp <- NULL
+  time_chr <- time_pos <- base <- NULL
   # All parameters are retrieved from separate files
   # Here all urls are generated
   params <- c("z", "u", "v", "w", "zdr", "rhohv", "phidp")
@@ -37,10 +37,55 @@ get_pvol_cz <- function(radar, time, ..., call = rlang::caller_env()) {
         time,
         time + lubridate::minutes(5)
       )
-    ))
-  pvol <- read_pvol_from_url_per_param(paste0(
-    files_to_get$base,
-    files_to_get$file
+    )) |>
+    dplyr::mutate(url = paste0(base, file))
+  # There are sometimes multiple pvols, generally one with 12 scans
+  # additionally there are (sometimes) scans in separate files for
+  # the 0.3 and 1.5 elevation angle. These are not always both present.
+  # It all seems a bit irregular
+  pvols <- lapply(
+    split(files_to_get$url, files_to_get$time_chr),
+    read_pvol_from_url_per_param
+  )
+  if (length(pvols) == 1) {
+    return(pvols[[1]])
+  }
+  attr <- purrr::map(pvols, purrr::pluck, "attributes") |>
+    purrr::map(purrr::assign_in, where = c("what", "time"), purrr::zap()) |>
+    purrr::map(purrr::assign_in, where = c("what", "date"), purrr::zap()) |>
+    purrr::map(purrr::assign_in, where = c("how", "scan_count"), purrr::zap())
+  if (!all(unlist(lapply(attr[-1], identical, attr[[1]])))) {
+    cli::cli_abort(
+      c(
+        "The attributes of the polar volumes about to be merged differ"
+      ),
+      class = "getRad_error_czechia_attributes_differ",
+      call = call
+    )
+  }
+  pvol <- purrr::pluck(pvols, 1)
+  pvol$scans <- purrr::list_flatten(purrr::map(pvols, "scans"))
+  pvol$attributes$how$scan_count <- length(pvol$scans)
+  pvol$datetime <- max(purrr::map_vec(pvols, "datetime"))
+  pvol$attributes$what$time <- max(purrr::map_vec(
+    pvols,
+    c("attributes", "what", "time")
+  ))
+  pvol$attributes$what$date <- max(purrr::map_vec(
+    pvols,
+    c("attributes", "what", "date")
   ))
-  pvol
+  if (anyDuplicated(get_elevation_angles(pvol))) {
+    # Note that if scanning pattern changes this might flag false positive, but
+    # currently the check is there to prevent falsely merging scans from two iterations
+    # of the scanning pattern
+    cli::cli_abort(
+      c(
+        "There are duplicated elevation angles, likely as a result of merging the wrong scans."
+      ),
+      class = "getRad_error_czechia_duplicated_elevation_angles",
+      call = call
+    )
+  }
+  return(pvol)
 }

R/get_pvol_ee.R

@@ -71,8 +71,9 @@ get_pvol_ee <- function(radar, time, ..., call = rlang::caller_env()) {
     httr2::resp_body_json()
   if (files$numFound == 0 || length(files$documents) != 1) {
     cli::cli_abort(
-      "The expected number of files is not found.",
-      class = "getRad_error_get_pvol_ee_differing_n_files"
+      "The expected number of files is not found for this Estonian Radar. This can occur when no data is available.",
+      class = "getRad_error_get_pvol_ee_differing_n_files",
+      call = call
     )
   }
   pvol <- withr::with_tempfile("file", fileext = ".h5", {

R/get_pvol_ro.R

@@ -3,5 +3,19 @@ get_pvol_ro <- function(radar, time, ..., call = rlang::caller_env()) {
   urls <- glue::glue(
     "https://opendata.meteoromania.ro/radar/{toupper(substr(radar,3,5))}/{toupper(substr(radar,3,5))}_{strftime(time,'%Y%m%d%H%M', tz='UTC')}0200{params}.hdf"
   )
-  read_pvol_from_url_per_param(urls, param = "all", call = call)
+  tryCatch(
+    read_pvol_from_url_per_param(urls, param = "all", call = call),
+    error = function(cnd) {
+      urls_updated <- glue::glue(
+        "https://opendata.meteoromania.ro/radar/{toupper(substr(radar,3,5))}/{toupper(substr(radar,3,5))}_{strftime(time,'%Y%m%d%H%M', tz='UTC')}0300{params}.hdf"
+      )
+      if (
+        rlang::has_name(cnd, "parent") && inherits(cnd$parent, "httr2_http_404")
+      ) {
+        read_pvol_from_url_per_param(urls_updated, param = "all", call = call)
+      } else {
+        return(cnd)
+      }
+    }
+  )
 }

R/get_vpts.R

@@ -34,8 +34,8 @@
 #'   - A vector of datetimes or dates, between which all data files are
 #'   downloaded.
 #'   - A [lubridate::interval()], between which all data files are downloaded.
-#' @param source Source of the data. One of `"baltrad"`, `"uva"`, `"ecog-04003"`
-#'   or `"rmi"`. Only one source can be queried at a time. If not provided,
+#' @param source Source of the data. One of `"baltrad"`, `"uva"`, `"ecog-04003"`,
+#'   `"rmi"`, or `"birdcast"`. Only one source can be queried at a time. If not provided,
 #'   `"baltrad"` is used. Alternatively a local directory can be specified,
 #'   see details for an explanation of the file format.
 #' @param return_type Type of object that should be returned. Either:
@@ -77,10 +77,12 @@
 #'   source = "baltrad",
 #'   return_type = "tibble"
 #' )
+#' #' Get VPTS data from the public BirdCast NEXRAD archive
+#' get_vpts(radar = "KABR", datetime = "2023-01-01", source = "birdcast")
 get_vpts <- function(
   radar,
   datetime,
-  source = c("baltrad", "uva", "ecog-04003", "rmi"),
+  source = c("baltrad", "uva", "ecog-04003", "rmi", "birdcast"),
   return_type = c("vpts", "tibble")
 ) {
   # Input checks ----
@@ -205,14 +207,19 @@ get_vpts <- function(
   # Query the selected radars ----
   # Directing to the correct get_vpts_* helper based on source.
   cl <- rlang::caller_env(0)
+
+  aloft_sources <- eval(formals("get_vpts_aloft")$source)
+
+  source_type <- dplyr::case_when(
+    source == "rmi" ~ "rmi",
+    source == "birdcast" ~ "birdcast",
+    source %in% aloft_sources ~ "aloft",
+    dir.exists(source) ~ "local"
+  )
+
   fetched_vpts <-
     switch(
-      dplyr::case_when(
-        source == "rmi" ~ "rmi",
-        source %in% eval(formals("get_vpts_aloft")$source) ~ "aloft",
-        # this is the last option to avoid using a local source if an online exists
-        dir.exists(source) ~ "local"
-      ),
+      source_type,
       rmi = purrr::map(
         radar,
         ~ get_vpts_rmi(.x, rounded_interval),
@@ -227,6 +234,14 @@ get_vpts <- function(
         ),
         .purrr_error_call = cl
       ),
+      birdcast = purrr::map(
+        radar,
+        ~ get_vpts_birdcast(
+          .x,
+          rounded_interval = rounded_interval
+        ),
+        .purrr_error_call = cl
+      ),
       local = get_vpts_local(radar, rounded_interval, directory = source)
     ) |>
     radar_to_name()

R/get_vpts_aloft.R

@@ -25,12 +25,14 @@
 #' @param coverage A data frame containing the coverage of the Aloft bucket.
 #'   If not provided, it will be fetched from via the internet.
 #' @return A tibble with VPTS data.
-#' @keywords internal
+#' @noRd
 get_vpts_aloft <- function(
   radar_odim_code,
   rounded_interval,
   source = c("baltrad", "uva", "ecog-04003"),
-  coverage = get_vpts_coverage_aloft()
+  coverage = get_vpts_coverage_aloft(),
+  ...,
+  call = rlang::caller_env()
 ) {
   # rename source argument for readability
   selected_source <- source
@@ -45,7 +47,8 @@ get_vpts_aloft <- function(
       "Can't find radar {.val {missing_radar}} in the coverage file (see
        {.fun get_vpts_coverage}).",
       missing_radar = missing_radar,
-      class = "getRad_error_aloft_radar_not_found"
+      class = "getRad_error_aloft_radar_not_found",
+      call = call
     )
   }
 
@@ -61,7 +64,8 @@ get_vpts_aloft <- function(
   if (!at_least_one_radar_date_combination_exists) {
     cli::cli_abort(
       "Can't find any data for the requested radar(s) and date(s).",
-      class = "getRad_error_date_not_found"
+      class = "getRad_error_date_not_found",
+      call = call
     )
   }
 
@@ -79,7 +83,8 @@ get_vpts_aloft <- function(
     cli::cli_abort(
       "Can't find radar{?s} {.val {missing_radars}} in the coverage file (see
        {.fun get_vpts_coverage}).",
-      class = "getRad_error_radar_not_found"
+      class = "getRad_error_radar_not_found",
+      call = call
     )
   }