R中plotly::subplot合并ggplotly图表无法同时显示双标题如何解决

问题原因 #

plotly::subplot 合并图表时默认会清除单个子图的顶层title配置，仅保留全局title属性，所以ggplot中设置的ggtitle经ggplotly转换后会被覆盖，无法正常显示。

修复代码 #

基于你给出的示例，仅需要对转换后的plotly对象添加子图专属注释标题，同时调整边距避免内容重叠即可，修改后的完整代码如下：

library(tidyverse)
library(plotly)

# 示例数据
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))

# 合并数据集
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("数量:", Value,
                          "<br>", "违规代码:", Code,
                          "<br>", "年份:", Type))) +
  geom_col(position = "dodge", show.legend = FALSE) +
  xlab("违规代码") +
  ylab("数量") +
  ggtitle("2020-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("数量:", Value,
                          "<br>", "违规代码:", Code,
                          "<br>", "年份:", Type))) +
  geom_col(position = "dodge", show.legend = FALSE) +
  xlab("违规代码") +
  ylab("数量") +
  ggtitle("2020-2021年第二组逮捕数量统计") +
  theme(axis.text=element_text(size=8)) 

# 转换为交互式图表
fig1 = ggplotly(ggplot_1, tooltip = "text")  
fig2 = ggplotly(ggplot_2, tooltip = "text")  

# ------------ 核心修改部分开始 ------------
# 给第一个子图添加标题、调整上边距
fig1 <- fig1 %>% 
  layout(
    margin = list(t = 50), # 顶部预留50像素放置标题
    annotations = list(
      list(
        x = 0.5, y = 1.15, # 基于子图自身坐标系顶部居中
        text = ggplot_1$labels$title, # 直接调用ggplot中设置的标题，无需重复编写
        xref = "paper", yref = "paper",
        showarrow = FALSE,
        font = list(size = 14)
      )
    )
  )

# 给第二个子图添加标题、调整上边距
fig2 <- fig2 %>% 
  layout(
    margin = list(t = 50),
    annotations = list(
      list(
        x = 0.5, y = 1.15,
        text = ggplot_2$labels$title,
        xref = "paper", yref = "paper",
        showarrow = FALSE,
        font = list(size = 14)
      )
    )
  )

# 合并子图，设置横向间距避免内容重叠
subplot(fig1, fig2, margin = 0.08)
# ------------ 核心修改部分结束 ------------

参数调整说明 #

• 如果子图是上下排列，只需要调整annotation的y值，以及对应上下边距即可
• 标题位置可以通过调整y参数控制上下偏移，数值越大标题位置越高
• 子图间距可以通过subplot的margin参数调整，取值范围0-1，数值越大间距越宽

内容的提问来源于stack exchange，提问作者Ed_Gravy