r - 两个数字向量上的全对全 setdiff 具有用于接受匹配的数字阈值

Question

我想要做的或多或少是以下两个线程中讨论的问题的组合:

Perform non-pairwise all-to-all comparisons between two unordered character vectors --- The opposite of intersect --- all-to-all setdiff

Merge data frames based on numeric rownames within a chosen threshold and keeping unmatched rows as well

我有两个数字向量:

b_1 <- c(543.4591, 489.36325, 12.03, 896.158, 1002.5698, 301.569)
b_2 <- c(22.12, 53, 12.02, 543.4891, 5666.31, 100.1, 896.131, 489.37)

我要比较 全部 b_1 中的元素针对 b_2 中的所有元素反之亦然。

如 element_i在 b_1是 不是 等于 任何 号码在 范围 element_j ± 0.045在 b_2然后 element_i必须报告。

同样，如果 element_j在 b_2是 不是 等于 任何 号码在 范围 element_i ± 0.045在 b_1然后 element_j必须报告。

因此，基于上面提供的向量的示例答案将是:

### based on threshold = 0.045
in_b1_not_in_b2 <- c(1002.5698, 301.569)
in_b2_not_in_b1 <- c(22.12, 53, 5666.31, 100.1)

有没有 R 函数可以做到这一点？

Answer 1

一个矢量化的野兽:

D <- abs(outer(b_1, b_2, "-")) > 0.045

in_b1_not_in_b2 <- b_1[rowSums(D) == length(b_2)]
#[1] 1002.570  301.569

in_b2_not_in_b1 <- b_2[colSums(D) == length(b_1)]
#[1]   22.12   53.00 5666.31  100.10

几小时后...

Henrik分享了一个提示使用时内存爆炸的问题 outer对于长向量: Matching two very very large vectors with tolerance (fast! but working space sparing) .然而， outer 的内存瓶颈可以很容易地被阻止杀死。

f <- function (b1, b2, threshold, chunk.size = 5000) {

  n1 <- length(b1)
  n2 <- length(b2)
  chunk.size <- min(chunk.size, n1, n2)

  RS <- numeric(n1)  ## rowSums, to be accumulated
  CS <- numeric(n2)  ## colSums, to be accumulated

  j <- 0
  while (j < n2) {
    chunk.size_j <- min(chunk.size, n2 - j)
    ind_j <- (j + 1):(j + chunk.size_j)
    b2_j <- b2[ind_j]
    i <- 0
    while (i < n1) {
      chunk.size_i <- min(chunk.size, n1 - i)
      ind_i <- (i + 1):(i + chunk.size_i)
      M <- abs(outer(b1[ind_i], b2_j, "-")) > threshold
      RS[ind_i] <- RS[ind_i] + rowSums(M)
      CS[ind_j] <- CS[ind_j] + colSums(M)
      i <- i + chunk.size_i
      }
    j <- j + chunk.size_j
    }

  list(in_b1_not_in_b2 = b1[RS == n2], in_b2_not_in_b1 = b2[CS == n1])
  }

有了这个功能， outer永远不会使用比存储两个更多的内存 chunk.size x chunk.size矩阵。现在让我们做些疯狂的事情。

b1 <- runif(1e+5, 0, 10000)
b2 <- b1 + runif(1e+5, -1, 1)

如果我们做一个简单的 outer ，我们需要内存来存储两个 1e+5 x 1e+5矩阵，最大为 149 GB。但是，在我只有 4 GB RAM 的 Sandy Bridge (2011) 笔记本电脑上，计算是可行的。

system.time(oo <- f(b1, b2, 0.045, 5000))
#   user  system elapsed 
#365.800 167.348 533.912 

鉴于 ，性能实际上已经足够好了我们一直在使用一个非常糟糕的算法 .

这里的所有答案都进行了穷尽搜索，这很复杂 length(b1) x length(b2) .我们可以将其减少到 length(b1) + length(b2)如果我们处理排序数组。但是这种深度优化的算法只能用编译语言来实现才能获得效率。