Как построить две переменные рядом в одном и том же ggplot, используя geom_col?

Question

У меня есть следующие данные

structure(list(id = 1:7, date = c(2019L, 2019L, 2019L, 2019L, 
2019L, 2019L, 2019L), station = structure(1:7, .Label = c("41B004", 
"41B011", "41MEU1", "41N043", "41R001", "41R012", "41WOL1"), class = "factor"), 
    days = c(6L, 21L, 5L, 9L, 13L, 14L, 3L), mean3y = c(8.33, 
    21.3, NA, 10, 11.3, 16.3, 3.67), environ = structure(c(3L, 
    4L, 2L, 1L, 3L, 4L, 3L), .Label = c("Industriel avec influence modérée du trafic", 
    "Urbain avec faible influence du trafic", "Urbain avec influence modérée du trafic", 
    "Urbain avec très faible influence du trafic"), class = "factor")), class = "data.frame", row.names = c(NA, 
-7L))

, которые наносятся с помощью следующего кода ggplot

ggplot(data, aes(x = reorder(station, -days), 
                 y = days, fill = environ)) + 
  geom_col(width = 0.5, colour = "black", size = 0.5) + 
  guides(fill = guide_legend(ncol = 2)) +
  geom_text(aes(label = days), 
            vjust=-0.3, color="black", size = 3.5) +
  geom_hline(aes(yintercept = 25), 
             linetype = 'dashed', colour = 'red', size = 1) +
  labs(x = '', y = bquote("Nombre de jours de dépassement de NET60" ~ O[3] ~ "en 2019")) +
  theme_minimal() + 
  theme(legend.position="bottom", legend.title = element_blank(), 
        legend.margin=margin(l = -2, unit='line'),
        legend.text = element_text(size = 11),
        axis.text.y = element_text(size = 12), 
        axis.title.y = element_text(size = 11), 
        axis.text.x = element_text(size = 11),
        panel.grid.major.x = element_blank()) + 
  geom_hline(yintercept = 0)

, генерирующего число .

Я хотел бы также добавить на этом рисунке переменную mean3y помимо days для каждого значения x с использованием другого geom_col, например

p <- ggplot(data, aes(x = reorder(station, -days), 
                      y = days, fill = environ)) + 
  geom_col(width = 0.5, colour = "black", size = 0.5) + 
  guides(fill = guide_legend(ncol = 2)) +
  geom_text(aes(label = days), 
            vjust=-0.3, color="black", size = 3.5) +
  geom_col(aes(x = reorder(station, -days), 
               y = mean3y, fill = environ), 
           inherit.aes = FALSE,
           width = 0.5, colour = "black", size = 0.5) +
  geom_hline(aes(yintercept = 25), 
             linetype = 'dashed', colour = 'red', size = 1) +
  labs(x = '', y = bquote("Nombre de jours de dépassement de NET60" ~ O[3] ~ "en 2019")) +
  theme_minimal() + 
  theme(legend.position="bottom", 
        legend.title = element_blank(), 
        legend.margin=margin(l = -2, unit='line'),
        legend.text = element_text(size = 11),
        axis.text.y = element_text(size = 12), 
        axis.title.y = element_text(size = 11), 
        axis.text.x = element_text(size = 11),
        panel.grid.major.x = element_blank()) + 
  geom_hline(yintercept = 0)

Однако я не смог достичь желаемого результата Несмотря на использование position = "dodge", как показано на этом рисунке , где обе переменные перекрываются.

Есть ли способ достичь этого, пожалуйста? Большое спасибо.

Answer 1

Позиционные уклоны работают только в одном слое, а не между несколькими слоями. Вы можете решить проблему, подтолкнув их вручную или отформатировав данные таким образом, чтобы их можно было избежать. Примеры обоих в приведенном ниже коде.

Ваши данные было трудно скопировать в мою сессию R, а ваш код был более сложным, чем необходимо, чтобы продемонстрировать проблему, поэтому я собрал оба минимума.

library(ggplot2)

df <- data.frame(
  x = c("A", "B"), 
  y = c(10, 15),
  z = c(12, 9)
)

# Example of nudging
# Choose width and nudge values manually to fit your data
ggplot(df, aes(x, y)) +
  geom_col(aes(fill = "first col"), 
           width = 0.45,
           position = position_nudge(x = -0.225)) +
  geom_col(aes(y = z, fill = "second_col"), 
           width = 0.45,
           position = position_nudge(x = 0.225))

library(dplyr)
#> Warning: package 'dplyr' was built under R version 3.6.3
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

# Example of dodging + data formatting
ggplot(mapping = aes(x, y)) +
  geom_col(data = rbind(mutate(df, a = "first_col"),
                        mutate(df, y = z, a = "second_col")),
           aes(fill = a),
           position = "dodge")

^{Создано в 2020-04-16 пакетом Представить (v0.3.0 )}

Answer 2

Один из способов добиться этого - преобразовать данные в длинный формат, например, с помощью tidyr::pivot_longer, чтобы переменные, которые мы хотим отобразить, были категориями одной переменной. Чтобы получить порядок станций, я переупорядочиваю station в соответствии с days, прежде чем конвертировать в long. Чтобы получить столбцы рядом, я использую position_dodge2 в geom_col и geom_text. Чтобы показать, какой столбец соответствует какой переменной, я поместил названия переменных в метки над столбцами.

library(ggplot2)
library(dplyr)
library(tidyr)

data1 <- data %>% 
  mutate(station = forcats::fct_reorder(station,-days)) %>% 
  pivot_longer(c(days, mean3y), names_to = "var", values_to = "value")

my_labels <- function(x) {
  gsub("(days.|mean3y.)", "", x)
}

    p <- ggplot(data1, aes(x = station, y = value, fill = environ)) + 
  geom_col(position = position_dodge2(preserve = "single"), colour = "black") + 
  guides(fill = guide_legend(ncol = 2)) +
  geom_text(aes(label = paste(var, "\n", value)), position = position_dodge2(width = .9, preserve = "single"), vjust=-0.3, color="black", size = 3.5) +
  scale_x_discrete(labels = my_labels) +
  geom_hline(aes(yintercept = 25), linetype = 'dashed', colour = 'red', size = 1) +
  labs(x = '', y = bquote("Nombre de jours de dépassement de NET60" ~ O[3] ~ "en 2019")) +
  theme_minimal() + theme(legend.position="bottom", legend.title = element_blank(), legend.margin=margin(l = -2, unit='line'),
                          legend.text = element_text(size = 11),
                          axis.text.y = element_text(size = 12), axis.title.y = element_text(size = 11), 
                          axis.text.x = element_text(size = 11),
                          panel.grid.major.x = element_blank()) + geom_hline(yintercept = 0)

Answer 3

Рассмотрим это возможное решение для вашего набора данных - хотя вы можете поэкспериментировать с эстетикой. Я попытался сохранить эстетику как можно более похожей и установить столбцы одинакового цвета (на основе df$environ), но с помощью текстовых меток сделать разницу между "days" и "mean3y".

Подготовка данных

Сначала нам нужно взять информацию из двух столбцов и объединить их: «days» и «mean3y». В вашем исходном фрейме данных эти два столбца можно (и нужно) объединить, чтобы показать значение type и само значение . Мы хотим преобразовать данные этого типа:

  day.type.1 day.type.2
1          4          1
2          5          3
3          6          4
4          7          5

В данные этого типа:

    day.type day.value
1 day.type.1         4
2 day.type.1         5
3 day.type.1         6
4 day.type.1         7
5 day.type.2         1
6 day.type.2         3
7 day.type.2         4
8 day.type.2         5

В приведенном выше примере вы можете использовать функцию gather() из dplyr:

t %>% gather('day.type', 'day.value')

Если мы применим это к вашему фрейму данных, мы должны указать, чтобы сделать это для фрейма данных, , но игнорировать другие столбцы :

df1 <- df %>% gather('variable', 'value', -date, -station, -environ)

Это преобразует ваши столбцы "days" и "mean3y" в два новых столбца, которые называются "variable" (это либо "days", либо "mean3y") и "value" (это фактическое число)

Мне также пришлось преобразовать новый столбец "value" в число c ... но это могло быть связано с тем, как мне пришлось импортировать ваши данные, что было ... сложно. Обратите внимание, что рекомендуется включать ваш набор данных в будущие вопросы через вывод dput(your.data.frame) ... поверьте мне, это все меняет. ;)

Построение нового набора данных

Здесь идея состоит в том, чтобы сохранить ту же ось x, но теперь мы устанавливаем «значение» как y aestheti c , Кроме того, вы должны убедиться, что включили group= aestheti c от "variable", чтобы уклонение работало надлежащим образом для текста и столбцов. Если вы не знакомы, термин «уклонение» - это термин, когда геом является «расщеплением» по оси aestheti c: как «подмножество» значений дискретной оси.

Вызов geom_col установлен на position='dodge' ... мало что там меняется. Вам это нужно, потому что по умолчанию position установлено как «сложенный» (именно поэтому ваша попытка привела к тому, что столбцы «сложены» друг над другом.

В вызове geom_text происходит несколько вещей. :

• Устанавливается здесь уклонение с position=position_dodge(), которое позволяет вам указать, как далеко друг от друга будет находиться "уклонение". Это позволило мне отделить "pu sh" от метки должны быть немного шире, чтобы текст выглядел нормально и не попадал в соседний столбец. Чем больше аргумент width= в position_dodge(), тем больше "раздвигали" метки. Значение 0 помещало бы метки в центре оси x по умолчанию - эстетика c ... 0,5.

• Метка эстетики c на самом деле использует столбцы «переменная» и «значение» в качестве способ отличить ваши столбцы друг от друга. Я использовал paste0 и вставил '\n' между ними, чтобы у вас было две строки и уместился в них. Пришлось тоже немного отрегулировать размер.

• По умолчанию метки будут располагаться прямо в точке y ( значение), что будет означать, что они будут совпадать с вашими столбцами. Вам нужно «подтолкнуть» их, но вы не можете использовать nudge_y, чтобы набрать sh их, потому что вы не можете объединить nudge_y с position. Что делать? Ну, мы можем просто перезаписать значение по умолчанию y aestheti c, установив его равным y + "число", чтобы подтолкнуть их вверх. Намного лучше сделать это следующим образом.

Вот окончательный код:

ggplot(df1, aes(x = reorder(station, -value),
                 y = value, fill = environ,
                group=variable)) + 
    geom_col(width = 0.5, colour = "black", size = 0.5, position='dodge') + 
    guides(fill = guide_legend(ncol = 2)) +
    geom_text(aes(label = paste0(variable,'\n', value), y=value+1.5), 
              color="black", size = 3,
              position=position_dodge(0.7)) +
    geom_hline(aes(yintercept = 25), 
               linetype = 'dashed', colour = 'red', size = 1) +
    labs(x = '', y = bquote("Nombre de jours de dépassement de NET60" ~ O[3] ~ "en 2019")) +
    theme_minimal() + 
    theme(legend.position="bottom", legend.title = element_blank(), 
          legend.margin=margin(l = -2, unit='line'),
          legend.text = element_text(size = 11),
          axis.text.y = element_text(size = 12), 
          axis.title.y = element_text(size = 11), 
          axis.text.x = element_text(size = 11),
          panel.grid.major.x = element_blank()) + 
    geom_hline(yintercept = 0)