我想做的或多或少是以下两个线程中讨论的问题的组合:
我有两个数值向量:
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
不等于范围中的任何个数字,{{1 }}中的element_i ± 0.045
中,则必须报告b_1
。
因此,基于以上提供的向量的示例答案将为:
element_j
是否有R函数可以做到这一点?
答案 0 :(得分:3)
向量化的野兽:
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)
。但是这种深度优化的算法只能用编译语言来实现,以提高效率。
答案 1 :(得分:2)
这是另一种方法
in_b1_not_in_b2 <- b_1[sapply(b_1, function(x) !any(abs(x - b_2) <= 0.045))]
in_b1_not_in_b2
#[1] 1002.570 301.569
in_b2_not_in_b1 <- b_2[sapply(b_2, function(x) !any(abs(x - b_1) <= 0.045))]
in_b2_not_in_b1
#[1] 22.12 53.00 5666.31 100.10
答案 2 :(得分:2)
如果您很乐意使用非base
软件包,则data.table::inrange
是一个方便的功能。
x1[!inrange(x1, x2 - 0.045, x2 + 0.045)]
# [1] 1002.570 301.569
x2[!inrange(x2, x1 - 0.045, x1 + 0.045)]
# [1] 22.12 53.00 5666.31 100.10
inrange
在较大的数据集上也很有效。在例如1e5
个向量,inrange
比其他两个选择快> 700
倍:
n <- 1e5
b1 <- runif(n, 0, 10000)
b2 <- b1 + runif(n, -1, 1)
microbenchmark(
f1 = f(b1, b2, 0.045, 5000),
f2 = list(in_b1_not_in_b2 = b1[sapply(b1, function(x) !any(abs(x - b2) <= 0.045))],
in_b2_not_in_b1 = b2[sapply(b2, function(x) !any(abs(x - b1) <= 0.045))]),
f3 = list(in_b1_not_in_b2 = b1[!inrange(b1, b2 - 0.045, b2 + 0.045)],
in_b2_not_in_b1 = b2[!inrange(b2, b1 - 0.045, b1 + 0.045)]),
unit = "relative", times = 10)
# Unit: relative
# expr min lq mean median uq max neval
# f1 1976.931 1481.324 1269.393 1103.567 1173.3017 1060.2435 10
# f2 1347.114 1027.682 858.908 766.773 754.7606 700.0702 10
# f3 1.000 1.000 1.000 1.000 1.0000 1.0000 10
是的,他们给出了相同的结果:
n <- 100
b1 <- runif(n, 0, 10000)
b2 <- b1 + runif(n, -1, 1)
all.equal(f(b1, b2, 0.045, 5000),
list(in_b1_not_in_b2 = b1[sapply(b1, function(x) !any(abs(x - b2) <= 0.045))],
in_b2_not_in_b1 = b2[sapply(b2, function(x) !any(abs(x - b1) <= 0.045))]))
# TRUE
all.equal(f(b1, b2, 0.045, 5000),
list(in_b1_not_in_b2 = b1[!inrange(b1, b2 - 0.045, b2 + 0.045)],
in_b2_not_in_b1 = b2[!inrange(b2, b1 - 0.045, b1 + 0.045)]))
# TRUE
searching for inrange
on SO时有几个相关的,可能有用的答案。