In-Class Exercise 3

Importing packages

pacman::p_load(sf, tmap, tidyverse)

Loading in data

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

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)

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)

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

Extreme value maps

Percentile map

NGA_wp <- NGA_wp %>%
  drop_na()

percent <- c(0, .01, .1, .5, .9, .99, 1)
var <- NGA_wp["pct_functional"] %>%
  st_set_geometry(NULL) #drop all 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 

# function: extract out the data from df where variable name is vname
# where vname is a name, df is a dataframe)
# 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

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)
}

#Function to extract variable as vector out of an sf dataframe
get.var <- function(vname,df) {
  v <- df[vname] %>% st_set_geometry(NULL)
  v <- unname(v[,1])
  return(v)
}

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

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)

#Recodes LGA with 0 water points into NA
NGA_wp <- NGA_wp %>%
  mutate(wp_functional = na_if(
    total_wp, total_wp < 0))