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)
#> 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
# Print information on the CRS
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]]
# 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()
#> Importing 10 station overviews from Wasserportal Berlin ... ok. (8.82 secs)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")
})
#> Importing master data for 61 stations from Wasserportal Berlin ... ok. (31.76 secs)
#> Failed fetching data from the following URLs:
#> [1] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5865900"
#> [2] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5827103"
#> [3] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5870400"
#> [4] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5865300"
#> [5] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5819900"
#> [6] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5864801"
#> [7] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5861101"
#> [8] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800107"
#> [9] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800317"
#> [10] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867003"
#> [11] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867401"
#> [12] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800301"
#> [13] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5863000"
#> [14] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867900"
#> [15] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5827101"
#> [16] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800320"
#> [17] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800313"
#> [18] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5860900"
#> [19] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867101"
#> [20] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5826702"
#> [21] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800305"
#> [22] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800304"
#> [23] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800306"
#> [24] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5861000"
#> [25] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867300"
#> [26] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5864700"
#> [27] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5865000"
#> [28] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5865200"
#> [29] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800308"
#> [30] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867100"
#> [31] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5869700"
#> [32] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867500"
#> [33] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5870100"
#> [34] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800309"
#> [35] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5819901"
#> [36] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800318"
#> [37] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5826701"
#> [38] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800315"
#> [39] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800316"
#> [40] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867700"
#> [41] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5803500"
#> [42] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800312"
#> [43] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867000"
#> [44] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800106"
#> [45] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5866700"
#> [46] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5866800"
#> [47] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5862811"
#> [48] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867600"
#> [49] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5827700"
#> [50] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5820000"
#> [51] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5815911"
#> [52] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5803200"
#> [53] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867301"
#> [54] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867201"
#> [55] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867202"
#> [56] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800310"
#> [57] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5800314"
#> [58] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5861200"
#> [59] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5867001"
#> [60] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5864800"
#> [61] "https://wasserportal.berlin.de/station.php?anzeige=i&thema=ows&station=5866301"
#> Error in `[.data.frame`(x, i) : undefined columns selectedDownload 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()
})
#> Writing gwl_master to gwl_master.csv ... ok. (0.09 secs)
#> Error : Could not find the header row (starting with 'Datum')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")
})
#> Writing gwq_master to gwq_master.csv ... ok. (0.01 secs)
#> 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)`
#> Writing gw_master to gw_master.csv ... ok. (0.01 secs)
#> Writing gwq_data to gwq_data.csv ... ok. (0.16 secs)
#> Writing gwq_chloride_data to gwq_chloride_data.csv ... ok. (0.11 secs)
#> Writing gwq_chloride_master to gwq_chloride_master.csv ... ok. (0.01 secs)
#> Writing gwq_chloride_data_stats_export to gwq_chloride_data_stats.csv ... ok. (0.01 secs)
#> Writing gwq_chloride_master_stats to gwq_chloride_master_stats.csv ... ok. (0.01 secs)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"
))
#> Error in eval(expr, envir) : object 'swl_master_sf' not found
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"
))
#> Error in eval(expr, envir) : object 'gwl_master_stats' not found
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)
#> [1] "Error in eval(expr, envir) : object 'swl_master_sf' not found\n"
#> attr(,"class")
#> [1] "try-error"
#> attr(,"condition")
#> <simpleError in eval(expr, envir): object 'swl_master_sf' not found>
print(gwl_map)
#> [1] "Error in eval(expr, envir) : object 'gwl_master_stats' not found\n"
#> attr(,"class")
#> [1] "try-error"
#> attr(,"condition")
#> <simpleError in eval(expr, envir): object 'gwl_master_stats' not found>
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
Groundwater
Master Data
for Groundwater Levels and Groundwater Levels