data (top level) ab:
Lade und analysiere die Barrieren:
# Laden der Daten kann einen Moment dauern
barriers <- read_sf(here("data", "baden-wuerttemberg-latest.osm.pbf"),
layer = "points",
query = "SELECT * FROM points WHERE BARRIER <> '' ")
# extrahiere width und maxwidth von "other tags"
barriers$maxwidth <- str_match(barriers$other_tags, '\"maxwidth\"=>\"\\s*(.*?)\\s*\"')[,2]
barriers$width <- str_match(barriers$other_tags, '\"width\"=>\"\\s*(.*?)\\s*\"')[,2]
# welche Barrieren gibt es wie häufig?
barriers %>%
tabyl("barrier") %>%
arrange(desc(n)) %>%
janitor::adorn_pct_formatting()## barrier_ogr_geometry_ n percent
## gate 28271 39.7%
## bollard 20274 28.5%
## lift_gate 10240 14.4%
## cycle_barrier 3752 5.3%
## block 2029 2.8%
## door 1540 2.2%
## entrance 1354 1.9%
## swing_gate 765 1.1%
## kerb 580 0.8%
## turnstile 258 0.4%
## yes 216 0.3%
## fence 197 0.3%
## kissing_gate 180 0.3%
## chain 175 0.2%
## cattle_grid 158 0.2%
## full-height_turnstile 146 0.2%
## sally_port 145 0.2%
## log 136 0.2%
## stile 114 0.2%
## hampshire_gate 110 0.2%
## height_restrictor 80 0.1%
## border_control 74 0.1%
## bump_gate 31 0.0%
## jersey_barrier 31 0.0%
## fallen_tree 26 0.0%
## wall 25 0.0%
## coupure 23 0.0%
## dyke_opening 19 0.0%
## tree 18 0.0%
## debris 17 0.0%
## hedge 17 0.0%
## boulder 16 0.0%
## chicane 15 0.0%
## flowerpot 14 0.0%
## toll_booth 13 0.0%
## guard_rail 11 0.0%
## rock 10 0.0%
## rope 10 0.0%
## ditch 9 0.0%
## motorcycle_barrier 8 0.0%
## pole 8 0.0%
## shower 8 0.0%
## sliding_gate 7 0.0%
## board 6 0.0%
## stone 6 0.0%
## water 6 0.0%
## no 5 0.0%
## sump_buster 5 0.0%
## undergrowth 5 0.0%
## wicket_gate 5 0.0%
## spikes 4 0.0%
## bench 3 0.0%
## embankment 3 0.0%
## g 3 0.0%
## planter 3 0.0%
## stack_of_wood 3 0.0%
## step 3 0.0%
## wood 3 0.0%
## blockade 2 0.0%
## bus_trap 2 0.0%
## caution_tape 2 0.0%
## checkpoint 2 0.0%
## choker 2 0.0%
## crash barrier 2 0.0%
## Firmengelände 2 0.0%
## flood_gate 2 0.0%
## handrail 2 0.0%
## narrow 2 0.0%
## traffic_cones 2 0.0%
## bar 1 0.0%
## barrier_(Trees) 1 0.0%
## barrier_board 1 0.0%
## Baum_umgestürzt 1 0.0%
## cable_barrier 1 0.0%
## city_wall 1 0.0%
## earth_wall 1 0.0%
## Fair Pfand Deutschland 1 0.0%
## FIXME 1 0.0%
## floodgate 1 0.0%
## flower pots 1 0.0%
## flower_tub 1 0.0%
## guide_curb 1 0.0%
## gully_cover 1 0.0%
## hole 1 0.0%
## horse_stile 1 0.0%
## lift_gate;bollard 1 0.0%
## line 1 0.0%
## logs 1 0.0%
## lug 1 0.0%
## motorhome 1 0.0%
## overgrown 1 0.0%
## overgrowth 1 0.0%
## Seilabsperrung 1 0.0%
## shrub 1 0.0%
## squeezer 1 0.0%
## stone_row 1 0.0%
## traffic_sign 1 0.0%
## tree_trunk 1 0.0%
## turnstile;gate 1 0.0%
## uncrossable 1 0.0%
## undefined 1 0.0%
## wood_pile 1 0.0%Wie viele der Barrieren haben ein width Tag?
with_width <- barriers %>% filter(!is.na(width) | !is.na(maxwidth))
print(paste("Anzahl aller Barrieren mit width oder maxwidth:", nrow(with_width)))## [1] "Anzahl aller Barrieren mit width oder maxwidth: 820"print(paste("Anzahl aller Barrieren:", nrow(barriers)))## [1] "Anzahl aller Barrieren: 71248"print(paste("Prozent mit width oder maxwidth", round(nrow(with_width) / nrow(barriers) * 100, 1), "%"))## [1] "Prozent mit width oder maxwidth 1.2 %"Wie viele der fünf häufigsten Barrieren haben einen width Tag?
barriers %>%
st_drop_geometry() %>%
mutate(has_width = !is.na(dplyr::coalesce(maxwidth, width))) %>%
select(barrier, has_width) %>%
filter(barrier %in% c("gate", "bollard", "cycle_barrier", "lift_gate", "block")) %>%
count(barrier, has_width) %>%
pivot_wider(names_from = has_width, values_from = n) %>%
mutate(`Anteil mit width in %` = round(`TRUE`/(`FALSE` + `TRUE`)*100, 1))## # A tibble: 5 x 4
## barrier `FALSE` `TRUE` `Anteil mit width in %`
## <chr> <int> <int> <dbl>
## 1 block 1978 51 2.5
## 2 bollard 19850 424 2.1
## 3 cycle_barrier 3687 65 1.7
## 4 gate 28104 167 0.6
## 5 lift_gate 10190 50 0.5Alle Arten von Barrieren haben kaum den Tag width vergeben - nur 0.5% - 2.5% haben je nach Kategorie diesen Tag.
Lade Straßen aus dem PBF File und extrahiere notwendige Tags aus other_tags.
# Laden der Daten kann einen Moment dauern
streets <- read_sf(here("data", "baden-wuerttemberg-latest.osm.pbf"),
layer = "lines",
query = "SELECT * FROM lines WHERE highway <> ''")
streets$bicycle <- str_match(streets$other_tags, '\"bicycle\"=>\"\\s*(.*?)\\s*\"')[,2]
streets$motorroad <- str_match(streets$other_tags, '\"motorroad\"=>\"\\s*(.*?)\\s*\"')[,2]
streets$surface <- str_match(streets$other_tags, '\"surface\"=>\"\\s*(.*?)\\s*\"')[,2]
streets$smoothness <- str_match(streets$other_tags, '\"smoothness\"=>\"\\s*(.*?)\\s*\"')[,2]Filtere nur Straßen, die auch von Fahrrädern befahren werden können.
print(paste("Anzahl alle Straßen:", nrow(streets)))## [1] "Anzahl alle Straßen: 1884161"streets <- streets %>%
filter(highway != "motorway",
highway != "motorway_link",
highway != "trunk",
highway != "trunk_link",
(highway != "pedestrian") | (bicycle == "yes"),
highway != "footway" | bicycle == "yes",
highway != "steps",
highway != "corridor",
motorroad != "yes" | is.na(motorroad))
print(paste("Anzahl relevante Straßen:", nrow(streets)))## [1] "Anzahl relevante Straßen: 1603728"Wie viel Prozent der Straßen haben eine Angabe zu Straßenoberfläche?
streets %>%
tabyl(surface) %>%
adorn_pct_formatting() %>%
arrange(desc(n)) %>%
rename("Oberfläche" = "surface_ogr_geometry_") %>%
head(10)## Oberfläche n percent valid_percent
## <NA> 954898 59.5% -
## asphalt 332555 20.7% 51.3%
## paved 68257 4.3% 10.5%
## gravel 62910 3.9% 9.7%
## grass 53383 3.3% 8.2%
## ground 42181 2.6% 6.5%
## paving_stones 18593 1.2% 2.9%
## unpaved 14223 0.9% 2.2%
## compacted 13676 0.9% 2.1%
## fine_gravel 12454 0.8% 1.9%Ungefähr 40% der Straßen haben eine Angabe zur Oberfläche. Davon hat die Hälfte der Straßen den Wert “Aspalt”.
Wie viel Prozent der Straßen haben eine Angabe zur Smoothness?
streets %>%
tabyl(smoothness) %>%
adorn_pct_formatting() %>%
arrange(desc(n)) %>%
head(10)## smoothness_ogr_geometry_ n percent valid_percent
## <NA> 1527620 95.3% -
## good 33808 2.1% 44.4%
## excellent 16671 1.0% 21.9%
## intermediate 9691 0.6% 12.7%
## bad 8123 0.5% 10.7%
## very_bad 3570 0.2% 4.7%
## horrible 1837 0.1% 2.4%
## very_horrible 1697 0.1% 2.2%
## impassable 648 0.0% 0.9%
## very_good 17 0.0% 0.0%Nur ca. 95% der Straßen haben keinen Wert für smoothness.
Wie viele Radwege haben eine Angabe zur Breite?
streets$width <- str_match(streets$other_tags, '\"width\"=>\"\\s*(.*?)\\s*\"')[,2]
streets %>%
filter(highway == "cycleway") %>%
mutate(has_width = !is.na(width)) %>%
tabyl(has_width)## has_width_ogr_geometry_ n percent
## FALSE 9833 0.90936835
## TRUE 980 0.09063165Ca. 9% der Radwege haben eine Angabe zur Breite.
Reduziere auf die Fläche von Stuttgart (für Performance) Reduziere die Kategorien der Barrieren und Straßenoberfläche für eine bessere Darstellung
# für performance nur Stuttgart darstellen
stgt <- read_sf(here("data", "stuttgart.geojson"))
stgt_streets <- streets[sf::st_intersects(streets, stgt, sparse = F)[,1], ]## although coordinates are longitude/latitude, st_intersects assumes that they are planarstgt_barriers <- barriers[sf::st_intersects(barriers, stgt, sparse = F)[,1], ]## although coordinates are longitude/latitude, st_intersects assumes that they are planarstgt_barriers$barrier_simple <- stgt_barriers$barrier
stgt_barriers[!stgt_barriers$barrier_simple %in% c("gate", "bollard", "cycle_barrier", "lift_gate", "block") &
!is.na(stgt_barriers$barrier_simple), "barrier_simple"] <- "other"
stgt_streets$surface_simple <- stgt_streets$surface
stgt_streets[stgt_streets$surface_simple %in% c("unpaved", "compacted", "fine_gravel", "rock", "grass", "ground", "gravel", "dirt",
"pebblestone", "earth", "grass_paver", "mud", "sand", "woodchips"), "surface_simple"] <- "unpaved"
stgt_streets[stgt_streets$surface_simple %in% c("sett", "cobblestone", "unhewn_cobblestone"), "surface_simple"] <- "cobblestone"
stgt_streets[!stgt_streets$surface_simple %in% c("asphalt", "concrete", "paved", "paving_stopnes", "unpaved", "cobblestone") & !is.na(stgt_streets$surface_simple), "surface_simple"] <- "other"center <- c(9.177, 48.7766)
stgt_barriers$radius <- ifelse(stgt_barriers$barrier == "cycle_barrier", 10, 5) # mache cycle_barriers größer
mapdeck(style = mapdeck_style("light"),
location = center,
zoom = 12) %>%
add_path(data = stgt_streets, stroke_colour = "surface_simple",
stroke_width = 8, legend = T, tooltip = "surface", update_view = F) %>%
add_scatterplot(data = stgt_barriers,
radius = "radius",
fill_colour = "barrier_simple",
palette = "plasma",
legend = T,
tooltip = "barrier",
update_view = T)## Registered S3 method overwritten by 'jsonify':
## method from
## print.json jsonlite