Likert style plot split out by levels within a factor

Question

I want to create a Likert plot which looks like this:

I have two columns in my dataframe - Age and Overall Satisfaction, both of which are factors. There is an uneven number of individuals in each age bracket. I want to produce a plot like the one above but with each bar in the plot representing a different age range. The plots above was created with the likert package but it doesn't seem to be able to have varying numbers of respondents.

df <- structure(list(Age = c("50-55 yrs", "35-40 yrs", "25-30 yrs", 
"45-50 yrs", "45-50 yrs", "20-25 yrs", "55-60 yrs", "55-60 yrs", 
"50-55 yrs", "45-50 yrs", "50-55 yrs", "55-60 yrs", "55-60 yrs", 
"65+ yrs", "60-65 yrs", "55-60 yrs", "35-40 yrs", "50-55 yrs", 
"45-50 yrs", "40-45 yrs", "45-50 yrs", "40-45 yrs", "30-35 yrs", 
"40-45 yrs", "45-50 yrs", "45-50 yrs", "30-35 yrs", "50-55 yrs", 
"40-45 yrs", "25-30 yrs"), OverallSatisfaction = c("Dissatisfied", 
"Dissatisfied", "Satisfied", "Very Dissatisfied", "Satisfied", 
"Neutral", "Dissatisfied", "Very Dissatisfied", "Very Dissatisfied", 
"Very Dissatisfied", "Very Dissatisfied", "Satisfied", "Satisfied", 
"Satisfied", "Satisfied", "Satisfied", "Neutral", "Neutral", 
"Neutral", "Neutral", "Dissatisfied", "Dissatisfied", "Dissatisfied", 
"Dissatisfied", "Dissatisfied", "Dissatisfied", "Dissatisfied", 
"Neutral", "Dissatisfied", "Neutral")), row.names = c(NA, 30L
), class = "data.frame")

How can I split out the bars by levels within a factor either in the likert package or in ggplot2?

I have tried the following:

ggplot(AgeSat.df, aes(y = OverallSatisfaction, x = Age), position = "stack") +
  geom_col(aes(fill = OverallSatisfaction)) +
  coord_flip()

but what I would like is to have neutrals in the center and the bottom axis (x after the coord_flip) display the percentages as in the likert example above.

Answer 1

If you convert your data to a wide format, plot.likert has no problem plotting it even if the age groups have different sizes.

library("tidyverse")
library("likert")

# Load your example data here....

ages <- sort(unique(df$Age))
satisfaction <- c("Very Dissatisfied", "Dissatisfied", "Neutral",
                  "Satisfied", "Very Satisfied")

# Commented out because it is redundant
# df$Age <- factor(df$Age, levels = ages)
df$OverallSatisfaction <- factor(df$OverallSatisfaction,
                                 levels = satisfaction)

items <- df %>%
  # Need to add an `id` column or `tidyr::spread` will complain.
  mutate(id = row_number()) %>%
  spread(Age, OverallSatisfaction) %>%
  # Need to remove `id` column or `likert::likert` will complain.
  select(-id)

plot(likert(items), type = "bar")

# If you want to specify how to sort the age groups
plot(likert(items), type = "bar", group.order = ages)
# or
plot(likert(items), type = "bar", group.order = rev(ages))

^{Created on 2019-03-04 by the reprex package (v0.2.1)}

Answer 2

Here is a somewhat "hacky" approach that boils down to reformatting your data in a way that it resembles a likert object, and then using plot.likert to plot.

library(tidyverse)
res <- df %>%
    group_by(Age, OverallSatisfaction) %>%
    tally() %>%
    group_by(Age) %>%
    transmute(
        OverallSatisfaction,
        frac = n / sum(n) * 100) %>%
    spread(OverallSatisfaction, frac, fill = 0) %>%
    ungroup() %>%
    mutate(Age = factor(Age)) %>%
    rename(Item = Age) %>%
    as.data.frame()
items <- df %>%
    group_by(Age) %>%
    mutate(n = 1:n()) %>%
    spread(Age, OverallSatisfaction) %>%
    select(-n) %>%
    mutate_all(~factor(., levels = levels(factor(df$OverallSatisfaction)))) %>%
    as.data.frame()

# Manually construct likert object from res and items
library(likert)
data <- list(
    results = res,
    items = items,
    nlevels = length(names(res)[-1]),
    levels = names(res)[-1])
class(data) <- "likert"

# Plot using plot.likert
plot(data)

We can compare results with those from a simple table call

table(df$Age, df$OverallSatisfaction)
#          Dissatisfied Neutral Satisfied Very Dissatisfied
#20-25 yrs            0       1         0                 0
#25-30 yrs            0       1         1                 0
#30-35 yrs            2       0         0                 0
#35-40 yrs            1       1         0                 0
#40-45 yrs            3       1         0                 0
#45-50 yrs            3       1         1                 2
#50-55 yrs            1       2         0                 2
#55-60 yrs            1       0         3                 1
#60-65 yrs            0       0         1                 0
#65+ yrs              0       0         1                 0