another experiment

simulate some survey data

library(ggstats)
library(tidyverse)
age_cats <- c("18-29", "30-49"," 50-64", "65+")
sex_cats <- c("Male", "Female")
edu_cats <- c('High school or less',  "Some college", "Bachelor's Degree",
              "Postgraduate")
income_cats <- c("Lower Income", "Middle Income", "Upper Income")
likert_cats <- c("strongly oppose", "somewhat_oppose", "neither",
                 "somewhat_favor", "strongly_favor")
likertforce_cats <- c("strongly oppose", "somewhat_oppose", 
                 "somewhat_favor", "strongly_favor")

yes_no <- c("no", "yes")

sample40replaceT <- function(x){
  sample(x, size = 40, replace = T) %>% factor(levels = x)
}




set.seed(12345)
survey <- data.frame(c1 = sample40replaceT(age_cats),
                     c2 = sample40replaceT(sex_cats),
                     c3 = sample40replaceT(edu_cats),
                     c4 = sample40replaceT(income_cats),
                     q1 = sample40replaceT(likert_cats),
                     q2 = sample40replaceT(likert_cats),
                     q3 = sample40replaceT(likert_cats),
                     q4 = sample40replaceT(likertforce_cats),
                     q6 = sample40replaceT(yes_no))

survey |> head()

##       c1     c2                c3            c4              q1              q2
## 1  30-49 Female      Some college  Lower Income  strongly_favor somewhat_oppose
## 2  50-64 Female Bachelor's Degree Middle Income  somewhat_favor somewhat_oppose
## 3    65+ Female Bachelor's Degree Middle Income strongly oppose somewhat_oppose
## 4  30-49 Female      Some college  Lower Income  strongly_favor         neither
## 5    65+   Male Bachelor's Degree  Lower Income  somewhat_favor         neither
## 6    65+ Female Bachelor's Degree Middle Income  strongly_favor strongly oppose
##                q3              q4  q6
## 1  somewhat_favor somewhat_oppose yes
## 2 somewhat_oppose  strongly_favor  no
## 3         neither  strongly_favor  no
## 4 somewhat_oppose  strongly_favor  no
## 5         neither  strongly_favor  no
## 6 strongly oppose  somewhat_favor  no

convenience layer ideas

geom_likert <- function(mapping = NULL, position = ggstats::position_likert(vjust = .5), 
                        stat = ggstats::StatProp, complete = "fill", ...){
  
  geom_bar(mapping = mapping, position = position,
           stat = ggstats::StatProp,
           complete = complete, ...)
  
}

custom_label <- function(x, min_prop = .075) {
  p <- scales::percent(x, accuracy = 1)
  p[x < min_prop] <- ""
  p
}

geom_likert_text <- function(mapping = NULL, stat = ggstats::StatProp,
    position = ggstats::position_likert(vjust = .5),
    complete = "fill", min_prop = .075, ...){ 

  geom_text(mapping = aes(label = custom_label(after_stat(prop), min_prop = min_prop), !!!mapping),
    stat = stat,
    position = position,
    complete = complete, ...
  ) 
  
}

Try them out…

survey %>% 
  ggplot() + 
  aes(y = c1, fill = q1) +
  geom_likert() + 
  geom_likert_text(min_prop = .01) + 
  aes(by = c1) + 
  labs(title = "Difference in responses, single question by single demographic") +
  scale_fill_brewer(palette = "RdYlBu") 

survey %>% 
  pivot_longer(cols = q1:q4) %>% 
  rename(question = name,
         response = value) %>% 
  ggplot() + 
  aes(y = question,   # question
      fill = response) +  # response
  geom_likert() + 
  geom_likert_text(size = 3) + aes(by = factor(question)) +
  scale_fill_brewer(palette = "RdYlBu") + 
  labs(title = "Overview plot of likert responses") #+

  # aes(y = fct_rev(fct_inorder(name)))  #consider reversing order
  

last_plot() +
  facet_wrap(~c2) + 
  labs(title = "Likert responses v. key characteristic")

survey %>% 
  pivot_longer(cols = c1:c4) %>% 
  rename(demographic_cat = value,
         demographic = name) %>% 
  ggplot() + 
  aes(y = demographic_cat, 
      fill = q1) + # response to q1
  geom_likert() + 
  geom_likert_text(size = 3) + aes(by = demographic_cat) + 
  scale_fill_brewer(palette = "RdYlBu") + 
  labs(title = "Likert") + 
  labs(title = "Single question Likert response\nv. several characterisitcs")

last_plot() + 
  ggforce::facet_col(demographic ~ ., 
                     scales = "free_y",
                     space = "free", 
                     strip.position = "left") + 
  labs(subtitle = "Same but more spatial grouping")

what if you have aggregated data? - use weight aes

survey %>% 
  count(c1, q1) %>% # maybe your data is already aggregated
  ggplot() + 
  aes(y = c1, fill = q1) + 
  aes(weight = n) +  #<< use weight aes
  geom_likert() + 
  geom_likert_text(min_prop = .01)  +
  scale_fill_brewer(palette = "RdYlBu") + 
  aes(by = c1)

last_plot() + 
  aes(x = c1, y = NULL)

## Error in `geom_bar()`:
## ! Problem while setting up geom.
## ℹ Error occurred in the 1st layer.
## Caused by error in `compute_geom_1()`:
## ! `geom_bar()` requires the following missing aesthetics: y.

knitr::knit_exit()