我有两个表，A和B。对于表格A的每一行，我想获得B$value的一些摘要统计信息，其中B$location的值在100的{{1}}范围内。我已经使用下面的for循环完成了这个，但这是一个缓慢的解决方案，当表很小但是我想扩展到一个表A$location，这是几千行和一个表A表是近百万行。有关如何实现这一目标的任何想法？提前致谢！
for-loop：
B一个例子：
for (i in 1:nrow(A)) {
subset(B, abs(A$location[i] - B$location) <= 100) -> temp
A$n[i] <- nrow(temp)
A$sum[i] <- sum(temp$value)
A$avg[i] <- mean(temp$value)
}
A
loc
150
250
400
会变成：
B
loc value
25 7
77 19
170 10
320 15
答案 0 :(得分：3)
与Matt Summersgill的答案类似，你可以做一个非等同连接来更新A：
A[, up := loc + 100]
A[, dn := loc - 100]
A[, c("n", "s", "m") :=
B[copy(.SD), on=.(loc >= dn, loc <= up), .(.N, sum(value), mean(value)), by=.EACHI][, .(N, V2, V3)]
]
或者在一个链式命令中：
A[, up := loc + 100][, dn := loc - 100][, c("n", "s", "m") :=
B[copy(.SD), on=.(loc >= dn, loc <= up),
.(.N, sum(value), mean(value)), by=.EACHI][,
.(N, V2, V3)]
]
我猜这应该是相当有效的。
工作原理
在j的{{1}}内，x[i, j]指的是来自.SD的数据子集（在这种情况下，它是x的所有数据）。
A是一个联接，使用x[i, on=, j, by=.EACHI]的每一行（在这种情况下为i == copy(.SD)）来查找A的匹配行（在这种情况下x）使用B中的条件。对于on=的每一行，计算i（这是j的含义）。
如果by=.EACHI没有名称，则会自动分配这些名称。 j，V1，依此类推。默认情况下，V2名为.N。
答案 1 :(得分：2)
我的纯R解决方案（下面）仍然相当慢， 在我的系统中，需要32秒才能完成Matt Summersgill的典范， 但与其他解决方案相比， 它仍然是合理的。
我的解决方案的逻辑是，
因为输入是排序的，
当你考虑A_loc的新元素时，
如果新的B_loc元素与之前的元素相同，则A_loc中的值范围将保持不变，
或者它将在B_loc中向右移动，
可能会收缩或扩大。
请注意，如果您使用double输入，
你必须对比较小心一点。
这个C ++版本自然更快。
如果您可以Rcpp::sourceCpp此代码：
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
DataFrame foo(IntegerVector A_loc, IntegerVector B_loc, IntegerVector B_val) {
IntegerVector n(A_loc.length());
IntegerVector sum(A_loc.length());
NumericVector avg(A_loc.length());
int lower = 0;
int upper = 0;
int count = 0;
int current_sum = 0;
for (int i = 0; i < A_loc.length(); i++) {
checkUserInterrupt();
while (lower < B_loc.length()) {
if (B_loc[lower] >= A_loc[i] - 100) {
break;
}
if (count > 0) {
count--;
current_sum -= B_val[lower];
}
lower++;
}
if (upper < lower) {
upper = lower;
}
while (upper < B_loc.length()) {
if (B_loc[upper] > A_loc[i] + 100) {
break;
}
count++;
current_sum += B_val[upper++];
}
n[i] = count;
sum[i] = current_sum;
avg[i] = static_cast<double>(current_sum) / count;
}
DataFrame df = DataFrame::create(
Named("loc") = A_loc,
Named("n") = n,
Named("sum") = sum,
Named("avg") = avg
);
return df;
}
然后这个：
A <- data.frame(loc = sample.int(1000, size = 1e4, replace = TRUE))
B <- data.frame(loc = sample.int(1000, size = 1e6, replace = TRUE),
value = sample.int(100, size = 1e6, replace = TRUE))
test <- function() {
# remove unique if you want to consider duplicated values
A_loc <- sort(unique(A$loc), decreasing = FALSE)
B <- B[order(B$loc),]
out <- foo(A_loc, B$loc, B$value)
}
microbenchmark::microbenchmark(test())
显示了这些时间：
Unit: milliseconds
expr min lq mean median uq max neval
test() 44.74469 45.8118 51.35361 47.34657 48.99376 95.00938 100
如果你不能使用Rcpp， 然后考虑下面的R版本， 或Frank的data.table解决方案， 我认为对输入进行排序也可能有助于这种情况？
R中通常避免使用 for个循环，
但我不认为他们总是很慢，
你必须要小心，不要过多地复制数据。
另外，自R v3.5.0起，
写for i in 1:10之类的东西不再首先分配整个向量，
它支持紧凑的表示。
A_loc <- sort(unique(A$loc), decreasing = FALSE)
B <- B[order(B$loc),]
out <- data.frame(loc = A_loc,
n = 0L,
sum = 0L,
avg = 0)
lower <- 1L
upper <- 1L
count <- 0L
sum <- 0L
upper_limit <- nrow(B)
for (i in seq_along(A_loc)) {
current_loc <- A_loc[i]
while (lower <= upper_limit) {
if (B$loc[lower] >= current_loc - 100L) {
break
}
if (count > 0L) {
count <- count - 1L
sum <- sum - B$value[lower]
}
lower <- lower + 1L
}
if (upper < lower) {
upper <- lower
}
while (upper <= upper_limit) {
if (B$loc[upper] > current_loc + 100L) {
break
}
count <- count + 1L
sum <- sum + B$value[upper]
upper <- upper + 1L
}
out$n[i] <- count
out$sum[i] <- sum
out$avg[i] <- sum / count
}
答案 2 :(得分：1)
这是一个library(tidyverse)
A = read.table(text = "
loc
150
250
400
", header=T)
B = read.table(text = "
loc value
25 7
77 19
170 10
320 15
", header=T)
A %>%
mutate(B = list(B)) %>% # create all combinations of rows of A and B
unnest() %>%
filter(abs(loc - loc1) <= 100) %>% # keep rows that satisfy your condition
group_by(loc) %>% # for each loc values
summarise(sum = sum(value), # calculate sum
avg = mean(value)) # calculate mean
# # A tibble: 3 x 3
# loc sum avg
# <int> <int> <dbl>
# 1 150 29 14.5
# 2 250 25 12.5
# 3 400 15 15
解决方案
A如果您有大型B和{{1}}表，则可能不是最佳解决方案，因为您必须创建所有行组合然后进行过滤。
答案 3 :(得分：1)
这可以通过foverlaps中的data.table函数实现，并且以下方法实际上是在完成您的实际用例时祷告 - A这是几千行在合理的时间内表B表，其中有近百万行。
library(data.table)
A <- fread("
loc
150
250
400")
B <- fread("
loc value
25 7
77 19
170 10
320 15")
## Create a 'dummy' value to create an interval w/same start and end in A
A[,loc_Dummy := loc]
## Create values bounding the match range for loc in B
B[,loc_Plus100 := loc + 100]
B[,loc_Minus100 := loc - 100]
## Set up for the overlap join
setkey(A,loc,loc_Dummy)
setkey(B,loc_Minus100, loc_Plus100)
## Create a table of only matches instead of doing a full cartesian join of all cases
Matches <- foverlaps(A[,.(loc, loc_Dummy)],
B[,.(loc_Minus100,loc_Plus100,value)])
## Create a summary table
Matches[,.(n = .N, sum = sum(value), avg = mean(value)), by = .(loc)]
# loc n sum avg
# 1: 150 2 29 14.5
# 2: 250 2 25 12.5
# 3: 400 1 15 15.0
但是 - 这实际上是一个非常计算密集型问题。扩展到您的实际案例大小显示了这里的挑战 - 对表A使用10,000行，为表B使用1,000,000行，此方法在服务器上以 91秒完成我正在运行，但使用超过112 GB的内存！
A <- data.table(loc = sample.int(1000, size = 1e4, replace = TRUE))
B <- data.table(loc = sample.int(1000, size = 1e6, replace = TRUE),
value = sample.int(100, size = 1e6, replace = TRUE))
system.time({
A[,loc_Dummy := loc]
B[,loc_Plus100 := loc + 100]
B[,loc_Minus100 := loc - 100]
setkey(A,loc,loc_Dummy)
setkey(B,loc_Minus100, loc_Plus100)
Matches <- foverlaps(A[,.(loc, loc_Dummy)],
B[,.(loc_Minus100,loc_Plus100,value)])
Summary <- Matches[,.(n = .N, sum = sum(value), avg = mean(value)), by = .(loc)]
})
## Warning: Memory usage peaks at ~112 GB!
# user system elapsed
# 56.407 46.258 91.135
这几乎不在我使用的服务器的功能范围内，可能实际上可能不适用于您的情况。
如果您没有数百GB的内存可供使用，那么您可能必须更加聪明地处理此问题并一次遍历块。
据我所知，你的问题实际上与Lorenzo Busetto所提出（并已解决）的问题类似，并在博客文章中详细说明：Speeding up spatial analyses by integrating sf and data.table: a test case。
需要超过100 GB的内存并不是真正一个可行的解决方案 - 特别是如果你想将A或B扩展到一个数量级某点。
然而，一个分块方法（灵感来自上面链接的Lorenzo的帖子）将问题分成100个块实际上只会将运行时间增加到 116秒，但将峰值内存使用量减少到小于3 GB ！如果我打算在制作中这样做，我会选择以下内容。
一个注意事项：我没有真正对结果的准确性进行一些深入的审核（我可能已经指定了一个范围界限错误地打开或关闭），所以我会仔细检查输出在投入生产之前您熟悉的数据。
A <- data.table(loc = sample.int(1000, size = 1e4, replace = TRUE))
B <- data.table(loc = sample.int(1000, size = 1e6, replace = TRUE),
value = sample.int(100, size = 1e6, replace = TRUE))
system.time({
A[,loc_Dummy := loc]
B[,loc_Plus100 := loc + 100]
B[,loc_Minus100 := loc - 100]
setkey(A,loc)
setkey(B,loc)
ChunkCount <- 100
ChunkSize <- A[,.N/ChunkCount]
ResultList <- vector("list", ChunkCount)
for (j in seq_len(ChunkCount)){
A_loc_Min <- A[((j-1)*ChunkSize + 1):(min(nrow(A),(j)*ChunkSize)), min(loc)]
A_loc_Max <- A[((j-1)*ChunkSize + 1):(min(nrow(A),(j)*ChunkSize)), max(loc)]
A_Sub <- A[loc >= A_loc_Min & loc < A_loc_Max]
B_Sub <- B[loc_Plus100 >= A_loc_Min & loc_Minus100 < A_loc_Max]
setkey(A_Sub,loc,loc_Dummy)
setkey(B_Sub,loc_Minus100, loc_Plus100)
Matches <- foverlaps(A_Sub[,.(loc, loc_Dummy)],
B_Sub[,.(loc_Minus100,loc_Plus100,value)])
ResultList[[j]] <- Matches[,.(n = .N, sum = sum(value), avg = mean(value)), by = .(loc)]
}
Summary <- rbindlist(ResultList)
})
# user system elapsed
# 109.125 16.864 116.129
更新：@Alexis和@Frank在评论中的建议生成相同的结果集，我的出现略有不同，但仅限于计数。如果其他人可以验证@ Alexis / @ Frank提供的答案是否正确，那么我很乐意收回我的答案，因为这两种方法的执行速度都比我提议的要快。
set.seed(1234)
A <- data.table(loc = sample.int(1000, size = 1e3, replace = TRUE))
B <- data.table(loc = sample.int(1000, size = 1e4, replace = TRUE),
value = sample.int(10, size = 1e4, replace = TRUE))
## Matt
Matt_A <- copy(A)
Matt_B <- copy(B)
Matt_A[,loc_Dummy := loc]
Matt_B[,loc_Plus100 := loc + 100]
Matt_B[,loc_Minus100 := loc - 100]
setkey(Matt_A,loc,loc_Dummy)
setkey(Matt_B,loc_Minus100, loc_Plus100)
Matches <- foverlaps(Matt_A[,.(loc, loc_Dummy)],
Matt_B[,.(loc_Minus100,loc_Plus100,value)])
Summary_Matt <- Matches[,.(n = .N, sum = sum(value), avg = mean(value)), keyby = .(loc)]
## Alexis
Rcpp::sourceCpp("RowRanges.cpp")
A_loc <- sort(A$loc, decreasing = FALSE)
B <- B[order(B$loc),]
Alexis <- foo(unique(A_loc), B$loc, B$value)
Summary_Alexis <- as.data.table(Alexis)
colnames(Summary_Alexis) <- c("n","sum","avg")
Summary_Alexis[,loc := unique(A_loc)]
setcolorder(Summary_Alexis, c("loc","n","sum","avg"))
## Frank
Frank <- A[, up := loc + 100][
, dn := loc - 100][
, c("n", "s", "m") := B[copy(.SD), on=.(loc >= dn, loc <= up), .(.N, sum(value), mean(value)), by=.EACHI][
, .(N, V2, V3)]][]
Summary_Frank <- unique(Frank[,.(loc,n, sum = s, avg = m)][order(loc)])
## Comparing
all.equal(Summary_Frank,Summary_Alexis)
# [1] TRUE
all.equal(Summary_Frank,Summary_Matt)
# [1] "Column 'n': Mean relative difference: 1.425292"
答案 4 :(得分：0)
我通常不建议依赖安装软件包的解决方案，但我认为这个方法可以帮到你。它将安装一个包，使您能够在R。
中的SQL中进行编码# Load the package
install.packages("sqldf")
library(sqldf)
# Create tables
A <- data.frame("loc"=c(150,250,400))
B <- data.frame("loc"=c(25,77,170,320),"value"=c(7,19,10,15))
# Join tables
df0 <- sqldf('select a.loc
,count(b.value) as n_value
,sum(b.value) as sum_value
,avg(b.value) as avg_value
from A as a
left join B as b
on abs(a.loc - b.loc) <= 100
group by a.loc')
# Print data frame
df0
答案 5 :(得分：0)
我不确定此解决方案的扩展程度 - 这取决于滤波器矩阵是否适合内存。
A <- within(A,{
B.filter <- outer(B$loc, A$loc, function(x, y) abs(x - y) <= 100)
n <- colSums(B.filter)
sum <- colSums(B$value * B.filter)
avg <- sum / n
rm(B.filter)
})
如果A和/或B中的位置重复，您可以通过仅使用唯一值来减小滤波器矩阵的大小：
A <- within(A,{
B.filter <- outer(unique(B$loc), unique(A$loc), function(x, y) abs(x - y) <= 100)
colnames(B.filter) <- unique(A$loc)
rownames(B.filter) <- unique(B$loc)
n <- colSums(B.filter[,as.character(A$loc)])
sum <- colSums(B$value * B.filter[as.character(B$loc),])
avg <- sum / n
rm(B.filter)
})