我正在尝试绘制两个plotly一起绘制在R using plotly::subplot。问题是子图没有显示titles两者的plots。类似问题的其他答案建议使用facet_wrap or 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)

您可以使用annotations:

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

EDIT

作为替代方案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)

然后，代替renderPlotly and plotlyOutput，你必须使用renderCombineWidgets and combineWidgetsOutput- see 组合小部件-闪亮 https://rdrr.io/cran/manipulateWidget/man/combineWidgets-shiny.html.