cornwall_cycle_map_share.R

# ---------------------------
# Purpose of script: Create a map of my cycles from Strava
#
# What this script does:
# 1. Downloads activities from Strava using the API
# 2. Wrangles them and creates yearly data
# 3. Plots the Cornwall bike rides
#
# Author: Dr. Daniel Padfield
#
# Date Created:  2024-11-17
#
# Copyright (c) Daniel Padfield, 2024
# License CC BY-NC - Only noncommercial uses of the work are permitted
#
# ---------------------------
#
# Notes:
#
# ---------------------------

# if librarian is not installed, install it
if (!requireNamespace("librarian", quietly = TRUE)){
  install.packages("librarian")
}

# if BiocManager is not installed, install it
if (!requireNamespace("BiocManager", quietly = TRUE)){
install.packages("BiocManager")
}

# if Biobase is not installed, install it from Bioconductor
if (!requireNamespace("Biobase", quietly = TRUE)){
BiocManager::install("Biobase")
}

# load packages
librarian::shelf(tidyverse, rStrava, ggmap, patchwork, extrafont, lubridate, cowplot, extrafontdb, paletteer, ggthemes, ggborderline)

## ---------------------------

# get fonts
#font_import()
loadfonts()
fonts()

# Strava key
app_name <- 'padpadpadpad'
app_client_id <- 'XXXXX'
app_secret <- 'XXXXX'

# Google elevation API key
GoogleAPI <- 'XXXXX'

# API key for stadia maps
stadia_api <- "XXXXX"

# create token
my_token <- httr::config(token = strava_oauth(app_name, app_client_id, app_secret,app_scope="profile:read_all,activity:read_all,read_all,activity:write"))

# get my activities
my_acts <- get_activity_list(stoken = my_token)
d <- compile_activities(my_acts)

head(d)

# check names
names(d)

#------------------------------------------------------#
# create bounding box for Cornwall and data wrangle ####
#------------------------------------------------------#

# create bounding box for cornwall
# cornwall bounding box
bbox <- c(-5.75, 49.93, -4.82, 50.41)
names(bbox) <- c('left', 'bottom', 'right', 'top')

# subset data to be within bbox
d2 <- dplyr::filter(d, start_latlng1 > bbox[2] & start_latlng1 < bbox[4]
             & start_latlng2 > bbox[1] & start_latlng2 < bbox[3])

# filter activities to be cycles
d2 <- d %>%
  filter(!is.na(map.summary_polyline)) %>%
  filter(type == 'Ride') %>%
  mutate(., date = gsub("T.*$", '', start_date) %>%
                 as.POSIXct(., format = '%Y-%m-%d'),
               EUdate = format(date, '%d/%m/%Y'),
               month = format(date, "%m"),
               day = format(date, "%d"),
               year = format(date, "%Y")) %>%
  filter(year <= 2024)

# subset data to be within bbox
d3 <- dplyr::filter(d2, start_latlng1 > bbox[2] & start_latlng1 < bbox[4]
                    & start_latlng2 > bbox[1] & start_latlng2 < bbox[3])

nrow(d3)
max(as.POSIXct(d3$start_date))
sum(d3$distance)
sum(d3$total_elevation_gain)

# get latitude and longitude for each ride
lat_lon <- d3 %>%
  mutate(key = GoogleAPI) %>%
  group_by(upload_id) %>%
  nest() %>%
  mutate(coords = map(data, ~get_latlon(.$map.summary_polyline, key = .$key)),
         dist = map(coords, ~get_dists(.x$lon, .x$lat))) %>%
  unnest(., data) %>%
  unnest(., c(coords, dist))

head(lat_lon)
names(lat_lon)

# select necessary columns and remove rides that are <12km
lat_lon2 <- lat_lon %>%
  select(., year, lat, lon, dist, total_elevation_gain, distance, upload_id) %>%
  filter(distance > 12)

# data for bar chart of distance for each year
d4 <- d2 %>%
  group_by(year) %>%
  summarise(distance = sum(distance))

# data for cumulative distance through the year
d5 <- d2 %>%
  group_by(year) %>%
  arrange(date) %>%
  mutate(cum_dist = cumsum(distance),
         day_month = as.POSIXct(paste(day, month, sep ='/'), format = "%d/%m")) %>%
  ungroup() 

# create a dataframe for the last day of the year
last_day <- group_by(d5, year) %>%
  filter(cum_dist == max(cum_dist)) %>%
  mutate(day_month = as.POSIXct('31/12', format = "%d/%m")) %>%
  ungroup()

d5 <- bind_rows(d5, last_day)

#--------------------------------#
# download map and make plots ####
#--------------------------------#

# make map of rides
register_stadiamaps(stadia_api, write = FALSE)

p <- get_stadiamap(bbox, zoom = 14, maptype = "stamen_toner") %>% 
  ggmap() 

# set colours
cols <- paletteer::paletteer_c("ggthemes::Green", length(d4$year))

p <- p +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        axis.title = element_blank(),
        plot.background = element_rect(fill = 'black', colour = 'black'),
        panel.border = element_blank()) 

p1 <- p +
  geom_path(aes(x = lon, y = lat, group = upload_id, col = forcats::fct_reorder(year, as.numeric(year))), data = lat_lon2, linewidth = 0.8, alpha = 0.3, show.legend = FALSE) +
  theme(plot.title = element_text(colour = 'white', size = 50,
                                  hjust = 0.5, vjust = -3,
                                  face = "bold"),
        plot.subtitle = element_text(colour = 'white', size = 20,
                                     hjust = 0, vjust = -20,
                                     face = "bold"),
        text = element_text(family = 'Lato')) +
  scale_color_manual(values = cols)

#p1

# make barplot of distance each year
p2 <- ggplot(d4, aes(distance, forcats::fct_reorder(year, as.numeric(year)))) +
  geom_bar(aes(fill = forcats::fct_reorder(year, as.numeric(year))), stat = 'identity', col = 'white', show.legend = FALSE) +
  scale_fill_manual(values = cols) + 
  MicrobioUoE::theme_black(base_size = 24) +
  theme(axis.title.y = element_blank(),
        panel.grid.major = element_blank(),
        panel.border = element_blank(),
        axis.line.x.bottom = element_line(colour = 'white'),
        axis.ticks.y = element_blank(),
        axis.text.y = element_text(hjust= 2),
        text = element_text(family = 'Lato'),
        plot.margin = unit(c(0,0,0,0), 'cm')) +
  labs(x = 'Distance (km)') +
  scale_x_continuous(expand = expansion(mult = c(0, 0.09)), limits = c(0,5300), n.breaks = 5)

p2

# make plot of cumulative distance through the year for each year

date_breaks <- as.POSIXct(c('15/01', '14/02', '15/03', '15/04', '15/05', '15/06', '15/07', '15/08', '15/09', '15/10', '15/11', '15/12'), format = "%d/%m")

# set autocontrast for text
contrast <- function(colour) {
  out   <- rep("black", length(colour))
  light <- farver::get_channel(colour, "l", space = "hcl")
  out[light < 50] <- "white"
  out
}

autocontrast <- aes(colour = after_scale(contrast(fill)))

p3 <- ggplot(d5, aes(day_month, cum_dist, group = year, col = forcats::fct_reorder(year, as.numeric(year)))) +
  geom_borderstep(show.legend = FALSE, borderwidth = .05, linewidth = 1) +
  scale_color_manual(values = cols) +
  scale_fill_manual(values = cols) +
  MicrobioUoE::theme_black(base_size = 24) +
  theme(panel.grid.major = element_blank(),
        axis.title.x = element_blank(),
        panel.border = element_blank(),
        axis.line.y.left = element_line(colour = 'white'),
        axis.line.x.bottom = element_line(colour = 'white'),
        axis.ticks.y = element_blank(),
        text = element_text(family = 'Lato'),
        plot.margin = unit(c(0,0,0,0), 'cm'),
        axis.text.x = element_text(angle = 45, hjust = 0.8, vjust =0.8, size = 14)) +
  labs(y = 'Distance (km)') +
  scale_x_datetime(expand = expansion(mult = c(0.05, 0.075)), breaks = date_breaks, labels = scales::date_format("%b")) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.05)), limits = c(0,5300), n.breaks = 6) +
  ggrepel::geom_label_repel(aes(fontface = 2, label = year, fill = year, !!!autocontrast), data = last_day, size = MicrobioUoE::pts(14), show.legend = FALSE, direction = 'y', nudge_x = 60*60*24*60, segment.colour = 'white', label.size = NA)

p3

#--------------------------------#
# Use cowplot to create print ####
#--------------------------------#

# make main grid
bottom_row <- plot_grid(NULL, p2, p3, NULL, rel_widths = c(0.05, 0.45, 0.45, 0.05), ncol = 4, align = 'hv')

main_plot <- plot_grid(p1, bottom_row,
                       rel_heights = c(0.7, 0.3),
                       ncol = 1) +
  theme(plot.margin = margin(8, 0.5, 5.5, 0.5, unit="cm"),
        plot.background = element_rect(fill="black", color="black"))

sum(d3$distance)
sum(d3$total_elevation_gain)

label_rides <- paste('Number of rides : ', nrow(d3), sep ='')
label_distance <- paste('Total distance : ', sum(d2$distance) %>% round() %>% prettyNum(big.mark = ','), 'km', sep = '')
label_elevation <- paste('Total elevation : ', sum(d2$total_elevation_gain) %>% round() %>% prettyNum(big.mark = ','), 'm', sep = '')
label_ridelong <- paste('Longest ride : ', max(d2$distance) %>% round() %>% prettyNum(big.mark = ','), 'km', sep = '')
label_asof <- paste('As of : ', Sys.Date() %>% format("%d/%m/%Y"))

start_table=0.85
start_table_x=0.07

main_plot_extra <- ggdraw(main_plot) +
  cowplot::draw_image('api_logo_pwrdBy_strava_stack_white.png', x = 0.79, y = 0.001, width = 0.2, height = 0.2, vjust = 0.2) +
  draw_label(label="My rides in Cornwall", x=0.5, y=0.95, size=70, fontfamily = 'Lato', fontface = "bold", color = "white") +
  draw_label(label="where have we been in 12 years of cycling", x=0.5, y=0.91, size=40, fontfamily = 'Lato', fontface = "bold", color = "white") +
  draw_line(x=c(0, 0.15), y=c(0.92, 0.92), size=4, color= "white") +
  draw_line(x=c(0.85, 1), y=c(0.92, 0.92), size=4, color= "white") +
  draw_line(x=c(0, 0.24), y=c(0.055, 0.055), size=3, color= "white") +
  draw_line(x=c(start_table_x, start_table_x+0.2), y=c(start_table, start_table), size=1.5, color= "white") +
  draw_line(x=c(start_table_x, start_table_x+0.2), y=c(start_table - 0.11, start_table - 0.11), size=1.5, color= "white") +
  draw_label(label=label_rides, x=start_table_x, y=start_table-0.015, size=20, fontfamily = 'Lato', color = "white", hjust = 0) +
  draw_label(label=label_distance, x=start_table_x, y=start_table - 0.035, size=20, fontfamily = 'Lato', color = "white", hjust = 0) +
  draw_label(label=label_ridelong, x=start_table_x, y=start_table - 0.055, size=20, fontfamily = 'Lato',  color = "white", hjust = 0) +
  draw_label(label=label_elevation, x=start_table_x, y=start_table-0.075, size=20, fontfamily = 'Lato', color = "white", hjust = 0) +
  draw_label(label=label_asof, x=start_table_x, y=start_table-0.095, size=20, fontfamily = 'Lato', fontface = 'italic', color = "white", hjust = 0) +
  draw_label(label = 'Map tiles by Stamen Design, under CC BY 3.0. Data by OpenStreetMap', y=0.055, x = 0.26, size=20, fontfamily = 'Lato', color = "white", hjust = 0)

# save plot out  
ggsave('plots/cornwall.pdf', main_plot_extra, width = 17, height = 24, units = 'in', bg = 'black', device = cairo_pdf)
ggsave('plots/cornwall.png', main_plot_extra, width = 17, height = 24, units = 'in', bg = 'black')
ggsave('plots/cornwall.jpeg', main_plot_extra, width = 17, height = 24, units = 'in', bg = 'black', device = 'jpeg', dpi = 600)