检查一个表中的关键字是否在另一个表中的字符串中使用R

Question

我一直试图用mapply解决这个问题，但我相信我将不得不使用几个嵌套应用来完成这项工作，并且它已经获得真正令人困惑。

问题如下：

数据帧一个包含大约400个关键字。这些大致分为15类。 Dataframe two包含一个字符串描述字段和15个额外的列，每个列命名为与数据框1中提及的类别相对应。这有数百万行。

如果从数据帧1的关键词在数据帧2串字段存在，其中关键字所在的类别，应在数据帧标记2

我想应该是这个样子：

> #Dataframe1 df1 
    >> keyword category 
    >> cat  A 
    >> dog  A 
    >> pig  A 
    >> crow  B 
    >> pigeon  B 
    >> hawk  B 
    >> catfish C 
    >> carp  C 
    >> ... 
    >> 
    > #Dataframe2 df2 
    >> description A B C .... 
    >> false cat  1 0 0 .... 
    >> smiling pig 1 0 0 .... 
    >> shady pigeon 0 1 0 .... 
    >> dogged dog  2 0 0 .... 
    >> sad catfish 0 0 1 .... 
    >> hawkward carp 0 1 1 .... 
    >> .... 

我试图使用mapply来使这个工作，但它失败了，给我的错误“更长的参数不是一个更短的长度的倍数”。它也计算这只适用于df2中的第一个字符串。我还没有超越这个阶段，即试图获得类别标志。

> mapply(grepl, pattern = df1$keyword, x = df2$description) 

任何人都可以帮忙吗？我非常感谢你。我是R新手，所以如果有人可以提到一些用于将循环转换为应用函数的“拇指规则”，也会有所帮助。我不能使用循环来解决这个问题，因为这会花费太多时间。

Answer 1

无论执行什么，计数每个类别的匹配数量需要k x d比较，其中k是关键字的数量和d的描述数量。

有一些技巧，使快速，无需大量的内存解决这个问题：

• 使用矢量操作。这些可以比使用循环更快地执行。请注意，lapply，mapply或vapply只是for循环的缩写。我对这些关键字进行了并行化处理（请参见下一步），以便向量化可以覆盖最大维度的描述。
• 使用并行化。优化使用多核可以以增加内存为代价加快处理速度（因为每个内核都需要自己的副本）。

实施例：

keywords   <- stringi::stri_rand_strings(400, 2) 
categories   <- letters[1:15] 
keyword_categories <- sample(categories, 400, TRUE) 
descriptions  <- stringi::stri_rand_strings(3e6, 20) 

keyword_occurance <- function(word, list_of_descriptions) { 
    description_keywords <- str_detect(list_of_descriptions, word) 
} 

category_occurance <- function(category, mat) { 
    rowSums(mat[,keyword_categories == category]) 
} 

list_keywords <- mclapply(keywords, keyword_occurance, descriptions, mc.cores = 8) 
df_keywords <- do.call(cbind, list_keywords) 
list_categories <- mclapply(categories, category_occurance, df_keywords, mc.cores = 8) 
df_categories <- do.call(cbind, list_categories) 

与我的计算机这需要140秒和14GB的RAM 15级中的类别3点百万的描述匹配400名的关键字。

Answer 2

有可能是一个更优雅的方式来做到这一点，但是这是我想出了：

## Your sample data: 
df1 <- structure(list(keyword = c("cat", "dog", "pig", "crow", "pigeon", "hawk", "catfish", "carp"), 
    category = c("A", "A", "A", "B", "B", "B", "C", "C")), 
    .Names = c("keyword", "category"), 
    class = "data.frame", row.names = c(NA,-8L)) 
df2 <- structure(list(description = structure(c(2L, 6L, 5L, 1L, 4L,3L), 
    .Label = c("dogged dog", "false cat", "hawkward carp", "sad catfish", "shady pigeon", "smiling pig"), class = "factor")), 
    .Names = "description", row.names = c(NA, -6L), class = "data.frame") 

## Load packages: 
library(stringr) 
library(dplyr) 
library(tidyr) 

## For each entry in df2$description count how many times each keyword 
## is contained in it: 
outList <- lapply(df2$description, function(description){ 
     outDf <- data.frame(description = description, 
       value = vapply(stringr::str_extract_all(description, df1$keyword), 
         length, numeric(1)), category = df1$category) 
    }) 

## Combine to one long data frame and aggregate by category: 
outLongDf<- do.call('rbind', outList) %>% 
    group_by(description, category) %>% 
    dplyr::summarise(value = sum(value)) 

## Reshape from long to wide format: 
outWideDf <- tidyr::spread(data = outLongDf, key = category, 
    value = value) 

outWideDf 
# Source: local data frame [6 x 4] 
# Groups: description [6] 
# 
#  description  A  B  C 
# *  <fctr> <dbl> <dbl> <dbl> 
# 1 dogged dog  2  0  0 
# 2  false cat  1  0  0 
# 3 hawkward carp  0  1  1 
# 4 sad catfish  1  0  1 
# 5 shady pigeon  1  1  0 
# 6 smiling pig  1  0  0 

这种方法，但是也可以抓住的“猪”，在“鸽子”和“猫”在“鲶鱼”。不过，我不知道这是不是你想要的。

Answer 3

您在寻找的是所谓的文档 - 术语矩阵（简称dtm），它源于NLP（自然语言处理）。有很多选项可用。我更喜欢text2vec。这个软件包速度非常快（如果它将在这里超过其他解决方案，我会不会感到惊讶），尤其是与tokenizers相结合。

在你的情况下，代码会是这个样子：

# Create the data 
df1 <- structure(list(keyword = c("cat", "dog", "pig", "crow", "pigeon", "hawk", "catfish", "carp"), 
         category = c("A", "A", "A", "B", "B", "B", "C", "C")), 
       .Names = c("keyword", "category"), 
       class = "data.frame", row.names = c(NA,-8L)) 
df2 <- structure(list(description = structure(c(2L, 6L, 5L, 1L, 4L,3L), 
               .Label = c("dogged dog", "false cat", "hawkward carp", "sad catfish", "shady pigeon", "smiling pig"), class = "factor")), 
       .Names = "description", row.names = c(NA, -6L), class = "data.frame") 

# load the libraries 
library(text2vec) # to create the dtm 
library(tokenizers) # to help creating the dtm 
library(reshape2) # to reshape the data from wide to long 

# 1. create the vocabulary from the keywords 
vocabulary <- vocab_vectorizer(create_vocabulary(itoken(df1$keyword))) 

# 2. create the dtm 
dtm <- create_dtm(itoken(as.character(df2$description)), vocabulary) 

# 3. convert the sparse-matrix to a data.frame 
dtm_df <- as.data.frame(as.matrix(dtm)) 
dtm_df$description <- df2$description 

# 4. melt to long format 
df_result <- melt(dtm_df, id.vars = "description", variable.name = "keyword") 
df_result <- df_result[df_result$value == 1, ] 

# 5. combine the data, i.e., add category 
df_final <- merge(df_result, df1, by = "keyword") 
# keyword description value category 
# 1 carp hawkward carp  1  C 
# 2  cat  false cat  1  A 
# 3 catfish sad catfish  1  C 
# 4  dog dogged dog  1  A 
# 5  pig smiling pig  1  A 
# 6 pigeon shady pigeon  1  B