循环遍历数据帧的行并将其用作 r 中的函数输入

Question

我想遍历包含类别的表，以将子类别分配给另一个名为“数据”的数据框中的列。文本是一个人手写的，是一个包含大约 100 个单词的字符字段，但长度是动态的。我想检查'search_pat'中提供的单词是否在'text'字段中，如果是并且'category'也匹配，则必须分配subcat。我在下面的代码中执行的应用功能为我提供了结果： "cat1" "cat2"

但我想要的结果是相同的数据框“数据”，但随后为“子猫”列填充了值（如果适用）。

我真正的“数据”数据框是 400.000 行，类别表现在大约 100 行，但将来会扩展。我使用 for 循环进行了此操作，但对我来说这似乎效率很低。我的目标是让代码更高效。

请参阅下面提供的示例。

# Create example data
data <- data.frame('text' = rep(c('blabla FOO blabla', 'blabla test','bla BAR blablabla', 'test BOO blabla'),2),
                   'category' = c('X', 'Y', 'Z', 'X', 'X', 'X', 'X', 'Z'),
                   'subcat' = rep(NA, 8))

categories <- data.frame('search_pat' = c('FOO', 'BAR', 'BOO', 'BOO'),
                         'category' = c('X', 'Z', 'X', 'Z'),
                         'subcat' = c('cat1', 'cat2', 'cat3', 'cat4'))

# Function for assigning the subcategory to the data
assign_subcat <- function(df, searchterm, category, subcat){
  bool_mask <- (grepl(searchterm, df$text) & (df$category == category))
  df$subcat[bool_mask] <- subcat
}

# Loop over the categories dataframe to assign subcategory on the data
apply(categories, MARGIN = 1, FUN = function(x) assign_subcat(df = data,
                                                              x['search_pat'],
                                                              x['category'],
                                                              x['subcat']))

# Desired result
       text           category subcat
1 blabla FOO blabla        X     cat1
2       blabla test        Y     NA
3 bla BAR blablabla        Z     cat2
4   test BOO blabla        X     cat3
5 blabla FOO blabla        X     cat1
6       blabla test        X     NA
7 bla BAR blablabla        X     NA
8   test BOO blabla        Z     cat4

Answer 1

您可以利用左连接操作来实现您的预​​期结果。使用dplyr 包，您可以首先创建一个列search_pat 来存储您要查找的密钥（在您的示例中，"FOO" 和"BAR" 是通过包stringr 中的str_extract 函数提取的），然后通过search_pat 和category 加入，然后丢弃不必要的列。

library(dplyr)

data %>% 
  mutate(search_pat = stringr::str_extract(text, paste(categories$search_pat, collapse = "|"))) %>% 
  left_join(categories, by = c("search_pat", "category"), suffix = c("_to_be_removed", "")) %>% 
  select(-search_pat, -subcat_to_be_removed)

#                text category subcat
# 1 blabla FOO blabla        X   cat1
# 2       blabla test        Y   <NA>
# 3 bla BAR blablabla        Z   cat2
# 4 blabla FOO blabla        X   cat1
# 5       blabla test        Z   <NA>
# 6 bla BAR blablabla        X   <NA>