如何合并分离的lapply并实现指定列筛选生成目标列表

需求说明 #

需要对多组数据集执行批量列提取操作，生成目标列表final_list，每个子列表需提取对应前缀的原始列及带1后缀的列。

原代码 #

library(glue)

x1 = c('mpg', 'cyl') 
x2 = c('Month', 'Ozone') 

list_x = list(x1, x2)
  
rm(list = ls())
mtcars
data1 = mtcars
colnames = colnames(data1)
colnames(data1) <- lapply(seq_along(mtcars), \(x) paste0(colnames(mtcars)[x], x))
colnames(data1) = lapply(colnames(mtcars), \(x) glue(x, '{1}'))

data_c = cbind(mtcars, data1)

data2 = airquality
colnames = colnames(airquality)
colnames(data2) <- lapply(seq_along(airquality), \(x) paste0(colnames(airquality)[x], x))
colnames(data2) = lapply(colnames(airquality), \(x) glue(x, '{1}'))

data_cc = cbind(airquality, data2)

list_combined = list(list(data_c, data_c), list(data_cc, data_cc))

dput(head(list_combined, 10))


flatten(lapply(seq(1:2), function(y)
  lapply(seq(1:2), function(j) {    
    cols = colnames(list_combined[[y]][[j]])
    if (str_detect(cols, list_x[[y]][j]) == T) {
      list_combined[[y]][[j]] %>% 
        select(starts_with(list_x[[y]][j]))
    }})))

 rm(list = ls())

期望输出 #

final_list[[1]][[1]]
#selected columns 
mpg, mpg1

final_list[[1]][[2]]
#selected columns 
cyl, cyl1

final_list[[2]][[1]]
#selected columns 
Month, Month1

final_list[[2]][[2]]
#selected columns 
Ozone, Ozone1

错误信息 #

Error in if (str_detect(cols, list_x[[y]][j]) == T) {
the condition has length > 1

解决方法 #

错误原因 #

str_detect(cols, list_x[[y]][j])返回的是布尔向量（每个列名是否匹配前缀），但if语句仅接受长度为1的判断条件，因此触发报错。实际上无需额外判断，直接用select(starts_with(...))即可完成筛选。

修正后的通用代码 #

library(dplyr)
library(purrr)
library(glue)

# 定义需提取的列前缀列表
x1 = c('mpg', 'cyl') 
x2 = c('Month', 'Ozone') 
list_x = list(x1, x2)

# 处理mtcars数据集：生成带1后缀的列并合并
data1 = mtcars
colnames(data1) <- glue("{colnames(mtcars)}1")
data_c = cbind(mtcars, data1)

# 处理airquality数据集：生成带1后缀的列并合并
data2 = airquality
colnames(data2) <- glue("{colnames(airquality)}1")
data_cc = cbind(airquality, data2)

# 构造数据集组合列表
list_combined = list(list(data_c, data_c), list(data_cc, data_cc))

# 批量提取目标列，生成final_list
final_list = map2(list_combined, list_x, function(data_group, prefixes) {
  map(prefixes, function(prefix) {
    data_group[[1]] %>% select(starts_with(prefix))
  })
})

# 验证结果
final_list[[1]][[1]]
final_list[[1]][[2]]
final_list[[2]][[1]]
final_list[[2]][[2]]

代码说明 #

1. 简化列重命名：用glue直接批量生成带1后缀的列名，替代原代码冗余的循环写法。
2. 使用purrr函数简化循环：map2实现数据集组与前缀组的一一对应，map处理单组内的多前缀提取，代码更简洁易读。
3. 去掉无效判断：select(starts_with(prefix))可直接筛选目标列，无需提前判断列是否存在（若需处理无匹配列的场景，可添加if(any(str_detect(colnames(data_group[[1]]), prefix)))的判断逻辑）。
4. 通用性适配：只需修改list_x的前缀定义和list_combined的数据集组合，即可适配不同数据集的批量列提取需求。

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