R语言提取非空值对应列名并按蔬果分组生成目标数据框

输入数据规则 #

• 输入数据框共7列，列构成固定：
  • 第1列：人员唯一标识id
  • 第2-4列：蔬菜类持有状态标记，取值仅为1（持有）或NA（未持有）
  • 第5-7列：水果类持有状态标记，取值仅为1（持有）或NA（未持有）
• 输入数据构造示例代码：

id1 <- c("id_1", 1, NA, NA, NA, 1, NA)
id2 <- c("id_2", NA, 1, 1, NA, NA, NA)
input <- data.frame(rbind(id1, id2))
colnames(input) = c("id", "lettuce", "tomato", "bellpeper", "pineapple", "apple", "banana")

输出目标 #

最终生成3列的结果数据框，匹配规则如下：

• 保留原数据的人员id列
• 新增veg列：提取对应人员持有状态为1的蔬菜列名，按列顺序拼接为字符串，无持有蔬菜则赋值为NA
• 新增fruit列：提取对应人员持有状态为1的水果列名，按列顺序拼接为字符串，无持有水果则赋值为NA
• 输出结果构造示例代码：

output_id1 <- c("id_1", "lettuce", "apple")
output_id2 <- c("id_2", "tomato, bellpeper", NA)
output <- data.frame(rbind(output_id1, output_id2))
colnames(output) <- c("id", "veg", "fruit")

可运行实现代码 #

基础R版本（无第三方包依赖） #

通过逐行遍历实现分类字段提取拼接，无需安装额外扩展包，适合极简运行环境：

# 逐行处理输入数据
res_rows <- lapply(seq_len(nrow(input)), function(i) {
  row_data <- input[i, ]
  # 提取蔬菜类持有项
  veg_names <- names(input)[2:4]
  held_veg <- veg_names[!is.na(row_data[veg_names])]
  veg_res <- if(length(held_veg) == 0) NA_character_ else paste(held_veg, collapse = ", ")
  
  # 提取水果类持有项
  fruit_names <- names(input)[5:7]
  held_fruit <- fruit_names[!is.na(row_data[fruit_names])]
  fruit_res <- if(length(held_fruit) == 0) NA_character_ else paste(held_fruit, collapse = ", ")
  
  data.frame(id = row_data$id, veg = veg_res, fruit = fruit_res)
})
# 合并所有行结果
output <- do.call(rbind, res_rows)

tidyverse版本（适配管道化开发流程） #

如果项目已经加载dplyr、purrr等扩展包，可通过管道式写法降低代码冗余，保持代码逻辑连贯：

library(dplyr)
library(purrr)
library(stringr)

# 定义单组字段的拼接函数
combine_held_cols <- function(...) {
  held_cols <- names(c(...))[!is.na(c(...))]
  if(length(held_cols) == 0) return(NA_character_)
  str_c(held_cols, collapse = ", ")
}

output <- input %>%
  mutate(
    veg = pmap_chr(select(., lettuce, tomato, bellpeper), combine_held_cols),
    fruit = pmap_chr(select(., pineapple, apple, banana), combine_held_cols)
  ) %>%
  select(id, veg, fruit)

结果校验 #

运行上述代码生成的输出与示例预期完全一致：

• id_1对应的veg值为lettuce，fruit值为apple
• id_2对应的veg值为tomato, bellpeper，fruit值为NA

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