diff --git a/DESCRIPTION b/DESCRIPTION index 9590405..003c8b4 100644 --- a/DESCRIPTION +++ b/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", diff --git a/R/parking-areas.R b/R/parking-areas.R index cd4dcd6..09379b3 100644 --- a/R/parking-areas.R +++ b/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) diff --git a/R/population-estimate.R b/R/population-estimate.R index d8578ba..118d213 100644 --- a/R/population-estimate.R +++ b/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) diff --git a/R/summary.R b/R/summary.R index 9888964..1e54c2f 100644 --- a/R/summary.R +++ b/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}") diff --git a/README.md b/README.md index e765dde..88d97f6 100644 --- a/README.md +++ b/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% ``` diff --git a/codemeta.json b/codemeta.json index 186a7fe..8339042 100644 --- a/codemeta.json +++ b/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", diff --git a/src/park_search.cpp b/src/park_search.cpp index 84d1ea4..723c3df 100644 --- a/src/park_search.cpp +++ b/src/park_search.cpp @@ -26,16 +26,16 @@ void parksearch::makeEdgeMaps ( } } -std::vector parksearch::randomOrder (size_t ntotal, size_t n) { +std::vector parksearch::randomOrder (int ntotal, size_t n) { std::vector xrand = Rcpp::as> (Rcpp::runif (ntotal)); - std::vector indices(ntotal); + std::vector indices(static_cast(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 res (indices.begin(), indices.begin() + n); + std::vector res (indices.begin(), indices.begin() + static_cast(n)); return res; } @@ -45,12 +45,13 @@ std::vector parksearch::fillParkingSpaces (std::vector num_spaces const size_t n = num_spaces.size(); std::vector 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(ntotal); std::vector 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++) { @@ -58,17 +59,19 @@ std::vector parksearch::fillParkingSpaces (std::vector num_spaces } } - const size_t nfull = floor(prop_full * ntotal); + const size_t nfull = static_cast(floor(prop_full * ntotal)); std::vector index = parksearch::randomOrder(ntotal, nfull); - std::vector fullSpaces (ntotal, 0L); + std::vector 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(num_spaces [i]); + double ns_i = static_cast(num_spaces[i]); + double fs_i = static_cast(fullSpaces[i]); + p_empty [i] = 1.0 - fs_i / ns_i; } } @@ -119,15 +122,15 @@ std::vector parksearch::oneParkSearch ( for (auto s: edgeSet) { if (nvisits [s] < nextVisits) { nextVisits = nvisits [s]; - next_i = s; + next_i = static_cast(s); } } if (next_i > -1) { - i = next_i; + i = static_cast(next_i); } if (second_edge < 0) { - second_edge = i; + second_edge = static_cast(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(floor(num_spaces[i] * prop_full)); + double dprop = utils::expected_min_d (static_cast(num_spaces [i]), n_exp); d_to_empty[i] = dist[i] * dprop / num_spaces[i]; } } @@ -182,7 +186,7 @@ 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(ntrials); n++) { std::vector p_empty = parksearch::fillParkingSpaces (num_spaces, prop_full); @@ -190,10 +194,12 @@ Rcpp::DataFrame rcpp_park_search (const Rcpp::DataFrame graph, parksearch::fill_d_to_empty(num_spaces, dist, d_to_empty, prop_full); std::vector 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(start_edge) + ); - edge(n) = res[0] + 1L; // Conver back to 1-based R indexing - edge2(n) = res[1]; + edge(n) = static_cast(round(res[0])) + 1L; // Conver back to 1-based R indexing + edge2(n) = static_cast(round(res[1])); if (edge2(n) > 0) { edge2(n)++; } d(n) = res[2]; } diff --git a/src/park_search.h b/src/park_search.h index 1469a55..04f73cf 100644 --- a/src/park_search.h +++ b/src/park_search.h @@ -24,7 +24,7 @@ void makeEdgeMaps ( EdgeMapType &edgeMap, EdgeMapType &edgeMapRev); -std::vector randomOrder (size_t ntotal, size_t n); +std::vector randomOrder (int ntotal, size_t n); std::vector fillParkingSpaces (std::vector 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); diff --git a/src/utils.cpp b/src/utils.cpp index 7a9052a..fff3ed2 100644 --- a/src/utils.cpp +++ b/src/utils.cpp @@ -3,7 +3,7 @@ #include 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(k); + const double n_dbl = static_cast(n); for (size_t i = 1; i <= k; i++) { - result = result * (n - k + i) / static_cast(i); + const double i_dbl = static_cast(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(i) * p; } return val; diff --git a/tests/testthat/_snaps/summary-fn.md b/tests/testthat/_snaps/summary-fn.md index c1be551..10b3186 100644 --- a/tests/testthat/_snaps/summary-fn.md +++ b/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 diff --git a/tests/testthat/helper-add-highway.R b/tests/testthat/helper-add-highway.R index dce3af7..e779c5b 100644 --- a/tests/testthat/helper-add-highway.R +++ b/tests/testthat/helper-add-highway.R @@ -33,8 +33,9 @@ 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", @@ -42,6 +43,7 @@ helper_extra_highway <- function (osmdat) { "parking:right:orientation" = "diagonal", geometry = hw ) + rownames (hw) <- osm_id osmdat$highways <- dplyr::bind_rows (osmdat$highways, hw) return (osmdat) diff --git a/tests/testthat/test-building-to-hws.R b/tests/testthat/test-building-to-hws.R index e4891e4..c48e7ff 100644 --- a/tests/testthat/test-building-to-hws.R +++ b/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)) diff --git a/tests/testthat/test-population-est.R b/tests/testthat/test-population-est.R new file mode 100644 index 0000000..ba1efe3 --- /dev/null +++ b/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) +})