r - 使用多个 geom 时如何消除 ggplotly 重复的图例条目

Question

我正在尝试在 R 中制作一个多面绘图线图，无论有多少组可用于分面，它都会生成一个图。当运行下面的代码时，我得到了一个理想的绘图，如下图所示

# R 3.6.0
# most of these packages not necessary 

library(shiny)
library(dplyr)
library(ggplot2)
library(bslib)
library(plotly)
library(readxl)
library(janitor)
library(tidyr)
library(lubridate)
library(DT)
library(stringr)
library(scales)
library(shinydashboard)
library(shinyBS)

times <- sample_data %>% 
  mutate(pre_start_time = if_else(pre_start_time == 999,
                                  NA_real_,
                                  pre_start_time),
         pre_end_time = if_else(pre_end_time == -999,
                                NA_real_,
                                pre_end_time))
plot <-
  sample_data %>%
  ggplot() +
  facet_wrap(~Group) +
  geom_line(aes(x = hour_ending,
                y = actual,
                color = "Actual"),
            linetype = 1) +
  geom_line(aes(x = hour_ending,
                y = baseline,
                color = 'Predicted'),
            linetype = 2) +
  scale_color_manual(values = c("grey","orange")) +
  labs(y = "Average", x = "Hour Ending") +
  theme(
    text = element_text(size = 14),
    strip.background = element_rect(fill = "white"),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank()
  )
ggplotly(p = plot)

但是，在添加阴影矩形时，我得到了每个 X 图的所有 4 个变量的重复图例条目。有谁知道为什么这个问题只在使用多个 geom 时出现，以及如何解决它？我真的很感激任何见解! (底部的样本数据)

times <- sample_data %>% 
  mutate(pre_start_time = if_else(pre_start_time == 999,
                                  NA_real_,
                                  pre_start_time),
         pre_end_time = if_else(pre_end_time == -999,
                                NA_real_,
                                pre_end_time))
plot <-
  sample_data %>%
  ggplot() +
  facet_wrap(~Group) +
  geom_rect(aes(xmin = start_time,
                xmax = end_time,
                fill = "Event"),
  ymin = -9999,
  ymax = 9999,
  color = NA,
  alpha = .5,
  data = times) +
  geom_rect(aes(xmin = pre_start_time,
                xmax = pre_end_time,
                fill = "Pre"),
  ymin = -9999,
  ymax = 9999,
  color = NA,
  alpha = .5,
  data = times) +
  scale_fill_manual(values = c("green","blue")) +
  geom_line(aes(x = hour_ending,
                y = actual,
                color = "Actual"),
            linetype = 1) +
  geom_line(aes(x = hour_ending,
                y = baseline,
                color = 'Predicted'),
            linetype = 2) +
  scale_color_manual(values = c("grey","orange")) +
  labs(y = "Average", x = "Hour Ending") +
  theme(
    text = element_text(size = 14),
    strip.background = element_rect(fill = "white"),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank()
  )
ggplotly(p = plot)

SAMPLE DATA:
sample_data <- structure(list(Group = c("A", "A", "A", "A", "A", "A", "A", "A", 
"A", "A", "A", "A", "A", "A", "A", "A", "B", "B", "B", "B", "B", 
"B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "C", "C", 
"C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
"C", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", 
"D", "D", "D", "D", "E", "E", "E", "E", "E", "E", "E", "E", "E", 
"E", "E", "E", "E", "E", "E", "F", "F", "F", "F", "F", "F", "F", 
"F", "F", "F", "F", "F", "F", "F", "F", "F", "F", "G", "G", "G", 
"G", "G", "G", "G", "G", "G", "G", "G", "G", "G", "G", "G", "G", 
"G", "G", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", 
"H", "H", "H"), hour_ending = c(9, 10, 11, 12, 13, 14, 15, 16, 
17, 18, 19, 20, 21, 22, 23, 24, 9, 10, 11, 12, 13, 14, 15, 16, 
17, 18, 19, 20, 21, 22, 23, 24, 9, 10, 11, 12, 13, 14, 15, 16, 
17, 18, 19, 20, 21, 22, 23, 24, 9, 10, 11, 12, 13, 14, 15, 16, 
17, 18, 19, 20, 21, 22, 23, 24, 9, 10, 11, 12, 13, 14, 15, 16, 
17, 18, 19, 20, 21, 22, 23, 24, 9, 10, 11, 12, 13, 14, 15, 16, 
17, 18, 19, 20, 21, 22, 23, 24, 9, 10, 11, 12, 13, 14, 15, 16, 
17, 18, 19, 20, 21, 22, 23, 24, 9, 10, 11, 12, 13, 14, 15, 16, 
17, 18, 19, 20, 21, 22, 23, 24), baseline = c(1.9077010172899, 
2.12655999407884, 2.41197416985174, 2.74162673465276, 3.02372981823073, 
3.33089700968182, 3.57394723410791, 3.15735222677014, 3.37064153193956, 
3.46202303231075, 3.2988268978525, 3.19380273795301, 3.39494847100847, 
3.16423855031123, 2.87590770187347, 2.62242044755453, 1.91837969817177, 
2.09605587597684, 2.35400325616559, 2.69368678708331, 2.95211113587406, 
3.27717322458092, 3.52177416324967, 3.10825406915911, 3.30992929450657, 
3.34630856600525, 3.24255670023855, 3.13894842902663, 3.38353563402117, 
3.16377736634442, 2.90389899178434, 2.58154912964004, 1.75202643782428, 
1.95987962050445, 2.25717577193271, 2.59545475336207, 2.89186581538241, 
3.18750480835101, 3.39609229031208, 3.08689595841167, 3.27283764354886, 
3.35569821773519, 3.22664274768324, 3.06136265180325, 3.32439657273435, 
3.13113242596454, 2.86702712497353, 2.55973838647848, 1.75109886182889, 
1.94067969528731, 2.21892615109579, 2.5357375096388, 2.85580015808717, 
3.16838503064795, 3.36737713160428, 3.01073017248253, 3.20380008801146, 
3.26592992821696, 3.15218179832372, 2.98931304543278, 3.26860865393324, 
3.09314311622858, 2.81770320200115, 2.51619056244461, 1.57306451648199, 
1.7696873344036, 2.02487555543073, 2.30853526084836, 2.57574304849849, 
2.83580654878125, 3.04490645265477, 2.85697900314717, 2.98071356731528, 
3.02137729426674, 2.9368021490555, 2.76006912238545, 2.84629853167221, 
2.6574544153176, 2.43116080779831, 2.19829301763476, 1.58537647490725, 
1.76528344218373, 2.03646190364937, 2.33758795942106, 2.62238206256903, 
2.86905933372095, 3.07361064877158, 2.8195083174373, 2.93217255361853, 
2.98756609399138, 2.88778793775513, 2.7356017384249, 2.86767530092669, 
2.69537094784409, 2.45836024615866, 2.21894264887326, 1.62245774927177, 
1.82860802815701, 2.07450744510814, 2.34192587241523, 2.62803024490283, 
2.91665747411445, 3.13200560169809, 2.88707311113673, 3.03644647227885, 
3.08254098145638, 2.9531395609934, 2.81382526166363, 2.90802138670738, 
2.76746258746592, 2.50629159744597, 2.2731739841822, 1.59609295943048, 
1.79453326340054, 2.0363530676287, 2.31854313612052, 2.60925295344696, 
2.88800151673408, 3.11099128741761, 2.84878965949279, 2.98275723405751, 
3.03282006535505, 2.93744358114238, 2.74668563536776, 2.87923567296551, 
2.69574807527118, 2.45871301999625, 2.22632476442406), actual = c(1.8904080196975, 
2.12062258177981, 2.40065072106929, 2.74594090749209, 3.04580372845586, 
3.34841013014421, 3.60839254308829, 3.19027435807246, 3.43037284558565, 
3.51726697150897, 2.14815335912768, 2.64856841364756, 3.92739711572283, 
3.39669011607457, 3.01470981357721, 2.69987337319733, 1.91719711853307, 
2.10992796332678, 2.3850884086444, 2.72041584806811, 2.99648002619515, 
3.31674197773412, 3.57856254092993, 3.16398821218075, 3.34720366732155, 
2.51604780615586, 2.8949115913556, 2.84865094957433, 3.88275703994761, 
3.42126719056974, 3.04166339227243, 2.70566142763589, 1.74723597867678, 
1.96971125137967, 2.26705156481774, 2.61576501253214, 2.90683435389552, 
3.20529863045216, 3.42776313034561, 3.12242460438547, 3.29840802246858, 
3.37654919425327, 1.89375336897544, 2.39456811321649, 3.91047356982817, 
3.39165267309245, 2.99897419306207, 2.67030894372122, 1.74757193816885, 
1.9339774078478, 2.22320927467301, 2.5438192627824, 2.87210939357907, 
3.18768014268728, 3.3974066587396, 3.04831985731272, 3.23633650416171, 
1.92882520808561, 2.53342449464923, 2.59724613555291, 3.88369797859691, 
3.38403091557669, 2.998112960761, 2.65884542211653, 1.55533834586466, 
1.76554958825636, 2.018141783029, 2.30549588256355, 3.50484783387039, 
3.45882563551736, 3.43867525957752, 2.08158968850698, 2.741858216971, 
2.97298961689939, 1.88632653061224, 2.24816684568564, 3.24166129609739, 
2.89050841389187, 2.50857500895095, 2.23477980665951, 1.58329600597238, 
1.76384845091452, 2.05471071295259, 2.35306084359836, 3.54227696901829, 
3.48377006345651, 3.46728630085853, 2.09081746920493, 2.72126913027249, 
1.87875326614408, 2.36983949234789, 2.42112355356476, 3.29287420679358, 
2.96752892870474, 2.55674132138858, 2.25788353863382, 1.62540127840909, 
1.82145596590909, 2.07686079545455, 2.35802201704545, 2.63303267045455, 
2.94107954545455, 3.14693181818182, 2.90647017045455, 3.05628196022727, 
3.10622869318182, 2.20209872159091, 2.02112926136364, 3.33937855113636, 
2.991015625, 2.60694957386364, 2.30830610795455, 1.58597605224964, 
1.79940856313498, 2.03201378809869, 2.32591436865022, 2.61089985486212, 
2.89880624092888, 3.13890420899855, 2.86659288824383, 2.99750362844702, 
2.44048984034833, 2.24725326560232, 2.20473149492017, 3.35098330914369, 
3.00576560232221, 2.635, 2.322793904209), pre_start_time = c(999, 
999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 
999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 
999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 
999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 
999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 999, 
999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 
999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 
999, 999, 999, 999, 999), pre_end_time = c(-999, -999, -999, 
-999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, 
-999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, 
-999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, 
-999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, 
-999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, 
-999, -999, -999, -999, -999, -999, 15, 15, 15, 15, 15, 15, 15, 
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 
15, 15, 15, 15, 15, 15, 15, 15, 15, -999, -999, -999, -999, -999, 
-999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, 
-999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, 
-999, -999, -999, -999, -999), start_time = c(18, 18, 18, 18, 
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 17, 17, 17, 17, 
17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 17, 17, 17, 17, 
17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 17, 17, 17, 17, 
17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 17, 17, 17, 17, 
17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17), end_time = c(20, 
20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 
20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 
20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 
20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 
20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 
20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 
20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 
20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20)), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -128L))

Answer 1

基本上，在 plotly 中，可以通过 legendgroup 参数对图例进行分组。不幸的是，我不知道有什么方法可以通过 ggplotly 实现这一点。

但是，适应this回答你的情况，实现你想要的结果的一个选择是像这样操作 plotly 对象。:

注意:我在代码中添加了一些更多的解释性注释作为注释。

library(plotly)
library(dplyr)

plot <-
  sample_data %>%
  ggplot() +
  facet_wrap(~Group) +
  geom_rect(aes(
    xmin = start_time,
    xmax = end_time,
    fill = "Event"
  ),
  ymin = -9999,
  ymax = 9999,
  color = NA,
  alpha = .5,
  data = times
  ) +
  geom_rect(aes(
    xmin = pre_start_time,
    xmax = pre_end_time,
    fill = "Pre"
  ),
  ymin = -9999,
  ymax = 9999,
  color = NA,
  alpha = .5,
  data = times
  ) +
  scale_fill_manual(values = c("green", "blue")) +
  geom_line(aes(
    x = hour_ending,
    y = actual,
    color = "Actual"
  ),
  linetype = 1
  ) +
  geom_line(aes(
    x = hour_ending,
    y = baseline,
    color = "Predicted"
  ),
  linetype = 2
  ) +
  scale_color_manual(values = c("grey", "orange")) +
  labs(y = "Average", x = "Hour Ending") +
  theme(
    text = element_text(size = 14),
    strip.background = element_rect(fill = "white"),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank()
  )

gp <- ggplotly(p = plot)

for (i in seq_along(gp$x$data)) {
  # Is the layer the first entry of the group?
  is_first <- grepl("^\\(.*?,1\\)", gp$x$data[[i]]$name)
  # Extract the group identifier and assign it to the name and legendgroup arguments
  gp$x$data[[i]]$name <- gsub("^\\((.*?),\\d+\\)", "\\1", gp$x$data[[i]]$name)
  gp$x$data[[i]]$legendgroup <- gp$x$data[[i]]$name
  # Show the legend only for the first layer of the group 
  if (!is_first) gp$x$data[[i]]$showlegend <- FALSE
}
gp