Use {rvest}

The Wikipedia page for the NBA has a table with each team and its location, including coordinates. We can use the {rvest} web-scraping package to extract that table into a data frame with these steps:

1. Read the HTML of the page with xml2::read_html()
2. Extract the HTML node for the table with rvest::html_nodes()
3. Parse the HTML as a table with rvest::html_table()

Note that you have to provide to html_nodes() a CSS selector or an XPath that identifies the table’s ‘location’ in the HTML. You can find these using a tool like SelectorGadget, or with your browser’s ‘inspect’ tool (for Chrome, right-click the element on the page, select ‘inspect’, right-click the HTML for that element, go to ‘Copy’, then ’Copy full XPath).

nba_scrape <-
  read_html("https://en.wikipedia.org/wiki/National_Basketball_Association") %>% 
  html_nodes(xpath = "/html/body/div[3]/div[3]/div[5]/div[1]/table[4]") %>%
  html_table(fill = TRUE, header = NA) %>%
  .[[1]]  # list was returned, so extract first list element

glimpse(nba_scrape)  # a data frame

## Rows: 32
## Columns: 9
## $ Division      <chr> "Eastern Conference", "Atlantic", "Atlantic", "Atlantic…
## $ Team          <chr> "Eastern Conference", "Boston Celtics", "Brooklyn Nets"…
## $ `City, State` <chr> "Eastern Conference", "Boston, Massachusetts", "New Yor…
## $ Arena         <chr> "Eastern Conference", "TD Garden", "Barclays Center", "…
## $ Capacity      <chr> "Eastern Conference", "18,624", "17,732", "19,812", "21…
## $ Coordinates   <chr> "Eastern Conference", "42°21′59″N 71°03′44″W / 42.366…
## $ Founded       <chr> "Eastern Conference", "1946", "1967*", "1946", "1946*",…
## $ Joined        <chr> "Eastern Conference", "1946", "1976", "1946", "1949", "…
## $ NA            <chr> "Eastern Conference", NA, NA, NA, NA, NA, NA, NA, NA, N…

So, the table has been returned, but it needs to be tidied up.

Wrangle the data

To summarise the main cleaning steps required:

• remove the rogue NA-filled column
• filter out the spanning headers that identify the conferences
• add a column for each team’s conference
• make numeric the arena capacity
• separate city and state into separate columns
• isolate the latitude and longitude by separating them from the Coordinates column
• remove the ‘zero width no-break space’ unicode character in the longitude column
• retain only the columns of interest

nba_wrangle <- nba_scrape %>% 
  select(-length(.)) %>%  # remove the last column (NA)
  dplyr::filter(!str_detect(Division, "Conference")) %>% 
  mutate(
    Conference = c(rep("Eastern", 15), rep("Western", 15)),
    Capacity = as.numeric(str_remove(Capacity, ","))
  ) %>% 
  separate(`City, State`, c("City", "State"), sep = ", ") %>% 
  separate(Coordinates, c("Coords1", "Coords2", "Coords3"), " / ") %>% 
  separate(Coords3, c("Latitude", "Longitude"), sep = "; ") %>% 
  separate(Longitude, c("Longitude", "X"), sep = " \\(") %>% 
  mutate(
    Latitude = as.numeric(Latitude),
    Longitude = as.numeric(
      str_remove(Longitude, "\\ufeff")  # remove rogue unicode
    )  
  ) %>% 
  select(
    Team, Conference, everything(),
    -Founded, -Joined, -Coords1, -Coords2, -X
  ) %>% 
  as_tibble()  # convert to tibble

glimpse(nba_wrangle)

## Rows: 30
## Columns: 9
## $ Team       <chr> "Boston Celtics", "Brooklyn Nets", "New York Knicks", "Phi…
## $ Conference <chr> "Eastern", "Eastern", "Eastern", "Eastern", "Eastern", "Ea…
## $ Division   <chr> "Atlantic", "Atlantic", "Atlantic", "Atlantic", "Atlantic"…
## $ City       <chr> "Boston", "New York City", "New York City", "Philadelphia"…
## $ State      <chr> "Massachusetts", "New York", "New York", "Pennsylvania", "…
## $ Arena      <chr> "TD Garden", "Barclays Center", "Madison Square Garden", "…
## $ Capacity   <dbl> 18624, 17732, 19812, 21600, 19800, 20917, 20562, 20491, 17…
## $ Latitude   <dbl> 42.36630, 40.68265, 40.75056, 39.90111, 43.64333, 41.88056…
## $ Longitude  <dbl> -71.06223, -73.97469, -73.99361, -75.17194, -79.37917, -87…

Great, a clean and tidy table.

Add more information

I also wanted to add three-letter team codes, which can be scraped from another Wikipedia table.

I also wanted to add team colours to later customise the marker pins on the interactive map. These are a little tricky to get in an automated way, so I input them manually with reference to teamcolorcodes.com. With {leaflet}, the markers can only take a small set of named colours (see ?awesomeIcons), whereas the icon can use any CSS-valid colour (like hex codes).

I’ve hidden the code for this below to save space and because it doesn’t introduce anything new.

nba_abbr_cols <- 
  read_html(
    "https://en.wikipedia.org/wiki/Wikipedia:WikiProject_National_Basketball_Association/National_Basketball_Association_team_abbreviations"
  ) %>% 
  html_nodes(xpath = "/html/body/div[3]/div[3]/div[5]/div[1]/table") %>%
  html_table(header = TRUE) %>%
  .[[1]] %>% 
  rename(Code = `Abbreviation/Acronym`) %>% 
  mutate(
    # {leaflet} markers take a named colour
    colour_marker = case_when(
      Code == "ATL" ~ "red",
      Code == "BKN" ~ "black",
      Code == "BOS" ~ "green",
      Code == "CHA" ~ "darkblue",
      Code == "CHI" ~ "red",
      Code == "CLE" ~ "darkred",
      Code == "DAL" ~ "blue",
      Code == "DEN" ~ "darkblue",
      Code == "DET" ~ "red",
      Code == "GSW" ~ "blue",
      Code == "HOU" ~ "red",
      Code == "IND" ~ "darkblue",
      Code == "LAC" ~ "red",
      Code == "LAL" ~ "blue",
      Code == "MEM" ~ "lightblue",
      Code == "MIA" ~ "red",
      Code == "MIL" ~ "darkgreen",
      Code == "MIN" ~ "darkblue",
      Code == "NOP" ~ "darkblue",
      Code == "NYK" ~ "blue",
      Code == "OKC" ~ "blue",
      Code == "ORL" ~ "blue",
      Code == "PHI" ~ "blue",
      Code == "PHX" ~ "darkblue",
      Code == "POR" ~ "red",
      Code == "SAC" ~ "purple",
      Code == "SAS" ~ "black",
      Code == "TOR" ~ "red",
      Code == "UTA" ~ "darkblue",
      Code == "WAS" ~ "darkblue"
    ),
    # {leaflet} marker icons take hex
    colour_icon = case_when(
      Code == "ATL" ~ "#C1D32F",
      Code == "BKN" ~ "#FFFFFF",
      Code == "BOS" ~ "#BA9653",
      Code == "CHA" ~ "#00788C",
      Code == "CHI" ~ "#000000",
      Code == "CLE" ~ "#FDBB30",
      Code == "DAL" ~ "#B8C4CA",
      Code == "DEN" ~ "#FEC524",
      Code == "DET" ~ "#1D42BA",
      Code == "GSW" ~ "#FFC72C",
      Code == "HOU" ~ "#000000",
      Code == "IND" ~ "#FDBB30",
      Code == "LAC" ~ "#1D428A",
      Code == "LAL" ~ "#FDB927",
      Code == "MEM" ~ "#12173F",
      Code == "MIA" ~ "#F9A01B",
      Code == "MIL" ~ "#EEE1C6",
      Code == "MIN" ~ "#9EA2A2",
      Code == "NOP" ~ "#C8102E",
      Code == "NYK" ~ "#F58426",
      Code == "OKC" ~ "#EF3B24",
      Code == "ORL" ~ "#C4CED4",
      Code == "PHI" ~ "#ED174C",
      Code == "PHX" ~ "#E56020",
      Code == "POR" ~ "#000000",
      Code == "SAC" ~ "#63727A",
      Code == "SAS" ~ "#C4CED4",
      Code == "TOR" ~ "#000000",
      Code == "UTA" ~ "#F9A01B",
      Code == "WAS" ~ "#E31837"
    )
  ) %>% 
  as_tibble()

sample_n(nba_abbr_cols, 5)

## # A tibble: 5 x 4
##   Code  Franchise              colour_marker colour_icon
##   <chr> <chr>                  <chr>         <chr>      
## 1 IND   Indiana Pacers         darkblue      #FDBB30    
## 2 UTA   Utah Jazz              darkblue      #F9A01B    
## 3 NOP   New Orleans Pelicans   darkblue      #C8102E    
## 4 SAC   Sacramento Kings       purple        #63727A    
## 5 MIN   Minnesota Timberwolves darkblue      #9EA2A2

Now this extra information can be joined to our scraped and wrangled data frame from before.

nba_table <- nba_wrangle %>% 
  left_join(nba_abbr_cols, by = c("Team" = "Franchise")) %>%
  select(Code, everything())

glimpse(nba_table)

## Rows: 30
## Columns: 12
## $ Code          <chr> "BOS", "BKN", "NYK", "PHI", "TOR", "CHI", "CLE", "DET",…
## $ Team          <chr> "Boston Celtics", "Brooklyn Nets", "New York Knicks", "…
## $ Conference    <chr> "Eastern", "Eastern", "Eastern", "Eastern", "Eastern", …
## $ Division      <chr> "Atlantic", "Atlantic", "Atlantic", "Atlantic", "Atlant…
## $ City          <chr> "Boston", "New York City", "New York City", "Philadelph…
## $ State         <chr> "Massachusetts", "New York", "New York", "Pennsylvania"…
## $ Arena         <chr> "TD Garden", "Barclays Center", "Madison Square Garden"…
## $ Capacity      <dbl> 18624, 17732, 19812, 21600, 19800, 20917, 20562, 20491,…
## $ Latitude      <dbl> 42.36630, 40.68265, 40.75056, 39.90111, 43.64333, 41.88…
## $ Longitude     <dbl> -71.06223, -73.97469, -73.99361, -75.17194, -79.37917, …
## $ colour_marker <chr> "green", "black", "blue", "blue", "red", "red", "darkre…
## $ colour_icon   <chr> "#BA9653", "#FFFFFF", "#F58426", "#ED174C", "#000000", …

Now we have everything we need to visualise the data and fetch the travel duration times.

Duration matrix

The osrm::osrmTable() function takes a data frame (or spatial object) where the first three columns are an identifier and coordinates. The return object is a list, where the first element is a matrix of durations for each pair of points.

nba_locs <- select(nba_table, Code, Longitude, Latitude)
nba_dur <- osrmTable(loc = nba_locs)

glimpse(nba_dur)

## List of 3
##  $ durations   : num [1:30, 1:30] 0 277 269 377 649 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:30] "BOS" "BKN" "NYK" "PHI" ...
##   .. ..$ : chr [1:30] "BOS" "BKN" "NYK" "PHI" ...
##  $ sources     :'data.frame':    30 obs. of  2 variables:
##   ..$ lon: num [1:30] -71.1 -74 -74 -75.2 -79.4 ...
##   ..$ lat: num [1:30] 42.4 40.7 40.7 39.9 43.6 ...
##  $ destinations:'data.frame':    30 obs. of  2 variables:
##   ..$ lon: num [1:30] -71.1 -74 -74 -75.2 -79.4 ...
##   ..$ lat: num [1:30] 42.4 40.7 40.7 39.9 43.6 ...

Duration: all teams

Let’s take this matrix and tidy it into a data frame so there’s one row per team-pair. We can also round to the nearest minute and calculate the nearest number of hours.

nba_dur_all <-
  as.data.frame(nba_dur$durations) %>% 
  rownames_to_column("Start") %>% 
  pivot_longer(
    cols = BOS:SAS,
    names_to = "End",
    values_to = "Duration (mins)"
  ) %>% 
  mutate(
    `Duration (mins)`= janitor::round_half_up(`Duration (mins)`),
    `Duration (hrs)` = janitor::round_half_up(`Duration (mins)` / 60)
  ) %>% 
  arrange(desc(`Duration (mins)`))

Here’s a {DT} interactive table sorted by duration that you can filter. Click the ‘CSV’ button to download the data.

nba_dur_all %>% 
  datatable(
    filter = "top",
    extensions = c("Buttons","Scroller"),
    class = "compact", width = "100%",
    options = list(
      dom = "Blrtip",
      scroller = TRUE, scrollY = 300,
      buttons = list("csv")
    )
)

So an incredible 58 hours of driving to get from Miami to Portland.

Duration: by division

We can also narrow this down to get only the team-pairs that play in the same division as each other.

nba_dur_div <- nba_dur_all %>%
  left_join(select(nba_table, Code, Division), by = c("Start" = "Code")) %>% 
  left_join(select(nba_table, Code, Division), by = c("End" = "Code")) %>% 
  dplyr::filter(Division.x == Division.y, `Duration (mins)` != 0) %>% 
  select(Division = Division.x, everything(), -Division.y) %>% 
  arrange(Division, desc(`Duration (mins)`))

Again, here’s an interactive table that you can use to explore the data. Note that it’s ordered by Division and then duration in minutes. I’ve hidden the code because it’s the same as for the table above.

nba_dur_div %>% 
  datatable(
    filter = "top",
    extensions = c("Buttons","Scroller"),
    rownames = FALSE,
    class = "compact", width = "100%",
    options = list(
      dom = "Blrtip",
      scroller = TRUE, scrollY = 300,
      buttons = list("csv")
    )
)

This time we can see that there’s a maximum of 33 hours of driving required between two teams in the same division: Portland to Oklahoma City.

A quick diversion: routing

We know from using osrm::osrmTable() that Miami to Portland has the longest travel duration. What’s the route?

Fortunately, {osrm} has the function osrmRoute() for fetching the routes between a pair of points.

We can grab a vector of coordinates for each team from our nba_table object and set these as our origin (src) and destination (dst) in osrm::osrmRoute(). The return object is a ‘linestring’ object that contains detail on the coordinates and coordinate system for the route.

# Function to extract latlong vectors for teams
get_ll <- function(data, team_code) {
  team_data <- dplyr::filter(data, Code == team_code)
  lng <- pull(team_data, Longitude)
  lat <- pull(team_data, Latitude)
  lnglat <- c(lng, lat)
  return(lnglat)
}

# Get route between latlong pairs
route <- osrmRoute(
  src = get_ll(nba_table, "MIA"),
  dst = get_ll(nba_table, "POR"),
  returnclass = "sf"
)

route

## Simple feature collection with 1 feature and 4 fields
## geometry type:  LINESTRING
## dimension:      XY
## bbox:           xmin: -122.6658 ymin: 25.78202 xmax: -80.15664 ymax: 45.8407
## CRS:            EPSG:4326
##         src dst duration distance                       geometry
## src_dst src dst 3459.378  5245.24 LINESTRING (-80.18809 25.78...

Now we can set up the same type of {leaflet} map as earlier, but we’ll include only Portland and OKC. I’ve hidden the map definition because it’s almost the same as before.

mia_por <- nba_table %>%
  dplyr::filter(Code %in% c("MIA", "POR"))

mia_por_map <- 
  leaflet(mia_por) %>%
  addProviderTiles(providers$Stamen.TonerLite) %>%  # add basemap
  addAwesomeMarkers(  # add markers
    lng = ~Longitude, lat = ~Latitude,  # coordinates
    popup = ~paste0(  # HTML content for popup info
      "<b>", mia_por$Team, "</b>",  # team name
      "<br>", paste0(mia_por$Arena, ", ", mia_por$City),  # location
      if_else(  # division/conference information
        mia_por$Conference == "Eastern",
        paste0("<br><font color='#0000FF'>", mia_por$Division,
               " Division (Eastern Conference)</font>"),
        paste0("<br><font color='#FF0000'>", mia_por$Division,
               " Division (Western Conference)</font>")
      )
    ),
    icon = awesomeIcons(
      library = "ion", icon = "ion-ios-basketball", # add basketball icon
      markerColor = mia_por$colour_marker,  # colour the marker
      iconColor = mia_por$colour_icon  # colour the basketball icon
    )
  ) %>%
  addMeasure()  # add straight-line distance-measuring tool

And to that map we can add the line that defines the route

mia_por_map %>% addPolylines(data = st_geometry(route))

That’s a long way.