r - plotly::sublot 不显示两个标题

Question

我正在尝试使用 plotly::subplot 在 R 中一起绘制两个 plotly 图。问题是子图不显示两个图的标题。类似问题的其他答案建议使用 facet_wrap 或 plot_ly，但我正在寻找与 ggplotly 配合使用的解决方案。

如何解决这个问题？

带有代码的示例数据:

library(tidyverse)
library(plotly)

# Sample Data
Group_1_2020 = data.frame(Code = c("A", "B", "C"),
                 Count_2020 = c(1,2,3))

Group_2_2020 = data.frame(Code = c("D", "E", "F"),
                          Count_2020 = c(4,5,6))

Group_1_2021 = data.frame(Code = c("A", "B", "C"),
                 Count_2021 = c(4, 8, 6))
Group_2_2021 = data.frame(Code = c("D", "E", "F"),
                          Count_2021 = c(8, 10, 12))

# Merge Datasets
DF_Merged_1 = 
  inner_join(Group_1_2020, Group_1_2021)

DFF_Merged_1 = DF_Merged_1 %>% dplyr::select(Code, Count_2020, Count_2021) %>% 
  gather(key = Type, value = Value, -Code) %>% 
  mutate(Type = ifelse(Type == "Count_2020", "2020", "2021"))

DF_Merged_2 = 
  inner_join(Group_2_2020, Group_2_2021)

DFF_Merged_2 = DF_Merged_2 %>% dplyr::select(Code, Count_2020, Count_2021) %>% 
  gather(key = Type, value = Value, -Code) %>% 
  mutate(Type = ifelse(Type == "Count_2020", "2020", "2021"))


# ggplot
ggplot_1 = DFF_Merged_1 %>% 
  ggplot(aes(x = reorder(Code,Value), y = Value, fill = Type, 
             text = paste("Count:", Value,
                          "<br>", "Offense Code:", Code,
                          "<br>", "Year:", Type))) +
  geom_col(position = "dodge", show.legend = FALSE) +
  xlab("Offense Code") +
  ylab("Count") +
  ggtitle("Arrest Counts for Group 1 in Year 2020 and  2021") +
  theme(axis.text=element_text(size=8)) 

ggplot_2 = DFF_Merged_2 %>% 
  ggplot(aes(x = reorder(Code,Value), y = Value, fill = Type, 
             text = paste("Count:", Value,
                          "<br>", "Offense Code:", Code,
                          "<br>", "Year:", Type))) +
  geom_col(position = "dodge", show.legend = FALSE) +
  xlab("Offense Code") +
  ylab("Count") +
  ggtitle("Arrest Counts for Group 2 in Year 2020 and  2021") +
  theme(axis.text=element_text(size=8)) 

# Interactive Plots
fig1 = ggplotly(ggplot_1, tooltip = "text")  
fig2 = ggplotly(ggplot_2, tooltip = "text")  
subplot(fig1, fig2)

Answer 1

您可以使用注释:

library(plotly)

gg1 <- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) + geom_point()
gg2 <- ggplot(iris, aes(x = Petal.Length, y = Petal.Width)) + geom_point()

pp1 <- ggplotly(gg1)
pp2 <- ggplotly(gg2)

subplot(pp1, pp2, margin = 0.05) %>% 
  layout(annotations = list(
    list(x = 0.2 , y = 1.1, text = "Title 1", showarrow = FALSE, xref='paper', yref='paper'),
    list(x = 0.8 , y = 1.1, text = "Title 2", showarrow = FALSE, xref='paper', yref='paper'))
  )

---

编辑

作为 subplot 的替代方案，您可以使用 manipulateWidget::combineWidgets:

gg1 <- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) + 
  geom_point() + ggtitle("Title1")
gg2 <- ggplot(iris, aes(x = Petal.Length, y = Petal.Width)) + 
  geom_point() + ggtitle("Title2")

pp1 <- ggplotly(gg1)
pp2 <- ggplotly(gg2)

manipulateWidget::combineWidgets(pp1, pp2, nrow = 1)

然后，您必须使用 renderCombineWidgets 和 combineWidgetsOutput，而不是 renderPlotly 和 plotlyOutput - 请参阅 combineWidgets-shiny 。