一个因子内按水平分割的李克特风格图

Question

我想创建一个如下所示的李克特图：

我的数据框中有两列 - 年龄和总体满意度，这两列都是因素。每个年龄段的人数不均。我想制作一个像上面那样的情节，但情节中的每个条形代表不同的年龄范围。上面的图是使用 likert 包创建的，但它似乎无法拥有不同数量的受访者。

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

如何在likert 包或ggplot2 中的因子内按级别拆分条形？

我尝试了以下方法：

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

但我希望在中心和底部轴（coord_flip 后的 x）中设置中性点，以显示上面李克特示例中的百分比。

Answer 1

如果您将数据转换为宽格式，plot.likert 可以毫无问题地绘制它，即使年龄组的大小不同。

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

^{由reprex package (v0.2.1) 于 2019 年 3 月 4 日创建}

Answer 2

这是一种有点“hacky”的方法，归结为以类似于likert 对象的方式重新格式化您的数据，然后使用plot.likert 进行绘图。

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)

我们可以将结果与简单的table 调用的结果进行比较

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