Winter Sports Heatmap

In this activity, I will create a heat map in leaflet for all of my winter sports activity. Much of the code for creating a heat map comes from this blog by Daniel Cullen.

Sourcing data from Strava

First, we need to set up a token to access Strava’s API. Note: the file secret.R contains my Strava app name, client ID, and my app’s secret code. As such, this is not included in my github repo.

#load app_name, app_client_id, and app_secret from a private file
source("secret.R", local = knitr::knit_global())
#define strava app
app <- oauth_app( app_name, app_client_id, app_secret)

endpoint <- oauth_endpoint(
  request = NULL,
  authorize = "https://www.strava.com/oauth/authorize",
  access = "https://www.strava.com/oauth/token"
)

token <- oauth2.0_token(endpoint, app, as_header = FALSE,
                        scope = "activity:read_all")

Next we pull my activity data from Strava, then reformat it.

#pulling all activity data from Strava's API
df_list <- list()
i <- 1
done <- FALSE
while (!done) {
  req <- GET(
    url = "https://www.strava.com/api/v3/athlete/activities",
    config = token,
    query = list(per_page = 200, page = i)
  )
  df_list[[i]] <- fromJSON(content(req, as = "text"), flatten = TRUE)
  if (length(content(req)) < 200) {
    done <- TRUE
  } else {
    i <- i + 1
  }
}

## Auto-refreshing stale OAuth token.

# compine into one data frame
df <- rbind_pages(df_list)
# filter all winter sports
ski <- df %>% 
  filter(str_detect(type, "Ski|Snow")) %>%
  select(upload_id, type, map.summary_polyline) %>%
  na.omit() %>%
  filter(map.summary_polyline != '')

Heat map

With all of the hard work done, creating a heatmap is easy!

#on map, yellow will be alpine, blue backcountry, green nordic, red snowboard
winterSports <- sort(unique(ski$type)) 
winterSports

## [1] "AlpineSki"      "BackcountrySki" "NordicSki"      "Snowboard"

colors = c("yellow", "blue", "green", "red")
#create basemap
map <- leaflet() %>% 
  addProviderTiles(providers$Stadia.StamenTerrain) %>%
  fitBounds(lng1 = -114.6, lng2 = -113.3, 
            lat1 = 48.1, lat2 = 48.6, )

index <- unique(ski$upload_id)
# loop through all activities, creating a polygonal line for each colored appropriately
for(i in index){
  activity <- ski %>% filter(upload_id == i)
  coords <- googleway::decode_pl(activity$map.summary_polyline)
  map <- addPolylines(map, lng = coords$lon, lat = coords$lat,
                      color = colors[which(activity$type == winterSports)], 
                      opacity = 1/4, weight = 2)
}
#finally, add a legend to the map and show the product
map  %>% addLegend(position= "bottomright", colors = colors, labels = winterSports)