Наложение процентов поверх отдельных баров в Лайкерте

Question

Я хочу добавить метки в процентах к отдельным столбцам моего графика Лайкерта. Есть ли простой способ сделать это? Я попытался использовать geom_text, настроить команды упорядочения и включить "plot.percents = TRUE". Кажется, что ничего из этого не работает.

Мой код, данные и текущий график ниже.

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

setwd("~/Desktop/")

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

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

df[2] <- lapply(df[2], factor, levels = 1:4)
myplot <- likert(df[2], 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),
        aspect.ratio = 1/6)

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

Answer 1

У вас странная проблема с позицией вашего процента влево и вправо, которые не соответствуют значениям столбца. Еще более странно, используя Centered = TRUE, ваши различные значения правильно упорядочены и соответствуют вашему процентному отображению:

plot(myplot, centered = TRUE, ordered = TRUE, col = c("#0A2240", "#3474DA", "#C1A783", "#323A45")) 

В любом случае, если вы ища решение, использующее ggplot2 вместо likert, вы можете начать с манипулирования результатами Likert, чтобы получить его в более длинном формате следующим образом:

library(tidyr)
library(dplyr)

as.data.frame(myplot$results) %>% rowwise() %>%
  mutate(Label_Left = sum(`1`,`2`), Label_Right = `3`+`4`) %>%
  pivot_longer(cols =`1`:`4`, names_to = "Response", values_to = "Percentage") 

# A tibble: 16 x 6
   Group  Item     Label_Left Label_Right Response Percentage
   <fct>  <fct>         <dbl>       <dbl> <chr>         <dbl>
 1 Female cake?          30          70   1              20  
 2 Female cake?          30          70   2              10  
 3 Female cake?          30          70   3              50  
 4 Female cake?          30          70   4              20  
 5 Female cookies?       70          30   1              50  
 6 Female cookies?       70          30   2              20  
 7 Female cookies?       70          30   3              10  
 8 Female cookies?       70          30   4              20  
 9 Male   cake?          66.7        33.3 1              11.1
10 Male   cake?          66.7        33.3 2              55.6
11 Male   cake?          66.7        33.3 3              11.1
12 Male   cake?          66.7        33.3 4              22.2
13 Male   cookies?       66.7        33.3 1              22.2
14 Male   cookies?       66.7        33.3 2              44.4
15 Male   cookies?       66.7        33.3 3              33.3
16 Male   cookies?       66.7        33.3 4               0  

Затем вы можете добавить ggplot часть и используйте geom_text для отображения всех желаемых меток:

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

as.data.frame(myplot$results) %>% rowwise() %>%
  mutate(Label_Left = sum(`1`,`2`), Label_Right = `3`+`4`) %>%
  pivot_longer(cols =`1`:`4`, names_to = "Response", values_to = "Percentage") %>%
  ggplot(aes(x = Group, y = Percentage))+
  geom_col(aes(fill = Response), position = position_stack(reverse = TRUE))+
  geom_text(data = . %>% filter(Percentage !=0), 
            aes(fill = Response, label = scales::percent(Percentage/100)), 
            position = position_stack(reverse = TRUE,0.5), color = "white")+
  scale_fill_manual(values =  c("#0A2240", "#3474DA", "#C1A783", "#323A45"))+
  scale_y_continuous(labels = function(x) scales::percent(x/100), name = "")+
  coord_flip()+
  facet_wrap(~Item, ncol = 1)+
  geom_text(data = . %>% distinct(Group, Item, Label_Left), 
            aes(x = Group, y = 0, label = scales::percent(round(Label_Left,0)/100)), hjust = 1)+
  geom_text(data = . %>% distinct(Group, Item, Label_Right), 
            aes(x = Group, y = 100, label = scales::percent(round(Label_Right,0)/100)), hjust = 0)+
  theme(legend.position = "bottom",
        axis.title.y = element_blank())+
  labs(title = "How much do you like... ")

Отвечает ли он на ваш вопрос?

---

Воспроизводимый пример

Я использовал набор данных, который вы отображаете в предыдущем вопросе ( Как вывести правильные проценты на каждом столбце моего графика Лайкерта? )

df <- data.frame(gender = c(rep(c("Male","Female"), each = 9),"Female"),
                 cake = c(3,2,2,4,2,2,2,1,4,1,3,3,3,1,4,4,3,2,3),
                 cookie = c(1,2,2,2,3,3,3,1,2,1,1,4,4,1,3,2,2,1,1))