Overlaying 2 histograms by 2 groups in plotly - r

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