在大型数据集上进行高效的子字符串搜索

Question

我有一个大数据集 tPro1（~500k 点）。如下所示，感兴趣的变量是 tPro1$Path.

      Path                                  Row      rm                                              
1  >root>aaaa>bbbb>cccc>dddd>hello         1        TRUE
2  >root>aaaa>bbbb>cccc>dddd>greetings     2        TRUE
3  >root>aaaa>bbbb>cccc>dddd>example       3        TRUE
4  >root>iiii>jjjj>kkkk>llll>mmmm          4        TRUE
5  >root>iiii>jjjj>kkkk>nnnn>testing       5        TRUE

我还有一个较小的数据集，我们称之为 Sub1，大约有几十个数据点。它具有比 tPro1 更高级别的路径。

     [1] ">root>aaaa>bbbb>cccc>dddd"
     [2] ">root>aaaa>bbbb>eeee>ffff"
     [3] ">root>aaaa>bbbb>gggg>hhhh" 
     [4] ">root>iiii>jjjj>kkkk>llll>mmmm"
     [5] ">root>iiii>jjjj>kkkk>nnnn" 
     [6] ">root>oooo>pppp>qqqq"

我想做的是将 tPro1 中的较长路径与 Sub1 中的较短路径相关联。 tPro1 是 Pro0 中一些关键信息的副本。输出 Pro0 将是

          Path                                  Short_path                                                    
1  >root>aaaa>bbbb>cccc>dddd>hello         >root>aaaa>bbbb>cccc>dddd
2  >root>aaaa>bbbb>cccc>dddd>greetings     >root>aaaa>bbbb>cccc>dddd
3  >root>aaaa>bbbb>cccc>dddd>example       >root>aaaa>bbbb>cccc>dddd
4  >root>iiii>jjjj>kkkk>llll>mmmm          >root>iiii>jjjj>kkkk>llll>mmmm
5  >root>iiii>jjjj>kkkk>nnnn>testing       >root>iiii>jjjj>kkkk>nnnn

我已经为 Sub1 中的每个路径编写了一个循环，grepl 的每个 tPro1 以查看它是否是一个子字符串。对于 500k*24 点，这将是一个非常低效的过程，所以我尝试了一些优化：

注tPro1$rm。当找到一个子字符串时，它被设置为 false。他们是 removed/skipped 之后，以节省毫无意义的复查时间。
1. A Path 在tPro1中可能出现多次。因此，当找到 s 的有效子字符串 p 时，算法不会继续执行 grepl，而是遍历数据集并查找 s 的所有未检查实例。

我的密码是

start.time <- Sys.time()

for (p in Sub1$Path) {
  for (i in 1:NROW(tPro1)) {
    if (tPro1[i,3]) {
      if (grepl(p, tPro1[i,1], fixed=TRUE)) {
        # Replace all of subpath 
        for (j in i:NROW(tPro1)) {
          if (tPro1[j,1] == tPro1[i,1]) {
            Pro0[tPro1[j,2],2] <- p
            tPro1[j,3] <- FALSE
          }
        }
      }
    }
  }
  v <- unlist(tPro1[,3])
  tPro1 <- tPro1[v,]
}

end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken

处理完整数据集不会在人工时间内停止（至少在我的机器上）。出于说明目的，一次执行 1000 个批次（减少 tPro1）需要 46 秒。 2000 需要 1 分钟，3000:1.4 分钟。

可以做出任何明显的改进，还是只是问题的本质？

编辑：大约有 54k 条独特的长路径，而且并非所有的长路径都有相应的短路径（例如，在 tPro1 中有 >root>strange>path，而在 sub1 没有 >root>strange)

形式的路径

EDIT2：按照下面 rosscova 的回答，时间从可能的永恒减少到 279.75 秒！

Answer 1

给定两个数据集（形式为data.table）：

library(data.table) # for data manipulation
library(stringi) # for string manipulation

 >dt1 
                               Path Row   rm
 1:     >root>aaaa>bbbb>cccc>dddd>hello   1 TRUE
 2: >root>aaaa>bbbb>cccc>dddd>greetings   2 TRUE
 3:   >root>aaaa>bbbb>cccc>dddd>example   3 TRUE
 4:      >root>iiii>jjjj>kkkk>llll>mmmm   4 TRUE
 5:   >root>iiii>jjjj>kkkk>nnnn>testing   5 TRUE

 > dt2 # introduced column name `names`

                        names
 1:      >root>aaaa>bbbb>cccc>dddd
 2:      >root>aaaa>bbbb>eeee>ffff
 3:      >root>aaaa>bbbb>gggg>hhhh
 4: >root>iiii>jjjj>kkkk>llll>mmmm
 5:      >root>iiii>jjjj>kkkk>nnnn
 6:           >root>oooo>pppp>qqqq

dt1b<-cbind(t(dt1[,stri_split(Path,fixed=">")]),dt1[,.(Row,rm)])[,V1:=NULL]
dt2b<-data.table(t(dt2[,stri_split(str = names,fixed=">")]))[,V1:=NULL]

 >dt1b
      V2   V3   V4   V5   V6        V7 Row   rm
1: root aaaa bbbb cccc dddd     hello   1 TRUE
2: root aaaa bbbb cccc dddd greetings   2 TRUE
3: root aaaa bbbb cccc dddd   example   3 TRUE
4: root iiii jjjj kkkk llll      mmmm   4 TRUE
5: root iiii jjjj kkkk nnnn   testing   5 TRUE

和

 >dt2b
      V2   V3   V4   V5   V6   V7
1: root aaaa bbbb cccc dddd      
2: root aaaa bbbb eeee ffff     
3: root aaaa bbbb gggg hhhh     
4: root iiii jjjj kkkk llll mmmm
5: root iiii jjjj kkkk nnnn     
6: root oooo pppp qqqq      root

最后，我将 dt1b 的每一行与 dt2b 的每一行进行比较，方法是：

  sub1<-subset(dt1b, select = grep("^V+", names(dt1b),perl = TRUE,value = TRUE))

创建（包含的列表）所有可能的比较

  l1<-lapply(seq(1:nrow(sub1)),function(x) {l1<-lapply(seq(1:nrow(dt2b)),function(y) {l2<-data.table(t(sub1[x] %in% dt2b[y]));names(l2)<-paste0(dt2b[y]);return(l2)}); names(l1)<-paste(sub1[x],collapse=" ");return(l1)})

部分结果

     l1[1:2]
    [[1]]
    [[1]]$`root aaaa bbbb cccc dddd hello`
       root aaaa bbbb cccc dddd      
    1: TRUE TRUE TRUE TRUE TRUE FALSE

    [[1]]$<NA>
       root aaaa bbbb  eeee  ffff      
    1: TRUE TRUE TRUE FALSE FALSE FALSE

    [[1]]$<NA>
       root aaaa bbbb  gggg  hhhh      
    1: TRUE TRUE TRUE FALSE FALSE FALSE

    [[1]]$<NA>
       root  iiii  jjjj  kkkk  llll  mmmm
    1: TRUE FALSE FALSE FALSE FALSE FALSE

    [[1]]$<NA>
       root  iiii  jjjj  kkkk  nnnn      
    1: TRUE FALSE FALSE FALSE FALSE FALSE

    [[1]]$<NA>
       root  oooo  pppp  qqqq        root
    1: TRUE FALSE FALSE FALSE FALSE FALSE



    [[2]]
    [[2]]$`root aaaa bbbb cccc dddd greetings`
       root aaaa bbbb cccc dddd      
    1: TRUE TRUE TRUE TRUE TRUE FALSE

    [[2]]$<NA>
       root aaaa bbbb  eeee  ffff      
    1: TRUE TRUE TRUE FALSE FALSE FALSE

    [[2]]$<NA>
       root aaaa bbbb  gggg  hhhh      
    1: TRUE TRUE TRUE FALSE FALSE FALSE

    [[2]]$<NA>
       root  iiii  jjjj  kkkk  llll  mmmm
    1: TRUE FALSE FALSE FALSE FALSE FALSE

    [[2]]$<NA>
       root  iiii  jjjj  kkkk  nnnn      
    1: TRUE FALSE FALSE FALSE FALSE FALSE

    [[2]]$<NA>
       root  oooo  pppp  qqqq        root
    1: TRUE FALSE FALSE FALSE FALSE FALSE

所以现在你可以有一个 score 每行 dt1b 例如0/6（甚至不接近），...，5/6（几乎相同），6/6（完全相同）。

想法（编辑）

这是我的想法：

l2<-lapply(seq_along(1:length(l1)),function(x) {
  z=rbindlist(t(l1[[x]][1:nrow(dt2b)]),fill = TRUE)
  z=cbind(z,score=apply(z,1,sum,na.rm=TRUE))
  setorder(z,-score)
  z[,V1:=NULL]
  z<-cbind(t(rep(names(l1[[x]][1]))),z)
  names(z)[1]<-"initialString"
  return(z)
})


   > l2[1:2]
 [[1]]
                     initialString root aaaa bbbb cccc dddd  eeee  ffff  gggg  hhhh  iiii  jjjj  kkkk  llll  mmmm  nnnn score
 1: root aaaa bbbb cccc dddd hello TRUE TRUE TRUE TRUE TRUE    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA     5
 2: root aaaa bbbb cccc dddd hello TRUE TRUE TRUE   NA   NA FALSE FALSE    NA    NA    NA    NA    NA    NA    NA    NA     3
 3: root aaaa bbbb cccc dddd hello TRUE TRUE TRUE   NA   NA    NA    NA FALSE FALSE    NA    NA    NA    NA    NA    NA     3
 4: root aaaa bbbb cccc dddd hello TRUE   NA   NA   NA   NA    NA    NA    NA    NA FALSE FALSE FALSE FALSE FALSE    NA     1
 5: root aaaa bbbb cccc dddd hello TRUE   NA   NA   NA   NA    NA    NA    NA    NA FALSE FALSE FALSE    NA    NA FALSE     1

 [[2]]
                         initialString root aaaa bbbb cccc dddd  eeee  ffff  gggg  hhhh  iiii  jjjj  kkkk  llll  mmmm  nnnn score
 1: root aaaa bbbb cccc dddd greetings TRUE TRUE TRUE TRUE TRUE    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA     5
 2: root aaaa bbbb cccc dddd greetings TRUE TRUE TRUE   NA   NA FALSE FALSE    NA    NA    NA    NA    NA    NA    NA    NA     3
 3: root aaaa bbbb cccc dddd greetings TRUE TRUE TRUE   NA   NA    NA    NA FALSE FALSE    NA    NA    NA    NA    NA    NA     3
 4: root aaaa bbbb cccc dddd greetings TRUE   NA   NA   NA   NA    NA    NA    NA    NA FALSE FALSE FALSE FALSE FALSE    NA     1
 5: root aaaa bbbb cccc dddd greetings TRUE   NA   NA   NA   NA    NA    NA    NA    NA FALSE FALSE FALSE    NA    NA FALSE     1

... 或保留具有最大 score 列的行，（这可以通过以下方式实现：return(z) 更改为上面 l2 lapply() 中的 return(z[score==max(score)])）和 rbindlist(t(l2[1:length(l2)])):

                        initialString root aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn score
1:     root aaaa bbbb cccc dddd hello TRUE TRUE TRUE TRUE TRUE   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA     5
2: root aaaa bbbb cccc dddd greetings TRUE TRUE TRUE TRUE TRUE   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA     5
3:   root aaaa bbbb cccc dddd example TRUE TRUE TRUE TRUE TRUE   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA     5
4:      root iiii jjjj kkkk llll mmmm TRUE   NA   NA   NA   NA   NA   NA   NA   NA TRUE TRUE TRUE TRUE TRUE   NA     6
5:   root iiii jjjj kkkk nnnn testing TRUE   NA   NA   NA   NA   NA   NA   NA   NA TRUE TRUE TRUE   NA   NA TRUE     5

initialString 列现在包含初始字符串。以下各列将其分解为子字符串及其 相似度 得分

Answer 2

以下代码应该可以立即解决您的问题。

library(data.table)
library(stringi)

Pro0 <- data.table(tPro1)

for (i in 1:length(Sub1$Short_path)) {
  Pro0[stri_detect_fixed(Path, Sub1$Short_path[i]), Short_path:=Sub1$Short_path[i]]
}

使用这种方法，我在一秒钟内将 230k 路径名与 14 个较短的路径名相关联。

这是我用来创建与您的相对应的数据集 tPro1 和 Sub1 的代码：

tPro1 <- data.table('Path' = list.files(path = '/usr', full.names = TRUE, recursive = TRUE))
Sub1 <- data.table('Short_path' = list.files(path = '/usr', full.names = TRUE))

Answer 3

sub 如此之小这一事实可能有助于减少必要的迭代次数。这里有一个比你现有的更有效的方法，虽然我在这里仍然使用循环。

首先，设置一些测试数据。使用与您指定的尺寸相同的尺寸：

set.seed(123)

sub <- sapply( seq_len( 24 ), function(x) {
    paste( sample( c( letters, ">" ),
                   12,
                   replace = TRUE,
                   prob = c( rep( 1, 26 ), 8 ) ),
           collapse = "")
} )
head( sub, 3 )
# [1] "puhyz>lymjbj" "rn>yc>fbyrda" "qsmop>byrv>k"

使用 sub 创建 tPro1 以便找到适当的子字符串。

tPro1 <- paste0( sample( sub,
                         5E5,
                         replace = TRUE ),
                 sample( c( ">hello", ">adf", ">;kjadf" ),
                         5E5,
                         replace = TRUE )
)
head( tPro1, 3 )
# [1] "bjwhrj>j>>zj>adf"   "b>>>zpx>fpvg>hello" ">q>hn>ljsllh>adf"

现在使用 while 循环。迭代 sub，在每次迭代中获得尽可能多的匹配项。如果我们到达 sub 的末尾，或者如果所有值都已填充，则停止迭代。

results <- vector( "character", length( tPro1 ) )
i <- 1L
system.time(
    while( sum( results == "" ) > 0L && i <= length( sub ) ) {
        results[ grep( sub[i], tPro1 ) ] <- sub[i]
        i <- i + 1L
    }
)
#    user  system elapsed 
#  4.655   0.007   4.661

输出结果。

output <- data.frame( tPro1 = tPro1, results = results, stringsAsFactors = FALSE )
head( output, 3 )

#                             tPro1                  results
# 1 >>ll>ldsjbzzcszcniwm>>em>;kjadf >>ll>ldsjbzzcszcniwm>>em
# 2 ijka>ca>>>ddpmhilphqlt>c>;kjadf ijka>ca>>>ddpmhilphqlt>c
# 3 zpnsniwyletn>qzifzjtrjg>>;kjadf zpnsniwyletn>qzifzjtrjg>

所以这不是一个完全矢量化的解决方案，但它确实为您节省了一些时间。对于您正在使用的相同大小的数据集，我们的速度降至 4.6 秒。

编辑：愚蠢的我，我正在使用 sub 几千个值。像你说的那样将 sub 的大小减少到几十个之后，它使这变得更快！

编辑：使用您显示的数据，您可能需要先创建 tPro1 和 sub 向量：

tPro1.vec <- tPro1$Path
sub <- Sub1$Path

results <- vector( "character", length( tPro1.vec ) )
i <- 1L
while( sum( results == "" ) > 0L && i <= length( sub ) ) {
    results[ grep( sub[i], tPro1.vec ) ] <- sub[i]
    i <- i + 1L
}

Answer 4

使用模糊匹配，agrepl:

tPro1$Short_path <- Sub1$Path[ apply(sapply(Sub1$Path, function(i) agrepl(i, tPro1$Path)), 1, which) ] 

tPro1

#                                  Path Row   rm                     Short_path
# 1     >root>aaaa>bbbb>cccc>dddd>hello   1 TRUE      >root>aaaa>bbbb>cccc>dddd
# 2 >root>aaaa>bbbb>cccc>dddd>greetings   2 TRUE      >root>aaaa>bbbb>cccc>dddd
# 3   >root>aaaa>bbbb>cccc>dddd>example   3 TRUE      >root>aaaa>bbbb>cccc>dddd
# 4      >root>iiii>jjjj>kkkk>llll>mmmm   4 TRUE >root>iiii>jjjj>kkkk>llll>mmmm
# 5   >root>iiii>jjjj>kkkk>nnnn>testing   5 TRUE      >root>iiii>jjjj>kkkk>nnnn

数据

tPro1  <- read.table(text = "Path                                  Row      rm                                              
1  >root>aaaa>bbbb>cccc>dddd>hello         1        TRUE
2  >root>aaaa>bbbb>cccc>dddd>greetings     2        TRUE
3  >root>aaaa>bbbb>cccc>dddd>example       3        TRUE
4  >root>iiii>jjjj>kkkk>llll>mmmm          4        TRUE
5  >root>iiii>jjjj>kkkk>nnnn>testing       5        TRUE",
                     header = TRUE, stringsAsFactors = FALSE)


Sub1 <- data.frame(Path = c(">root>aaaa>bbbb>cccc>dddd",
                            ">root>aaaa>bbbb>eeee>ffff",
                            ">root>aaaa>bbbb>gggg>hhhh",
                            ">root>iiii>jjjj>kkkk>llll>mmmm",
                            ">root>iiii>jjjj>kkkk>nnnn",
                            ">root>oooo>pppp>qqqq"),
                   stringsAsFactors = FALSE)

在大型数据集上进行高效的子字符串搜索

Efficient sub-string search over large dataset

regex

optimization

substring

r

grepl

创建（包含的列表）所有可能的比较

想法（编辑）

数据