progress bar and parallel compute for cartogram_ncont

.gitignore

@@ -38,3 +38,6 @@ vignettes/*.pdf
 
 # pkgdown
 docs
+
+# private folder for draft test scripts
+private

DESCRIPTION

@@ -12,8 +12,16 @@ Authors@R: c(
 Description: Construct continuous and non-contiguous area cartograms.
 URL: https://github.com/sjewo/cartogram, https://sjewo.github.io/cartogram/
 BugReports: https://github.com/sjewo/cartogram/issues
-Imports: methods, sf, packcircles
-Suggests: 
+Imports: 
+    methods,
+    sf,
+    packcircles,
+    furrr,
+    parallelly,
+    future
 License: GPL-3
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
+Suggests: 
+    testthat (>= 3.0.0)
+Config/testthat/edition: 3

R/cartogram_ncont.R

@@ -24,6 +24,7 @@
 #' @param k Factor expansion for the unit with the greater value
 #' @param inplace If TRUE, each polygon is modified in its original place, 
 #' if FALSE multi-polygons are centered on their initial centroid
+#' @param n_cpu Number of cores to use. Defaults to maximum available identified with \code{\link[parallelly]{availableCores}}.
 #' @return An object of the same class as x with resized polygon boundaries
 #' @export
 #' @importFrom methods is slot as
@@ -47,7 +48,13 @@
 #'plot(nc_utm_carto[,"BIR74"], add =TRUE)
 #'
 #' @references Olson, J. M. (1976). Noncontiguous Area Cartograms. In The Professional Geographer, 28(4), 371-380.
-cartogram_ncont <- function(x, weight, k = 1, inplace = TRUE){
+cartogram_ncont <- function(
+  x,
+  weight,
+  k = 1,
+  inplace = TRUE,
+  n_cpu = parallelly::availableCores()
+){
   UseMethod("cartogram_ncont")
 }
 
@@ -66,15 +73,27 @@ nc_cartogram <- function(shp, ...) {
 #' @rdname cartogram_ncont
 #' @importFrom sf st_as_sf
 #' @export
-cartogram_ncont.SpatialPolygonsDataFrame <- function(x, weight, k = 1, inplace = TRUE){
-  as(cartogram_ncont.sf(sf::st_as_sf(x), weight, k = k, inplace = inplace), 'Spatial')
+cartogram_ncont.SpatialPolygonsDataFrame <- function(
+  x,
+  weight,
+  k = 1,
+  inplace = TRUE,
+  n_cores = parallelly::availableCores()
+){
+  as(cartogram_ncont.sf(sf::st_as_sf(x), weight, k = k, inplace = inplace, n_cores = n_cores), 'Spatial')
 }
 
 
 #' @rdname cartogram_ncont
 #' @importFrom sf st_geometry st_area st_buffer st_is_longlat
 #' @export
-cartogram_ncont.sf <- function(x, weight, k = 1, inplace = TRUE){
+cartogram_ncont.sf <- function(
+  x,
+  weight,
+  k = 1,
+  inplace = TRUE,
+  n_cores = parallelly::availableCores()
+) {
 
   if (isTRUE(sf::st_is_longlat(x))) {
     stop('Using an unprojected map. This function does not give correct centroids and distances for longitude/latitude data:\nUse "st_transform()" to transform coordinates to another projection.', call. = F)
@@ -92,11 +111,19 @@ cartogram_ncont.sf <- function(x, weight, k = 1, inplace = TRUE){
   spdf$r <- as.numeric(sqrt( wArea/ surf))
   spdf$r[spdf$r == 0] <- 0.001 # don't shrink polygons to zero area
   n <- nrow(spdf)
-  for(i in 1:n){
-    sf::st_geometry(spdf)[i] <- rescalePoly.sf(spdf[i, ], 
-                                         inplace = inplace, 
-                                         r = spdf[i,]$r)
-  } 
+  crs <- st_crs(spdf) # save crs
+  future::plan(future::multisession, workers = n_cores)
+  spdf_geometry_list <- furrr::future_map(1:n, function(i) {
+    rescalePoly.sf(spdf[i, ], 
+                   inplace = inplace, 
+                   r = spdf$r[i])
+  },
+    .progress = TRUE,
+    .options = furrr::furrr_options(seed = TRUE)
+  )
+  future::plan(future::sequential)
+  spdf$geometry <- do.call(c, spdf_geometry_list)
+  st_crs(spdf) <- crs # restore crs
   spdf$r <- NULL
   sf::st_buffer(spdf, 0)
 }

tests/testthat.R

@@ -0,0 +1,13 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(cartogram)
+
+
+test_check("cartogram")

tests/testthat/test-cartogram_ncont.R

@@ -0,0 +1,22 @@
+test_that("nc cartogram matches expected area", {
+  # Load North Carolina SIDS data
+  nc = sf::st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE)
+  # transform to NAD83 / UTM zone 16N
+  nc_utm <- sf::st_transform(nc, 26916)
+
+  # Create cartogram
+  nc_utm_carto <- cartogram_ncont(nc_utm, weight = "BIR74")
+  cartogram_area <- as.integer((sum(nc_utm_carto |> st_area()))/1000)
+  expect_equal(cartogram_area, 22284872, tolerance = 0)
+})
+
+test_that("nc cartogram has crs", {
+  # Load North Carolina SIDS data
+  nc = sf::st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE)
+  # transform to NAD83 / UTM zone 16N
+  nc_utm <- sf::st_transform(nc, 26916)
+
+  # Create cartogram
+  nc_utm_carto <- cartogram_ncont(nc_utm, weight = "BIR74")
+  expect_false(is.na(sf::st_crs(nc_utm_carto)$wkt))
+})