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


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(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 = id(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=id(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)
Avatar
Emi Tanaka
Lecturer in Statistics

My research interests are developing high impact statistical methods and useful, easy-to-use tools for application in bioinformatics, biometrics and biology with a particular focus on agriculture.

comments powered by Disqus