In KWB-R/kwb.geosalz: R Package for Documenting Workflow Used in Project "geosalz"

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

Define Helper Functions

library(kwb.geosalz)

add_label <- function(df, columns) {
  df %>%
    dplyr::mutate(label = wasserportal::columns_to_labels(
      data = df,
      columns = columns,
      fmt = "<p>%s: %s</p>",
      sep = ""
    ))
}

add_interval_label <- function(df) {
  add_label(df, c("Nummer", "start", "end", "n", "interval"))
}

add_waterbody_label <- function(df) {
  add_label(df, c("Nummer", "Gewaesser", "Auspraegung", "Betreiber"))
}

get_data_stats <- function(df, group_col = "Messstellennummer") {
  df %>%
    dplyr::group_by(.data[[group_col]]) %>%
    dplyr::summarise(
      start = min(as.Date(.data$Datum)),
      end = max(as.Date(.data$Datum)),
      period = diff(c(.data$start, .data$end)),
      n = dplyr::n(),
      interval = round(.data$period / .data$n)
    )
}

difftime_to_numeric <- function(df) {
  df %>%  
    dplyr::rename(
      period_days = "period", 
      interval_days = "interval"
    ) %>% 
    dplyr::mutate(
      period_days = as.numeric(.data$period_days),
      interval_days = as.numeric(.data$interval_days)
    )
}

remove_na_and_geometry <- function(df) {
  df %>%
    kwb.utils::removeColumns("label") %>%
    kwb.utils::removeEmptyColumns(dbg = FALSE) %>%
    remove_geometry()
}

remove_geometry <- function(df) {
  sf::st_geometry(df) <- NULL
  df
}

write_csv <- function(x, file) {
  kwb.utils::catAndRun(
    sprintf("Writing %s to %s", deparse(substitute(x)), file),
    readr::write_csv2(x, file)
  )
}

# Function to create a map
create_map <- function(
    basemap, data, labels, legend_label, legend_color, circle_color
)
{
  basemap %>%
    leaflet::addCircles(
      data = data,
      color = circle_color,
      opacity = 0.4,
      label = lapply(labels, htmltools::HTML)
    ) %>%
    leaflet::addLegend(
      position = "topright",
      colors = c("red", legend_color),
      labels = c("SVM Modellgrenze", legend_label),
      title = "Legende"
    )
}

Initialise objects

swl_data_stats_export <- NULL
gwl_data_stats_export <- NULL
gwq_chloride_data_stats_export <- NULL

# Load SVM boundaries and transform coordinate reference system (CRS)
svm <- "extdata/gis/shapefiles/svm_south.shp" %>%
  system.file(package = "kwb.geosalz") %>%
  sf::st_read() %>%
  sf::st_transform(crs = 4326)

# Print information on the CRS
sf::st_crs(svm)

# Function to filter for study area
filter_for_study_area <- function(x) {
  sf::st_filter(x, y = svm$geometry[svm$name == "Friedrichshagen"])
}

# Get information on "Wasserportal"-stations 
stations <- wasserportal::get_stations()

Download and Process Surface Water Level Data

try({

  swl_master <- wasserportal::get_wasserportal_masters_data(
    master_urls = stations$overview_list$surface_water.water_level %>%
      dplyr::filter(.data$Betreiber == "Land Berlin") %>%
      dplyr::pull(.data$stammdaten_link)
  ) 

  swl_master_sf <- swl_master %>%
    kwb.geosalz::convert_to_sf() %>%
    filter_for_study_area() %>%
    add_waterbody_label()

  swl_master <- swl_master %>% 
    dplyr::filter(.data$Nummer %in% swl_master_sf$Nummer) 

  write_csv(swl_master, "swl_master.csv")

  swl_data_list <- lapply(
    X = stats::setNames(nm = swl_master$Nummer),
    FUN = wasserportal::read_wasserportal,
    from_date = "1900-01-01",
    variables = "ows", 
    type = "daily",
    stations_crosstable = stations$crosstable
  )

  column_level_zero <- "Pegelnullpunkt_m_NHN"
  key_columns <- c("Nummer", column_level_zero)

  swl_data <- stats::setNames(nm = names(swl_data_list)) %>%
    lapply(function(name) swl_data_list[[name]][[1]]) %>% 
    dplyr::bind_rows(.id = "Messstellennummer") %>% 
    dplyr::mutate(Datum = as.Date(.data$Datum, format = "%d.%m.%Y")) %>% 
    dplyr::filter(.data$Tagesmittelwert != -777) %>% 
    dplyr::rename(
      Tagesmittelwert_cm_ueber_Pegelnullpunkt = "Tagesmittelwert"
    ) %>% 
    dplyr::left_join(
      swl_master[, ..key_columns],
      by = c(Messstellennummer = "Nummer")
    ) %>%  
    dplyr::mutate(
      Tagesmittelwert_Pegelstand_mNN = as.numeric(.data[[column_level_zero]]) +
        .data$Tagesmittelwert_cm_ueber_Pegelnullpunkt / 100
    ) %>% 
    kwb.utils::removeColumns(column_level_zero)

  write_csv(swl_data, "swl_data.csv")

  swl_data_stats <- get_data_stats(swl_data)

  swl_data_stats_export <- swl_master_sf %>% 
    remove_na_and_geometry() %>%
    dplyr::left_join(
      difftime_to_numeric(swl_data_stats),
      by = c("Nummer" = "Messstellennummer")
    )

  write_csv(swl_data_stats_export, "swl_data_stats.csv")
})

Download and Process Groundwater Level Data

try({

  gwl_master <- jsonlite::fromJSON(
    "https://kwb-r.github.io/wasserportal/stations_gwl_master.json"
  )

  gwl_master_sf <- gwl_master %>%
    kwb.geosalz::convert_to_sf() %>%
    filter_for_study_area()

  gwl_master <- gwl_master %>% 
    dplyr::filter(.data$Nummer %in% gwl_master_sf$Nummer)

  write_csv(gwl_master, "gwl_master.csv")

  gwl_data <- lapply(
    X = gwl_master$Nummer,
    FUN = wasserportal::read_wasserportal_raw_gw, 
    stype = "gwl"
  ) %>% 
    data.table::rbindlist()

  write_csv(gwl_data, "gwl_data.csv")

  gwl_data_stats <- get_data_stats(gwl_data) 

  gwl_data_stats_export <- gwl_master_sf %>% 
    remove_na_and_geometry() %>%
    dplyr::left_join(
      difftime_to_numeric(gwl_data_stats),
      by = c("Nummer" = "Messstellennummer")
    )

  write_csv(gwl_data_stats_export, "gwl_data_stats.csv")

  gwl_master_stats <- gwl_master %>%
    dplyr::left_join(gwl_data_stats, by = c(Nummer = "Messstellennummer")) %>%
    add_interval_label()

})

Download and Process Groundwater Quality Data

try({

  gwq_master <- jsonlite::fromJSON(
    "https://kwb-r.github.io/wasserportal/stations_gwq_master.json"
  )

  gwq_master_sf <- gwq_master %>%
    kwb.geosalz::convert_to_sf() %>%
    filter_for_study_area()

  gwq_master <- gwq_master %>% 
    dplyr::filter(.data$Nummer %in% gwq_master_sf$Nummer)

  write_csv(gwq_master, "gwq_master.csv")

  gw_master <- gwl_master %>%  
    dplyr::full_join(gwq_master) %>% 
    dplyr::mutate(Nummer = as.integer(.data$Nummer)) %>% 
    dplyr::arrange(.data$Nummer)

  write_csv(gw_master, "gw_master.csv")

  gwq_data <- jsonlite::fromJSON(
    "https://kwb-r.github.io/wasserportal/stations_gwq_data.json"
  ) %>%
    dplyr::filter(.data$Messstellennummer %in% gwq_master$Nummer)

  write_csv(gwq_data, "gwq_data.csv")

  gwq_chloride_data <- gwq_data %>%
    dplyr::filter(.data$Parameter == "Chlorid")

  write_csv(gwq_chloride_data, "gwq_chloride_data.csv")

  gwq_chloride_master <- gwq_master %>% 
    dplyr::filter(.data$Nummer %in% gwq_chloride_data$Messstellennummer)

  write_csv(gwq_chloride_master, "gwq_chloride_master.csv")

  gwq_chloride_data_stats <- gwq_chloride_data %>%
    get_data_stats()

  gwq_chloride_data_stats_export <- gwq_chloride_master %>%
    kwb.geosalz::convert_to_sf() %>% 
    remove_na_and_geometry() %>%
    dplyr::mutate(Nummer = as.integer(.data$Nummer)) %>% 
    dplyr::left_join(
      difftime_to_numeric(gwq_chloride_data_stats),
      by = c("Nummer" = "Messstellennummer")
    )

  write_csv(gwq_chloride_data_stats_export, "gwq_chloride_data_stats.csv")

  gwq_chloride_master_stats <- gwq_chloride_master %>%
    dplyr::mutate(Nummer = as.integer(.data$Nummer)) %>%
    dplyr::left_join(
      gwq_chloride_data_stats, 
      by = c("Nummer" = "Messstellennummer")
    ) %>%
    add_interval_label()

  write_csv(gwq_chloride_master_stats, "gwq_chloride_master_stats.csv")
})

Create Maps

basemap <- svm %>%
  leaflet::leaflet() %>%
  leaflet::addTiles() %>%
  leaflet::addProviderTiles(leaflet::providers$CartoDB.Positron) %>%
  leaflet::addPolygons(color = "red", fill = FALSE)

swl_map <- try(create_map(
  basemap,
  data = swl_master_sf, 
  labels = swl_master_sf$label,
  legend_label = "OW-Stand (Wasserportal)",
  legend_color = "darkblue",
  circle_color = "blue"
))

gwl_map <- try(create_map(
  basemap,
  data = kwb.geosalz::convert_to_sf(gwl_master_stats),
  labels = gwl_master_stats$label,
  legend_label = "GW-Stand (Wasserportal)",
  legend_color = "blue",
  circle_color = "blue"
))

gwq_map <- try(create_map(
  basemap,
  data = kwb.geosalz::convert_to_sf(gwq_chloride_master_stats),
  labels = gwq_chloride_master_stats$label,
  legend_label = "GW-G\u00FCte (Wasserportal)",
  legend_color = "orange",
  circle_color = "orange"
))

print(swl_map)
print(gwl_map)
print(gwq_map)

Save Maps

Save maps for full page view:

htmlwidgets::saveWidget(
  swl_map, 
  "./map_swl.html", 
  title = "SW level"
)

htmlwidgets::saveWidget(
  gwl_map, 
  "./map_gwl.html", 
  title = "GW level"
)

htmlwidgets::saveWidget(
  gwq_map, 
  "./map_gwq.html", 
  title = "GW quality (Chloride)"
)

Links to full-page view maps:

Datasets

Surface Water

Groundwater

Master Data

for Groundwater Levels and Groundwater Levels

https://kwb-r.github.io/kwb.geosalz/gw_master.csv

Groundwater Levels

Groundwater Quality

Tables

SW Levels

DT::datatable(swl_data_stats_export)

GW Levels

stats for groundwater levels

DT::datatable(gwl_data_stats_export)

GW Quality

stats for Chloride

DT::datatable(gwq_chloride_data_stats_export)

KWB-R/kwb.geosalz documentation built on July 4, 2025, 12:47 a.m.

rdrr.io home R language documentation Run R code online

CRAN packages Bioconductor packages R-Forge packages GitHub packages

Note that we can't provide technical support on individual packages. You should contact the package authors for that.

KWB-R/kwb.geosalz
R Package for Documenting Workflow Used in Project "geosalz"

In KWB-R/kwb.geosalz: R Package for Documenting Workflow Used in Project "geosalz"

Define Helper Functions

Initialise objects

Download and Process Surface Water Level Data

Download and Process Groundwater Level Data

Download and Process Groundwater Quality Data

Create Maps

Save Maps

Datasets

Surface Water

Groundwater

Master Data

Groundwater Levels

Groundwater Quality

Tables

SW Levels

GW Levels

GW Quality

R Package Documentation

Browse R Packages

We want your feedback!

KWB-R/kwb.geosalz R Package for Documenting Workflow Used in Project "geosalz"

In KWB-R/kwb.geosalz: R Package for Documenting Workflow Used in Project "geosalz"

Define Helper Functions

Initialise objects

Download and Process Surface Water Level Data

Download and Process Groundwater Level Data

Download and Process Groundwater Quality Data

Create Maps

Save Maps

Datasets

Surface Water

Groundwater

Master Data

Groundwater Levels

Groundwater Quality

Tables

SW Levels

GW Levels

GW Quality

R Package Documentation

Browse R Packages

We want your feedback!

KWB-R/kwb.geosalz
R Package for Documenting Workflow Used in Project "geosalz"