Displaying totals for regions outside the USA on a USA specific choropleth map

Hello,

I'm trying to reproduce the following map in R:
image

I got some help. Unfortunately, I'm running into two other issues:

  1. [Resolved] There is a lot of white space on the map. I would like to zoom into the main USA map. The tigris::shift_geometry() partially solved the problem by pulling Alaska, Hawaii, and Puerto Rico closer.

  2. [Not Resolved] I need some way to include totals for regions outside of the USA. In the example map, the OTHER block serves to visualize the combined total for regions outside the USA. I tried to calculate the total for all non-US regions and combine the result with the US regions data.

Here is my attempt:

options(scipen = 999)
library(tidyverse)
library(tigris)
#> To enable 
#> caching of data, set `options(tigris_use_cache = TRUE)` in your R script or .Rprofile.
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(forcats)
library(ggrepel)
library(tidygeocoder)
library(knitr)

# Generate Data
data <- tibble::tribble(
                  ~lon,       ~lat,
            -98.133208, 11.4326077,
            -89.552784,  11.634501,
           -62.2766186, 44.5090949,
           -65.3279894, 33.1067754,
           -67.7095365, 44.6294348,
            -96.552784,  35.634501,
           -97.3279093, 29.7724417,
           -82.6363869, 28.2949194,
           -80.2061931, 46.0133808,
            -72.014118, 32.4681642,
           -76.2531465, 47.3666368,
           -82.1650991, 46.7758541,
             -5.696645,  11.945587,
           -112.707349, 38.5205043,
           -63.0884036, 52.3930959,
            -87.128901, 39.1242719,
           -65.1626756, 31.3463503,
           -94.3254958, 40.3274999,
             -98.56121, 42.5770056,
          -115.4429944, 46.1502862,
          -117.7901088, 30.6913751,
           -63.7389596, 54.6584068,
          -109.1147095, 24.2156978,
          -119.8340735, 22.6832497,
          -117.8780275, 37.7311394,
           -67.1763467, 38.5861576,
           -96.4427769,   25.14644,
           -78.0814292, 15.5386936,
           -74.4185584, 34.5834425,
           -77.4185584, 36.5834425,
           -79.4185584, 37.5834425,
            -63.121085, 33.9241038,
            -88.121085, 41.9241038,
          -112.7260713,  40.836309,
            -90.552784,  30.634501,
           -109.552784,  12.634501,
           -73.9224329, 48.6153549
          ) 

data <-
  data %>% sample_n(100, replace = TRUE) %>% 
  mutate(
    total = round( runif(nrow(.), min = 100, max = 10000), digits = 0) ,
    lon =  lon + round( runif(nrow(.), min = -10, max = 10), digits = 0),
    lat =  lat + round( runif(nrow(.), min = -10, max = 10), digits = 0)
  ) 

data <- data %>%
  reverse_geocode(
    lat = lat,
    long = lon,
    method = 'arcgis',
    full_results = TRUE,
    return_input = TRUE,
    return_coords = FALSE
  )

data <- data %>% mutate(country = if_else(CountryCode == "USA", "USA", "Other"), state = if_else(CountryCode == "USA", Region, "International"))



# Download state data and filter states
sts <- states(cb = FALSE, resolution = "20m") %>%
  shift_geometry()
#>   |                                                                              |                                                                      |   0%  |                                                                              |                                                                      |   1%  |                                                                              |=                                                                     |   1%  |                                                                              |=                                                                     |   2%  |                                                                              |==                                                                    |   2%  |                                                                              |==                                                                    |   3%  |                                                                              |===                                                                   |   4%  |                                                                              |===                                                                   |   5%  |                                                                              |====                                                                  |   6%  |                                                                              |=======                                                               |   9%  |                                                                              |=======                                                               |  10%  |                                                                              |========                                                              |  11%  |                                                                              |========                                                              |  12%  |                                                                              |=========                                                             |  12%  |                                                                              |=========                                                             |  13%  |                                                                              |==========                                                            |  15%  |                                                                              |===========                                                           |  16%  |                                                                              |============                                                          |  17%  |                                                                              |=============                                                         |  18%  |                                                                              |=============                                                         |  19%  |                                                                              |==============                                                        |  20%  |                                                                              |===============                                                       |  21%  |                                                                              |================                                                      |  23%  |                                                                              |================                                                      |  24%  |                                                                              |==================                                                    |  26%  |                                                                              |===================                                                   |  27%  |                                                                              |====================                                                  |  29%  |                                                                              |=====================                                                 |  30%  |                                                                              |======================                                                |  32%  |                                                                              |=======================                                               |  33%  |                                                                              |========================                                              |  34%  |                                                                              |========================                                              |  35%  |                                                                              |=========================                                             |  35%  |                                                                              |==========================                                            |  36%  |                                                                              |===========================                                           |  39%  |                                                                              |==============================                                        |  42%  |                                                                              |==============================                                        |  43%  |                                                                              |===============================                                       |  44%  |                                                                              |===============================                                       |  45%  |                                                                              |================================                                      |  46%  |                                                                              |==================================                                    |  48%  |                                                                              |===================================                                   |  50%  |                                                                              |====================================                                  |  51%  |                                                                              |====================================                                  |  52%  |                                                                              |=====================================                                 |  53%  |                                                                              |=======================================                               |  56%  |                                                                              |========================================                              |  57%  |                                                                              |=========================================                             |  59%  |                                                                              |==========================================                            |  60%  |                                                                              |==========================================                            |  61%  |                                                                              |===========================================                           |  61%  |                                                                              |===========================================                           |  62%  |                                                                              |============================================                          |  62%  |                                                                              |============================================                          |  63%  |                                                                              |=============================================                         |  64%  |                                                                              |==============================================                        |  66%  |                                                                              |===============================================                       |  67%  |                                                                              |================================================                      |  68%  |                                                                              |================================================                      |  69%  |                                                                              |=================================================                     |  70%  |                                                                              |=================================================                     |  71%  |                                                                              |==================================================                    |  71%  |                                                                              |===================================================                   |  73%  |                                                                              |====================================================                  |  74%  |                                                                              |====================================================                  |  75%  |                                                                              |=====================================================                 |  75%  |                                                                              |======================================================                |  77%  |                                                                              |======================================================                |  78%  |                                                                              |=======================================================               |  78%  |                                                                              |=======================================================               |  79%  |                                                                              |========================================================              |  79%  |                                                                              |=========================================================             |  81%  |                                                                              |=========================================================             |  82%  |                                                                              |==========================================================            |  83%  |                                                                              |==========================================================            |  84%  |                                                                              |===========================================================           |  84%  |                                                                              |===========================================================           |  85%  |                                                                              |============================================================          |  85%  |                                                                              |============================================================          |  86%  |                                                                              |=============================================================         |  86%  |                                                                              |=============================================================         |  87%  |                                                                              |=============================================================         |  88%  |                                                                              |==============================================================        |  88%  |                                                                              |==============================================================        |  89%  |                                                                              |===============================================================       |  89%  |                                                                              |===============================================================       |  90%  |                                                                              |================================================================      |  91%  |                                                                              |================================================================      |  92%  |                                                                              |=================================================================     |  93%  |                                                                              |==================================================================    |  94%  |                                                                              |==================================================================    |  95%  |                                                                              |===================================================================   |  95%  |                                                                              |===================================================================   |  96%  |                                                                              |====================================================================  |  96%  |                                                                              |====================================================================  |  97%  |                                                                              |===================================================================== |  98%  |                                                                              |===================================================================== |  99%  |                                                                              |======================================================================| 100%
# Summarize to DIVISION polygons, see sf::st_union
REGION <- sts %>%
  group_by(REGION) %>% 
  summarize()  %>%
  mutate(REGION = recode(REGION, "1"="Northeast",
                         "2"="Midwest",
                         "3"="South",
                         "4"="West",
                         "9"="Puerto Rico"))#%>% as_tibble()


# spatial points using your data
data_pt <- sf::st_as_sf(data, coords = c("lon", "lat"), crs = 4269)%>%
  shift_geometry()%>% 
  st_transform(4269)# %>% as_tibble()
#> Warning: None of your features are in Alaska, Hawaii, or Puerto Rico, so no geometries will be shifted.
#> Transforming your object's CRS to 'ESRI:102003'
# join points to region spatially
# then make non spatial
# summarise to get total
region_counts <- REGION %>% 
  st_transform(4269) %>% 
  st_intersection(data_pt) %>% 
  st_set_geometry(NULL) %>% 
  group_by(REGION) %>% 
  summarise(total = sum(total))
#> Warning: attribute variables are assumed to be spatially constant throughout all
#> geometries
# join counts to region, spatial data
region_data <- left_join(REGION, region_counts) %>% 
  st_transform(5070)
#> Joining, by = "REGION"
# sum total for regions outside USA

other <-  data %>% group_by(country) %>% summarise(total= sum(total)) %>% filter(country=="Other") %>% rename("REGION" = country)

region_data <- full_join(region_data, other)
#> Joining, by = c("REGION", "total")
# # Plot it

ggplot() +
  geom_sf(data = region_data, fill = NA, color = "black", size = 0.1) +
  geom_sf(data = region_data, aes(fill = total), color = NA) +
  theme_void(base_size = 16) +
  labs(title = "Total by Region",
       fill = "Total  ",
       caption = "Note: Alaska, Hawaii, and Puerto Rico are shifted and not to scale.") +
  geom_sf_label(data = region_data,aes(label = paste(REGION,  sep = "") ), colour = "black") +
  theme(plot.title = element_text(hjust = 0.5))
#> Warning: Removed 1 rows containing missing values (geom_label).

region_data %>% kable()
REGION geometry total
Northeast MULTIPOLYGON (((2002871 227… 7065
Midwest POLYGON ((1057577 2178191, … 40175
South MULTIPOLYGON (((1331106 268… 66847
West MULTIPOLYGON (((-2614144 -8… 66722
Puerto Rico MULTIPOLYGON (((3369551 -16… NA
Other GEOMETRYCOLLECTION EMPTY 309551

Created on 2021-09-19 by the reprex package (v2.0.1)

I was able to fix the map positioning by adding coord_sf(crs = st_crs(2163),xlim = c(-2500000, 2500000), ylim = c(-2300000, 730000))+ to the plot.

options(scipen = 999)
library(tidyverse)
library(tigris)
#> To enable 
#> caching of data, set `options(tigris_use_cache = TRUE)` in your R script or .Rprofile.
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(forcats)
library(ggrepel)
library(tidygeocoder)
library(knitr)

# Generate Data
data <- tibble::tribble(
                  ~lon,       ~lat,
            -98.133208, 11.4326077,
            -89.552784,  11.634501,
           -62.2766186, 44.5090949,
           -65.3279894, 33.1067754,
           -67.7095365, 44.6294348,
            -96.552784,  35.634501,
           -97.3279093, 29.7724417,
           -82.6363869, 28.2949194,
           -80.2061931, 46.0133808,
            -72.014118, 32.4681642,
           -76.2531465, 47.3666368,
           -82.1650991, 46.7758541,
             -5.696645,  11.945587,
           -112.707349, 38.5205043,
           -63.0884036, 52.3930959,
            -87.128901, 39.1242719,
           -65.1626756, 31.3463503,
           -94.3254958, 40.3274999,
             -98.56121, 42.5770056,
          -115.4429944, 46.1502862,
          -117.7901088, 30.6913751,
           -63.7389596, 54.6584068,
          -109.1147095, 24.2156978,
          -119.8340735, 22.6832497,
          -117.8780275, 37.7311394,
           -67.1763467, 38.5861576,
           -96.4427769,   25.14644,
           -78.0814292, 15.5386936,
           -74.4185584, 34.5834425,
           -77.4185584, 36.5834425,
           -79.4185584, 37.5834425,
            -63.121085, 33.9241038,
            -88.121085, 41.9241038,
          -112.7260713,  40.836309,
            -90.552784,  30.634501,
           -109.552784,  12.634501,
           -73.9224329, 48.6153549
          ) 

data <-
  data %>% sample_n(100, replace = TRUE) %>% 
  mutate(
    total = round( runif(nrow(.), min = 100, max = 10000), digits = 0) ,
    lon =  lon + round( runif(nrow(.), min = -10, max = 10), digits = 0),
    lat =  lat + round( runif(nrow(.), min = -10, max = 10), digits = 0)
  ) 

data <- data %>%
  reverse_geocode(
    lat = lat,
    long = lon,
    method = 'arcgis',
    full_results = TRUE,
    return_input = TRUE,
    return_coords = FALSE
  )

data <- data %>% mutate(country = if_else(CountryCode == "USA", "USA", "Other"), state = if_else(CountryCode == "USA", Region, "International"))



# Download state data and filter states
sts <- states(cb = FALSE, resolution = "20m") %>%
  shift_geometry()
#>   |                                                                              |                                                                      |   0%  |                                                                              |=                                                                     |   1%  |                                                                              |=                                                                     |   2%  |                                                                              |==                                                                    |   2%  |                                                                              |==                                                                    |   3%  |                                                                              |===                                                                   |   4%  |                                                                              |===                                                                   |   5%  |                                                                              |====                                                                  |   5%  |                                                                              |====                                                                  |   6%  |                                                                              |=====                                                                 |   7%  |                                                                              |=====                                                                 |   8%  |                                                                              |======                                                                |   8%  |                                                                              |=======                                                               |   9%  |                                                                              |=======                                                               |  10%  |                                                                              |========                                                              |  11%  |                                                                              |========                                                              |  12%  |                                                                              |=========                                                             |  12%  |                                                                              |=========                                                             |  13%  |                                                                              |==========                                                            |  14%  |                                                                              |==========                                                            |  15%  |                                                                              |===========                                                           |  15%  |                                                                              |===========                                                           |  16%  |                                                                              |============                                                          |  16%  |                                                                              |============                                                          |  17%  |                                                                              |=============                                                         |  18%  |                                                                              |=============                                                         |  19%  |                                                                              |==============                                                        |  20%  |                                                                              |===============                                                       |  21%  |                                                                              |===============                                                       |  22%  |                                                                              |================                                                      |  22%  |                                                                              |================                                                      |  23%  |                                                                              |=================                                                     |  24%  |                                                                              |=================                                                     |  25%  |                                                                              |==================                                                    |  25%  |                                                                              |==================                                                    |  26%  |                                                                              |===================                                                   |  27%  |                                                                              |====================                                                  |  28%  |                                                                              |====================                                                  |  29%  |                                                                              |=====================                                                 |  30%  |                                                                              |======================                                                |  31%  |                                                                              |======================                                                |  32%  |                                                                              |=======================                                               |  32%  |                                                                              |=======================                                               |  33%  |                                                                              |========================                                              |  34%  |                                                                              |=========================                                             |  35%  |                                                                              |=========================                                             |  36%  |                                                                              |==========================                                            |  37%  |                                                                              |==========================                                            |  38%  |                                                                              |===========================                                           |  39%  |                                                                              |============================                                          |  40%  |                                                                              |============================                                          |  41%  |                                                                              |=============================                                         |  42%  |                                                                              |==============================                                        |  43%  |                                                                              |===============================                                       |  44%  |                                                                              |===============================                                       |  45%  |                                                                              |================================                                      |  45%  |                                                                              |================================                                      |  46%  |                                                                              |=================================                                     |  47%  |                                                                              |=================================                                     |  48%  |                                                                              |==================================                                    |  49%  |                                                                              |===================================                                   |  50%  |                                                                              |===================================                                   |  51%  |                                                                              |====================================                                  |  51%  |                                                                              |====================================                                  |  52%  |                                                                              |=====================================                                 |  52%  |                                                                              |=====================================                                 |  53%  |                                                                              |======================================                                |  54%  |                                                                              |======================================                                |  55%  |                                                                              |=======================================                               |  56%  |                                                                              |========================================                              |  57%  |                                                                              |=========================================                             |  58%  |                                                                              |=========================================                             |  59%  |                                                                              |==========================================                            |  59%  |                                                                              |==========================================                            |  60%  |                                                                              |==========================================                            |  61%  |                                                                              |===========================================                           |  61%  |                                                                              |===========================================                           |  62%  |                                                                              |============================================                          |  62%  |                                                                              |============================================                          |  63%  |                                                                              |=============================================                         |  64%  |                                                                              |=============================================                         |  65%  |                                                                              |==============================================                        |  65%  |                                                                              |==============================================                        |  66%  |                                                                              |===============================================                       |  67%  |                                                                              |===============================================                       |  68%  |                                                                              |================================================                      |  68%  |                                                                              |================================================                      |  69%  |                                                                              |=================================================                     |  69%  |                                                                              |=================================================                     |  70%  |                                                                              |=================================================                     |  71%  |                                                                              |==================================================                    |  71%  |                                                                              |==================================================                    |  72%  |                                                                              |===================================================                   |  73%  |                                                                              |====================================================                  |  74%  |                                                                              |====================================================                  |  75%  |                                                                              |=====================================================                 |  75%  |                                                                              |=====================================================                 |  76%  |                                                                              |======================================================                |  76%  |                                                                              |======================================================                |  77%  |                                                                              |=======================================================               |  78%  |                                                                              |=======================================================               |  79%  |                                                                              |========================================================              |  79%  |                                                                              |========================================================              |  80%  |                                                                              |========================================================              |  81%  |                                                                              |=========================================================             |  81%  |                                                                              |=========================================================             |  82%  |                                                                              |==========================================================            |  82%  |                                                                              |==========================================================            |  83%  |                                                                              |===========================================================           |  84%  |                                                                              |===========================================================           |  85%  |                                                                              |============================================================          |  85%  |                                                                              |============================================================          |  86%  |                                                                              |=============================================================         |  87%  |                                                                              |=============================================================         |  88%  |                                                                              |==============================================================        |  88%  |                                                                              |==============================================================        |  89%  |                                                                              |===============================================================       |  90%  |                                                                              |===============================================================       |  91%  |                                                                              |================================================================      |  91%  |                                                                              |================================================================      |  92%  |                                                                              |=================================================================     |  92%  |                                                                              |=================================================================     |  93%  |                                                                              |==================================================================    |  94%  |                                                                              |==================================================================    |  95%  |                                                                              |===================================================================   |  95%  |                                                                              |===================================================================   |  96%  |                                                                              |====================================================================  |  96%  |                                                                              |====================================================================  |  97%  |                                                                              |====================================================================  |  98%  |                                                                              |===================================================================== |  98%  |                                                                              |===================================================================== |  99%  |                                                                              |======================================================================| 100%
# Summarize to DIVISION polygons, see sf::st_union
REGION <- sts %>%
  group_by(REGION) %>% 
  summarize()  %>%
  mutate(REGION = recode(REGION, "1"="Northeast",
                         "2"="Midwest",
                         "3"="South",
                         "4"="West",
                         "9"="Puerto Rico"))#%>% as_tibble()


# spatial points using your data
data_pt <- sf::st_as_sf(data, coords = c("lon", "lat"), crs = 4269)%>%
  shift_geometry()%>% 
  st_transform(4269)# %>% as_tibble()
#> Warning: None of your features are in Alaska, Hawaii, or Puerto Rico, so no geometries will be shifted.
#> Transforming your object's CRS to 'ESRI:102003'
# join points to region spatially
# then make non spatial
# summarise to get total
region_counts <- REGION %>% 
  st_transform(4269) %>% 
  st_intersection(data_pt) %>% 
  st_set_geometry(NULL) %>% 
  group_by(REGION) %>% 
  summarise(total = sum(total))
#> Warning: attribute variables are assumed to be spatially constant throughout all
#> geometries
# join counts to region, spatial data
region_data <- left_join(REGION, region_counts) %>% 
  st_transform(5070)
#> Joining, by = "REGION"
# sum total for regions outside USA

other <-  data %>% group_by(country) %>% summarise(total= sum(total)) %>% filter(country=="Other") %>% rename("REGION" = country)

region_data <- full_join(region_data, other)
#> Joining, by = c("REGION", "total")
# # Plot it

ggplot() +
  geom_sf(data = region_data, fill = NA, color = "black", size = 0.1) +
  geom_sf(data = region_data, aes(fill = total), color = NA) +
  theme_void(base_size = 16) +
  labs(title = "Total by Region",
       fill = "Total  ",
       caption = "Note: Alaska, Hawaii, and Puerto Rico are shifted and not to scale.") +
  coord_sf(crs = st_crs(2163),xlim = c(-2500000, 2500000), ylim = c(-2300000, 730000))+
  geom_sf_label(data = region_data,aes(label = paste(REGION,  sep = "") ), colour = "black") +
  theme(plot.title = element_text(hjust = 0.5))
#> Warning: Removed 1 rows containing missing values (geom_label).

kable(region_data)
REGION geometry total
Northeast MULTIPOLYGON (((2002871 227… 17711
Midwest POLYGON ((1057577 2178191, … 33075
South MULTIPOLYGON (((1331106 268… 49231
West MULTIPOLYGON (((-2614144 -8… 117025
Puerto Rico MULTIPOLYGON (((3369551 -16… 5779
Other GEOMETRYCOLLECTION EMPTY 315834

Created on 2021-09-20 by the reprex package (v2.0.1)

I'm now trying to use mutate and case_when to manually set the geometry (=GEOMETRYCOLLECTION EMPTY) for the "Other" Region:

region_data <-
  region_data %>% mutate(geometry = case_when(
    REGION == "Other" ~ st_cast(st_sfc(st_multipoint(matrix(
      c(-26,-25, 25, 70), ncol = 2
    ), dim = "XY"), crs = 2163), "GEOMETRY"),
    TRUE ~ st_cast(geometry, "GEOMETRY")
  )) %>%
  st_transform(5070)

Unfortunately, using the updated data, results in :

Error in FUN(X[[i]], ...) : invalid 'times' argument

I was thinking that the points needed to be a polygon instead, but it comes up with a different error, so unlikely.

points <- st_sfc(st_multipoint(matrix(c(-26, 25,
                                        -25, 26,
                                        -25, 25),
                                        nrow = 3,
                                        byrow = TRUE),
                               dim = "XY"), crs = 2163)

poly <- st_cast(points, "POLYGON")
region_data <- region_data %>% mutate(geometry = case_when(
  REGION == "Other" ~ st_cast(poly, "GEOMETRY"),
  TRUE ~ st_cast(geometry, "GEOMETRY")
  )) %>%
  st_transform(5070)
1 Like

@williaml , thanks for continuing to help me with this plot! Apologies, I obviously have a lot of basics to learn here...

I've applied your code to the data going into the map and and removed #coord_sf(crs = st_crs(2163),xlim = c(-2500000, 2500000), ylim = c(-2300000, 730000))+ from the plot to show everything.

The label for "Other" now shows on the map.

However, I was hoping the label will show in a color-filled rectangle to indicate the total outside of the USA. Like in this manual edit:

Sort of like this perhaps? I changed this xlim = c(-2500000, 3000000). I also just drew the polygon in QGIS, then just got the coords to put in here.

points_5070 <- structure(c(1667713.82544079, 1661187.49044641, 3048033.67675197,
                           3041507.3417576, 3041507.3417576, 1667713.82544079, 751602.545187886,
                           1267183.00974384, 1270446.17724103, 748339.377690696, 748339.377690696,
                           751602.545187886), .Dim = c(6L, 2L))

points <- st_sfc(st_multipoint(points_5070), crs = 5070)
poly <- st_cast(points, "POLYGON")

region_data <- region_data %>% mutate(geometry = case_when(
  REGION == "Other" ~ st_cast(poly, "GEOMETRY"),
  TRUE ~ st_cast(geometry, "GEOMETRY")
)) %>%
  st_transform(5070)

# I edited the xlim in the coords
ggplot() +
  geom_sf(data = region_data, fill = NA, color = "black", size = 0.1) +
  geom_sf(data = region_data, aes(fill = total), color = NA) +
  theme_void(base_size = 16) +
  labs(title = "Total by Region",
       fill = "Total  ",
       caption = "Note: Alaska, Hawaii, and Puerto Rico are shifted and not to scale.") +
  coord_sf(crs = st_crs(2163),xlim = c(-2500000, 3000000), ylim = c(-2300000, 730000))+
  geom_sf_label(data = region_data,aes(label = paste(REGION,  sep = "") ), colour = "black") +
  theme(plot.title = element_text(hjust = 0.5))

image

1 Like

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.