├── .Rbuildignore ├── .gitignore ├── .lintr ├── .travis.yml ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── RcppExports.R ├── assign_polygons.R ├── calculate_grid.R ├── geogrid-package.R ├── get_shape_details.R └── read_polygons.R ├── README.Rmd ├── README.md ├── codecov.yml ├── geogrid.Rproj ├── inst └── extdata │ ├── bay_counties.geojson │ ├── london_LA.json │ └── states.json ├── man ├── README_figs │ ├── README-example0-1.png │ ├── README-example0-2.png │ ├── README-example1-1.png │ ├── README-example2-1.png │ ├── README-example4-1.png │ ├── README-example4-2.png │ ├── README-example4-3.png │ ├── README-example5-1.png │ ├── README-example6-1.png │ ├── README-example6a-1.png │ ├── README-example7-1.png │ └── README-example8-1.png ├── assign_polygons.Rd ├── calculate_cell_size.Rd ├── calculate_grid.Rd ├── geogrid-package.Rd ├── get_shape_details.Rd ├── get_shape_details_internal.Rd ├── hungarian_cc.Rd ├── hungariansafe_cc.Rd ├── plot.geogrid.Rd └── read_polygons.Rd ├── src ├── RcppExports.cpp └── minimal-assignment.cpp └── tests ├── testthat.R └── testthat ├── test-general.R └── test-zzz-lintr.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.travis\.yml$ 4 | ^codecov\.yml$ 5 | ^\.lintr 6 | ^README_figs 7 | ^README.Rmd 8 | ^cran-comments\.md$ 9 | \.sublime\- 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .DS_Store 6 | /src/*.o 7 | /src/*.o-* 8 | /src/*.so 9 | /src/*.d 10 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | cache_directory: ".lintr_cache" 2 | linters: with_defaults( 3 | commented_code_linter = NULL, 4 | line_length_linter(120), 5 | NULL 6 | ) 7 | exclusions: 8 | list( 9 | "R/RcppExports.R" 10 | ) 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | 5 | # sudo: false 6 | sudo: required 7 | # cache: packages 8 | 9 | 10 | 11 | dist: trusty 12 | 13 | addons: 14 | postgresql: "9.6" 15 | 16 | before_install: 17 | - sudo add-apt-repository ppa:ubuntugis/ubuntugis-unstable --yes 18 | - sudo apt-get --yes --force-yes update -qq 19 | # install tmap dependencies 20 | - sudo apt-get install --yes libprotobuf-dev protobuf-compiler libv8-3.14-dev 21 | # install tmap dependencies; for 16.04 libjq-dev this ppa is needed: 22 | - sudo add-apt-repository -y ppa:opencpu/jq 23 | - sudo apt-get --yes --force-yes update -qq 24 | - sudo apt-get install libjq-dev 25 | # units/udunits2 dependency: 26 | - sudo apt-get install --yes libudunits2-dev 27 | # sf dependencies: 28 | - sudo apt-get install --yes libproj-dev libgeos-dev libgdal-dev 29 | # postgis source compile dependencies: 30 | - sudo apt-get --yes install libjson-c-dev postgresql-server-dev-9.6 31 | # # install postgis from source: 32 | # - wget http://download.osgeo.org/postgis/source/postgis-2.3.2.tar.gz 33 | # - (mv postgis* /tmp; cd /tmp; tar xzf postgis-2.3.2.tar.gz) 34 | # - (cd /tmp/postgis-2.3.2 ; ./configure; make; sudo make install) 35 | # # create postgis databases: 36 | # - sudo service postgresql restart 37 | # - createdb postgis 38 | # - psql -d postgis -c "CREATE EXTENSION postgis;" 39 | # - psql -d postgis -c "GRANT CREATE ON DATABASE postgis TO travis" 40 | # - createdb empty 41 | # - psql -d empty -c "CREATE EXTENSION postgis;" 42 | 43 | warnings_are_errors: true 44 | 45 | after_success: 46 | # - dropdb postgis 47 | # - createdb postgis 48 | # - psql -d postgis -c "CREATE EXTENSION postgis;" 49 | # - psql -d postgis -c "GRANT CREATE ON DATABASE postgis TO travis" 50 | - Rscript -e 'covr::codecov()' 51 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: geogrid 2 | Title: Turn Geospatial Polygons into Regular or Hexagonal Grids 3 | Version: 0.1.1 4 | Authors@R: c( 5 | person("Joseph", "Bailey", email = "jbailey@futurecities.catapult.org.uk", role = c("aut", "cre")), 6 | person("Ryan", "Hafen", email = "rhafen@gmail.com", role = "ctb"), 7 | person("Jakub", "Nowosad", email = "nowosad.jakub@gmail.com", role = "ctb", comment = c(ORCID = "0000-0002-1057-3721")), 8 | person("Lars Simon Zehnder", role = "ctb", 9 | comment = "RcppArmadillo implmentation of Munkres' Assignment Algorithm" 10 | )) 11 | Description: Turn irregular polygons (such as geographical regions) into regular or hexagonal grids. 12 | This package enables the generation of regular (square) and hexagonal grids through the package 13 | 'sp' and then assigns the content of the existing polygons to the new grid using 14 | the Hungarian algorithm, Kuhn (1955) (). 15 | This prevents the need for manual generation of hexagonal grids or regular grids 16 | that are supposed to reflect existing geography. 17 | Imports: 18 | methods, 19 | sp, 20 | sf, 21 | rgeos, 22 | Rcpp 23 | License: MIT + file LICENSE 24 | Encoding: UTF-8 25 | LazyData: true 26 | LinkingTo: 27 | Rcpp, 28 | RcppArmadillo 29 | Suggests: 30 | testthat, 31 | lintr, 32 | covr 33 | RoxygenNote: 6.1.1 34 | URL: https://github.com/jbaileyh/geogrid 35 | BugReports: https://github.com/jbaileyh/geogrid/issues 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2018 2 | COPYRIGHT HOLDER: Joseph Bailey 3 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(assign_polygons,SpatialPolygonsDataFrame) 4 | S3method(assign_polygons,sf) 5 | S3method(calculate_grid,SpatialPolygonsDataFrame) 6 | S3method(calculate_grid,sf) 7 | S3method(plot,geogrid) 8 | export(assign_polygons) 9 | export(calculate_cell_size) 10 | export(calculate_grid) 11 | export(get_shape_details) 12 | export(read_polygons) 13 | importFrom(Rcpp,sourceCpp) 14 | importFrom(methods,as) 15 | importFrom(rgeos,gCentroid) 16 | importFrom(sf,st_as_sf) 17 | importFrom(sf,st_read) 18 | importFrom(sp,CRS) 19 | importFrom(sp,HexPoints2SpatialPolygons) 20 | importFrom(sp,SpatialPixels) 21 | importFrom(sp,SpatialPolygonsDataFrame) 22 | importFrom(sp,coordinates) 23 | importFrom(sp,merge) 24 | importFrom(sp,plot) 25 | importFrom(sp,spDists) 26 | importFrom(sp,spDistsN1) 27 | importFrom(sp,spsample) 28 | useDynLib(geogrid) 29 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # geogrid 0.1.1 2 | 3 | * **sf** enhancements and README update 4 | 5 | # geogrid 0.1.1 6 | 7 | * Add a support for the **sf** objects 8 | 9 | # geogrid 0.1.0 10 | 11 | * Added a `NEWS.md` file to track changes to the package. 12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #' hungarian_cc 5 | #' @param cost cost matrix 6 | hungarian_cc <- function(cost) { 7 | .Call("_geogrid_hungarian_cc", PACKAGE = "geogrid", cost) 8 | } 9 | 10 | #' hungariansafe_cc 11 | #' @param cost cost matrix 12 | hungariansafe_cc <- function(cost) { 13 | .Call("_geogrid_hungariansafe_cc", PACKAGE = "geogrid", cost) 14 | } 15 | -------------------------------------------------------------------------------- /R/assign_polygons.R: -------------------------------------------------------------------------------- 1 | #' Assign the polygons in the original spatial data to their new location. 2 | #' 3 | #' Assigns each polygon in the original file to a new location in the gridded geometry using the Hungarian algorithm. 4 | #' 5 | #' @param shape A "SpatialPolygonsDataFrame" or an sf object representing the original spatial polygons. 6 | #' @param new_polygons A "geogrid" object returned from \code{\link{calculate_grid}}. 7 | #' @importFrom rgeos gCentroid 8 | #' @importFrom sp SpatialPolygonsDataFrame coordinates spDistsN1 spDists merge 9 | #' @importFrom sf st_as_sf 10 | #' @return An object of the same class as shape 11 | #' @export 12 | #' @examples 13 | #' library(sf) 14 | #' input_file <- system.file("extdata", "london_LA.json", package = "geogrid") 15 | #' original_shapes <- st_read(input_file) %>% st_set_crs(27700) 16 | #' 17 | #' # calculate grid 18 | #' new_cells <- calculate_grid(shape = original_shapes, 19 | #' grid_type = "hexagonal", seed = 1) 20 | #' grid_shapes <- assign_polygons(original_shapes, new_cells) 21 | #' plot(grid_shapes) 22 | #' 23 | #' par(mfrow = c(1, 2)) 24 | #' plot(st_geometry(original_shapes)) 25 | #' plot(st_geometry(grid_shapes)) 26 | #' 27 | #' \dontrun{ 28 | #' # look at different grids using different seeds 29 | #' par(mfrow=c(2, 3), mar = c(0, 0, 2, 0)) 30 | #' for (i in 1:6) { 31 | #' new_cells <- calculate_grid(shape = original_shapes, grid_type = "hexagonal", seed = i) 32 | #' plot(new_cells, main = paste("Seed", i, sep=" ")) 33 | #' } 34 | #' } 35 | assign_polygons <- function(shape, new_polygons){ 36 | UseMethod("assign_polygons") 37 | } 38 | 39 | #' @rdname assign_polygons 40 | #' @export 41 | assign_polygons.SpatialPolygonsDataFrame <- function(shape, new_polygons) { 42 | original_points <- rgeos::gCentroid(shape, byid = TRUE) 43 | shape@data$CENTROIX <- original_points$x 44 | shape@data$CENTROIY <- original_points$y 45 | shape@data$key_orig <- paste(original_points$x, original_points$y, sep = "_") 46 | 47 | if (!inherits(new_polygons, "geogrid")) 48 | stop("'new_polygons' must be an object obtained ", 49 | "from calling calculate_grid().") 50 | 51 | new_points <- new_polygons[[1]] 52 | vector_length <- length(shape) 53 | 54 | new_polygons2 <- new_polygons[[2]] 55 | # polygon_points <- rgeos::gCentroid(new_polygons2, byid = TRUE) 56 | s_poly <- sp::SpatialPolygonsDataFrame( 57 | new_polygons2, as.data.frame(sp::coordinates(new_polygons2))) 58 | s_poly$key_new <- paste(s_poly@data$V1, s_poly@data$V2, sep = "_") 59 | 60 | # Define these vectors, used in the assignment loop. 61 | closest_site_vec <- vector(mode = "numeric", length = vector_length) 62 | min_dist_vec <- vector(mode = "numeric", length = vector_length) 63 | taken_vec <- vector(mode = "numeric", length = vector_length) 64 | taken_vec_index <- integer(vector_length) 65 | 66 | # shape_areas <- rgeos::gArea(shape, byid = TRUE) 67 | 68 | for (i in 1:vector_length) { 69 | dist_vec <- sp::spDistsN1(original_points, new_points[i], longlat = FALSE) 70 | min_dist_vec[i] <- min(dist_vec) 71 | 72 | if (i > 1) { 73 | dist_vec[taken_vec_index] <- NA 74 | closest_site_vec[i] <- which.min(dist_vec) 75 | } else { 76 | closest_site_vec[i] <- which.min(dist_vec) 77 | } 78 | 79 | taken_vec[i] <- which.min(dist_vec) 80 | taken_vec_index <- taken_vec[taken_vec > 0] 81 | 82 | costmatrix <- sp::spDists(original_points, new_points, longlat = FALSE) 83 | colnames(costmatrix) <- paste(s_poly@data$V1, s_poly@data$V2, sep = "_") 84 | rownames(costmatrix) <- paste(original_points@coords[, 1], 85 | original_points@coords[, 2], sep = "_") 86 | hungarian_costmin <- hungarian_cc(costmatrix) 87 | } 88 | 89 | costmin_locs <- as.data.frame(which(hungarian_costmin == 1, arr.ind = TRUE)) 90 | costmin_locs$key_new <- colnames(costmatrix)[costmin_locs$col] 91 | costmin_locs$key_orig <- rownames(costmatrix)[costmin_locs$row] 92 | # val <- strsplit(costmin_locs$key_new, "_") 93 | # costmin_locs$CENTROIDX <- as.numeric(val[[1]][1]) 94 | # costmin_locs$CENTROIDy <- as.numeric(vsl[[1]][1]) 95 | 96 | final_table <- costmin_locs 97 | 98 | combi <- sp::merge(shape@data, final_table, by.x = "key_orig") 99 | combi2 <- sp::merge(s_poly, combi, by.x = "key_new") 100 | return(combi2) 101 | } 102 | 103 | #' @rdname assign_polygons 104 | #' @export 105 | assign_polygons.sf <- function(shape, new_polygons){ 106 | st_as_sf(assign_polygons(as(shape, "Spatial"), new_polygons)) 107 | } 108 | -------------------------------------------------------------------------------- /R/calculate_grid.R: -------------------------------------------------------------------------------- 1 | #' Calculate grid from spatial polygons. 2 | #' 3 | #' Given an input multipolgyon spatial data frame this function calculates a hexagonal or regular grid that strives to preserve the original geography. 4 | #' @param shape A 'SpatialPolygonsDataFrame' or an sf object representing the original spatial polygons. 5 | #' @param learning_rate The rate at which the gradient descent finds the optimum cellsize to ensure that your gridded points fit within the outer boundary of the input polygons. 6 | #' @param grid_type Either 'hexagonal' for a hexagonal grid (default) or 'regular' for a regular grid. 7 | #' @param seed An optional random seed integer to be used for the grid calculation algorithm. 8 | #' @param verbose A logical indicating whether messages should be printed as the algorithm iterates. 9 | #' @importFrom sp spsample HexPoints2SpatialPolygons SpatialPixels 10 | #' @importFrom methods as 11 | #' @importFrom sf st_as_sf 12 | #' @export 13 | #' @examples 14 | #' library(sf) 15 | #' input_file <- system.file('extdata', 'london_LA.json', package = 'geogrid') 16 | #' original_shapes <- st_read(input_file) %>% st_set_crs(27700) 17 | #' 18 | #' # calculate grid 19 | #' new_cells <- calculate_grid(shape = original_shapes, 20 | #' grid_type = 'hexagonal', seed = 1) 21 | #' grid_shapes <- assign_polygons(original_shapes, new_cells) 22 | #' plot(grid_shapes) 23 | #' 24 | #' par(mfrow = c(1, 2)) 25 | #' plot(st_geometry(original_shapes)) 26 | #' plot(st_geometry(grid_shapes)) 27 | #' 28 | #' \dontrun{ 29 | #' # look at different grids using different seeds 30 | #' par(mfrow=c(2, 3), mar = c(0, 0, 2, 0)) 31 | #' for (i in 1:6) { 32 | #' new_cells <- calculate_grid(shape = original_shapes, grid_type = 'hexagonal', seed = i) 33 | #' plot(new_cells, main = paste('Seed', i, sep=' ')) 34 | #' } 35 | #' } 36 | calculate_grid <- function(shape, learning_rate = 0.03, grid_type = c("hexagonal", 37 | "regular"), seed = NULL, verbose = FALSE) { 38 | UseMethod("calculate_grid") 39 | } 40 | 41 | #' @rdname calculate_grid 42 | #' @export 43 | calculate_grid.SpatialPolygonsDataFrame <- function(shape, learning_rate = 0.03, 44 | grid_type = c("hexagonal", "regular"), seed = NULL, verbose = FALSE) { 45 | 46 | if (!is.null(seed)) 47 | set.seed(seed) 48 | # = c('regular', 'hexagonal') check that regular and hexagon dont return 49 | # different lists of points (list and list[[]] respectively?) 50 | 51 | shape_details <- get_shape_details_internal(shape) 52 | 53 | grid_type <- match.arg(grid_type) 54 | 55 | if (!inherits(shape_details, "shape_details")) 56 | stop("'shape_details' must be an object obtained ", "from calling get_shape_details().") 57 | 58 | # Lets find some bounds for the optimisation that make sense. max_allowed_area 59 | # <- shape_details$total_area / shape_details$nhex hexagon_diam <- 60 | # sqrt(max_allowed_area / 2.598076) * 2 61 | 62 | cellsize <- shape_details$start_size 63 | 64 | repeat { 65 | hex_pts <- sp::spsample(shape, type = grid_type, cellsize = cellsize, iter = 10000) 66 | npolygons <- length(hex_pts) 67 | if (verbose) { 68 | message(npolygons) 69 | message(cellsize) 70 | } 71 | 72 | if (npolygons == shape_details$nhex) { 73 | break 74 | } else if (npolygons > shape_details$nhex) { 75 | if (verbose) 76 | message("too many polygons") 77 | cellsize_new <- cellsize * (1 + learning_rate) 78 | cellsize <- cellsize_new 79 | } else { 80 | # else (npolygons < shape_details$nhex) 81 | if (verbose) 82 | message("too few polygons") 83 | cellsize_new <- cellsize * (1 - learning_rate) 84 | cellsize <- cellsize_new 85 | } 86 | } 87 | 88 | if (verbose) 89 | message("The cellsize is ", cellsize) 90 | 91 | if (grid_type == "hexagonal") { 92 | pols <- sp::HexPoints2SpatialPolygons(hex_pts) 93 | } else { 94 | pols <- sp::SpatialPixels(hex_pts) 95 | pols <- methods::as(pols, "SpatialPolygons") 96 | } 97 | # or spatial polygons? need to turn this into same object as hexagons above try 98 | # making dataframe and going that route. need correct ids for match between then 99 | # and now note <- cellsize could be unsolveable. Add rotation of grid if needed. 100 | 101 | res <- list(hex_pts, pols) 102 | class(res) <- c("geogrid", "list") 103 | 104 | return(res) 105 | } 106 | 107 | #' @rdname calculate_grid 108 | #' @export 109 | calculate_grid.sf <- function(shape, learning_rate = 0.03, grid_type = c("hexagonal", 110 | "regular"), seed = NULL, verbose = FALSE) { 111 | calculate_grid(as(shape, "Spatial"), learning_rate = learning_rate, grid_type = grid_type, 112 | seed = seed, verbose = verbose) 113 | } 114 | 115 | #' Calculate size of grid items (deprecated). 116 | #' 117 | #' Given an input multipolgyon spatial data frame this function calculates the required cell size of a regular or hexagonal grid. 118 | #' @param shape A 'SpatialPolygonsDataFrame' object representing the original spatial polygons. 119 | #' @param shape_details deprecated. 120 | #' @param learning_rate The rate at which the gradient descent finds the optimum cellsize to ensure that your gridded points fit within the outer boundary of the input polygons. 121 | #' @param grid_type Either 'hexagonal' for a hexagonal grid (default) or 'regular' for a regular grid. 122 | #' @param seed An optional random seed integer to be used for the grid calculation algorithm. 123 | #' @param verbose A logical indicating whether messages should be printed as the algorithm iterates. 124 | #' @importFrom sp spsample HexPoints2SpatialPolygons SpatialPixels 125 | #' @importFrom methods as 126 | #' @export 127 | calculate_cell_size <- function(shape, shape_details = NULL, learning_rate = 0.03, 128 | grid_type = c("hexagonal", "regular"), seed = NULL, verbose = FALSE) { 129 | 130 | stop("calculate_cell_size() has been deprecated. Please use ", "calculate_grid() instead.", 131 | call. = FALSE) 132 | } 133 | 134 | #' Plot a 'geogrid' object 135 | #' 136 | #' @param x An object of class 'geogrid' to plot. 137 | #' @param y ignored 138 | #' @param ... Additional parameters passed to the 'sp' package's plot method. 139 | #' 140 | #' @importFrom sp plot 141 | #' @method plot geogrid 142 | #' @export 143 | plot.geogrid <- function(x, y, ...) { 144 | sp::plot(x[[2]], ...) 145 | } 146 | -------------------------------------------------------------------------------- /R/geogrid-package.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib geogrid 2 | #' @importFrom Rcpp sourceCpp 3 | #' @keywords internal 4 | "_PACKAGE" -------------------------------------------------------------------------------- /R/get_shape_details.R: -------------------------------------------------------------------------------- 1 | #' Extract details from provided polygons. 2 | #' 3 | #' Extract spatial extent, range and other geospatial features from the output of read_polygons. Items are returned as a list for use in \code{\link{calculate_grid}}. 4 | #' 5 | #' @param input_shape A "SpatialPolygonsDataFrame" object representing the original spatial polygons. 6 | get_shape_details_internal <- function(input_shape) { 7 | 8 | nhex <- length(input_shape) 9 | 10 | if (nhex < 4) 11 | message("Your shape has fewer than 5 polygons. ", 12 | "Please be aware that a geogrid may have limited value.") 13 | 14 | # Start off with guidance but start with bins that are too large 15 | # (cellsize too large) 16 | # shape_summary <- input_shape@bbox 17 | 18 | #xmax <- shape_summary[2][[1]][1, 2] 19 | xmax <- input_shape@bbox[3] 20 | #ymax <- shape_summary[2][[1]][2, 2] 21 | ymax <- input_shape@bbox[4] 22 | #xmin <- shape_summary[2][[1]][1, 1] 23 | xmin <- input_shape@bbox[1] 24 | #ymin <- shape_summary[2][[1]][2, 1] 25 | ymin <- input_shape@bbox[2] 26 | xrange <- (xmax - xmin) 27 | yrange <- (ymax - ymin) 28 | start_width <- ifelse(xrange > yrange, xrange, yrange) 29 | 30 | # Let's assume that the user want's something more than 4 hexagons wide 31 | # or long. If they want something this small then a geogrid is probably 32 | # not worth it. 33 | start_size <- start_width / 100 34 | total_area <- input_shape@polygons[[1]]@Polygons[[1]]@area 35 | 36 | shape_details <- list(nhex = nhex, xmax = xmax, ymax = ymax, 37 | xmin = xmin, ymin = ymin, xrange = xrange, yrange = yrange, 38 | start_size = start_size, total_area = total_area) 39 | class(shape_details) <- c("shape_details", "list") 40 | 41 | return(shape_details) 42 | } 43 | 44 | #' Extract details from provided polygons (deprecated). 45 | #' 46 | #' Extract spatial extent, range and other geospatial features from the output of read_polygons. Items are returned as a list for use in \code{\link{calculate_grid}}. 47 | #' 48 | #' @param input_shape A "SpatialPolygonsDataFrame" object representing the original spatial polygons. 49 | #' @export 50 | get_shape_details <- function(input_shape) { 51 | stop("get_shape_details() has been deprecated. ", 52 | "It is now handled automatically in calculate_grid().", 53 | call. = FALSE) 54 | } 55 | -------------------------------------------------------------------------------- /R/read_polygons.R: -------------------------------------------------------------------------------- 1 | #' Import spatial data. 2 | #' 3 | #' Simple function to read spatial data into a SpatialPolygonsDataFrame. Based on st_read from package sf. 4 | #' @param file A file path pointing to a shapefile or GeoJSON file, or a character string holding GeoJSON data. See the \code{dsn} argument of \code{\link[sf]{st_read}} for more details. 5 | #' @importFrom sf st_read 6 | #' @importFrom sp CRS 7 | #' @export 8 | read_polygons <- function(file) { 9 | .Deprecated("sf::st_read") 10 | 11 | # check resulting file is polgyons 12 | shape <- sf::st_read(file) 13 | shape <- methods::as(shape, "Spatial") 14 | 15 | if (class(shape) != "SpatialPolygonsDataFrame") 16 | stop("Please ensure you are using polygons") 17 | 18 | shape@proj4string <- sp::CRS(as.character(NA)) 19 | 20 | return(shape) 21 | } 22 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Algorithmic tesselation with geogrid" 3 | author: "Joseph Bailey" 4 | date: "`r format(Sys.Date())`" 5 | output: 6 | github_document: 7 | fig_width: 8 8 | fig_height: 8 9 | --- 10 | 11 | 12 | ```{r, echo = FALSE} 13 | knitr::opts_chunk$set(collapse=TRUE, comment="##", fig.retina=2, fig.path = "man/README_figs/README-") 14 | ``` 15 | 16 | [![Travis-CI Build Status](https://travis-ci.org/jbaileyh/geogrid.svg?branch=master)](https://travis-ci.org/jbaileyh/geogrid) 17 | [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/geogrid)](https://cran.r-project.org/package=geogrid) 18 | [![Coverage Status](https://img.shields.io/codecov/c/github/jbaileyh/geogrid/master.svg)](https://codecov.io/github/jbaileyh/geogrid?branch=master) 19 | 20 | # geogrid 21 | 22 | Turn geospatial polygons like states, counties or local authorities into regular or hexagonal grids automatically. 23 | 24 | 25 | 26 | ## Intro 27 | 28 | Using geospatial polygons to portray geographical information can be a challenge when polygons are of different sizes. 29 | For example, it can be difficult to ensure that larger polygons do not skew how readers retain or absorb information. 30 | As a result, many opt to generate maps that use consistent shapes (i.e. regular grids) to ensure that no specific geography is emphasised unfairly. 31 | Generally there are four reasons that one might transform geospatial polygons to a different grid (or geospatial representation): 32 | 33 | 1. We may use cartograms to represent the number of people (or any value) within a particular geography. 34 | For more information and examples see [here](https://www.wired.com/2016/10/electoral-maps-look-little-different-heres/) and [here](http://www.nytimes.com/interactive/2013/04/08/business/global/asia-map.html). 35 | This cartogram approach changes the size of a particular geography in-line with the values that one seeks to visualise. 36 | 2. We may use grids to bin data and typically visualise the spatial density of a particular variable. 37 | For an example see [here](https://bl.ocks.org/mbostock/4330486). 38 | 3. We may use grids to segment a geographical region. 39 | For example tesselation can be used in [biological sampling](https://www.arcgis.com/home/item.html?id=03388990d3274160afe240ac54763e57) or even in generating [game environments](https://www.redblobgames.com/grids/hexagons/). 40 | 4. We may use grids to 'fairly' represent existing geographical entities (such as US states, UK local authorities, or even countries in Europe). 41 | For an example of representing US states as both regular and hexagonal grids see [here](http://blog.apps.npr.org/2015/05/11/hex-tile-maps.html). 42 | 43 | The link in bullet 4 provides an excellent introduction to the notion of tesselation and its challenges. 44 | Interestingly, the eventual generation of hexagonal and regular grids demonstrated in the article was done **manually**. 45 | I believe that this can be very time consuming, and though it may stimulate some fun discussion - wouldn't it be great to do it automatically? 46 | 47 | Recent functionality for representing US states, European countries and World countries in a grid has been made available for ggplot2 [here](https://hafen.github.io/geofacet/) and there are many other great examples of **hand-specified** or **bespoke** grids. 48 | The challenge with this is that if you have a less commonly used geography then it might be hard to find a **hand-specified** or **bespoke** grid for your area of interest. 49 | 50 | What I wanted to do with `geogrid` is make it easier to generate these grids in ways that might be visually appealing and then assign the original geographies to their gridded counterparts in a way that made sense. 51 | Using an input of geospatial polgyons `geogrid` will generate either a regular or hexagonal grid, and then assign each of the polygons in your original file to that new grid. 52 | 53 | ## Idea 54 | 55 | There are two steps to using `geogrid`: 56 | 57 | 1. Generate a regular or hexagonal grid of your choice. 58 | There are lots of different arrangements of these grids so choosing one with the `calculate_grid` function and varying the `seed` is a good place to start. 59 | 2. Use the [**hungarian algorithm**](https://en.wikipedia.org/wiki/Hungarian_algorithm) to efficiently calculate the assignments from the original geography to the new geography. 60 | This involves identifying the solution where the total distance between the centroid of every original geography and its new centroid on the grid is minimised. 61 | For this I have included a previous implementation of the Hungarian algorithm kindly made available [here](https://github.com/RcppCore/rcpp-gallery/blob/gh-pages/src/2013-09-24-minimal-assignment.cpp). 62 | Huge thanks to Lars Simon Zehnder for this implementation. 63 | 64 | ## Example 65 | 66 | This is a basic example which shows how the assignment of London boroughs could work. 67 | 68 | ```{r example, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 69 | library(geogrid) 70 | library(sf) 71 | library(tmap) 72 | 73 | input_file <- system.file("extdata", "london_LA.json", package = "geogrid") 74 | original_shapes <- st_read(input_file) %>% st_set_crs(27700) 75 | original_shapes$SNAME <- substr(original_shapes$NAME, 1, 4) 76 | ``` 77 | 78 | For reference, lets see how London's local authorities are actually bounded in real space. 79 | In this example, I have coloured each polygon based on it's area. 80 | Brighter polygons are larger. 81 | 82 | ```{r example0, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 83 | rawplot <- tm_shape(original_shapes) + 84 | tm_polygons("HECTARES", palette = "viridis") + 85 | tm_text("SNAME") 86 | rawplot 87 | ``` 88 | 89 | So, let's turn this into a grid to stop places like Bromley, Hillingdon and Havering from stealing our attention. 90 | First of all, we can generate a number of different grids using `seed`. 91 | Since there are many ways to dissect the outer boundary of the polygons you might want to choose an output that appeals to you. 92 | I'd recommend looking at different `seed` values and choosing the one that best matches the outline that you approve of. 93 | 94 | The `calculate_grid` function takes in a SpatialPolygonsDataframe or sf object, a learning rate (suggestion = 0.03 to begin), a grid type `hexagonal` or `regular` and a seed value. 95 | Let's have a look at some hexagonal grid options for the London local authorities: 96 | 97 | ```{r example1, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 98 | par(mfrow = c(2, 3), mar = c(0, 0, 2, 0)) 99 | for (i in 1:6) { 100 | new_cells <- calculate_grid(shape = original_shapes, grid_type = "hexagonal", seed = i) 101 | plot(new_cells, main = paste("Seed", i, sep = " ")) 102 | } 103 | ``` 104 | 105 | Let's also look at things with a regular grid: 106 | 107 | ```{r example2, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 108 | par(mfrow = c(2, 3), mar = c(0, 0, 2, 0)) 109 | for (i in 1:6) { 110 | new_cells <- calculate_grid(shape = original_shapes, grid_type = "regular", seed = i) 111 | plot(new_cells, main = paste("Seed", i, sep = " ")) 112 | } 113 | ``` 114 | 115 | As we can see there are lots of options. 116 | Now, lets choose a grid and assign our existing places to it. I happen to like the both grids that have a `seed` of 3. 117 | So I'm going to assign the polygons to those grids. 118 | Let's do that and see what they look like compared to the original. 119 | 120 | ```{r example3, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 121 | new_cells_hex <- calculate_grid(shape = original_shapes, grid_type = "hexagonal", seed = 3) 122 | resulthex <- assign_polygons(original_shapes, new_cells_hex) 123 | 124 | new_cells_reg <- calculate_grid(shape = original_shapes, grid_type = "regular", seed = 3) 125 | resultreg <- assign_polygons(original_shapes, new_cells_reg) 126 | ``` 127 | 128 | Now we have an example transfer from real space to grid space - we can visualise it. 129 | 130 | ```{r example4, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 131 | hexplot <- tm_shape(resulthex) + 132 | tm_polygons("HECTARES", palette = "viridis") + 133 | tm_text("SNAME") 134 | 135 | regplot <- tm_shape(resultreg) + 136 | tm_polygons("HECTARES", palette = "viridis") + 137 | tm_text("SNAME") 138 | 139 | tmap_arrange(rawplot, hexplot, regplot, nrow = 3) 140 | ``` 141 | 142 | ## Details 143 | 144 | The package has two major functions: 145 | 146 | 1. `calculate_grid()` given your input polygons this will generate the grid as specified by your arguments: 147 | - `shape`: the original polygons 148 | - `learning_rate`: the rate at which the gradient descent finds the optimum cellsize to ensure that your gridded points fit within the outer boundary of the input polygons. 149 | - `grid_type`: either `regular` for a square grid or `hexagonal` for a hexagonal grid. 150 | - `seed`: the seed to ensure you get the same grid output. 151 | 2. `assign_polygons()`: this will assign the original polygons to their new locations on the grid generated in `calculate_grid()`. 152 | It will find the solution that minimises the sum of the total distance between the original polygon centroids and eventual gridded centroids. Arguments: 153 | - `shape`: the original polygons 154 | - `new_polygons`: the output (a list) from `calculate_grid()`. 155 | 156 | ## TODO 157 | 158 | - Assignment may not always work - check the `assign_polygons()` why does it only work sometimes? 159 | - Make it work (done I think), make it right (not yet), make it fast (not yet). 160 | - Improve the cellsize calculation methodology. 161 | - Get someone to answer [this stack overflow question](https://math.stackexchange.com/questions/2388000/find-topologically-closest-graph-under-constraints). 162 | 163 | ## Notes 164 | 165 | This is my first attempt at a package. 166 | If it doesn't work I'd like suggestions for improvements and thanks in advance for providing them! 167 | 168 | I welcome critique and feedback. 169 | Blog post to follow. 170 | 171 | ## Thanks 172 | 173 | I read a lot of the work by [Hadley Wickham](http://hadley.nz/), [Jenny Bryan](https://github.com/jennybc), [Thomas Lin Pedersen](https://www.data-imaginist.com/about/), [Mara Averick](https://twitter.com/dataandme?lang=en) and [Bob Rudis](https://github.com/hrbrmstr) to name a few. 174 | But also love the R community and learn a huge amount from [R Bloggers](https://www.r-bloggers.com/). 175 | 176 | Extra thanks go to [Ryan Hafen](http://ryanhafen.com/) for making this package publishable. 177 | 178 | # Other examples 179 | 180 | From others: 181 | 182 | Simon Hailstone has looked at [male life expectancy in the South East region of England](http://rpubs.com/Hailstone/326118) using the package. 183 | Thanks Simon for using! 184 | 185 | From me: 186 | 187 | This time using the contiguous USA. 188 | Again, I used set seed and chose some that I liked but I'd recommend you'd do the same. 189 | 190 | ```{r example5, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 191 | input_file2 <- system.file("extdata", "states.json", package = "geogrid") 192 | original_shapes2 <- st_read(input_file2) %>% st_transform(2163) 193 | original_shapes2$SNAME <- substr(original_shapes2$NAME, 1, 4) 194 | 195 | rawplot2 <- tm_shape(original_shapes2) + 196 | tm_polygons("CENSUSAREA", palette = "viridis") + 197 | tm_text("SNAME") 198 | ``` 199 | 200 | Let's check the seeds again. 201 | 202 | ```{r example6, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 203 | par(mfrow = c(2, 3), mar = c(0, 0, 2, 0)) 204 | for (i in 1:6) { 205 | new_cells <- calculate_grid(shape = original_shapes2, grid_type = "hexagonal", seed = i) 206 | plot(new_cells, main = paste("Seed", i, sep = " ")) 207 | } 208 | ``` 209 | 210 | ```{r example6a, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 211 | par(mfrow = c(2, 3), mar = c(0, 0, 2, 0)) 212 | for (i in 1:6) { 213 | new_cells <- calculate_grid(shape = original_shapes2, grid_type = "regular", seed = i) 214 | plot(new_cells, main = paste("Seed", i, sep = " ")) 215 | } 216 | ``` 217 | 218 | Now we've seen some seed demo's lets assign them... 219 | 220 | ```{r example7, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 221 | new_cells_hex2 <- calculate_grid(shape = original_shapes2, grid_type = "hexagonal", seed = 6) 222 | resulthex2 <- assign_polygons(original_shapes2, new_cells_hex2) 223 | 224 | new_cells_reg2 <- calculate_grid(shape = original_shapes2, grid_type = "regular", seed = 4) 225 | resultreg2 <- assign_polygons(original_shapes2, new_cells_reg2) 226 | 227 | hexplot2 <- tm_shape(resulthex2) + 228 | tm_polygons("CENSUSAREA", palette = "viridis") + 229 | tm_text("SNAME") 230 | 231 | regplot2 <- tm_shape(resultreg2) + 232 | tm_polygons("CENSUSAREA", palette = "viridis") + 233 | tm_text("SNAME") 234 | 235 | tmap_arrange(rawplot2, hexplot2, regplot2, nrow = 3) 236 | ``` 237 | 238 | Likewise, you can try the bay area... 239 | 240 | ```{r example8, message=FALSE, warning=FALSE, results='hide', fig.keep='all', fig.align='center'} 241 | input_file3 <- system.file("extdata", "bay_counties.geojson", package = "geogrid") 242 | original_shapes3 <- st_read(input_file3) %>% st_transform(3310) 243 | original_shapes3$SNAME <- substr(original_shapes3$county, 1, 4) 244 | 245 | rawplot3 <- tm_shape(original_shapes3) + 246 | tm_polygons(col = "gray25") + 247 | tm_text("SNAME") 248 | 249 | new_cells_hex3 <- calculate_grid(shape = original_shapes3, grid_type = "hexagonal", seed = 6) 250 | resulthex3 <- assign_polygons(original_shapes3, new_cells_hex3) 251 | 252 | new_cells_reg3 <- calculate_grid(shape = original_shapes3, grid_type = "regular", seed = 1) 253 | resultreg3 <- assign_polygons(original_shapes3, new_cells_reg3) 254 | 255 | hexplot3 <- tm_shape(resulthex3) + 256 | tm_polygons(col = "gray25") + 257 | tm_text("SNAME") 258 | 259 | regplot3 <- tm_shape(resultreg3) + 260 | tm_polygons(col = "gray25") + 261 | tm_text("SNAME") 262 | 263 | tmap_arrange(rawplot3, hexplot3, regplot3, nrow = 3) 264 | ``` 265 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Algorithmic tesselation with geogrid 2 | ================ 3 | Joseph Bailey 4 | 2018-12-07 5 | 6 | 7 | 8 | [![Travis-CI Build 9 | Status](https://travis-ci.org/jbaileyh/geogrid.svg?branch=master)](https://travis-ci.org/jbaileyh/geogrid) 10 | [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/geogrid)](https://cran.r-project.org/package=geogrid) 11 | [![Coverage 12 | Status](https://img.shields.io/codecov/c/github/jbaileyh/geogrid/master.svg)](https://codecov.io/github/jbaileyh/geogrid?branch=master) 13 | 14 | # geogrid 15 | 16 | Turn geospatial polygons like states, counties or local authorities into 17 | regular or hexagonal grids 18 | automatically. 19 | 20 | 21 | 22 | ## Intro 23 | 24 | Using geospatial polygons to portray geographical information can be a 25 | challenge when polygons are of different sizes. For example, it can be 26 | difficult to ensure that larger polygons do not skew how readers retain 27 | or absorb information. As a result, many opt to generate maps that use 28 | consistent shapes (i.e. regular grids) to ensure that no specific 29 | geography is emphasised unfairly. Generally there are four reasons that 30 | one might transform geospatial polygons to a different grid (or 31 | geospatial representation): 32 | 33 | 1. We may use cartograms to represent the number of people (or any 34 | value) within a particular geography. For more information and 35 | examples see 36 | [here](https://www.wired.com/2016/10/electoral-maps-look-little-different-heres/) 37 | and 38 | [here](http://www.nytimes.com/interactive/2013/04/08/business/global/asia-map.html). 39 | This cartogram approach changes the size of a particular geography 40 | in-line with the values that one seeks to visualise. 41 | 2. We may use grids to bin data and typically visualise the spatial 42 | density of a particular variable. For an example see 43 | [here](https://bl.ocks.org/mbostock/4330486). 44 | 3. We may use grids to segment a geographical region. For example 45 | tesselation can be used in [biological 46 | sampling](https://www.arcgis.com/home/item.html?id=03388990d3274160afe240ac54763e57) 47 | or even in generating [game 48 | environments](https://www.redblobgames.com/grids/hexagons/). 49 | 4. We may use grids to ‘fairly’ represent existing geographical 50 | entities (such as US states, UK local authorities, or even countries 51 | in Europe). For an example of representing US states as both regular 52 | and hexagonal grids see 53 | [here](http://blog.apps.npr.org/2015/05/11/hex-tile-maps.html). 54 | 55 | The link in bullet 4 provides an excellent introduction to the notion of 56 | tesselation and its challenges. Interestingly, the eventual generation 57 | of hexagonal and regular grids demonstrated in the article was done 58 | **manually**. I believe that this can be very time consuming, and though 59 | it may stimulate some fun discussion - wouldn’t it be great to do it 60 | automatically? 61 | 62 | Recent functionality for representing US states, European countries and 63 | World countries in a grid has been made available for ggplot2 64 | [here](https://hafen.github.io/geofacet/) and there are many other great 65 | examples of **hand-specified** or **bespoke** grids. The challenge with 66 | this is that if you have a less commonly used geography then it might be 67 | hard to find a **hand-specified** or **bespoke** grid for your area of 68 | interest. 69 | 70 | What I wanted to do with `geogrid` is make it easier to generate these 71 | grids in ways that might be visually appealing and then assign the 72 | original geographies to their gridded counterparts in a way that made 73 | sense. Using an input of geospatial polgyons `geogrid` will generate 74 | either a regular or hexagonal grid, and then assign each of the polygons 75 | in your original file to that new grid. 76 | 77 | ## Idea 78 | 79 | There are two steps to using `geogrid`: 80 | 81 | 1. Generate a regular or hexagonal grid of your choice. There are lots 82 | of different arrangements of these grids so choosing one with the 83 | `calculate_grid` function and varying the `seed` is a good place to 84 | start. 85 | 2. Use the [**hungarian 86 | algorithm**](https://en.wikipedia.org/wiki/Hungarian_algorithm) to 87 | efficiently calculate the assignments from the original geography to 88 | the new geography. This involves identifying the solution where the 89 | total distance between the centroid of every original geography and 90 | its new centroid on the grid is minimised. For this I have included 91 | a previous implementation of the Hungarian algorithm kindly made 92 | available 93 | [here](https://github.com/RcppCore/rcpp-gallery/blob/gh-pages/src/2013-09-24-minimal-assignment.cpp). 94 | Huge thanks to Lars Simon Zehnder for this implementation. 95 | 96 | ## Example 97 | 98 | This is a basic example which shows how the assignment of London 99 | boroughs could work. 100 | 101 | ``` r 102 | library(geogrid) 103 | library(sf) 104 | library(tmap) 105 | 106 | input_file <- system.file("extdata", "london_LA.json", package = "geogrid") 107 | original_shapes <- st_read(input_file) %>% st_set_crs(27700) 108 | original_shapes$SNAME <- substr(original_shapes$NAME, 1, 4) 109 | ``` 110 | 111 | For reference, lets see how London’s local authorities are actually 112 | bounded in real space. In this example, I have coloured each polygon 113 | based on it’s area. Brighter polygons are larger. 114 | 115 | ``` r 116 | rawplot <- tm_shape(original_shapes) + 117 | tm_polygons("HECTARES", palette = "viridis") + 118 | tm_text("SNAME") 119 | rawplot 120 | ``` 121 | 122 | 123 | 124 | So, let’s turn this into a grid to stop places like Bromley, Hillingdon 125 | and Havering from stealing our attention. First of all, we can generate 126 | a number of different grids using `seed`. Since there are many ways to 127 | dissect the outer boundary of the polygons you might want to choose an 128 | output that appeals to you. I’d recommend looking at different `seed` 129 | values and choosing the one that best matches the outline that you 130 | approve of. 131 | 132 | The `calculate_grid` function takes in a SpatialPolygonsDataframe or sf 133 | object, a learning rate (suggestion = 0.03 to begin), a grid type 134 | `hexagonal` or `regular` and a seed value. Let’s have a look at some 135 | hexagonal grid options for the London local authorities: 136 | 137 | ``` r 138 | par(mfrow = c(2, 3), mar = c(0, 0, 2, 0)) 139 | for (i in 1:6) { 140 | new_cells <- calculate_grid(shape = original_shapes, grid_type = "hexagonal", seed = i) 141 | plot(new_cells, main = paste("Seed", i, sep = " ")) 142 | } 143 | ``` 144 | 145 | 146 | 147 | Let’s also look at things with a regular grid: 148 | 149 | ``` r 150 | par(mfrow = c(2, 3), mar = c(0, 0, 2, 0)) 151 | for (i in 1:6) { 152 | new_cells <- calculate_grid(shape = original_shapes, grid_type = "regular", seed = i) 153 | plot(new_cells, main = paste("Seed", i, sep = " ")) 154 | } 155 | ``` 156 | 157 | 158 | 159 | As we can see there are lots of options. Now, lets choose a grid and 160 | assign our existing places to it. I happen to like the both grids that 161 | have a `seed` of 3. So I’m going to assign the polygons to those grids. 162 | Let’s do that and see what they look like compared to the 163 | original. 164 | 165 | ``` r 166 | new_cells_hex <- calculate_grid(shape = original_shapes, grid_type = "hexagonal", seed = 3) 167 | resulthex <- assign_polygons(original_shapes, new_cells_hex) 168 | 169 | new_cells_reg <- calculate_grid(shape = original_shapes, grid_type = "regular", seed = 3) 170 | resultreg <- assign_polygons(original_shapes, new_cells_reg) 171 | ``` 172 | 173 | Now we have an example transfer from real space to grid space - we can 174 | visualise it. 175 | 176 | ``` r 177 | hexplot <- tm_shape(resulthex) + 178 | tm_polygons("HECTARES", palette = "viridis") + 179 | tm_text("SNAME") 180 | 181 | regplot <- tm_shape(resultreg) + 182 | tm_polygons("HECTARES", palette = "viridis") + 183 | tm_text("SNAME") 184 | 185 | tmap_arrange(rawplot, hexplot, regplot, nrow = 3) 186 | ``` 187 | 188 | 189 | 190 | ## Details 191 | 192 | The package has two major functions: 193 | 194 | 1. `calculate_grid()` given your input polygons this will generate the 195 | grid as specified by your arguments: 196 | - `shape`: the original polygons 197 | - `learning_rate`: the rate at which the gradient descent finds 198 | the optimum cellsize to ensure that your gridded points fit 199 | within the outer boundary of the input polygons. 200 | - `grid_type`: either `regular` for a square grid or `hexagonal` 201 | for a hexagonal grid. 202 | - `seed`: the seed to ensure you get the same grid output. 203 | 2. `assign_polygons()`: this will assign the original polygons to their 204 | new locations on the grid generated in `calculate_grid()`. It will 205 | find the solution that minimises the sum of the total distance 206 | between the original polygon centroids and eventual gridded 207 | centroids. Arguments: 208 | - `shape`: the original polygons 209 | - `new_polygons`: the output (a list) from `calculate_grid()`. 210 | 211 | ## TODO 212 | 213 | - Assignment may not always work - check the `assign_polygons()` why 214 | does it only work sometimes? 215 | - Make it work (done I think), make it right (not yet), make it fast 216 | (not yet). 217 | - Improve the cellsize calculation methodology. 218 | - Get someone to answer [this stack overflow 219 | question](https://math.stackexchange.com/questions/2388000/find-topologically-closest-graph-under-constraints). 220 | 221 | ## Notes 222 | 223 | This is my first attempt at a package. If it doesn’t work I’d like 224 | suggestions for improvements and thanks in advance for providing them\! 225 | 226 | I welcome critique and feedback. Blog post to follow. 227 | 228 | ## Thanks 229 | 230 | I read a lot of the work by [Hadley Wickham](http://hadley.nz/), [Jenny 231 | Bryan](https://github.com/jennybc), [Thomas Lin 232 | Pedersen](https://www.data-imaginist.com/about/), [Mara 233 | Averick](https://twitter.com/dataandme?lang=en) and [Bob 234 | Rudis](https://github.com/hrbrmstr) to name a few. But also love the R 235 | community and learn a huge amount from [R 236 | Bloggers](https://www.r-bloggers.com/). 237 | 238 | Extra thanks go to [Ryan Hafen](http://ryanhafen.com/) for making this 239 | package publishable. 240 | 241 | # Other examples 242 | 243 | From others: 244 | 245 | Simon Hailstone has looked at [male life expectancy in the South East 246 | region of England](http://rpubs.com/Hailstone/326118) using the package. 247 | Thanks Simon for using\! 248 | 249 | From me: 250 | 251 | This time using the contiguous USA. Again, I used set seed and chose 252 | some that I liked but I’d recommend you’d do the 253 | same. 254 | 255 | ``` r 256 | input_file2 <- system.file("extdata", "states.json", package = "geogrid") 257 | original_shapes2 <- st_read(input_file2) %>% st_transform(2163) 258 | original_shapes2$SNAME <- substr(original_shapes2$NAME, 1, 4) 259 | 260 | rawplot2 <- tm_shape(original_shapes2) + 261 | tm_polygons("CENSUSAREA", palette = "viridis") + 262 | tm_text("SNAME") 263 | ``` 264 | 265 | Let’s check the seeds again. 266 | 267 | ``` r 268 | par(mfrow = c(2, 3), mar = c(0, 0, 2, 0)) 269 | for (i in 1:6) { 270 | new_cells <- calculate_grid(shape = original_shapes2, grid_type = "hexagonal", seed = i) 271 | plot(new_cells, main = paste("Seed", i, sep = " ")) 272 | } 273 | ``` 274 | 275 | 276 | 277 | ``` r 278 | par(mfrow = c(2, 3), mar = c(0, 0, 2, 0)) 279 | for (i in 1:6) { 280 | new_cells <- calculate_grid(shape = original_shapes2, grid_type = "regular", seed = i) 281 | plot(new_cells, main = paste("Seed", i, sep = " ")) 282 | } 283 | ``` 284 | 285 | 286 | 287 | Now we’ve seen some seed demo’s lets assign 288 | them… 289 | 290 | ``` r 291 | new_cells_hex2 <- calculate_grid(shape = original_shapes2, grid_type = "hexagonal", seed = 6) 292 | resulthex2 <- assign_polygons(original_shapes2, new_cells_hex2) 293 | 294 | new_cells_reg2 <- calculate_grid(shape = original_shapes2, grid_type = "regular", seed = 4) 295 | resultreg2 <- assign_polygons(original_shapes2, new_cells_reg2) 296 | 297 | hexplot2 <- tm_shape(resulthex2) + 298 | tm_polygons("CENSUSAREA", palette = "viridis") + 299 | tm_text("SNAME") 300 | 301 | regplot2 <- tm_shape(resultreg2) + 302 | tm_polygons("CENSUSAREA", palette = "viridis") + 303 | tm_text("SNAME") 304 | 305 | tmap_arrange(rawplot2, hexplot2, regplot2, nrow = 3) 306 | ``` 307 | 308 | 309 | 310 | Likewise, you can try the bay 311 | area… 312 | 313 | ``` r 314 | input_file3 <- system.file("extdata", "bay_counties.geojson", package = "geogrid") 315 | original_shapes3 <- st_read(input_file3) %>% st_transform(3310) 316 | original_shapes3$SNAME <- substr(original_shapes3$county, 1, 4) 317 | 318 | rawplot3 <- tm_shape(original_shapes3) + 319 | tm_polygons(col = "gray25") + 320 | tm_text("SNAME") 321 | 322 | new_cells_hex3 <- calculate_grid(shape = original_shapes3, grid_type = "hexagonal", seed = 6) 323 | resulthex3 <- assign_polygons(original_shapes3, new_cells_hex3) 324 | 325 | new_cells_reg3 <- calculate_grid(shape = original_shapes3, grid_type = "regular", seed = 1) 326 | resultreg3 <- assign_polygons(original_shapes3, new_cells_reg3) 327 | 328 | hexplot3 <- tm_shape(resulthex3) + 329 | tm_polygons(col = "gray25") + 330 | tm_text("SNAME") 331 | 332 | regplot3 <- tm_shape(resultreg3) + 333 | tm_polygons(col = "gray25") + 334 | tm_text("SNAME") 335 | 336 | tmap_arrange(rawplot3, hexplot3, regplot3, nrow = 3) 337 | ``` 338 | 339 | 340 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | -------------------------------------------------------------------------------- /geogrid.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | StripTrailingWhitespace: Yes 16 | 17 | BuildType: Package 18 | PackageUseDevtools: Yes 19 | PackageInstallArgs: --no-multiarch --with-keep.source 20 | PackageRoxygenize: rd,collate,namespace 21 | -------------------------------------------------------------------------------- /man/README_figs/README-example0-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example0-1.png -------------------------------------------------------------------------------- /man/README_figs/README-example0-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example0-2.png -------------------------------------------------------------------------------- /man/README_figs/README-example1-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example1-1.png -------------------------------------------------------------------------------- /man/README_figs/README-example2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example2-1.png -------------------------------------------------------------------------------- /man/README_figs/README-example4-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example4-1.png -------------------------------------------------------------------------------- /man/README_figs/README-example4-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example4-2.png -------------------------------------------------------------------------------- /man/README_figs/README-example4-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example4-3.png -------------------------------------------------------------------------------- /man/README_figs/README-example5-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example5-1.png -------------------------------------------------------------------------------- /man/README_figs/README-example6-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example6-1.png -------------------------------------------------------------------------------- /man/README_figs/README-example6a-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example6a-1.png -------------------------------------------------------------------------------- /man/README_figs/README-example7-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example7-1.png -------------------------------------------------------------------------------- /man/README_figs/README-example8-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jbaileyh/geogrid/2625053a117d164da7eaa8bc736a6e92c4851b44/man/README_figs/README-example8-1.png -------------------------------------------------------------------------------- /man/assign_polygons.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/assign_polygons.R 3 | \name{assign_polygons} 4 | \alias{assign_polygons} 5 | \alias{assign_polygons.SpatialPolygonsDataFrame} 6 | \alias{assign_polygons.sf} 7 | \title{Assign the polygons in the original spatial data to their new location.} 8 | \usage{ 9 | assign_polygons(shape, new_polygons) 10 | 11 | \method{assign_polygons}{SpatialPolygonsDataFrame}(shape, new_polygons) 12 | 13 | \method{assign_polygons}{sf}(shape, new_polygons) 14 | } 15 | \arguments{ 16 | \item{shape}{A "SpatialPolygonsDataFrame" or an sf object representing the original spatial polygons.} 17 | 18 | \item{new_polygons}{A "geogrid" object returned from \code{\link{calculate_grid}}.} 19 | } 20 | \value{ 21 | An object of the same class as shape 22 | } 23 | \description{ 24 | Assigns each polygon in the original file to a new location in the gridded geometry using the Hungarian algorithm. 25 | } 26 | \examples{ 27 | library(sf) 28 | input_file <- system.file("extdata", "london_LA.json", package = "geogrid") 29 | original_shapes <- st_read(input_file) \%>\% st_set_crs(27700) 30 | 31 | # calculate grid 32 | new_cells <- calculate_grid(shape = original_shapes, 33 | grid_type = "hexagonal", seed = 1) 34 | grid_shapes <- assign_polygons(original_shapes, new_cells) 35 | plot(grid_shapes) 36 | 37 | par(mfrow = c(1, 2)) 38 | plot(st_geometry(original_shapes)) 39 | plot(st_geometry(grid_shapes)) 40 | 41 | \dontrun{ 42 | # look at different grids using different seeds 43 | par(mfrow=c(2, 3), mar = c(0, 0, 2, 0)) 44 | for (i in 1:6) { 45 | new_cells <- calculate_grid(shape = original_shapes, grid_type = "hexagonal", seed = i) 46 | plot(new_cells, main = paste("Seed", i, sep=" ")) 47 | } 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /man/calculate_cell_size.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_grid.R 3 | \name{calculate_cell_size} 4 | \alias{calculate_cell_size} 5 | \title{Calculate size of grid items (deprecated).} 6 | \usage{ 7 | calculate_cell_size(shape, shape_details = NULL, learning_rate = 0.03, 8 | grid_type = c("hexagonal", "regular"), seed = NULL, 9 | verbose = FALSE) 10 | } 11 | \arguments{ 12 | \item{shape}{A 'SpatialPolygonsDataFrame' object representing the original spatial polygons.} 13 | 14 | \item{shape_details}{deprecated.} 15 | 16 | \item{learning_rate}{The rate at which the gradient descent finds the optimum cellsize to ensure that your gridded points fit within the outer boundary of the input polygons.} 17 | 18 | \item{grid_type}{Either 'hexagonal' for a hexagonal grid (default) or 'regular' for a regular grid.} 19 | 20 | \item{seed}{An optional random seed integer to be used for the grid calculation algorithm.} 21 | 22 | \item{verbose}{A logical indicating whether messages should be printed as the algorithm iterates.} 23 | } 24 | \description{ 25 | Given an input multipolgyon spatial data frame this function calculates the required cell size of a regular or hexagonal grid. 26 | } 27 | -------------------------------------------------------------------------------- /man/calculate_grid.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_grid.R 3 | \name{calculate_grid} 4 | \alias{calculate_grid} 5 | \alias{calculate_grid.SpatialPolygonsDataFrame} 6 | \alias{calculate_grid.sf} 7 | \title{Calculate grid from spatial polygons.} 8 | \usage{ 9 | calculate_grid(shape, learning_rate = 0.03, grid_type = c("hexagonal", 10 | "regular"), seed = NULL, verbose = FALSE) 11 | 12 | \method{calculate_grid}{SpatialPolygonsDataFrame}(shape, 13 | learning_rate = 0.03, grid_type = c("hexagonal", "regular"), 14 | seed = NULL, verbose = FALSE) 15 | 16 | \method{calculate_grid}{sf}(shape, learning_rate = 0.03, 17 | grid_type = c("hexagonal", "regular"), seed = NULL, 18 | verbose = FALSE) 19 | } 20 | \arguments{ 21 | \item{shape}{A 'SpatialPolygonsDataFrame' or an sf object representing the original spatial polygons.} 22 | 23 | \item{learning_rate}{The rate at which the gradient descent finds the optimum cellsize to ensure that your gridded points fit within the outer boundary of the input polygons.} 24 | 25 | \item{grid_type}{Either 'hexagonal' for a hexagonal grid (default) or 'regular' for a regular grid.} 26 | 27 | \item{seed}{An optional random seed integer to be used for the grid calculation algorithm.} 28 | 29 | \item{verbose}{A logical indicating whether messages should be printed as the algorithm iterates.} 30 | } 31 | \description{ 32 | Given an input multipolgyon spatial data frame this function calculates a hexagonal or regular grid that strives to preserve the original geography. 33 | } 34 | \examples{ 35 | library(sf) 36 | input_file <- system.file('extdata', 'london_LA.json', package = 'geogrid') 37 | original_shapes <- st_read(input_file) \%>\% st_set_crs(27700) 38 | 39 | # calculate grid 40 | new_cells <- calculate_grid(shape = original_shapes, 41 | grid_type = 'hexagonal', seed = 1) 42 | grid_shapes <- assign_polygons(original_shapes, new_cells) 43 | plot(grid_shapes) 44 | 45 | par(mfrow = c(1, 2)) 46 | plot(st_geometry(original_shapes)) 47 | plot(st_geometry(grid_shapes)) 48 | 49 | \dontrun{ 50 | # look at different grids using different seeds 51 | par(mfrow=c(2, 3), mar = c(0, 0, 2, 0)) 52 | for (i in 1:6) { 53 | new_cells <- calculate_grid(shape = original_shapes, grid_type = 'hexagonal', seed = i) 54 | plot(new_cells, main = paste('Seed', i, sep=' ')) 55 | } 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /man/geogrid-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geogrid-package.R 3 | \docType{package} 4 | \name{geogrid-package} 5 | \alias{geogrid} 6 | \alias{geogrid-package} 7 | \title{geogrid: Turn Geospatial Polygons into Regular or Hexagonal Grids} 8 | \description{ 9 | Turn irregular polygons (such as geographical regions) into regular or hexagonal grids. 10 | This package enables the generation of regular (square) and hexagonal grids through the package 11 | 'sp' and then assigns the content of the existing polygons to the new grid using 12 | the Hungarian algorithm, Kuhn (1955) (). 13 | This prevents the need for manual generation of hexagonal grids or regular grids 14 | that are supposed to reflect existing geography. 15 | } 16 | \seealso{ 17 | Useful links: 18 | \itemize{ 19 | \item \url{https://github.com/jbaileyh/geogrid} 20 | \item Report bugs at \url{https://github.com/jbaileyh/geogrid/issues} 21 | } 22 | 23 | } 24 | \author{ 25 | \strong{Maintainer}: Joseph Bailey \email{jbailey@futurecities.catapult.org.uk} 26 | 27 | Other contributors: 28 | \itemize{ 29 | \item Ryan Hafen \email{rhafen@gmail.com} [contributor] 30 | \item Jakub Nowosad \email{nowosad.jakub@gmail.com} (0000-0002-1057-3721) [contributor] 31 | \item Lars Simon Zehnder (RcppArmadillo implmentation of Munkres' Assignment Algorithm) [contributor] 32 | } 33 | 34 | } 35 | \keyword{internal} 36 | -------------------------------------------------------------------------------- /man/get_shape_details.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_shape_details.R 3 | \name{get_shape_details} 4 | \alias{get_shape_details} 5 | \title{Extract details from provided polygons (deprecated).} 6 | \usage{ 7 | get_shape_details(input_shape) 8 | } 9 | \arguments{ 10 | \item{input_shape}{A "SpatialPolygonsDataFrame" object representing the original spatial polygons.} 11 | } 12 | \description{ 13 | Extract spatial extent, range and other geospatial features from the output of read_polygons. Items are returned as a list for use in \code{\link{calculate_grid}}. 14 | } 15 | -------------------------------------------------------------------------------- /man/get_shape_details_internal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_shape_details.R 3 | \name{get_shape_details_internal} 4 | \alias{get_shape_details_internal} 5 | \title{Extract details from provided polygons.} 6 | \usage{ 7 | get_shape_details_internal(input_shape) 8 | } 9 | \arguments{ 10 | \item{input_shape}{A "SpatialPolygonsDataFrame" object representing the original spatial polygons.} 11 | } 12 | \description{ 13 | Extract spatial extent, range and other geospatial features from the output of read_polygons. Items are returned as a list for use in \code{\link{calculate_grid}}. 14 | } 15 | -------------------------------------------------------------------------------- /man/hungarian_cc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{hungarian_cc} 4 | \alias{hungarian_cc} 5 | \title{hungarian_cc} 6 | \usage{ 7 | hungarian_cc(cost) 8 | } 9 | \arguments{ 10 | \item{cost}{cost matrix} 11 | } 12 | \description{ 13 | hungarian_cc 14 | } 15 | -------------------------------------------------------------------------------- /man/hungariansafe_cc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{hungariansafe_cc} 4 | \alias{hungariansafe_cc} 5 | \title{hungariansafe_cc} 6 | \usage{ 7 | hungariansafe_cc(cost) 8 | } 9 | \arguments{ 10 | \item{cost}{cost matrix} 11 | } 12 | \description{ 13 | hungariansafe_cc 14 | } 15 | -------------------------------------------------------------------------------- /man/plot.geogrid.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_grid.R 3 | \name{plot.geogrid} 4 | \alias{plot.geogrid} 5 | \title{Plot a 'geogrid' object} 6 | \usage{ 7 | \method{plot}{geogrid}(x, y, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class 'geogrid' to plot.} 11 | 12 | \item{y}{ignored} 13 | 14 | \item{...}{Additional parameters passed to the 'sp' package's plot method.} 15 | } 16 | \description{ 17 | Plot a 'geogrid' object 18 | } 19 | -------------------------------------------------------------------------------- /man/read_polygons.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_polygons.R 3 | \name{read_polygons} 4 | \alias{read_polygons} 5 | \title{Import spatial data.} 6 | \usage{ 7 | read_polygons(file) 8 | } 9 | \arguments{ 10 | \item{file}{A file path pointing to a shapefile or GeoJSON file, or a character string holding GeoJSON data. See the \code{dsn} argument of \code{\link[sf]{st_read}} for more details.} 11 | } 12 | \description{ 13 | Simple function to read spatial data into a SpatialPolygonsDataFrame. Based on st_read from package sf. 14 | } 15 | -------------------------------------------------------------------------------- /src/RcppExports.cpp: -------------------------------------------------------------------------------- 1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include 5 | #include 6 | 7 | using namespace Rcpp; 8 | 9 | // hungarian_cc 10 | arma::imat hungarian_cc(Rcpp::NumericMatrix cost); 11 | RcppExport SEXP _geogrid_hungarian_cc(SEXP costSEXP) { 12 | BEGIN_RCPP 13 | Rcpp::RObject rcpp_result_gen; 14 | Rcpp::RNGScope rcpp_rngScope_gen; 15 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type cost(costSEXP); 16 | rcpp_result_gen = Rcpp::wrap(hungarian_cc(cost)); 17 | return rcpp_result_gen; 18 | END_RCPP 19 | } 20 | // hungariansafe_cc 21 | arma::imat hungariansafe_cc(Rcpp::NumericMatrix cost); 22 | RcppExport SEXP _geogrid_hungariansafe_cc(SEXP costSEXP) { 23 | BEGIN_RCPP 24 | Rcpp::RObject rcpp_result_gen; 25 | Rcpp::RNGScope rcpp_rngScope_gen; 26 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type cost(costSEXP); 27 | rcpp_result_gen = Rcpp::wrap(hungariansafe_cc(cost)); 28 | return rcpp_result_gen; 29 | END_RCPP 30 | } 31 | 32 | static const R_CallMethodDef CallEntries[] = { 33 | {"_geogrid_hungarian_cc", (DL_FUNC) &_geogrid_hungarian_cc, 1}, 34 | {"_geogrid_hungariansafe_cc", (DL_FUNC) &_geogrid_hungariansafe_cc, 1}, 35 | {NULL, NULL, 0} 36 | }; 37 | 38 | RcppExport void R_init_geogrid(DllInfo *dll) { 39 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 40 | R_useDynamicSymbols(dll, FALSE); 41 | } 42 | -------------------------------------------------------------------------------- /src/minimal-assignment.cpp: -------------------------------------------------------------------------------- 1 | /** 2 | * @title Munkres' Assignment Algorithm with RcppArmadillo 3 | * @author Lars Simon Zehnder 4 | * @license GPL (>= 2) 5 | * @tags armadillo 6 | * @summary Demonstrates the Minimal (or Maximal) Assignment Problem algorithm. 7 | */ 8 | 9 | /** 10 | * _Munkres' Assignment Algorithm_ 11 | * ([Munkres (1957)](http://www.jstor.org/discover/10.2307/2098689?uid=3737864&uid=2&uid=4&sid=21102674250347), 12 | * also known as _hungarian algorithm_) is a well known algorithm 13 | * in Operations Research solving the problem to optimally 14 | * assign `N` jobs to `N` workers. 15 | * 16 | * I needed to solve the _Minimal Assignment Problem_ for a 17 | * relabeling algorithm in MCMC sampling for _finite mixture_ 18 | * distributions, where I use a random permutation Gibbs 19 | * sampler. For each sample an optimal labeling must be found, 20 | * i.e. I have `N` parameter vectors and must assign each vector 21 | * to one of the `N` components of the finite mixture under the restriction 22 | * that each component gets a parameter vector. For the assignment 23 | * of parameters to components 24 | * [Stephens (1997b)] (http://www.isds.duke.edu/~scs/Courses/Stat376/Papers/Mixtures/LabelSwitchingStephensJRSSB.pdf) 25 | * suggests an algorithm relying on the Minimal Assignment in regard 26 | * to a _loss matrix_. The labeling with the smallest loss is 27 | * then considered as optimal. 28 | * 29 | * After an unsuccessful search for libraries implementing 30 | * the algorithm easily for C++ or C, I made the decision to 31 | * program it myself using `RcppArmadillo` for good performance. 32 | * I found some guidance by the websites of 33 | * [Bob Pilgrim](http://csclab.murraystate.edu/bob.pilgrim/445/munkres.html) and 34 | * [TopCoder] (http://community.topcoder.com/tc?module=Static&d1=tutorials&d2=hungarianAlgorithm). 35 | * These websites offer excellent tutorials to understand 36 | * the algorithm and to convert it to code. The order of this 37 | * implementation of Munkres' algorithm is of an order `N` to the power of 4. There exists 38 | * also a version of order `N` to the power of 3, but an order of `N` to the power of 4 works 39 | * very good for me and coding time is as usual a critical factor 40 | * for me. 41 | * 42 | * In the following I walk through the different steps of 43 | * Munkres' algorithm and explain the main parts and their 44 | * functionality. 45 | * 46 | * Let's begin. The first step in Munkres' algorithm is to 47 | * subtract the minimal element of each row from each element 48 | * in this row. 49 | */ 50 | 51 | #include 52 | // [[Rcpp::depends(RcppArmadillo)]] 53 | 54 | void step_one(unsigned int &step, arma::mat &cost, 55 | const unsigned int &N) 56 | { 57 | for (unsigned int r = 0; r < N; ++r) { 58 | cost.row(r) -= arma::min(cost.row(r)); 59 | } 60 | step = 2; 61 | } 62 | 63 | /** 64 | * Note, that we use references for all function arguments. 65 | * As we have to switch between the steps of the algorithm 66 | * continously, we always must be able to determine which 67 | * step should be chosen next. Therefore we give a mutable 68 | * unsigned integer `step` as an argument to each step 69 | * function of the algorithm. 70 | * 71 | * Inside the function we can easily access a whole row by 72 | * Armadillo's `row()` method for matrices. 73 | * In the second step, we then search for a zero in the 74 | * modified cost matrix of step one. 75 | */ 76 | void step_two (unsigned int &step, const arma::mat &cost, 77 | arma::umat &indM, arma::ivec &rcov, 78 | arma::ivec &ccov, const unsigned int &N) 79 | { 80 | for (unsigned int r = 0; r < N; ++r) { 81 | for (unsigned int c = 0; c < N; ++c) { 82 | if (cost.at(r, c) == 0.0 && rcov.at(r) == 0 && ccov.at(c) == 0) { 83 | indM.at(r, c) = 1; 84 | rcov.at(r) = 1; 85 | ccov.at(c) = 1; 86 | break; // Only take the first 87 | // zero in a row and column 88 | } 89 | } 90 | } 91 | /* for later reuse */ 92 | rcov.fill(0); 93 | ccov.fill(0); 94 | step = 3; 95 | } 96 | 97 | /** 98 | * Only the first zero in a row is taken. Then, the indicator 99 | * matrix `indM` indicates this zero by setting the corresponding 100 | * element at `(r, c)` to 1. A unique zero - the only or first one in 101 | * a column and row - is called _starred zero_. In `step 2` we find 102 | * such a _starred zero_. 103 | * 104 | * Note, that we use here Armadillo's element access via the 105 | * method `at()`, which makes no bound checks and improves performance. 106 | * 107 | * _Note Bene: This code is thoroughly debugged - never do this for fresh written 108 | * code!_ 109 | * 110 | * In `step 3` we cover each column with a _starred zero_. If already 111 | * `N` columns are covered all _starred zeros_ describe a complete 112 | * assignment - so, go to `step 7` and finish. Otherwise go to 113 | * `step 4`. 114 | */ 115 | void step_three(unsigned int &step, const arma::umat &indM, 116 | arma::ivec &ccov, const unsigned int &N) 117 | { 118 | unsigned int colcount = 0; 119 | for (unsigned int r = 0; r < N; ++r) { 120 | for (unsigned int c = 0; c < N; ++c) { 121 | if (indM.at(r, c) == 1) { 122 | ccov.at(c) = 1; 123 | } 124 | } 125 | } 126 | for (unsigned int c = 0; c < N; ++c) { 127 | if (ccov.at(c) == 1) { 128 | ++colcount; 129 | } 130 | } 131 | if (colcount == N) { 132 | step = 7; 133 | } else { 134 | step = 4; 135 | } 136 | } 137 | /** 138 | * We cover a column by looking for 1s in the indicator 139 | * matrix `indM` (See `step 2` for assuring that these are 140 | * indeed only _starred zeros_). 141 | * 142 | * `Step 4` finds _noncovered zeros_ and _primes_ them. If there 143 | * are zeros in a row and none of them is _starred_, _prime_ 144 | * them. For this task we program a helper function to keep 145 | * the code more readable and reusable. The helper function 146 | * searches for _noncovered zeros_. 147 | */ 148 | void find_noncovered_zero(int &row, int &col, 149 | const arma::mat &cost, const arma::ivec &rcov, 150 | const arma::ivec &ccov, const unsigned int &N) 151 | { 152 | unsigned int r = 0; 153 | unsigned int c; 154 | bool done = false; 155 | row = -1; 156 | col = -1; 157 | while (!done) { 158 | c = 0; 159 | while (true) { 160 | if (cost.at(r, c) == 0.0 && rcov.at(r) == 0 && ccov.at(c) == 0) { 161 | row = r; 162 | col = c; 163 | done = true; 164 | } 165 | ++c; 166 | if (c == N || done) { 167 | break; 168 | } 169 | } 170 | ++r; 171 | if (r == N) { 172 | done = true; 173 | } 174 | } 175 | } 176 | /** 177 | * We can detect _noncovered zeros_ by checking if the cost matrix 178 | * contains at row r and column c a zero and row and column 179 | * are not covered yet, i.e. `rcov(r) == 0`, `ccov(c) == 0`. 180 | * This loop breaks, if we have found our first _uncovered zero_ or 181 | * no _uncovered zero_ at all. 182 | * 183 | * In `step 4`, if no _uncovered zero_ is found we go to `step 6`. If 184 | * instead an _uncovered zero_ has been found, we set the indicator 185 | * matrix at its position to 2. We then have to search for a _starred 186 | * zero_ in the row with the _uncovered zero_, _uncover_ the column with 187 | * the _starred zero_ and _cover_ the row with the _starred zero_. To 188 | * indicate a _starred zero_ in a row and to find it we create again 189 | * two helper functions. 190 | */ 191 | bool star_in_row(int &row, const arma::umat &indM, 192 | const unsigned int &N) 193 | { 194 | bool tmp = false; 195 | for (unsigned int c = 0; c < N; ++c) { 196 | if (indM.at(row, c) == 1) { 197 | tmp = true; 198 | break; 199 | } 200 | } 201 | return tmp; 202 | } 203 | 204 | void find_star_in_row (const int &row, int &col, 205 | const arma::umat &indM, const unsigned int &N) 206 | { 207 | col = -1; 208 | for (unsigned int c = 0; c < N; ++c) { 209 | if (indM.at(row, c) == 1) { 210 | col = c; 211 | } 212 | } 213 | } 214 | /** 215 | * We know that _starred zeros_ are indicated by the indicator 216 | * matrix containing an element equal to 1. 217 | * Now, `step 4`. 218 | */ 219 | void step_four (unsigned int &step, const arma::mat &cost, 220 | arma::umat &indM, arma::ivec &rcov, arma::ivec &ccov, 221 | int &rpath_0, int &cpath_0, const unsigned int &N) 222 | { 223 | int row = -1; 224 | int col = -1; 225 | bool done = false; 226 | while(!done) { 227 | find_noncovered_zero(row, col, cost, rcov, 228 | ccov, N); 229 | 230 | if (row == -1) { 231 | done = true; 232 | step = 6; 233 | } else { 234 | /* uncovered zero */ 235 | indM(row, col) = 2; 236 | if (star_in_row(row, indM, N)) { 237 | find_star_in_row(row, col, indM, N); 238 | /* Cover the row with the starred zero 239 | * and uncover the column with the starred 240 | * zero. 241 | */ 242 | rcov.at(row) = 1; 243 | ccov.at(col) = 0; 244 | } else { 245 | /* No starred zero in row with 246 | * uncovered zero 247 | */ 248 | done = true; 249 | step = 5; 250 | rpath_0 = row; 251 | cpath_0 = col; 252 | } 253 | } 254 | } 255 | } 256 | /** 257 | * Notice the `rpath_0` and `cpath_0` variables. These integer 258 | * variables store the first _vertex_ for an _augmenting path_ in `step 5`. 259 | * If zeros could be _primed_ we go further to `step 5`. 260 | * 261 | * `Step 5` constructs a path beginning at an _uncovered primed 262 | * zero_ (this is actually graph theory - alternating and augmenting 263 | * paths) and alternating between _starred_ and _primed zeros_. 264 | * This path is continued until a _primed zero_ with no _starred 265 | * zero_ in its column is found. Then, all _starred zeros_ in 266 | * this path are _unstarred_ and all _primed zeros_ are _starred_. 267 | * All _primes_ in the indicator matrix are erased and all rows 268 | * are _uncovered_. Then return to `step 3` to _cover_ again columns. 269 | * 270 | * `Step 5` needs several helper functions. First, we need 271 | * a function to find _starred zeros_ in columns. 272 | */ 273 | void find_star_in_col (const int &col, int &row, 274 | const arma::umat &indM, const unsigned int &N) 275 | { 276 | row = -1; 277 | for (unsigned int r = 0; r < N; ++r) { 278 | if (indM.at(r, col) == 1) { 279 | row = r; 280 | } 281 | } 282 | } 283 | /** 284 | * Then we need a function to find a _primed zero_ in a row. 285 | * Note, that these tasks are easily performed by searching the 286 | * indicator matrix `indM`. 287 | */ 288 | void find_prime_in_row (const int &row, int &col, 289 | const arma::umat &indM, const unsigned int &N) 290 | { 291 | for (unsigned int c = 0; c < N; ++c) { 292 | if (indM.at(row, c) == 2) { 293 | col = c; 294 | } 295 | } 296 | } 297 | /** 298 | * In addition we need a function to augment the path, one to 299 | * clear the _covers_ from rows and one to erase the _primed zeros_ 300 | * from the indicator matrix `indM`. 301 | */ 302 | void augment_path (const int &path_count, arma::umat &indM, 303 | const arma::imat &path) 304 | { 305 | for (unsigned int p = 0; p < path_count; ++p) { 306 | if (indM.at(path(p, 0), path(p, 1)) == 1) { 307 | indM.at(path(p, 0), path(p, 1)) = 0; 308 | } else { 309 | indM.at(path(p, 0), path(p, 1)) = 1; 310 | } 311 | } 312 | } 313 | 314 | void clear_covers (arma::ivec &rcov, arma::ivec &ccov) 315 | { 316 | rcov.fill(0); 317 | ccov.fill(0); 318 | } 319 | 320 | void erase_primes(arma::umat &indM, const unsigned int &N) 321 | { 322 | for (unsigned int r = 0; r < N; ++r) { 323 | for (unsigned int c = 0; c < N; ++c) { 324 | if (indM.at(r, c) == 2) { 325 | indM.at(r, c) = 0; 326 | } 327 | } 328 | } 329 | } 330 | /** 331 | * The function to augment the path gets an integer matrix `path` 332 | * of dimension 2 * N x 2. In it all vertices between rows and columns 333 | * are stored row-wise. 334 | * Now, we can set the complete `step 5`: 335 | */ 336 | void step_five (unsigned int &step, 337 | arma::umat &indM, arma::ivec &rcov, 338 | arma::ivec &ccov, arma::imat &path, 339 | int &rpath_0, int &cpath_0, 340 | const unsigned int &N) 341 | { 342 | bool done = false; 343 | int row = -1; 344 | int col = -1; 345 | unsigned int path_count = 1; 346 | path.at(path_count - 1, 0) = rpath_0; 347 | path.at(path_count - 1, 1) = cpath_0; 348 | while (!done) { 349 | find_star_in_col(path.at(path_count - 1, 1), row, 350 | indM, N); 351 | if (row > -1) { 352 | /* Starred zero in row 'row' */ 353 | ++path_count; 354 | path.at(path_count - 1, 0) = row; 355 | path.at(path_count - 1, 1) = path.at(path_count - 2, 1); 356 | } else { 357 | done = true; 358 | } 359 | if (!done) { 360 | /* If there is a starred zero find a primed 361 | * zero in this row; write index to 'col' */ 362 | find_prime_in_row(path.at(path_count - 1, 0), col, 363 | indM, N); 364 | ++path_count; 365 | path.at(path_count - 1, 0) = path.at(path_count - 2, 0); 366 | path.at(path_count - 1, 1) = col; 367 | } 368 | } 369 | augment_path(path_count, indM, path); 370 | clear_covers(rcov, ccov); 371 | erase_primes(indM, N); 372 | step = 3; 373 | } 374 | /** 375 | * Recall, if `step 4` was successfull in uncovering all columns 376 | * and covering all rows with a primed zero, it then calls 377 | * `step 6`. 378 | * `Step 6` takes the cover vectors `rcov` and `ccov` and looks 379 | * in the uncovered region of the cost matrix for the smallest 380 | * value. It then subtracts this value from each element in an 381 | * _uncovered column_ and adds it to each element in a _covered row_. 382 | * After this transformation, the algorithm starts again at `step 4`. 383 | * Our last helper function searches for the smallest value in 384 | * the uncovered region of the cost matrix. 385 | */ 386 | void find_smallest (double &minval, const arma::mat &cost, 387 | const arma::ivec &rcov, const arma::ivec &ccov, 388 | const unsigned int &N) 389 | { 390 | for (unsigned int r = 0; r < N; ++r) { 391 | for (unsigned int c = 0; c < N; ++c) { 392 | if (rcov.at(r) == 0 && ccov.at(c) == 0) { 393 | if (minval > cost.at(r, c)) { 394 | minval = cost.at(r, c); 395 | } 396 | } 397 | } 398 | } 399 | } 400 | /** 401 | * `Step 6` looks as follows: 402 | */ 403 | void step_six (unsigned int &step, arma::mat &cost, 404 | const arma::ivec &rcov, const arma::ivec &ccov, 405 | const unsigned int &N) 406 | { 407 | double minval = DBL_MAX; 408 | find_smallest(minval, cost, rcov, ccov, N); 409 | for (unsigned int r = 0; r < N; ++r) { 410 | for (unsigned int c = 0; c < N; ++c) { 411 | if (rcov.at(r) == 1) { 412 | cost.at(r, c) += minval; 413 | } 414 | if (ccov.at(c) == 0) { 415 | cost.at(r, c) -= minval; 416 | } 417 | } 418 | } 419 | step = 4; 420 | } 421 | /** 422 | * At last, we must create a function that enables us to 423 | * jump around the different steps of the algorithm. 424 | * The following code shows the main function of 425 | * the algorithm. It defines also the important variables 426 | * to be passed to the different steps. 427 | */ 428 | arma::umat hungarian(const arma::mat &input_cost) 429 | { 430 | const unsigned int N = input_cost.n_rows; 431 | unsigned int step = 1; 432 | int cpath_0 = 0; 433 | int rpath_0 = 0; 434 | arma::mat cost(input_cost); 435 | arma::umat indM(N, N, arma::fill::zeros); 436 | arma::ivec rcov(N, arma::fill::zeros); 437 | arma::ivec ccov(N, arma::fill::zeros); 438 | arma::imat path(2 * N, 2, arma::fill::zeros); 439 | 440 | indM = arma::zeros(N, N); 441 | bool done = false; 442 | while (!done) { 443 | switch (step) { 444 | case 1: 445 | step_one(step, cost, N); 446 | break; 447 | case 2: 448 | step_two(step, cost, indM, rcov, ccov, N); 449 | break; 450 | case 3: 451 | step_three(step, indM, ccov, N); 452 | break; 453 | case 4: 454 | step_four(step, cost, indM, rcov, ccov, 455 | rpath_0, cpath_0, N); 456 | break; 457 | case 5: 458 | step_five(step, indM, rcov, ccov, 459 | path, rpath_0, cpath_0, N); 460 | break; 461 | case 6: 462 | step_six(step, cost, rcov, ccov, N); 463 | break; 464 | case 7: 465 | done = true; 466 | break; 467 | } 468 | } 469 | return indM; 470 | } 471 | /** 472 | * Note, this function takes the numeric cost matrix as 473 | * an argument and returns the integer indicator matrix 474 | * `indM`. 475 | * 476 | * I chose to set the argument `input_cost` constant and copy 477 | * it for reasons of reusability of the cost matrix in other 478 | * C++ code. When working with rather huge cost matrices, it 479 | * makes sense to make the argument mutable. Though, I used 480 | * _pass-by-reference_ for all the arguments in functions to 481 | * avoid useless copying inside the functions. 482 | * 483 | * To call the main function `hungarian` from R and to use 484 | * our algorithm we construct an `Rcpp Attribute`: 485 | */ 486 | 487 | //' hungarian_cc 488 | //' @param cost cost matrix 489 | // [[Rcpp::export]] 490 | arma::imat hungarian_cc(Rcpp::NumericMatrix cost) 491 | { 492 | // Reuse memory from R 493 | unsigned int N = cost.rows(); 494 | arma::mat arma_cost(cost.begin(), N, N, false, true); 495 | // Call the C++-function 'hungarian' 496 | arma::umat indM = hungarian(arma_cost); 497 | //Convert the result to an Armadillo integer 498 | //matrix - R does not know unsigned integers. 499 | return arma::conv_to::from(indM); 500 | } 501 | 502 | /** 503 | * If we want to provide this function also to other users 504 | * we should probably ensure, that the matrix is square (There 505 | * exists also an extension to rectangular matrices, see 506 | * [Burgeois and Lasalle (1971)](http://dl.acm.org/citation.cfm?id=362945)). 507 | * This can be done easily with the exceptions provided by 508 | * `Rcpp` passed over to R: 509 | */ 510 | 511 | //' hungariansafe_cc 512 | //' @param cost cost matrix 513 | // [[Rcpp::export]] 514 | arma::imat hungariansafe_cc(Rcpp::NumericMatrix cost) 515 | { 516 | unsigned int N = cost.rows(); 517 | unsigned int K = cost.cols(); 518 | if (N != K) { 519 | throw Rcpp::exception("Matrix is not square."); 520 | } 521 | // Reuse memory from R 522 | arma::mat arma_cost(cost.begin(), N, K, false, true); 523 | // Call the C++-function 'hungarian' 524 | arma::umat indM = hungarian(arma_cost); 525 | //convert the result to an Armadillo integer 526 | //matrix - R does not know unsigned integers. 527 | return arma::conv_to::from(indM); 528 | } 529 | 530 | /** 531 | * Note, that it is also possible to use for the attribute 532 | * directly an `Armadillo` matrix, but following the [recent 533 | * discussion on the Rcpp-devel list](http://www.mail-archive.com/rcpp-devel@lists.r-forge.r-project.org/msg05784.html), 534 | * a _pass-by-reference_ of arguments is not yet possible. Romain 535 | * Francois' proposals seem promising, so maybe we can expect 536 | * in some of the next releases _shallow_ copies allowing 537 | * _pass-by-reference_ in `Rcpp Attributes`. 538 | */ 539 | 540 | /** 541 | * Let us begin now with a very easy example that makes clear 542 | * what is going on. 543 | */ 544 | 545 | /*** R 546 | # Check exception: 547 | cost <- matrix(c(1:6), nrow = 3, ncol = 2, byrow = TRUE) 548 | tryCatch(indM <- hungariansafe_cc(cost), error = function(e) {print(e)}) 549 | cost <- matrix(c(1, 2, 2, 4), nrow = 2, ncol = 2, byrow = TRUE) 550 | cost 551 | indM <- hungarian_cc(cost) 552 | indM 553 | min.cost <- sum(indM * cost) 554 | min.cost 555 | */ 556 | 557 | /** 558 | * We can also compute a maximal assignment over a revenue 559 | * matrix by simply considering the difference between 560 | * a big value and this matrix as a cost matrix. 561 | */ 562 | 563 | /*** R 564 | revenues <- matrix(seq(1, 4)) %*% seq(1, 4) 565 | revenues 566 | cost <- 100 - revenues 567 | indM <- hungarian_cc(cost) 568 | indM 569 | max.revenue <- sum(indM * revenues) 570 | max.revenue 571 | */ 572 | 573 | /** 574 | * CoCost matrices containing negative values work as well: 575 | */ 576 | /*** R 577 | cost <- matrix(rnorm(100), ncol = 10, nrow = 10) 578 | cost 579 | indM <- hungarian_cc(cost) 580 | indM 581 | min.cost <- sum(indM * cost) 582 | min.cost 583 | */ 584 | 585 | /** 586 | * Finally let us make some benchmarking. We load the 587 | * rbenchmark package and take now a more _realistic_ cost 588 | * matrix. 589 | */ 590 | /*** R 591 | library(rbenchmark) 592 | cost <- matrix(rpois(10000, 312), ncol = 100, nrow = 100) 593 | benchmark(indM <- hungarian_cc(cost), columns=c('test','replications','elapsed','user.self','sys.self'), replications=1000) 594 | */ 595 | /** 596 | * But we also see, where the limitations of this algorithm lie 597 | * - huge matrices: 598 | */ 599 | 600 | /*** R 601 | cost <- matrix(rpois(250000, 312), ncol = 500, nrow = 500) 602 | system.time(indM <- hungarian_cc(cost)) 603 | */ 604 | 605 | /** 606 | * Some last notes on the structure of the code. I prefer to 607 | * put the code of the algorithm in an header file, e.g. 608 | * `hungarian.h`. And use an `attributes.cpp` (`attributes.cc`) 609 | * file to program the `Rcpp Attributes`. With this, 610 | * I can easily reuse the algorithm in C++ code by simple 611 | * inclusion (`#include "hungarian.h"`) and have a complete 612 | * overview on all the C++ functions I export to R. 613 | */ 614 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(geogrid) 3 | 4 | test_check("geogrid") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-general.R: -------------------------------------------------------------------------------- 1 | context("general") 2 | 3 | test_that("general usage works", { 4 | 5 | input_file <- system.file("extdata", "london_LA.json", package = "geogrid") 6 | original_shapes <- read_polygons(input_file) 7 | 8 | expect_s4_class(original_shapes, "SpatialPolygonsDataFrame") 9 | expect_length(original_shapes, 33) 10 | 11 | new_cells <- calculate_grid(shape = original_shapes, 12 | grid_type = "hexagonal", seed = 1) 13 | 14 | expect_s3_class(new_cells, "geogrid") 15 | expect_s4_class(new_cells[[1]], "SpatialPoints") 16 | expect_s4_class(new_cells[[2]], "SpatialPolygons") 17 | expect_length(new_cells[[2]], 33) 18 | 19 | crds <- round(as.numeric(sp::coordinates(new_cells[[2]])[, 1]), 1) 20 | comp <- c(533504.4, 540491, 523024.4, 530011, 536997.7, 543984.3, 512544.4, 21 | 519531.1, 526517.7, 533504.4, 540491, 547477.7, 516037.7, 523024.4, 22 | 530011, 536997.7, 543984.3, 550971, 512544.4, 519531.1, 526517.7, 23 | 533504.4, 540491, 547477.7, 554464.3, 516037.7, 523024.4, 530011, 24 | 536997.7, 543984.3, 550971, 526517.7, 533504.4) 25 | expect_equivalent(crds, comp) 26 | 27 | grid_shapes <- assign_polygons(original_shapes, new_cells) 28 | expect_s4_class(grid_shapes, "SpatialPolygonsDataFrame") 29 | expect_length(grid_shapes, 33) 30 | # should test the content of grid_shapes to ensure it contains what we expect 31 | }) 32 | -------------------------------------------------------------------------------- /tests/testthat/test-zzz-lintr.R: -------------------------------------------------------------------------------- 1 | # https://github.com/jimhester/lintr 2 | if (requireNamespace("lintr", quietly = TRUE)) { 3 | context("lints") 4 | 5 | line_exclusions <- c("src/RcppExports.cpp", "R/RcppExports.R") 6 | 7 | test_that("package Style", { 8 | lintr::expect_lint_free(cache = TRUE, exclusions = line_exclusions) 9 | }) 10 | } 11 | --------------------------------------------------------------------------------