plotly::sublot not showing both titles

Question

I am trying to plot two plotly plots together in R using plotly::subplot. The problem is subplot doesn't show the titles of both the plots. Other answers to similar questions recommend either using facet_wrap or plot_ly, but I am looking for a solution that works with ggplotly.

How can this be fixed?

Sample data with code:

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

You can use 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

As an alternative to subplot, you can use 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)

Then, instead of renderPlotly and plotlyOutput, you have to use renderCombineWidgets and combineWidgetsOutput- see combineWidgets-shiny.