Эффективный подсчет вхождений списка слов в столбце с использованием R

Question

Если у меня есть список слов, как мне эффективно подсчитать количество вхождений этих слов в набор данных?

Пример:

set.seed(123) 
df_data <- data.frame(   
   data_strings = sample(c("tom smith", "smith jim", "sam sam", "ted", "xxx"), 10, replace = TRUE)
)

df_names <- data.frame(
   names = c("tom", "jim", "sam", "ted", "yyy")
)

То есть:

> df_data
   data_strings
1       sam sam
2       sam sam
3     smith jim
4     smith jim
5       sam sam
6           xxx
7           ted
8     tom smith
9     smith jim
10      sam sam

и

> df_names
  names
1   tom
2   jim
3   sam
4   ted
5   yyy

Я могу сделать это с помощью str_count из пакета stringr:

library(stringr)
library(tictoc)
tic()
df_data$counts <- as.vector(sapply(
  paste(df_names[,"names"], collapse='|'), 
  str_count, 
  string=df_data$data_strings
))
toc()

Это дает желаемый результат:

> df_data
   data_strings counts
1       sam sam      2
2       sam sam      2
3     smith jim      1
4     smith jim      1
5       sam sam      2
6           xxx      0
7           ted      1
8     tom smith      1
9     smith jim      1
10      sam sam      2

Однако, поскольку мои реальные данные содержат миллионы строк, и мой список слов также исчисляется миллионами. Это оказывается очень неэффективным способом получить результат. Как я могу ускорить его? Я попытался использовать больше ядер с пакетом parallel, но он заканчивает работу в одно и то же время (используется только одно ядро, хотя я советую использовать более одного). Я на windows, поэтому я не могу проверить mclapply(). parallel, кажется, работает правильно, так как я могу заставить его использовать больше ядер на других примерах.

library(stringr)
library(parallel)
library(tictoc)

cl <- makeCluster(4, type = "PSOCK")
tic()
df_data$counts <- as.vector(parSapply(
  cl = cl,
  paste(df_names[,"names"], collapse='|'),
  FUN=str_count, 
  string=df_data$data_strings
))
toc()
stopCluster(cl)

Какие еще подходы я могу попробовать? Что-то с data.tables? Можно ли сделать пасту внутри аппликации иначе?

Answer 1

Я не уверен, что он быстрее в наборе данных реального размера, но вы можете использовать quanteda, который имеет встроенную поддержку многоядерности и должен быть довольно эффективным в этом случае:

library(dplyr)
library(quanteda)
quanteda_options("threads" = 4) # choose how many threads are used

df_data$counts <- df_data %>%
  pull(data_strings) %>% 
  dfm() %>%                               # construct document-feature-matrix
  dfm_keep(pattern = df_names$names) %>%  # keep features that are names
  convert(to = "data.frame") %>%          # convert to data.frame
  select(-document) %>%                   # remove non-numeric columns
  rowSums()                               # only keep sums

df_data
#>    data_strings counts
#> 1       sam sam      2
#> 2       sam sam      2
#> 3     smith jim      1
#> 4     smith jim      1
#> 5       sam sam      2
#> 6           xxx      0
#> 7           ted      1
#> 8     tom smith      1
#> 9     smith jim      1
#> 10      sam sam      2

^{Создано в 2020-01-13 пакетом Представления (v0.3.0)}

Обратите внимание, что я установил параметр stringsAsFactors = FALSE при создании data.frames. В противном случае у вас возникнут проблемы с факторами.

Я мог бы представить, что это быстрее, если в вашем наборе много имен. Но на моей скамейке отметка stringr::str_count и stringi::stri_count_regex была быстрее с небольшим набором имен, которые вы указали.

Answer 2

str_count() уже векторизовано, вам не нужно sapply(), просто используйте stringr::str_count(df_data$data_strings, paste(df_names$names, collapse='|')).

Answer 3

Вот некоторые базовые решения R.

Поскольку все мои методы основаны на базе R, производительность не будет такой же хорошей, как при использовании пакета stringr, но, возможно, вы сможете позаимствовать некоторые идеи, если считаете, что они полезны.

# method by ThomasIsCoding
f_ThomasIsCoding1 <- function() {sapply(as.vector(df_data$data_strings), function(x) sum(unlist(strsplit(x,split = " "))%in% df_names$names) )}

f_ThomasIsCoding2 <- function() {sapply(strsplit(as.vector(df_data$data_strings),split = " "), function(x) sum(x %in% df_names$names))}

f_ThomasIsCoding3 <- function() {
  bk <- paste0(df_names$names,collapse = "|")
  lengths(regmatches(df_data$data_strings,gregexpr(bk,df_data$data_strings)))
}

f_ThomasIsCoding4 <- function() {
  with(df_data, as.numeric(ave(as.vector(data_strings),as.numeric(data_strings),FUN = function(x) sum(strsplit(unique(as.vector(x)),split = " ")[[1]] %in% as.vector(df_names$names)))))
}

Вы можете увидеть тест в моем другом посте

Answer 4

Это очень интересный вопрос, касающийся ограничения производительности, поэтому я создаю шаблон эталонного теста для визуального сравнения производительности различных методов.

Это сообщение предназначено для вики-сообщества, поэтому все желающие могут добавить различные подходы для определения скорости.

Шаблон теста

library(microbenchmark)
library(stringr)

set.seed(123) 
df_data <- data.frame(   
  data_strings = sample(c("tom smith", "smith jim", "sam sam", "ted", "xxx"), 10000, replace = TRUE)
)

df_names <- data.frame(
  names = c("tom", "jim", "sam", "ted", "yyy")
)

# method by Joshua
f_Joshua <- function() {as.vector(sapply(
  paste(df_names[,"names"], collapse='|'), 
  str_count, 
  string=df_data$data_strings
))}
# method by F. Privé
f_F.Prive <- function() str_count(df_data$data_strings, paste(df_names[,"names"], collapse='|'))
# method by ThomasIsCoding
f_ThomasIsCoding1 <- function() {sapply(as.vector(df_data$data_strings), function(x) sum(unlist(strsplit(x,split = " "))%in% df_names$names) )}
f_ThomasIsCoding2 <- function() {sapply(strsplit(as.vector(df_data$data_strings),split = " "), function(x) sum(x %in% df_names$names))}
f_ThomasIsCoding3 <- function() {
  bk <- paste0(df_names$names,collapse = "|")
  lengths(regmatches(df_data$data_strings,gregexpr(bk,df_data$data_strings)))
}
f_ThomasIsCoding4 <- function() {
  with(df_data, as.numeric(ave(as.vector(data_strings),as.numeric(data_strings),FUN = function(x) sum(strsplit(unique(as.vector(x)),split = " ")[[1]] %in% as.vector(df_names$names)))))
}


bm <- microbenchmark(
  f_Joshua(),
  f_F.Prive(),
  f_ThomasIsCoding1(),
  f_ThomasIsCoding2(),
  f_ThomasIsCoding3(),
  f_ThomasIsCoding4(),
  times = 10,
  check = "equivalent",
  unit = "relative")

такой, что

> bm
Unit: relative
                expr       min        lq       mean    median         uq        max neval
          f_Joshua()  1.126535  1.067945  0.6261978  1.028165  0.9859666  0.2677307    10
         f_F.Prive()  1.000000  1.000000  1.0000000  1.000000  1.0000000  1.0000000    10
 f_ThomasIsCoding1() 57.177203 61.011742 32.5759501 54.980633 53.4825275 12.4735502    10
 f_ThomasIsCoding2() 18.167507 18.053833 11.8592174 17.945895 23.3277056  4.4468403    10
 f_ThomasIsCoding3() 63.448741 72.585445 35.6459037 65.608859 61.8789544  8.8344612    10
 f_ThomasIsCoding4()  4.039085  3.994598  2.1024356  3.545432  3.3914213  0.7529932    10

Answer 5

Если у вас есть повторяющиеся имена в df_data, вы можете использовать объединение в data.table, чтобы ускорить процесс. Если у вас не много повторяющихся имен, я не думаю, что это слишком сильно поможет. Кроме того, обязательно извлеките повторные имена из шаблона поиска. Даже такие вещи, как "sam" и "samuel" будут повторяться для частичного сопоставления строк (хотя сложно разобрать).

setDT(df_data2, key = "data_strings")
dt_data2 <- unique(df_data2)

dt_data2[, counts := str_count(string = data_strings, pattern = str_c(df_names$names, collapse='|'))]
dt_data2[df_data2]

    data_strings counts
 1:      sam sam      2
 2:      sam sam      2
 3:      sam sam      2
 4:      sam sam      2
 5:    smith jim      1
 6:    smith jim      1
 7:    smith jim      1
 8:          ted      1
 9:    tom smith      1
10:          xxx      0

Данные :

set.seed(123) 
df_data <- data.frame(   
  data_strings = sample(c("tom smith", "smith jim", "sam sam", "ted", "xxx"), 10, replace = TRUE)
)

df_names <- data.frame(
  names = c("tom", "jim", "sam", "ted", "yyy")
)