simplify 'area_per_resident' estimate

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: superblock
 Type: Package
 Title: Analyses of potential superblock
-Version: 0.1.0.091
+Version: 0.1.0.103
 Authors@R: 
     person(given = "Mark",
            family = "Padgham",

NAMESPACE

@@ -6,6 +6,7 @@ export(get_bbox)
 export(hws_to_polygons)
 export(no_building_floors)
 export(no_parking_ways)
+export(sb_car_spaces_per_resident)
 export(sb_osmdata_extract)
 export(sb_parking_times)
 export(sb_summary)

R/osmdata-extract.R

@@ -33,6 +33,11 @@ sb_osmdata_extract <- function (bbox, hw_names, outer = TRUE) {
     parking_facilities <- extract_osm_parking_facilities (bbox)
     cli::cli_alert_success ("Extracted data on parking areas.")
 
+    # Extract tree and bicycle parking nodes
+    nodes <- extract_osm_nodes (bbox)
+    index <- sf::st_within (nodes, bounding_poly, sparse = FALSE)
+    nodes <- nodes [index, ]
+
     list (
         bbox = bbox,
         hw_names = hw_names,
@@ -42,6 +47,7 @@ sb_osmdata_extract <- function (bbox, hw_names, outer = TRUE) {
         open_spaces = open_spaces,
         parking_areas = parking_areas,
         parking_facilities = parking_facilities,
+        nodes = nodes,
         dat_sc = dat_hw$dat_sc
     )
 }
@@ -81,7 +87,7 @@ extract_osm_highways <- function (bbox, bounding_poly) {
     nms <- names (hws) [which (!names (hws) == "geometry")]
     has_data <- vapply (nms, function (n) any (!is.na (hws [[n]])), logical (1L))
     has_data <- c (which (has_data), which (nms == "geometry"))
-    hws [, has_data]
+    hws <- hws [, has_data]
 
     return (list (highways = hws, dat_sc = dat_sc))
 }
@@ -99,7 +105,13 @@ reduce_osm_highways <- function (hws, hw_names) {
     )
     index <- which (hws$highway %in% c ("residential", "secondary", "tertiary"))
     hws_internal <- hws [index, ]
-    hws_internal [which (!hws_internal$name %in% hw_names), ]
+    hws <- hws_internal [which (!hws_internal$name %in% hw_names), ]
+
+    # Then reduce cols again to only those with data:
+    index <- vapply (names (hws), function (n) any (!is.na (hws [[n]])), logical (1L))
+    hws <- hws [, index]
+
+    return (hws)
 }
 
 extract_osm_buildings <- function (bbox, bounding_poly) {
@@ -194,3 +206,19 @@ extract_osm_parking_facilities <- function (bbox) {
 
     return (pts)
 }
+
+extract_osm_nodes <- function (bbox) {
+
+    amenity <- natural <- osm_id <- NULL
+
+    dat <- osmdata::opq (bbox) |>
+        osmdata::add_osm_features (list (
+            natural = "tree",
+            amenity = "bicycle_parking"
+        )) |>
+        m_osmdata_sf ()
+
+    dat$osm_points |>
+        dplyr::filter (amenity == "bicycle_parking" | natural == "tree") |>
+        dplyr::select (osm_id, amenity, natural)
+}

R/parking-areas.R

@@ -7,6 +7,7 @@ car_parking_areas <- function (osmdat, add_parking_osm_ids = NULL) {
     hws$lanes <- as.numeric (hws$lanes)
     hws$road_area <- sf::st_length (hws) * units::set_units (hws$lanes * lane_width)
     hws <- parking_structure (hws)
+    hws <- reduce_parking_for_trees (hws, osmdat)
 
     if (!is.null (add_parking_osm_ids)) {
         index <- which (as.numeric (hws$parking_area) > 0)
@@ -25,8 +26,9 @@ parking_structure <- function (hws) {
 
     # Depth of parking spaces out into the street
     depths <- c (3, 4, 5) # (parallel, diagonal, perpendicular)
+    angles <- c ("parallel", "diagonal", "perpenducular")
     # And equivalent lengths along the street
-    lengths <- c (5, 3, 3)
+    lengths <- c (5, 4, 3)
 
     parking <- sf::st_drop_geometry (hws [, grep ("parking", names (hws))])
     hws <- hws [, which (!grepl ("parking", names (hws)))]
@@ -48,15 +50,16 @@ parking_structure <- function (hws) {
         })
         conditions <- do.call (cbind, conditions)
 
-        parking_space <- rep (0, nrow (parking))
+        parking_depth <- parking_length <- rep (0, nrow (parking))
         for (i in 2:4) {
-            parking_space [which (conditions [, i])] <- depths [i - 1L]
+            parking_depth [which (conditions [, i])] <- depths [i - 1L]
+            parking_length [which (conditions [, i])] <- lengths [i - 1L]
         }
 
         # And set any "no" or "false" flags to no parking space:
         parking_prohibited <- conditions [, 1]
 
-        return (cbind (parking_space, parking_prohibited))
+        return (cbind (parking_depth, parking_length, parking_prohibited))
     }
 
     dirs <- c ("left", "right", "both")
@@ -71,18 +74,29 @@ parking_structure <- function (hws) {
     hws$parking_prohibited [parking_prohibited [[2]]] <- "right"
     hws$parking_prohibited [parking_prohibited [[3]]] <- "both"
 
-    parking_sides <- parking [[1]] [, 1] + parking [[2]] [, 1]
+    parking_sides <- parking [[1]] [, 1] + parking [[2]] [, 1] # [, 1] == depth
     parking_both <- parking [[3]] [, 1] * 2
-    parking_space <- apply (cbind (parking_sides, parking_both), 1, max)
-    hws$parking_area <- sf::st_length (hws) * units::set_units (parking_space, "m")
+    parking_depth <- apply (cbind (parking_sides, parking_both), 1, max)
+    hws$parking_area <- sf::st_length (hws) * units::set_units (parking_depth, "m")
+
+    # Add details of parking on each side:
+    hws$parking_left <- hws$parking_right <- NA_character_
+    for (i in seq_along (depths)) {
+        index <- which (parking [[1]] [, 1] == depths [i])
+        hws$parking_left [index] <- angles [i]
+        index <- which (parking [[2]] [, 1] == depths [i])
+        hws$parking_right [index] <- angles [i]
+        index <- which (parking [[3]] [, 1] == depths [i])
+        hws$parking_left [index] <- hws$parking_right [index] <- angles [i]
+    }
 
     # Then estimate number of parking spaces:
     hw_lens <- as.numeric (sf::st_length (hws))
     n_spaces <- lapply (lengths, function (l) {
         res <- lapply (
             parking,
             function (p) {
-                index <- which (p [, 1] > 0 & p [, 1] %% l == 0)
+                index <- which (p [, 2] > 0 & p [, 2] %% l == 0) # [, 2] == length
                 index_ids <- match (names (index), hws$osm_id)
                 n <- floor (hw_lens [index_ids] / l)
                 cbind (n, names (index))
@@ -104,3 +118,39 @@ parking_structure <- function (hws) {
 
     return (hws)
 }
+
+reduce_parking_for_trees <- function (hws, osmdat, buffer = 5) {
+
+    nodes <- osmdat$nodes
+    # First reduce nodes to only those within buffer distance of hws:
+    dmat <- sf::st_distance (nodes, hws)
+    dmin <- apply (dmat, 1, min)
+    nodes <- nodes [which (dmin <= buffer), ]
+
+    # Then map nodes to hws:
+    dmat <- sf::st_distance (nodes, hws)
+    index <- table (apply (dmat, 1, which.min))
+    index <- data.frame (
+        hw_num = as.integer (names (index)),
+        count = as.integer (index)
+    )
+    node_counts <- rep (0, nrow (hws))
+    node_counts [index$hw_num] <- index$count
+
+    angles <- c ("parallel", "diagonal", "perpenducular")
+    reductions <- c (1, 2, 3) # reduction in parking spaces
+
+    # Then presume nodes are evenly divided on both sides of each highway:
+    for (dir in c ("left", "right")) {
+        this_dir <- hws [[paste0 ("parking_", dir)]]
+        this_red <- reductions [match (this_dir, angles)]
+        this_red [is.na (this_red)] <- 0
+        this_red [which (hws$num_parking_spaces == 0)] <- 0
+
+        hws$num_parking_spaces <- hws$num_parking_spaces -
+            this_red * node_counts / 2
+    }
+    hws$num_parking_spaces <- floor (hws$num_parking_spaces)
+
+    return (hws)
+}

R/population-estimate.R

@@ -1,49 +1,79 @@
+#' Estimate number of car spaces per resident
+#'
+#' @param osmdat Object returned from \link{sb_osmdata_extract}.
+#' @return An estimate of numbers of parking spaces per resident.
+#' @export
+sb_car_spaces_per_resident <- function (osmdat) {
+
+    a_per_res <- area_per_resident (osmdat)
+    a_per_res_floor <- 10 * floor (mean (a_per_res$floor) / 10)
+    a_per_res_roof <- 10 * floor (mean (a_per_res$roof) / 10)
+
+    a_building <- building_areas (osmdat)
+    area_floor <- sum (a_building$floor)
+    area_roof <- sum (a_building$roof)
+
+    num_res_floor <- as.numeric (area_floor) / a_per_res_floor
+    num_res_roof <- as.numeric (area_roof) / a_per_res_roof
+    num_res <- num_res_floor + num_res_roof
+
+    p <- car_parking_areas (osmdat)
+    num_parking_spaces <- sum (p$num_parking_spaces)
+    num_parking_spaces / num_res
+}
+
 #' Estimate floor and roof area per resident.
 #'
 #' Uses example building with known numbers of residents, and which is typical
 #' of the neighbourhood.
 #' @noRd
 area_per_resident <- function (osmdat) {
 
-    street <- "Papenburger Straße"
-    housenumber <- 2
     num_residents_floors <- 21
     num_residents_roof <- 2.5
+    area <- 181 # m2
 
-    b <- osmdat$buildings
+    b <- filter_residential_buildings (osmdat$buildings)
+    num_levels <- as.numeric (b$`building:levels`)
+    num_roof_levels <- as.numeric (b$`roof:levels`)
 
-    i <- which (
-        b$`addr:street` == street & b$`addr:housenumber` == housenumber
-    )
-    area <- sf::st_area (osmdat$buildings [i, ]) # in m^2
+    # Replace missing values with averages:
+    num_levels_mn <- mean (num_levels, na.rm = TRUE)
+    num_roof_levels_mn <- mean (num_roof_levels, na.rm = TRUE)
+    num_levels <- ifelse (is.na (num_levels), num_levels_mn, num_levels)
+    num_roof_levels <- ifelse (is.na (num_roof_levels), num_roof_levels_mn, num_roof_levels)
 
-    num_levels <- as.numeric (b$`building:levels` [i])
-    num_roof_levels <- as.numeric (b$`roof:levels` [i])
-    num_roof_levels <- ifelse (is.na (num_roof_levels), 0, num_roof_levels)
     a_per_res_floors <- area * num_levels / num_residents_floors
-    a_per_res_floors <- 10 * floor (a_per_res_floors / 10)
     # This is artifically inflated, because roof areas are always smaller:
     a_per_res_roof <- area * num_roof_levels / num_residents_roof
-    a_per_res_roof <- 10 * floor (a_per_res_roof / 10)
 
-    c (floor = a_per_res_floors, roof = a_per_res_roof)
+    data.frame (osm_id = b$osm_id, floor = a_per_res_floors, roof = a_per_res_roof)
 }
 
-building_areas <- function (osmdat) {
+exclude_ground_floor <- c ("civic", "office", "retail", "supermarket")
+
+filter_residential_buildings <- function (b) {
+
+    `addr:street` <- `addr:housenumber` <- NULL
 
     exclude <- c ("carport", "garage", "garages", "school", "shed", "yes")
-    b <- osmdat$buildings |>
-        dplyr::filter (!building %in% exclude) |>
+    b <- dplyr::filter (b, !building %in% exclude) |>
         dplyr::filter (!is.na (`addr:street`) & !is.na (`addr:housenumber`))
 
-    exclude_ground_floor <- c ("civic", "office", "retail", "supermarket")
     num_levels <- as.numeric (b$`building:levels`)
     index <- which (b$building %in% exclude_ground_floor & num_levels == 1)
     if (length (index > 0)) {
         b <- b [-index, ]
-        num_levels <- as.numeric (b$`building:levels`)
-        index <- which (b$building %in% exclude_ground_floor)
     }
+    return (b)
+}
+
+building_areas <- function (osmdat) {
+
+    b <- filter_residential_buildings (osmdat$buildings)
+
+    num_levels <- as.numeric (b$`building:levels`)
+    index <- which (b$building %in% exclude_ground_floor)
     num_levels [index] <- num_levels [index] - 1
     num_roof_levels <- as.numeric (b$`roof:levels`)
 
@@ -55,5 +85,5 @@ building_areas <- function (osmdat) {
     area_levels <- areas * num_levels
     area_roofs <- areas * num_roof_levels
 
-    c (floor = sum (area_levels), roof = sum (area_roofs))
+    data.frame (osm_id = b$osm_id, floor = area_levels, roof = area_roofs)
 }

R/summary.R

@@ -7,6 +7,7 @@
 #' average values from all other ways which do have parking specified.
 #' @export
 sb_summary <- function (osmdat, hw_polygons = NULL, add_parking_osm_ids = NULL) {
+
     if (is.null (hw_polygons)) {
         hw_polygons <- hws_to_polygons (osmdat)
     }

codemeta.json

@@ -7,7 +7,7 @@
   "codeRepository": "https://github.com/UrbanAnalyst/superblock-ms",
   "issueTracker": "https://github.com/UrbanAnalyst/superblock-ms/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.1.0.091",
+  "version": "0.1.0.103",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
@@ -259,7 +259,7 @@
     },
     "SystemRequirements": {}
   },
-  "fileSize": "4389.635KB",
+  "fileSize": "4436.035KB",
   "contIntegration": [
     "https://github.com/UrbanAnalyst/superblock/actions/workflows/R-CMD-check.yaml",
     "https://app.codecov.io/gh/UrbanAnalyst/superblock"

tests/testthat/helper-osmdata-memoise.R

@@ -27,4 +27,8 @@ memoise_osmdata_calls <- function (bbox, hw_names) {
     parking_facilities <- httptest2::with_mock_dir ("osm-parking-facilities", {
         extract_osm_parking_facilities (bbox)
     })
+
+    parking_facilities <- httptest2::with_mock_dir ("osm-nodes", {
+        extract_osm_nodes (bbox)
+    })
 }