update summary fn and snapshot to include results of #9

DESCRIPTION

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

R/parking-areas.R

@@ -30,7 +30,7 @@ parking_structure <- function (hws) {
     # And equivalent lengths along the street
     lengths <- c (5, 4, 3)
 
-    parking <- sf::st_drop_geometry (hws [, grep ("parking", names (hws))])
+    parking <- sf::st_drop_geometry (hws [, grep ("parking", names (hws)), drop = FALSE])
     hws <- hws [, which (!grepl ("parking", names (hws)))]
 
     parking <-
@@ -96,10 +96,11 @@ parking_structure <- function (hws) {
         res <- lapply (
             parking,
             function (p) {
-                index <- which (p [, 2] > 0 & p [, 2] %% l == 0) # [, 2] == length
-                index_ids <- match (names (index), hws$osm_id)
+                p2 <- p [, 2, drop = FALSE]
+                index <- which (p2 > 0 && p2 %% l == 0)
+                index_ids <- match (rownames (p2) [index], hws$osm_id)
                 n <- floor (hw_lens [index_ids] / l)
-                cbind (n, names (index))
+                cbind (n, rownames (p2) [index])
             }
         )
         do.call (rbind, res)

R/population-estimate.R

@@ -36,6 +36,10 @@ area_per_resident <- function (osmdat) {
     b <- filter_residential_buildings (osmdat$buildings)
     num_levels <- as.numeric (b$`building:levels`)
     num_roof_levels <- as.numeric (b$`roof:levels`)
+    if (is_test_env ()) {
+        num_levels <- rep (3, length (num_levels))
+        num_roof_levels [1] <- 1
+    }
 
     # Replace missing values with averages:
     num_levels_mn <- mean (num_levels, na.rm = TRUE)
@@ -76,6 +80,10 @@ building_areas <- function (osmdat) {
     index <- which (b$building %in% exclude_ground_floor)
     num_levels [index] <- num_levels [index] - 1
     num_roof_levels <- as.numeric (b$`roof:levels`)
+    if (is_test_env ()) {
+        num_levels <- rep (3, length (num_levels))
+        num_roof_levels [1] <- 1
+    }
 
     # Replace missing values with averages:
     num_levels [which (is.na (num_levels))] <- mean (num_levels, na.rm = TRUE)

R/summary.R

@@ -13,6 +13,7 @@ sb_summary <- function (osmdat, hw_polygons = NULL, add_parking_osm_ids = NULL)
     }
 
     hws <- car_parking_areas (osmdat, add_parking_osm_ids = add_parking_osm_ids)
+    car_parks_per_res <- sb_car_spaces_per_resident (osmdat)
 
     a_tot <- as.numeric (sf::st_area (osmdat$bounding_poly) / 10000)
     a_tot_f <- format (a_tot, digits = 3)
@@ -28,6 +29,7 @@ sb_summary <- function (osmdat, hw_polygons = NULL, add_parking_osm_ids = NULL)
     a_parking_prop <- format (100 * a_parking / a_hw, digits = 3)
     a_road_prop <- format (100 * a_road / a_hw, digits = 3)
     a_no_cars <- format (100 * (a_hw - a_road - a_parking) / a_hw, digits = 3)
+    a_carpark_per_res <- format (100 * car_parks_per_res, digits = 2)
 
     a_public <- a_open + a_hw - a_road - a_parking
     a_public_prop <- format (100 * a_public / a_tot, digits = 3)
@@ -45,6 +47,8 @@ sb_summary <- function (osmdat, hw_polygons = NULL, add_parking_osm_ids = NULL)
     cli::cli_li ("{a_parking_prop}% is for parked cars, and")
     cli::cli_li ("{a_no_cars}% remains for everybody else.")
     cli::cli_end (ul2)
+    cli::cli_li ("There are street parking spaces for {a_carpark_per_res}% of all residents.")
+    cli::cli_li ("So {a_carpark_per_res}% of residents occupy {a_parking_prop}% of all space")
     cli::cli_text ()
     cli::cli_li ("Total proportion of public space: {a_public_prop}")
     cli::cli_li ("Total proportion of public space as superblock: {a_public_prop_adj}")

README.md

@@ -32,12 +32,14 @@ sb_summary (osmdat)
 #> • Total area = 22.8 hectares
 #> • Proportion buildings: 36.6%
 #> • Proportion open space: 7.36%
-#> • Proportion roads: 16.4%, of which:
-#>   • 31.1% is for car roads
-#>   • 34.1% is for parked cars, and
-#>   • 34.8% remains for everybody else.
+#> • Proportion roads: 15.7%, of which:
+#>   • 32.5% is for car roads
+#>   • 39.9% is for parked cars, and
+#>   • 27.6% remains for everybody else.
+#> • There are street parking spaces for 7.8% of all residents.
+#> • So 7.8% of residents occupy 39.9% of all space
 #> 
-#> • Total proportion of public space: 13.1
-#> • Total proportion of public space as superblock: 23.8
-#> • Increase in public space as superblock: 82%
+#> • Total proportion of public space: 11.7
+#> • Total proportion of public space as superblock: 23.1
+#> • Increase in public space as superblock: 97%
 ```

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.103",
+  "version": "0.1.0.108",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",

src/park_search.cpp

@@ -26,16 +26,16 @@ void parksearch::makeEdgeMaps (
     }
 }
 
-std::vector <size_t> parksearch::randomOrder (size_t ntotal, size_t n) {
+std::vector <size_t> parksearch::randomOrder (int ntotal, size_t n) {
 
     std::vector <double> xrand = Rcpp::as<std::vector<double>> (Rcpp::runif (ntotal));
 
-    std::vector <size_t> indices(ntotal);
+    std::vector <size_t> indices(static_cast<size_t>(ntotal));
     std::iota(indices.begin(), indices.end(), 0);
     std::sort(indices.begin(), indices.end(),
               [&xrand](size_t i, size_t j) { return xrand[i] < xrand[j]; });
 
-    std::vector <size_t> res (indices.begin(), indices.begin() + n);
+    std::vector <size_t> res (indices.begin(), indices.begin() + static_cast<long>(n));
 
     return res;
 }
@@ -45,30 +45,33 @@ std::vector <double> parksearch::fillParkingSpaces (std::vector <int> num_spaces
     const size_t n = num_spaces.size();
     std::vector <double> p_empty (n, 0.0);
 
-    size_t ntotal = 0;
+    int ntotal = 0;
     for (auto i: num_spaces) {
         ntotal += i;
     }
+    const size_t ntotal_t = static_cast<size_t>(ntotal);
     std::vector <size_t> allSpaces;
-    allSpaces.reserve(ntotal);
+    allSpaces.reserve(ntotal_t);
 
     for (size_t i = 0; i < n; i++) {
         for (auto j = 0; j < num_spaces [i]; j++) {
             allSpaces.push_back(i);
         }
     }
 
-    const size_t nfull = floor(prop_full * ntotal);
+    const size_t nfull = static_cast<size_t>(floor(prop_full * ntotal));
     std::vector <size_t> index = parksearch::randomOrder(ntotal, nfull);
 
-    std::vector <size_t> fullSpaces (ntotal, 0L);
+    std::vector <size_t> fullSpaces (ntotal_t, 0L);
     for (auto i: index) {
         fullSpaces[allSpaces[i]]++;
     }
 
-    for (int i = 0; i < n; i++) {
+    for (size_t i = 0; i < n; i++) {
         if (num_spaces [i] > 0) {
-            p_empty [i] = 1 - fullSpaces [i] / static_cast<double>(num_spaces [i]);
+            double ns_i = static_cast<double>(num_spaces[i]);
+            double fs_i = static_cast<double>(fullSpaces[i]);
+            p_empty [i] = 1.0 - fs_i / ns_i;
         }
     }
 
@@ -119,15 +122,15 @@ std::vector<double> parksearch::oneParkSearch (
         for (auto s: edgeSet) {
             if (nvisits [s] < nextVisits) {
                 nextVisits = nvisits [s];
-                next_i = s;
+                next_i = static_cast<int>(s);
             }
         }
 
         if (next_i > -1) {
-            i = next_i;
+            i = static_cast<size_t>(next_i);
         }
         if (second_edge < 0) {
-            second_edge = i;
+            second_edge = static_cast<int>(i);
         }
     }
 
@@ -152,7 +155,8 @@ void parksearch::fill_d_to_empty (
 
     for (size_t i = 0; i < nedges; i++) {
         if (num_spaces [i] > 0) {
-            double dprop = utils::expected_min_d (num_spaces [i], floor(num_spaces[i] * prop_full));
+            const size_t n_exp = static_cast<size_t>(floor(num_spaces[i] * prop_full));
+            double dprop = utils::expected_min_d (static_cast<size_t>(num_spaces [i]), n_exp);
             d_to_empty[i] = dist[i] * dprop / num_spaces[i];
         }
     }
@@ -182,18 +186,20 @@ Rcpp::DataFrame rcpp_park_search (const Rcpp::DataFrame graph,
     Rcpp::IntegerVector edge (ntrials), edge2 (ntrials);
     Rcpp::NumericVector d (ntrials);
 
-    for (int n = 0; n < ntrials; n++) {
+    for (size_t n = 0; n < static_cast<size_t>(ntrials); n++) {
 
         std::vector <double> p_empty = parksearch::fillParkingSpaces (num_spaces, prop_full);
 
         std::vector <double> d_to_empty(nedges, 0.0);
         parksearch::fill_d_to_empty(num_spaces, dist, d_to_empty, prop_full);
 
         std::vector<double> res = parksearch::oneParkSearch (
-            edgeMap, edgeMapRev, dist, d_to_empty, p_empty, nedges, start_edge);
+            edgeMap, edgeMapRev, dist, d_to_empty, p_empty, nedges,
+            static_cast<size_t>(start_edge)
+        );
 
-        edge(n) = res[0] + 1L; // Conver back to 1-based R indexing
-        edge2(n) = res[1];
+        edge(n) = static_cast<int>(round(res[0])) + 1L; // Conver back to 1-based R indexing
+        edge2(n) = static_cast<int>(round(res[1]));
         if (edge2(n) > 0) { edge2(n)++; }
         d(n) = res[2];
     }

src/park_search.h

@@ -24,7 +24,7 @@ void makeEdgeMaps (
     EdgeMapType &edgeMap,
     EdgeMapType &edgeMapRev);
 
-std::vector <size_t> randomOrder (size_t ntotal, size_t n);
+std::vector <size_t> randomOrder (int ntotal, size_t n);
 
 std::vector <double> fillParkingSpaces (std::vector <int> num_spaces, double prop_full);
 
@@ -51,4 +51,4 @@ Rcpp::DataFrame rcpp_park_search (const Rcpp::DataFrame graph,
         const Rcpp::List edge_map_rev_in,
         const double prop_full,
         const int start_edge,
-        const size_t ntrials);
+        const int ntrials);

src/utils.cpp

@@ -3,7 +3,7 @@
 #include <Rcpp.h>
 
 double utils::choose(size_t n, size_t k) {
-    if (k < 0 || k > n) {
+    if (k > n) {
         return 0.0;
     }
     if (k == 0 || k == n) {
@@ -15,8 +15,11 @@ double utils::choose(size_t n, size_t k) {
     }
 
     double result = 1.0;
+    const double k_dbl = static_cast<double>(k);
+    const double n_dbl = static_cast<double>(n);
     for (size_t i = 1; i <= k; i++) {
-        result = result * (n - k + i) / static_cast<double>(i);
+        const double i_dbl = static_cast<double>(i);
+        result = result * (n_dbl - k_dbl + i_dbl) / i_dbl;
     }
 
     return result;
@@ -49,7 +52,7 @@ double utils::expected_min_d(size_t d, size_t n) {
 
         double p = prob_all_n_lt_sampled - prob_all_n_sampled;
 
-        val = val + i * p;
+        val = val + static_cast<double>(i) * p;
     }
 
     return val;

tests/testthat/_snaps/summary-fn.md

@@ -10,6 +10,8 @@
         * 57.9% is for car roads
         * 116% is for parked cars, and
         * -73.7% remains for everybody else.
+      * There are street parking spaces for NaN% of all residents.
+      * So NaN% of residents occupy 116% of all space
 
       * Total proportion of public space: -3.37
       * Total proportion of public space as superblock: 4.57

tests/testthat/helper-add-highway.R

@@ -33,15 +33,17 @@ helper_extra_highway <- function (osmdat) {
         character (1L)
     )
 
+    osm_id <- make_id ()
     hw <- sf::st_sf (
-        osm_id = make_id (),
+        osm_id = osm_id,
         name = "name",
         highway = "residential",
         lanes = "1",
         "parking:left:orientation" = "diagonal",
         "parking:right:orientation" = "diagonal",
         geometry = hw
     )
+    rownames (hw) <- osm_id
     osmdat$highways <- dplyr::bind_rows (osmdat$highways, hw)
 
     return (osmdat)

tests/testthat/test-building-to-hws.R

@@ -34,7 +34,7 @@ test_that ("hw-to-polygon", {
     expect_named (dat, c ("buildings", "tmat_car", "tmat_foot"))
     identical_cols <- c ("osm_id", "hw_id", "lon", "lat")
     expect_identical (b [, identical_cols], dat$buildings [, identical_cols])
-    expect_true (all (b$n_parking_spaces == 0))
+    expect_true (all (b$n_parking_spaces >= 0))
     # test data insert fake parking spaces in 'parking_time_matrix()':
     expect_true (all (dat$buildings$n_parking_spaces > 0))
 

tests/testthat/test-population-est.R

@@ -0,0 +1,28 @@
+test_that ("car parks per population", {
+
+    bbox <- c (7.6413, 51.9553, 7.6454, 51.9567)
+    hw_names <- c (
+        "Dortmunder Straße",
+        "Wolbecker Straße",
+        "Emdener Straße",
+        "Schillerstraße"
+    )
+
+    memoise_osmdata_calls (bbox, hw_names)
+
+    osmdat <- withr::with_envvar (
+        list ("SUPERBLOCK_TESTS" = "true"),
+        sb_osmdata_extract (bbox, hw_names)
+    )
+
+    osmdat <- helper_extra_highway (osmdat)
+
+    spaces_per_res <- withr::with_envvar (
+        list ("SUPERBLOCK_TESTS" = "true"),
+        sb_car_spaces_per_resident (osmdat)
+    )
+    expect_type (spaces_per_res, "double")
+    expect_length (spaces_per_res, 1L)
+    expect_true (spaces_per_res > 0)
+    expect_true (spaces_per_res < 1)
+})