含NA的Likert型问题绘图代码调整方案咨询

核心问题是NA值未被过滤，导致偏移量计算时包含了无应答分组，破坏了Likert图的居中逻辑。调整方案如下：

1. 过滤NA值，仅保留有效回答 #

在数据预处理阶段新增过滤步骤，移除无应答记录，确保后续计算仅基于有效回答：

# 处理含NA的数据集d3
d.reduced <- d3 %>%
  select(-id) %>%
  gather("Q", "ans") %>%
  filter(!is.na(ans)) %>%  # 过滤无应答的NA值
  group_by(Q, ans) %>%
  summarize(n=n()) %>%
  mutate(per = n/sum(n),  # 基于有效回答计算百分比
         ans = factor(ans, levels=answers)) %>%
  arrange(Q, ans)

2. 保留原有偏移量计算逻辑 #

过滤NA后，每个问题的分组仅包含有效选项，原偏移量计算逻辑会自动适配：它会计算不同意类选项的总占比 + 中间选项的一半占比，确保条形以0轴为中心对称分布：

# 创建绘图数据
stage1 <- d.reduced %>%
  mutate(text = paste0(formatC(100 * per, format="f", digits=0), "%"),
         cs = cumsum(per),
         offset = sum(per[1:(floor(n()/2))]) + (n() %% 2)*0.5*(per[ceiling(n()/2)]),
         xmax = -offset + cs,
         xmin = xmax-per) %>%
  ungroup()

完整可运行代码 #

将调整后的代码整合后，完整可复现代码如下：

# 加载包
library(dplyr)
library(ggplot2)
library(knitr)
library(tidyr)
library(scales)

# 模拟原始数据
N <- 50
answers <- c("Strongly Disagree","Somewhat Disagree","Neither Agree nor Disagree",
              "Somewhat Agree", "Strongly Agree")
set.seed(12342)
d <- tibble(
  id = paste0("Respondent", 1:N),
  Q1 = sample(answers, N, replace=TRUE),
  Q2 = sample(answers, N, replace=TRUE),
  Q3 = sample(answers, N, replace=TRUE),
  Q4 = sample(answers, N, replace=TRUE),
  Q5 = sample(answers, N, replace=TRUE)
)

# 生成含NA的数据集
d2 <- apply(d[2:ncol(d)], 2,
             function(x) {x[sample(c(1:N), floor(N/10))] <- NA; x} )
d3 <- cbind(d[,1], d2) %>% as_tibble()  # 转为tibble避免类型问题

# 处理含NA的数据集（核心调整）
d.reduced <- d3 %>%
  select(-id) %>%
  gather("Q", "ans") %>%
  filter(!is.na(ans)) %>%  # 过滤无应答的NA值
  group_by(Q, ans) %>%
  summarize(n=n()) %>%
  mutate(per = n/sum(n),  # 基于有效回答计算百分比
         ans = factor(ans, levels=answers)) %>%
  arrange(Q, ans)

# 创建绘图数据
stage1 <- d.reduced %>%
  mutate(text = paste0(formatC(100 * per, format="f", digits=0), "%"),
         cs = cumsum(per),
         offset = sum(per[1:(floor(n()/2))]) + (n() %% 2)*0.5*(per[ceiling(n()/2)]),
         xmax = -offset + cs,
         xmin = xmax-per) %>%
  ungroup()

# 排序绘图数据
gap <- 0.2
stage2 <- stage1 %>%
  left_join(stage1 %>%
              group_by(Q) %>%
              summarize(max.xmax = max(xmax)) %>%
              mutate(r = row_number(max.xmax)),
            by = "Q") %>%
  arrange(desc(r)) %>%
  mutate(ymin = r - (1-gap)/2,
         ymax = r + (1-gap)/2)

# 绘制Likert图
ggplot(stage2) +
  geom_rect(aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill=ans)) +
  geom_text(aes(x=(xmin+xmax)/2, y=(ymin+ymax)/2, label=text), size = 3) +
  scale_x_continuous("", labels=percent, breaks=seq(-1, 1, len=9), limits=c(-1, 1)) +
  scale_y_continuous("", breaks = 1:n_distinct(stage2$Q),
                     labels=rev(stage2 %>% distinct(Q) %>% .$Q)) +
  scale_fill_brewer("", palette = "BrBG")

补充说明 #

• 过滤NA后，百分比反映的是有效受访者的态度分布，更符合Likert图的解读逻辑。
• 若需展示无应答占比，可将NA单独作为额外类别处理，但需修改偏移量计算逻辑（将NA排除在对称分布计算之外，放在条形一侧或单独标注）。

内容的提问来源于stack exchange，提问作者ndem763