KWB-R · ma-z-am · Sep 24, 2023 · Sep 24, 2023 · Sep 24, 2023 · Sep 24, 2023
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,29 +1,20 @@
 Package: wasserportal
-Title: R Package with Functions for Scraping Data of
-    Wasserportal Berlin
-Version: 0.3.0
-Authors@R: 
-    c(person(given = "Hauke",
-             family = "Sonnenberg",
-             role = "aut",
-             email = "hauke.sonnenberg@kompetenz-wasser.de",
-             comment = c(ORCID = "0000-0001-9134-2871")),
-      person(given = "Michael",
-             family = "Rustler",
-             role =  c("aut","cre"),
-             email = "michael.rustler@kompetenz-wasser.de",
-             comment = c(ORCID = "0000-0003-0647-7726")),
-      person(given = "DWC",
-             role = "fnd"),
-      person(given = "IMPETUS",
-             role = "fnd"),
-      person(given = "PROMISCES",
-             role = "fnd"),
-      person(given = "Kompetenzzentrum Wasser Berlin gGmbH (KWB)",
-             role = "cph"))
-Description: R Package with Functions for Scraping Data of
-    Wasserportal Berlin (https://wasserportal.berlin.de), which contains
-    real-time data of surface water and groundwater monitoring stations.
+Title: R Package with Functions for Scraping Data of Wasserportal Berlin
+Version: 0.4.0
+Authors@R: c(
+    person("Hauke", "Sonnenberg", , "hauke.sonnenberg@kompetenz-wasser.de", role = "aut",
+           comment = c(ORCID = "0000-0001-9134-2871")),
+    person("Michael", "Rustler", , "michael.rustler@kompetenz-wasser.de", role = c("aut", "cre"),
+           comment = c(ORCID = "0000-0003-0647-7726")),
+    person("AD4GD", role = "fnd"),
+    person("DWC", role = "fnd"),
+    person("IMPETUS", role = "fnd"),
+    person("PROMISCES", role = "fnd"),
+    person("Kompetenzzentrum Wasser Berlin gGmbH (KWB)", role = "cph")
+  )
+Description: R Package with Functions for Scraping Data of Wasserportal
+    Berlin (https://wasserportal.berlin.de), which contains real-time data
+    of surface water and groundwater monitoring stations.
 License: MIT + file LICENSE
 URL: https://github.com/KWB-R/wasserportal
 BugReports: https://github.com/KWB-R/wasserportal/issues
@@ -48,28 +39,29 @@ Suggests:
     covr,
     DT,
     forcats,
-    htmlwidgets,
-    janitor,
-    jsonlite,
-    leaflet,
     ggplot2,
     gridExtra,
     htmltools,
+    htmlwidgets,
+    janitor,
+    jsonlite,
     knitr,
     kwb.pkgbuild,
+    leaflet,
     openxlsx,
     plotly,
     rmarkdown,
     sf,
-    tidyselect,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    tidyselect
+VignetteBuilder: 
+    knitr
 Remotes: 
     github::kwb-r/kwb.datetime,
     github::kwb-r/kwb.pkgbuild,
     github::kwb-r/kwb.utils
+Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
-VignetteBuilder: knitr
-Config/testthat/edition: 3
+RoxygenNote: 7.3.1
diff --git a/LICENSE b/LICENSE
@@ -1,6 +1,6 @@
 MIT License
 
-Copyright (c) 2021-2022 Kompetenzzentrum Wasser Berlin gGmbH (KWB)
+Copyright (c) 2021-2024 Kompetenzzentrum Wasser Berlin gGmbH (KWB)
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

diff --git a/LICENSE.md b/LICENSE.md
@@ -1,6 +1,6 @@
 # MIT License
 
-Copyright (c) 2021-2022 Kompetenzzentrum Wasser Berlin gGmbH (KWB)
+Copyright (c) 2021-2024 Kompetenzzentrum Wasser Berlin gGmbH (KWB)
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

diff --git a/NAMESPACE b/NAMESPACE
@@ -9,6 +9,8 @@ export(get_groundwater_options)
 export(get_overview_options)
 export(get_station_variables)
 export(get_stations)
+export(get_surfacewater_qualities)
+export(get_surfacewater_quality)
 export(get_surfacewater_variables)
 export(get_wasserportal_master_data)
 export(get_wasserportal_masters_data)
@@ -41,6 +43,7 @@ importFrom(dplyr,select_if)
 importFrom(fs,dir_create)
 importFrom(httr,POST)
 importFrom(httr,content)
+importFrom(httr,http_error)
 importFrom(kwb.datetime,textToEuropeBerlinPosix)
 importFrom(kwb.utils,catAndRun)
 importFrom(kwb.utils,getAttribute)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,12 @@
+# [wasserportal 0.4.0](https://github.com/KWB-R/wasserportal/releases/tag/v0.4.0) <small>2024-04-05</small>
+
+* New feature: add support for downloading all available surface water quality 
+data for one or multiple monitoring stations. For details see `get_surfacewater_qualities()` 
+* Bugfix for groundwater level and quality due to new Wasserportal API 
+* Add project [AD4GD](https://www.kompetenz-wasser.de/de/forschung/projekte/ad4gd) 
+as funder
+
+
 # [wasserportal 0.3.0](https://github.com/KWB-R/wasserportal/releases/tag/v0.3.0) <small>2023-02-19</small>
 
 * Fix errors in GitHub actions: use actions from branches `v2`, `v3`, not from 

diff --git a/R/.test-surface-water_download.R b/R/.test-surface-water_download.R
@@ -1,51 +1,53 @@
-if (FALSE) {
-library(wasserportal)
-
-stations <- wasserportal::get_stations()
-stations_crosstable <-  stations$crosstable
-
-stations_crosstable_bb <- stations_crosstable %>%
-  dplyr::filter(stringr::str_detect(.data$Messstellennummer,
-                                    pattern = "^[A-Z]{2}_"))
-
-stations_crosstable_berlin <- stations_crosstable %>%
-  dplyr::filter(stringr::str_detect(.data$Messstellennummer,
-                                    pattern = "^[A-Z]{2}_",
-                                    negate = TRUE))
-
-
-
-station_crosstable_berlin <- stations_crosstable_berlin[1,]
-stations_crosstable_berlin
-from_date <- "1900-01-01"
-sw_station_berlin_daily <- wasserportal::read_wasserportal_raw(
-  station = station_crosstable_berlin$Messstellennummer,
-  variable = get_station_variables(stations_crosstable_berlin)[1],
-  type = "daily",
-  from_date = from_date,
-  include_raw_time = TRUE,
-  stations_crosstable = stations_crosstable
-)
-
-str(sw_station_berlin_daily)
-
-
-
-sw_stations_berlin_daily <- stats::setNames(lapply(stations_crosstable_berlin$Messstellennummer,
-                   function(station) {
-                     msg <- sprintf("Fetching data for station '%s'", station)
-                     kwb.utils::catAndRun(msg, expr = {
-                     wasserportal::read_wasserportal(
-  station = station,
-  type = "daily",
-  from_date = from_date,
-  include_raw_time = TRUE,
-  stations_crosstable = stations_crosstable
-)})}
-), nm = stations_crosstable$Messstellennummer)
-
-str(sw_stations_daily)
-
-
+if (FALSE)
+{
+  `%>%` <- magrittr::`%>%`
+
+  stations_crosstable <- wasserportal::get_stations(type = "crosstable")
+
+  stations_crosstable_bb <- stations_crosstable %>%
+    dplyr::filter(stringr::str_detect(
+      .data$Messstellennummer,
+      pattern = "^[A-Z]{2}_"
+    ))
+
+  stations_crosstable_berlin <- stations_crosstable %>%
+    dplyr::filter(stringr::str_detect(
+      .data$Messstellennummer,
+      pattern = "^[A-Z]{2}_",
+      negate = TRUE
+    ))
+
+  stations_crosstable_berlin
+
+  from_date <- "1900-01-01"
+
+  sw_station_berlin_daily <- wasserportal::read_wasserportal_raw(
+    station = stations_crosstable_berlin[1L, ] %>%
+      kwb.utils::selectColumns("Messstellennummer"),
+    variable = wasserportal::get_station_variables(stations_crosstable_berlin)[1],
+    type = "daily",
+    from_date = from_date,
+    include_raw_time = TRUE,
+    stations_crosstable = stations_crosstable
+  )
+
+  str(sw_station_berlin_daily)
+
+  sw_stations_berlin_daily <- stations_crosstable_berlin %>%
+    kwb.utils::selectColumns("Messstellennummer") %>%
+    lapply(function(station) cat_and_run(
+      sprintf("Fetching data for station '%s'", station),
+      expr = wasserportal::read_wasserportal(
+        station = station,
+        type = "daily",
+        from_date = from_date,
+        include_raw_time = TRUE,
+        stations_crosstable = stations_crosstable
+      )
+    )) %>%
+    stats::setNames(
+      kwb.utils::selectColumns(stations_crosstable, "Messstellennummer")
+    )
+
+  str(sw_stations_daily)
 }
-
diff --git a/R/get_daily_surfacewater_data.R b/R/get_daily_surfacewater_data.R
@@ -13,7 +13,6 @@
 #' variables
 #' sw_data_daily <- wasserportal::get_daily_surfacewater_data(stations, variables)
 #' }
-#' @importFrom kwb.utils catAndRun
 #' @importFrom dplyr bind_rows filter pull
 #' @importFrom stats setNames
 get_daily_surfacewater_data <- function(
@@ -23,17 +22,17 @@ get_daily_surfacewater_data <- function(
 )
 {
   #kwb.utils::assignPackageObjects("wasserportal")
-  overviews <- kwb.utils::selectElements(stations, "overview_list")
-  crosstable <- kwb.utils::selectElements(stations, "crosstable")
+  overviews <- select_elements(stations, "overview_list")
+  crosstable <- select_elements(stations, "crosstable")
 
   data_frames <- lapply(names(variables), function(variable_name) {
 
     #variable_name <- names(variables)[1L]
 
-    kwb.utils::catAndRun(sprintf("Importing '%s'", variable_name), expr = {
+    cat_and_run(sprintf("Importing '%s'", variable_name), expr = {
 
       # data frame with stations at which <variable_name> is measured
-      station_data <- kwb.utils::selectElements(overviews, variable_name)
+      station_data <- select_elements(overviews, variable_name)
 
       # Identifiers of non-external monitoring stations to loop through
       station_ids <- get_non_external_station_ids(station_data)
@@ -87,17 +86,18 @@ get_daily_surfacewater_data <- function(
 get_surfacewater_variables <- function()
 {
   variables <- unlist(get_overview_options())
-  variables[startsWith(names(variables), "surface")]
+  variables <- variables[startsWith(names(variables), "surface")]
+  variables[variables != "opq"]
 }
 
 # get_non_external_station_ids -------------------------------------------------
 get_non_external_station_ids <- function(station_data)
 {
   # Function to safely select columns from station_data
-  pull <- kwb.utils::createAccessor(station_data)
+  pull <- create_accessor(station_data)
 
   is_external <- is_external_link(pull("stammdaten_link"))
-  is_berlin <- pull("Betreiber") == "Land Berlin"
+  is_berlin <- default_if_na(pull("Betreiber"), "") == "Land Berlin"
 
   # Identifiers of monitoring stations to loop through
   as.character(pull("Messstellennummer")[is_berlin & !is_external])
@@ -115,7 +115,6 @@ get_non_external_station_ids <- function(station_data)
 #' @importFrom stringr str_detect str_split_fixed
 #' @importFrom tibble tibble
 #' @importFrom dplyr bind_cols bind_rows
-#' @importFrom kwb.utils getAttribute
 sw_data_list_to_df <- function (sw_data_list)
 {
   # Helper function to split parameter string into parameter and unit
@@ -136,7 +135,7 @@ sw_data_list_to_df <- function (sw_data_list)
 
     # Get its metadata
     metadata <- if (!is.null(data)) {
-      kwb.utils::getAttribute(data, "metadata")
+      get_attribute(data, "metadata")
     } else {
       message(sprintf(
         "Empty data frame when looping through '%s' in %s",

diff --git a/R/get_groundwater_data.R b/R/get_groundwater_data.R
@@ -2,15 +2,16 @@
 #'
 #' @description wrapper function to scrape all available raw data, i.e. groundwater
 #' level and quality data and save in list
-#' @param stations stations list as retrieved by \code{\link{get_stations}}
+#' @param stations list as retrieved by \code{\link{get_stations}}.
+#'   Deprecated. Please use \code{stations_list} instead
 #' @param groundwater_options as retrieved by \code{\link{get_groundwater_options}}
 #' @param debug print debug messages (default: TRUE)
-#'
+#' @param stations_list list of station metadata as returned by
+#'   \code{\link{get_stations}(type = "list")}
 #' @return list with elements "groundwater.level" and "groundwater.quality" data
 #' frames
 #' @export
 #' @importFrom stats setNames
-#' @importFrom kwb.utils catAndRun
 #' @importFrom data.table rbindlist
 #' @examples
 #' \dontrun{
@@ -21,30 +22,35 @@
 get_groundwater_data <- function(
     stations,
     groundwater_options = get_groundwater_options(),
-    debug = TRUE
+    debug = TRUE,
+    stations_list = NULL
 )
 {
   #kwb.utils::assignPackageObjects("wasserportal")
+
+  if (is.null(stations_list)) {
+    stations_list <- select_elements(stations, "overview_list")
+  }
+
   result <- lapply(
     X = seq_along(groundwater_options),
     FUN = function(i) {
       option_key <- groundwater_options[i]
       option_name <- names(option_key)
-      kwb.utils::catAndRun(
+      cat_and_run(
         messageText = sprintf(
           "Importing '%s' data (%d/%d)",
           option_name, i, length(groundwater_options)
         ),
         dbg = debug,
         expr = {
-          ids <- stations %>%
-            kwb.utils::selectElements("overview_list") %>%
-            kwb.utils::selectElements(option_name) %>%
-            kwb.utils::selectColumns("Messstellennummer")
+          ids <- stations_list %>%
+            select_elements(option_name) %>%
+            select_columns("Messstellennummer")
           lapply(
             X = ids,
             FUN = function(id) {
-              kwb.utils::catAndRun(
+              cat_and_run(
                 sprintf(
                   "Downloading Messstellennummer '%s' (%d/%d)",
                   id, which(id == ids), length(ids)
@@ -75,6 +81,5 @@ get_groundwater_options <- function ()
 
   is_groundwater <- startsWith(names(overview_options), "groundwater")
 
-  overview_options[is_groundwater] %>%
-    gsub(pattern = "gws", replacement = "gwl")
+  overview_options[is_groundwater]
 }
diff --git a/R/get_overview_options.R b/R/get_overview_options.R
@@ -17,7 +17,8 @@ get_overview_options <- function()
       conductivity = "olf",
       ph = "oph",
       oxygen_concentration = "oog",
-      oxygen_saturation = "oos"
+      oxygen_saturation = "oos",
+      quality = "opq"
     ),
     groundwater = list(
       level = "gws",