R Annotate heatmap along x-axis (time interval)

Question

# load libraries
library(ggplot2)
library(viridis)
library(lubridate)
library(ggExtra)
library(tidyverse)

# read 
checkin_malaysia_time <- read_csv(file = 'https://raw.githubusercontent.com/MoH-Malaysia/covid19-public/main/mysejahtera/checkin_malaysia_time.csv')

# pivot longer for ggplot
checkin_malaysia_time <- checkin_malaysia_time %>%
 pivot_longer(!date, names_to = "hour", values_to = "count")
checkin_malaysia_time

# date feats
checkin_malaysia_time <- checkin_malaysia_time %>% 
 dplyr::mutate(day = lubridate::day(date),
               month = lubridate::month(date),
               year = lubridate::year(date),
               ith_hour = as.integer(hour),
               yearmon = as.factor(zoo::as.yearmon(date))) %>% 
 dplyr::select(yearmon, day, ith_hour, month, year, count)
# map hour
checkin_malaysia_time$hour <- rep(rep(0:23,each = 2),237)

# hourly data
checkin_malaysia_time_hour <- checkin_malaysia_time %>%
 group_by(yearmon, day, month, year, hour) %>% 
 summarise(count = sum(count)) %>% ungroup()

# plot
p <-ggplot(checkin_malaysia_time_hour,
           aes(day,hour,fill=count))+
 geom_tile(color= "white",size=0.1) + coord_equal() + 
 scale_fill_viridis(name="Hourly checkins",option ="H")
p <-p + facet_wrap(year~month, nrow = 1)
p <-p + scale_y_continuous(trans = "reverse", breaks = seq(0,23,2))
p <-p + scale_x_continuous(breaks =sort(c(1,seq(5,25,5),31)))
p <-p + theme_minimal(base_size = 8)
p <-p + labs(title= paste("Checkin Time Density",' - MySejahtera'), x="Day", y="Hour")
p <-p + theme(legend.position = "right") +
 theme(plot.title=element_text(size = 14))+
 theme(axis.text.y=element_text(size=6)) +
 theme(strip.background = element_rect(colour="white"))+
 theme(plot.title=element_text(hjust=0))+
 theme(axis.ticks=element_blank())+
 theme(axis.text=element_text(size=7))+
 theme(legend.title=element_text(size=8))+
 theme(legend.text=element_text(size=6))+ 
 removeGrid()
p

I would like to annotate the heatmap below based on time interval. For example from 15th Jan to 15th February: lockdown, 11th March 20th March: festive period, 31st May: Outlier

Answer 1

You could draw in the lines "manually" with grid, e.g.

# load libraries
library(tidyverse)
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#> 
#>     date, intersect, setdiff, union
library(ggExtra)
library(grid)
library(pBrackets)

# read 
checkin_malaysia_time <- read_csv(file = 'https://raw.githubusercontent.com/MoH-Malaysia/covid19-public/main/mysejahtera/checkin_malaysia_time.csv')
#> 
#> ── Column specification ────────────────────────────────────────────────────────
#> cols(
#>   .default = col_double(),
#>   date = col_date(format = "")
#> )
#> ℹ Use `spec()` for the full column specifications.

# pivot longer for ggplot
checkin_malaysia_time <- checkin_malaysia_time %>%
  pivot_longer(!date, names_to = "hour", values_to = "count")
checkin_malaysia_time
#> # A tibble: 11,376 x 3
#>    date       hour  count
#>    <date>     <chr> <dbl>
#>  1 2020-12-01 0      6395
#>  2 2020-12-01 1      4052
#>  3 2020-12-01 2      2611
#>  4 2020-12-01 3      2005
#>  5 2020-12-01 4      1660
#>  6 2020-12-01 5      1574
#>  7 2020-12-01 6      1371
#>  8 2020-12-01 7      1421
#>  9 2020-12-01 8      1736
#> 10 2020-12-01 9      3316
#> # … with 11,366 more rows

# date feats
checkin_malaysia_time <- checkin_malaysia_time %>% 
  dplyr::mutate(day = lubridate::day(date),
                month = lubridate::month(date),
                year = lubridate::year(date),
                ith_hour = as.integer(hour),
                yearmon = as.factor(zoo::as.yearmon(date))) %>% 
  dplyr::select(yearmon, day, ith_hour, month, year, count)
# map hour
checkin_malaysia_time$hour <- rep(rep(0:23,each = 2),237)

# hourly data
checkin_malaysia_time_hour <- checkin_malaysia_time %>%
  group_by(yearmon, day, month, year, hour) %>% 
  summarise(count = sum(count)) %>% ungroup()
#> `summarise()` has grouped output by 'yearmon', 'day', 'month', 'year'. You can override using the `.groups` argument.

png(filename = "example_1.png", width = 1080, height = 360)
# plot
p <- ggplot(checkin_malaysia_time_hour,
           aes(day,hour,fill=count))+
  geom_tile(color= "white",size=0.1) + coord_equal() + 
  scale_fill_viridis_c(name="Hourly checkins",option ="H") +
facet_wrap(year~month, nrow = 1) +
scale_y_continuous(trans = "reverse", breaks = seq(0,23,2)) +
scale_x_continuous(breaks =sort(c(1,seq(5,25,5),31))) +
theme_minimal(base_size = 8) +
labs(title= paste("Checkin Time Density",' - MySejahtera'), x="Day", y="Hour") +
  theme(legend.position = "right") +
  theme(plot.title=element_text(size = 14))+
  theme(axis.text.y=element_text(size=6)) +
  theme(strip.background = element_rect(colour="white"))+
  theme(plot.title=element_text(hjust=0))+
  theme(axis.ticks=element_blank())+
  theme(axis.text=element_text(size=7))+
  theme(legend.title=element_text(size=8))+
  theme(legend.text=element_text(size=6))+ 
  removeGrid()
p

grid.brackets(unit(0.4, "npc"), 130, unit(0.52, "npc"), 130, lwd=2, col="red")
grid.text(label = "Festive period", x = unit(0.471, "npc"), y = unit(0.711, "npc"),
          gp=gpar(fontsize=12, col="red"))
grid.brackets(unit(0.29, "npc"), 260, unit(0.18, "npc"), 260, lwd=2, col="red")
grid.text(label = "Lockdown", x = unit(0.232, "npc"), y = unit(0.2, "npc"),
          gp=gpar(fontsize=12, col="red"))
grid.lines(x = unit(c(0.69, 0.69), "npc"),
           y = unit(c(0.2, 0.3), "npc"),
           gp = gpar(col = "red", fill="red"),
           arrow = arrow(length = unit(0.2, "inches"), 
                         ends="last", type="closed"))
grid.text(label = "Outlier", x = unit(0.69, "npc"), y = unit(0.16, "npc"),
          gp=gpar(fontsize=12, col="red"))
dev.off()

^{Created on 2021-07-26 by the reprex package (v2.0.0)}

This approach has the advantages and disadvantages: with some tweaking you can make the annotations look exactly how you want them to look, but you have to specify exactly where on the plot they will be drawn and you can't rescale the plot dynamically i.e. you need to specify the dimensions of the final plot before you draw the lines.

For more info on grid graphics:

• https://bookdown.org/rdpeng/RProgDA/the-grid-package.html
• https://stat.ethz.ch/R-manual/R-devel/library/grid/doc/index.html
• The R Graphics book by Paul Murrell