An error occurred while loading the file. Please try again.
-
Olivier Kaufmann authored7982bdb2
#' 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
#' @export
get_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)
}