优化计算未来事件的时间

Question

我有两个数据框，一个包含 57 名受试者的实验数据，分 2 个区块，每个区块 250 次试验（总共 28500 行），另一个包含所有执行漂移校正的试验的主题、行、区块和试验数（总共 160 行）。以下是两个文件中相关列的样子：

实验数据：

> head(dori.np[c("userid","blocknum","trialnum")])
   userid blocknum trialnum
26      1        1        1
27      1        1        2
28      1        1        3
29      1        1        4
30      1        1        5
31      1        1        6

漂移修正数据：

> head(driftCor.user)
  userid driftTrials blocknum trialnum
1      4          61        1       61
2      4         140        1      140
3      5           1        1        1
4      6         208        1      208
5      8          71        1       71
6      8         197        1      197

我想做的是为每个参与者的每次试验计算未来最近的漂移校正距离（在试验中）多远。现在我正在使用嵌套循环来执行此操作，但它需要很长时间才能运行。

numTilDrifCor<-numeric(0)
for (i in driftCor.user$userid) {
  temp1 <- subset(driftCor.user,driftCor.user$userid==i)

  for (j in temp1$blocknum) {
    temp2<-subset(dori.np,dori.np$userid==i & dori.np$blocknum==j)
    driftTrials<-subset(temp1,temp1$blocknum==j)

    n <- 1
    for (k in 1:250) {
      if (n <= length(driftTrials$trialnum)) {
        diff <- driftTrials$trialnum[n] - k

        if (diff > 0) {
          numTilDrifCor <- c(numTilDrifCor,diff)
        } else if (diff == 0) {
          numTilDrifCor <- c(numTilDrifCor,0)
          n <- n + 1
        }

      } else {
        numTilDrifCor <- c(numTilDrifCor,NA)
      }
    }
  }
}

有更快的方法吗？

Answer 1

听起来，对于dori.np 中的每个试验（具有用户 ID、块编号和试验编号），您想要计算下一次漂移校正之前的试验次数（如果没有后续漂移校正，则为 NA）；所有漂移修正都存储在driftCor.user。

让我们考虑一个小的示例数据集：

(dori.np <- data.frame(userid=rep(1, 6), blocknum=c(1, 1, 1, 2, 2, 2), trialnum=c(1, 2, 3, 1, 2, 3)))
#   userid blocknum trialnum
# 1      1        1        1
# 2      1        1        2
# 3      1        1        3
# 4      1        2        1
# 5      1        2        2
# 6      1        2        3
(driftCor.user <- data.frame(userid=c(1, 1), blocknum=c(1, 1), driftTrials=c(1, 3)))
#   userid blocknum driftTrials
# 1      1        1           1
# 2      1        1           3

我会使用 split-apply-combine 来解决这个问题：

1. 按用户 ID 和区块编号拆分 dori.np
2. 在driftCor.user 中查找相关的漂移修正
3. 在单个矢量化操作中计算您的dori.np 子集的每一行到下一个漂移校正的距离（我将使用cut 来执行此操作）
4. 将所有结果重新组合在一起

这是在基本 R 中的样子（我在这里假设 dori.np 首先按用户 ID 排序，然后按 blocknum 排序）：

dori.np$nextDrift <- unlist(lapply(split(dori.np, paste(dori.np$userid, dori.np$blocknum)),
  function(x) {
    corrs <- sort(driftCor.user$driftTrials[driftCor.user$userid == x$userid[1] &
                                            driftCor.user$blocknum == x$blocknum[1]])
    if (length(corrs) == 0) {
      rep(NA, nrow(x))
    } else {
      corrs[cut(x$trialnum, c(0, corrs))] - x$trialnum
    }
  }
))
#   userid blocknum trialnum nextDrift
# 1      1        1        1         0
# 2      1        1        2         1
# 3      1        1        3         0
# 4      1        2        1        NA
# 5      1        2        2        NA
# 6      1        2        3        NA

我想这会给你带来显着的效率提升，因为它使用矢量化操作来计算直到下一次漂移校正的时间，并且它避免了一次增加一个元素的矢量（看看为什么这会减慢你的代码，查看the R Inferno的第二个圈子）。虽然我在这里提供了一个基本的 R 解决方案，但许多包也可用于执行这些类型的分组操作，其中一些可能会产生进一步的效率改进（想到的两个是 data.table 和 dplyr）。