檢查一個表中的關鍵字是否在另一個表中的字符串中使用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