From a6ff8ef9faee1543d4c59b33816bfbe73e0b2ced Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@inrae.fr>
Date: Fri, 6 Aug 2021 16:52:04 +0200
Subject: [PATCH] feat(get_hydrometrie_observations_tr): add option "entities"
Fix #10
---
R/get_hydrometrie_observations_tr.R | 20 +++++++++++-----
R/get_niveaux_nappes_chroniques_tr.R | 3 ++-
man/get_hydrometrie_observations_tr.Rd | 3 +++
man/get_niveaux_nappes_chroniques_tr.Rd | 3 ++-
.../test-get_hydrometrie_observations_tr.R | 24 +++++++++++++++++++
5 files changed, 45 insertions(+), 8 deletions(-)
create mode 100644 tests/testthat/test-get_hydrometrie_observations_tr.R
diff --git a/R/get_hydrometrie_observations_tr.R b/R/get_hydrometrie_observations_tr.R
index 5b5f262..0cf9d4b 100644
--- a/R/get_hydrometrie_observations_tr.R
+++ b/R/get_hydrometrie_observations_tr.R
@@ -3,6 +3,7 @@
#' See the API documentation for available filter parameters: \url{https://hubeau.eaufrance.fr/page/api-hydrometrie}
#'
#' @template param_get_common
+#' @param entities 1-[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
#'
#' @return a [tibble::tibble] with all available parameters in columns and one row by time step and by station.
#' @export
@@ -12,7 +13,8 @@
#' get_hydrometrie_observations_tr(list(code_entite = "H0203020", grandeur_hydro = "Q"))
#'
get_hydrometrie_observations_tr <- function(params,
- cfg = config::get(file = system.file("config.yml",
+ entities = "station",
+ cfg = config::get(file = system.file("config.yml",
package = "hubeau"))) {
l <- doApiQuery(
api = "hydrometrie",
@@ -22,12 +24,18 @@ get_hydrometrie_observations_tr <- function(params,
)
l <- lapply(l, function(x) {
x$geometry <- NULL
- if (is.null(x$code_station)) {
- # See bug https://github.com/BRGM/hubeau/issues/73
- NULL
- } else {
- x
+ if (entities == "station") {
+ if (is.null(x$code_station)) {
+ return(NULL)
+ }
+ } else if (entities == "site") {
+ if (!is.null(x$code_station)) {
+ return(NULL)
+ }
+ } else if (entities != "both") {
+ stop("Argument 'entities' must be one of these values: 'station', 'site', 'both'")
}
+ return(x)
})
l[sapply(l, is.null)] <- NULL
convert_list_to_tibble(l)
diff --git a/R/get_niveaux_nappes_chroniques_tr.R b/R/get_niveaux_nappes_chroniques_tr.R
index 390b701..633bcb5 100644
--- a/R/get_niveaux_nappes_chroniques_tr.R
+++ b/R/get_niveaux_nappes_chroniques_tr.R
@@ -8,7 +8,8 @@
#' @export
#'
#' @examples
-#' # For retrieving the last real time observed piezometric level at station 'BSS001VZGZ' (new BSS identifier)
+#' # For retrieving the last real time observed piezometric level
+#' # at station 'BSS001VZGZ' (new BSS identifier)
#' df <- get_niveaux_nappes_chroniques_tr(list(bss_id = "BSS001VZGZ"))
#'
#' # Plot the water elevation (NGF)
diff --git a/man/get_hydrometrie_observations_tr.Rd b/man/get_hydrometrie_observations_tr.Rd
index 03509eb..32e21a8 100644
--- a/man/get_hydrometrie_observations_tr.Rd
+++ b/man/get_hydrometrie_observations_tr.Rd
@@ -6,12 +6,15 @@
\usage{
get_hydrometrie_observations_tr(
params,
+ entities = "station",
cfg = config::get(file = system.file("config.yml", package = "hubeau"))
)
}
\arguments{
\item{params}{a \link{list} the list of parameters of the queries and their values in the format \code{list(ParamName = "Param value", ...)}, use the function \link{get_available_params} for a list of the available parameters for a given operation in an API and see the API documentation for the complete list of available filter parameters}
+\item{entities}{1-\link{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}
+
\item{cfg}{a \link{config} object Configuration of the communication. Use by default the internal package
configuration}
}
diff --git a/man/get_niveaux_nappes_chroniques_tr.Rd b/man/get_niveaux_nappes_chroniques_tr.Rd
index 19627fd..904f4e9 100644
--- a/man/get_niveaux_nappes_chroniques_tr.Rd
+++ b/man/get_niveaux_nappes_chroniques_tr.Rd
@@ -22,7 +22,8 @@ a \link[tibble:tibble]{tibble::tibble} with all available parameters in columns
See the API documentation for available filter parameters: \url{https://hubeau.eaufrance.fr/page/api-piezometrie}
}
\examples{
-# For retrieving the last real time observed piezometric level at station 'BSS001VZGZ' (new BSS identifier)
+# For retrieving the last real time observed piezometric level
+# at station 'BSS001VZGZ' (new BSS identifier)
df <- get_niveaux_nappes_chroniques_tr(list(bss_id = "BSS001VZGZ"))
# Plot the water elevation (NGF)
diff --git a/tests/testthat/test-get_hydrometrie_observations_tr.R b/tests/testthat/test-get_hydrometrie_observations_tr.R
new file mode 100644
index 0000000..cd874a0
--- /dev/null
+++ b/tests/testthat/test-get_hydrometrie_observations_tr.R
@@ -0,0 +1,24 @@
+params <- list(code_entite = "H0203020",
+ date_debut_obs = format(Sys.Date()-3),
+ grandeur_hydro = "Q")
+
+test_that("entities not in ('station', 'site', 'both') should throw an error", {
+ expect_error(
+ df <- get_hydrometrie_observations_tr(params, entities = "wrong value"),
+ regexp = "must be one of these values"
+ )
+})
+
+
+test_that("`entities = 'station'` => 'code_station' must be always not NA", {
+ skip_on_cran()
+ df <- get_hydrometrie_observations_tr(params, entities = "station")
+ expect_true(all(!is.na(df$code_station)))
+})
+
+test_that("`entities = 'site'` => 'code_station' must be always NA", {
+ skip_on_cran()
+ df <- get_hydrometrie_observations_tr(params, entities = "site")
+ expect_true(all(is.na(df$code_station)))
+})
+
--
GitLab