Skip to content

Instantly share code, notes, and snippets.

@z3tt
Last active April 8, 2021 09:10
Show Gist options
  • Save z3tt/8781769f5ab88d613a3735d863e7e46a to your computer and use it in GitHub Desktop.
Save z3tt/8781769f5ab88d613a3735d863e7e46a to your computer and use it in GitHub Desktop.
Doenload Berlin Shapefiles
#' Download data to draw Berlin template map
#' @examples download_data_berlin()
download_data_berlin <- function() {
## SETUP ---------------------------------------------------------------------
## output dir for raw geo files
dir <- here::here("data-raw", "geo-raw")
if (!dir.exists(dir)) dir.create(dir, showWarnings = TRUE, recursive = TRUE)
## DISTRICTS -----------------------------------------------------------------
## Berlin districts (WGS 84)
## Source: Technologiestiftung Berlin
json_file <- here::here("data-raw", "geo-raw", "bezirksgrenzen.geojson")
if(!file.exists(json_file)) {
## Download and unzip Berlin districts (WGS 84)
## - German: https://daten.odis-berlin.de/de/dataset/bezirksgrenzen
## - English: https://daten.odis-berlin.de/en/dataset/bezirksgrenzen
link <- "https://tsb-opendata.s3.eu-central-1.amazonaws.com/bezirksgrenzen/bezirksgrenzen.geojson"
message(paste0("Loading Berlin district data from ", link, "."))
curl::curl_download(link, destfile = json_file)
message(paste0("Downloaded to ", json_file, "."))
} else {
message(paste0("Berlin district data already exists: ", json_file, "."))
}
## OSM DATA ------------------------------------------------------------------
## Berlin OSM data (WGS 84)
## Source: OpenStreetMaps via Geofabrik
zip_file <- here::here("data-raw", "geo-raw", "berlin_shapes.zip")
shp_path <- here::here("data-raw", "geo-raw", "berlin_shapes")
if(!file.exists(glue::glue("{shp_path}/gis_osm_water_a_free_1.shp"))) {
## Download and unzip Berlin shapefiles (WGS 84)
## https://download.geofabrik.de/europe/germany/berlin.html
link <- "https://download.geofabrik.de/europe/germany/berlin-latest-free.shp.zip"
message(paste0("Loading Berlin OSM data from ", link, "."))
curl::curl_download(link, destfile = zip_file)
message(paste0("Unzip Berlin OSM data from ", zip_file, "."))
unzip(zipfile = zip_file, exdir = shp_path)
suppressMessages(file.remove(zip_file))
curl::curl_download(link, destfile = json_file)
message(paste0("Downloaded to ", shp_path, "/."))
} else {
message(paste0("Berlin OSM data already exists: ", shp_path, "/."))
}
}
## PREPARE DATA --------------------------------------------------------------
## Berlin districts (WGS 84)
## Source: Technologiestiftung Berlin
sf_districts <- sf::read_sf(json_file)
## Derive Berlin Outline
sf_berlin <- suppressMessages(sf::st_union(sf_districts))
## Berlin Waterways (WGS 84)
sf_water <-
suppressMessages(sf::read_sf(dsn = glue::glue("{shp_path}/gis_osm_water_a_free_1.shp"),
layer = "gis_osm_water_a_free_1") %>%
sf::st_intersection(sf_districts))
## Berlin Roads (WGS 84)
if(roads == TRUE) {
message("Loading road data as well, this might take some time.")
sf_roads <-
suppressMessages(sf::read_sf(dsn = glue::glue("{shp_path}/gis_osm_roads_free_1.shp"),
layer = "gis_osm_roads_free_1") %>%
## keep only roads + links
dplyr::filter(stringr::str_detect(
fclass,
"motorway|trunk|primary|secondary|tertiary|unclassified|residential|living"
)) %>%
sf::st_intersection(sf_districts))
}
if(type == "green_areas") {
## Combine relevant natural categories
sf_type <-
suppressMessages(
## Berlin Landuse Categories (WGS 84)
sf::read_sf(dsn = glue::glue("{shp_path}/gis_osm_landuse_a_free_1.shp"),
layer = "gis_osm_landuse_a_free_1") %>%
## Berlin Natural Areas (WGS 84)
rbind(sf::read_sf(dsn = glue::glue("{shp_path}/gis_osm_natural_a_free_1.shp"),
layer = "gis_osm_natural_a_free_1")) %>%
dplyr::filter(fclass %in% c("forest", "grass", "meadow", "nature_reserve",
"scrub", "heath", "beach", "cliff")) %>%
sf::st_intersection(sf_districts)
)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment