Как вывести правильные проценты на каждом столбце моего графика Лайкерта? - PullRequest
2 голосов
/ 22 апреля 2020

Я пытаюсь, чтобы мой код выводил процент в верхней части каждого отдельного бара. Прямо сейчас проценты, показанные ниже, находятся не с той стороны. Мой код объединяет метки 1 и 2 и метки 3 и 4, а затем выводит эти цифры с неправильных сторон.

Существует ли функция для правильной маркировки этих полос? Я включаю мои код, данные из файла .csv и текущая визуализация.

library(ggplot2)
library(reshape)
library(likert)
library(dplyr)

setwd("~/Desktop/")

df <- read.csv("Likert_Test.csv")

df[2:3] <- lapply(df[2:3], as.factor)
colnames(df)[2:3] <- c("cake?", "cookies?")

df[2:3] <- lapply(df[2:3], factor, levels = 1:4)
myplot <- likert(df[2:3], grouping = df$gender)

plot(myplot, centered = FALSE, col = c("#0A2240", "#3474DA", "#C1A783", "#323A45")) +
  scale_y_continuous(labels = function(x) paste0(x, "%")) +
  ggtitle("How much do you like...") +
  theme(legend.title = element_blank(),
        axis.title = element_blank(),
        plot.title = element_text(hjust = 0.5))

enter image description here

    gender      cake         cookies
    Male        3            1    
    Male        2            2         
    Male        2            2
    Male        4            2
    Male        2            3
    Male        2            3
    Male        2            3
    Male        1            1
    Male        4            2
    Female      1            1
    Female      3            1
    Female      3            4
    Female      3            4
    Female      1            1
    Female      4            3
    Female      4            2
    Female      3            2
    Female      2            1
    Female      3            1

1 Ответ

1 голос
/ 22 апреля 2020

Вот пример ответа - использование ggplot без использования пакета likart.



library(tidyverse)
#> Warning: package 'tibble' was built under R version 3.6.3
#> Warning: package 'dplyr' was built under R version 3.6.3
df <- readr::read_table("gender      cake         cookies
    Male        3            1    
    Male        2            2         
    Male        2            2
    Male        4            2
    Male        2            3
    Male        2            3
    Male        2            3
    Male        1            1
    Male        4            2
    Female      1            1
    Female      3            1
    Female      3            4
    Female      3            4
    Female      1            1
    Female      4            3
    Female      4            2
    Female      3            2
    Female      2            1
    Female      3            1")

df %>%
  pivot_longer(-gender, names_to = "question", values_to = "values") %>%
  group_by(gender, question) %>%
  count(values) %>%
  mutate(
    level = case_when(values %in% c(3, 4) ~ "high",
                      values %in% c(1, 2) ~ "low",
                      TRUE ~ "NA"),
    values = as.character(values),
    total_n = sum(n),
    pct_low = sum(n[level == "low"]) / sum(n),
    pct_high = sum(n[level == "high"]) / sum(n)
  ) %>%
  print() %>%
  ggplot(aes(x = gender, y = n, fill = values)) +
  geom_bar(aes(fill = values), position = position_fill(reverse = TRUE), stat = "identity") +
  scale_fill_manual(values = c("#0A2240", "#3474DA", "#C1A783", "#323A45")) +
  scale_y_continuous(labels = scales::percent_format(),
                     expand = expand_scale(mult = .05)) +
  geom_text(aes(
    y = -.05,
    x = gender,
    label = scales::percent(round(pct_low, 2), accuracy = 1)
  ),
  data = . %>% filter(level == "low")) +
  geom_text(aes(
    y = 1.05,
    x = gender,
    label = scales::percent(round(pct_high, 2), accuracy = 1)
  ),
  data = . %>% filter(level == "high")) +
  coord_flip() +
  facet_wrap(~ question, nrow = 2) +
  theme(
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.background = element_blank(),
    axis.line = element_line(colour = "black"),
    plot.title = element_text(hjust = 0.5),
    legend.position = "bottom"
  ) +
  labs(title = "How Much do you like...",
       fill = "",
       x = NULL,
       y = NULL)
#> # A tibble: 15 x 8
#> # Groups:   gender, question [4]
#>    gender question values     n level total_n pct_low pct_high
#>    <chr>  <chr>    <chr>  <int> <chr>   <int>   <dbl>    <dbl>
#>  1 Female cake     1          2 low        10   0.3      0.7  
#>  2 Female cake     2          1 low        10   0.3      0.7  
#>  3 Female cake     3          5 high       10   0.3      0.7  
#>  4 Female cake     4          2 high       10   0.3      0.7  
#>  5 Female cookies  1          5 low        10   0.7      0.3  
#>  6 Female cookies  2          2 low        10   0.7      0.3  
#>  7 Female cookies  3          1 high       10   0.7      0.3  
#>  8 Female cookies  4          2 high       10   0.7      0.3  
#>  9 Male   cake     1          1 low         9   0.667    0.333
#> 10 Male   cake     2          5 low         9   0.667    0.333
#> 11 Male   cake     3          1 high        9   0.667    0.333
#> 12 Male   cake     4          2 high        9   0.667    0.333
#> 13 Male   cookies  1          2 low         9   0.667    0.333
#> 14 Male   cookies  2          4 low         9   0.667    0.333
#> 15 Male   cookies  3          3 high        9   0.667    0.333

Создано в 2020-04-22 с помощью Представить пакет (v0.3.0)

...