Граничный горизонтальный расходящийся столбчатый столбец с отрицательными значениями с использованием dplyr и ggplot

Question

Я надеюсь, что этот пример будет понятен. Я хотел бы иметь столбцы с накоплением, где средний столбец охватывает «0», поскольку он представляет нейтральное значение. Это используется со шкалой Лайкерта. Для воспроизводимости использую набор данных по алмазам.

Следующий пример достаточно близок к моему сценарию использования и демонстрирует трудность получения «хороших» или «положительных» данных в правильном порядке (так что нейтральное значение ближе всего к 0).

Вот мой код:

require(tidyverse)

diamonds_new <- diamonds %>%
  mutate(quality = fct_recode(cut, "Very poor" = "Fair", "Poor" = "Good", "Neutral" = "Very Good", "Good" = "Premium", "Excellent" = "Ideal")) %>% 
  select(color, clarity, quality) %>% 
  group_by(color, clarity, quality) %>% count()

diamonds_bad <- 
  diamonds_new %>% filter(quality %in% c("Very poor", "Poor", "Neutral")) %>% 
  mutate(n = ifelse(quality == "Neutral", -n/2, -n))

diamonds_good <- 
  diamonds_new %>% filter(quality %in% c("Neutral", "Good", "Excellent")) %>% 
  mutate(n = ifelse(quality == "Neutral", n/2, n)) # %>% 
#  arrange(color, clarity, desc(quality))  # this doesn't seem to make a difference

ggplot() + geom_col(data = diamonds_bad, aes(x=color, y = n, fill = quality)) +  
  geom_col(data = diamonds_good, aes(x=color, y = n, fill = quality)) + 
  facet_grid(. ~ clarity, scales = "free") + 
  coord_flip()

Я также пытался использовать scale_fill_manual(), но также не нашел способа, чтобы это сработало.

Я полагаю, что это сложнее, чем некоторые существующие примеры, в которых нет осложнений отрицательных значений или необходимости span 0. Что мне не хватает в текущей версии ggplot?

Кроме того, я прав, что положительный и отрицательный набор нужно разделить или, по крайней мере, это легче сделать?

Answer 1

Столбцы, созданные с помощью geom_col, формируются с использованием position_stack, который складывает положительные и отрицательные значения отдельно, где положительные значения складываются вверх, а отрицательные значения вниз. Центральная группа, Neutral в этом примере, настраивается на диапазон 0, устанавливая ее равной половине ее первоначального значения, а затем отображая ее как положительное и отрицательное значение. Кроме того, порядок групп необходимо изменить на положительные значения.

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

library(tidyverse)
#
# summarize groups and save counts in variable quality_cnt
#
  diamonds_cnt <- diamonds %>%
    mutate(quality = fct_recode(cut, "Very_Poor" = "Fair", "Poor" = "Good",
                                "Neutral" = "Very Good", "Good" = "Premium", "Excellent" = "Ideal")) %>%
    select(color, clarity, quality) %>%
    group_by(color, clarity, quality) %>% summarize(quality_cnt = n())

# make function to plot counts    

  plot_ratings <- function(survey, rated_item, rating_cnt, rating, rating_cat, facet = "wrap") {
#
#  Input:   
#         rated_item  =  unquoted variable name of rated items
#         rating = unquoted variable name of ratings for each rated_items; 
#                  variable should be a factor ordered from lowest to highest 
#         rating_cnt = unquoted variable name of counts or frequencies for each rated_item 
#         rated_cat = unquoted variable name of categories of rated items
#         facet  = "grid" for all panels on one row or 
#                   "wrap" to spread panels across multiple rows
#
#  make arguments quosures
#
    rated_item <- enquo(rated_item)
    rating_cnt <- enquo(rating_cnt)  
    rating <- enquo(rating)
    rating_cat <- enquo(rating_cat)
#
# If number of rating levels is odd, find middle rating
#
  rating_levels <- levels(pull(survey, !!rating))
  mid_level <-  ceiling(length(rating_levels)/2)
  mid_rating <- ifelse(length(rating_levels)%%2 == 1, rating_levels[mid_level], NA_character_)  
#
# make local variabels for use with aes
# plot positive and negative columns separately
#
  survey <- survey %>% mutate( rating_plt = !!rating, rating_cnt_plt = !!rating_cnt)

  sp <- ggplot(survey, aes_(x = rated_item,  fill = rating)) + 
        geom_col(data=filter(survey, !!rating %in% tail(rating_levels, mid_level)),
                 aes( y = ifelse(rating_plt == mid_rating, .5*rating_cnt_plt, rating_cnt_plt)),
                 position = position_stack(reverse = TRUE )) +
        geom_col(data=filter(survey, !!rating %in% head(rating_levels, mid_level)),
                 aes( y = ifelse(rating_plt == mid_rating, -.5*rating_cnt_plt, -rating_cnt_plt)),
                 position = "stack") +
        labs(y = rating_cnt) +
        scale_fill_brewer(palette = "RdYlGn", direction = -1) +
        coord_flip() +
        switch(facet,
               grid = facet_grid( facets=rating_cat, scales = "free_x"),
               wrap = facet_wrap( facets=rating_cat, scales = "free_x"))
  plot(sp)
  } 
#
#  Use function to make charts
#
  plot_ratings(diamonds_cnt,  rated_item = color, rating_cnt = quality_cnt, 
               rating = quality, rating_cat = clarity, facet = "wrap")

, который дает график

Answer 2

Как-то так - мое ключевое изменение - перейти от geom_col к geom_rectangle, где вы можете свободно контролировать начало и конец.

diamonds_new <-  diamonds %>%
  mutate(quality = fct_recode(cut, "Very poor" = "Fair", "Poor" = "Good", "Neutral" =     "Very Good", "Good" = "Premium", "Excellent" = "Ideal")) %>% 
  select(color, clarity, quality) %>% 
  group_by(color, clarity, quality) %>% 
  count() %>% 
  group_by(color, clarity) %>% 
  arrange(quality) %>%
  mutate(end = cumsum(n)) %>%  
  mutate(start = end-n) %>%
  mutate(offset = (end[quality=="Neutral"] + start[quality=="Neutral"])/2) %>%   
  mutate(start = start - offset,
         end = end - offset) %>%
  mutate(colStart = as.numeric(color) + 0.25,
         colEnd = as.numeric(color) + 0.75)

Увидев второй ответ (и не увидев никакого ввода от OP), я также включил альтернативную фасетку.

ggplot() + 
    geom_rect(data = diamonds_new, aes(xmin=colStart, xmax=colEnd, ymin=start, ymax=end, fill = quality)) +  
    facet_wrap(. ~ clarity, scales="free_x") +        
    coord_flip()

Ответ WaltS сохраняет уровни факторов на оси Y, что, безусловно, ближе к исходному вопросу. Тем не менее, это требует значительного изменения данных, поэтому я думаю, что есть смысл в сохранении моего альтернативного ответа.

Если ноль должен быть центрирован на панелях, вам необходимо соответственно настроить xlim.