In-class Exercise 3: Analytical Mapping

Loading packages and data

pacman::p_load(tmap, tidyverse, sf)

Import data

NGA_wp <- read_rds("data/rds/NGA_wp.rds")

Basic Choropleth Mapping

Distribution of non-functional water points by LGA

p1 <- tm_shape(NGA_wp) +
  tm_fill("wp_functional",
          n = 10,
          style = "equal",
          palette = "Blues") +
  tm_borders(lwd = 0.1,
             alpha = 1) +
  tm_layout(main.title = "Distribution of functional water point by LGAs",
            legend.outside = FALSE)

p2 <- tm_shape(NGA_wp) +
  tm_fill("total_wp",
          n = 10,
          style = "equal",
          palette = "Blues") +
  tm_borders(lwd = 0.1,
             alpha = 1) +
  tm_layout(main.title = "Distribution of total  water point by LGAs",
            legend.outside = FALSE)

Explanation: tm_shape(spatial data)

tmap_arrange(p2, p1, nrow = 1)

Choropleth Map for Rates

Compare the proportion of functional water points to the proportion of non-functional water points.

NGA_wp <- NGA_wp %>%
  mutate(pct_functional = wp_functional/total_wp) %>%
  mutate(pct_nonfunctional = wp_nonfunctional/total_wp)

Plotting map of rate

tm_shape(NGA_wp) +
  tm_fill("pct_functional",
          n = 10,
          style = "equal",
          palette = "Blues",
          legend.hist = TRUE) +
  tm_borders(lwd = 0.1,
             alpha = 1) +
  tm_layout(main.title = "Rate map of functional water point by LGAs",
            legend.outside = TRUE)

Extreme Value Maps

Identify outliers by highlighting extreme values at the lower and upper end of the scale.

Percentile map

Data Preparation

1. Exclude records with NA:

NGA_wp <- NGA_wp %>%
  drop_na()

2. Create customers classification and extract values

percent <- c(0,.01,.1,.5,.9,.99,1)
var <- NGA_wp["pct_functional"] %>%
  st_set_geometry(NULL)
quantile(var[,1], percent)

       0%        1%       10%       50%       90%       99%      100% 
0.0000000 0.0000000 0.2169811 0.4791667 0.8611111 1.0000000 1.0000000 

Creating functions

get.var function

R function to extract a variable as a vector out of an sf dataframe.

• arguments:

  • vname (as character, in quotes)
  • df: name of sf data frame

• returns

  • v: vector with values (without a column name)

  get.var <- function(vname,df) {
    v <- df[vname] %>% 
      st_set_geometry(NULL)
    v <- unname(v[,1])
    return(v)
  }

Percentile mapping function

percentmap <- function(vnam, df, legtitle=NA, mtitle="Percentile Map"){
  percent <- c(0,.01,.1,.5,.9,.99,1)
  var <- get.var(vnam, df)
  bperc <- quantile(var, percent)
  tm_shape(df) +
  tm_polygons() +
  tm_shape(df) +
     tm_fill(vnam,
             title=legtitle,
             breaks=bperc,
             palette="Blues",
          labels=c("< 1%", "1% - 10%", "10% - 50%", "50% - 90%", "90% - 99%", "> 99%"))  +
  tm_borders() +
  tm_layout(main.title = mtitle, 
            title.position = c("right","bottom"))
}

Test the percentile mapping function

percentmap("wp_nonfunctional", NGA_wp)

Box map

ggplot(data = NGA_wp,
       aes(x = "",
           y = wp_nonfunctional)) +
  geom_boxplot()

boxbreaks function

• arguments:
  • v: vector with observations
  • mult: multiplier for IQR (default 1.5)
• returns:
  • bb: vector with 7 break points compute quartile and fences

boxbreaks <- function(v,mult=1.5) {
  qv <- unname(quantile(v))
  iqr <- qv[4] - qv[2]
  upfence <- qv[4] + mult * iqr
  lofence <- qv[2] - mult * iqr
  # initialize break points vector
  bb <- vector(mode="numeric",length=7)
  # logic for lower and upper fences
  if (lofence < qv[1]) {  # no lower outliers
    bb[1] <- lofence
    bb[2] <- floor(qv[1])
  } else {
    bb[2] <- lofence
    bb[1] <- qv[1]
  }
  if (upfence > qv[5]) { # no upper outliers
    bb[7] <- upfence
    bb[6] <- ceiling(qv[5])
  } else {
    bb[6] <- upfence
    bb[7] <- qv[5]
  }
  bb[3:5] <- qv[2:4]
  return(bb)
}

get.var function

• arguments:
  • vname: variable name (as character, in quotes)
  • df: name of sf data frame
• returns:
  • v: vector with values (without a column name)

get.var <- function(vname,df) {
  v <- df[vname] %>% st_set_geometry(NULL)
  v <- unname(v[,1])
  return(v)
}

Test the functions

var <- get.var("wp_nonfunctional", NGA_wp) 
boxbreaks(var)

[1] -56.5   0.0  14.0  34.0  61.0 131.5 278.0

Boxmap function

• arguments:
  • vname: variable name (as character, in quotes)
  • df: simple features polygon layer
  • legtitle: legend title
  • mtitle: map title
  • mult: multiplier for IQR
• returns:
  • a tmap-element (plots a map)

boxmap <- function(vnam, df, 
                   legtitle=NA,
                   mtitle="Box Map",
                   mult=1.5){
  var <- get.var(vnam,df)
  bb <- boxbreaks(var)
  tm_shape(df) +
    tm_polygons() +
  tm_shape(df) +
     tm_fill(vnam,title=legtitle,
             breaks=bb,
             palette="Blues",
          labels = c("lower outlier", 
                     "< 25%", 
                     "25% - 50%", 
                     "50% - 75%",
                     "> 75%", 
                     "upper outlier"))  +
  tm_borders() +
  tm_layout(main.title = mtitle, 
            title.position = c("left",
                               "top"))
}

tmap_mode("plot")
boxmap("wp_nonfunctional", NGA_wp)

Recode zero

Recode LGAs with zero total water point into NA:

NGA_wp <- NGA_wp %>%
  mutate(wp_functional = na_if(
    total_wp, total_wp < 0))