对未来事件计算时间的最优化

Question

我有两个数据帧，一个是57个受试者的实验数据，分为两个块，每个块有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(它有一个userid, blocknum和trialnum)的每次试验中，你想在下一次漂移校正之前计算试验的次数(或者如果没有后续的漂移校正，则为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. 按用户名和分组分割dori.np
2. 查找driftCor.user
中的相关漂移修正
3. 在单个矢量化操作中计算dori.np子集的每一行到下一个漂移校正的距离(我将使用cut来执行此操作)
4. 将所有结果合并在一起

下面是在base R中可能看起来的样子(我假设这里dori.np首先按userid排序，然后按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

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