Question

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

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行和第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）改进的解决方案似乎：

按降序排列字符串排序;
将每个字符串（不是最长的）与较长的字符串进行比较。
如果发现字符串包含在较长的字符串中，则会标记此较短的字符串，并且在比较甚至更短的字符串时不会将其与之进行比较。（例如，当11_22_bb被发现包含在11_22_bb_33中时，11_22_bb会被标记，并且在比较11_22时，它只会与{{1}进行比较而不是11_22_bb_33。）

如下图所示：

11_22_bb

我的问题：有没有办法让它更有效率。此时，第二种方法需要大约16秒来减少6700行数据帧（最终的结果数据帧为1400行）。第一种方法大约需要50秒。

Answer 1

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

有效删除R

1 个答案: