Define Helper Functions
library(kwb.fisbroker)
get_id <- function(data) {
data %>%
dplyr::filter(.data$parameter %in% c("Rechneradresse",
"ATOM-Feed-Url")) %>%
dplyr::mutate(url = .data$value,
id = basename(.data$value))
}
get_metadata_from_ghpages <- function() {
paths_list <- list(
base_url = "https://kwb-r.github.io/kwb.fisbroker/metadata_",
file_format = ".json",
atom = "<base_url>atom<file_format>",
wfs = "<base_url>wfs<file_format>",
wms = "<base_url>wms<file_format>"
)
paths <- kwb.utils::resolve(paths_list)
meta_paths <- paths[names(paths) %in% c("atom", "wfs", "wms")]
stats::setNames(lapply(meta_paths, function(path) {
jsonlite::read_json(path, simplifyVector = TRUE) %>%
get_id()
}), names(meta_paths))
}
write_wfs_as <- function(format = "nc", #use netCDF as default!
data_wfs,
target_dir = tempdir(),
dbg = TRUE) {
fs::dir_create(target_dir)
lapply(seq_len(length(data_wfs)), function(i) {
id <- names(data_wfs)[i]
file <- sprintf("%s/%s.%s", fs::path_abs(target_dir), id, format)
kwb.utils::catAndRun(messageText = sprintf("Exporting (%d/%d): '%s' to '%s'",
i,
length(data_wfs),
id,
file),
expr = {sf::st_write(data_wfs[[i]], file)},
dbg = dbg)
})
}Metdata
meta <- get_metadata_from_ghpages()
str(meta)
#> List of 3
#> $ atom:'data.frame': 136 obs. of 6 variables:
#> ..$ identifier: chr [1:136] "K.lod1@senstadt" "K.lod2@senstadt" "K.k_adressenberlin@senstadt" "K.AD_AdressenBerlin_K@senstadt" ...
#> ..$ section : chr [1:136] "Technische Angaben" "Technische Angaben" "Technische Angaben" "Technische Angaben" ...
#> ..$ parameter : chr [1:136] "ATOM-Feed-Url" "ATOM-Feed-Url" "ATOM-Feed-Url" "ATOM-Feed-Url" ...
#> ..$ value : chr [1:136] "https://fbinter.stadt-berlin.de/fb/feed/senstadt/a_lod1" "https://fbinter.stadt-berlin.de/fb/feed/senstadt/a_lod2" "https://fbinter.stadt-berlin.de/fb/feed/senstadt/a_adressenberlin" "https://fbinter.stadt-berlin.de/fb/feed/senstadt/a_AD_AdressenBerlin" ...
#> ..$ url : chr [1:136] "https://fbinter.stadt-berlin.de/fb/feed/senstadt/a_lod1" "https://fbinter.stadt-berlin.de/fb/feed/senstadt/a_lod2" "https://fbinter.stadt-berlin.de/fb/feed/senstadt/a_adressenberlin" "https://fbinter.stadt-berlin.de/fb/feed/senstadt/a_AD_AdressenBerlin" ...
#> ..$ id : chr [1:136] "a_lod1" "a_lod2" "a_adressenberlin" "a_AD_AdressenBerlin" ...
#> $ wfs :'data.frame': 403 obs. of 6 variables:
#> ..$ identifier: chr [1:403] "K.k_adressenberlin@senstadt" "K.k_rbs_adr@senstadt" "K.k_alkis_bezirke@senstadt" "K.k_alkis_flurstuecke@senstadt" ...
#> ..$ section : chr [1:403] "Technische Angaben" "Technische Angaben" "Technische Angaben" "Technische Angaben" ...
#> ..$ parameter : chr [1:403] "Rechneradresse" "Rechneradresse" "Rechneradresse" "Rechneradresse" ...
#> ..$ value : chr [1:403] "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s_wfs_adressenberlin" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s_rbs_adr" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s_wfs_alkis_bezirk" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s_wfs_alkis" ...
#> ..$ url : chr [1:403] "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s_wfs_adressenberlin" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s_rbs_adr" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s_wfs_alkis_bezirk" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s_wfs_alkis" ...
#> ..$ id : chr [1:403] "s_wfs_adressenberlin" "s_rbs_adr" "s_wfs_alkis_bezirk" "s_wfs_alkis" ...
#> $ wms :'data.frame': 509 obs. of 6 variables:
#> ..$ identifier: chr [1:509] "K.k_adressenberlin@senstadt" "K.AD_AdressenBerlin_K@senstadt" "K.k_rbs_adr@senstadt" "K.wmsk_afis@senstadt" ...
#> ..$ section : chr [1:509] "Technische Angaben" "Technische Angaben" "Technische Angaben" "Technische Angaben" ...
#> ..$ parameter : chr [1:509] "Rechneradresse" "Rechneradresse" "Rechneradresse" "Rechneradresse" ...
#> ..$ value : chr [1:509] "https://fbinter.stadt-berlin.de/fb/wms/senstadt/k_adressenberlin" "https://fbinter.stadt-berlin.de/fb/wms/senstadt/AD_AdressenBerlin_K" "https://fbinter.stadt-berlin.de/fb/wms/senstadt/k_rbs_adr" "https://fbinter.stadt-berlin.de/fb/wms/senstadt/wmsk_afis" ...
#> ..$ url : chr [1:509] "https://fbinter.stadt-berlin.de/fb/wms/senstadt/k_adressenberlin" "https://fbinter.stadt-berlin.de/fb/wms/senstadt/AD_AdressenBerlin_K" "https://fbinter.stadt-berlin.de/fb/wms/senstadt/k_rbs_adr" "https://fbinter.stadt-berlin.de/fb/wms/senstadt/wmsk_afis" ...
#> ..$ id : chr [1:509] "k_adressenberlin" "AD_AdressenBerlin_K" "k_rbs_adr" "wmsk_afis" ...
overview <- kwb.fisbroker::get_dataset_overview()
#> Login to FIS-Broker ... ok. (2.82s)
#> Getting HTML text from 'https://fbinter.stadt-be...d=navigationFrameResult' ... ok. (1.31s)
str(overview)
#> 'data.frame': 1840 obs. of 7 variables:
#> $ category_id : int 1 1 1 1 1 1 1 1 1 1 ...
#> $ category_name: Factor w/ 9 levels "Basisdaten/Luftbilder",..: 1 1 1 1 1 1 1 1 1 1 ...
#> $ dataset_id : int 1 1 2 2 3 3 3 3 4 4 ...
#> $ dataset_name : chr "3D-Gebäudemodelle im Level of Detail 1 (LoD 1)" "3D-Gebäudemodelle im Level of Detail 1 (LoD 1)" "3D-Gebäudemodelle im Level of Detail 2 (LoD 2)" "3D-Gebäudemodelle im Level of Detail 2 (LoD 2)" ...
#> $ cmd : Factor w/ 2 levels "navigationShowResult",..: 1 2 1 2 1 2 2 2 1 2 ...
#> $ type : Factor w/ 4 levels "","ATOM","WMS",..: 1 2 1 2 1 3 4 2 1 3 ...
#> $ identifier : chr "K.lod1%40senstadt" "K.lod1@senstadt" "K.lod2%40senstadt" "K.lod2@senstadt" ...
#> - attr(*, "session_id")= chr "2CB3D9F1A2C77DE4801685319765A3E7"
### There are more "overview" identifiers than "ids/urls" (i.e. WFS files). T
### Thus multiple identifiers use the same WFS
### (limit to 2 categories: "Umweltbeobachtung" and "Umweltschutz")
### if you want to import everything remove the "dplyr::filter" below
meta_wfs <- meta$wfs %>%
dplyr::left_join(overview) %>%
dplyr::filter(.data$category_name %in% c("Umweltbeobachtung", "Umweltschutz"))
#> Joining, by = "identifier"
str(meta_wfs)
#> 'data.frame': 214 obs. of 12 variables:
#> $ identifier : chr "K.k08_07_2tehganlagen@senstadt" "K.k08_07_2tehganlagen@senstadt" "K.wmsk_03_12_2emissionen@senstadt" "K.wmsk_03_12_2emissionen@senstadt" ...
#> $ section : chr "Technische Angaben" "Technische Angaben" "Technische Angaben" "Technische Angaben" ...
#> $ parameter : chr "Rechneradresse" "Rechneradresse" "Rechneradresse" "Rechneradresse" ...
#> $ value : chr "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s08_07_2tehganlagen" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s08_07_2tehganlagen" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s03_12_2emissionen" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s03_12_2emissionen" ...
#> $ url : chr "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s08_07_2tehganlagen" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s08_07_2tehganlagen" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s03_12_2emissionen" "https://fbinter.stadt-berlin.de/fb/wfs/data/senstadt/s03_12_2emissionen" ...
#> $ id : chr "s08_07_2tehganlagen" "s08_07_2tehganlagen" "s03_12_2emissionen" "s03_12_2emissionen" ...
#> $ category_id : int 7 7 7 7 7 7 7 7 7 7 ...
#> $ category_name: Factor w/ 9 levels "Basisdaten/Luftbilder",..: 7 7 7 7 7 7 7 7 7 7 ...
#> $ dataset_id : int 458 458 459 459 460 460 461 461 462 462 ...
#> $ dataset_name : chr "CO2-Emissionen durch Anlagen nach dem Treibhausgas-Emissionshandelsgesetz TEHG (Umweltatlas)" "CO2-Emissionen durch Anlagen nach dem Treibhausgas-Emissionshandelsgesetz TEHG (Umweltatlas)" "Entwicklung Luftqualität - Emissionen 2015 (Umweltatlas)" "Entwicklung Luftqualität - Emissionen 2015 (Umweltatlas)" ...
#> $ cmd : Factor w/ 2 levels "navigationShowResult",..: 2 2 2 2 2 2 2 2 2 2 ...
#> $ type : Factor w/ 4 levels "","ATOM","WMS",..: 3 4 3 4 3 4 3 4 3 4 ...
nrow(meta_wfs)
#> [1] 214
urls <- unique(meta_wfs$url)[order(unique(meta_wfs$url))]
length(urls)
#> [1] 76Multiple WFS Datasets
The code below reads (into R as sf object), checks (the R data structure) and exports (to NetCDF) 76 WFS datasets (out of in total 214 available at FIS-Broker.
Export
write_wfs_as(format = "shp", data_wfs = data_wfs)
# Exporting (19/76): 's_04_08_1lniederschl_bl_8110' to 'C:/Users/mrustl/Documents/RProjects/kwb.fisbroker/vignettes/shapefiles/s_04_08_1lniederschl_bl_8110.shp' ... Warnung: Field names abbreviated for ESRI Shapefile driverWriting layer `s_04_08_1lniederschl_bl_8110' to data source
# `C:/Users/mrustl/Documents/RProjects/kwb.fisbroker/vignettes/shapefiles/s_04_08_1lniederschl_bl_8110.shp' using driver `ESRI Shapefile'
# Warnung: GDAL Message 6: Normalized/laundered field name: 'rgn_8110_ww_j' to 'rgn_8110_w'Warnung: GDAL Message 6: Normalized/laundered field name: 'rgn_8110_ww_s' to 'rgn_8110_1'Warnung: GDAL Message 6: Normalized/laundered field name: 'rgn_8110_ww_w' to 'rgn_8110_2'Writing 25352 features with 4 fields and geometry type Multi Polygon.
# Unknown field name `rgn_8110_ww_j': updating a layer with improper field name(s)?
# Error in CPL_write_ogr(obj, dsn, layer, driver, as.character(dataset_options),
exp_ds <- data_wfs[which(!sapply(data_wfs, kwb.utils::isTryError))]
export_nc <- stats::setNames(lapply(seq_len(length(exp_ds)), function(i) { try(write_wfs_as(format = "nc", data_wfs = exp_ds[i], target_dir = "./netCDF"))}), names(exp_ds))