From c2a00a7246eafca9cdc199d95a7ffbe6a862ea28 Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@inrae.fr>
Date: Tue, 27 Jul 2021 16:44:43 +0200
Subject: [PATCH] feat: add API data retrieving functions

Closes #2
---
 DESCRIPTION                   |  4 +-
 NAMESPACE                     |  2 +
 R/doApiQuery.R                | 29 +++++++++++
 R/get_chronique.R             | 24 +++++++++
 R/get_points_prelevement.R    | 20 ++++++++
 README.Rmd                    | 28 ++++++++++-
 README.md                     | 92 +++++++++++++++++++++++++++++++++--
 inst/config.yml               |  4 ++
 man/get_chronique.Rd          | 28 +++++++++++
 man/get_points_prelevement.Rd | 28 +++++++++++
 10 files changed, 251 insertions(+), 8 deletions(-)
 create mode 100644 R/doApiQuery.R
 create mode 100644 R/get_chronique.R
 create mode 100644 R/get_points_prelevement.R
 create mode 100644 man/get_chronique.Rd
 create mode 100644 man/get_points_prelevement.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index b87255f..a3e311a 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: bnpe
 Type: Package
 Title: Retrieval Functions for the French national data bank of quantitative withdrawals (BNPE)
-Version: 0.2.0
+Version: 0.2.0.9000
 Authors@R: c(
     person("David", "Dorchies", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6595-7984"), email = "david.dorchies@inrae.fr")
     )
@@ -14,6 +14,8 @@ LazyData: true
 Imports: 
     config,
     httr,
+    purrr,
+    tibble,
     urltools
 RoxygenNote: 7.1.1
 Roxygen: list(markdown = TRUE)
diff --git a/NAMESPACE b/NAMESPACE
index 3932bb8..8c050ac 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -6,3 +6,5 @@ export(getCookie)
 export(getOuvrageSeries)
 export(getTimeSeriesCom)
 export(getTimeSeriesDep)
+export(get_chronique)
+export(get_points_prelevement)
diff --git a/R/doApiQuery.R b/R/doApiQuery.R
new file mode 100644
index 0000000..62330f6
--- /dev/null
+++ b/R/doApiQuery.R
@@ -0,0 +1,29 @@
+doApiQuery <- function(url_path,
+                       params,
+                       cfg = config::get(file = system.file("config.yml", package = "bnpe"))) {
+  query <- file.path(cfg$api$url, url_path)
+  for (paramName in names(params)) {
+    if (!is.null(params[[paramName]])) {
+      query <- urltools::param_set(query,
+                                   key = paramName,
+                                   value = params[[paramName]])
+    }
+  }
+  data <- list()
+  repeat {
+    resp <- httr::GET(query)
+    if (resp$status_code >= 300) {
+      stop("Error", resp$status_code, " on query: ", query)
+    } else {
+      l <- httr::content(resp, "parsed")
+      data <- c(data, l$data)
+      if (resp$status_code == 206) {
+        query <- l$`next`
+      }
+      if (resp$status_code == 200) {
+        break
+      }
+    }
+  }
+  return(data)
+}
diff --git a/R/get_chronique.R b/R/get_chronique.R
new file mode 100644
index 0000000..c85cfcd
--- /dev/null
+++ b/R/get_chronique.R
@@ -0,0 +1,24 @@
+#' Retrieve time series of withdrawals from Hub'Eau API
+#'
+#' See the API documentation for available filter parameters: \url{https://hubeau.eaufrance.fr/page/api-prelevements-eau#/prelevements/chronique}
+#'
+#' @param params [list] where the keys are the names of the filtered parameters and the values are the values of the filters. See the API documentation for the complete list of available filter parameters
+#' @inheritParams getCookie
+#'
+#' @return a [tibble::tibble] with all available parameters in columns and one row by device, year and usage.
+#' @export
+#'
+#' @examples
+#' # For retrieving the withdrawal time series of the devices located in Romilly-sur-Seine
+#' get_chronique(list(code_commune_insee = "10323"))
+#'
+get_chronique <- function(params, cfg = config::get(file = system.file("config.yml",
+                                                                       package = "bnpe"))) {
+  l <- doApiQuery(cfg$api_prelevements$chronique, params)
+  l <- lapply(l, function(x) {
+    x$geometry <- NULL
+    x
+  })
+  l <- lapply(l, function(row) {lapply(row, function(cell) { if(is.null(unlist(cell))) NA else unlist(cell) })})
+  return(purrr::map_df(l, tibble::as_tibble))
+}
diff --git a/R/get_points_prelevement.R b/R/get_points_prelevement.R
new file mode 100644
index 0000000..3092a6d
--- /dev/null
+++ b/R/get_points_prelevement.R
@@ -0,0 +1,20 @@
+#' Retrieve withdrawal points from Hub'Eau API
+#'
+#' See the API documentation for available filter parameters: \url{https://hubeau.eaufrance.fr/page/api-prelevements-eau#/prelevements/prelevement}
+#'
+#' @param params [list] where the keys are the names of the filtered parameters and the values are the values of the filters. See the API documentation for the complete list of available filter parameters
+#' @inheritParams getCookie
+#'
+#' @return a [tibble::tibble] with all available parameters in columns and one row by device.
+#' @export
+#'
+#' @examples
+#' # For retrieving the withdrawal points located in Romilly-sur-Seine
+#' get_points_prelevement(list(code_commune_insee = "10323"))
+#'
+get_points_prelevement <- function(params, cfg = config::get(file = system.file("config.yml",
+                                                                        package = "bnpe"))) {
+  l <- doApiQuery(cfg$api_prelevements$points_prelevement, params)
+  l <- lapply(l, function(row) {lapply(row, function(cell) { if(is.null(unlist(cell))) NA else unlist(cell) })})
+  return(purrr::map_df(l, tibble::as_tibble))
+}
diff --git a/README.Rmd b/README.Rmd
index 186b640..34710d7 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -20,7 +20,7 @@ knitr::opts_chunk$set(
 `r badger::badge_lifecycle("experimental", color = "blue")`
 <!-- badges: end -->
 
-'bnpe' is an R-package proposes a collection of function to help retrieve the French national data bank of quantitative withdrawals (Banque Nationale des Prélèvements quantitatifs en Eau - BNPE) available on its website: https://bnpe.eaufrance.fr
+'bnpe' is an R-package proposing a collection of function to help retrieve the French national data bank of quantitative withdrawals (Banque Nationale des Prélèvements quantitatifs en Eau - BNPE) available on its website https://bnpe.eaufrance.fr and on https://hubeau.eaufrance.fr/page/api-prelevements-eau
 
 ## Installation
 
@@ -39,7 +39,31 @@ remotes::install_gitlab("in-wop/bnpe", host = "gitlab.irstea.fr")
 library(bnpe)
 ```
 
-### Time series
+### Loading data from the Hub'Eau API
+
+Two functions are available:
+
+- `get_points_prelevement`: retrieve data about abstraction points
+- `get_chronique`: retrieve annual volume time series and characteristics
+
+The available filters for these functions are detailed in the API documentation respectively: https://hubeau.eaufrance.fr/page/api-prelevements-eau#/prelevements/prelevement and https://hubeau.eaufrance.fr/page/api-prelevements-eau#/prelevements/chronique
+
+Examples:
+
+```{r}
+# Characteristics of surface abstraction points in the Ardennes departement
+pp08 <- get_points_prelevement(list(code_departement = "08", code_type_milieu = "CONT"))
+str(pp08)
+
+# Time series of annual abstracted volumes for drinking water supply from surface water in the Ardennes departement
+# As the parameter "source of the water" (ground, surface...) is not available here, we can use the list of abstraction points previously downloaded as filter:
+dfAEP <- get_chronique(list(code_ouvrage = paste(pp08$code_ouvrage, collapse = ","), 
+                            code_usage = "AEP"))
+str(dfAEP)
+```
+
+
+### Scrapping aggregated data from the BNPE website
 
 Functions for getting time series are: 
 
diff --git a/README.md b/README.md
index c3fefc5..5e5a9be 100644
--- a/README.md
+++ b/README.md
@@ -10,10 +10,11 @@ MIT](https://img.shields.io/badge/license-MIT-orange.svg)](https://cran.r-projec
 [![](https://img.shields.io/badge/lifecycle-experimental-blue.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental)
 <!-- badges: end -->
 
-‘bnpe’ is an R-package proposes a collection of function to help
+‘bnpe’ is an R-package proposing a collection of function to help
 retrieve the French national data bank of quantitative withdrawals
 (Banque Nationale des Prélèvements quantitatifs en Eau - BNPE) available
-on its website: <https://bnpe.eaufrance.fr>
+on its website <https://bnpe.eaufrance.fr> and on
+<https://hubeau.eaufrance.fr/page/api-prelevements-eau>
 
 ## Installation
 
@@ -33,12 +34,93 @@ remotes::install_gitlab("in-wop/bnpe", host = "gitlab.irstea.fr")
 library(bnpe)
 ```
 
-### Time series
+### Loading data from the Hub’Eau API
+
+Two functions are available:
+
+-   `get_points_prelevement`: retrieve data about abstraction points
+-   `get_chronique`: retrieve annual volume time series and
+    characteristics
+
+The available filters for these functions are detailed in the API
+documentation respectively:
+<https://hubeau.eaufrance.fr/page/api-prelevements-eau#/prelevements/prelevement>
+and
+<https://hubeau.eaufrance.fr/page/api-prelevements-eau#/prelevements/chronique>
+
+Examples:
+
+``` r
+# Characteristics of surface abstraction points in the Ardennes departement
+pp08 <- get_points_prelevement(list(code_departement = "08", code_type_milieu = "CONT"))
+str(pp08)
+#> tibble [85 x 28] (S3: tbl_df/tbl/data.frame)
+#>  $ code_point_prelevement     : chr [1:85] "PTP000000000005792" "PTP000000000005793" "PTP000000000005794" "PTP000000000005795" ...
+#>  $ nom_point_prelevement      : chr [1:85] "SARL WIEDENMANN" "ENERPRO BOGNY" "FORCES ENERGIES ELECTRIQUES" "STE EXPL CHUTES HYDRAULIQUES" ...
+#>  $ date_exploitation_debut    : chr [1:85] "1900-01-01" "1900-01-01" "1900-01-01" "1900-01-01" ...
+#>  $ date_exploitation_fin      : logi [1:85] NA NA NA NA NA NA ...
+#>  $ code_type_milieu           : chr [1:85] "CONT" "CONT" "CONT" "CONT" ...
+#>  $ libelle_type_milieu        : chr [1:85] "Surface continental" "Surface continental" "Surface continental" "Surface continental" ...
+#>  $ code_nature                : chr [1:85] "F" "F" "F" "F" ...
+#>  $ libelle_nature             : chr [1:85] "FICTIF" "FICTIF" "FICTIF" "FICTIF" ...
+#>  $ lieu_dit                   : logi [1:85] NA NA NA NA NA NA ...
+#>  $ commentaire                : logi [1:85] NA NA NA NA NA NA ...
+#>  $ code_commune_insee         : chr [1:85] "08083" "08081" "08185" "08302" ...
+#>  $ nom_commune                : chr [1:85] "Brévilly" "Bogny-sur-Meuse" "Fumay" "Monthermé" ...
+#>  $ code_departement           : chr [1:85] "08" "08" "08" "08" ...
+#>  $ libelle_departement        : chr [1:85] "Ardennes" "Ardennes" "Ardennes" "Ardennes" ...
+#>  $ code_entite_hydro_cours_eau: logi [1:85] NA NA NA NA NA NA ...
+#>  $ uri_entite_hydro_cours_eau : logi [1:85] NA NA NA NA NA NA ...
+#>  $ code_entite_hydro_plan_eau : logi [1:85] NA NA NA NA NA NA ...
+#>  $ uri_entite_hydro_plan_eau  : logi [1:85] NA NA NA NA NA NA ...
+#>  $ code_zone_hydro            : chr [1:85] NA NA NA NA ...
+#>  $ uri_zone_hydro             : chr [1:85] NA NA NA NA ...
+#>  $ code_mer_ocean             : logi [1:85] NA NA NA NA NA NA ...
+#>  $ nappe_accompagnement       : logi [1:85] TRUE TRUE TRUE TRUE TRUE TRUE ...
+#>  $ uri_bss_point_eau          : logi [1:85] NA NA NA NA NA NA ...
+#>  $ code_ouvrage               : chr [1:85] "OPR0000005780" "OPR0000005781" "OPR0000005782" "OPR0000005783" ...
+#>  $ uri_ouvrage                : chr [1:85] "https://id.eaufrance.fr/OuvragePrel/OPR0000005780" "https://id.eaufrance.fr/OuvragePrel/OPR0000005781" "https://id.eaufrance.fr/OuvragePrel/OPR0000005782" "https://id.eaufrance.fr/OuvragePrel/OPR0000005783" ...
+#>  $ code_bdlisa                : logi [1:85] NA NA NA NA NA NA ...
+#>  $ uri_bdlisa                 : logi [1:85] NA NA NA NA NA NA ...
+#>  $ code_bss_point_eau         : logi [1:85] NA NA NA NA NA NA ...
+
+# Time series of annual abstracted volumes for drinking water supply from surface water in the Ardennes departement
+# As the parameter "source of the water" (ground, surface...) is not available here, we can use the list of abstraction points previously downloaded as filter:
+dfAEP <- get_chronique(list(code_ouvrage = paste(pp08$code_ouvrage, collapse = ","), 
+                            code_usage = "AEP"))
+str(dfAEP)
+#> tibble [40 x 23] (S3: tbl_df/tbl/data.frame)
+#>  $ code_ouvrage                 : chr [1:40] "OPR0000000767" "OPR0000000767" "OPR0000000767" "OPR0000000767" ...
+#>  $ annee                        : int [1:40] 2012 2013 2014 2015 2016 2017 2018 2012 2013 2014 ...
+#>  $ volume                       : num [1:40] 189938 175878 167035 169552 169694 ...
+#>  $ code_usage                   : chr [1:40] "AEP" "AEP" "AEP" "AEP" ...
+#>  $ libelle_usage                : chr [1:40] "EAU POTABLE" "EAU POTABLE" "EAU POTABLE" "EAU POTABLE" ...
+#>  $ code_statut_volume           : chr [1:40] "1" "1" "1" "1" ...
+#>  $ libelle_statut_volume        : chr [1:40] "Contrôlé Niveau 1" "Contrôlé Niveau 1" "Contrôlé Niveau 1" "Contrôlé Niveau 1" ...
+#>  $ code_qualification_volume    : chr [1:40] "1" "1" "1" "1" ...
+#>  $ libelle_qualification_volume : chr [1:40] "Correcte" "Correcte" "Correcte" "Correcte" ...
+#>  $ code_statut_instruction      : chr [1:40] "REA" "REA" "REA" "REA" ...
+#>  $ libelle_statut_instruction   : chr [1:40] "Prélèvement réalisé" "Prélèvement réalisé" "Prélèvement réalisé" "Prélèvement réalisé" ...
+#>  $ code_mode_obtention_volume   : chr [1:40] "MED" "MED" "MED" "MED" ...
+#>  $ libelle_mode_obtention_volume: chr [1:40] "Mesure directe" "Mesure directe" "Mesure directe" "Mesure directe" ...
+#>  $ prelevement_ecrasant         : logi [1:40] FALSE FALSE FALSE FALSE FALSE FALSE ...
+#>  $ producteur_donnee            : chr [1:40] "AERM" "AERM" "AERM" "AERM" ...
+#>  $ longitude                    : num [1:40] 4.83 4.83 4.83 4.83 4.83 ...
+#>  $ latitude                     : num [1:40] 50.1 50.1 50.1 50.1 50.1 ...
+#>  $ code_commune_insee           : chr [1:40] "08247" "08247" "08247" "08247" ...
+#>  $ nom_commune                  : chr [1:40] "Landrichamps" "Landrichamps" "Landrichamps" "Landrichamps" ...
+#>  $ code_departement             : chr [1:40] "08" "08" "08" "08" ...
+#>  $ libelle_departement          : chr [1:40] "Ardennes" "Ardennes" "Ardennes" "Ardennes" ...
+#>  $ nom_ouvrage                  : chr [1:40] "COMMUNE DE GIVET" "COMMUNE DE GIVET" "COMMUNE DE GIVET" "COMMUNE DE GIVET" ...
+#>  $ uri_ouvrage                  : chr [1:40] "https://id.eaufrance.fr/OuvragePrel/OPR0000000767" "https://id.eaufrance.fr/OuvragePrel/OPR0000000767" "https://id.eaufrance.fr/OuvragePrel/OPR0000000767" "https://id.eaufrance.fr/OuvragePrel/OPR0000000767" ...
+```
+
+### Scrapping aggregated data from the BNPE website
 
 Functions for getting time series are:
 
-  - `getTimeSeriesDep`: for one department
-  - `getTimeSeriesCom`: for one commune
+-   `getTimeSeriesDep`: for one department
+-   `getTimeSeriesCom`: for one commune
 
 These functions uses the French official geographical codification
 (<https://fr.wikipedia.org/wiki/Code_officiel_g%C3%A9ographique>).
diff --git a/inst/config.yml b/inst/config.yml
index e1fd1ed..736ca55 100644
--- a/inst/config.yml
+++ b/inst/config.yml
@@ -1,4 +1,8 @@
 default:
+  api_prelevements:
+    url: https://hubeau.eaufrance.fr/api/v1/prelevements
+    points_prelevement: referentiel/points_prelevement
+    chroniques: chroniques
   url: https://bnpe.eaufrance.fr/Bnpe-Diffusion
   url_time_series: synthese/synthese_temporelle
   url_com_series: synthese/synthese_geographique
diff --git a/man/get_chronique.Rd b/man/get_chronique.Rd
new file mode 100644
index 0000000..b63c22c
--- /dev/null
+++ b/man/get_chronique.Rd
@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/get_chronique.R
+\name{get_chronique}
+\alias{get_chronique}
+\title{Retrieve time series of withdrawals from Hub'Eau API}
+\usage{
+get_chronique(
+  params,
+  cfg = config::get(file = system.file("config.yml", package = "bnpe"))
+)
+}
+\arguments{
+\item{params}{\link{list} where the keys are the names of the filtered parameters and the values are the values of the filters. See the API documentation for the complete list of available filter parameters}
+
+\item{cfg}{a \link{config} object Configuration of the communication. Use by default the internal package
+configuration stored at location \code{system.file("config.yml", package = "bnpe")}}
+}
+\value{
+a \link[tibble:tibble]{tibble::tibble} with all available parameters in columns and one row by device, year and usage.
+}
+\description{
+See the API documentation for available filter parameters: \url{https://hubeau.eaufrance.fr/page/api-prelevements-eau}
+}
+\examples{
+# For retrieving the withdrawal time series of the devices located in Romilly-sur-Seine
+get_chronique(list(code_commune_insee = "10323"))
+
+}
diff --git a/man/get_points_prelevement.Rd b/man/get_points_prelevement.Rd
new file mode 100644
index 0000000..1f2eec6
--- /dev/null
+++ b/man/get_points_prelevement.Rd
@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/get_points_prelevement.R
+\name{get_points_prelevement}
+\alias{get_points_prelevement}
+\title{Retrieve withdrawal points from Hub'Eau API}
+\usage{
+get_points_prelevement(
+  params,
+  cfg = config::get(file = system.file("config.yml", package = "bnpe"))
+)
+}
+\arguments{
+\item{params}{\link{list} where the keys are the names of the filtered parameters and the values are the values of the filters. See the API documentation for the complete list of available filter parameters}
+
+\item{cfg}{a \link{config} object Configuration of the communication. Use by default the internal package
+configuration stored at location \code{system.file("config.yml", package = "bnpe")}}
+}
+\value{
+a \link[tibble:tibble]{tibble::tibble} with all available parameters in columns and one row by device.
+}
+\description{
+See the API documentation for available filter parameters: \url{https://hubeau.eaufrance.fr/page/api-prelevements-eau}
+}
+\examples{
+# For retrieving the withdrawal points located in Romilly-sur-Seine
+get_points_prelevement(list(code_commune_insee = "10323"))
+
+}
-- 
GitLab