Sharing axes and legends between subplots in plotly in R (faceting in ggplot2 and using ggplotly doesn't work)

Question

I have the following data:

df <- data.frame(numbers = rep(1:3, 30),
                 letter = sample(c("A", "B", "C", "D"), 90, replace = TRUE),
                 status = sample(c("good", "bad", "ugly"), 90, replace = TRUE))

I am trying to replicate this ggplot2 plot, but make it interactive:

ggplot(df, aes(letter, fill = status)) + geom_bar() + facet_wrap(.~numbers)

If I use ggplotly , then I can select and deselect variables, but the bars do not readjust so I get something that looks like this:

So my idea was to cast the data, then create individual plotly plots and use subplot:

df_group <- df %>% group_by(numbers, letter, status) %>% tally()
df_group_cast <- dcast(df_group, numbers + letter ~ status)

p1 <- df_group_cast %>% 
    filter(numbers == 1) %>%
    plot_ly(x = ~letter, y = ~good, type = 'bar', name = 'good') %>%
    add_trace(y = ~bad, name = 'bad') %>%
    add_trace(y = ~ugly, name = 'ugly') %>%
    layout(yaxis = list(title = 'Count'), barmode = 'stack')

p2 <- df_group_cast %>% 
    filter(numbers == 2) %>%
    plot_ly(x = ~letter, y = ~good, type = 'bar', name = 'good') %>%
    add_trace(y = ~bad, name = 'bad') %>%
    add_trace(y = ~ugly, name = 'ugly') %>%
    layout(yaxis = list(title = 'Count'), barmode = 'stack')

p3 <- df_group_cast %>% 
    filter(numbers == 3) %>%
    plot_ly(x = ~letter, y = ~good, type = 'bar', name = 'good') %>%
    add_trace(y = ~bad, name = 'bad') %>%
    add_trace(y = ~ugly, name = 'ugly') %>%
    layout(yaxis = list(title = 'Count'), barmode = 'stack')

subplot(p1, p2, p3)

This is interactive, but also looks bad. I would like them to share a scale, have one legend, and have titles for each number group.

Is this possible?

(I am trying to embed an interactive graph like this into slidify, if there are better libraries I am open to using them. So far rCharts has failed me, so I'm trying plotly)

Answer 1

I figured it out! Didn't need to cast my data in the end. I have even added a step for adding subgroup titles.

df_group <- df %>% group_by(numbers, letter, status) %>% tally()

Put together annotation texts to add to the plots:

a <- list(
    text = sprintf("<b>1</b>"),
    xref = "paper",
    yref = "paper",
    yanchor = "bottom",
    xanchor = "center",
    align = "center",
    x = 0.5,
    y = 1,
    showarrow = FALSE)

b <- list(
    text = sprintf("<b>2</b>"),
    xref = "paper",
    yref = "paper",
    yanchor = "bottom",
    xanchor = "center",
    align = "center",
    x = 0.5,
    y = 1,
    showarrow = FALSE)

c <- list(
    text = sprintf("<b>3</b>"),
    xref = "paper",
    yref = "paper",
    yanchor = "bottom",
    xanchor = "center",
    align = "center",
    x = 0.5,
    y = 1,
    showarrow = FALSE)

Put together the actual plots, note the "annotations" option under layout. I also didn't need to add all that trace nonsense, coloring by status did the work for me.

p1 <- df_group %>% 
    filter(numbers == 1) %>% 
    group_by(letter) %>% 
    plot_ly(x = ~letter, y= ~n, color = ~status, type = 'bar', legendgroup = ~status) %>% 
    layout(barmode = 'stack', annotations = a)

p2 <- df_group %>% 
    filter(numbers == 2) %>% 
    group_by(letter) %>% 
    plot_ly(x = ~letter, y= ~n, color = ~status, type = 'bar', legendgroup = ~status, showlegend = FALSE) %>% 
    layout(barmode = 'stack', annotations = b)

p3 <- df_group %>% 
    filter(numbers == 3) %>% 
    group_by(letter) %>% 
    plot_ly(x = ~letter, y= ~n, color = ~status, type = 'bar', legendgroup = ~status, showlegend = FALSE) %>% 
    layout(barmode = 'stack', annotations = c)

Plotting:

subplot(p1, p2, p3, shareY = TRUE)

Imgur can't show interactivity, so you will just have to trust that this is interactive and you can select the categories in all plots by clicking on their labels.