Вопрос о том, как рисовать параллельный график, используя R и ggplot2

Question

Я стремлюсь нарисовать пирамиду, похожую на прикрепленную.

Я нашел несколько примеров использования ggplot, но я все еще борюсь с принятием моего примера к моим данным (или данным, которые я хочу построить).

structure(list(serial = c(40051004, 16160610, 16090310), DMSex = structure(c(2, 
2, 2), label = "Gender from household grid", labels = c(`No answer/refused` = -9, 
`Don't know` = -8, `Interview not achieved` = -7, `Schedule not applicable` = -2, 
`Item not applicable` = -1, Male = 1, Female = 2), class = "haven_labelled"), 
    dtotac = structure(c(-9, -9, -8), label = "DV: Total actual hours in all jobs and businesses", labels = c(`No answer/refused` = -9, 
    `Don't know` = -8, `Interview not achieved` = -7, `Item not applicable` = -1
    ), class = "haven_labelled")), row.names = c(NA, -3L), class = c("tbl_df", 
"tbl", "data.frame"))

Как я могу преобразовать свои данные и нарисовать двухсторонний график? Или как определить переменные Gender и Dtotac без подразделов?

код, который я использую

library(ggplot2)
library(plyr)
library(gridExtra)

SerialGenderWorkN <- data.frame(Type = sample(c('Male', 'Female', 'Female'), 
                                              11421, replace=TRUE),
                                dtotac = sample (0:60, 11421, replace=TRUE))

WrkFactor <- ordered(cut(SerialGenderWork$dtotac, 
                         breaks = c(0, seq(20, 60, 10)), 
                         include.lowest = TRUE))

SerialGenderWorkN$dtotac <- WrkFactor 

ggplotWrk <- ggplot(data =SerialGenderWorkN, aes(x=dtotac))

ggplotWrk.female <- ggplotWrk + 
  geom_bar(data=subset(SerialGenderWorkN, Type == 'Female'), 
           aes( y = ..count../sum(..count..), fill = dtotac)) +
  scale_y_continuous('', labels = scales::percent) +
  theme(legend.position = 'none', 
        axis.title.y = element_blank(),
        plot.title = element_text(size = 11.5),
        plot.margin=unit(c(0.1,0.2,0.1,-.1),"cm"), 
        axis.ticks.y = element_blank(), 
        axis.text.y = theme_bw()$axis.text.y) + 
  ggtitle("Female") + 
  theme(plot.title = element_text(hjust = 0.5)) + 
  coord_flip()

ggplotWrk.male <- ggplotWrk + 
  geom_bar(data=subset(SerialGenderWorkN,Type == 'Male'), 
           aes( y = ..count../sum(..count..), fill = dtotac)) +
  scale_y_continuous('', labels = scales::percent, 
                     trans = 'reverse') + 
  theme(legend.position = 'none',
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(), 
        plot.title = element_text(size = 11.5),
        plot.margin=unit(c(0.1,0.2,0.1,-.1),"cm")) + 
  ggtitle("Male") + 
  theme(plot.title = element_text(hjust = 0.5)) + 
  coord_flip() + 
  xlab("Work Hours")

## Plutting it together
grid.arrange(ggplotWrk.male, ggplotWrk.female,
             widths=c(0.4, 0.4), ncol=2)

И это вывод

Как я могу переместить «Рабочее время», чтобы показать между «Мужским» и «Женским» участками?

Answer 1

Я нахожу эту проблему очень интересной, и я думаю, что нет идеального решения.Лично я хочу, чтобы все выглядело аккуратно и выровнено, поэтому аргумент gridExtra::grid.arrange top (или bottom для метки оси) не очень радует мой глаз.

Другое решение состоит в использовании фасетов иотредактируйте сюжет с пакетами gtable и grid.Это также не идеально, потому что я не нашел решения для индивидуальной настройки масштабов фасетов.Единственный вариант - освободить весы, добавив scales = "free_x" к фасету.Если максимальный процент с обеих сторон близок, это работает очень хорошо.Если нет, может быть, не так.

Сначала я написал функцию для удаления столбца в гробе.Мы будем использовать его для перемещения меток оси в центр.

library(tidyverse)
library(grid)
library(gtable)

delete_col <- function(x, pattern) {
  t <- x$layout %>% 
    filter(str_detect(name, pattern)) %>% 
    pull(l)

  x <- gtable_filter(x, pattern, invert = TRUE)

  x$widths[t] <- unit(0, "cm")

  x
}

Затем мы создадим данные и базовый график.Два параметра темы необходимы, чтобы установить тексты осей прямо в середине фасетов.

test_data <- rnorm(500, 50, 15) %>% 
  crossing(sex = c("M", "F")) %>% 
  transmute(sex, value = cut(., c(min(.), 20, 40, 60, max(.)), include.lowest = TRUE))

test_data <- test_data %>% 
  count(sex, value) %>% 
  group_by(sex) %>% 
  mutate(p = n/sum(n)) %>% 
  ungroup() %>% 
  mutate(p = if_else(sex == "F", -p, p)) # negative values for the left-hand side.

p1 <- test_data %>% 
  ggplot(aes(value, p)) + 
  facet_wrap(~ sex, scales = "free_x") + 
  geom_col() +
  coord_flip() +
  theme(axis.text.y = element_text(hjust = 0.5, margin = margin(0, 0, 0, 0)),
        axis.ticks.length = unit(0, "pt")) +
  scale_y_continuous(labels = function(x) paste0(abs(x) * 100, "%")) +
  labs(x = NULL)

Теперь это становится немного сложнее.Сначала мы создадим объект grob из объекта ggplot.

p1_g <- ggplotGrob(p1)

Затем мы расширим пространство между фасетами, взяв существующее пространство, занятое текстами оси, и добавив несколько пробелов.Я взглянул на объект grob, чтобы увидеть, какие столбцы какие, используя gtable_show_layout(p1_g).

p1_g$widths[7] <- p1_g$widths[4] + unit(0.5, "cm")

Далее мы отсоединим тексты осей от своего собственного объекта для дальнейшего использования.

p1g_axis <- gtable_filter(p1_g, "axis-l-1-1") 

И, наконец, мы добавим все это вместе.Теперь я знаю, глядя на макет, где все положить.l для левого экстента и t для верхнего экстента.

p1_g %>% 
  gtable_add_grob(p1g_axis, l = 7, t = 8, name = "middle_axis") %>% # add the axis to the middle
  delete_col("axis-l-1-1") %>% # delete the original axis
  gtable_add_grob(textGrob("Label", gp = gpar(fontsize = 11)), l = 7, t = 7) %>% # add the top label
  grid.draw() # draw the result

Answer 2

Вы можете использовать аргумент top и опустить его, используя vjust.

grid.arrange(ggplotWrk.male, ggplotWrk.female,
             widths=c(0.4, 0.4), ncol=2,
             top = textGrob("Work Hours",gp=gpar(fontsize=11,font=1), vjust=2))