Introduction

It has been a while since I wrote a blog for this website. This blog inspired by this visualization build by Greta vega and Estefanía Casal and presented at the excellent Outlier.io presentation (video link here) I attended earlier this year and my desire to do some more automated web scraping. The above-mentioned plot was prepared in R, but clearly completed and post-processed in some sort of photo editing software. I wanted to make a similar visualization, but only using R. This did mean I had to use some quite new and experimental packages, so there is a good chance the syntax of some of these packages might have changed by the time you read this.

It is clear that for this blog I chose form over function, but that does not mean there are no interesting lessons to learn from the analysis. I used R to web scrape information about Wikipedia entries of the 260 districts in Ghana. Currently, almost all districts have Wikipedia page, but some 37 still do not. Furthermore, the first Wikipedia pages for these districts were created back in 2006, while 3 districts only got their Wikipedia page in 2021. Finally, it is apparent that there is a wide variation in how active the Wikipedia pages of different districts are. This activeness is measured by the total number of words added to a page in a given year and on how many different edits were made in a single year.

Packages

These are the packages I use for this blog.

library(rvest)
library(httr)
library(tidyverse)
library(ggfittext)
library(ggplot2)
library(cowplot)
library(tidyverse)
library(colorspace)
library(ggtext)
library(showtext)
library(formattable)
library(lubridate)
library(glue)
library(patchwork)
library(kableExtra)
library(ggfittext)

Step 1: Scrape the data from Wikipedia

To get the data on when a Wikipedia was first created, how often certain Wikipedia pages were edited, and how long a Wikipedia page, I need to scrape that data from Wikipedia. Luckily, 1) there is a Wikipedia page with links to all the Wikipedia of different districts and 2) Wikipedia saves copies of all old versions of Wikipedia entries. This makes it possible to easily see how the content of a Wikipedia page used to look a couple of years ago.

First I set the page with links to pages of districts

url <- "https://en.wikipedia.org/wiki/Districts_of_Ghana"
webpage <- read_html(url)

Then I use a function to get links from a table. This code was taken from this Stackoverflow answer

html_table_href <- function (x, header = NA, trim = TRUE, fill = FALSE, dec = ".")
{

  fx <- function (x, header = NA, trim = TRUE, fill = FALSE, dec = ".")
  {
    stopifnot(html_name(x) == "table")
    rows <- html_nodes(x, "tr")
    n <- length(rows)
    cells <- lapply(rows, "html_nodes", xpath = ".//td|.//th")
    ncols <- lapply(cells, html_attr, "colspan", default = "1")
    ncols <- lapply(ncols, as.integer)
    nrows <- lapply(cells, html_attr, "rowspan", default = "1")
    nrows <- lapply(nrows, as.integer)
    p <- unique(vapply(ncols, sum, integer(1)))
    maxp <- max(p)
    if (length(p) > 1 & maxp * n != sum(unlist(nrows)) & maxp *
        n != sum(unlist(ncols))) {
      if (!fill) {
        stop("Table has inconsistent number of columns. ",
             "Do you want fill = TRUE?", call. = FALSE)
      }
    }
    values      <- lapply(lapply(cells, html_node, "a"), html_attr, name = "href")
    values[[1]] <- html_text(cells[[1]])
    out <- matrix(NA_character_, nrow = n, ncol = maxp)
    for (i in seq_len(n)) {
      row <- values[[i]]
      ncol <- ncols[[i]]
      col <- 1
      for (j in seq_len(length(ncol))) {
        out[i, col:(col + ncol[j] - 1)] <- row[[j]]
        col <- col + ncol[j]
      }
    }
    for (i in seq_len(maxp)) {
      for (j in seq_len(n)) {
        rowspan <- nrows[[j]][i]
        colspan <- ncols[[j]][i]
        if (!is.na(rowspan) & (rowspan > 1)) {
          if (!is.na(colspan) & (colspan > 1)) {
            nrows[[j]] <- c(utils::head(nrows[[j]], i),
                            rep(rowspan, colspan - 1), utils::tail(nrows[[j]],
                                                                   length(rowspan) - (i + 1)))
            rowspan <- nrows[[j]][i]
          }
          for (k in seq_len(rowspan - 1)) {
            l <- utils::head(out[j + k, ], i - 1)
            r <- utils::tail(out[j + k, ], maxp - i + 1)
            out[j + k, ] <- utils::head(c(l, out[j, i],
                                          r), maxp)
          }
        }
      }
    }
    if (is.na(header)) {
      header <- all(html_name(cells[[1]]) == "th")
    }
    if (header) {
      col_names <- out[1, , drop = FALSE]
      out <- out[-1, , drop = FALSE]
    }
    else {
      col_names <- paste0("X", seq_len(ncol(out)))
    }
    df <- lapply(seq_len(maxp), function(i) {
      utils::type.convert(out[, i], as.is = TRUE, dec = dec)
    })
    names(df) <- col_names
    class(df) <- "data.frame"
    attr(df, "row.names") <- .set_row_names(length(df[[1]]))
    if (length(unique(col_names)) < length(col_names)) {
      warning("At least two columns have the same name")
    }
    df
  }
  lapply(x, fx, header = header, trim = trim, fill = fill,
         dec = dec)
}

Now I can scrape the URLs to the Wikipedia pages of all the different districts and create a dataframe with the name of the district and a link to the edit history of that specific page.

districts_href <- webpage %>%
  html_nodes("[class='wikitable sortable']")  %>%
  html_table_href(fill = TRUE) %>%
  do.call(rbind, .) %>%
  as_tibble()  %>%
  select(District_link = District)

districts <- webpage %>%
  html_nodes("[class='wikitable sortable']")  %>%
  html_table(fill = TRUE) %>%
  do.call(rbind, .) %>%
  as_tibble()  %>%
  mutate(District = gsub("\\[[^][]*]", "", District)) %>%
  bind_cols(districts_href) %>%
  mutate(page_available = !grepl("redlink=1$", District_link))%>%
  mutate(link_to_hist = paste0("https://en.wikipedia.org/w/index.php?title=",
                               gsub("/wiki/", "", District_link),
                               "&offset=&limit=5000&action=history"))

saveRDS(districts, "districts_in_Ghana.RDS")

districts %>%
  select(District, District_link, link_to_hist)

With the links set up, I can now actually start the web scraping. I did run into some issues while trying to do so, but all could be fixed easily.

• Some of the districts are redirected to new pages. this was problematic in the web scraping For example, Tano South links to https://en.wikipedia.org/wiki/Tano_South_District, but if you go to that page, you are automatically redirected to https://en.wikipedia.org/wiki/Tano_South_Municipal_District. However, if you go to the edits history of https://en.wikipedia.org/wiki/Tano_South_District, there is only one edit, which is the redirection to the new page. All the actually edit history is transferred to the Tano_South_Municipal_District page. Therefore I built in a little logical test. This tests whether the page name is, which is web scraped from the URL, is the same as the original page name. If they are the same, no problem, but if they are different a new page_name is created.

logical_redirect <- function(x) {
  link_check <- read_html(paste0("https://en.wikipedia.org", x))
  link_check %>%
    html_nodes('head') %>%
    html_text() %>%
    as.character() %>%
    stringr::str_extract_all('(?<=wgPageName).+(?=wgTitle)') %>%
    gsub("[^-_/()a-zA-Z\\s]" , "" , . , perl = TRUE) %>%
    paste0("/wiki/", .) == x
}

Now I loop over all the 260 districts and for every district loop over all the edits and record in which year they were made, and how long an article was after the edit. The speed of this loop is mostly limited by my internet speed and the timeouts on the web scraping of Wikipedia, so the fact that for loops might not be the most efficient coding here does not matter that much.

list_results <- list()
for (i in 1:nrow(districts)) {
  if (districts$page_available[i]) {
    if (logical_redirect(districts$District_link[i])) {
      webpage_main <- read_html(districts$link_to_hist[i])

    } else{
      link_check <-
        read_html(paste0("https://en.wikipedia.org", districts$District_link[i]))
      new_link <- link_check %>%
        html_nodes('head') %>%
        html_text() %>%
        as.character() %>%
        stringr::str_extract_all('(?<=wgPageName).+(?=wgTitle)') %>%
        # remove most, but not all special characters
        gsub("[^-_/()a-zA-Z\\s]" , "" , . , perl = TRUE) %>%
        paste0(
          "https://en.wikipedia.org/w/index.php?title=",
          .,
          "&offset=&limit=5000&action=history"
        )

      # there is one rogue comma that needs to be added to  this link, I fixed that this way, by manually overriding it

      new_link  <-
        ifelse(
          new_link == "https://en.wikipedia.org/w/index.php?title=Banda_District_Ghana&offset=&limit=5000&action=history",
          "https://en.wikipedia.org/w/index.php?title=Banda_District,_Ghana&action=history",
          new_link
        )

      webpage_main <- read_html(new_link)
    }

    table_with_hist <- tibble(
      district = webpage_main %>%
        html_nodes('[class="mw-changeslist-date"]')  %>%
        html_attr("title"),
      ref_to_hist = webpage_main %>%
        html_nodes('[class="mw-changeslist-date"]')  %>%
        html_attr("href"),
      date = webpage_main %>%
        html_nodes('[class="mw-changeslist-date"]') %>%
        html_text() %>%
        parse_date_time(
          orders = "%H:%M, %d %B %Y",
          locale = "UK",
          tz     = "GMT"
        )
    )

    number_words <- c()

    for (j in 1:nrow(table_with_hist)) {
      # this allows for setting a time out
      # (https://stackoverflow.com/questions/48722076/how-to-set-timeout-in-rvest)
      tryCatch(
        number_words[j] <-
          GET(
            paste0(
              "https://en.wikipedia.org/",
              table_with_hist$ref_to_hist[j]
            ),
            timeout(1000)
          )  %>%
          read_html %>%
          #html_nodes('body')  %>%
          html_nodes('p')  %>%
          html_text() %>%
          paste0(collapse = " ") %>%
          stringr::str_replace_all("[\r\n]" , "") %>%
          # remove the warning message
          # to prevent it from being part of the word count
          str_replace("This is an old revision.*the current revision.", "") %>%
          str_replace(
            "This is the current revision of this page.*link to this version.",
            ""
          ) %>%
          stringi::stri_count_words(),
        error = function(e) {
          number_words[j] <<- "Timed out!"
        }
      )

      print(glue(
        "collected word count for {j} out of {nrow(table_with_hist)} pages"
      ))
    }

    table_with_hist$number_words <- unlist(number_words)
    list_results[[i]] <- table_with_hist

  } else{
    list_results[[i]] <- tibble(
      district = districts$District[i],
      ref_to_hist = NA,
      date = NA,
      number_words = NA
    )
  }
  # I save after every run
  saveRDS(list_results, "list_results_wiki_entries.RDS")
  print(glue(
    "collected information for {i} out of {nrow(districts)} districts"
  ))
}

Data preparation

Now I can load in all the scraped data and process it to make it ready for the plotting

list_results <- readRDS( "list_results_wiki_entries.RDS")
districts    <- readRDS("districts_in_Ghana.RDS")
results_df   <- do.call(rbind, list_results)

Calculate for every district when it was first published

order_of_entry <- results_df %>%
  group_by(district) %>%
  summarise(first_date = min(date))

order_of_entry

From this data, I can now calculate both the number of edits per year and the net number of words added in a year (number of words on the last date of the year a page was edited minus the number of words at the start of the year)

# calculate number of edits in a year
complete_df_1 <- results_df %>%
  mutate(year_report = year(date)) %>%
  group_by(district, year_report) %>%
  summarise(n = n()) %>%
  ungroup() %>%
  complete(district, nesting(year_report)) %>%
  filter(!is.na(year_report))

## `summarise()` has grouped output by 'district'. You can override using the `.groups` argument.

# calculate number of words added in a year
complete_df_2 <- results_df %>%
  mutate(year_report = year(date)) %>%
  group_by(district, year_report) %>%
  summarise(last_entry = number_words[which.max(date)]) %>%
  group_by(district) %>%
  arrange(district, year_report) %>%
  mutate(net_words_added = last_entry - lag(last_entry, 1)) %>%
  ungroup() %>%
  mutate(net_words_added = ifelse(is.na(net_words_added),
                                  last_entry,
                                  net_words_added)) %>%
  complete(district, nesting(year_report))

## `summarise()` has grouped output by 'district', 'year_report'. You can override using the `.groups` argument.

# combine both statistics.
complete_df <- left_join(complete_df_1, complete_df_2,
                        by = c("district", "year_report")) %>%
  left_join(order_of_entry,  by = "district") %>%
  mutate(district = as.factor(district))%>%
  mutate(district = fct_reorder(district, first_date))

Now that the data is ready, I can prepare some parameters and set some custom functions that are needed to create the final plot. The fact that I wanted to use a circular type of heatmap, complicated considerably

• Because the plot uses a polar coordinate system, drawing slightly curved and straight annotations lines is not possible with base ggplot. A solution to this was provided by Stackoverflow.
• I wanted to curve some text ‘around’ the heatmap. To do this I used the ggfittext package.
• To add the Wikipedia logo and to add the legend I will create separately to the plot, I used the patchwork package.
• To create this bivariate legend (showing both the number of edits and words added per year), I used the bivariate package and particularly some code I sourced from https://github.com/R4IDSR/epichecks, that was needed to extend the bivariate’s 3x3 matrix to a 5x5 matrix.
• To add the year labels at the 12 o’clock position of the plot, I needed to add some white space and make sure that the circular heatmap did not close on itself at that position.
• I wanted to make a distinction between data that was missing for a year (so a Wikipedia that does exist, but was simply not edited for a whole year) and districts for which no Wikipedia page existed (yet) in a given year. I created this distinction by overlapping the heatmap with another bar chart that has the exact same colour as the background, This way the plot cleanly merges into the background of the plot.

These are some plot wide parameter

# number of empty columns to be added for the years
n_white_gaps <- 5

# this is the plot I want to use
font_add_google(name = "Trirong")
showtext_auto()
plot_font <- "Trirong"

# This is the colors I am using
background_col <- "#fcfbe3"
col_arrows_and_lines <- "#8a7586"

These are combinations of year and districts for which no Wikipedia page was created at that time. As explained above, these are removed from the plot.

white_bars <- complete_df %>%
  arrange(first_date) %>%
  group_by(district) %>%
  summarise(min = min(year(first_date))) %>%
  mutate(min = replace_na(min, 2022)) %>%
  ungroup()

These are the labels surrounding the plot. This code was inspired by the code of Greta vega and Estefanía Casal.

label_data <- complete_df %>%
  select(district) %>%
  distinct() %>%
  # clean the names of districts a bit
  mutate(label = gsub('District', "",district),
         label = gsub('Municipal', "", label),
         label = gsub('district', "", label),
         label = gsub('municipal', "", label),
         label = gsub("Assembly", "", label),
         label = gsub('[()]', "", label),
         label = trimws(label)) %>%
  mutate(angle = 90 - 360 * (as.numeric(district)-0.5) / (n() + n_white_gaps)) %>%
  mutate(hjust = ifelse(angle < -90, 1, 0)) %>%
  mutate(angle = ifelse(angle < -90, angle+180, angle))

This is the function needed to draw straight lines in a polar coordinated plot. This code takes the geom_curve() function from ggplot2 and alters this function so that it ignores whether a coordinate system is linear or not.

geom_curve_polar <- function(...) {
  layer <- geom_curve(...)
  new_layer <- ggproto(NULL, layer)
  old_geom <- new_layer$geom
  geom <- ggproto(
    NULL, old_geom,
    draw_panel = function(data, panel_params, coord,
                          curvature = 0.5, angle = 90, ncp = 5,
                          arrow = NULL, arrow.fill = NULL,
                          lineend = "butt", linejoin = "round",
                          na.rm = FALSE) {
      data <- ggplot2:::remove_missing(
        data, na.rm = na.rm, c("x", "y", "xend", "yend",
                               "linetype", "size", "shape")
      )
      if (ggplot2:::empty(data)) {
        return(zeroGrob())
      }
      coords <- coord$transform(data, panel_params)
      ends <- transform(data, x = xend, y = yend)
      ends <- coord$transform(ends, panel_params)

      arrow.fill <- if (!is.null(arrow.fill)) arrow.fill else coords$colour
      return(grid::curveGrob(
        coords$x, coords$y, ends$x, ends$y,
        default.units = "native", gp = grid::gpar(
          col = alpha(coords$colour, coords$alpha),
          fill = alpha(arrow.fill, coords$alpha),
          lwd = coords$size * .pt,
          lty = coords$linetype,
          lineend = lineend,
          linejoin = linejoin
        ),
        curvature = curvature, angle = angle, ncp = ncp,
        square = FALSE, squareShape = 1, inflect = FALSE, open = TRUE,
        arrow = arrow
      ))

    }
  )
  new_layer$geom <- geom
  return(new_layer)
}

As explained above, I sourced code to create a bivariate 5x5 legend.

source("https://raw.githubusercontent.com/R4IDSR/epichecks/master/R/bivarcolours.R")

Now I sourced the make_colours() function from Github and now I create 26 different colours (5 times 5 + a colour for the missing data). Then I create 5 different n-tiles for both the number of words added and the numbers of edits. These will be plotted using scale_fill_identity() in the plot.

cols2 <- make_colours(
  num1 = 5,
  num2 = 5,
  og_pal1 = "Teal" ,
  og_pal2 = "Peach"
) %>%
  mutate(merger = str_glue("{rws}-{cls}")) %>%
  add_row(merger = "NA-NA", clrs = "#f5f5f5")

complete_df <- complete_df %>%
  mutate(quant_n = ntile(n, 5),
         quant_net_words_added = ntile(net_words_added , 5)) %>%
  mutate(merger = str_glue("{quant_n}-{quant_net_words_added}")) %>%
  left_join(cols2, "merger")

complete_df %>%
  sample_n(20) %>%
  kable() %>%
  kable_styling(c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%", height = "200px")

Now I am creating some extra dataframes that will be used to annotate the final visualization.

# some overall summary statistics.
summary_edits <- complete_df %>%
  summarise(max_words_added = max(net_words_added, na.rm = T),
            year_max_word_added = year_report[which.max(net_words_added)],
            district_max_word_added = district[which.max(net_words_added)],
            max_edits = max(n, na.rm = T),
            year_max_edits = year_report[which.max(n)],
            district_max_edits= district[which.max(n)])

# calculate the height and the colour of the column charts on the outer edge  of the circlular plot
summary_min_and_max_words_2021 <- results_df %>%
  group_by(district) %>%
  summarise(words_2021 = number_words[which.max(date)],
            n_edits = n())%>%
  ungroup() %>%
  mutate(quant_n = ntile(n_edits,5),
         quant_net_words_added = ntile(words_2021 ,5))%>%
  mutate(merger = str_glue("{quant_n}-{quant_net_words_added}")) %>%
  left_join(cols2, "merger")

bars_on_top <- left_join(white_bars, summary_min_and_max_words_2021, by = "district")  %>%
  mutate(words_2021 = replace_na(words_2021, 0))%>%
  # redo the factor reordering
  left_join(order_of_entry,  by = "district") %>%
  mutate(district = as.factor(district))%>%
  mutate(district = fct_reorder(district, first_date))

To make the plot visually more appealing, I trimmed off the tops of the bar to the 97th percentile.

max_val <- as.numeric(quantile(bars_on_top$words_2021, c(.97)))
deviding_factor <- max_val/(40-24)

Now that all the data is prepared, the fun can start…

circle <- ggplot() +
  # add the tiles
  geom_tile(
    data = complete_df,
    aes(x = district,
        y = year_report - 1998,
        fill = clrs),
    colour = "grey60",
    inherit.aes = F,
    na.value = 'red'
  ) +
  # add the proper colours
  scale_fill_identity(drop = FALSE) +
  # mask the year-district combinations for whihch no data excisted yet
  geom_rect(
    data = white_bars,
    aes(
      xmin = as.numeric(district) - 0.5,
      xmax = as.numeric(district) + .5 ,
      ymin = 2005.5 - 1998,
      ymax = min - 1998.5
    ),
    fill = background_col,
    col = background_col,
    alpha = 1,
    inherit.aes = F
  ) +
  # add an inner and outer circle
  scale_y_continuous(limits = c(-7, 40), expand = c(0, -7)) +
  # add some white space to put the year labels in
  scale_x_discrete(limits = c(levels(complete_df$district),
                              paste0("NA", 1:n_white_gaps))) +
  # change the coordinate system to polar
  coord_polar(start = 0, clip = "off") +
  # add bar charts to outer circle
  geom_rect(
    data = bars_on_top,
    aes(
      xmin = as.numeric(district) - 0.5,
      xmax = as.numeric(district) + .5 ,
      ymin = 24,
      fill = clrs ,
      ymax = 24 + (
        ifelse(words_2021  > max_val, max_val, words_2021) / deviding_factor
      )
    ),
    alpha = .5
  ) +
  # add the labels
  geom_text(
    data = label_data,
    aes(
      x = district,
      y = 24,
      label = label,
      hjust = hjust
    ),
    color = "black",
    fontface = "bold",
    family = plot_font,
    alpha = 0.6,
    size = 2,
    angle = label_data$angle,
    inherit.aes = FALSE
  ) +
  # add a black line around the inner part of the plot
  geom_step(
    data = white_bars,
    aes(x = as.numeric(district) - 0.5,
        y = min - 1998.5),
    col = "black",
    size = .5,
    alpha = 1,
    inherit.aes = F
  ) +
  # add a black line on the ouer pary of the plot
  geom_hline(yintercept = 2021 - 1997.5,
             size = .5,
             col = "black") +
  # add the year labels
  geom_text(
    data = tibble(
      y = c(2021:2006) - 1998,
      x = 0.5,
      labels = 2021:2006
    ),
    aes(x = x ,
        y = y,
        label = labels),
    hjust = 1,
    size = 2.5,
    family = plot_font,
    inherit.aes = F
  ) +
  # add a curved arrow to indicate direction
  # of reading the plot
  geom_segment(
    aes(
      x = white_bars$district[1],
      y = 2005.2 - 1998,
      xend = white_bars$district[70],
      yend = 2005.2 - 1998
    ),
    size = .5,
    col = col_arrows_and_lines,
    arrow = arrow(length = unit(0.15, "cm"))
  )  +
  # add an annotation thi this line
  geom_fit_text(
    data = tibble(
      ymin = c(2003.7) - 1997.5,
      ymax = c(2004.3) - 1997.5,
      xmin = 0,
      xmax = 80,
      labels = "districts ordered by date first Wiki entry"
    ),
    aes(
      ymin = ymin,
      ymax = ymax,
      xmin = xmin,
      xmax = xmax,
      label = labels
    ),
    family = plot_font,
    min.size = 3,
    grow = TRUE,
    padding.x = grid::unit(0, "mm"),
    padding.y = grid::unit(0, "mm"),
    fullheight  = TRUE,
    inherit.aes = F
  ) +
  # add annotation showing how many
  # districts do not yet have a wikipedia page
  geom_fit_text(
    data = tibble(
      ymin = c(2020) - 1997.6,
      ymax = c(2021) - 1997.6,
      xmin = white_bars$district[sum(white_bars$min != 2022) + 2],
      xmax = white_bars$district[nrow(white_bars)],
      labels = paste0(
        sum(white_bars$min == 2022),
        " districts do not yet have a Wiki entry"
      )
    ),
    aes(
      ymin = ymin,
      ymax = ymax,
      xmin = xmin,
      xmax = xmax,
      label = labels
    ),
    min.size = 1,
    grow = TRUE,
    padding.x = grid::unit(0, "mm"),
    padding.y = grid::unit(0, "mm"),
    family = plot_font,
    fullheight  = TRUE,
    inherit.aes = F
  ) +
  # add annotation (arrow and text)
  # to point to some interesting data
  geom_curve_polar(
    aes(
      x = summary_edits$district_max_word_added,
      y = summary_edits$year_max_word_added - 1998,
      yend = 2010.5 - 1998,
      xend = 'Akatsi South District'
    ),
    arrow = arrow(length = unit(0.2, "cm")),
    col = col_arrows_and_lines,
    curvature = -.3,
    angle = -90,
    size = .5
  )  +
  annotate(
    "text",
    x = 'Akatsi South District',
    y = 2010 - 1998,
    label = str_glue(
      "In 2017, {comma(summary_edits$max_words_added, digits = 0)} new words\nwere added to the Wikipedia\npage of {summary_edits$district_max_word_added}"
    ),
    vjust = 0,
    family = plot_font,
    size = 2.5,
    lineheight = .9
  ) +
  # add arrow pointing towards district that was added last
  geom_curve_polar(
    aes(
      x = white_bars$district[sum(white_bars$min != 2022)  + 2],
      y = 2017 - 1998,
      yend = 2021 - 1998,
      xend = white_bars$district[sum(white_bars$min != 2022)]
    ),
    arrow = arrow(length = unit(0.2, "cm")),
    col = col_arrows_and_lines ,
    curvature = -.3,
    angle = -90,
    size = .5
  ) +
  # add arrow pointing towards Accra Metropolitan District
   geom_curve_polar(
    aes(
      x = which(white_bars$district == "Accra Metropolitan District") + 2.5,
      y = 2038 - 1998,
      yend = 2038 - 1998,
      xend =  which(white_bars$district == "Accra Metropolitan District")
    ),
    arrow = arrow(length = unit(0.2, "cm")),
    col = col_arrows_and_lines,
    curvature = .3,
    angle = -90,
    size = .5
  ) +
# add label with information on district that was added last
  annotate(
    "text",
    x =  white_bars$district[sum(white_bars$min != 2022)],
    y = 2016 - 1998,
    label = str_glue(
      "On {format(as_date(ymd_hms(max(results_df$date, na.rm = T))), '%d %B %Y')}, \n{white_bars$district[sum(white_bars$min != 2022) ]}\nwas the latest district to get\na Wikipedia page"
    ),
    vjust = 0,
    hjust = 0,
    family = plot_font,
    size = 2.5,
    lineheight = .9
  ) +
  # add label with information on Accra Metropolitan District
  annotate(
    "text",
    x = which(white_bars$district == "Accra Metropolitan District") + 3,
    y = 2037 - 1998,
    label = str_glue(
      "Accra Metropolitan District\nis the district with the longest\nWiki entry page (24,743 words)"
    ),
    vjust = 0,
    family = plot_font,
    size = 2.5,
    hjust = 0,
    lineheight = .9
  ) +
  # add annotation layer explaining plot
  annotate(
    "text",
    x = 235,
    y =39,
    label = str_wrap(str_glue(
      "The gradient from blues to reds indicate the number of words that were added to a given page,\\
      while the darker shades of corresponding colors represent the number of edits that were made to these pages. \\
      In this visualization, too many dimensions are plotted at once. Admittedly, a simple bar chart would have been clearer. \\
            However, form over function is not always a bad thing and sometimes a visualization should just be nice to look at. \\
      The data for the project was scraped in the first week of March 2021, so it might be outdated by now. \\
      The bivariate colour mapping is inspired by the biscale package and to implement the 5x5 matrix it sourced code from: \\
      https://github.com/R4IDSR/epichecks."
    ), 55),
    vjust = -0.05,
    family = plot_font,
    size = 2.1,
    hjust = 0,
    lineheight = .9
  ) +
  # add scale on top of plot
  geom_errorbar(
    aes(
      xmax = 265,
      ymax   = 24,
      ymin   = 40,
      x = 265,
      y = 30
    ),
    col = col_arrows_and_lines,
  ) +
  # add text to this scale
  geom_text(
    aes(y = 24, x = 265, label = "0"),
    hjust = 1,
    size = 2,
    nudge_x = -.5,
    family = plot_font
  ) +
  geom_text(
    aes(
      y = 40,
      x = 265,
      label = glue("{ceiling(max_val/100)*100}+")
    ),
    hjust = 1,
    size = 2,

    nudge_x = -.5,
    family = plot_font
  ) +
  # add label to axis
  geom_text(
    aes(y = mean(c(24, 40)),
        x = 265,
        label = "total number of words"),
    hjust = .5,
    nudge_x = -.7,
    angle = 90,
    size = 2,
    family = plot_font
  ) +
  # add base theme
  theme_void() +
  # make some adjustments to theme
  theme(
    panel.background = element_rect(
      fill = background_col,
      colour  = NA,
      size = 0
    ),
    plot.background = element_rect(
      fill = background_col,
      colour  = NA,
      size = 0
    ),
    panel.border = element_blank(),
    axis.title = element_blank(),
    panel.grid = element_blank(),
    plot.title = element_text(
      family = plot_font,
      face = "bold",
      hjust = .5,
      size = 16
    ),
    plot.subtitle =  element_text(
      family = plot_font,
      color = col_arrows_and_lines,
      hjust = .5,
      size = 9
    ),
    plot.caption =  element_text(
      family = plot_font,
      hjust =1,
      size = 8
    ),
    panel.spacing = unit(0, "lines"),
    plot.margin = margin(0, 0, 0, 0, unit = "cm"),
    axis.text.x = element_blank(),
    axis.ticks = element_blank(),
    axis.text.y = element_blank(),
    legend.position = "none"
  ) +
  # add title and labels to plot
  labs(title = "Visualizing  Contributions to the Wikipedia Pages of Ghana's 260 Districts",
       subtitle = paste0(str_wrap(
         glue(
           "This infographic shows the results of web-scraped Wikipedia data on the 260 districts in Ghana.\\
     It shows both the number of edits and the net number of words added per year per district.\\
     Over other dimensions, it also shows the total length of each district's Wikipedia  article \\
     and in which year a page was first created.\n\n"
         ),
         140
       ), "\n\n"),
       caption = "visualization by Laurent Smeets")

# dowload wikipedia logo
logo <- png::readPNG("https://upload.wikimedia.org/wikipedia/en/thumb/8/80/Wikipedia-logo-v2.svg/1122px-Wikipedia-logo-v2.svg.png", native = TRUE)

# add wikipedia logo to plot
circle_logo <- circle +
  inset_element(
    p = logo,
    left = 0.45,
    bottom = 0.45,
    right = 0.55,
    top = 0.55,
    align_to = 'panel'
  ) +
  theme_void()



# create a custom legend
legend_square <- ggplot(data = cols2,
                        mapping = aes(x = cls,
                                      y = rws,
                                      fill = clrs)) +
  geom_tile(alpha = 1) +
  scale_fill_identity() +
  scale_x_continuous(breaks = c(0:5)) +
  scale_y_continuous(breaks = c(0:5)) +
  labs(x = substitute(paste("more words added", "" %->% "")),
       y = substitute(paste("more revisions", "" %->% ""))) +
  theme(
    plot.margin = margin(0, 0, 0, 0, unit = "cm"),
    panel.grid.major.x = element_blank(),
    panel.grid.minor.x = element_blank(),
    panel.grid.major.y = element_blank(),
    axis.text = element_blank(),
    panel.grid.minor.y = element_blank(),
    strip.background = element_rect(color = "transparent", fill = "transparent"),
    plot.background = element_rect(color = "transparent", fill = "transparent"),
    panel.background = element_rect(color = "transparent", fill = "transparent"),
    panel.border  = element_blank(),
    axis.title.x = element_text(
      margin = margin(-0.1, 0 , 0, 0, unit = "cm"),
      family = plot_font,
      size = 13
    ),
    axis.title.y = element_text(
      margin = margin(0,-0.1, 0, 0, unit = "cm"),
      family = plot_font,
      size = 13
    )
  )

# add legend to plot
circle_logo_legend <-
  circle_logo +
  inset_element(
    p = legend_square,
    left = 0.01,
    bottom = 0.83,
    right = 0.18,
    top = 1,
    align_to = 'panel'
  ) +
  theme_minimal() +
  theme(
    panel.grid.major.x = element_blank(),
    panel.grid.minor.x = element_blank(),
    panel.grid.major.y = element_blank(),
    axis.text = element_blank(),
    axis.title.x = element_text(
      margin = margin(-0.1, 0 , 0, 0, unit = "cm"),
      family = plot_font,
      hjust = 0.5,
      size = 9
    ),
    axis.title.y = element_text(
      margin = margin(0, -0.1, 0, 0, unit = "cm"),
      family = plot_font,
      hjust = 0.5,
      size = 9
    )
  ) +
  coord_fixed(expand = F)

circle_logo_legend

This short video shows how this plot was actually built in ggplot (hosted on Vimeo).

Valuable Information and Tutorials

These are some further valuable sources on analysis of these kinds:

• Harvesting the web with rvest
• Web Scraping in R: rvest Tutorial
• Multivariate Mapping
• Bivariate Choropleth Maps: A How-to Guide (for a good explanation of bivariate maps)