From 430997e20f7bf5892ec6862917802e0d789d8199 Mon Sep 17 00:00:00 2001 From: Egor Kotov Date: Sun, 3 Nov 2024 12:56:44 +0100 Subject: [PATCH 1/5] ignore private test scripts folder --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index 867c90b..f16a728 100644 --- a/.gitignore +++ b/.gitignore @@ -38,3 +38,6 @@ vignettes/*.pdf # pkgdown docs + +# private folder for draft test scripts +private From 43d79ef84ce73d96b1831486b81808eba0a71d3f Mon Sep 17 00:00:00 2001 From: Egor Kotov Date: Sun, 3 Nov 2024 13:46:35 +0100 Subject: [PATCH 2/5] parallel processing and progress bar for cartogram_ncont --- DESCRIPTION | 15 ++++++++-- R/cartogram_ncont.R | 43 +++++++++++++++++++++------ man/cartogram_ncont.Rd | 26 ++++++++++++++-- man/nc_cartogram.Rd | 1 + tests/testthat.R | 13 ++++++++ tests/testthat/test-cartogram_ncont.R | 11 +++++++ 6 files changed, 94 insertions(+), 15 deletions(-) create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-cartogram_ncont.R diff --git a/DESCRIPTION b/DESCRIPTION index f468674..181d906 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,8 +12,17 @@ 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, + progressr, + 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 diff --git a/R/cartogram_ncont.R b/R/cartogram_ncont.R index 05869bf..63a91af 100644 --- a/R/cartogram_ncont.R +++ b/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,17 @@ 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) - } + 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) spdf$r <- NULL sf::st_buffer(spdf, 0) } diff --git a/man/cartogram_ncont.Rd b/man/cartogram_ncont.Rd index a3e7b32..c67bd6d 100644 --- a/man/cartogram_ncont.Rd +++ b/man/cartogram_ncont.Rd @@ -6,11 +6,29 @@ \alias{cartogram_ncont.sf} \title{Calculate Non-Contiguous Cartogram Boundaries} \usage{ -cartogram_ncont(x, weight, k = 1, inplace = TRUE) +cartogram_ncont( + x, + weight, + k = 1, + inplace = TRUE, + n_cpu = parallelly::availableCores() +) -\method{cartogram_ncont}{SpatialPolygonsDataFrame}(x, weight, k = 1, inplace = TRUE) +\method{cartogram_ncont}{SpatialPolygonsDataFrame}( + x, + weight, + k = 1, + inplace = TRUE, + n_cores = parallelly::availableCores() +) -\method{cartogram_ncont}{sf}(x, weight, k = 1, inplace = TRUE) +\method{cartogram_ncont}{sf}( + x, + weight, + k = 1, + inplace = TRUE, + n_cores = parallelly::availableCores() +) } \arguments{ \item{x}{a polygon or multiplogyon sf object} @@ -21,6 +39,8 @@ cartogram_ncont(x, weight, k = 1, inplace = TRUE) \item{inplace}{If TRUE, each polygon is modified in its original place, if FALSE multi-polygons are centered on their initial centroid} + +\item{n_cpu}{Number of cores to use. Defaults to maximum available identified with \code{\link[parallelly]{availableCores}}.} } \value{ An object of the same class as x with resized polygon boundaries diff --git a/man/nc_cartogram.Rd b/man/nc_cartogram.Rd index f366b35..ab51087 100644 --- a/man/nc_cartogram.Rd +++ b/man/nc_cartogram.Rd @@ -16,6 +16,7 @@ nc_cartogram(shp, ...) \item{\code{k}}{Factor expansion for the unit with the greater value} \item{\code{inplace}}{If TRUE, each polygon is modified in its original place, if FALSE multi-polygons are centered on their initial centroid} + \item{\code{n_cpu}}{Number of cores to use. Defaults to maximum available identified with \code{\link[parallelly]{availableCores}}.} }} } \description{ diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..9240045 --- /dev/null +++ b/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") diff --git a/tests/testthat/test-cartogram_ncont.R b/tests/testthat/test-cartogram_ncont.R new file mode 100644 index 0000000..6270b3a --- /dev/null +++ b/tests/testthat/test-cartogram_ncont.R @@ -0,0 +1,11 @@ +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) +}) From b632be1849073570b18f0e8467774367f48561b1 Mon Sep 17 00:00:00 2001 From: Egor Kotov Date: Sun, 3 Nov 2024 13:47:29 +0100 Subject: [PATCH 3/5] no need for progressr package --- DESCRIPTION | 1 - 1 file changed, 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 181d906..c005f1a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,7 +16,6 @@ Imports: methods, sf, packcircles, - progressr, furrr, parallelly, future From 2c4d8b8f3457c0dc0a0994481469931b86f5560c Mon Sep 17 00:00:00 2001 From: Egor Kotov Date: Sun, 3 Nov 2024 14:01:43 +0100 Subject: [PATCH 4/5] hotfix to restore CRS of the original sf object --- R/cartogram_ncont.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/cartogram_ncont.R b/R/cartogram_ncont.R index 63a91af..6e4c29b 100644 --- a/R/cartogram_ncont.R +++ b/R/cartogram_ncont.R @@ -111,6 +111,7 @@ cartogram_ncont.sf <- function( spdf$r <- as.numeric(sqrt( wArea/ surf)) spdf$r[spdf$r == 0] <- 0.001 # don't shrink polygons to zero area n <- nrow(spdf) + 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, ], @@ -122,6 +123,7 @@ cartogram_ncont.sf <- function( ) 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) } From cdec44bc94f1ab2f78481fe881a01d1b1eb7416b Mon Sep 17 00:00:00 2001 From: Egor Kotov Date: Sun, 3 Nov 2024 14:08:08 +0100 Subject: [PATCH 5/5] a test for empty CRS --- tests/testthat/test-cartogram_ncont.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-cartogram_ncont.R b/tests/testthat/test-cartogram_ncont.R index 6270b3a..ca0e419 100644 --- a/tests/testthat/test-cartogram_ncont.R +++ b/tests/testthat/test-cartogram_ncont.R @@ -9,3 +9,14 @@ test_that("nc cartogram matches expected area", { 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)) +})