Define Helper Functions
library(kwb.geosalz)
add_label <- function(
df,
columns = c("Nummer", "start", "end", "n", "interval")
)
{
df %>%
dplyr::mutate(label = wasserportal::columns_to_labels(
data = df,
columns = columns,
fmt = "<p>%s: %s</p>",
sep = ""
))
}
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, 0)
)
}
difftime_to_numeric <- function(df) {
df %>%
dplyr::rename(
period_days = .data$period,
interval_days = .data$interval
) %>%
dplyr::mutate(
period_days = as.numeric(.data$period_days),
interval_days = as.numeric(.data$interval_days)
)
}
remove_na_and_geometry <- function(df) {
if (any(names(df) == "label")) {
df <- dplyr::select(df, - .data$label)
}
sf::st_geometry(df) <- NULL
df %>%
dplyr::select_if(function(x){!all(is.na(x))})
}
library(kwb.geosalz)
### Set target CRS
crs_target <- 4326
### Load SVM Boundaries
shp_svm_path <- system.file(
"extdata/gis/shapefiles/svm_south.shp",
package = "kwb.geosalz"
)
svm <- sf::st_read(shp_svm_path) %>%
sf::st_transform(crs = crs_target)
#> Reading layer `svm_south' from data source
#> `D:\a\_temp\Library\kwb.geosalz\extdata\gis\shapefiles\svm_south.shp'
#> using driver `ESRI Shapefile'
#> Simple feature collection with 1 feature and 2 fields
#> Geometry type: POLYGON
#> Dimension: XY
#> Bounding box: xmin: 13.49052 ymin: 52.3341 xmax: 13.75224 ymax: 52.45715
#> Geodetic CRS: WGS 84
sf::st_crs(svm)
#> Coordinate Reference System:
#> User input: EPSG:4326
#> wkt:
#> GEOGCRS["WGS 84",
#> ENSEMBLE["World Geodetic System 1984 ensemble",
#> MEMBER["World Geodetic System 1984 (Transit)"],
#> MEMBER["World Geodetic System 1984 (G730)"],
#> MEMBER["World Geodetic System 1984 (G873)"],
#> MEMBER["World Geodetic System 1984 (G1150)"],
#> MEMBER["World Geodetic System 1984 (G1674)"],
#> MEMBER["World Geodetic System 1984 (G1762)"],
#> MEMBER["World Geodetic System 1984 (G2139)"],
#> ELLIPSOID["WGS 84",6378137,298.257223563,
#> LENGTHUNIT["metre",1]],
#> ENSEMBLEACCURACY[2.0]],
#> PRIMEM["Greenwich",0,
#> ANGLEUNIT["degree",0.0174532925199433]],
#> CS[ellipsoidal,2],
#> AXIS["geodetic latitude (Lat)",north,
#> ORDER[1],
#> ANGLEUNIT["degree",0.0174532925199433]],
#> AXIS["geodetic longitude (Lon)",east,
#> ORDER[2],
#> ANGLEUNIT["degree",0.0174532925199433]],
#> USAGE[
#> SCOPE["Horizontal component of 3D system."],
#> AREA["World."],
#> BBOX[-90,-180,90,180]],
#> ID["EPSG",4326]]
polygon_svm_fri <- svm$geometry[svm$name == "Friedrichshagen"]
stations <- wasserportal::get_stations()
#> Importing 9 station overviews from Wasserportal Berlin ... ok. (10.50 secs)
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)
)
#> Importing 62 station metadata from Wasserportal Berlin ... ok. (46.66 secs)
swl_master_sf <- swl_master %>%
kwb.geosalz::convert_to_sf(crs_target = crs_target) %>%
sf::st_filter(y = polygon_svm_fri) %>%
add_label(columns = c("Nummer", "Gewaesser", "Auspraegung", "Betreiber"))
swl_master <- swl_master %>%
dplyr::filter(.data$Nummer %in% swl_master_sf$Nummer)
readr::write_csv2(swl_master, file = "swl_master.csv")
swl_data_list <- stats::setNames(
lapply(swl_master$Nummer, function(station) {
wasserportal::read_wasserportal(
station = station,
from_date = "1900-01-01",
variables = "ows",
type = "daily",
stations_crosstable = stations$crosstable
)
}),
nm = swl_master$Nummer
)
#> Reading 'NA' for station 5827103 (station_5827103) ... ok. (0.83 secs)
#> Warning in warning_not_implemented("merge_raw_results_daily()"):
#> merge_raw_results_daily() is not yet implemented. Returning raw data
#> Reading 'NA' for station 5827101 (station_5827101) ... ok. (0.48 secs)
#> Warning in warning_not_implemented("merge_raw_results_daily()"):
#> merge_raw_results_daily() is not yet implemented. Returning raw data
#> Reading 'NA' for station 5826702 (station_5826702) ... ok. (0.40 secs)
#> Warning in warning_not_implemented("merge_raw_results_daily()"):
#> merge_raw_results_daily() is not yet implemented. Returning raw data
#> Reading 'NA' for station 5826701 (station_5826701) ... ok. (0.46 secs)
#> Warning in warning_not_implemented("merge_raw_results_daily()"):
#> merge_raw_results_daily() is not yet implemented. Returning raw data
#> Reading 'NA' for station 5862811 (station_5862811) ... ok. (0.38 secs)
#> Warning in warning_not_implemented("merge_raw_results_daily()"):
#> merge_raw_results_daily() is not yet implemented. Returning raw data
swl_data <- stats::setNames(
lapply(names(swl_data_list), function(name) {
swl_data_list[[name]][[1]]
}),
names(swl_data_list)
) %>%
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 = .data$Tagesmittelwert) %>%
dplyr::left_join(
swl_master[, c("Nummer", "Pegelnullpunkt_m")],
by = c("Messstellennummer" = "Nummer")
) %>%
dplyr::mutate(
Tagesmittelwert_Pegelstand_mNN = as.numeric(.data$Pegelnullpunkt_m) +
.data$Tagesmittelwert_cm_ueber_Pegelnullpunkt/100
) %>%
dplyr::select(- .data$Pegelnullpunkt_m)
#> Warning: Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.
#> ℹ Please use `"Tagesmittelwert"` instead of `.data$Tagesmittelwert`
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
#> Warning: Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.
#> ℹ Please use `"Pegelnullpunkt_m"` instead of `.data$Pegelnullpunkt_m`
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
readr::write_csv2(swl_data, file = "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")
)
#> Warning: Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.
#> ℹ Please use `"label"` instead of `.data$label`
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
#> Warning: Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.
#> ℹ Please use `"period"` instead of `.data$period`
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
#> Warning: Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.
#> ℹ Please use `"interval"` instead of `.data$interval`
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
readr::write_csv2(swl_data_stats_export, file = "swl_data_stats.csv")
gwl_master <- jsonlite::fromJSON(
"https://kwb-r.github.io/wasserportal/stations_gwl_master.json"
)
gwl_master_sf <- gwl_master %>%
kwb.geosalz::convert_to_sf(crs_target = crs_target) %>%
sf::st_filter(y = polygon_svm_fri)
gwl_master <- gwl_master %>%
dplyr::filter(.data$Nummer %in% gwl_master_sf$Nummer)
readr::write_csv2(gwl_master, file = "gwl_master.csv")
gwl_data <- data.table::rbindlist(
lapply(gwl_master$Nummer, function(id) {
wasserportal::read_wasserportal_raw_gw(station = id, stype = "gwl")
})
)
readr::write_csv2(gwl_data, file = "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")
)
readr::write_csv2(gwl_data_stats_export, file = "gwl_data_stats.csv")
gwl_master_stats <- gwl_master %>%
dplyr::left_join(gwl_data_stats, by = c("Nummer" = "Messstellennummer")) %>%
add_label()
gwq_master <- jsonlite::fromJSON(
"https://kwb-r.github.io/wasserportal/stations_gwq_master.json"
)
gwq_master_sf <- gwq_master %>%
kwb.geosalz::convert_to_sf(crs_target = crs_target) %>%
sf::st_filter(y = polygon_svm_fri)
gwq_master <- gwq_master %>%
dplyr::filter(.data$Nummer %in% gwq_master_sf$Nummer)
readr::write_csv2(gwq_master, file = "gwq_master.csv")
gw_master <- gwl_master %>%
dplyr::full_join(gwq_master) %>%
dplyr::mutate(Nummer = as.integer(.data$Nummer)) %>%
dplyr::arrange(.data$Nummer)
#> Joining with `by = join_by(Nummer, Bezirk, Betreiber, Auspraegung,
#> Grundwasserleiter, Gelaendeoberkante_GOK_m_ue_NHN, Rohroberkante_m_ue_NHN,
#> Filteroberkante_m_u_GOK, Filterunterkante_m_u_GOK, Rechtswert_UTM_33_N,
#> Hochwert_UTM_33_N)`
readr::write_csv2(gw_master, file = "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)
readr::write_csv2(
gwq_data,
file = "gwq_data.csv"
)
gwq_chloride_data <- gwq_data %>%
dplyr::filter(.data$Parameter == "Chlorid")
readr::write_csv2(
gwq_chloride_data,
file = "gwq_chloride_data.csv"
)
gwq_chloride_master <- gwq_master %>%
dplyr::filter(.data$Nummer %in% gwq_chloride_data$Messstellennummer)
readr::write_csv2(
gwq_chloride_master,
file = "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")
)
readr::write_csv2(
gwq_chloride_data_stats_export,
file = "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_label()
readr::write_csv2(
gwq_chloride_master_stats,
file = "gwq_chloride_master_stats.csv"
)
# Print Map
basemap <- svm %>%
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addProviderTiles(leaflet::providers$CartoDB.Positron) %>%
leaflet::addPolygons(color = "red", fill = FALSE)
swl_map <- basemap %>%
leaflet::addCircles(
data = swl_master_sf,
color = "blue",
opacity = 0.4,
label = lapply(swl_master_sf$label, htmltools::HTML)
) %>%
leaflet::addLegend(
position = "topright",
colors = c("red", "darkblue"),
labels = c("SVM Modellgrenze", "OW-Stand (Wasserportal)"),
title = "Legende"
)
gwl_map <- basemap %>%
leaflet::addCircles(
data = kwb.geosalz::convert_to_sf(gwl_master_stats),
color = "blue",
opacity = 0.4,
label = lapply(gwl_master_stats$label, htmltools::HTML)
) %>%
leaflet::addLegend(
position = "topright",
colors = c("red", "blue"),
labels = c("SVM Modellgrenze", "GW-Stand (Wasserportal)"),
title = "Legende"
)
gwq_map <- basemap %>%
leaflet::addCircles(
data = kwb.geosalz::convert_to_sf(gwq_chloride_master_stats),
color = "orange",
opacity = 0.4,
label = lapply(gwq_chloride_master_stats$label, htmltools::HTML)
) %>%
leaflet::addLegend(
position = "topright",
colors = c("red", "orange"),
labels = c("SVM Modellgrenze", "GW-G\u00FCte (Wasserportal)"),
title = "Legende"
)
swl_mapMaps
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
Groundwater
Master Data
for Groundwater Levels and Groundwater Levels