choropleth maps using R leaflet

preliminary_census_counts_country_birth.R

#################################################################################
# England And Wales * Preliminary Census 2021 Counts by (some) Country of Birth #
#################################################################################
# ONS data: https://www.ons.gov.uk/peoplepopulationandcommunity/populationandmigration/populationestimates/adhocs/14354ct210001

library(data.table)
library(dplyr)
library(sf)
library(leaflet)

# download population count
tmpf <- tempfile()
url <- 'https://www.ons.gov.uk/file?uri=/peoplepopulationandcommunity/populationandmigration/populationestimates/adhocs/14354ct210001/ct210001.xlsx'
download.file(url, destfile = tmpf)
y <- as.data.table(readxl::read_xlsx(tmpf, 2, skip = 9))
y <- y[!is.na(Area)][, Area := NULL]
setnames(y, 'Code', 'LAD')
y <- melt(y, id.vars = 'LAD', variable.name = 'country')[value > 0][, value := as.numeric(value)]

# download polygons
tmpd <- tempdir()
url <- 'https://opendata.arcgis.com/api/v3/datasets/0f131e03df73415b824a1c214594eeab_0/downloads/data?format=shp&spatialRefId=27700'
download.file(url, destfile = tmpf)
unzip(tmpf, exdir = tmpd)
fnames <- unzip(tmpf, list = TRUE)$Name
yb <- st_read(tmpd, gsub('.shp', '', fnames[grepl('.shp', fnames)]))

# clean polygons
yb <- yb |> select(names(yb)[grepl(paste0('^LAD.*CD$|NM$'), toupper(names(yb)))]) |>
          rename('LAD' := 1, 'LADn' := 2) |>
          filter(substr(LAD, 1, 1) %in% c('E', 'W')) |>
          rmapshaper::ms_simplify() |>
          st_transform(4326)

# build polygons labels >>> TO DO <<<
lbls <- htmltools::HTML()

# basemap
ym <- leaflet() |> addProviderTiles(providers$CartoDB.PositronNoLabels)

# add nationalities
grps <- NULL
for(cnt in levels(y$country)){
    ybc <- merge(yb, y[country == cnt])  
    yp <- colorNumeric('Reds', ybc$value)
    grp <- paste0(cnt, ': ', formatC(as.integer(sum(ybc$value)), big.mark = ','))
    grps <- c(grps, grp)
    ym <- ym |> 
              addPolygons(
                  data = ybc,
                  smoothFactor = 0.2,
                  group = grp,
                  # stroke = FALSE,
                  color = 'black',
                  weight = 0.3,
                  fillColor = ~yp(value),
                  fillOpacity = 0.4,
                  label = ~paste0(LADn, ': ', formatC(value, big.mark = ',')), 
                  highlightOptions = highlightOptions(color = '#67000d', weight = 6, bringToFront = TRUE, opacity = 1)
              ) |>
              addLegend(
                  position = 'bottomright', 
                  group = grp,
                  className = paste('info legend', cnt),
                  pal = yp, 
                  values = ybc$value,
                  title = cnt,
                  opacity = 1
              )
}

# add menu and title
ym <- ym |> 
          addLayersControl(grps, options = layersControlOptions(collapsed = FALSE)) |>
          htmlwidgets::onRender("
              function(el, x) {
                  var updateLegend = function () {
                      var selectedGroup = document.querySelectorAll('input:checked')[0].nextSibling.innerText.substr(1).replace(/[^a-zA-Z]+/g, '');
                      document.querySelectorAll('.legend').forEach( a => a.hidden=true );
                      document.querySelectorAll('.legend').forEach(
                          l => { if (l.classList.contains(selectedGroup)) l.hidden=false; }
                      );
                  };
                  updateLegend();
                  this.on('baselayerchange', el => updateLegend());
              }
          ") |> 
          # addControl(, position = "topleft", className="map-title") |>        #  >>> TO DO <<<
          # addControl(, position = "bottomleft", className="map-title") |>     # >>> TO DO <<<
          showGroup(grp)

# view
ym
      
# save and copy to shiny server
htmlwidgets::saveWidget(ym, '~/gists/preliminary_census_counts_country_birth.html')
system('rm -rf ~/gists/preliminary_census_counts_country_birth_files/')
system('cp ~/gists/preliminary_census_counts_country_birth.html /srv/shiny-server/uk_pop_precensus_country/index.html')

# clean env
unlink(tmpf)
unlink(tmpd)
rm(list = ls())
gc()