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

How to run a function on each subset of a dataframe based on multiple conditions

数据

我在 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')
)

我想做什么

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

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

到目前为止我有什么

下面的代码允许我运行整个数据帧的计算,没有子集:

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

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

原始dataframe很大,有几百个子集,几十万个文件,还有明显更长的文本,所以需要进行子集化。此外,每次计算新的相似度矩阵时,我都需要删除或覆盖之前的相似度矩阵,因为它们的大小变得非常大。

这是我解决这个问题的方法。您不一定需要在这里求助于映射,因为问题实际上不是数据帧输入、数据帧输出(唯一的输入是每个子集中的 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 只会将向量的一部分暴露给我们以后使用的任何函数,因此我们需要编写一个接受向量的函数。我们希望它 return TRUE 如果一个字符串与向量中的任何其他元素太相似,那么我们使用 applyany 来检查每一行的这种情况。我们必须确保首先摆脱对角线元素以避免自我比较。这也是参数化 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-09-03 创建