TidyTuesday Kenya

Aim

Map the households growing permanent crops by type and county.

Methods

Load a bunch of libraries

Wrangle the shape file from the rKenyaCensus package

# Wrangle shapefile
load('KenyaCounties_SHP.rda')
kenya <- sf::st_as_sf(KenyaCounties_SHP) %>% 
  sf::st_transform( crs = "+proj=longlat +datum=WGS84") %>% 
  rmapshaper::ms_simplify(keep = 0.1, keep_shapes = T)

## Loading required package: sp

Import the crop data

Create some summary data and objects:

1. The number of crops types; greater values means more crops in a county
   
2. A HTML table for the leaflet popup; the number of households growing each crop

# N crop types
n_crop_types <-
  crops %>% 
  pivot_longer(-SubCounty) %>% 
  filter(!is.na(value)) %>% 
  count(SubCounty, name = 'n_crop_types')

# HTML table for popup
# * Split by county and make a list-column of HTML tables
crop_split <-
  crops %>%
  group_by(SubCounty) %>% 
  group_split()

crop_tbls <-  
  tibble(SubCounty = sapply(crop_split, pluck, 1),
         tbl = lapply(crop_split, function(split){
           tbl <-
             split %>% 
             select(-SubCounty) %>% 
             pivot_longer(everything(), names_to = 'Crop type', values_to = 'Population') %>% 
             replace_na(list(Population= 0)) %>% 
             kable(escape = F, align = 'r') %>% 
             kable_styling(bootstrap_options = c('striped', 'condensed')) %>% 
             row_spec(0, align = 'c', extra_css  =  'background-color: rgba(0, 140, 81, 0.5);') %>% 
             row_spec(ncol(split) - 1,extra_css = 'border-bottom: 1px solid #E0E0E0')

           htmltools::tagList(
             htmltools::span(split$SubCounty[1], 
                             style = 'font-size: 1.25em; margin: 2px; margin-left:0; margin-bottom: 5px; font-weight:bold;'),
             HTML(tbl)) %>%
             as.character()
         })
  ) 

Join data to the shapefile

# Join data
kenya_plus <-
  left_join(kenya, crops,
            by = c('County' = 'SubCounty')) %>% 
  left_join(n_crop_types, 
            by = c('County' = 'SubCounty')) %>% 
  left_join(crop_tbls,
            by = c('County' = 'SubCounty')) %>% 
  # need to fix missing join
  filter(!is.na(n_crop_types))

Prepare the leaflet plot. I tried to use the colours of the Kenyan flag.

# Colours
kenya_colours = c(red = '#922529',
                  green = '#008C51',
                  black = '#000000',
                  white = '#FFFFFF')

n_crop_pal <-
  colorNumeric(kenya_colours[c('white', 'green')],
               domain = kenya_plus$n_crop_types)

# The plot
leaflet(kenya_plus) %>% 
  addProviderTiles("Stamen.Watercolor", 
                   options = providerTileOptions(opacity = 0.25)) %>%
  addPolygons(color = '#922529',
              weight = 0.25,
              opacity = 1,
              fillColor = ~n_crop_pal(n_crop_types),
              fillOpacity = 0.5,
              #label = ~County,
              popup = ~tbl,
              highlightOptions = highlightOptions(weight = 3,
                                                  fillOpacity = 1,
                                                  bringToFront = T)) %>% 
  addLegend(title = 'Number of crops',
            position = 'bottomright', 
            pal = n_crop_pal, values = ~n_crop_types) %>% 
  leaflet.extras::addBootstrapDependency()