ggplotly() 中跨方面的形状注释

Question

我有一个 Shiny 仪表板，其中包含一个折线图，用于跟踪三年内每月周一至周四和周五至周日的访客数量：

我最初也有一个注释，它为澳大利亚 Covid 大流行期间（即 2020 年 3 月 1 日至今）发生的图表部分添加阴影。当在 ggplot 上调用 ggplotly 时，它会去掉注释。我想要做的是添加 2020-03-01 的阴影以重新呈现。我尝试添加

%>% 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
         ) 
      )

在 ggplotly() 调用之后，但它什么也没做。

我也尝试按照this question 中的代码进行操作，但是阴影不是从正确的日期开始的，而且它也只是在第一个方面。

可重现的代码示例：

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)

Answer 1

此任务比看起来要复杂一些，因为您在 facet_wrap 调用中使用了 scales_free 参数。因此，您需要一个小帮手，它不包含阴影区域的全局限制并使用ggplot2::geom_rect，否则您可以使用ggplot2::annotate（为了完整起见，我也会列出这个选项）。重要的是要记住，至少在使用plotly::ggplotly 时，plotly 似乎存在 INF 作为坐标限制的问题。 （在声明你的总变量之前，我将省略这些行）

# 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) 

我用过的两个资源是：12