在R中按前缀分组DataFrame列并实现列求和的技术疑问

问题 #

我有一个包含二进制列的大型DataFrame，列名如下：

[1] "imagetag_logos_position_Apple_BOTTOM_CENTER"         "imagetag_logos_position_Apple_BOTTOM_LEFT"           "imagetag_logos_position_Apple_BOTTOM_RIGHT"          "imagetag_logos_position_Apple_CENTER"                "imagetag_logos_position_Apple_CENTER_LEFT"          
  [6] "imagetag_logos_position_Apple_CENTER_RIGHT"          "imagetag_logos_position_Apple_TOP_CENTER"            "imagetag_logos_position_Apple_TOP_LEFT"              "imagetag_logos_position_Apple_TOP_RIGHT"             "imagetag_logos_position_Banana_BOTTOM_CENTER"       
 [11] "imagetag_logos_position_Banana_BOTTOM_LEFT"          "imagetag_logos_position_Banana_BOTTOM_RIGHT"         "imagetag_logos_position_Banana_CENTER_LEFT"          "imagetag_logos_position_Banana_CENTER_RIGHT"         "imagetag_logos_position_Banana_TOP_RIGHT"           
 [16] "imagetag_logos_position_Pear_BOTTOM_CENTER"      "imagetag_logos_position_Pear_BOTTOM_LEFT"        "imagetag_logos_position_Pear_BOTTOM_RIGHT"       "imagetag_logos_position_Pear_CENTER"             "imagetag_logos_position_Pear_CENTER_LEFT"       
 [21] "imagetag_logos_position_Pear_CENTER_RIGHT"       "imagetag_logos_position_Pear_TOP_RIGHT"          "imagetag_logos_position_Kiwi_BOTTOM_CENTER"    "imagetag_logos_position_Kiwi_BOTTOM_LEFT"      "imagetag_logos_position_Kiwi_BOTTOM_RIGHT"    
 [26] "imagetag_logos_position_Kiwi_CENTER_LEFT"      "imagetag_logos_position_Kiwi_CENTER_RIGHT"     "imagetag_logos_position_Kiwi_TOP_LEFT"         "Product_position_Product_0"                         "Product_position_Product_BOTTOM_CENTER"            
 [31] "Product_position_Product_BOTTOM_LEFT"               "Product_position_Product_BOTTOM_RIGHT"              "Product_position_Product_CENTER"                    "Product_position_Product_CENTER_LEFT"               "Product_position_Product_CENTER_RIGHT"              
 [36] "Product_position_Product_TOP_CENTER"                "Product_position_Product_TOP_LEFT"                  "Product_position_Product_TOP_RIGHT"                 "Person_position_Person_0"                           "Person_position_Person_BOTTOM_CENTER"               
 [41] "Person_position_Person_BOTTOM_LEFT"                 "Person_position_Person_BOTTOM_RIGHT"                "Person_position_Person_CENTER"                      "Person_position_Person_CENTER_LEFT"                 "Person_position_Person_CENTER_RIGHT"               
 [46] "Person_position_Person_TOP_CENTER"                  "Person_position_Person_TOP_LEFT"                    "Person_position_Person_TOP_RIGHT"                   "Logo_position_Logo_0"                               "Logo_position_Logo_BOTTOM_CENTER"                  
 [51] "Logo_position_Logo_BOTTOM_LEFT"                     "Logo_position_Logo_BOTTOM_RIGHT"                    "Logo_position_Logo_CENTER"                          "Logo_position_Logo_CENTER_LEFT"                     "Logo_position_Logo_CENTER_RIGHT"                    
 [56] "Logo_position_Logo_TOP_CENTER"                      "Logo_position_Logo_TOP_LEFT"                        "Logo_position_Logo_TOP_RIGHT"                       "CTA_ShopNow_position_Shop Now_0"                    "CTA_ShopNow_position_Shop Now_BOTTOM_CENTER"       
 [61] "CTA_ShopNow_position_Shop Now_BOTTOM_LEFT"          "CTA_ShopNow_position_Shop Now_BOTTOM_RIGHT"         "CTA_ShopNow_position_Shop Now_CENTER"               "CTA_ShopNow_position_Shop Now_CENTER_LEFT"          "CTA_ShopNow_position_Shop Now_CENTER_RIGHT"        
 [66] "CTA_ShopNow_position_Shop Now_TOP_CENTER"           "CTA_ShopNow_position_Shop Now_TOP_RIGHT"            "CTA_JoinNow_position_Join Now_0"                    "CTA_JoinNow_position_Join Now_BOTTOM_CENTER"        "CTA_JoinNow_position_Join Now_BOTTOM_LEFT"         
 [71] "CTA_JoinNow_position_Join Now_BOTTOM_RIGHT"         "CTA_JoinNow_position_Join Now_CENTER"               "CTA_JoinNow_position_Join Now_CENTER_RIGHT"         "CTA_JoinNow_position_Join Now_TOP_CENTER"           "CTA_JoinNow_position_Join Now_TOP_RIGHT"           
 [76] "CTA_position_CTA_0"                                 "CTA_position_CTA_BOTTOM_CENTER"                     "CTA_position_CTA_BOTTOM_LEFT"                       "CTA_position_CTA_BOTTOM_RIGHT"                      "CTA_position_CTA_CENTER"                            
 [81] "CTA_position_CTA_CENTER_LEFT"                       "CTA_position_CTA_CENTER_RIGHT"                      "CTA_position_CTA_TOP_CENTER"                        "CTA_position_CTA_TOP_LEFT"                          "CTA_position_CTA_TOP_RIGHT"                         
 [86] "Text_position_text_BOTTOM_CENTER"                   "Text_position_text_BOTTOM_LEFT"                     "Text_position_text_BOTTOM_RIGHT"                    "Text_position_text_CENTER"                          "Text_position_text_CENTER_LEFT"                     
 [91] "Text_position_text_CENTER_RIGHT"                    "Text_position_text_TOP_CENTER"                      "Text_position_text_TOP_LEFT"                        "Text_position_text_TOP_RIGHT"                       "Product_position_Product_0_LF"                      
 [96] "Product_position_Product_BOTTOM_CENTER_LF"          "Product_position_Product_BOTTOM_LEFT_LF"            "Product_position_Product_BOTTOM_RIGHT_LF"           "Product_position_Product_CENTER_LF"                 "Product_position_Product_CENTER_LEFT_LF"           
[101] "Product_position_Product_CENTER_RIGHT_LF"           "Product_position_Product_TOP_CENTER_LF"             "Product_position_Product_TOP_LEFT_LF"               "Product_position_Product_TOP_RIGHT_LF"              "Logo_position_Logo_0_LF"                           

我需要按前缀分组，对每组中包含BOTTOM_CENTER、BOTTOM_RIGHT、BOTTOM_LEFT的列求和。比如imagetag_logos_position_Apple_相关的底部位置列单独求和，imagetag_logos_position_Banana_的相关列也单独求和。

我已经用以下代码提取了唯一前缀列表：

library(stringr)
prefix_list <- str_extract(colnames(positionsdf),".+?(?=([A-Z])([A-Z])([A-Z]))")
prefix_list1 <- unique(prefix_list)

得到的唯一前缀列表：

> prefix_list1
 [1] "imagetag_logos_position_Apple_"      "imagetag_logos_position_Banana_"     "imagetag_logos_position_Kiwi_"   "imagetag_logos_position_Pear_" NA                                   "Product_position_Product_"          "Person_position_Person_"           
 [8] "Logo_position_Logo_"                "CTA_ShopNow_position_Shop Now_"     "CTA_JoinNow_position_Join Now_"     "CTA_position_"                      "Text_position_text_"                "CTA_LearnMore_position_Learn More_" "Person_position_"  

尝试过用%in%匹配，但它不支持部分匹配，循环代码也没成功：

for(i in prefix_list1){
  sapply(positionsdf, function(x) i %in% x)
}

现在需要找到合适的方法实现按前缀分组求和。

解决方案 #

方法1：grepl匹配前缀 + 循环求和 #

用grepl实现部分匹配，筛选对应列后计算每行求和，最后合并结果：

library(dplyr)

# 过滤前缀列表中的NA值
valid_prefixes <- prefix_list1[!is.na(prefix_list1)]

# 初始化结果DataFrame
result_df <- data.frame()

for(prefix in valid_prefixes){
  # 筛选当前前缀下的底部位置列
  target_cols <- colnames(positionsdf)[
    grepl(paste0("^", prefix), colnames(positionsdf)) & 
    grepl("BOTTOM_(CENTER|LEFT|RIGHT)", colnames(positionsdf))
  ]
  
  # 存在符合条件的列时计算求和
  if(length(target_cols) > 0){
    sum_col <- rowSums(positionsdf[target_cols])
    # 生成新列名（去掉前缀末尾下划线，添加标识）
    col_name <- gsub("_$", "", prefix) |> paste0("_bottom_sum")
    result_df[[col_name]] <- sum_col
  }
}

# 将求和结果合并到原DataFrame（可选）
positionsdf <- cbind(positionsdf, result_df)

方法2：dplyr的across + matches批量处理 #

用dplyr的语法实现更简洁的批量求和：

library(dplyr)
library(stringr)

valid_prefixes <- prefix_list1[!is.na(prefix_list1)]

positionsdf <- positionsdf |> 
  mutate(
    !!!setNames(
      lapply(valid_prefixes, function(prefix){
        # 生成匹配规则
        matches_pattern <- paste0("^", prefix, "BOTTOM_(CENTER|LEFT|RIGHT)")
        rowSums(across(matches(matches_pattern)))
      }),
      # 生成新列名
      gsub("_$", "", valid_prefixes) |> paste0("_bottom_sum")
    )
  )

方法3：purrr函数式处理 #

用purrr的map替代循环，代码更简洁：

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

valid_prefixes <- prefix_list1[!is.na(prefix_list1)]

# 定义单前缀求和函数
sum_bottom_cols <- function(prefix){
  pattern <- paste0("^", prefix, "BOTTOM_(CENTER|LEFT|RIGHT)")
  cols <- matches(pattern)
  if(any(colnames(positionsdf) %in% cols)){
    rowSums(across(cols))
  } else {
    NULL
  }
}

# 生成所有求和列并合并
bottom_sums <- map_dfc(valid_prefixes, sum_bottom_cols)
colnames(bottom_sums) <- gsub("_$", "", valid_prefixes) |> paste0("_bottom_sum")

# 合并到原DataFrame
positionsdf <- bind_cols(positionsdf, bottom_sums)

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