как применить изменяющийся шаблон gsub (переменная функция) к каждой строке data.table в R - PullRequest
Новая
       30

как применить изменяющийся шаблон gsub (переменная функция) к каждой строке data.table в R

0 голосов
/ 17 сентября 2018

У меня есть 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

Я хотел бы добавитьновый столбец с первыми n-словами string_col, как показано ниже: 

> 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

Это не желаемый вывод

Ответы [ 3 ]

0 голосов
/ 17 сентября 2018

Попробуйте использовать apply в режиме строки: 

apply(DT[, c('string_col', 'first_n_words')], 1, function(x) {
    gsub(paste0("^((\\w+\\W+){", x[1] - 1, "}\\w+).*$"), "\\1", x[0])
})
0 голосов
/ 17 сентября 2018

Чтобы сохранить использование 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

Edit

As @Франк заметил, что группировка должна быть на 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
0 голосов
/ 17 сентября 2018

Возможный подход: 

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

Как указывалось в комментариях Дж. Гротендика, микробенчмарк, возможно, не самый правильный способ измерения производительности таблицы данных, поскольку DT изменяется от одной итерации к следующей без сброса ее к начальному значению.

Итакв следующие несколько строк производительность будет измеряться только один раз после создания таблицы данных 

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)
...