У меня есть data.table, и я хотел бы создать гистограмму (или гистограмму) по 2 группам в сюжете
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")
Вот результат, который я хочу получить (сделанный с помощью ggplot), и я не хочу использовать ggplotly(...)
Я не знаю, нужно ли мне обрабатывать данные, как показано ниже, для создания гистограммы вместо гистограммы.
dt = dt[, .N, by = .(x, group1, group2)]
dt = dcast(dt,
group1 ~ x + group2,
value.var = c("N"))
Сначала вы говорите, что хотите сделать это сюжетно, а затем говорите: «Я не хочу использовать ggplotly (...)».
есть разница в создании графика полностью с использованием plotly, а не в создании его в ggplot и преобразовании с помощью ggplotly
@I_O, поскольку цель гистограммы состоит в том, чтобы дискретизировать числовые переменные / переменные отношения на основе частотных диапазонов, а гистограмма чаще всего используется для категориальных / номинальных частот, не является ли идея спрашивающего извлечь выгоду из агрегации данных Plotly для гистограмм? Напротив, Plotly по своей сути не считается гистограммой. Можно ли сказать, что такая же неадекватность присутствует в гистограмме?
@Kat, гистограммы и гистограммы IMO - действительно ценные (и, возможно, даже недооцененные) визуализации. Не в последнюю очередь потому, что наше зрительное восприятие так искусно оценивает разницу в росте («могу ли я съесть эту штуку или она съест меня?») по сравнению, например, с г. углы, как на круговых диаграммах. Однако для этого эффекта элементы должны иметь одну и ту же базовую линию (не базовую линию), что имеет место для нижней части, но не для следующих гистограмм стека. Я считаю, что одна из самых сложных схем — это наборы дробей с цветовой кодировкой.
Я предполагаю, что все сводится к цели визуализации... упростить информацию или сделать ее менее сложной, более легкой для понимания... и все такое... Я отслеживаю.
Вы можете сделать что-то подобное в нескольких строках кода. Если вы хотите, чтобы все детали были выстроены так, как вы нарисовали, это «еще немного».
Кстати, я использовал
set.seed(34)
, если вы хотели увидеть точно такой же сюжет.
# 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')
(Я не включил в изображение заголовок или легенду оси; я просто пытаюсь подчеркнуть отсутствие пробела)
Вы всегда можете продолжить изменять этот график в соответствии с желаемым графиком. Однако вы не получите желаемых промежутков между стержнями.
В качестве альтернативы вы можете использовать subplot
и создать отдельный график для каждого из уникальных значений, используемых для огранки исходного графика.
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
С помощью еще нескольких строк кода вы можете добавить маркировку, как показано на гранях ggplot
.
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
Некоторый «мета» комментарий: наложение двух гистограмм приведет к ступенчатой, а не гладкой базовой линии второй гистограммы. Это мешает реальной цели гистограммы, т.е. е. простое визуальное сравнение частот по высоте столбца / длине полосы.