# An simple function to turn an xts time series into a ggplot calendar heatmap
# https://margintale.blogspot.com/2018/01/ggplot2-time-series-heatmaps-revisited.html
xts_heatmap <- function(x) {
  data.frame(Date=as.Date(index(x)), x[,1]) %>%
    setNames(c("Date","Value")) %>%
    dplyr::mutate(
      Year=lubridate::year(Date),
      Month=lubridate::month(Date),
      # I use factors here to get plot ordering in the right order without worrying about locale
      MonthTag=factor(Month,levels=as.character(1:12),
                      labels=c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"),ordered=TRUE),
      # week start on Monday in my world
      Wday=lubridate::wday(Date,week_start=1),
      # the rev reverse here is just for the plotting order
      WdayTag=factor(Wday,levels=rev(1:7),labels=rev(c("Mon","Tue","Wed","Thu","Fri","Sat","Sun")),ordered=TRUE),
      Week=as.numeric(format(Date,"%W"))
    ) %>%
    # group by year and month and then calculate the week of the month we are currently in
    dplyr::group_by(Year,Month) %>%
    dplyr::mutate(Wmonth=1+Week-min(Week)) %>%
    dplyr::ungroup() %>%
    ggplot2::ggplot(aes(x=Wmonth, y=WdayTag, fill=Value)) +
    ggplot2::geom_tile(colour="white") +
    ggplot2::facet_grid(Year~MonthTag) +
    ggplot2::scale_fill_gradientn(colours=coolwarm(100), guide="colourbar") +
    ggplot2::labs(x="Week of Month", y=NULL)
}