classify_cycle_infrastructure_portugal test function

R/test-code/portugal.R

@@ -0,0 +1,168 @@
+# classify osm tags in 4 types:
+# 1. Cycle track or lane: Light or separated tracks exclusive for cycling
+# 2. Advisory lane: Marked (e.g. sharrow or advisory) cycle lanes, but shared with motor vehicles
+# 3. Protected Active: Shared with pedestrians but not with motor vehicles
+# 4. Mixed traffic: Shared with motor vehicles
+
+
+
+library(dplyr)
+library(sf)
+library(osmactive)
+library(tmap)
+
+et_active = function() {
+  c(
+    "maxspeed",
+    "oneway",
+    "bicycle",
+    "cycleway",
+    "cycleway:left",
+    "cycleway:right",
+    "cycleway:both",
+    "lanes",
+    "lanes:both_ways",
+    "lanes:forward",
+    "lanes:backward",
+    "lanes:bus",
+    "lanes:bus:conditional",
+    "oneway",
+    "width",      # useful to ensure width of cycleways is at least 1.5m
+    "segregated",  # classifies whether cycles and pedestrians are segregated on shared paths
+    "sidewalk",    # useful to ensure width of cycleways is at least 1.5m
+    "footway",
+    # "highway", # included by default
+    # "name", # included by default
+    "service", 
+    "surface", 
+    "tracktype",
+    "surface",
+    "smoothness",
+    "access",
+    "foot" # add this to filter the protected to active modes 
+  )
+}
+
+get_travel_network = function(
+    place,
+    extra_tags = et_active(),
+    columns_to_remove = c("waterway", "aerialway", "barrier", "manmade"),
+    ...
+) {
+  osm_highways = osmextract::oe_get(
+    place = place,
+    extra_tags = extra_tags,
+    ...
+  )
+  osm_highways |>
+    dplyr::filter(!is.na(highway)) |>
+    # Remove all service tags based on https://wiki.openstreetmap.org/wiki/Key:service
+    dplyr::filter(is.na(service)) |>
+    dplyr::select(-dplyr::matches(columns_to_remove))
+}
+
+
+u = "https://ushift.tecnico.ulisboa.pt/content/data/lisbon_limit.geojson"
+f = basename(u)
+if (!file.exists(f)) download.file(u, f)
+lisbon = sf::read_sf(f)
+lisbon = lisbon |>
+  sf::st_cast("POLYGON")
+osm = get_travel_network("Portugal", boundary = lisbon, boundary_type = "clipsrc", force_vectortranslate = TRUE)
+cycle_net = get_cycling_network(osm)
+drive_net = get_driving_network_major(osm)
+cycle_net = distance_to_road(cycle_net, drive_net)
+
+
+classify_cycle_infrastructure_portugal = function(osm) {
+  osm |>
+    # If highway == cycleway|pedestrian|path, detailed_segregation can be defined in most cases...
+    dplyr::mutate(detailed_segregation = dplyr::case_when(
+      highway == "cycleway" ~ "Level track",
+      # highway == "cycleway" & foot != "no" ~ "Stepped or footway",
+      # highway == "footway" & bicycle == "yes" ~ "Stepped or footway",
+      # highway == "pedestrian" & bicycle == "designated" ~ "Stepped or footway",
+      highway == "path" & bicycle == "designated" ~ "Level track",
+      # these by default are not shared with traffic:
+      segregated == "yes" ~ "Stepped or footway",
+      segregated == "no" ~ "Stepped or footway",
+      TRUE ~ "Mixed traffic"
+    )) |>
+    # ...including by name
+    dplyr::mutate(detailed_segregation = dplyr::case_when(
+      # highways named towpaths or paths are assumed to be off-road
+      stringr::str_detect(name, "Path|Towpath|Railway|Trail") &
+        detailed_segregation %in% c("Level track", "Stepped or footway") &
+        foot != "yes" ~ "Cycle track",
+      TRUE ~ detailed_segregation
+    )) |>
+    tidyr::unite("cycleway_chars", dplyr::starts_with("cycleway"), sep = "|", remove = FALSE) |>
+    # ...including by cycleway tag
+    dplyr::mutate(detailed_segregation2 = dplyr::case_when(
+      stringr::str_detect(cycleway_chars, "separate") & detailed_segregation == "Mixed traffic" ~ "Stepped or footway", 
+      stringr::str_detect(cycleway_chars, "buffered_lane") & detailed_segregation == "Mixed traffic" ~ "Cycle lane", #not existing in Portugal
+      stringr::str_detect(cycleway_chars, "segregated") & detailed_segregation == "Mixed traffic" ~ "Stepped or footway", #not existing in Portugal
+      TRUE ~ detailed_segregation
+    )) |>
+    dplyr::mutate(detailed_segregation2 = dplyr::case_when(
+      stringr::str_detect(cycleway_chars, "shared_lane") ~ "Advisory lane",
+      stringr::str_detect(cycleway_chars, "lane") & detailed_segregation == "Mixed traffic" ~ "Cycle lane",
+      stringr::str_detect(cycleway_chars, "track") & detailed_segregation == "Mixed traffic" ~ "Light segregation",
+      TRUE ~ detailed_segregation
+    )) |>
+    # CANT SOLVE THIS ONE
+    # dplyr::mutate(detailed_segregation2 = dplyr::case_when( # when we have a cycle lane in one direction and a advisory in the other direction, the street should be classified as cycle lane
+    #   stringr::str_detect(cycleway_chars, "lane|shared_lane") ~ "Cycle lane",
+    #   stringr::str_detect(cycleway_chars, "shared_lane|lane") ~ "Cycle lane",
+    #   TRUE ~ detailed_segregation
+    # )) |>
+    dplyr::mutate(detailed_segregation3 = dplyr::case_when(
+      detailed_segregation2 %in% c("Cycle track", "Level track", "Light segregation", "Cycle lane", "Stepped or footway") ~ "Cycle track or lane",
+      detailed_segregation2 %in% c("Advisory lane") ~ "Advisory lane",
+      detailed_segregation2 %in% c("Mixed traffic") ~ "Mixed traffic",
+      detailed_segregation2 %in% c("Stepped or footway") ~ "Protected Active",
+      TRUE ~ detailed_segregation2
+    )) |>
+
+    dplyr::mutate(detailed_segregation4 = dplyr::case_when(
+      detailed_segregation3 %in% "Cycle track or lane" & highway == "cycleway" & foot %in% c("designated", "permissive", "private", "use_sidepath", "yes") ~ "Protected Active",
+      detailed_segregation3 %in% "Cycle track or lane" & highway == "footway" & bicycle == "yes" ~ "Protected Active",
+      detailed_segregation3 %in% "Cycle track or lane" & highway == "pedestrian" & bicycle == "designated" ~ "Protected Active",
+      TRUE ~ detailed_segregation3
+    )) |>
+
+    dplyr::mutate(cycle_segregation = factor(
+      detailed_segregation4,
+      levels = c("Cycle track or lane", "Advisory lane", "Protected Active", "Mixed traffic"),
+      ordered = TRUE
+    ))
+}
+
+
+   # "Cycle track or lane": Light or separated tracks exclusive for cycling
+   # "Mixed traffic": Marked (e.g. sharrow or advisory) cycle lanes
+   # "Proctected Active":Shared with pedestrians
+
+cycle_net_pt = classify_cycle_infrastructure_portugal(cycle_net)
+
+# table(stringr::str_detect(cycle_net_pt$cycleway_chars, "lane") & cycle_net_pt$detailed_segregation == "Mixed traffic")
+
+
+table(cycle_net_pt$detailed_segregation)
+table(cycle_net_pt$detailed_segregation2)
+table(cycle_net_pt$detailed_segregation3)
+table(cycle_net_pt$detailed_segregation4)
+table(cycle_net_pt$cycle_segregation)
+
+m = plot_osm_tmap(cycle_net_pt)
+m
+
+mapview::mapview(cycle_net_pt |> filter(cycle_segregation != "Mixed traffic"), zcol="cycle_segregation")
+
+# there are still a lot of them what have the osm tag foot="yes" and shouldn't have it.
+# Edit in OSM. Examples
+# https://www.openstreetmap.org/way/976381232
+# https://www.openstreetmap.org/way/686372908
+# https://www.openstreetmap.org/way/498545079
+
+