数据

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。之后删除/跳过它们以节省无意义的重新检查时间。
1. 路径可能会在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不是equals）

EDIT2：在下面rosscova的回答之后，时间从可能的永久性下降到279.75秒！

Answer 1

使用模糊匹配，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)

Answer 2

给定两个数据集（以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

所以现在你可以获得每行dt1b的分数，例如0/6（甚至没有关闭），...，5/6（几乎相同），6/6（完全相同）。

IDEA（编辑）

这是我的想法：

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)中的return(z[score==max(score)])更改为l2 lapply()来实现，{ {1}}：

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现在包含初始字符串。以下列将其分解为子字符串及其相似度得分

Answer 3

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

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 4

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
}

在大型数据集

4 个答案:

数据

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

IDEA（编辑）