R语言：如何用更简洁的dplyr管道实现分组Likert量表百分比统计？

问题描述 #

我有一份包含Likert量表答案的数据集，已经编写了一段R代码来计算各Country分组下不同Likert等级的百分比（代码及输出如下）。请问是否存在更简洁高效的方法，仅使用dplyr函数结合管道操作实现相同结果？

原实现代码 #

likert_levels <- c(
  "Very Dissatisfied",
  "Dissatisfied",
  "Average",
  "Satisfied",
  "Very Satisfied"
)

df <- 
  tibble(
    "q1" = sample(likert_levels, 10, replace = TRUE),
    "q2" = sample(likert_levels, 10, replace = TRUE, prob = 5:1),
    "q3" = sample(likert_levels, 10, replace = TRUE, prob = 1:5),
    "q4" = sample(likert_levels, 10, replace = TRUE, prob = 1:5),
    "q5" = sample(c(likert_levels, NA), 10, replace = TRUE)
  ) %>%
  mutate(across(everything(), ~ factor(.x, levels = likert_levels))) %>%
  mutate(Country = c("USA","BRAZIL","BRAZIL","BRAZIL","USA","GERMANY","ITALY","GERMANY","BRAZIL","USA")) %>%
  relocate(Country,.before=q1)


df$O_1 <- apply(df, 1, function(x) sum(x=="Very Dissatisfied", na.rm=TRUE)) #统计每行的"Very Dissatisfied"数量
df$O_2 <- apply(df, 1, function(x) sum(x=="Dissatisfied", na.rm=TRUE))
df$O_3 <- apply(df, 1, function(x) sum(x=="Average", na.rm=TRUE))
df$O_4 <- apply(df, 1, function(x) sum(x=="Satisfied", na.rm=TRUE))
df$O_5 <- apply(df, 1, function(x) sum(x=="Very Satisfied", na.rm=TRUE))

df$O_sum <-  df$O_1 + df$O_2 + df$O_3 + df$O_4 + df$O_5
df <- df[,-c(2: (ncol(df)-6))]

Likert_df =  as.data.frame (df %>% group_by(Country,O_sum) %>% summarise( 
  OO_1 = sum(O_1) / (n() * (O_sum[1])) * 100,
  OO_2 = sum(O_2) / (n() * (O_sum[1])) * 100,
  OO_3 = sum(O_3) / (n() * (O_sum[1])) * 100,
  OO_4 = sum(O_4) / (n() * (O_sum[1])) * 100,
  OO_5 = sum(O_5) / (n() * (O_sum[1])) * 100 ) ) 

Likert_df$O_sum <- NULL

Likert_df <- as.data.frame(Likert_df %>% group_by(Country) %>% summarise(
  OO_1 = mean(OO_1),
  OO_2 = mean(OO_2),
  OO_3 = mean(OO_3),
  OO_4 = mean(OO_4),
  OO_5 = mean(OO_5) ))

colnames(Likert_df) <- c("Item",  "Strongly Disagree",  "Disagree",  "So So",  "Agree",  "Strongly Agree")
DF = Likert_df

原输出结果 #

DF
     Item Strongly Disagree Disagree So So Agree Strongly Agree
1  BRAZIL                10       25  25.0  30.0             10
2 GERMANY                30       20  20.0  20.0             10
3   ITALY                20       40  20.0   0.0             20
4     USA                 5       10  42.5  17.5             25

优化后的dplyr管道实现 #

可以通过宽表转窄表的思路简化流程，避免手动创建计数列，全程用dplyr管道完成：

likert_levels <- c(
  "Very Dissatisfied",
  "Dissatisfied",
  "Average",
  "Satisfied",
  "Very Satisfied"
)

# 生成原始数据（和原代码一致）
df <- 
  tibble(
    q1 = sample(likert_levels, 10, replace = TRUE),
    q2 = sample(likert_levels, 10, replace = TRUE, prob = 5:1),
    q3 = sample(likert_levels, 10, replace = TRUE, prob = 1:5),
    q4 = sample(likert_levels, 10, replace = TRUE, prob = 1:5),
    q5 = sample(c(likert_levels, NA), 10, replace = TRUE)
  ) %>%
  mutate(across(everything(), ~ factor(.x, levels = likert_levels))) %>%
  mutate(Country = c("USA","BRAZIL","BRAZIL","BRAZIL","USA","GERMANY","ITALY","GERMANY","BRAZIL","USA")) %>%
  relocate(Country,.before=q1)

# 核心计算逻辑：全程dplyr管道
optimized_df <- df %>%
  # 给每行添加唯一标识，用于按行统计
  mutate(row_id = row_number()) %>%
  # 把所有问题列转成窄表：行id、国家、问题回答
  pivot_longer(cols = starts_with("q"), names_to = "question", values_to = "response") %>%
  # 按行和国家分组，统计每行各等级的数量，以及有效回答总数
  group_by(row_id, Country) %>%
  count(response, name = "count") %>%
  mutate(total = sum(count, na.rm = TRUE)) %>%
  # 计算每行各等级占比（转百分比）
  mutate(percent = (count / total) * 100) %>%
  ungroup() %>%
  # 按国家和等级分组，计算平均百分比
  group_by(Country, response) %>%
  summarise(avg_percent = mean(percent, na.rm = TRUE)) %>%
  ungroup() %>%
  # 转成宽表，匹配原输出格式
  pivot_wider(names_from = response, values_from = avg_percent) %>%
  # 重命名列，和原输出一致
  rename(
    Item = Country,
    `Strongly Disagree` = `Very Dissatisfied`,
    Disagree = Dissatisfied,
    `So So` = Average,
    Agree = Satisfied,
    `Strongly Agree` = `Very Satisfied`
  )

# 查看结果
optimized_df

优化后输出结果 #

# A tibble: 4 × 6
  Item    `Strongly Disagree` Disagree `So So` Agree `Strongly Agree`
  <chr>                 <dbl>    <dbl>   <dbl> <dbl>            <dbl>
1 BRAZIL                   10       25    25    30               10
2 GERMANY                  30       20    20    20               10
3 ITALY                    20       40    20     0               20
4 USA                       5       10    42.5  17.5             25

优化思路说明 #

1. 宽转窄：用pivot_longer把多个问题列合并成一列，无需手动创建O_1到O_5的计数列，适配任意数量的问题。
2. 按行统计：通过row_id标识每行，计算每行各等级的占比（自动处理NA的有效回答总数）。
3. 分组取平均：按国家和等级分组，直接计算平均百分比，避免原代码中先按O_sum分组再取平均的冗余步骤。
4. 全程管道：所有操作通过dplyr管道串联，代码更简洁、可读性更强，且易于维护。

内容的提问来源于stack exchange，提问作者Homer Jay Simpson