Shape annotations across facets in ggplotly()

Question

I have a Shiny dashboard which includes a line graph which tracks number of visitors on mon-thur and fri-sun periods per month for three years:

I originally also had an annotation which shaded the parts of the graph which occur during the Covid pandemic in Australia, i.e. 2020-03-01 to present. When ggplotly is called on the ggplot, it strips the annotations out. What I want to do is add the shading from 2020-03-01 to present back in. I've tried adding

%>% layout(
     shapes = list(
         list(type = "rect",
              fillcolor = "blue", line = list(color = "blue"), opacity = 0.9,
              x0 = "2020-03-01", x1 = Inf,
              y0 = 0, y1 = Inf
         ) 
      )

after the ggplotly() call, but it doesn't do anything.

I also tried following the code in this question, but the shading doesn't start at the correct date, and it's also only on the first facet.

Reproducible code example:

date <- c("2019-01-01","2019-01-01","2019-02-01","2019-02-01","2019-03-01","2019-03-01","2019-04-01",
          "2019-04-01","2019-05-01","2019-05-01","2019-06-01","2019-06-01","2019-07-01","2019-07-01",
          "2019-08-01","2019-08-01","2019-09-01","2019-09-01","2019-10-01","2019-10-01","2019-11-01",
          "2019-11-01","2019-12-01","2019-12-01","2020-01-01","2020-01-01","2020-02-01","2020-02-01",
          "2020-03-01","2020-03-01","2020-04-01","2020-04-01","2020-05-01","2020-05-01","2020-06-01",
          "2020-06-01","2020-07-01","2020-07-01","2020-08-01","2020-08-01","2020-09-01","2020-09-01",
          "2020-10-01","2020-10-01","2020-11-01","2020-11-01","2020-12-01","2020-12-01","2021-01-01",
          "2021-01-01","2021-02-01","2021-02-01","2021-03-01","2021-03-01","2021-04-01","2021-04-01",
          "2021-05-01","2021-05-01","2021-06-01","2021-06-01","2019-01-01","2019-01-01","2019-02-01",
          "2019-02-01","2019-03-01","2019-03-01","2019-04-01","2019-04-01","2019-05-01","2019-05-01",
          "2019-06-01","2019-06-01","2019-07-01","2019-07-01","2019-08-01","2019-08-01","2019-09-01",
          "2019-09-01","2019-10-01","2019-10-01","2019-11-01","2019-11-01","2019-12-01","2019-12-01",
          "2020-01-01","2020-01-01","2020-02-01","2020-02-01","2020-03-01","2020-03-01","2020-04-01",
          "2020-04-01","2020-05-01","2020-05-01","2020-06-01","2020-06-01","2020-07-01","2020-07-01",
          "2020-08-01","2020-08-01","2020-09-01","2020-09-01","2020-10-01","2020-10-01","2020-11-01",
          "2020-11-01","2020-12-01","2020-12-01","2021-01-01","2021-01-01","2021-02-01","2021-02-01",
          "2021-03-01","2021-03-01","2021-04-01","2021-04-01","2021-05-01","2021-05-01","2021-06-01",
          "2021-06-01")
location <- rep(c("1001", "1002"), c(60, 60))
daytype <- rep(c("mon-thur", "fri-sat"), 60)
visitors <- c(5694,6829,3087,4247,2814,4187,5310,6408,5519,5934,2817,4080,6762,6595,5339,6669,
              4863,6137,8607,11974,4909,9103,7986,9493,15431,13044,6176,5997,6458,7694,5990,5419,
              5171,8149,6091,7971,10677,10468,7782,7627,7210,9526,8554,9844,8262,9218,9418,9038,
              13031,13418,7408,10621,6908,8122,8851,8861,7940,9179,5992,7026,7939,6923,8209,7815,
              8190,7085,9136,7905,9784,8454,9467,9092,9183,8436,9029,8927,8828,8323,7679,7112,
              1885,3156,6932,5530,6077,4975,4922,4008,5549,4557,3932,3395,4865,4820,5090,4529,
              5407,4262,4858,4200,5101,4761,5108,4413,5209,4116,5405,4445,4140,2985,5589,4684,
              5322,4540,4898,4214,5266,4188,5184,4555)

total <- data.frame(location, date, daytype, visitors)

mon_year_vis <- total %>%
  ggplot() +
  (
    mapping =
      aes(
        x = as.Date(date),
        y = visitors,
        group = daytype,
        color = daytype
      )
  ) +
  geom_line() +
  geom_point(show.legend = FALSE, size = 1) +
  scale_y_continuous(labels = comma) +
  facet_wrap( ~location, ncol = 1, scales = "free") +
  scale_x_date(date_labels = "%b-%y",
               breaks = "3 month",
               limits = range)


ggplotly(mon_year_vis)

DPH · Answer 1 · 2022-01-07T16:12:13.493

this task is a bit more complex than it appears to be, since you use the scales_free argument in the facet_wrap call. Because of this you need a little helper that holds none global limits of the shaded areas and work with ggplot2::geom_rect else you could use ggplot2::annotate (for completeness I will list this option also). It is important to bear in mind that plotly seems to have issues with INF as limitations for coordinates when using plotly::ggplotly at least. (I will omit the lines until the declaration of your total variable)

# libraries needed to make things work
library(dplyr)
library(ggplot2)
library(plotly)
library(scales)

ggplot2::geom_rect

# needed for coordinates of shadowed area
helper <- total %>% 
              dplyr::group_by(location) %>% 
              dplyr::summarise(mv = max(visitors) , md = max(as.Date(date))) %>%
              dplyr::ungroup()

mon_year_vis <- total %>%
  ggplot() +
  (
    mapping =
      aes(
        x = as.Date(date),
        y = visitors,
            group = daytype,
        color = daytype
      )
  ) +
    # insert the geom_rect before the lines so that plotly gets the layer order right
    geom_rect(data = helper, aes(xmin = as.Date("2020-03-01"), xmax = md, ymin = 0, ymax = mv), alpha = 0.3, fill="blue", inherit.aes = FALSE) +
  geom_line() +
  geom_point(show.legend = FALSE, size = 1) +
  scale_y_continuous(labels = comma) +
  facet_wrap( ~location, ncol = 1, scales = "free") +
  scale_x_date(date_labels = "%b-%y",
               breaks = "3 month",
               limits = range) 


ggplotly(mon_year_vis)

ggplot2::annotate

mon_year_vis2 <- total %>%
  group_by(daytype) %>%
  mutate(maxy = max(visitors)) %>%
  ggplot() +
  (
    mapping =
      aes(
        x = as.Date(date),
        y = visitors,
            group = daytype,
        color = daytype
      )
  ) +
    # insert the annotate before the lines so that plotly gets the layer order right
    annotate("rect", xmin=as.Date("2020-03-01"), xmax=max(as.Date(date)), ymin=0, ymax=max(visitors), alpha=0.2, fill="blue")  +
  geom_line() +
  geom_point(show.legend = FALSE, size = 1) +
  scale_y_continuous(labels = comma) +
  facet_wrap( ~location, ncol = 1, scales = "free") +
  scale_x_date(date_labels = "%b-%y",
               breaks = "3 month",
               limits = range) 


ggplotly(mon_year_vis2)

The two resources I have used are: 1 2

Shape annotations across facets in ggplotly()

1 Answers1