Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -20,12 +20,11 @@ Depends:
R (>= 3.6)
Imports:
abind,
curl,
geosphere,
ggplot2,
grid,
gridtext,
jsonlite,
httr2,
lubridate,
ncdf4,
patchwork,
Expand All @@ -41,7 +40,8 @@ Suggests:
knitr,
mockery,
rmarkdown,
testthat
testthat,
vcr
LinkingTo:
Rcpp,
RcppArmadillo
Expand Down
3 changes: 2 additions & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
# resourcecode (development version)

- Custom labels are now handeled properly in `cut_seasons()`
- Custom labels are now handled properly in `cut_seasons()` ;
- Switch to {httr2} to download files and API request.

# resourcecode 0.5.2

Expand Down
122 changes: 92 additions & 30 deletions R/download_data.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,11 @@
#' @return a tibble with 2 columns and as many rows as needed
#' @noRd
get_parameters_raw <- function(
parameter = "hs",
node = 42,
start = as.POSIXct("1994-01-01Z00:00:00", tz = "UTC"),
end = as.POSIXct("1994-12-31Z23:00:00", tz = "UTC")) {
parameter = "hs",
node = 42,
start = as.POSIXct("1994-01-01Z00:00:00", tz = "UTC"),
end = as.POSIXct("1994-12-31Z23:00:00", tz = "UTC")
) {
if (parameter == "tp") {
single_parameter <- "fp"
} else {
Expand All @@ -27,7 +28,7 @@ get_parameters_raw <- function(
# Cassandra database start indexing at 1, so decrements node number
node <- node - 1

request <- paste0(
request_url <- paste0(
rcd_cassandra_url,
"api/timeseries",
"?parameter=",
Expand All @@ -40,28 +41,69 @@ get_parameters_raw <- function(
end_str
)

# Try retrieving and parsing JSON
# Try retrieving and parsing JSON using httr2
resp <- tryCatch(
httr2::request(request_url) |>
httr2::req_error(is_error = \(resp) FALSE) |> # Don't auto-error on HTTP errors
httr2::req_retry(max_tries = 3) |> # Retry transient failures
httr2::req_timeout(30) |> # 30 second timeout
httr2::req_user_agent("Resourcecode R package") |>
httr2::req_perform(),
httr2_failure = function(cnd) {
message(
"Network error: Could not connect to the remote resource. ",
"The server may be unavailable."
)
NULL
},
error = function(e) {
message("Unexpected error retrieving data: ", conditionMessage(e))
NULL
}
)

# If request failed, exit
if (is.null(resp)) {
return(NULL)
}

# Check HTTP status
if (httr2::resp_status(resp) != 200) {
message(
"HTTP error ",
httr2::resp_status(resp),
": ",
httr2::resp_status_desc(resp)
)
return(NULL)
}

# Parse JSON response
res <- tryCatch(
jsonlite::fromJSON(request),
httr2::resp_body_json(resp, simplifyVector = TRUE),
error = function(e) {
message("Could not retrieve data from the remote resource. ",
"The server may be unavailable or the URL may have changed.")
NULL # graceful fallback
message("Error parsing response: Invalid JSON format")
NULL
}
)

# If retrieval failed, exit
if (is.null(res)) return(NULL)
# If parsing failed, exit
if (is.null(res)) {
return(NULL)
}

# Check API-level error
if (!is.null(res$errorcode) && res$errorcode != 0) {
message("The data source returned an error: ", res$errormessage,
"\nReturning NULL.")
return(NULL) # graceful fallback
message(
"The data source returned an error: ",
res$errormessage,
"\nReturning NULL."
)
return(NULL) # graceful fallback
}


data <- res$result$data
# Convert list to data frame
data <- as.data.frame(res$result$data)
colnames(data) <- c("time", parameter)
data <- tibble::as_tibble(data)

Expand All @@ -70,14 +112,15 @@ get_parameters_raw <- function(
}

data$time <- as.POSIXct(
data$time / 1000,
as.numeric(data$time) / 1000,
origin = as.POSIXct("1970-01-01", tz = "UTC"),
tz = "UTC"
) # Convert UNIX time (ms) to POSIXct format
attr(data, "node") <- node
data
}


#' Download time series of sea-state parameters from RESOURCECODE database
#'
#' If the remote resource is unavailable or returns an error, the function returns NULL
Expand All @@ -91,21 +134,25 @@ get_parameters_raw <- function(
#' @return a tibble with N-rows and `length(parameters)` columns.
#' @export
#'
#' @examplesIf curl::has_internet()
#' ts <- get_parameters(parameters = c("hs", "tp"), node = 42)
#' plot(ts$time, ts$hs, type = "l")
#' @examples
#' rscd_data <- get_parameters(parameters = c("hs", "tp"), node = 42)
#' if(!is.null(rscd_data)) plot(rscd_data$time, rscd_data$hs, type = "l")
get_parameters <- function(
parameters = "hs",
node = 42,
start = as.POSIXct("1994-01-01 00:00:00", tz = "UTC"),
end = as.POSIXct("1994-12-31 23:00:00", tz = "UTC")) {
parameters = "hs",
node = 42,
start = as.POSIXct("1994-01-01 00:00:00", tz = "UTC"),
end = as.POSIXct("1994-12-31 23:00:00", tz = "UTC")
) {
parameters <- tolower(parameters)

if (any(parameters %nin% c("tp", resourcecodedata::rscd_variables$name))) {
errors <- parameters[parameters %nin% c("tp", resourcecodedata::rscd_variables$name)]
errors <- parameters[
parameters %nin% c("tp", resourcecodedata::rscd_variables$name)
]
stop(
"Requested parameters do not exists in the database: ",
paste0(errors, collapse = ", "), "."
paste0(errors, collapse = ", "),
"."
)
}

Expand Down Expand Up @@ -144,7 +191,8 @@ get_parameters <- function(
stop(
"'start' is outside the covered period: ",
paste(
format(c(rscd_casandra_start_date, rscd_casandra_end_date),
format(
c(rscd_casandra_start_date, rscd_casandra_end_date),
format = "%Y-%m-%d %H:%M %Z"
),
collapse = " \u2014 "
Expand All @@ -155,7 +203,8 @@ get_parameters <- function(
stop(
"'end' is outside the covered period: ",
paste(
format(c(rscd_casandra_start_date, rscd_casandra_end_date),
format(
c(rscd_casandra_start_date, rscd_casandra_end_date),
format = "%Y-%m-%d %H:%M %Z"
),
collapse = " \u2014 "
Expand All @@ -173,14 +222,27 @@ get_parameters <- function(
end = end
)

# If first parameter retrieval failed, return NULL
if (is.null(out)) {
message("Failed to retrieve parameter: ", parameters[1])
return(NULL)
}

for (i in seq_len(length(parameters) - 1)) {
temp <- get_parameters_raw(
parameters[i + 1],
node = node,
start = start,
end = end
)
out <- cbind(out, temp[, 2])

# If any subsequent parameter retrieval fails, return NULL
if (is.null(temp)) {
message("Failed to retrieve parameter: ", parameters[i + 1])
return(NULL)
}

out <- cbind.data.frame(out, temp[, 2])
}
out
}
Loading
Loading