Overlaying 2 histograms by 2 groups in plotly

Question

I have a data.table, and I would like to create an histogram (or barplot) by 2 groups in plotly

library(data.table)
library(plotly)
library(ggplot2)

n = 7200
n1 = 4/3*n
n2 = 2*n


dt = data.table(x = sample(rep(c("0-20", "21-40", "41-60", "61-80"), n)),
                group1 = sample(rep(c("A", "B", "C"), n1)),
                group2 = sample(rep(c(0, 1), n2))
)
setorder(dt, x, group1, group2)
dt[, x := factor(x)]
dt[, group1 := factor(group1)]
dt[, group2 := factor(group2)]



ggplot(dt) + geom_bar(aes(x = x, fill = factor(group2)), width = 1) +
  scale_fill_manual(values = c("#9c868b", "#038073"), guide = 'none') + guides(legend = 'none') +
  scale_y_continuous(position = 'right') +
  facet_grid(rows = vars(forcats::fct_rev(group1)), switch = 'y') +
  coord_flip(clip = "off")

Here is the result I want to have (made with ggplot) and I don't want to use ggplotly(...)

I do not know if I have to handle data like below to create barplot instead of histogram

dt = dt[, .N, by = .(x, group1, group2)]
dt = dcast(dt,
        group1 ~ x + group2,
        value.var = c("N"))

Answer 1

You could make something similar in a few lines of code. If you want all the details lined up as you've depicted, it's a 'few more'.

By the way, I used set.seed(34) if you wanted to see the exact same plot.

# not really what you're looking for
plot_ly(subset(dt, group2 == "0"), type = 'histogram', name = 'group 0',
        y = ~list(rev(group1), x), orientation = 'h') %>% 
  add_histogram(subset(dt, group2 == "1"), name = 'group 1',
                y = ~list(rev(group1), x), orientation = 'h') %>% 
  layout(barmode = 'stack')

(I didn't include the axis title or legend in the image; I'm just trying to highlight the lack of gap)

You can always continue to mod this graph toward the desired plot. However, you won't get the gaps you're looking for between the bars.

Alternatively, you could use subplot and make a separate plot for each of the unique values used in faceting in your original plot.

lapply(1:length(unique(dt$group1)), # for each facet...
       function(k) {
         dt <- subset(dt, group1 == unique(dt$group1)[k])             # find facet data
         p <- plot_ly(dt, type = "histogram", color = ~group2,
                      y = ~x, orientation = 'h', showlegend = F) %>%  # no legend
           layout(barmode = 'stack', bargap = 0)
         assign(paste0('p', k), p, envir = .GlobalEnv)                # put in global env
       })

subplot(p1, p2, p3, nrows = 3, titleX = T, shareX = T) %>%            # assemble facets
  layout(xaxis = list(side = 'top', title = 'count', anchor = 'y1'))  # anchor top plot

With a few more lines of code, you can add the labeling as you see in ggplot faceting.

lapply(1:length(unique(dt$group1)), # for each facet...
       function(k) {
         message(print(k))
         dt <- subset(dt, group1 == unique(dt$group1)[k])             # find facet data
         p <- plot_ly(dt, type = "histogram", color = ~group2,
                      y = ~x, orientation = 'h', showlegend = F) %>%  # no legend
           layout(barmode = 'stack', bargap = 0,
                  shapes = list(     # like facet plot this is the gray bar behind label
                    type = "rect", xref = 'x', yref = 'paper',     # set plot 'space'
                    y0 = 0, y1 = 1, x0 = -250, x1 = -50,           # rect limits
                    fillcolor = 'lightgrey',
                    line = list(linewidth = 0.0001, color = 'lightgrey') # remove border
                  ),
                  annotations = list(    # like facet plot, this is the facet label
                    showarrow = F, text = unique(dt$group1),          # no arrow; label
                    xref = 'x', yref = 'paper', x = -150, y = .5,     # center of 'rect'
                    xanchor = 'center', yanchor = 'center', textangle = -90 # rotate text
                  ))
         assign(paste0('p', k), p, envir = .GlobalEnv)                # put in global env
       })

subplot(p1, p2, p3, nrows = 3, titleX = T, shareX = T) %>%            # assemble facets
  layout(xaxis = list(side = 'top', title = 'count', anchor = 'y1'))  # anchor top plot