使用子集（）进行矢量化？

Question

我有一个scores (V3) 的数据框，用于一系列整数范围（V1 到V2）。

scores <- structure(list(V1 = c(2037651L, 2037659L, 2037677L, 2037685L, 
  2037703L, 2037715L), V2 = c(2037700L, 2037708L, 2037726L, 2037734L, 
  2037752L, 2037764L), V3 = c(1.474269, 1.021012, 1.180993, 1.717131, 
  2.361985, 1.257013)), .Names = c("V1", "V2", "V3"), class = "data.frame", 
  row.names = c(NA, -6L))

    V1      V2      V3
1 2037651 2037700 1.474269
2 2037659 2037708 1.021012
3 2037677 2037726 1.180993
4 2037685 2037734 1.717131
5 2037703 2037752 2.361985
6 2037715 2037764 1.257013

我还有一个整数向量。

 coords <- structure(list(V1 = c(2037652, 2037653, 2037654, 2037655, 2037656, 
 2037657, 2037658, 2037659, 2037660, 2037661, 2037662, 2037663, 
 2037664, 2037665, 2037666, 2037667, 2037668, 2037669, 2037670, 
 2037671)), .Names = "V1", row.names = c(NA, -20L), class = "data.frame")

对于每个整数（coords），我想确定整数范围（分数V1 到V2）包含coord$V1 的所有分数（scores$V3）的平均值。为此，我尝试了：

for(i in 1:nrow(coord)){
    range_scores <- subset(scores, 
                           scores$V1 <= coord$V1[i] & scores$V2 >= coord$V1[i])
    coord$V2[i] <- mean(range_scores$V3)
}

该功能有效，但速度极慢。

我怎样才能更有效地完成同样的事情？

Answer 1

这是我提出的解决方案：

scores = read.table(header=FALSE,
                    text="2037651 2037700 1.474269
                          2037659 2037708 1.021012
                          2037677 2037726 1.180993
                          2037685 2037734 1.717131
                          2037703 2037752 2.361985
                          2037715 2037764 1.257013")

coord = data.frame(V1=c(2037652, 2037653, 2037654, 2037655, 2037656, 2037657,
                     2037658, 2037659, 2037660, 2037661, 2037662, 2037663,
                     2037664, 2037665, 2037666, 2037667, 2037668, 2037669,
                     2037670, 2037671))

coord_vec = coord$V1                  # Store as a vector instead of data.frame
scores_mat = as.matrix(scores)        # Store as a matrix instead of data.frame
results = numeric(length=nrow(coord)) # Pre-allocate vector to store results.

for (i in 1:nrow(coord)) {
    select_rows = ((scores_mat[, 1] <= coord_vec[i]) & 
                   (scores_mat[, 2] >= coord_vec[i]))
    scores_subset = scores_mat[select_rows, 3] # Use logical indexing.
    results[i] = mean(scores_subset)
}
results
#  [1] 1.474269 1.474269 1.474269 1.474269 1.474269 1.474269 1.474269 1.247641
#  [9] 1.247641 1.247641 1.247641 1.247641 1.247641 1.247641 1.247641 1.247641
# [17] 1.247641 1.247641 1.247641 1.247641

# Benchmark results using @GSee's code. Needs library(rbenchmark).
#        test replications elapsed relative user.self sys.self
# 4 bdemarest          100   0.046 1.000000     0.046    0.001
# 2      gsee          100   0.170 3.695652     0.170    0.001
# 1      orig          100   0.358 7.782609     0.360    0.001
# 3    sepehr          100   0.163 3.543478     0.164    0.000

这似乎比其他提案要快很多。我很确定通过避免读取或写入 data.frame（高开销函数）可以获得优势。此外，我使用逻辑索引而不是 subset() 来进一步减少开销。使用 *ply 策略可能会更快？

Answer 2

coord$V2 <- sapply(coord$V1, function(x) mean(scores[scores[, 2] >= x & x >= scores[, 1], 3])) 大约快一倍。

首先，重新创建您的数据：

scores <- read.table(text="       V1      V2      V3
1 2037651 2037700 1.474269
2 2037659 2037708 1.021012
3 2037677 2037726 1.180993
4 2037685 2037734 1.717131
5 2037703 2037752 2.361985
6 2037715 2037764 1.257013", row.names=1)

coord <-data.frame(V1=c(2037652, 2037653, 2037654, 2037655, 2037656, 2037657, 2037658, 
           2037659, 2037660, 2037661, 2037662, 2037663, 2037664, 2037665, 
           2037666, 2037667, 2037668, 2037669, 2037670, 2037671))

制作函数和基准：

gsee <- function(coord) {
    coord$V2 <- sapply(coord$V1, function(x) mean(scores[scores[, 2] >= x & x >=  scores[, 1], 3]))
    coord
}

orig <- function(coord) {
    for(i in 1:NROW(coord)){
        range_scores<-subset(scores, scores$V1 <= coord$V1[i] & scores$V2 >= coord$V1[i]);
        coord$V2[i]<-mean(range_scores$V3)
    }
    coord
}
identical(gsee(coord), orig(coord))  # TRUE
benchmark(orig=orig(coord), gsee=gsee(coord))

test replications elapsed relative user.self sys.self user.child sys.child
2 gsee          100   0.175 1.000000     0.175    0.000          0         0
1 orig          100   0.379 2.165714     0.377    0.002          0         0 

---

编辑： @Sepehr 的lapply 稍微好一点。

sepehr <- function(coord) {
    coord$V2 <- unlist(lapply(coord$V1, function(x) mean(scores[scores[, 2] >= x & x >=  scores[, 1], 3])))
    coord
}
benchmark(orig=orig(coord), gsee=gsee(coord), sepehr=sepehr(coord))
test replications elapsed relative user.self sys.self user.child sys.child
2   gsee          100   0.171 1.023952     0.171    0.000          0         0
1   orig          100   0.369 2.209581     0.369    0.001          0         0
3 sepehr          100   0.167 1.000000     0.167    0.000          0         0