cartogram icon indicating copy to clipboard operation
cartogram copied to clipboard

Book chapter examples

Open Nowosad opened this issue 2 years ago • 3 comments

@sjewo cartogram_ncont and cartogram_dorling works as expected; however there is some issue withe the cartogram_cont function.

list.of.packages <- c("cartogram", "dplyr", "sf", "tmap")
new.packages <- list.of.packages[!(list.of.packages
                                   %in% installed.packages()[,"Package"])]
if(length(new.packages)) install.packages(new.packages)
lapply(list.of.packages, library, character.only = TRUE)

data("World", package = "tmap")

download.file("https://github.com/elisamarchetto/Cartogram_chapter/raw/main/PresAbs.bias.rds", "PresAbs.bias.rds", mode = "wb")
PresAbs.bias <- readRDS("PresAbs.bias.rds")
head(PresAbs.bias)
#>            x        y Observed
#> 1   40.41667 21.75000        1
#> 2  105.91667 28.08333        1
#> 3 -111.25000 28.75000        1
#> 4   69.75000 37.25000        1
#> 5   87.25000 34.25000        1
#> 6 -102.25000 29.41667        1

PresAbs.bias <- st_as_sf(PresAbs.bias, coords = c("x", "y"), crs = "EPSG:4326")

World_ea <- st_transform(World, "EPSG:8857")
PresAbs.bias <- st_transform(PresAbs.bias, "EPSG:8857")

PresAbs.bias <- st_join(PresAbs.bias, World_ea["iso_a3"])

count.PresAbs.bias <- PresAbs.bias |>
  st_drop_geometry() |>
  group_by(iso_a3) |>
  summarize(countISO = sum(Observed)) 
bias_world <- World_ea |>
  left_join(count.PresAbs.bias, by = "iso_a3") |>
  mutate(countISO = ifelse(is.na(countISO), 0, countISO))

bias_world$countISO2 <- bias_world$countISO*10000

cart_cont <- cartogram_cont(bias_world, "countISO2", itermax = 30, verbose = TRUE)
#> Mean size error for iteration 1: 7678100566380.34
#> Mean size error for iteration 2: 7678100566380.32
#> Mean size error for iteration 3: 7678100566380.31
#> Mean size error for iteration 4: 7678100566380.29
#> Mean size error for iteration 5: 7678100566380.27
#> Mean size error for iteration 6: 7678100566380.26
#> Mean size error for iteration 7: 7678100566380.24
#> Mean size error for iteration 8: 7678100566380.22
#> Mean size error for iteration 9: 7678100566380.21
#> Mean size error for iteration 10: 7678100566380.19
#> Mean size error for iteration 11: 7678100566380.17
#> Mean size error for iteration 12: 7678100566380.15
#> Mean size error for iteration 13: 7678100566380.14
#> Mean size error for iteration 14: 7678100566380.13
#> Mean size error for iteration 15: 7678100566380.11
#> Mean size error for iteration 16: 7678100566380.1
#> Mean size error for iteration 17: 7678100566380.07
#> Mean size error for iteration 18: 7678100566380.06
#> Mean size error for iteration 19: 7678100566380.04
#> Mean size error for iteration 20: 7678100566380.03
#> Mean size error for iteration 21: 7678100566380
#> Mean size error for iteration 22: 7678100566379.99
#> Mean size error for iteration 23: 7678100566379.97
#> Mean size error for iteration 24: 7678100566379.96
#> Mean size error for iteration 25: 7678100566379.94
#> Mean size error for iteration 26: 7678100566379.93
#> Mean size error for iteration 27: 7678100566379.91
#> Mean size error for iteration 28: 7678100566379.88
#> Mean size error for iteration 29: 7678100566379.88
#> Mean size error for iteration 30: 7678100566379.85

map_standard <- tm_shape(bias_world) + 
  tm_polygons("countISO", style = "jenks",
              palette = "cividis") +
  tm_layout(frame = FALSE, legend.position = c("left", "bottom"), 
            legend.width = 1.5, legend.outside = TRUE)  
#> Deprecated tmap v3 code detected. Code translated to v4
map_carto1 <- tm_shape(cart_cont) + 
  tm_polygons("countISO", style = "jenks",
              palette = "cividis") +
  tm_layout(frame = FALSE, legend.position = c("left", "bottom"), 
            legend.width = 1.5, legend.outside = TRUE)  
#> Deprecated tmap v3 code detected. Code translated to v4
tmap_arrange(map_standard, map_carto1)


cart_ncont <- cartogram_ncont(bias_world, "countISO")
tm_shape(bias_world) + 
  tm_borders() +
  tm_shape(cart_ncont) +
  tm_polygons("countISO", style = "jenks", palette = "cividis") +
  tm_layout(frame = FALSE, legend.position = c("left", "bottom"), 
            legend.width = 1.5, legend.outside = TRUE) 
#> Deprecated tmap v3 code detected. Code translated to v4


cart_dorling <- cartogram_dorling(bias_world, "countISO")
tm_shape(bias_world) + tm_borders() +
  tm_shape(cart_dorling) +
  tm_polygons("countISO", style = "jenks", palette = "cividis") +
  tm_layout(frame = FALSE, legend.position = c("left", "bottom"),
            legend.width = 1.5, legend.outside = TRUE)
#> Deprecated tmap v3 code detected. Code translated to v4

Nowosad avatar Oct 13 '23 10:10 Nowosad

cartogram_cont has some difficulties with zero inflated data and one needs to raise the treshold parameter to to adjust for this.

cart_cont <- cartogram_cont(bias_world, "countISO2", itermax = 30, threshold = 0.16)

map_standard <- tm_shape(bias_world) + 
  tm_polygons("countISO", style = "jenks",
              palette = "cividis") +
  tm_layout(frame = FALSE, legend.show = FALSE)  

map_carto1 <- tm_shape(cart_cont) + 
  tm_polygons("countISO", style = "jenks",
              palette = "cividis") +
  tm_layout(frame = FALSE, , legend.show = FALSE)  

tmap_arrange(map_standard, map_carto1)

threashold016

cartogram_cont might need better documentation oder default settings.

sjewo avatar Oct 13 '23 11:10 sjewo

Great!

@sjewo have you consider automatic adaptation of the threshold value based on the proportion of 0's?

Nowosad avatar Oct 13 '23 11:10 Nowosad

@elisamarchetto please update the code in the chapter to include threshold = 0.16.

Nowosad avatar Oct 13 '23 15:10 Nowosad