For 循环使用自定义匹配函数按所有行比较 2 个数据帧答案

【问题标题】：For loop to compare 2 dataframes all by all rows with custom matching functionsFor 循环使用自定义匹配函数按所有行比较 2 个数据帧
【发布时间】：2021-09-16 12:35:08
【问题描述】：

这是对r - for loop to compare 2 dataframes all by all rows 的跟进，但应用了不同的匹配函数（stringr::str_detect()）。

我正在尝试逐行比较数据框 d1 中的 2 列与数据框 d2 中的 2 列。为了说明我创建虚拟数据集的问题：

d1 <- data.frame(
  a = c("a","b","c", "d"),
  b = c("aa", "bbb", "ccc", "d")
)

d2 <- data.frame(
  a = c("a", "a", "d", "b"),
  b = c("aaa", "bbb", "ddd", "bbb")
)

理想情况下，我想标记d1 中的所有行，我可以在d2 的至少一行中找到匹配项。这就是提供所需结果的原因：

output <- matrix(nrow = nrow(d1), ncol =nrow(d2))
for (i in 1:nrow(d1)) {
  for (j in 1:nrow(d2)) {
    output[i,j] = ifelse(
      d1$a[i] == d2$a[j] & str_detect(d2$b[j], d1$b[i]), 
      1, 
      0)
  }
}

d1$flag <- apply(output,1,max)
d1

由于我的 d1 表的行数会变得相当大，因此矩阵的大小也会变得很大。有没有更好的方法来编写这个循环，而不是矩阵，我创建一个具有每行最大值的向量并且内存不会爆炸？

【问题讨论】：

您使用str_detect（即子字符串）而不是严格相等是否有原因？
是的，我无法分享的原始示例需要 str_detect。我改变了上面的例子
rdrr.io/cran/fuzzyjoin/man/regex_join.html
我们不要求您提供真实数据，而是提供与真实数据反映相同问题的示例
上面的例子反映了同样的问题。使用stringr::str_detect 是因为我需要检查 d1$b 是否包含在 d2$b 中

标签： r for-loop

【解决方案1】：

高效连接

@Roland 暗示了一个很好的解决方案：fuzzyjoin::fuzzy_*_join。唯一的问题是它仍然是一个连接，OP 希望避免这种情况......坦率地说，大多数 merge 和 *_join 函数相对有效，因为比较是在爆炸每一行之前完成的反对每一行；当约束太松且接近笛卡尔连接时，效率就会低下。

接下来，我将修改 d2 以便我们至少有一个两行匹配：

d2 <- data.frame(
  a = c("a", "a", "d", "b", "b"),
  b = c("aaa", "bbb", "ddd", "bbb", "bbb")
)

从这里开始，我们需要添加一个行 id，加入，然后在该行 id 上聚合。

d1$rowid <- seq_len(nrow(d1))
out <- fuzzyjoin::fuzzy_left_join(d1, d2, by = c("a", "b"), match_fun = list(`==`, Vectorize(grepl)))
out
#   a.x b.x rowid  a.y  b.y
# 1   a  aa     1    a  aaa
# 2   b bbb     2    b  bbb
# 3   b bbb     2    b  bbb
# 4   c ccc     3 <NA> <NA>
# 5   d   d     4    d  ddd

这样，请注意 rowid 2 出现了两次（因此我们需要将它们组合起来），而 rowid 3 是不匹配的。（旁注：fuzzyjoin by design 复制所有“by”列。减少它们很容易，即使看起来很奇怪。）

out2 <- aggregate(a.y ~ rowid + a.x + b.x, data = out, na.action = na.pass,
                  FUN = function(z) sum(!is.na(z)))
names(out2)[-1] <- c("a", "b", "flag")
out2
#   rowid a   b flag
# 1     1 a  aa    1
# 2     2 b bbb    2
# 3     3 c ccc    0
# 4     4 d   d    1

按行

如果这会导致内存问题，那么下一步就是为其中一个帧逐行执行此操作。

d1$flag <- mapply(function(A1, B1) sum(A1 == d2$a & grepl(B1, d2$b)), d1$a, d1$b)
d1
#   a   b flag
# 1 a  aa    1
# 2 b bbb    2
# 3 c ccc    0
# 4 d   d    1

【讨论】：

【解决方案2】：

想使用str_detect 和for loops 创建解决方案，但说实话，它比此处和您的原始帖子中提供的解决方案效率低得多：

d1$flag <- 0

for (i in 1:nrow(d1)) {
  flag <- list()
  for (j in 1:nrow(d2)) {
    flag <- rbind(flag, stringr::str_detect(paste(d1[i,1], d1[i,2]), paste(d2[j,1], d2[j,2])))
  }
  if (any(flag == TRUE)) {
    d1[i, 3] <- 1
  }
}

如果您不想使用列索引，可以将它们替换为“列名”，只需确保在其周围加上引号，即d1[i, "flag"]。

【讨论】：