Dev

.github/workflows/pkgdown.yaml

@@ -10,7 +10,7 @@ jobs:
     runs-on: ubuntu-latest
 
     steps:
-      - uses: actions/checkout@v4
+      - uses: actions/checkout@v7
 
       - uses: r-lib/actions/setup-pandoc@v2
 

.github/workflows/rcmdcheck.yaml

@@ -28,7 +28,7 @@ jobs:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-    - uses: actions/checkout@v4
+    - uses: actions/checkout@v7
 
     - uses: r-lib/actions/setup-r@v2
       with:

.github/workflows/test-coverage.yaml

@@ -15,7 +15,7 @@ jobs:
     runs-on: ubuntu-latest
 
     steps:
-      - uses: actions/checkout@v4
+      - uses: actions/checkout@v7
 
       - uses: r-lib/actions/setup-r@v2
 
@@ -34,7 +34,7 @@ jobs:
           covr::to_cobertura(cov)
         shell: Rscript {0}
 
-      - uses: codecov/codecov-action@v5
+      - uses: codecov/codecov-action@v7
         with:
           # Fail if error if not on PR, or if on PR and token is given
           fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }}

NEWS.md

@@ -11,6 +11,10 @@
 - Accessibility functions now treat `NA` opportunity, demand and supply
   values, and `travel_matrix` ids missing from `land_use_data`, as 0.
   Previously, they could make results `NA`.
+- Integer opportunity, demand, supply and population columns are now
+  converted to doubles, so sums no longer overflow. As a result,
+  `cumulative_cutoff()` and `gravity()` (with `decay_binary()`) return doubles
+  instead of integers when opportunities are integers.
 - `concentration_index(type = "corrected")` now uses the bounds of the whole
   accessibility distribution, not of each `group_by` group, to calculate the
   correction factor.
@@ -40,6 +44,8 @@
     `fill_missing_ids = TRUE` and `group_by` leave combinations missing.
   - `constraint = "total"` no longer adds an index to the user's
     `land_use_data`.
+- `cost_to_closest()` no longer returns `Inf` due to integer overflow with
+  large opportunity counts.
 - `cumulative_cutoff()`: cutoffs with floating point noise (e.g. from
   `seq(0, 0.5, by = 0.1)`) could be zeroed when filling missing ids. Travel
   cost columns with non-syntactic names now work.
@@ -77,9 +83,7 @@
   strings. With `constraint = "doubly"`, it is about 2 to 4 times faster and
   uses much less memory.
 - `cost_to_closest()` is about 1.3 to 2.3 times faster.
-- `cumulative_cutoff()` and `cumulative_interval()` return accessibility
-  above the largest integer as doubles instead of erroring.
-  `cumulative_interval()` always sorts rows by interval, id and `group_by`.
+- `cumulative_interval()` always sorts rows by interval, id and `group_by`.
 - `decay_exponential()`, `decay_logistic()`, `decay_power()` and
   `decay_stepped()` are about 2 to 200 times faster.
 - `decay_linear()` requires `cutoff` greater than 0.
@@ -89,9 +93,7 @@
   `poor_below_threshold`, and warns when `poor_below_threshold = FALSE` and
   `accessibility_data` has `Inf` values (e.g. from `cost_to_closest()`).
 - `floating_catchment_area()` and `gravity()` are faster with several decay
-  values (about 4 times with three). `gravity()` with integer opportunities and
-  `decay_binary()` no longer fails when accessibility exceeds the largest
-  integer.
+  values (about 4 times with three).
 - `spatial_availability()` is about 2 times faster.
 
 ## Notes

R/concentration_index.R

@@ -106,11 +106,15 @@ concentration_index <- function(
 
   warn_extra_access_cols(accessibility_data, opportunity, group_by)
 
-  # integer opportunities and population counts may overflow when multiplied,
-  # so we convert them to doubles first
+  # integer opportunities may overflow when multiplied by the population, so
+  # they are converted to doubles first (merge_by_reference() already converts
+  # the population)
 
-  .numeric_cols <- c(opportunity, population)
-  data[, (.numeric_cols) := lapply(.SD, as.numeric), .SDcols = .numeric_cols]
+  data.table::set(
+    data,
+    j = opportunity,
+    value = as.numeric(data[[opportunity]])
+  )
 
   .opp_colname <- opportunity
   .pop_colname <- population

R/constrained_accessibility.R

@@ -158,7 +158,9 @@
 #' to match; otherwise, the model will not converge.
 #'  - `active` must be `NULL`. Since supply must match demand, their units are
 #'  the same and there is no distinction between 'active' and 'passive' notions.
-#' - Only accepts `detailed_results = TRUE`.
+#' - Should be used with `detailed_results = TRUE`. With
+#'   `detailed_results = FALSE`, it only returns the demand and supply
+#'   marginals, with a warning.
 #'
 #' ### Interpretation:
 #' - Results include OD-level flows (`flow`) along with balancing factors (`A_i`,
@@ -171,12 +173,40 @@
 #' "What is the count of A->1 flows given A->1's region-relative travel impedance,
 #'  demand and supply?"
 #'
+#' @return A data frame of the same class as `travel_matrix` (`data.table`,
+#'   `data.frame` or `tibble`). Its columns depend on `constraint`, `active`
+#'   and `detailed_results`:
+#'
+#' - `constraint = "total"` or `"singly"`, `detailed_results = FALSE`: one
+#'   row per origin (`from_id`, when `active = TRUE`) or destination (`to_id`,
+#'   when `active = FALSE`), plus the `group_by` columns. Accessibility is in a
+#'   column named `supply` (active) or `demand` (passive).
+#' - `constraint = "total"`, `detailed_results = TRUE`: one row per
+#'   origin-destination pair, with the columns `from_id`, `to_id`, the weighted
+#'   opportunities (`weighted_supply` or `weighted_demand`), the share of the
+#'   regional total allocated to the pair (`kappa_total` or `hatkappa_total`),
+#'   the allocated flow (`supply` or `demand`) and the scaling constant
+#'   (`K_total` or `hatK_total`).
+#' - `constraint = "singly"`, `detailed_results = TRUE`: one row per
+#'   origin-destination pair, with the columns `from_id`, `to_id`, the
+#'   allocation share (`kappa_singly` or `hatkappa_singly`), the allocated flow
+#'   (`supply` or `demand`) and the balancing factor (`B_j` or `A_i`).
+#' - `constraint = "doubly"`, `detailed_results = TRUE`: one row per
+#'   origin-destination pair, with the columns `from_id`, `to_id`, `flow`, the
+#'   balancing factors `A_i` and `B_j`, `kappa_doubly` and the final balancing
+#'   `error`.
+#' - `constraint = "doubly"`, `detailed_results = FALSE`: the columns `id`
+#'   and `flow`, holding the demand of each origin followed by the supply of
+#'   each destination (so an id can appear twice).
+#'
+#' Detailed results don't include the `group_by` columns.
+#'
 #' @references
 #' \insertAllCited{}
-
+#'
 #' @family Constrained accessibility
 #'
-#' @examples
+#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true")
 #' # Load demo data shipped with the package
 #' data_dir <- system.file("extdata", package = "accessibility")
 #' travel_matrix <- readRDS(file.path(data_dir, "travel_matrix.rds"))

R/cumulative_cutoff.R

@@ -230,8 +230,7 @@ cumulative_by_cutoff <- function(data,
     binned_sums,
     grid_groups,
     groups,
-    n_cutoffs = length(cutoffs),
-    integer_opportunity = is.integer(data[[opportunity]])
+    n_cutoffs = length(cutoffs)
   )
 
   if (!fill_missing_ids) access <- access[.n > 0]
@@ -284,11 +283,9 @@ cumulative_by_filtering <- function(data,
           cum_opps <- cum_opps[cum_opps[, .I[1], by = .od_group]$V1]
         }
 
-        # opportunities are summed as doubles, so integer sums don't overflow
-
         cum_opps <- cum_opps[
           ,
-          .(access = sum(as.numeric(get(.opportunity_colname)))),
+          .(access = sum(get(.opportunity_colname))),
           by = eval(groups, envir = env)
         ]
 
@@ -303,11 +300,6 @@ cumulative_by_filtering <- function(data,
 
   access <- data.table::rbindlist(access)
 
-  is_integer_opportunity <- is.integer(data[[opportunity]])
-  if (is_integer_opportunity && all(access$access <= .Machine$integer.max)) {
-    data.table::set(access, j = "access", value = as.integer(access$access))
-  }
-
   if (fill_missing_ids) {
     unique_values <- lapply(groups, function(x) unique(travel_matrix[[x]]))
     names(unique_values) <- groups

R/cumulative_interval.R

@@ -104,12 +104,17 @@ cumulative_interval <- function(travel_matrix,
 
   # each interval is summarised over its own cutoffs only, which always include
   # the interval's upper limit (even if it's not a multiple of the increment).
+  # with fractional increments, the last value of the sequence may be the upper
+  # limit with floating point noise (e.g. 0.8999999999999999 instead of 0.9),
+  # so values that close to the limit are dropped before adding the limit.
   # accessibility is calculated once for the union of all cutoffs
 
   interval_cutoffs <- lapply(
     interval,
     function(pair) {
-      unique(c(seq.int(pair[1], pair[2], by = interval_increment), pair[2]))
+      steps <- seq.int(pair[1], pair[2], by = interval_increment)
+      steps <- steps[pair[2] - steps > interval_increment * 1e-6]
+      c(steps, pair[2])
     }
   )
   cutoffs <- unique(unlist(interval_cutoffs))
@@ -162,8 +167,7 @@ cumulative_interval <- function(travel_matrix,
     binned_sums,
     grid_groups,
     groups,
-    n_cutoffs = length(cutoffs),
-    integer_opportunity = is.integer(data[[opportunity]])
+    n_cutoffs = length(cutoffs)
   )
   data.table::set(access_list, j = "cutoffs", value = cutoffs[access_list$.bin])
 

R/gini_index.R

@@ -71,11 +71,15 @@ gini_index <- function(
 
   warn_extra_access_cols(accessibility_data, opportunity, group_by)
 
-  # integer opportunities and population counts may overflow when multiplied,
-  # so we convert them to doubles first
+  # integer opportunities may overflow when multiplied by the population, so
+  # they are converted to doubles first (merge_by_reference() already converts
+  # the population)
 
-  .numeric_cols <- c(opportunity, population)
-  data[, (.numeric_cols) := lapply(.SD, as.numeric), .SDcols = .numeric_cols]
+  data.table::set(
+    data,
+    j = opportunity,
+    value = as.numeric(data[[opportunity]])
+  )
 
   .opp_colname <- opportunity
   .pop_colname <- population
@@ -88,9 +92,7 @@ gini_index <- function(
     by = .groups
   ]
   data[,
-    .cum_total_access := cumsum(
-      as.numeric(get(.pop_colname) * get(.opp_colname))
-    ) /
+    .cum_total_access := cumsum(get(.pop_colname) * get(.opp_colname)) /
       sum(get(.pop_colname) * get(.opp_colname)),
     by = .groups
   ]

R/merge_by_reference.R

@@ -21,13 +21,20 @@ merge_by_reference <- function(data,
     match(left_ids, right_ids)
   }
 
-  values <- land_use_data[[opportunity]][match_index]
+  # integer counts (opportunities, demand, supply, population) are converted to
+  # doubles, so that sums and products in the measures don't overflow. they are
+  # converted before matching, because land_use_data is usually much shorter
+  # than the travel matrix
+
+  values <- land_use_data[[opportunity]]
+  if (is.integer(values)) values <- as.numeric(values)
+  values <- values[match_index]
 
   # in accessibility measures, NA values and ids missing from land_use_data
   # count as 0 opportunities (or 0 demand/supply). the inequality and poverty
   # functions keep the NAs
 
-  if (na_as_zero && anyNA(values)) values[is.na(values)] <- 0L
+  if (na_as_zero && anyNA(values)) values[is.na(values)] <- 0
 
   data.table::set(data, j = opportunity, value = values)
 }

R/palma_ratio.R

@@ -86,11 +86,13 @@ palma_ratio <- function(
   warn_extra_access_cols(accessibility_data, opportunity, group_by)
 
   # normwt = TRUE treats population as relative weights, so the quantiles don't
-  # depend on its scale (e.g. counts vs. shares)
+  # depend on its scale (e.g. counts vs. shares). integer weights are converted
+  # to doubles, because Hmisc multiplies them by the number of observations,
+  # which may overflow
 
   income_quantiles <- Hmisc::wtd.quantile(
     sociodemographic_data[[income]],
-    weights = sociodemographic_data[[population]],
+    weights = as.numeric(sociodemographic_data[[population]]),
     probs = c(0.4, 0.9),
     normwt = TRUE
   )

R/sum_by_cost_bin.R

@@ -18,9 +18,10 @@ sum_by_cost_bin <- function(data, groups, opportunity, travel_cost, cutoffs) {
   names(binned) <- groups
   binned$.bin <- bin[keep]
 
-  # opportunities are summed as doubles, so integer sums don't overflow
+  # the opportunities are doubles (merge_by_reference() converts integers), so
+  # their sums don't overflow
 
-  binned$.opp <- as.numeric(data[[opportunity]][keep])
+  binned$.opp <- data[[opportunity]][keep]
   binned <- data.table::setDT(binned)
 
   binned_sums <- binned[
@@ -37,12 +38,9 @@ sum_by_cost_bin <- function(data, groups, opportunity, travel_cost, cutoffs) {
 cumulative_sums_grid <- function(binned_sums,
                                  grid_groups,
                                  groups,
-                                 n_cutoffs,
-                                 integer_opportunity) {
+                                 n_cutoffs) {
   # one row per group (from grid_groups) and cutoff. bins that no row falls
-  # into get 0 opportunities and 0 rows. the cumulative sums are doubles, so
-  # they don't overflow, and are converted back to integers when the
-  # opportunities are integers and the sums fit
+  # into get 0 opportunities and 0 rows
 
   grid <- grid_groups[rep(seq_len(nrow(grid_groups)), each = n_cutoffs)]
   data.table::set(
@@ -69,9 +67,5 @@ cumulative_sums_grid <- function(binned_sums,
   grid[, `:=`(access = cumsum(.opp), .n = cumsum(.n)), by = c(groups)]
   grid[, .opp := NULL]
 
-  if (integer_opportunity && all(grid$access <= .Machine$integer.max)) {
-    data.table::set(grid, j = "access", value = as.integer(grid$access))
-  }
-
   return(grid[])
 }

R/theil_t.R

@@ -120,11 +120,15 @@ theil_t <- function(
 
   warn_extra_access_cols(accessibility_data, opportunity, group_by)
 
-  # integer opportunities and population counts may overflow when multiplied,
-  # so we convert them to doubles first
+  # integer opportunities may overflow when multiplied by the population, so
+  # they are converted to doubles first (merge_by_reference() already converts
+  # the population)
 
-  .numeric_cols <- c(opportunity, population)
-  data[, (.numeric_cols) := lapply(.SD, as.numeric), .SDcols = .numeric_cols]
+  data.table::set(
+    data,
+    j = opportunity,
+    value = as.numeric(data[[opportunity]])
+  )
 
   if (is.null(socioeconomic_groups)) {
     result <- theil_without_groups(data, opportunity, population, group_by)
@@ -212,9 +216,7 @@ theil_with_groups <- function(
 
   summarized_data <- data[,
     .(
-      group_tot_access = as.numeric(
-        sum(get(..opportunity) * get(..population))
-      ),
+      group_tot_access = sum(get(..opportunity) * get(..population)),
       group_tot_pop = sum(get(..population)),
       group_theil_t = calc_theil_t(
         get(..opportunity),