Overlaying percentages on top of individual bars in Likert

问题

I want to add labels as percentages to the individual bars of my Likert chart. Is there an easy way to do this? I've tried using geom_text, adjusting ordering commands, and enabling "plot.percents = TRUE." None of these things seem to work.

My code, data, and current plot below.

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

回答1:

You have a weird issue with the positioning of your percentage on left and right that do not match your column values. Even weirder, using Centered = TRUE, your different values are correctly ordered and are matching your percentages display:

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

Anyway, if you are looking for a solution using ggplot2 instead of likert, you can start by manipulating the results of Likert in order to get it in a longer format as follow:

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

Then, you can add the ggplot part and use geom_text to display all desired labels:

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... ")

Does it answer your question ?

Reproducible example

I used a dataset that you display in your previous question (How do I output the correct percentages on each bar of my Likert chart?)

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))

来源：https://stackoverflow.com/questions/61369850/overlaying-percentages-on-top-of-individual-bars-in-likert

标签

ggplot2

dplyr

visualization

likert