In-Class Exercise 3

Published

January 25, 2023

Modified

March 27, 2023

Import Packages

pacman::p_load(sf, tmap, tidyverse)

Load Data

NGA_wp = read_rds("data/rds/NGA_wp.rds")

Plot Choropleth Maps

p1 <- tm_shape(NGA_wp) +
  tm_fill("wp_functional",
          n = 10,
          style = "equal",
          palette = "Blues") + #color scheme
  tm_borders(lwd = 0.1, #line width
             alpha = 1) + #opacity/transparency
  tm_layout(main.title = "Distribution of functional water points",
            legend.outside = FALSE)
tmap_style("albatross")
p1

p2 <- tm_shape(NGA_wp) +
  tm_fill("total_wp",
          n = 10,
          style = "equal",
          palette = "Blues") + #color scheme
  tm_borders(lwd = 0.1, #line width
             alpha = 1) + #opacity/transparency
  tm_layout(main.title = "Distribution of functional water points",
            legend.outside = FALSE)
tmap_arrange(p2, p1, nrow=1)

# Add cols for percentile values for functional and nonfunctional WPs
NGA_wp <- NGA_wp %>%
  mutate(pct_functional = wp_functional/total_wp) %>%
  mutate(pct_nonfunctional = wp_nonfunctional/total_wp)
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

Percentile map: special type of quantile map

Create a classification scheme (including of beginning and end)

# Exclusde NA records
NGA_wp <- NGA_wp %>%
  drop_na()
# Create custom classification & extracting vals
percent <- c(0, .01, .1, .5, .9, .99, 1)
var <- NGA_wp["pct_functional"] %>%
  st_set_geometry(NULL) #drop away all the geometric fields
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 

Extract map plotting into a reusable function

# function: extract a variable (vname) as a vector
# out of a s.f. dataframe (df)
# returns vector of values (without a col name
get.var <- function(vname, df) {
  v <- df[vname] %>%
    st_set_geometry(NULL)
  v <- unname(v[,1])
  return(v)
}
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"),
              legend.outside = TRUE)
}
percentmap ("pct_functional", NGA_wp)

BoxPlot

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

BoxMap

# Creates break points for box map
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)
}
var <- get.var("wp_nonfunctional", NGA_wp) 
boxbreaks(var)
[1] -56.5   0.0  14.0  34.0  61.0 131.5 278.0
# Function to create Boxmap
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 LGAs with 0 wp to NA
NGA_wp <- NGA_wp %>%
  mutate(wp_functional = na_if(
    total_wp, total_wp < 0))