Наложение 2 гистограмм на 2 группы в графике

У меня есть 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"))

Некоторый «мета» комментарий: наложение двух гистограмм приведет к ступенчатой, а не гладкой базовой линии второй гистограммы. Это мешает реальной цели гистограммы, т.е. е. простое визуальное сравнение частот по высоте столбца / длине полосы.

I_O 10.01.2023 17:02

Сначала вы говорите, что хотите сделать это сюжетно, а затем говорите: «Я не хочу использовать ggplotly (...)».

IRTFM 11.01.2023 00:56

есть разница в создании графика полностью с использованием plotly, а не в создании его в ggplot и преобразовании с помощью ggplotly

nimliug 11.01.2023 15:02

@I_O, поскольку цель гистограммы состоит в том, чтобы дискретизировать числовые переменные / переменные отношения на основе частотных диапазонов, а гистограмма чаще всего используется для категориальных / номинальных частот, не является ли идея спрашивающего извлечь выгоду из агрегации данных Plotly для гистограмм? Напротив, Plotly по своей сути не считается гистограммой. Можно ли сказать, что такая же неадекватность присутствует в гистограмме?

Kat 12.01.2023 17:01

@Kat, гистограммы и гистограммы IMO - действительно ценные (и, возможно, даже недооцененные) визуализации. Не в последнюю очередь потому, что наше зрительное восприятие так искусно оценивает разницу в росте («могу ли я съесть эту штуку или она съест меня?») по сравнению, например, с г. углы, как на круговых диаграммах. Однако для этого эффекта элементы должны иметь одну и ту же базовую линию (не базовую линию), что имеет место для нижней части, но не для следующих гистограмм стека. Я считаю, что одна из самых сложных схем — это наборы дробей с цветовой кодировкой.

I_O 12.01.2023 21:28

Я предполагаю, что все сводится к цели визуализации... упростить информацию или сделать ее менее сложной, более легкой для понимания... и все такое... Я отслеживаю.

Kat 12.01.2023 23:23
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
1
6
74
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Вы можете сделать что-то подобное в нескольких строках кода. Если вы хотите, чтобы все детали были выстроены так, как вы нарисовали, это «еще немного».

Кстати, я использовал 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

Другие вопросы по теме