Failed to fetch fork details. Try again later.
-
Delaigue Olivier authored6bcc5057
Forked from
HYCAR-Hydro / airGR
Source project has a limited visibility.
#' Retrieve data from API "Hydrométrie"#'#' @description#'#' Available endpoints are:#'#' - `get_hydrometrie_obs_elab` retrieves hydrometric elaborate observations (daily/monthly mean flow)#' - `get_hydrometrie_observations_tr` retrieves hydrometric "real time" observations ()#' - `get_hydrometrie_sites` retrieves hydrometric sites#' - `get_hydrometrie_stations` retrieves hydrometric stations#'#' See the API documentation of each endpoint for available filter parameters:#' \url{https://hubeau.eaufrance.fr/page/api-hydrometrie}#'#' @template param_get_common#'#' @export#' @rdname get_hydrometrie#' @examples#' # Retrieve the hydrometric sites in the department of Aube#' get_hydrometrie_sites(list(code_departement = "10"))#'#' # The same operation returning 2 rows for the site 'H0203020' which has 2 different locations#' get_hydrometrie_sites(list(code_departement = "10"), unique_site = FALSE)#'#' \dontrun{#' # This function is currently (2021-12-23) unstable and can be unavailable#' # (See https://github.com/BRGM/hubeau/issues/85)#' # Retrieve the hydrometric stations in the department of Aube#' get_hydrometrie_stations(list(code_departement = "10"))#' }#'#' # Which parameters are available for endpoint "obs_elab" of API "hydrometrie"?#' get_available_params("hydrometrie", "obs_elab")#'#' # Retrieve the hydrometric monthly mean flow at site 'H0203020'#' get_hydrometrie_obs_elab(list(code_entite = "H0203020", grandeur_hydro_elab = "QmM"))#'#' # Retrieve the hydrometric daily mean flow at site 'H0203020' of the last 30 days#' get_hydrometrie_obs_elab(#' list(code_entite = "H0203020",#' date_debut_obs_elab = format(Sys.Date() -30, "%Y-%m-%d"),#' grandeur_hydro_elab = "QmJ"))#'get_hydrometrie_obs_elab <- function(params, cfg = config::get(file = system.file("config.yml", package = "hubeau"))) { l <- doApiQuery( api = "hydrometrie", operation = "obs_elab", params = params, cfg = cfg ) convert_list_to_tibble(l)}#' @param entities 1-length [character] string filtering the rows of the returned value, possible values are: "station" for filtering on station rows, "site" for filtering on site rows, "both" for keeping all the rows#' @rdname get_hydrometrie#' @exportget_hydrometrie_observations_tr <- function(params, entities = "station", cfg = config::get(file = system.file("config.yml", package = "hubeau"))) { # Checks if(!entities %in% c("station", "site", "both")) { stop("Argument 'entities' must be one of these values: 'station', 'site', 'both'") } l <- doApiQuery( api = "hydrometrie",7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
operation = "observations_tr",
params = params,
cfg = cfg
)
if(!is.null(l)) {
l <- lapply(l, function(x) {
x$geometry <- NULL
if (entities == "station") {
if (is.null(x$code_station)) {
return(NULL)
}
} else if (entities == "site") {
if (!is.null(x$code_station)) {
return(NULL)
}
}
return(x)
})
l[sapply(l, is.null)] <- NULL
l <- convert_list_to_tibble(l)
}
return(l)
}
#' @param unique_site optional [logical], if set to `FALSE` sites with several different locations produce one row by different location otherwise the first location found is used for fields `code_commune_site`, `libelle_commune`, `code_departement`, `code_region`, `libelle_region`, `libelle_departement`
#' @rdname get_hydrometrie
#' @export
get_hydrometrie_sites <- function(params,
unique_site = TRUE,
cfg = config::get(file = system.file("config.yml",
package = "hubeau"))) {
l <- doApiQuery(
api = "hydrometrie",
operation = "sites",
params = params,
cfg = cfg
)
l <- lapply(l, function(x) {
fields <-
c(
"code_commune_site",
"libelle_commune",
"code_departement",
"code_region",
"libelle_region",
"libelle_departement"
)
bFirst <- TRUE
for (field in fields) {
if (!is.null(x[[field]])) {
fieldValue <- unique(unlist(x[[field]]))
if (unique_site && length(fieldValue) > 1) {
if(bFirst) {
warning(
"The site '",
x$code_site,
"' has ",
length(fieldValue),
" different locations, only the first one is returned",
call. = FALSE
)
bFirst <- FALSE
}
fieldValue <- x[[field]][[1]]
}
x[[field]] <- fieldValue
}
}
x$geometry <- NULL
x
141142143144145146147148149150151152153154155156157158159160161162163
})
convert_list_to_tibble(l)
}
#' @param code_sandre_reseau_station optional [logical] indicating if `code_sandre_reseau_station` field is included in the result; if so, one line is added by item and other fields are repeated
#' @rdname get_hydrometrie
#' @export
get_hydrometrie_stations <- function(params, code_sandre_reseau_station = FALSE, cfg = config::get(file = system.file("config.yml",
package = "hubeau"))) {
l <- doApiQuery(api = "hydrometrie",
operation = "stations",
params = params,
cfg = cfg)
l <- lapply(l, function(x) {
if (!code_sandre_reseau_station) {
x$code_sandre_reseau_station <- NULL
}
x$geometry <- NULL
x
})
convert_list_to_tibble(l)
}