Where is the centre of University of Oxford?

University of Oxford has over 800 years of history to it, but if you want to organise a meeting at the centre of campus… where do you meet?
R
dataviz
GIS
Published

February 18, 2019

My team at University of Oxford provide research data management and reproducible research advice to researchers across the whole of the University. A fairly common point of contention is where should we meet, and where is the centre of the University?

We broadly agreed that the centre of the University should be calculated as the (weighted) centre of mass of specific buildings or campuses within the University. Two of our favourite options were:

In this blogpost I go through all the steps of scraping and combining data from the OxPoints service and Wikipedia to calculate these centres through history.

Get data from OxPoints

OxPoints is a tool for accessing geographic information about University of Oxford. We extract shapefiles for all colleges using the API:

library("jsonlite")
library("tidyverse")
library("sf")
library("here")
library("rvest")

raw_json_oxpoints_colleges <- read_json(
  "https://maps.ox.ac.uk/api/places/search?type=%2Funiversity%2Fcollege&inoxford=true&-type_exact=%5C%2Funiversity%5C%2Fsub-library&-type_exact=%5C%2Funiversity%5C%2Froom&count=50&facet=type_exact"
)

oxpoints_colleges <- raw_json_oxpoints_colleges$`_embedded`$pois

Extract college data with a helper function:

get_college_data <- function(oxpoints_data, college_index) {
  college_properties <- names(oxpoints_data[[college_index]])
  extracted_properties <- college_properties[
    college_properties %in%
      c(
        "id",
        "lat",
        "lon",
        "name",
        "name_sort",
        "shape",
        "social_facebook",
        "website"
      )
  ]

  oxpoints_data[[college_index]] %>%
    .[extracted_properties] %>%
    as_tibble() %>%
    mutate(across(where(is.list), as.character)) %>%
    mutate(across(everything(), readr::parse_guess))
}

college_oxpoints_data <- oxpoints_colleges |>
  get_college_data(1)

tibble(x = 2:38) |>
  pwalk(function(x) {
    college_oxpoints_data <<- college_oxpoints_data |>
      bind_rows(get_college_data(oxpoints_colleges, x))
  })

college_oxpoints_data <- college_oxpoints_data |>
  select(-lat, -lon, -id, -name_sort)

Extract data from Wikipedia

The Colleges of the University of Oxford Wikipedia page provides a useful summary including year of foundation:

colleges_of_oxford <- read_html(
  "https://en.wikipedia.org/wiki/Colleges_of_the_University_of_Oxford"
) |>
  html_nodes("table")
colleges_of_oxford <- colleges_of_oxford[[3]]

colleges_of_oxford <- colleges_of_oxford |>
  html_nodes("tbody") |>
  html_nodes("tr") |>
  html_text()

colleges_of_oxford <- colleges_of_oxford |>
  .[2:length(.)] |>
  str_trim() |>
  str_replace_all("\n{1,}", ";") |>
  read_delim(delim = ";", show_col_types = FALSE)

colnames(colleges_of_oxford) <- c(
  "name",
  "foundation.year",
  "sister.college",
  "total.assets",
  "financial.endowment",
  "undergraduates",
  "post.graduates",
  "visiting.students",
  "male.students",
  "female.students",
  "total.students",
  "assets.per.student"
)

colleges_of_oxford <- colleges_of_oxford |>
  select(name, sister.college, everything()) |>
  mutate(across(
    foundation.year:undergraduates,
    ~ if (is.numeric(.)) . else parse_number(.)
  ))

Creating an sf object

college_data <- college_oxpoints_data |>
  left_join(colleges_of_oxford)

college_nongeometric_data <- college_data |> select(-shape)

college_features <- college_data |> select(shape) |> .[[1]]
college_geometries <- st_as_sfc(college_features) |>
  st_zm() |>
  st_set_crs(4326) |>
  st_cast("MULTIPOLYGON") |>
  sf:::largest_ring()

st_geometry(college_nongeometric_data) <- college_geometries
college_shapes <- college_nongeometric_data

college_shapes |>
  write_sf(
    here("data", "shapefiles_oxford_colleges.json"),
    driver = "GeoJSON",
    update = TRUE
  )

Visualising college shapefiles with ggmap

library("ggmap")
library("ggrepel")

register_google(key = "My-FAKE-KEY")

make_ggmap_styles <- function(styles) {
  styles |>
    mutate(style = glue("&style=feature:{feature}|visibility:{visibility}")) |>
    pull(style) |>
    paste0(collapse = "")
}

my_styles <- tribble(
  ~feature             , ~visibility ,
  "poi"                , "off"       ,
  "poi.park"           , "on"        ,
  "landscape.man_made" , "off"
)

base_map <- get_googlemap(
  center = c(-1.257411, 51.7601055),
  maptype = "roadmap",
  zoom = 14,
  style = make_ggmap_styles(my_styles)
)
gg_oxford_city <- ggmap(base_map)

gg_oxford_city +
  geom_sf(
    data = college_shapes,
    inherit.aes = FALSE,
    aes(fill = foundation.year < 1300)
  ) +
  geom_label_repel(
    data = college_shapes |> filter(foundation.year < 1300),
    aes(label = name, geometry = geometry),
    stat = "sf_coordinates",
    nudge_x = 2,
    inherit.aes = FALSE
  )

Animating the centre of mass over time

century_cut <- function(
  x,
  lower = 0,
  upper,
  by = 100,
  sep = "-",
  above.char = "+"
) {
  labs <- c(
    paste(
      seq(lower, upper - by, by = by),
      seq(lower + by - 1, upper - 1, by = by),
      sep = sep
    ),
    paste(upper, above.char, sep = "")
  )
  cut(
    floor(x),
    breaks = c(seq(lower, upper, by = by), Inf),
    right = FALSE,
    labels = labs
  )
}
colleges_by_century <- college_shapes |>
  group_by(
    century = century_cut(foundation.year, lower = 1200, upper = 2100, by = 100)
  )

centre_over_time_period <- function(shapes, lower, upper) {
  suppressWarnings(
    shapes |>
      filter(foundation.year >= lower & foundation.year < upper) |>
      st_centroid() |>
      st_combine() |>
      st_centroid() |>
      st_coordinates() |>
      as_tibble() |>
      rename(long = X, lat = Y)
  )
}

time_periods <- tibble(lower = 1200, upper = seq(1300, 2100, 100))

centres_through_history <- time_periods |>
  mutate(
    centre = pmap(
      list(lower, upper),
      centre_over_time_period,
      shapes = college_shapes
    )
  ) |>
  unnest(centre) |>
  st_as_sf(coords = c("long", "lat")) |>
  st_set_crs(4326) |>
  mutate(time_period = glue("{lower} - {upper}"))

library("gganimate")
anim <- gg_oxford_city +
  geom_sf(data = centres_through_history, inherit.aes = FALSE) +
  transition_states(time_period, transition_length = 2, state_length = 1) +
  enter_fade() +
  shadow_wake(wake_length = 0.05) +
  exit_shrink()
anim_save(here("oxford-centres.gif"))