有效删除包含在 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) 改进的解决方案似乎 是:
- 按长度降序对字符串进行排序;
- 将每个字符串(不是最长的)与更长的字符串进行比较。
- 如果发现一个字符串包含在一个较长的字符串中,这个较短的字符串将被标记,并且不会在比较一个更短的字符串时进行比较。 (例如,当
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
假设我有一个如下所示的数据框:
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) 改进的解决方案似乎 是:
- 按长度降序对字符串进行排序;
- 将每个字符串(不是最长的)与更长的字符串进行比较。
- 如果发现一个字符串包含在一个较长的字符串中,这个较短的字符串将被标记,并且不会在比较一个更短的字符串时进行比较。 (例如,当
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