如何将不同的 gsub 模式(变量函数)应用于 R 中 data.table 的每一行

how to apply varying gsub pattern (variable function) to each row of data.table in R

我有一个 data.table DT,其中有一个字符串列和一个数字列,指示应从字符串开头提取多少个单词。

    > require(data.table)
    > DT <- data.table(string_col = c("A BB CCC", "DD EEE FFFF GDG", "AB DFD EFGD ABC DBC", "ABC DEF") 
                     , first_n_words = c(2, 3, 3, 1))
    > DT
                string_col first_n_words
    1:            A BB CCC             2
    2:     DD EEE FFFF GDG             3
    3: AB DFD EFGD ABC DBC             3
    4:             ABC DEF             1

我想添加一个包含 string_col 的前 n 个单词的新列,如下所示:

> output_DT
            string_col first_n_words output_string_col
1:            A BB CCC             2              A BB
2:     DD EEE FFFF GDG             3       DD EEE FFFF
3: AB DFD EFGD ABC DBC             3       AB DFD EFGD
4:             ABC DEF             1               ABC

这是可以使用的 gsub 语法:

> gsub(paste0("^((\w+\W+){", first_n_words - 1, "}\w+).*$"),"\1", string_col)

我基本上需要为每一行创建此 gsub 函数,使用该行的 first_n_words,然后再将其应用于该行的 string_col。 我只对 data.table 语法解决方案感兴趣,因为它是一个非常大的数据集。最需要 gsub 解决方案。


编辑:我已经尝试了以下方法,但它不起作用

> DT[, output_string_col := gsub(paste0("^((\w+\W+){", first_n_words - 1, "}\w+).*$"),"\1", string_col)]
Warning message:
In gsub(paste0("^((\w+\W+){", first_n_words - 1, "}\w+).*$"),  :
  argument 'pattern' has length > 1 and only the first element will be used
>## This is not the desired output    
> DT 
                string_col first_n_words output_string_col
    1:            A BB CCC             2              A BB
    2:     DD EEE FFFF GDG             3            DD EEE
    3: AB DFD EFGD ABC DBC             3            AB DFD
    4:             ABC DEF             1           ABC DEF

这不是想要的输出

一种可能的方法是:

stringr::word(DT$string_col, end = DT$first_n_words)
#output
[1] "A BB"        "DD EEE FFFF" "AB DFD EFGD" "ABC"

下面是这个小数据集的速度比较:

library(microbenchmark)

denis <- function(x){
  x[,line := .I]
  x[, output_string_col := gsub(paste0("^((\w+\W+){", first_n_words - 1, "}\w+).*$"),"\1", string_col),
    by = line]
  x[,("line") := NULL]
}



Tim <- function(x){
  x[, output_string_col := apply(x, 1, function(x) {
    gsub(paste0("^((\w+\W+){", as.numeric(x[2]) - 1, "}\w+).*$"), "\1", x[1])
  })]
}

miss <- function(x){
  x[, output_string_col := stringr::word(string_col, end = first_n_words)]
}

microbenchmark(
  Tim(DT),
  miss(DT),
  denis(DT)
)
Unit: milliseconds
      expr      min       lq     mean   median       uq      max neval cld
   Tim(DT) 1.875036 1.926662 2.174488 1.971941 2.181196 12.83158   100  a 
  miss(DT) 1.452720 1.484245 1.710604 1.510905 1.592787 15.27196   100  a 
 denis(DT) 2.780183 2.864604 3.255014 2.948813 3.126542 18.78252   100   b

在更大的数据集上:

DT <- DT[sample(1:4, 100000, replace = TRUE),]

    Unit: seconds
      expr       min        lq      mean    median        uq       max neval cld
   Tim(DT) 13.924312 14.628571 15.030614 14.810397 15.840749 15.949039     5   b
  miss(DT)  3.571372  3.939229  4.150258  4.237873  4.492383  4.510435     5  a 
 denis(DT) 11.291374 11.728155 13.362248 12.738197 13.478435 17.575077     5   b

正如 G. Grothendieck 的评论中所建议的那样,微基准测试可能不是衡量数据性能的最正确方法 table,因为 DT 从一个迭代更改为下一个迭代而无需将其重置为初始值。

因此在接下来的几行中,性能将在创建数据后仅测量一次 table

DT <- data.table(string_col = c("A BB CCC",
                                "DD EEE FFFF GDG",
                                "AB DFD EFGD ABC DBC",
                                "ABC DEF"), 
                 first_n_words = c(2, 3, 3, 1))
set.seed(1)

ind <- sample(1:4, 100000, replace = TRUE)
DT1 <- DT[ind,]
system.time(Tim(DT1))
#output
   user  system elapsed 
  14.06    0.02   15.01 

DT2 <- DT[ind,]
system.time(miss(DT2))
#output
   user  system elapsed 
   2.82    0.00    2.87    

DT3 <- DT[ind,]
system.time(denis(DT3))    
#output
   user  system elapsed 
  11.56    0.03   11.98  


all.equal(DT1, DT2)
all.equal(DT2, DT3)

尝试在行模式下使用 apply

apply(DT[, c('string_col', 'first_n_words')], 1, function(x) {
    gsub(paste0("^((\w+\W+){", x[1] - 1, "}\w+).*$"), "\1", x[0])
})

继续使用 data.table 的一个答案是使用分组操作,因为您需要 gsub 中的值,而不是向量:

DT[,line := .I]
DT[, output_string_col := gsub(paste0("^((\w+\W+){", first_n_words - 1, "}\w+).*$"),"\1", string_col),by = line]

> DT
            string_col first_n_words line output_string_col
1:            A BB CCC             2    1              A BB
2:     DD EEE FFFF GDG             3    2       DD EEE FFFF
3: AB DFD EFGD ABC DBC             3    3       AB DFD EFGD
4:             ABC DEF             1    4               ABC

编辑

正如@Franck 所说,分组应该first_n_words更有效

DT[, output_string_col := gsub(paste0("^((\w+\W+){", first_n_words[1] - 1, "}\w+).*$"),"\1", string_col),by = first_n_words]

此修改版本的基准测试提供更快的结果:

library(microbenchmark)

denis <- function(x){
  x[, output_string_col := gsub(paste0("^((\w+\W+){", first_n_words[1] - 1, "}\w+).*$"),"\1", string_col),by = first_n_words]
}



Tim <- function(x){
  x[, output_string_col := apply(x, 1, function(x) {
    gsub(paste0("^((\w+\W+){", as.numeric(x[2]) - 1, "}\w+).*$"), "\1", x[1])
  })]
}

miss <- function(x){
  x[, output_string_col := stringr::word(string_col, end = first_n_words)]
}

DT <- DT[sample(1:4, 1000, replace = TRUE),]

microbenchmark(
  Tim(DT),
  miss(DT),
  denis(DT)
)

Unit: milliseconds
      expr       min        lq      mean    median        uq
   Tim(DT) 56.851716 57.836126 60.435164 58.714486 60.753051
  miss(DT) 11.042056 11.516928 12.427029 11.871800 12.617031
 denis(DT)  1.993437  2.355283  2.555936  2.615181  2.680001
        max neval
 111.169277   100
  20.916932   100
   3.530668   100