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

visualisation interactive

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

Emi Tanaka https://emitanaka.org (Monash University)https://numbat.space/
2019-03-26


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

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(googlesheets)
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
key <- gs_key("1T7aH5PzQghU0htnqOjzzEyfe0qdWs_L-1Ybu9PX-rYY")
travel_df <- gs_read(key, col_types = list()) %>%
  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)

Corrections

If you see mistakes or want to suggest changes, please create an issue on the source repository.

Reuse

Text and figures are licensed under Creative Commons Attribution CC BY 4.0. Source code is available at https://github.com/emitanaka/emitanaka.github.io, unless otherwise noted. The figures that have been reused from other sources don't fall under this license and can be recognized by a note in their caption: "Figure from ...".

Citation

For attribution, please cite this work as

Tanaka (2019, March 26). Emi Tanaka: My Travel Schedule 2019: Building an interactive visualisation as twitter card. Retrieved from https://emitanaka.org/posts/travel2019/

BibTeX citation

@misc{travel2019,
  author = {Tanaka, Emi},
  title = {Emi Tanaka: My Travel Schedule 2019: Building an interactive visualisation as twitter card},
  url = {https://emitanaka.org/posts/travel2019/},
  year = {2019}
}