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

2 回答

• 2

  这是我提出的解决方案：

  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策略可以更快地制作它？

  回复于 2024-05-13T12:48:05+08:00
• 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
  

  ---

  编辑： lapply 每@Sepehr稍微好一点 .

  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
  

  回复于 2024-05-13T12:48:05+08:00