优化计算未来事件的时间

时间:2015-09-27 22:56:21

标签: r

我有两个数据框,一个包含57个受试者的实验数据,每个包含250个试验的2个区块(共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)
      }
    }
  }
}

有更快的方法吗?

1 个答案:

答案 0 :(得分: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. 按用户ID和blocknum
  2. 拆分dori.np
  3. driftCor.user
  4. 中查找相关的漂移校正
  5. 在单个矢量化操作中计算dori.np子集每行的下一次漂移校正的距离(我将使用cut来执行此操作)
  6. 将所有结果重新组合在一起
  7. 以下是基本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
    

    我认为这会给你带来显着的效率提升,因为它使用向量化运算来计算下一次漂移校正之前的时间,并且它避免一次增加一个向量元素(看看为什么这会减慢你的代码,看看the R Inferno的第二个圈子。虽然我在这里提供了一个基础R解决方案,但许多软件包也可用于执行这些类别的分组操作,有些软件包可能会进一步提高效率(两个可以想到的是data.table和{{1} })。