如何根据多个条件在数据帧的每个子集上运行函数

Question

数据

我在 R 中有一个具有以下结构的数据框：

ID   Type  Group           Text
100    A     1    Lorem ipsum dolor sit amet
103    A     1    Lorem ipsum dolor sit amet
105    A     1    consectetur adipiscing eli
106    A     1    et dolore magna aliqua. Ut
107    B     1    Lorem ipsum dolor sit amet
209    B     1    Lorem ipsum dolor sing eli
300    C     1    Lorem ipsum dolor sit amet
501    C     1    Lorem ipsum dolor sit amet
503    A     2    Lorem ipsum dolor sit amet
711    A     2    consectetur adipiscing eli
799    B     2    Lorem ipsum dolor sit amet
811    B     2    Lorem ipsum dolor sit amet
812    C     3    Lorem ipsum dolor sit amet
820    C     3    Lorem ipsum dolor sing eli
831    C     3    sed do eiusmod temporo eli

可以用这段代码重现：

test_df <- data.frame(
  "ID" = c(100, 103, 105, 106, 107, 209, 300, 501, 503, 711, 799, 811, 812, 820, 831),
  "Type" = c('A', 'A', 'A', 'A', 'B', 'B', 'C', 'C', 'A', 'A', 'B', 'B', 'C', 'C', 'C'),
  "Group" = c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3),
  "Text" = c('Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sit amet', 'consectetur adipiscing eli', 'et dolore magna aliqua. Ut', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sing eli', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sit amet', 'consectetur adipiscing eli', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sing eli', 'sed do eiusmod temporo eli')
)

我要做什么

我正在尝试编写一个执行以下操作的函数：

• 遍历数据框中的所有行，并根据“类型”和“组”的交叉识别样本中的所有子集（例如 A1、A2、B1、B2...）
• 对于每个子集，比较该子集中的所有文本。
• 然后，识别高度相似的文本（即重复文本），将它们移动到单独的数据框中（所有重复文本都应最终位于同一数据框中，无论子集如何），然后将它们从原始数据框中删除。

基本上，该函数应该通过一次运行一个子集来识别每个子集中高度相似的文本。

我目前所拥有的

下面的代码允许我在整个数据帧上运行这个计算，没有子集：

library(stringdist)
library(dplyr)

temp_var <- stringdistmatrix(test_df$Text, test_df$Text) # Calculate similarities

temp_var <- which((temp_var <= 10), arr.ind = TRUE) # Identify texts with 10 or fewer differences (i.e. duplicates)
temp_var <- as.data.frame(temp_var)
temp_var <- temp_var %>%
  filter(temp_var$row != temp_var$col) # Removes cases where a text is compared with itself

x <- temp_var[,1]
x <- unique(x) # Create list of row numbers of duplicate texts

duplicate_texts <- test_df[x, ] # Save the duplicate texts
test_df_2 <- test_df[!test_df$ID %in% duplicate_texts$ID,] # Remove the duplicate texts from the original dataframe

我想弄清楚的是如何一次在样本的一个子集上运行此代码。

原始数据框很大，有数百个子集，数十万个文件，以及明显较长的文本，因此子集是必要的。此外，每次计算新的相似度矩阵时，我都需要删除或覆盖之前的相似度矩阵，因为它们的大小变得相当大。

Answer 1

以下是我解决此问题的方法。您不一定需要在此处使用映射，因为问题实际上不是数据帧输入、数据帧输出（唯一的输入是每个子集中的 Text 向量）。这意味着我们可以简单地使用分组过滤器来获取任何一个感兴趣的数据帧（唯一或重复）。

library(stringdist)
library(dplyr)
test_df <- data.frame(
  "ID" = c(100, 103, 105, 106, 107, 209, 300, 501, 503, 711, 799, 811, 812, 820, 831),
  "Type" = c('A', 'A', 'A', 'A', 'B', 'B', 'C', 'C', 'A', 'A', 'B', 'B', 'C', 'C', 'C'),
  "Group" = c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3),
  "Text" = c('Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sit amet', 'consectetur adipiscing eli', 'et dolore magna aliqua. Ut', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sing eli', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sit amet', 'consectetur adipiscing eli', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sit amet', 'Lorem ipsum dolor sing eli', 'sed do eiusmod temporo eli'),
  stringsAsFactors = FALSE
)

要实现的关键是group_by 只会将向量的一部分暴露给我们以后使用的任何函数，因此我们需要编写一个接受向量的函数。我们希望它返回TRUE if字符串与向量中的任何其他元素都过于相似，因此我们使用apply 和any 来检查每一行是否存在这种情况。我们必须确保我们首先摆脱对角线元素以避免自我比较。这也是参数化threshold 的好时机。

any_string_duplicates <- function(text_vector, threshold = 10) {
  mat <- stringdistmatrix(text_vector, text_vector)
  mat <- mat < threshold
  diag(mat) <- NA # Simpler way to remove self-comparisons
  apply(mat, 1, any, na.rm = TRUE)
}

现在可以使用分组的filter 轻松检索重复值和唯一值。

test_df %>% # Duplicates
  group_by(Type, Group) %>%
  filter(any_string_duplicates(Text))
#> # A tibble: 10 x 4
#> # Groups:   Type, Group [5]
#>       ID Type  Group Text                      
#>    <dbl> <chr> <dbl> <chr>                     
#>  1   100 A         1 Lorem ipsum dolor sit amet
#>  2   103 A         1 Lorem ipsum dolor sit amet
#>  3   107 B         1 Lorem ipsum dolor sit amet
#>  4   209 B         1 Lorem ipsum dolor sing eli
#>  5   300 C         1 Lorem ipsum dolor sit amet
#>  6   501 C         1 Lorem ipsum dolor sit amet
#>  7   799 B         2 Lorem ipsum dolor sit amet
#>  8   811 B         2 Lorem ipsum dolor sit amet
#>  9   812 C         3 Lorem ipsum dolor sit amet
#> 10   820 C         3 Lorem ipsum dolor sing eli

test_df %>% # Uniques
  group_by(Type, Group) %>%
  filter(!any_string_duplicates(Text))
#> # A tibble: 5 x 4
#> # Groups:   Type, Group [3]
#>      ID Type  Group Text                      
#>   <dbl> <chr> <dbl> <chr>                     
#> 1   105 A         1 consectetur adipiscing eli
#> 2   106 A         1 et dolore magna aliqua. Ut
#> 3   503 A         2 Lorem ipsum dolor sit amet
#> 4   711 A         2 consectetur adipiscing eli
#> 5   831 C         3 sed do eiusmod temporo eli

^{由reprex package (v0.3.0) 于 2019 年 9 月 3 日创建}