优化R语言Likert绘图函数：单图导出、分板块与自动标题

我正在为调查的Likert数据编写绘图函数，需要批量生成大量图表，希望将其优化为高度自动化、易用的工具，目前存在三个待实现的需求：

• 支持单图导出，例如通过plot_likert(tbls$dummy1.no)生成指定图表；
• 支持按调查板块（如Technology仅取A、B列）和子样本（如dummy1.no）筛选数据绘图，例如plot_likert(section=Technology, subsample=dummy1.no)；
• 实现图表标题随板块、子样本参数自动变化。

现有数据与预处理代码如下：

df1<-data.frame(A=c(1,2,2,3,4,5,1,1,2,3),
              B=c(4,4,2,3,4,2,1,5,2,2),
              C=c(3,3,3,3,4,2,5,1,2,3),
              D=c(1,2,5,5,5,4,5,5,2,3),
              E=c(1,4,2,3,4,2,5,1,2,3),
              dummy1=c("yes","yes","no","no","no","no","yes","no","yes","yes"),
              dummy2=c("high","low","low","low","high","high","high","low","low","high"))

df1[colnames(df1)] <- lapply(df1[colnames(df1)], factor)

vals <- colnames(df1)[1:5]
dummies <- colnames(df1)[-(1:5)]
step1 <- lapply(dummies, function(x) df1[, c(vals, x)])
step2 <- lapply(step1, function(x) split(x, x[, 6]))
names(step2) <- dummies
tbls <- unlist(step2, recursive=FALSE)
tbls<-lapply(tbls, function(x) x[(names(x) %in% names(df1[c(1:5)]))])

其中A、B属于调查的"Technology"板块，C、D、E属于"Social"板块。

1. 定义板块映射表 #

先创建板块与变量的对应关系，方便后续筛选：

section_mapping <- list(
  Technology = c("A", "B"),
  Social = c("C", "D", "E")
)

2. 完整的plot_likert函数实现 #

library(likert)
library(ggplot2)

plot_likert <- function(data = NULL, section = NULL, subsample = NULL) {
  # 参数逻辑处理：优先使用传入的data，其次用section+subsample组合
  if (!is.null(data)) {
    # 场景1：直接传入子样本数据
    likert_data <- likert(data)
    # 从参数名提取子样本信息生成标题
    data_label <- gsub("tbls\\$", "", deparse(substitute(data)))
    plot_title <- paste("Likert分布 -", data_label)
  } else if (!is.null(section) && !is.null(subsample)) {
    # 场景2：按板块和子样本筛选数据
    # 验证板块有效性
    if (!section %in% names(section_mapping)) {
      stop(paste("无效板块，可选板块：", paste(names(section_mapping), collapse = ", ")))
    }
    # 验证子样本有效性
    if (!subsample %in% names(tbls)) {
      stop(paste("无效子样本，可选子样本：", paste(names(tbls), collapse = ", ")))
    }
    # 筛选对应变量
    target_vars <- section_mapping[[section]]
    filtered_data <- tbls[[subsample]][, target_vars, drop = FALSE]
    likert_data <- likert(filtered_data)
    # 生成动态标题
    plot_title <- paste("Likert分布 -", section, "板块（子样本：", subsample, "）")
  } else {
    stop("请传入`data`参数，或同时传入`section`和`subsample`参数")
  }
  
  # 绘制图表并添加标题
  p <- plot(likert_data) +
    ggtitle(plot_title) +
    theme(plot.title = element_text(hjust = 0.5))
  
  return(p)
}

3. 函数使用示例 #

• 单图导出：

# 生成dummy1.no子样本的全变量图
plot_likert(tbls$dummy1.no)
# 导出到本地文件
ggsave("dummy1_no_full.png", plot_likert(tbls$dummy1.no), width = 10, height = 6)

• 按板块+子样本筛选绘图：

# 生成Technology板块、dummy1.no子样本的图表
plot_likert(section = "Technology", subsample = "dummy1.no")
# 生成Social板块、dummy2.high子样本的图表
plot_likert(section = "Social", subsample = "dummy2.high")

• 批量导出所有组合：添加批量绘图功能，一次性生成所有板块+子样本的图表：

batch_plot_likert <- function(output_dir = "likert_plots") {
  dir.create(output_dir, showWarnings = FALSE)
  # 遍历所有板块和子样本组合
  for (sec in names(section_mapping)) {
    for (sub in names(tbls)) {
      p <- plot_likert(section = sec, subsample = sub)
      ggsave(file.path(output_dir, paste0(sec, "_", sub, ".png")), p, width = 10, height = 6)
    }
  }
}
# 调用批量导出
batch_plot_likert()

• 自定义主题支持：可添加theme参数，允许用户传入自定义ggplot主题，增强灵活性；
• 数据有效性校验：扩展参数验证逻辑，检查传入的data是否符合likert包的数据格式要求；
• 显示模式切换：添加type参数，支持切换显示百分比或原始计数。

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