有效删除包含在 R 列中其他字符串中的字符串

Efficiently remove strings that are contained within other strings in a column in R

假设我有一个如下所示的数据框:

data<-data.frame(id=c("11_22", "11_22_bb", "11_22_bb_33", 
                      "22_bb_33", "bb_33", "ab_cc_sd", "dd_e3_bb", 
                      "33_34_sd_22_32_87_cc"), stringsAsFactors=FALSE)
data

#                    id
#1                11_22
#2             11_22_bb
#3          11_22_bb_33
#4             22_bb_33
#5                bb_33
#6             ab_cc_sd
#7             dd_e3_bb
#8 33_34_sd_22_32_87_cc

第 1-2 行和第 4-5 行的字符串包含在第 3 行的字符串中。我的目标是删除第 1-2 行和第 4-5 行,只保留行中的字符串不包含在其他字符串中。

(1) 最简单的解决方案 是将每一行与所有其他行进行比较,如果发现它包含在另一行中则标记它。例如:

data$flag <- TRUE
for( i in 1:nrow( data ) ){
  if( sum(grepl( data[i, 1], data[-i,1] )) > 0 )
      data$flag[ i ] <- FALSE
}
data <- data[data$flag, ]

#                    id flag
#3          11_22_bb_33 TRUE
#6             ab_cc_sd TRUE
#7             dd_e3_bb TRUE
#8 33_34_sd_22_32_87_cc TRUE

但这并不高效,尤其是在处理较长的数据帧时。

(2) 改进的解决方案似乎 是:

  1. 按长度降序对字符串进行排序;
  2. 将每个字符串(不是最长的)与更长的字符串进行比较。
  3. 如果发现一个字符串包含在一个较长的字符串中,这个较短的字符串将被标记,并且不会在比较一个更短的字符串时进行比较。 (例如,当11_22_bb被发现包含在11_22_bb_33中时,11_22_bb被标记,当比较11_22时,它只会与11_22_bb_33 而不是 11_22_bb.)

如下图:

data<-data.frame(id=c("11_22", "11_22_bb", "11_22_bb_33", 
                       "22_bb_33", "bb_33", "ab_cc_sd", "dd_e3_bb", 
                       "33_34_sd_22_32_87_cc"), stringsAsFactors=FALSE)
data$len_char <- nchar(data$id)
data <- data[ order(data$len_char, decreasing=TRUE),]
data$flag <- TRUE

for( i in 2:nrow(data)){
    if( sum(grepl( data[i, "id"],
        data[ data$len_char > data$len_char[i] & data$flag, "id"])) > 0
       )
        data[i, "flag"] <- FALSE
}
data <- data[data$flag, ]
data

#                    id len_char flag
#8 33_34_sd_22_32_87_cc       20 TRUE
#3          11_22_bb_33       11 TRUE
#6             ab_cc_sd        8 TRUE
#7             dd_e3_bb        8 TRUE

我的问题:有没有办法让它更有效。此时,第二种方法大约需要 16 秒来减少 6700 行数据帧(最终生成的数据帧为 1400 行)。第一种方法大约需要 50 秒。

vapply 获胜。

data<-data.frame(id=c("11_22", "11_22_bb", "11_22_bb_33", 
                       "22_bb_33", "bb_33", "ab_cc_sd", "dd_e3_bb", 
                       "33_34_sd_22_32_87_cc"), stringsAsFactors=FALSE)
data$len_char <- nchar(data$id)
data <- data[ order(data$len_char, decreasing=TRUE),]
data$flag <- TRUE

samp <- sample(1:nrow(data), 6700, replace = TRUE)

Strings <- Strings_orig <- data[samp, , drop=FALSE]

system.time({
  for( i in 2:nrow(Strings)){
    if( sum(grepl( Strings[i, "id"],
        Strings[ Strings$len_char > Strings$len_char[i] & Strings$flag, "id"])) > 0
       )
        Strings[i, "flag"] <- FALSE
}
})

 user  system elapsed  
 3.81    0.00    3.81 


Strings <- Strings_orig

system.time({
for (i in 2:nrow(Strings)){
  Strings$flag[i] <- !any(grepl( Strings[i, "id"],
        Strings[ Strings$len_char > Strings$len_char[i] & Strings$flag, "id"]))
}
})

  user  system elapsed 
  3.79    0.00    3.79 



Strings <- Strings_orig
fn <- function(id, len_char){
  any(grepl(id, Strings$id[Strings$len_char > len_char & Strings$flag]))
}
system.time({
  vapply(Strings$flag, fn, TRUE, len_char = Strings$len_char)
})
  user  system elapsed 
  1.03    0.00    1.03