├── .github ├── .gitignore └── workflows │ ├── recheck.yaml │ ├── pkgdown.yaml │ └── R-CMD-check.yaml ├── _pkgdown.yml ├── man ├── figures │ ├── README-cont-1.png │ ├── README-ncont-1.png │ ├── README-dorling-1.png │ ├── README-parallel-1.png │ └── README-sfsupport-1.png ├── nc_cartogram.Rd ├── cartogram_assert_package.Rd ├── cartogram_dorling.Rd ├── cartogram.Rd ├── cartogram_ncont.Rd └── cartogram_cont.Rd ├── .lintr ├── .Rbuildignore ├── tests ├── testthat │ ├── test-markdown.R │ ├── test.Rmd │ ├── test-cartogram_ncont.R │ └── test-cartogram_cont.R └── testthat.R ├── cartogram.Rproj ├── .gitignore ├── NAMESPACE ├── R ├── utils.R ├── cartogram_dorling.R ├── cartogram_ncont.R └── cartogram_cont.R ├── DESCRIPTION ├── NEWS.md ├── README.Rmd └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: ~ 2 | template: 3 | bootstrap: 5 4 | 5 | -------------------------------------------------------------------------------- /man/figures/README-cont-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sjewo/cartogram/HEAD/man/figures/README-cont-1.png -------------------------------------------------------------------------------- /man/figures/README-ncont-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sjewo/cartogram/HEAD/man/figures/README-ncont-1.png -------------------------------------------------------------------------------- /man/figures/README-dorling-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sjewo/cartogram/HEAD/man/figures/README-dorling-1.png -------------------------------------------------------------------------------- /man/figures/README-parallel-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sjewo/cartogram/HEAD/man/figures/README-parallel-1.png -------------------------------------------------------------------------------- /man/figures/README-sfsupport-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sjewo/cartogram/HEAD/man/figures/README-sfsupport-1.png -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: linters_with_defaults( 2 | return_linter = NULL, 3 | line_length_linter = NULL, 4 | commented_code_linter = NULL, 5 | object_name_linter = NULL, 6 | quotes_linter = NULL, 7 | indentation_linter = NULL) 8 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.travis\.yml$ 4 | ^README\.Rmd$ 5 | ^README-.*\.png$ 6 | ^_pkgdown\.yml$ 7 | ^docs$ 8 | ^pkgdown$ 9 | ^\.github$ 10 | ^private$ 11 | ^.cache$ 12 | ^.config$ 13 | ^.local$ 14 | ^.vscode$ 15 | ^.DS_Store$ 16 | ^.lintr$ -------------------------------------------------------------------------------- /tests/testthat/test-markdown.R: -------------------------------------------------------------------------------- 1 | test_that("R Markdown documents can be rendered", { 2 | skip_on_cran() 3 | skip_if_not_installed(c("rmarkdown", "tmap")) 4 | rmarkdown::render("test.Rmd", quiet = TRUE) 5 | expect_true(file.exists("test.html")) 6 | unlink("test.html") 7 | }) 8 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview 7 | # * https://testthat.r-lib.org/articles/special-files.html 8 | 9 | library(testthat) 10 | library(cartogram) 11 | 12 | 13 | test_check("cartogram") 14 | -------------------------------------------------------------------------------- /.github/workflows/recheck.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | workflow_dispatch: 3 | inputs: 4 | which: 5 | type: choice 6 | description: Which dependents to check 7 | options: 8 | - strong 9 | - most 10 | 11 | name: Reverse dependency check 12 | 13 | jobs: 14 | revdep_check: 15 | name: Reverse check ${{ inputs.which }} dependents 16 | uses: r-devel/recheck/.github/workflows/recheck.yml@v1 17 | with: 18 | which: ${{ inputs.which }} -------------------------------------------------------------------------------- /cartogram.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 8c1bcf45-2691-44bd-9d45-e57d19d3e1ce 3 | 4 | RestoreWorkspace: Default 5 | SaveWorkspace: Default 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: knitr 14 | LaTeX: pdfLaTeX 15 | 16 | BuildType: Package 17 | PackageUseDevtools: Yes 18 | PackageInstallArgs: --no-multiarch --with-keep.source 19 | PackageCheckArgs: --as-cran 20 | PackageRoxygenize: rd,collate,namespace,vignette 21 | -------------------------------------------------------------------------------- /tests/testthat/test.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "test" 3 | output: html_document 4 | --- 5 | 6 | 7 | ```{r parallel, fig.asp = 1.2} 8 | library(cartogram) 9 | library(sf) 10 | library(tmap) 11 | 12 | data("World") 13 | 14 | # keep only the african continent 15 | afr <- World[World$continent == "Africa", ] 16 | 17 | # project the map 18 | afr <- st_transform(afr, 3395) 19 | 20 | # Create cartogram using 2 CPU cores on local machine 21 | afr_cont <- cartogram_cont(afr, weight = "pop_est", itermax = 5) 22 | 23 | # plot it 24 | tm_shape(afr_cont) + 25 | tm_polygons("pop_est", 26 | fill.scale = tm_scale_intervals(style = "jenks")) + 27 | tm_layout(frame = FALSE, 28 | legend.position = c("left", "bottom")) 29 | ``` 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # Example code in package build process 9 | *-Ex.R 10 | 11 | # Output files from R CMD build 12 | /*.tar.gz 13 | 14 | # Output files from R CMD check 15 | /*.Rcheck/ 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | 20 | # produced vignettes 21 | vignettes/*.html 22 | vignettes/*.pdf 23 | 24 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 25 | .httr-oauth 26 | 27 | # knitr and R markdown default cache directories 28 | /*_cache/ 29 | /cache/ 30 | 31 | # Temporary files created by R markdown 32 | *.utf8.md 33 | *.knit.md 34 | .Rproj.user 35 | 36 | # VIM files 37 | *.swp 38 | 39 | # pkgdown 40 | docs 41 | 42 | # private folder for draft test scripts 43 | private 44 | 45 | .cache 46 | .config 47 | .local 48 | .vscode 49 | .DS_Store 50 | -------------------------------------------------------------------------------- /tests/testthat/test-cartogram_ncont.R: -------------------------------------------------------------------------------- 1 | test_that("nc cartogram matches expected area", { 2 | # Load North Carolina SIDS data 3 | nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) 4 | # transform to NAD83 / UTM zone 16N 5 | nc_utm <- sf::st_transform(nc, 26916) 6 | 7 | # Create cartogram 8 | nc_utm_carto <- cartogram_ncont(nc_utm, weight = "BIR74") 9 | cartogram_area <- as.integer((sum(nc_utm_carto |> st_area())) / 1000) 10 | expect_equal(cartogram_area, 22284872, tolerance = 500) 11 | }) 12 | 13 | test_that("nc cartogram has crs", { 14 | # Load North Carolina SIDS data 15 | nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) 16 | # transform to NAD83 / UTM zone 16N 17 | nc_utm <- sf::st_transform(nc, 26916) 18 | 19 | # Create cartogram 20 | nc_utm_carto <- cartogram_ncont(nc_utm, weight = "BIR74") 21 | expect_false(is.na(sf::st_crs(nc_utm_carto)$wkt)) 22 | }) 23 | -------------------------------------------------------------------------------- /tests/testthat/test-cartogram_cont.R: -------------------------------------------------------------------------------- 1 | test_that("cartogram_cont matches expected area", { 2 | # Load North Carolina SIDS data 3 | nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) 4 | # transform to NAD83 / UTM zone 16N 5 | nc_utm <- sf::st_transform(nc, 26916) 6 | 7 | # Create cartogram 8 | nc_utm_carto <- cartogram_cont(nc_utm, weight = "BIR74", itermax = 5) 9 | cartogram_area <- as.integer((sum(nc_utm_carto |> st_area())) / 1000) 10 | expect_equal(cartogram_area, 118877899, tolerance = 500) 11 | }) 12 | 13 | test_that("cartogram_cont has crs", { 14 | # Load North Carolina SIDS data 15 | nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) 16 | # transform to NAD83 / UTM zone 16N 17 | nc_utm <- sf::st_transform(nc, 26916) 18 | 19 | # Create cartogram 20 | nc_utm_carto <- cartogram_cont(nc_utm, weight = "BIR74", itermax = 5) 21 | expect_false(is.na(sf::st_crs(nc_utm_carto)$wkt)) 22 | }) 23 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(cartogram_cont,SpatialPolygonsDataFrame) 4 | S3method(cartogram_cont,sf) 5 | S3method(cartogram_dorling,SpatialPolygonsDataFrame) 6 | S3method(cartogram_dorling,sf) 7 | S3method(cartogram_ncont,SpatialPolygonsDataFrame) 8 | S3method(cartogram_ncont,sf) 9 | export(cartogram) 10 | export(cartogram_cont) 11 | export(cartogram_dorling) 12 | export(cartogram_ncont) 13 | export(nc_cartogram) 14 | importFrom(methods,as) 15 | importFrom(methods,is) 16 | importFrom(methods,slot) 17 | importFrom(packcircles,circleRepelLayout) 18 | importFrom(sf,"st_crs<-") 19 | importFrom(sf,"st_geometry<-") 20 | importFrom(sf,st_area) 21 | importFrom(sf,st_as_sf) 22 | importFrom(sf,st_buffer) 23 | importFrom(sf,st_cast) 24 | importFrom(sf,st_centroid) 25 | importFrom(sf,st_coordinates) 26 | importFrom(sf,st_crs) 27 | importFrom(sf,st_distance) 28 | importFrom(sf,st_geometry) 29 | importFrom(sf,st_geometry_type) 30 | importFrom(sf,st_is_longlat) 31 | importFrom(sf,st_point) 32 | importFrom(sf,st_union) 33 | importFrom(stats,quantile) 34 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # reworked is_installed2 from https://github.com/dataheld/elf/blob/main/R/dependencies.R 2 | #' Checks if a package is installed and *informs* the user if not 3 | #' 4 | #' This is wrapper around [rlang::check_installed]; 5 | #' instead of erroring out if the check fails it returns `FALSE`. 6 | #' However, unlike [rlang::is_installed], it emits a message to the user. 7 | #' 8 | #' @inheritParams rlang::check_installed 9 | #' @inheritDotParams rlang::check_installed 10 | #' @keywords internal 11 | cartogram_assert_package <- function(...) { 12 | if (rlang::is_installed(...)) { 13 | return(TRUE) 14 | } 15 | 16 | withRestarts( 17 | tryCatch( 18 | rlang::check_installed(...), 19 | error = function(cnd) { 20 | if (inherits(cnd, "rlib_error_package_not_found")) { 21 | message("The required package is not installed.") 22 | stop(cnd) # Re-throw the error 23 | } 24 | } 25 | ), 26 | abort = function(cnd) { 27 | message("The required package is not installed.") 28 | stop(cnd) # Re-throw the error 29 | } 30 | ) 31 | 32 | rlang::is_installed(...) 33 | } 34 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: cartogram 2 | Title: Create Cartograms with R 3 | Version: 0.4.0 4 | Authors@R: c( 5 | person("Sebastian", "Jeworutzki", , "sebastian.jeworutzki@ruhr-uni-bochum.de", role = c("aut", "cre"), 6 | comment = c(ORCID = "0000-0002-2671-5253")), 7 | person("Timothee", "Giraud", role = "ctb"), 8 | person("Nicolas", "Lambert", role = "ctb"), 9 | person("Roger", "Bivand", , "Roger.Bivand@nhh.no", role = "cph"), 10 | person("Edzer", "Pebesma", role = "cph"), 11 | person("Jakub", "Nowosad", , "nowosad.jakub@gmail.com", role = "ctb", 12 | comment = c(ORCID = "0000-0002-1057-3721")), 13 | person("Egor", "Kotov", , "kotov.egor@gmail.com", role = "ctb", 14 | comment = c(ORCID = "0000-0001-6690-5345")) 15 | ) 16 | Description: Construct continuous and non-contiguous area cartograms. 17 | License: GPL-3 18 | URL: https://github.com/sjewo/cartogram, 19 | https://sjewo.github.io/cartogram/ 20 | BugReports: https://github.com/sjewo/cartogram/issues 21 | Imports: 22 | methods, 23 | packcircles, 24 | rlang, 25 | sf 26 | Suggests: 27 | future (>= 1.40.0), 28 | future.apply, 29 | parallelly, 30 | progressr, 31 | rmarkdown, 32 | testthat (>= 3.0.0), 33 | tmap 34 | Config/testthat/edition: 3 35 | Encoding: UTF-8 36 | RoxygenNote: 7.3.2 37 | Roxygen: list(markdown = TRUE) 38 | 39 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # cartogram 0.4.0 2 | 3 | * The new `n_cpu` option in `cartogram_cont()` and `cartogram_ncont()` enables distortion calculation across multiple CPU cores (thanks to [e-kotov](https://github.com/e-kotov)!) 4 | * The default threshold value in `cartogram_cont()` will now automatically increase if the weighting variable contains a significant number of zeros. 5 | * Additional tests have been implemented. 6 | 7 | # cartogram 0.3.0 8 | 9 | * Remove `sp`, `rgdal` and `maptools` from examples and suggestions. 10 | * `cartogram_cont()` has a new parameter `verbose = FALSE` to hide print of size error on each iteration. 11 | 12 | # cartogram 0.2.2 13 | 14 | * Fix geometry replacement in `cartogram_ncont` 15 | 16 | # cartogram 0.2.0 17 | 18 | * Migrated all functions to sf, fixed problems with multipolygons. 19 | * cartogram functions won't accept features with longitude/latitude coordinates anymore. 20 | 21 | # cartogram 0.1.1 22 | 23 | * Update sf code. Thanks to [@Nowosad](https://github.com/Nowosad) for speeding things up! 24 | 25 | # cartogram 0.1.0 26 | 27 | * Non-Overlapping Circles Cartogram (Dorling) 28 | 29 | # cartogram 0.0.3 30 | 31 | * sf support added 32 | 33 | # cartogram 0.0.2 34 | 35 | * Non-contiguous Area Cartogram 36 | * Prepare data with missing or extreme values before cartogram calculation for faster convergence 37 | 38 | # cartogram 0.0.1 39 | 40 | * Initial Release 41 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | permissions: 23 | contents: write 24 | steps: 25 | - uses: actions/checkout@v3 26 | 27 | - uses: r-lib/actions/setup-pandoc@v2 28 | 29 | - uses: r-lib/actions/setup-r@v2 30 | with: 31 | use-public-rspm: true 32 | 33 | - uses: r-lib/actions/setup-r-dependencies@v2 34 | with: 35 | extra-packages: any::pkgdown, local::. 36 | needs: website 37 | 38 | - name: Build site 39 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 40 | shell: Rscript {0} 41 | 42 | - name: Deploy to GitHub pages 🚀 43 | if: github.event_name != 'pull_request' 44 | uses: JamesIves/github-pages-deploy-action@v4.4.1 45 | with: 46 | clean: false 47 | branch: gh-pages 48 | folder: docs 49 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macos-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | 31 | steps: 32 | - uses: actions/checkout@v3 33 | 34 | - uses: r-lib/actions/setup-pandoc@v2 35 | 36 | - uses: r-lib/actions/setup-r@v2 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | http-user-agent: ${{ matrix.config.http-user-agent }} 40 | use-public-rspm: true 41 | 42 | - uses: r-lib/actions/setup-r-dependencies@v2 43 | with: 44 | extra-packages: any::rcmdcheck 45 | needs: check 46 | 47 | - uses: r-lib/actions/check-r-package@v2 48 | with: 49 | upload-snapshots: true 50 | -------------------------------------------------------------------------------- /man/nc_cartogram.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cartogram_ncont.R 3 | \name{nc_cartogram} 4 | \alias{nc_cartogram} 5 | \title{Calculate Non-Contiguous Cartogram Boundaries} 6 | \usage{ 7 | nc_cartogram(shp, ...) 8 | } 9 | \arguments{ 10 | \item{shp}{SpatialPolygonDataFrame or an sf object} 11 | 12 | \item{...}{ 13 | Arguments passed on to \code{\link[=cartogram_ncont]{cartogram_ncont}} 14 | \describe{ 15 | \item{\code{weight}}{Name of the weighting variable in x} 16 | \item{\code{k}}{Factor expansion for the unit with the greater value} 17 | \item{\code{inplace}}{If TRUE, each polygon is modified in its original place, 18 | if FALSE multi-polygons are centered on their initial centroid} 19 | \item{\code{n_cpu}}{Number of cores to use. Defaults to "respect_future_plan". Available options are: 20 | \itemize{ 21 | \item "respect_future_plan" - By default, the function will run on a single core, unless the user specifies the number of cores using \code{\link[future]{plan}} (e.g. \code{future::plan(future::multisession, workers = 4)}) before running the \code{cartogram_ncont} function. 22 | \item "auto" - Use all except available cores (identified with \code{\link[parallelly]{availableCores}}) except 1, to keep the system responsive. 23 | \item a \code{numeric} value - Use the specified number of cores. In this case \code{cartogram_ncont} will use set the specified number of cores internally with \code{future::plan(future::multisession, workers = n_cpu)} and revert that back by switching the plan back to whichever plan might have been set before by the user. If only 1 core is set, the function will not require \code{future} and \code{future.apply} and will run on a single core. 24 | }} 25 | \item{\code{show_progress}}{A \code{logical} value. If TRUE, show progress bar. Defaults to TRUE.} 26 | }} 27 | } 28 | \description{ 29 | This function has been renamed: Please use cartogram_ncont() instead of nc_cartogram(). 30 | } 31 | \keyword{internal} 32 | -------------------------------------------------------------------------------- /man/cartogram_assert_package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{cartogram_assert_package} 4 | \alias{cartogram_assert_package} 5 | \title{Checks if a package is installed and \emph{informs} the user if not} 6 | \usage{ 7 | cartogram_assert_package(...) 8 | } 9 | \arguments{ 10 | \item{...}{ 11 | Arguments passed on to \code{\link[rlang:is_installed]{rlang::check_installed}} 12 | \describe{ 13 | \item{\code{pkg}}{The package names. Can include version requirements, 14 | e.g. \code{"pkg (>= 1.0.0)"}.} 15 | \item{\code{version}}{Minimum versions for \code{pkg}. If supplied, must be the 16 | same length as \code{pkg}. \code{NA} elements stand for any versions.} 17 | \item{\code{compare}}{A character vector of comparison operators to use 18 | for \code{version}. If supplied, must be the same length as 19 | \code{version}. If \code{NULL}, \code{>=} is used as default for all 20 | elements. \code{NA} elements in \code{compare} are also set to \code{>=} by 21 | default.} 22 | \item{\code{reason}}{Optional string indicating why is \code{pkg} needed. 23 | Appears in error messages (if non-interactive) and user prompts 24 | (if interactive).} 25 | \item{\code{action}}{An optional function taking \code{pkg} and \code{...} 26 | arguments. It is called by \code{check_installed()} when the user 27 | chooses to update outdated packages. The function is passed the 28 | missing and outdated packages as a character vector of names.} 29 | \item{\code{call}}{The execution environment of a currently 30 | running function, e.g. \code{caller_env()}. The function will be 31 | mentioned in error messages as the source of the error. See the 32 | \code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} 33 | }} 34 | } 35 | \description{ 36 | This is wrapper around \link[rlang:is_installed]{rlang::check_installed}; 37 | instead of erroring out if the check fails it returns \code{FALSE}. 38 | However, unlike \link[rlang:is_installed]{rlang::is_installed}, it emits a message to the user. 39 | } 40 | \keyword{internal} 41 | -------------------------------------------------------------------------------- /man/cartogram_dorling.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cartogram_dorling.R 3 | \name{cartogram_dorling} 4 | \alias{cartogram_dorling} 5 | \alias{cartogram_dorling.sf} 6 | \alias{cartogram_dorling.SpatialPolygonsDataFrame} 7 | \title{Calculate Non-Overlapping Circles Cartogram} 8 | \usage{ 9 | cartogram_dorling(x, weight, k = 5, m_weight = 1, itermax = 1000) 10 | 11 | \method{cartogram_dorling}{sf}(x, weight, k = 5, m_weight = 1, itermax = 1000) 12 | 13 | \method{cartogram_dorling}{SpatialPolygonsDataFrame}(x, weight, k = 5, m_weight = 1, itermax = 1000) 14 | } 15 | \arguments{ 16 | \item{x}{a polygon or multiplogyon sf object} 17 | 18 | \item{weight}{Name of the weighting variable in x} 19 | 20 | \item{k}{Share of the bounding box of x filled by the larger circle} 21 | 22 | \item{m_weight}{Circles' movements weights. An optional vector of numeric weights 23 | (0 to 1 inclusive) to 24 | apply to the distance each circle moves during pair-repulsion. A weight of 0 25 | prevents any movement. A weight of 1 gives the default movement distance. A 26 | single value can be supplied for uniform weights. A vector with length less 27 | than the number of circles will be silently extended by repeating the final 28 | value. Any values outside the range [0, 1] will be clamped to 0 or 1.} 29 | 30 | \item{itermax}{Maximum iterations for the cartogram transformation.} 31 | } 32 | \value{ 33 | Non overlaping proportional circles of the same class as x. 34 | } 35 | \description{ 36 | Construct a cartogram which represents each geographic region 37 | as non-overlapping circles (Dorling 1996). 38 | } 39 | \examples{ 40 | library(sf) 41 | library(cartogram) 42 | 43 | nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 44 | 45 | # transform to NAD83 / UTM zone 16N 46 | nc_utm <- st_transform(nc, 26916) 47 | 48 | # Create cartogram 49 | nc_utm_carto <- cartogram_dorling(nc_utm, weight = "BIR74") 50 | 51 | # Plot 52 | par(mfrow = c(2,1)) 53 | plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 54 | plot(nc_utm_carto[, "BIR74"], main="distorted", key.pos = NULL, reset = FALSE) 55 | 56 | } 57 | \references{ 58 | Dorling, D. (1996). Area Cartograms: Their Use and Creation. In Concepts and Techniques in Modern Geography (CATMOG), 59. 59 | } 60 | -------------------------------------------------------------------------------- /man/cartogram.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cartogram_cont.R 3 | \name{cartogram} 4 | \alias{cartogram} 5 | \title{Calculate Contiguous Cartogram Boundaries} 6 | \usage{ 7 | cartogram(shp, ...) 8 | } 9 | \arguments{ 10 | \item{shp}{SpatialPolygonDataFrame or an sf object} 11 | 12 | \item{...}{ 13 | Arguments passed on to \code{\link[=cartogram_cont]{cartogram_cont}} 14 | \describe{ 15 | \item{\code{weight}}{Name of the weighting variable in x} 16 | \item{\code{itermax}}{Maximum iterations for the cartogram transformation, if maxSizeError ist not reached} 17 | \item{\code{maxSizeError}}{Stop if meanSizeError is smaller than maxSizeError} 18 | \item{\code{prepare}}{Weighting values are adjusted to reach convergence much earlier. Possible methods are: 19 | \itemize{ 20 | \item "adjust", adjust values to restrict the mass vector to the quantiles defined by threshold and 1-threshold (default), 21 | \item "remove", remove features with values lower than quantile at threshold, 22 | \item "none", don't adjust weighting values 23 | }} 24 | \item{\code{threshold}}{"auto" or a threshold value between 0 and 1. With “auto”, the value is 0.05 or, if the proportion of zeros in the weight is greater than 0.05, the value is adjusted accordingly.} 25 | \item{\code{verbose}}{print meanSizeError on each iteration} 26 | \item{\code{n_cpu}}{Number of cores to use. Defaults to "respect_future_plan". Available options are: 27 | \itemize{ 28 | \item "respect_future_plan" - By default, the function will run on a single core, unless the user specifies the number of cores using \code{\link[future]{plan}} (e.g. \code{future::plan(future::multisession, workers = 4)}) before running the \code{cartogram_cont} function. 29 | \item "auto" - Use all except available cores (identified with \code{\link[parallelly]{availableCores}}) except 1, to keep the system responsive. 30 | \item a \code{numeric} value - Use the specified number of cores. In this case \code{cartogram_cont} will use set the specified number of cores internally with \code{future::plan(future::multisession, workers = n_cpu)} and revert that back by switching the plan back to whichever plan might have been set before by the user. If only 1 core is set, the function will not require \code{future} and \code{future.apply} and will run on a single core. 31 | }} 32 | \item{\code{show_progress}}{A \code{logical} value. If TRUE, show progress bar. Defaults to TRUE.} 33 | }} 34 | } 35 | \description{ 36 | This function has been renamed: Please use cartogram_cont() instead of cartogram(). 37 | } 38 | \keyword{internal} 39 | -------------------------------------------------------------------------------- /R/cartogram_dorling.R: -------------------------------------------------------------------------------- 1 | #' @title Calculate Non-Overlapping Circles Cartogram 2 | #' @description Construct a cartogram which represents each geographic region 3 | #' as non-overlapping circles (Dorling 1996). 4 | #' @name cartogram_dorling 5 | #' @param x a polygon or multiplogyon sf object 6 | #' @param weight Name of the weighting variable in x 7 | #' @param k Share of the bounding box of x filled by the larger circle 8 | #' @param m_weight Circles' movements weights. An optional vector of numeric weights 9 | #' (0 to 1 inclusive) to 10 | #' apply to the distance each circle moves during pair-repulsion. A weight of 0 11 | #' prevents any movement. A weight of 1 gives the default movement distance. A 12 | #' single value can be supplied for uniform weights. A vector with length less 13 | #' than the number of circles will be silently extended by repeating the final 14 | #' value. Any values outside the range \[0, 1\] will be clamped to 0 or 1. 15 | #' @param itermax Maximum iterations for the cartogram transformation. 16 | #' @return Non overlaping proportional circles of the same class as x. 17 | #' @export 18 | #' @references Dorling, D. (1996). Area Cartograms: Their Use and Creation. In Concepts and Techniques in Modern Geography (CATMOG), 59. 19 | #' @examples 20 | #'library(sf) 21 | #'library(cartogram) 22 | #' 23 | # Load North Carolina SIDS data 24 | #'nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 25 | #' 26 | #'# transform to NAD83 / UTM zone 16N 27 | #'nc_utm <- st_transform(nc, 26916) 28 | #' 29 | #'# Create cartogram 30 | #'nc_utm_carto <- cartogram_dorling(nc_utm, weight = "BIR74") 31 | #' 32 | #'# Plot 33 | #'par(mfrow = c(2,1)) 34 | #'plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 35 | #'plot(nc_utm_carto[, "BIR74"], main="distorted", key.pos = NULL, reset = FALSE) 36 | #' 37 | cartogram_dorling <- function(x, weight, k = 5, m_weight = 1, itermax = 1000) { 38 | UseMethod("cartogram_dorling") 39 | } 40 | 41 | #' @rdname cartogram_dorling 42 | #' @importFrom sf st_is_longlat st_as_sf st_geometry st_coordinates st_geometry st_centroid st_crs 43 | #' @importFrom packcircles circleRepelLayout 44 | #' @export 45 | cartogram_dorling.sf <- function(x, weight, k = 5, m_weight = 1, itermax = 1000) { 46 | # proj or unproj 47 | if (sf::st_is_longlat(x)) { 48 | 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. = FALSE) 49 | } 50 | # no 0 values 51 | x <- x[x[[weight]] > 0, ] 52 | # data prep 53 | dat.init <- data.frame(sf::st_coordinates(sf::st_centroid(sf::st_geometry(x))), 54 | v = x[[weight]]) 55 | surf <- (max(dat.init[, 1]) - min(dat.init[, 1])) * (max(dat.init[, 2]) - min(dat.init[, 2])) 56 | dat.init$v <- dat.init$v * (surf * k / 100) / max(dat.init$v) 57 | # circles layout and radiuses 58 | res <- packcircles::circleRepelLayout(x = dat.init, xysizecols = 1:3, 59 | wrap = FALSE, sizetype = "area", 60 | maxiter = itermax, weights = m_weight) 61 | # sf object creation 62 | . <- sf::st_buffer(sf::st_as_sf(res$layout, 63 | coords = c('x', 'y'), 64 | crs = sf::st_crs(x)), 65 | dist = res$layout$radius) 66 | sf::st_geometry(x) <- sf::st_geometry(.) 67 | return(x) 68 | } 69 | 70 | #' @rdname cartogram_dorling 71 | #' @export 72 | cartogram_dorling.SpatialPolygonsDataFrame <- function(x, weight, k = 5, m_weight = 1, itermax = 1000) { 73 | as(cartogram_dorling.sf(sf::st_as_sf(x), weight = weight, k = k, m_weight = m_weight, itermax = itermax), "Spatial") 74 | } 75 | -------------------------------------------------------------------------------- /man/cartogram_ncont.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cartogram_ncont.R 3 | \name{cartogram_ncont} 4 | \alias{cartogram_ncont} 5 | \alias{cartogram_ncont.SpatialPolygonsDataFrame} 6 | \alias{cartogram_ncont.sf} 7 | \title{Calculate Non-Contiguous Cartogram Boundaries} 8 | \usage{ 9 | cartogram_ncont( 10 | x, 11 | weight, 12 | k = 1, 13 | inplace = TRUE, 14 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 15 | show_progress = getOption("cartogram.show_progress", TRUE) 16 | ) 17 | 18 | \method{cartogram_ncont}{SpatialPolygonsDataFrame}( 19 | x, 20 | weight, 21 | k = 1, 22 | inplace = TRUE, 23 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 24 | show_progress = getOption("cartogram.show_progress", TRUE) 25 | ) 26 | 27 | \method{cartogram_ncont}{sf}( 28 | x, 29 | weight, 30 | k = 1, 31 | inplace = TRUE, 32 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 33 | show_progress = getOption("cartogram.show_progress", TRUE) 34 | ) 35 | } 36 | \arguments{ 37 | \item{x}{a polygon or multiplogyon sf object} 38 | 39 | \item{weight}{Name of the weighting variable in x} 40 | 41 | \item{k}{Factor expansion for the unit with the greater value} 42 | 43 | \item{inplace}{If TRUE, each polygon is modified in its original place, 44 | if FALSE multi-polygons are centered on their initial centroid} 45 | 46 | \item{n_cpu}{Number of cores to use. Defaults to "respect_future_plan". Available options are: 47 | \itemize{ 48 | \item "respect_future_plan" - By default, the function will run on a single core, unless the user specifies the number of cores using \code{\link[future]{plan}} (e.g. \code{future::plan(future::multisession, workers = 4)}) before running the \code{cartogram_ncont} function. 49 | \item "auto" - Use all except available cores (identified with \code{\link[parallelly]{availableCores}}) except 1, to keep the system responsive. 50 | \item a \code{numeric} value - Use the specified number of cores. In this case \code{cartogram_ncont} will use set the specified number of cores internally with \code{future::plan(future::multisession, workers = n_cpu)} and revert that back by switching the plan back to whichever plan might have been set before by the user. If only 1 core is set, the function will not require \code{future} and \code{future.apply} and will run on a single core. 51 | }} 52 | 53 | \item{show_progress}{A \code{logical} value. If TRUE, show progress bar. Defaults to TRUE.} 54 | } 55 | \value{ 56 | An object of the same class as x with resized polygon boundaries 57 | } 58 | \description{ 59 | Construct a non-contiguous area cartogram (Olson 1976). 60 | } 61 | \examples{ 62 | # ========= Basic example ========= 63 | library(sf) 64 | library(cartogram) 65 | 66 | nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 67 | 68 | # transform to NAD83 / UTM zone 16N 69 | nc_utm <- st_transform(nc, 26916) 70 | 71 | # Create cartogram 72 | nc_utm_carto <- cartogram_ncont(nc_utm, weight = "BIR74") 73 | 74 | # Plot 75 | par(mfrow=c(2,1)) 76 | plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 77 | plot(st_geometry(nc_utm), main="distorted", reset = FALSE) 78 | plot(nc_utm_carto[,"BIR74"], add =TRUE) 79 | 80 | 81 | # ========= Advanced example 1 ========= 82 | # Faster cartogram using multiple CPU cores 83 | # using n_cpu parameter 84 | library(sf) 85 | library(cartogram) 86 | 87 | nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 88 | 89 | # transform to NAD83 / UTM zone 16N 90 | nc_utm <- st_transform(nc, 26916) 91 | 92 | # Create cartogram using 2 CPU cores on local machine 93 | nc_utm_carto <- cartogram_ncont(nc_utm, weight = "BIR74", n_cpu = 2) 94 | 95 | # Plot 96 | par(mfrow=c(2,1)) 97 | plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 98 | plot(st_geometry(nc_utm), main="distorted", reset = FALSE) 99 | plot(nc_utm_carto[,"BIR74"], add =TRUE) 100 | 101 | 102 | # ========= Advanced example 2 ========= 103 | # Faster cartogram using multiple CPU cores 104 | # using future package plan 105 | library(sf) 106 | library(cartogram) 107 | library(future) 108 | 109 | nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 110 | 111 | # transform to NAD83 / UTM zone 16N 112 | nc_utm <- st_transform(nc, 26916) 113 | # Set the future plan with 2 CPU local cores 114 | # You can of course use any other plans, not just multisession 115 | future::plan(future::multisession, workers = 2) 116 | 117 | # Create cartogram with multiple CPU cores 118 | # The cartogram_cont() will respect the plan set above 119 | nc_utm_carto <- cartogram_ncont(nc_utm, weight = "BIR74") 120 | 121 | # Shutdown the R processes that were created by the future plan 122 | future::plan(future::sequential) 123 | 124 | # Plot 125 | par(mfrow=c(2,1)) 126 | plot(nc[,"BIR74"], main = "original", key.pos = NULL, reset = FALSE) 127 | plot(st_geometry(nc_utm), main = "distorted", reset = FALSE) 128 | plot(nc_utm_carto[,"BIR74"], add = TRUE) 129 | 130 | 131 | } 132 | \references{ 133 | Olson, J. M. (1976). Noncontiguous Area Cartograms. In The Professional Geographer, 28(4), 371-380. 134 | } 135 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "cartogram: Create Cartograms with R" 3 | output: 4 | github_document: 5 | fig_width: 4 6 | fig_height: 3.5 7 | --- 8 | 9 | 10 | [![CRAN status](https://www.r-pkg.org/badges/version/cartogram)](https://cran.r-project.org/package=cartogram) 11 | [![R-CMD-check](https://github.com/sjewo/cartogram/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/sjewo/cartogram/actions/workflows/R-CMD-check.yaml) 12 | [![CRAN Downloads](https://cranlogs.r-pkg.org/badges/cartogram)](https://cran.r-project.org/package=cartogram) 13 | 14 | 15 | ```{r, echo=F} 16 | knitr::opts_chunk$set( 17 | collapse = TRUE, 18 | comment = "#>", 19 | fig.path = "man/figures/README-" 20 | ) 21 | ``` 22 | 23 | `cartogram` is an R package that implements methods for generating continuous area cartograms (based on the rubber sheet distortion algorithm by Dougenik et al., 1985), non-contiguous area cartograms (Olson, 1976), and non-overlapping circles cartograms (Dorling et al., 1996). 24 | 25 | ## Installation 26 | 27 | You can install the **cartogram** package from CRAN as follows: 28 | 29 | ```{r, eval=FALSE} 30 | install.packages("cartogram") 31 | ``` 32 | 33 | To upgrade to the latest development version of `cartogram`, install the package `remotes` and run the following command: 34 | 35 | ```{r, eval=FALSE} 36 | remotes::install_github("sjewo/cartogram") 37 | ``` 38 | 39 | ## Examples 40 | 41 | ### Continuous Area Cartogram 42 | 43 | ```{r cont, fig.asp = 1.2} 44 | library(cartogram) 45 | library(sf) 46 | library(tmap) 47 | 48 | data("World") 49 | 50 | # Keep only the African continent 51 | afr <- World[World$continent == "Africa", ] 52 | 53 | # Project the map 54 | afr <- st_transform(afr, 3395) 55 | 56 | # Construct continuous area cartogram 57 | afr_cont <- cartogram_cont(afr, "pop_est", itermax = 5) 58 | 59 | # Plot the cartogram 60 | tm_shape(afr_cont) + 61 | tm_polygons("pop_est", 62 | fill.scale = tm_scale_intervals(style = "jenks")) + 63 | tm_layout(frame = FALSE, 64 | legend.position = c("left", "bottom")) 65 | ``` 66 | 67 | ### Non-contiguous Area Cartogram 68 | 69 | ```{r ncont, fig.asp = 1.2} 70 | library(cartogram) 71 | library(sf) 72 | library(tmap) 73 | 74 | data("World") 75 | 76 | # Keep only the African continent 77 | afr <- World[World$continent == "Africa", ] 78 | 79 | # Project the map 80 | afr <- st_transform(afr, 3395) 81 | 82 | # Plot the original map boundaries 83 | tm_shape(afr) + 84 | tm_borders() + 85 | # Add the the cartogram 86 | tm_shape(cartogram_ncont(afr, "pop_est")) + 87 | tm_polygons("pop_est", 88 | fill.scale = tm_scale_intervals(style = "jenks")) + 89 | tm_layout(frame = FALSE, 90 | legend.position = c("left", "bottom")) 91 | ``` 92 | 93 | ### Non-Overlapping Circles Cartogram 94 | 95 | ```{r dorling, fig.asp = 1.2} 96 | library(cartogram) 97 | library(sf) 98 | library(tmap) 99 | 100 | data("World") 101 | 102 | # Keep only the African continent 103 | afr <- World[World$continent == "Africa", ] 104 | 105 | # Project the map 106 | afr <- st_transform(afr, 3395) 107 | 108 | # Plot the original map boundaries 109 | tm_shape(afr) + 110 | tm_borders() + 111 | # Add the the cartogram 112 | tm_shape(cartogram_dorling(afr, "pop_est")) + 113 | tm_polygons("pop_est", 114 | fill.scale = tm_scale_intervals(style = "jenks")) + 115 | tm_layout(frame = FALSE, 116 | legend.position = c("left", "bottom")) 117 | ``` 118 | 119 | ## Use multiple CPU cores 120 | 121 | ```{r parallel, fig.asp = 1.2} 122 | library(cartogram) 123 | library(sf) 124 | library(tmap) 125 | library(future) 126 | library(future.apply) 127 | library(parallelly) 128 | library(progressr) 129 | 130 | data("World") 131 | 132 | # Keep only the African continent 133 | afr <- World[World$continent == "Africa", ] 134 | 135 | # Project the map 136 | afr <- st_transform(afr, 3395) 137 | 138 | # Create cartogram using 2 CPU cores on the local machine 139 | # This can speed up computation for larger datasets. 140 | # Set show_progress to TRUE for a progress indicator. 141 | afr_cont <- cartogram_cont(afr, weight = "pop_est", 142 | itermax = 5, 143 | n_cpu = 2, 144 | show_progress = FALSE) 145 | 146 | # Plot the cartogram 147 | tm_shape(afr_cont) + 148 | tm_polygons("pop_est", 149 | fill.scale = tm_scale_intervals(style = "jenks")) + 150 | tm_layout(frame = FALSE, 151 | legend.position = c("left", "bottom")) 152 | ``` 153 | 154 | ## Acknowledgements 155 | 156 | The non-contiguous area cartogram and non-overlapping circles cartogram functionalities include major code contributions from [@rCarto](https://github.com/rCarto) and [@neocarto](https://github.com/neocarto). 157 | 158 | [@nowosad](https://github.com/nowosad) contributed to the package by transitioning it to use the `sf` package and by enhancing the documentation, a task further supported by documentation improvements from [@oliveroy](https://github.com/oliveroy). 159 | 160 | The functionality to utilize multiple CPU cores was contributed by [@e-kotov](https://github.com/e-kotov). 161 | 162 | ## References 163 | 164 | This package implements algorithms based on the following seminal works: 165 | 166 | * Dorling, D. (1996). Area Cartograms: Their Use and Creation. In Concepts and Techniques in Modern Geography (CATMOG), 59. 167 | * Dougenik, J. A., Chrisman, N. R., & Niemeyer, D. R. (1985). An Algorithm To Construct Continuous Area Cartograms. In The Professional Geographer, 37(1), 75-81. 168 | * Olson, J. M. (1976), Noncontiguous Area Cartograms. The Professional Geographer, 28: 371–380. [doi:10.1111/j.0033-0124.1976.00371.x](https://doi.org/10.1111/j.0033-0124.1976.00371.x) 169 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | cartogram: Create Cartograms with R 2 | ================ 3 | 4 | 5 | 6 | [![CRAN 7 | status](https://www.r-pkg.org/badges/version/cartogram)](https://cran.r-project.org/package=cartogram) 8 | [![R-CMD-check](https://github.com/sjewo/cartogram/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/sjewo/cartogram/actions/workflows/R-CMD-check.yaml) 9 | [![CRAN 10 | Downloads](https://cranlogs.r-pkg.org/badges/cartogram)](https://cran.r-project.org/package=cartogram) 11 | 12 | 13 | `cartogram` is an R package that implements methods for generating 14 | continuous area cartograms (based on the rubber sheet distortion 15 | algorithm by Dougenik et al., 1985), non-contiguous area cartograms 16 | (Olson, 1976), and non-overlapping circles cartograms (Dorling et al., 17 | 1996). 18 | 19 | ## Installation 20 | 21 | You can install the **cartogram** package from CRAN as follows: 22 | 23 | ``` r 24 | install.packages("cartogram") 25 | ``` 26 | 27 | To upgrade to the latest development version of `cartogram`, install the 28 | package `remotes` and run the following command: 29 | 30 | ``` r 31 | remotes::install_github("sjewo/cartogram") 32 | ``` 33 | 34 | ## Examples 35 | 36 | ### Continuous Area Cartogram 37 | 38 | ``` r 39 | library(cartogram) 40 | library(sf) 41 | #> Linking to GEOS 3.13.0, GDAL 3.8.5, PROJ 9.5.1; sf_use_s2() is TRUE 42 | library(tmap) 43 | 44 | data("World") 45 | 46 | # Keep only the African continent 47 | afr <- World[World$continent == "Africa", ] 48 | 49 | # Project the map 50 | afr <- st_transform(afr, 3395) 51 | 52 | # Construct continuous area cartogram 53 | afr_cont <- cartogram_cont(afr, "pop_est", itermax = 5) 54 | 55 | # Plot the cartogram 56 | tm_shape(afr_cont) + 57 | tm_polygons("pop_est", 58 | fill.scale = tm_scale_intervals(style = "jenks")) + 59 | tm_layout(frame = FALSE, 60 | legend.position = c("left", "bottom")) 61 | ``` 62 | 63 | ![](man/figures/README-cont-1.png) 64 | 65 | ### Non-contiguous Area Cartogram 66 | 67 | ``` r 68 | library(cartogram) 69 | library(sf) 70 | library(tmap) 71 | 72 | data("World") 73 | 74 | # Keep only the African continent 75 | afr <- World[World$continent == "Africa", ] 76 | 77 | # Project the map 78 | afr <- st_transform(afr, 3395) 79 | 80 | # Plot the original map boundaries 81 | tm_shape(afr) + 82 | tm_borders() + 83 | # Add the the cartogram 84 | tm_shape(cartogram_ncont(afr, "pop_est")) + 85 | tm_polygons("pop_est", 86 | fill.scale = tm_scale_intervals(style = "jenks")) + 87 | tm_layout(frame = FALSE, 88 | legend.position = c("left", "bottom")) 89 | ``` 90 | 91 | ![](man/figures/README-ncont-1.png) 92 | 93 | ### Non-Overlapping Circles Cartogram 94 | 95 | ``` r 96 | library(cartogram) 97 | library(sf) 98 | library(tmap) 99 | 100 | data("World") 101 | 102 | # Keep only the African continent 103 | afr <- World[World$continent == "Africa", ] 104 | 105 | # Project the map 106 | afr <- st_transform(afr, 3395) 107 | 108 | # Plot the original map boundaries 109 | tm_shape(afr) + 110 | tm_borders() + 111 | # Add the the cartogram 112 | tm_shape(cartogram_dorling(afr, "pop_est")) + 113 | tm_polygons("pop_est", 114 | fill.scale = tm_scale_intervals(style = "jenks")) + 115 | tm_layout(frame = FALSE, 116 | legend.position = c("left", "bottom")) 117 | ``` 118 | 119 | ![](man/figures/README-dorling-1.png) 120 | 121 | ## Use multiple CPU cores 122 | 123 | ``` r 124 | library(cartogram) 125 | library(sf) 126 | library(tmap) 127 | library(future) 128 | library(future.apply) 129 | library(parallelly) 130 | library(progressr) 131 | 132 | data("World") 133 | 134 | # Keep only the African continent 135 | afr <- World[World$continent == "Africa", ] 136 | 137 | # Project the map 138 | afr <- st_transform(afr, 3395) 139 | 140 | # Create cartogram using 2 CPU cores on the local machine 141 | # This can speed up computation for larger datasets. 142 | # Set show_progress to TRUE for a progress indicator. 143 | afr_cont <- cartogram_cont(afr, weight = "pop_est", 144 | itermax = 5, 145 | n_cpu = 2, 146 | show_progress = FALSE) 147 | 148 | # Plot the cartogram 149 | tm_shape(afr_cont) + 150 | tm_polygons("pop_est", 151 | fill.scale = tm_scale_intervals(style = "jenks")) + 152 | tm_layout(frame = FALSE, 153 | legend.position = c("left", "bottom")) 154 | ``` 155 | 156 | ![](man/figures/README-parallel-1.png) 157 | 158 | ## Acknowledgements 159 | 160 | The non-contiguous area cartogram and non-overlapping circles cartogram 161 | functionalities include major code contributions from 162 | [@rCarto](https://github.com/rCarto) and 163 | [@neocarto](https://github.com/neocarto). 164 | 165 | [@nowosad](https://github.com/nowosad) contributed to the package by 166 | transitioning it to use the `sf` package and by enhancing the 167 | documentation, a task further supported by documentation improvements 168 | from [@oliveroy](https://github.com/oliveroy). 169 | 170 | The functionality to utilize multiple CPU cores was contributed by 171 | [@e-kotov](https://github.com/e-kotov). 172 | 173 | ## References 174 | 175 | This package implements algorithms based on the following seminal works: 176 | 177 | - Dorling, D. (1996). Area Cartograms: Their Use and Creation. In 178 | Concepts and Techniques in Modern Geography (CATMOG), 59. 179 | - Dougenik, J. A., Chrisman, N. R., & Niemeyer, D. R. (1985). An 180 | Algorithm To Construct Continuous Area Cartograms. In The Professional 181 | Geographer, 37(1), 75-81. 182 | - Olson, J. M. (1976), Noncontiguous Area Cartograms. The Professional 183 | Geographer, 28: 371–380. 184 | [doi:10.1111/j.0033-0124.1976.00371.x](https://doi.org/10.1111/j.0033-0124.1976.00371.x) 185 | -------------------------------------------------------------------------------- /man/cartogram_cont.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cartogram_cont.R 3 | \name{cartogram_cont} 4 | \alias{cartogram_cont} 5 | \alias{cartogram_cont.SpatialPolygonsDataFrame} 6 | \alias{cartogram_cont.sf} 7 | \title{Calculate Contiguous Cartogram Boundaries} 8 | \usage{ 9 | cartogram_cont( 10 | x, 11 | weight, 12 | itermax = 15, 13 | maxSizeError = 1.0001, 14 | prepare = "adjust", 15 | threshold = "auto", 16 | verbose = FALSE, 17 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 18 | show_progress = getOption("cartogram.show_progress", TRUE) 19 | ) 20 | 21 | \method{cartogram_cont}{SpatialPolygonsDataFrame}( 22 | x, 23 | weight, 24 | itermax = 15, 25 | maxSizeError = 1.0001, 26 | prepare = "adjust", 27 | threshold = "auto", 28 | verbose = FALSE, 29 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 30 | show_progress = getOption("cartogram.show_progress", TRUE) 31 | ) 32 | 33 | \method{cartogram_cont}{sf}( 34 | x, 35 | weight, 36 | itermax = 15, 37 | maxSizeError = 1.0001, 38 | prepare = "adjust", 39 | threshold = "auto", 40 | verbose = FALSE, 41 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 42 | show_progress = getOption("cartogram.show_progress", TRUE) 43 | ) 44 | } 45 | \arguments{ 46 | \item{x}{a polygon or multiplogyon sf object} 47 | 48 | \item{weight}{Name of the weighting variable in x} 49 | 50 | \item{itermax}{Maximum iterations for the cartogram transformation, if maxSizeError ist not reached} 51 | 52 | \item{maxSizeError}{Stop if meanSizeError is smaller than maxSizeError} 53 | 54 | \item{prepare}{Weighting values are adjusted to reach convergence much earlier. Possible methods are: 55 | \itemize{ 56 | \item "adjust", adjust values to restrict the mass vector to the quantiles defined by threshold and 1-threshold (default), 57 | \item "remove", remove features with values lower than quantile at threshold, 58 | \item "none", don't adjust weighting values 59 | }} 60 | 61 | \item{threshold}{"auto" or a threshold value between 0 and 1. With “auto”, the value is 0.05 or, if the proportion of zeros in the weight is greater than 0.05, the value is adjusted accordingly.} 62 | 63 | \item{verbose}{print meanSizeError on each iteration} 64 | 65 | \item{n_cpu}{Number of cores to use. Defaults to "respect_future_plan". Available options are: 66 | \itemize{ 67 | \item "respect_future_plan" - By default, the function will run on a single core, unless the user specifies the number of cores using \code{\link[future]{plan}} (e.g. \code{future::plan(future::multisession, workers = 4)}) before running the \code{cartogram_cont} function. 68 | \item "auto" - Use all except available cores (identified with \code{\link[parallelly]{availableCores}}) except 1, to keep the system responsive. 69 | \item a \code{numeric} value - Use the specified number of cores. In this case \code{cartogram_cont} will use set the specified number of cores internally with \code{future::plan(future::multisession, workers = n_cpu)} and revert that back by switching the plan back to whichever plan might have been set before by the user. If only 1 core is set, the function will not require \code{future} and \code{future.apply} and will run on a single core. 70 | }} 71 | 72 | \item{show_progress}{A \code{logical} value. If TRUE, show progress bar. Defaults to TRUE.} 73 | } 74 | \value{ 75 | An object of the same class as x 76 | } 77 | \description{ 78 | Construct a continuous area cartogram by a rubber sheet distortion algorithm (Dougenik et al. 1985) 79 | } 80 | \examples{ 81 | # ========= Basic example ========= 82 | library(sf) 83 | library(cartogram) 84 | 85 | nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 86 | 87 | # transform to NAD83 / UTM zone 16N 88 | nc_utm <- st_transform(nc, 26916) 89 | 90 | # Create cartogram 91 | nc_utm_carto <- cartogram_cont(nc_utm, weight = "BIR74", itermax = 5) 92 | 93 | # Plot 94 | par(mfrow=c(2,1)) 95 | plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 96 | plot(nc_utm_carto[,"BIR74"], main="distorted", key.pos = NULL, reset = FALSE) 97 | 98 | 99 | # ========= Advanced example 1 ========= 100 | # Faster cartogram using multiple CPU cores 101 | # using n_cpu parameter 102 | library(sf) 103 | library(cartogram) 104 | 105 | nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 106 | 107 | # transform to NAD83 / UTM zone 16N 108 | nc_utm <- st_transform(nc, 26916) 109 | 110 | # Create cartogram using 2 CPU cores on local machine 111 | nc_utm_carto <- cartogram_cont(nc_utm, weight = "BIR74", itermax = 5, 112 | n_cpu = 2) 113 | 114 | # Plot 115 | par(mfrow=c(2,1)) 116 | plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 117 | plot(nc_utm_carto[,"BIR74"], main="distorted", key.pos = NULL, reset = FALSE) 118 | 119 | 120 | # ========= Advanced example 2 ========= 121 | # Faster cartogram using multiple CPU cores 122 | # using future package plan 123 | \donttest{ 124 | library(sf) 125 | library(cartogram) 126 | library(future) 127 | 128 | nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 129 | 130 | # transform to NAD83 / UTM zone 16N 131 | nc_utm <- st_transform(nc, 26916) 132 | 133 | # Set the future plan with 2 CPU local cores 134 | # You can of course use any other plans, not just multisession 135 | future::plan(future::multisession, workers = 2) 136 | 137 | # Create cartogram with multiple CPU cores 138 | # The cartogram_cont() will respect the plan set above 139 | nc_utm_carto <- cartogram_cont(nc_utm, weight = "BIR74", itermax = 5) 140 | 141 | # Shutdown the R processes that were created by the future plan 142 | future::plan(future::sequential) 143 | 144 | # Plot 145 | par(mfrow=c(2,1)) 146 | plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 147 | plot(nc_utm_carto[,"BIR74"], main="distorted", key.pos = NULL, reset = FALSE) 148 | } 149 | 150 | } 151 | \references{ 152 | Dougenik, J. A., Chrisman, N. R., & Niemeyer, D. R. (1985). An Algorithm To Construct Continuous Area Cartograms. In The Professional Geographer, 37(1), 75-81. 153 | } 154 | -------------------------------------------------------------------------------- /R/cartogram_ncont.R: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2016 Sebastian Jeworutzki 2 | # Copyright (C) of 'nc_cartogram' Timothee Giraud and Nicolas Lambert 3 | # 4 | # This program is free software; you can redistribute it and/or modify it 5 | # under the terms of the GNU General Public License as published by the 6 | # Free Software Foundation; either version 3 of the License, or (at your 7 | # option) any later version. 8 | # 9 | # This program is distributed in the hope that it will be useful, but WITHOUT 10 | # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 11 | # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 12 | # more details. 13 | # 14 | # You should have received a copy of the GNU General Public License along 15 | # with this program. If not, see . 16 | 17 | 18 | #' @title Calculate Non-Contiguous Cartogram Boundaries 19 | #' @description Construct a non-contiguous area cartogram (Olson 1976). 20 | #' 21 | #' @name cartogram_ncont 22 | #' @param x a polygon or multiplogyon sf object 23 | #' @param weight Name of the weighting variable in x 24 | #' @param k Factor expansion for the unit with the greater value 25 | #' @param inplace If TRUE, each polygon is modified in its original place, 26 | #' if FALSE multi-polygons are centered on their initial centroid 27 | #' @param n_cpu Number of cores to use. Defaults to "respect_future_plan". Available options are: 28 | #' * "respect_future_plan" - By default, the function will run on a single core, unless the user specifies the number of cores using \code{\link[future]{plan}} (e.g. `future::plan(future::multisession, workers = 4)`) before running the `cartogram_ncont` function. 29 | #' * "auto" - Use all except available cores (identified with \code{\link[parallelly]{availableCores}}) except 1, to keep the system responsive. 30 | #' * a `numeric` value - Use the specified number of cores. In this case `cartogram_ncont` will use set the specified number of cores internally with `future::plan(future::multisession, workers = n_cpu)` and revert that back by switching the plan back to whichever plan might have been set before by the user. If only 1 core is set, the function will not require `future` and `future.apply` and will run on a single core. 31 | #' @param show_progress A `logical` value. If TRUE, show progress bar. Defaults to TRUE. 32 | #' @return An object of the same class as x with resized polygon boundaries 33 | #' @export 34 | #' @importFrom methods is slot as 35 | #' @examples 36 | #'# ========= Basic example ========= 37 | #'library(sf) 38 | #'library(cartogram) 39 | #' 40 | # Load North Carolina SIDS data 41 | #'nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 42 | #' 43 | #'# transform to NAD83 / UTM zone 16N 44 | #'nc_utm <- st_transform(nc, 26916) 45 | #' 46 | #'# Create cartogram 47 | #'nc_utm_carto <- cartogram_ncont(nc_utm, weight = "BIR74") 48 | #' 49 | #'# Plot 50 | #'par(mfrow=c(2,1)) 51 | #'plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 52 | #'plot(st_geometry(nc_utm), main="distorted", reset = FALSE) 53 | #'plot(nc_utm_carto[,"BIR74"], add =TRUE) 54 | #' 55 | #' 56 | #'# ========= Advanced example 1 ========= 57 | #'# Faster cartogram using multiple CPU cores 58 | #'# using n_cpu parameter 59 | #'library(sf) 60 | #'library(cartogram) 61 | #' 62 | # Load North Carolina SIDS data 63 | #'nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 64 | #' 65 | #'# transform to NAD83 / UTM zone 16N 66 | #'nc_utm <- st_transform(nc, 26916) 67 | #' 68 | #'# Create cartogram using 2 CPU cores on local machine 69 | #'nc_utm_carto <- cartogram_ncont(nc_utm, weight = "BIR74", n_cpu = 2) 70 | #' 71 | #'# Plot 72 | #'par(mfrow=c(2,1)) 73 | #'plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 74 | #'plot(st_geometry(nc_utm), main="distorted", reset = FALSE) 75 | #'plot(nc_utm_carto[,"BIR74"], add =TRUE) 76 | #' 77 | #' 78 | #'# ========= Advanced example 2 ========= 79 | #'# Faster cartogram using multiple CPU cores 80 | #'# using future package plan 81 | #'library(sf) 82 | #'library(cartogram) 83 | #'library(future) 84 | #' 85 | # Load North Carolina SIDS data 86 | #'nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 87 | #' 88 | #'# transform to NAD83 / UTM zone 16N 89 | #'nc_utm <- st_transform(nc, 26916) 90 | # 91 | #'# Set the future plan with 2 CPU local cores 92 | #'# You can of course use any other plans, not just multisession 93 | #'future::plan(future::multisession, workers = 2) 94 | #' 95 | #'# Create cartogram with multiple CPU cores 96 | #'# The cartogram_cont() will respect the plan set above 97 | #'nc_utm_carto <- cartogram_ncont(nc_utm, weight = "BIR74") 98 | #' 99 | #'# Shutdown the R processes that were created by the future plan 100 | #'future::plan(future::sequential) 101 | #' 102 | #'# Plot 103 | #'par(mfrow=c(2,1)) 104 | #'plot(nc[,"BIR74"], main = "original", key.pos = NULL, reset = FALSE) 105 | #'plot(st_geometry(nc_utm), main = "distorted", reset = FALSE) 106 | #'plot(nc_utm_carto[,"BIR74"], add = TRUE) 107 | #' 108 | #' 109 | #' @references Olson, J. M. (1976). Noncontiguous Area Cartograms. In The Professional Geographer, 28(4), 371-380. 110 | cartogram_ncont <- function( 111 | x, 112 | weight, 113 | k = 1, 114 | inplace = TRUE, 115 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 116 | show_progress = getOption("cartogram.show_progress", TRUE) 117 | ) { 118 | UseMethod("cartogram_ncont") 119 | } 120 | 121 | #' @title Calculate Non-Contiguous Cartogram Boundaries 122 | #' @description This function has been renamed: Please use cartogram_ncont() instead of nc_cartogram(). 123 | #' 124 | #' @export 125 | #' @param shp SpatialPolygonDataFrame or an sf object 126 | #' @inheritDotParams cartogram_ncont -x 127 | #' @keywords internal 128 | nc_cartogram <- function(shp, ...) { 129 | message("\nPlease use cartogram_ncont() instead of nc_cartogram().\n", call. = FALSE) 130 | cartogram_ncont(x = shp, ...) 131 | } 132 | 133 | #' @rdname cartogram_ncont 134 | #' @importFrom sf st_as_sf 135 | #' @export 136 | cartogram_ncont.SpatialPolygonsDataFrame <- function( 137 | x, 138 | weight, 139 | k = 1, 140 | inplace = TRUE, 141 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 142 | show_progress = getOption("cartogram.show_progress", TRUE) 143 | ) { 144 | as(cartogram_ncont.sf(sf::st_as_sf(x), weight, k = k, inplace = inplace, n_cpu = n_cpu, show_progress = show_progress), 'Spatial') 145 | } 146 | 147 | 148 | #' @rdname cartogram_ncont 149 | #' @importFrom sf st_geometry st_area st_buffer st_is_longlat 150 | #' @export 151 | cartogram_ncont.sf <- function( 152 | x, 153 | weight, 154 | k = 1, 155 | inplace = TRUE, 156 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 157 | show_progress = getOption("cartogram.show_progress", TRUE) 158 | ) { 159 | 160 | if (isTRUE(sf::st_is_longlat(x))) { 161 | 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. = FALSE) 162 | } 163 | 164 | if (length(n_cpu) > 1) { 165 | stop('Invalid value for `n_cpu`. Use "respect_future_plan", "auto", or a numeric value.', call. = FALSE) 166 | } 167 | 168 | if (is.numeric(n_cpu) && n_cpu == 1) { 169 | multithreadded <- FALSE 170 | } else if (is.numeric(n_cpu) && n_cpu > 1) { 171 | cartogram_assert_package(c("future", "future.apply")) 172 | with(future::plan(future::multisession, workers = n_cpu), local = TRUE) 173 | multithreadded <- TRUE 174 | } else if (n_cpu == "auto") { 175 | cartogram_assert_package("parallelly") 176 | n_cpu <- max(parallelly::availableCores() - 1, 1) 177 | if (n_cpu == 1) { 178 | multithreadded <- FALSE 179 | } else if (n_cpu > 1) { 180 | cartogram_assert_package(c("future", "future.apply")) 181 | with(future::plan(future::multisession, workers = n_cpu), local = TRUE) 182 | multithreadded <- TRUE 183 | } 184 | } else if (n_cpu == "respect_future_plan") { 185 | if (rlang::is_installed("future")) { 186 | if (is(future::plan(), "sequential")) { 187 | multithreadded <- FALSE 188 | } else { 189 | multithreadded <- TRUE 190 | } 191 | } else { 192 | # if future is not installed, there is definetly no multithreading plan active, so just fallback to single core code 193 | multithreadded <- FALSE 194 | } 195 | } else if (n_cpu != "respect_future_plan") { 196 | stop('Invalid value for `n_cpu`. Use "respect_future_plan", "auto", or a numeric value.', call. = FALSE) 197 | } 198 | 199 | var <- weight 200 | spdf <- x[!is.na(x[, var, drop = TRUE]), ] 201 | 202 | # size 203 | surf <- as.numeric(sf::st_area(spdf, by_element = TRUE)) 204 | v <- spdf[, var, drop = TRUE] 205 | mv <- max(v) 206 | ms <- surf[v == mv] 207 | wArea <- k * v * (ms / mv) 208 | spdf$r <- as.numeric(sqrt(wArea / surf)) 209 | spdf$r[spdf$r == 0] <- 0.001 # don't shrink polygons to zero area 210 | crs <- st_crs(spdf) # save crs 211 | 212 | if (multithreadded == TRUE) { 213 | cartogram_assert_package("future.apply") 214 | # handle show_progress 215 | if (show_progress && interactive()) { 216 | cartogram_assert_package("progressr") 217 | old_handlers <- progressr::handlers("progress") 218 | on.exit(progressr::handlers(old_handlers), add = TRUE) 219 | global_handlers_status <- progressr::handlers(global = NA) 220 | progressr::handlers(global = TRUE) 221 | on.exit(progressr::handlers(global = global_handlers_status), add = FALSE) 222 | p <- progressr::progressor(along = seq_len(nrow(spdf))) 223 | } else { 224 | p <- function(...) NULL # don't show progress 225 | } 226 | 227 | spdf_geometry_list <- future.apply::future_lapply( 228 | X = seq_len(nrow(spdf)), 229 | FUN = function(i) { 230 | if (interactive() && show_progress) { 231 | p(sprintf("Processing polygon %d", i)) 232 | } 233 | rescalePoly.sf( 234 | spdf[i, ], 235 | r = spdf$r[i], 236 | inplace = inplace 237 | ) 238 | }, 239 | future.seed = TRUE 240 | ) 241 | } else if (multithreadded == FALSE) { 242 | if (interactive() && show_progress) { 243 | pb <- utils::txtProgressBar(min = 0, max = nrow(spdf), style = 3) 244 | } 245 | spdf_geometry_list <- lapply( 246 | X = seq_len(nrow(spdf)), 247 | FUN = function(i) { 248 | if (interactive() && show_progress) { 249 | utils::setTxtProgressBar(pb, i) 250 | } 251 | rescalePoly.sf( 252 | spdf[i, ], 253 | r = spdf$r[i], 254 | inplace = inplace 255 | ) 256 | } 257 | ) 258 | 259 | if (interactive() && show_progress) { 260 | close(pb) 261 | } 262 | } 263 | spdf$geometry <- do.call(c, spdf_geometry_list) 264 | st_crs(spdf) <- crs # restore crs 265 | spdf$r <- NULL 266 | sf::st_buffer(spdf, 0) 267 | } 268 | 269 | #' @importFrom sf st_geometry st_centroid st_cast st_union 270 | #' @keywords internal 271 | rescalePoly.sf <- function(p, r = 1, inplace = TRUE) { 272 | 273 | co <- sf::st_geometry(p) 274 | 275 | if (inplace) { 276 | cntr <- sf::st_centroid(co) 277 | ps <- (co - cntr) * r + cntr 278 | } else { 279 | cop <- sf::st_cast(co, "POLYGON") 280 | cntrd <- sf::st_centroid(cop) 281 | ps <- sf::st_union((cop - cntrd) * r + cntrd) 282 | } 283 | 284 | return(ps) 285 | } 286 | -------------------------------------------------------------------------------- /R/cartogram_cont.R: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2016 Sebastian Jeworutzki 2 | # Copyright (C) of 'checkPolygonsGEOS' from package maptools Roger Bivand and Edzer Pebesma 3 | 4 | # This program is free software; you can redistribute it and/or modify it 5 | # under the terms of the GNU General Public License as published by the 6 | # Free Software Foundation; either version 3 of the License, or (at your 7 | # option) any later version. 8 | # 9 | # This program is distributed in the hope that it will be useful, but WITHOUT 10 | # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 11 | # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 12 | # more details. 13 | # 14 | # You should have received a copy of the GNU General Public License along 15 | # with this program. If not, see . 16 | 17 | #' @title Calculate Contiguous Cartogram Boundaries 18 | #' @description Construct a continuous area cartogram by a rubber sheet distortion algorithm (Dougenik et al. 1985) 19 | #' 20 | #' @name cartogram_cont 21 | #' @param x a polygon or multiplogyon sf object 22 | #' @param weight Name of the weighting variable in x 23 | #' @param itermax Maximum iterations for the cartogram transformation, if maxSizeError ist not reached 24 | #' @param maxSizeError Stop if meanSizeError is smaller than maxSizeError 25 | #' @param prepare Weighting values are adjusted to reach convergence much earlier. Possible methods are: 26 | #' * "adjust", adjust values to restrict the mass vector to the quantiles defined by threshold and 1-threshold (default), 27 | #' * "remove", remove features with values lower than quantile at threshold, 28 | #' * "none", don't adjust weighting values 29 | #' @param threshold "auto" or a threshold value between 0 and 1. With “auto”, the value is 0.05 or, if the proportion of zeros in the weight is greater than 0.05, the value is adjusted accordingly. 30 | #' @param verbose print meanSizeError on each iteration 31 | #' @param n_cpu Number of cores to use. Defaults to "respect_future_plan". Available options are: 32 | #' * "respect_future_plan" - By default, the function will run on a single core, unless the user specifies the number of cores using \code{\link[future]{plan}} (e.g. `future::plan(future::multisession, workers = 4)`) before running the `cartogram_cont` function. 33 | #' * "auto" - Use all except available cores (identified with \code{\link[parallelly]{availableCores}}) except 1, to keep the system responsive. 34 | #' * a `numeric` value - Use the specified number of cores. In this case `cartogram_cont` will use set the specified number of cores internally with `future::plan(future::multisession, workers = n_cpu)` and revert that back by switching the plan back to whichever plan might have been set before by the user. If only 1 core is set, the function will not require `future` and `future.apply` and will run on a single core. 35 | #' @param show_progress A `logical` value. If TRUE, show progress bar. Defaults to TRUE. 36 | #' @return An object of the same class as x 37 | #' @export 38 | #' @importFrom methods is slot 39 | #' @importFrom stats quantile 40 | #' @importFrom sf st_area st_as_sf st_centroid st_coordinates st_distance st_geometry st_geometry<- st_point st_crs st_crs<- 41 | #' @examples 42 | #'# ========= Basic example ========= 43 | #'library(sf) 44 | #'library(cartogram) 45 | #' 46 | # Load North Carolina SIDS data 47 | #'nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 48 | #' 49 | #'# transform to NAD83 / UTM zone 16N 50 | #'nc_utm <- st_transform(nc, 26916) 51 | #' 52 | #'# Create cartogram 53 | #'nc_utm_carto <- cartogram_cont(nc_utm, weight = "BIR74", itermax = 5) 54 | #' 55 | #'# Plot 56 | #'par(mfrow=c(2,1)) 57 | #'plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 58 | #'plot(nc_utm_carto[,"BIR74"], main="distorted", key.pos = NULL, reset = FALSE) 59 | #' 60 | #' 61 | #'# ========= Advanced example 1 ========= 62 | #'# Faster cartogram using multiple CPU cores 63 | #'# using n_cpu parameter 64 | #'library(sf) 65 | #'library(cartogram) 66 | #' 67 | # Load North Carolina SIDS data 68 | #'nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 69 | #' 70 | #'# transform to NAD83 / UTM zone 16N 71 | #'nc_utm <- st_transform(nc, 26916) 72 | #' 73 | #'# Create cartogram using 2 CPU cores on local machine 74 | #'nc_utm_carto <- cartogram_cont(nc_utm, weight = "BIR74", itermax = 5, 75 | #' n_cpu = 2) 76 | #' 77 | #'# Plot 78 | #'par(mfrow=c(2,1)) 79 | #'plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 80 | #'plot(nc_utm_carto[,"BIR74"], main="distorted", key.pos = NULL, reset = FALSE) 81 | #' 82 | #' 83 | #'# ========= Advanced example 2 ========= 84 | #'# Faster cartogram using multiple CPU cores 85 | #'# using future package plan 86 | #'\donttest{ 87 | #'library(sf) 88 | #'library(cartogram) 89 | #'library(future) 90 | #' 91 | # Load North Carolina SIDS data 92 | #'nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 93 | #' 94 | #'# transform to NAD83 / UTM zone 16N 95 | #'nc_utm <- st_transform(nc, 26916) 96 | #' 97 | #'# Set the future plan with 2 CPU local cores 98 | #'# You can of course use any other plans, not just multisession 99 | #'future::plan(future::multisession, workers = 2) 100 | #' 101 | #'# Create cartogram with multiple CPU cores 102 | #'# The cartogram_cont() will respect the plan set above 103 | #'nc_utm_carto <- cartogram_cont(nc_utm, weight = "BIR74", itermax = 5) 104 | #' 105 | #'# Shutdown the R processes that were created by the future plan 106 | #'future::plan(future::sequential) 107 | #' 108 | #'# Plot 109 | #'par(mfrow=c(2,1)) 110 | #'plot(nc[,"BIR74"], main="original", key.pos = NULL, reset = FALSE) 111 | #'plot(nc_utm_carto[,"BIR74"], main="distorted", key.pos = NULL, reset = FALSE) 112 | #'} 113 | #' 114 | #' @references Dougenik, J. A., Chrisman, N. R., & Niemeyer, D. R. (1985). An Algorithm To Construct Continuous Area Cartograms. In The Professional Geographer, 37(1), 75-81. 115 | cartogram_cont <- function(x, weight, itermax = 15, maxSizeError = 1.0001, 116 | prepare = "adjust", threshold = "auto", verbose = FALSE, 117 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 118 | show_progress = getOption("cartogram.show_progress", TRUE)) { 119 | UseMethod("cartogram_cont") 120 | } 121 | 122 | #' @title Calculate Contiguous Cartogram Boundaries 123 | #' @description This function has been renamed: Please use cartogram_cont() instead of cartogram(). 124 | #' 125 | #' @export 126 | #' @param shp SpatialPolygonDataFrame or an sf object 127 | #' @inheritDotParams cartogram_cont -x 128 | #' @keywords internal 129 | cartogram <- function(shp, ...) { 130 | message("\nPlease use cartogram_cont() instead of cartogram().\n") 131 | cartogram_cont(x = shp, ...) 132 | } 133 | 134 | #' @rdname cartogram_cont 135 | #' @importFrom sf st_as_sf 136 | #' @export 137 | cartogram_cont.SpatialPolygonsDataFrame <- function(x, weight, itermax = 15, maxSizeError = 1.0001, 138 | prepare = "adjust", threshold = "auto", verbose = FALSE, 139 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 140 | show_progress = getOption("cartogram.show_progress", TRUE)) { 141 | as(cartogram_cont.sf(sf::st_as_sf(x), weight, itermax = itermax, maxSizeError = maxSizeError, 142 | prepare = prepare, threshold = threshold, verbose = verbose, n_cpu = n_cpu, show_progress = show_progress), 'Spatial') 143 | 144 | } 145 | 146 | #' @rdname cartogram_cont 147 | #' @importFrom sf st_area st_geometry st_geometry_type st_centroid st_crs st_coordinates st_buffer st_is_longlat 148 | #' @export 149 | cartogram_cont.sf <- function(x, weight, itermax = 15, maxSizeError = 1.0001, 150 | prepare = "adjust", threshold = "auto", verbose = FALSE, 151 | n_cpu = getOption("cartogram_n_cpu", "respect_future_plan"), 152 | show_progress = getOption("cartogram.show_progress", TRUE)) { 153 | 154 | if (isTRUE(sf::st_is_longlat(x))) { 155 | 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. = FALSE) 156 | } 157 | 158 | # Check n_cpu parameter and set up parallel processing 159 | if (length(n_cpu) > 1) { 160 | stop('Invalid value for `n_cpu`. Use "respect_future_plan", "auto", or a numeric value.', call. = FALSE) 161 | } 162 | 163 | # Check if weight variable exists 164 | if (!(weight %in% names(x))) { 165 | stop('There is no variable "', weight, '" in object "', deparse(substitute(x)), '".', call. = FALSE) 166 | } 167 | 168 | # Determine if we should use multithreading 169 | if (is.numeric(n_cpu) && n_cpu == 1) { 170 | multithreadded <- FALSE 171 | } else if (is.numeric(n_cpu) && n_cpu > 1) { 172 | cartogram_assert_package(c("future", "future.apply")) 173 | with(future::plan(future::multisession, workers = n_cpu), local = TRUE) 174 | multithreadded <- TRUE 175 | } else if (n_cpu == "auto") { 176 | cartogram_assert_package("parallelly") 177 | n_cpu <- max(parallelly::availableCores() - 1, 1) 178 | if (n_cpu == 1) { 179 | multithreadded <- FALSE 180 | } else if (n_cpu > 1) { 181 | cartogram_assert_package(c("future", "future.apply")) 182 | with(future::plan(future::multisession, workers = n_cpu), local = TRUE) 183 | multithreadded <- TRUE 184 | 185 | if (verbose) { 186 | message("Using ", n_cpu, " cores for parallel processing.\n") 187 | } 188 | } 189 | } else if (n_cpu == "respect_future_plan") { 190 | if (rlang::is_installed("future")) { 191 | if (is(future::plan(), "sequential")) { 192 | multithreadded <- FALSE 193 | } else { 194 | multithreadded <- TRUE 195 | } 196 | } else { 197 | multithreadded <- FALSE 198 | } 199 | } else { 200 | stop('Invalid value for `n_cpu`. Use "respect_future_plan", "auto", or a numeric value.', call. = FALSE) 201 | } 202 | 203 | # prepare data 204 | value <- x[[weight]] 205 | 206 | # Adjust threshold on zero inflated data 207 | # Set the threshold value to the proportion of zeros + number of cases corresponding to 1% of the observations, if larger than default value of 0.05 208 | if (threshold == "auto") { 209 | threshold <- round(max(0.05, (sum(value == 0, na.rm = TRUE) + ceiling(length(value) / 100)) / length(value)), 2) 210 | if (verbose) { 211 | message("\nSetting threshold parameter to ", threshold, ".\n") 212 | } 213 | } 214 | 215 | switch(prepare, 216 | # remove missing and values below threshold 217 | "remove" = { 218 | minValue <- quantile(value, probs = threshold, na.rm = TRUE) 219 | x <- x[value > minValue | !is.na(value), ] 220 | value <- value[value > minValue | !is.na(value)] 221 | }, 222 | # Adjust ratio 223 | "adjust" = { 224 | if (any(is.na(value))) { 225 | warning("NA not allowed in weight vector. Features will be removed from Shape.") 226 | x <- x[!is.na(value), ] 227 | value <- value[!is.na(value)] 228 | } 229 | 230 | # area for polygons and total area 231 | area <- as.numeric(st_area(x)) 232 | areaTotal <- sum(area) 233 | area[area < 0] <- 0 234 | 235 | # sum up total value 236 | valueTotal <- sum(value, na.rm = TRUE) 237 | 238 | # prepare force field calculations 239 | desired <- areaTotal * value / valueTotal 240 | ratio <- desired / area 241 | maxRatio <- quantile(ratio, probs = (1 - threshold)) 242 | minRatio <- quantile(ratio, probs = threshold) 243 | 244 | # adjust values 245 | value[ratio > maxRatio] <- (maxRatio * area[ratio > maxRatio] * valueTotal) / areaTotal 246 | value[ratio < minRatio] <- (minRatio * area[ratio < minRatio] * valueTotal) / areaTotal 247 | }, 248 | "none" = { 249 | }) 250 | 251 | # sum up total value 252 | valueTotal <- sum(value, na.rm = TRUE) 253 | 254 | # set meanSizeError 255 | meanSizeError <- 100 256 | 257 | x.iter <- x 258 | 259 | # setup for single-threaded progress bar 260 | if (show_progress && !multithreadded) { 261 | step <- 0 262 | bar_width <- 40 263 | } 264 | 265 | # setup for multi-threaded progress bar 266 | if (show_progress && multithreadded && interactive()) { 267 | cartogram_assert_package("progressr") 268 | old_handlers <- progressr::handlers("progress") 269 | on.exit(progressr::handlers(old_handlers), add = TRUE) 270 | global_handlers_status <- progressr::handlers(global = NA) 271 | progressr::handlers(global = TRUE) 272 | on.exit(progressr::handlers(global = global_handlers_status), add = FALSE) 273 | p <- progressr::progressor(steps = itermax * nrow(x)) 274 | } else { 275 | p <- function(...) NULL 276 | } 277 | 278 | # iterate until itermax is reached 279 | for (z in 1:itermax) { 280 | # break if mean Sizer Error is less than maxSizeError 281 | if (meanSizeError < maxSizeError) break 282 | 283 | # geometry 284 | x.iter_geom <- sf::st_geometry(x.iter) 285 | 286 | # polygon centroids (centroids for multipart polygons) 287 | centroids_sf <- sf::st_centroid(x.iter_geom) 288 | st_crs(centroids_sf) <- sf::st_crs(NULL) 289 | centroids <- do.call(rbind, centroids_sf) 290 | 291 | # area for polygons and total area 292 | area <- as.numeric(sf::st_area(x.iter)) 293 | areaTotal <- as.numeric(sum(area)) 294 | area[area < 0] <- 0 295 | 296 | # prepare force field calculations 297 | desired <- areaTotal * value / valueTotal 298 | desired[desired == 0] <- 0.01 # set minimum size to prevent inf values size Error 299 | radius <- sqrt(area / pi) 300 | mass <- sqrt(desired / pi) - sqrt(area / pi) 301 | 302 | sizeError <- apply(cbind(area, desired), 1, max) / apply(cbind(area, desired), 1, min) 303 | meanSizeError <- mean(sizeError, na.rm = TRUE) 304 | forceReductionFactor <- 1 / (1 + meanSizeError) 305 | 306 | if (verbose) { 307 | message(paste0("Mean size error for iteration ", z, ": ", round(meanSizeError, 5))) 308 | } 309 | 310 | # Process polygons either in parallel or sequentially 311 | if (multithreadded) { 312 | x.iter_geom <- future.apply::future_lapply( 313 | seq_len(nrow(x.iter)), 314 | function(i) { 315 | if (interactive() && show_progress) { 316 | p(sprintf("[Iter.:%d/%d] Polygon %d", z, itermax, i)) 317 | } 318 | process_polygon(x.iter_geom[[i]], centroids, mass, radius, forceReductionFactor) 319 | }, 320 | future.seed = TRUE 321 | ) 322 | # in case we used the local in-fuction plan instead of externally future plan set by user, shutdown the workers 323 | if (n_cpu != "respect_future_plan") { 324 | future::plan(future::sequential) 325 | } 326 | } else { 327 | x.iter_geom <- lapply( 328 | seq_len(nrow(x.iter)), 329 | function(i) { 330 | if (interactive() && show_progress && !multithreadded) { 331 | step <<- step + 1 332 | # calculate progress 333 | progress <- step / (itermax * nrow(x)) 334 | filled <- floor(progress * bar_width) 335 | empty <- bar_width - filled 336 | bar <- paste0("[Iter.:", z, "/", itermax, "] ", 337 | paste0(rep("=", filled), collapse = ""), 338 | paste0(rep(".", empty), collapse = ""), 339 | sprintf(" %3d%%", floor(progress * 100))) 340 | cat("\r", bar) 341 | utils::flush.console() 342 | } 343 | process_polygon(x.iter_geom[[i]], centroids, mass, radius, forceReductionFactor) 344 | } 345 | ) 346 | } 347 | 348 | sf::st_geometry(x.iter) <- do.call(sf::st_sfc, x.iter_geom) 349 | } 350 | 351 | # Restore CRS 352 | st_crs(x.iter) <- st_crs(x) 353 | 354 | return(sf::st_buffer(x.iter, 0)) 355 | } 356 | 357 | #' @keywords internal 358 | process_polygon <- function(poly_geom, centroids, mass, radius, forceReductionFactor) { 359 | pts <- sf::st_coordinates(poly_geom) 360 | idx <- unique(pts[, colnames(pts) %in% c("L1", "L2", "L3")]) 361 | 362 | for (k in seq_len(nrow(idx))) { 363 | newpts <- pts[pts[, "L1"] == idx[k, "L1"] & pts[, "L2"] == idx[k, "L2"], c("X", "Y")] 364 | 365 | distances <- apply(centroids, 1, function(pt) { 366 | ptm <- matrix(pt, nrow = nrow(newpts), ncol = 2, byrow = TRUE) 367 | sqrt(rowSums((newpts - ptm)^2)) 368 | }) 369 | 370 | for (j in seq_len(nrow(centroids))) { 371 | distance <- distances[, j] 372 | 373 | # calculate force vector 374 | Fij <- mass[j] * radius[j] / distance 375 | Fbij <- mass[j] * (distance / radius[j]) ^ 2 * (4 - 3 * (distance / radius[j])) 376 | Fij[distance <= radius[j]] <- Fbij[distance <= radius[j]] 377 | Fij <- Fij * forceReductionFactor / distance 378 | 379 | # calculate new border coordinates 380 | newpts <- newpts + cbind(X1 = Fij, X2 = Fij) * (newpts - centroids[rep(j, nrow(newpts)), ]) 381 | } 382 | 383 | # save final coordinates from this iteration 384 | if (sf::st_geometry_type(poly_geom) == "POLYGON") { 385 | poly_geom[[idx[k, "L1"]]] <- newpts 386 | } else { 387 | poly_geom[[idx[k, "L2"]]][[idx[k, "L1"]]] <- newpts 388 | } 389 | } 390 | return(poly_geom) 391 | } 392 | --------------------------------------------------------------------------------