My Travel Schedule 2019: Building an interactive visualisation as twitter card

Making an interactive schedule heat map with interactive twitter card display.

Hovering over the above graph will show you more details. This year I have a fair bit of travel scheduled including:

• Eco Sta 2019 at Taichung, Taiwan,
• ISI WSC 2019 at Kuala Lumpur, Malaysia,
• YSC 2019 at Canberra, Australia, and
• Biometrics by the Botanic Garden 2019 at Adelaide, Australia.

If you happen to be going to the same conference as myself, do get in touch and maybe you can pay for my taxi? :) (I forgot to put it in my budget …)

The code to make the above graph is shown below. This post benefit largely from this post here to turn plotly output into interactive twitter card.

library(tidyverse)
library(tsibble)
library(googlesheets4)
library(highcharter)
library(widgetframe)

# get the data
date_range <- tibble(
  Dates = as.Date(c("06/03/2019", "12/31/2019"), format = "%m/%d/%Y"),
  Location = "Sydney, Australia"
) # the start to end for schedule show
travel_df <- read_sheet("1T7aH5PzQghU0htnqOjzzEyfe0qdWs_L-1Ybu9PX-rYY") %>%
  mutate(
    Start = as.Date(Start, format = "%m/%d/%Y"),
    End = as.Date(End, format = "%m/%d/%Y")
  ) %>%
  pivot_longer(Start:End, names_to = "Time", values_to = "Dates") %>%
  as_tsibble(key = Event, index = Dates) %>%
  fill_gaps(Time = "Between") %>%
  group_by(Event) %>%
  fill(FullEvent, URL, Location, What, .direction = "down") %>%
  ungroup() %>% # this part feels clumsy.. probably better way to do this
  bind_rows(date_range) %>%
  as_tibble() %>%
  mutate(Key = "All") %>%
  as_tsibble(key = Key, index = Dates) %>%
  fill_gaps(Location = "Sydney, Australia", Event = "", What = "", FullEvent = "") %>%
  mutate(
    Day = substring(weekdays(Dates), 1, 3),
    Week = lubridate::isoweek(Dates)
  ) %>%
  filter(Week != 1)

fntltp <- JS("function(){
              return '<b style=\"color:#DC5084\">' + this.point.event + '</b><br><span style=\"font-size:0.7em\">' +  this.series.yAxis.categories[this.point.y] + ', ' +
             this.point.date + '</span><br><span style=\"font-size:0.7em\">' + this.point.name + '</span><br><span style=\"font-size:0.7em;color:#FFFFCC\">' + this.point.what + '</span><br>'+ this.point.loc;
             }")

hcout <- hchart(travel_df, "heatmap", hcaes(
  x = factor(Week),
  y = factor(Day, levels = c("Sun", "Sat", "Fri", "Thu", "Wed", "Tue", "Mon")),
  group = Location,
  loc = Location,
  event = Event,
  what = What,
  name = FullEvent,
  date = Dates
),
style = list(fontSize = "2em", fontFamily = "Helvetica")
) %>%
  hc_tooltip(formatter = fntltp) %>%
  # hc_tooltip(crosshairs=TRUE, pointFormat = "y: {point.y}<br>x: {point.x}") %>%
  hc_title(text = "My 2019 Travel Schedule", style = list(fontWeight = "bold")) %>%
  hc_subtitle(text = "Hover over the tile to see more information") %>%
  hc_size(height = 225) %>%
  hc_legend(enabled = FALSE) %>%
  hc_yAxis(title = "") %>%
  hc_xAxis(
    title = "", categories = c("Jun", "", "", "", "Jul", "", "", "", "Aug", "", "", "", "Sep", "", "", "", "", "Oct", "", "", "", "Nov", "", "", "", "Dec", "", "", ""),
    endOnTick = FALSE
  ) %>%
  hc_add_theme(hc_theme_538()) %>%
  hc_plotOptions(heatmap = list(borderColor = "black", borderWidth = 1))

frameWidget(hcout)