R：使用一个列表有效地修改另一个列表

Question

我正在尝试修改另一个列表中包含的基于列表的信息。问题的本质是一个列表list1包含数据框——每列两列，第1列（time）=时间瞬间，第2列（score）填充0s——另一个列表@ 987654324@ 包含数据框——两列包含成对的时间实例（例如 0.12 和 0.125 或 1.54 和 1.57），或时间窗口的起点和终点。 list1中的每个数据框在list2中都有一个对应的（即同名）数据框

目标是通过修改确定list1 中每个数据帧中的哪些时间瞬间（即来自time 列）确实落在list2 中相关数据帧中包含的任何时间窗口之间list1（全零）中数据帧的“分数”列，如果其关联的时间时刻在来自list2 的相应（即同名）数据帧的配对时间中的至少一个之间。最终结果本质上是list1，score 列中的 0 将不落入任何窗口的时间瞬间与落入的时间瞬间区分开来。

以下是一些示例数据：

set.seed(1)
list1 <- split(d<-replicate(10,1:100+rnorm(100,0,0.1)), 
         ceiling(seq_along(d)/100))
list1 <- lapply(list1, function(x) data.frame(cbind(time = x, score = 0)))
names(list1) <- letters[1:10]

list2 <- replicate(10, sample(1:100, sample(1:20), replace=FALSE)) 
list2 <- lapply(list2, function(x) 
         data.frame(cbind(x, x + sample(runif(100,min=0.1,max=3),length(x)))))
names(list2) <- letters[1:10]

我能够拼凑出一两个适用于小示例的解决方案，但是当我在更大的列表中尝试它时（即真实的 list1 中的几百万个时间瞬间），我遇到了内存错误。

首先，我做了一个函数来做我想做的给定两个适当的数据框

testfxn1 <-function(df1, df2)
  {
    df1<-lapply(1:dim(df2)[1], function(x)
    {
    df1[which(df1[1] > df2[x,1] & df1[1] < df2[x,2]), 2] <- 1
    return(df1)
    })
    return(cbind(df1[[1]][1], 
           score = rowSums(do.call(cbind,lapply(df1,'[[',2)))))
  }

然后，我使用sapply 将该函数应用于整个列表：

sapply(names(list1), simplify=FALSE, function(x) return(testfxn1(list1[[x]], list2[[x]])))

它做我想要的（即在数据不在相关时间窗口之间的情况下留下 0），但在我的真实数据中，list1 中有许多具有 250,000 - 750,000 个时间瞬间的数据帧，我无法分配足够的内存来完成任务。

关于如何更有效地完成此任务的任何想法？当然，我的testfxn1 中的第一个lapply 调用肯定是问题的很大一部分。

Answer 1

不确定这是否会更快。

res <- setNames(lapply(names(list1), function(x) {
         x1 <- list2[[x]]
         x2 <- list1[[x]][, 1]
         x3 <- t(replicate(length(x2), x1[, 1]))
         x4 <- t(replicate(length(x2), x1[, 2]))
            data.frame(time = x2, score = rowSums(x2 > x3 & x2 < x4))
      }), names(list1))

 s1 <- sapply(names(list1), simplify=FALSE, function(x) return(testfxn1(list1[[x]], list2[[x]])))     

 identical(res, s1)
  #[1] TRUE

另一种方法是：

 library(data.table)
 x1 <- rbindlist(list1)
 x2 <- rbindlist(list2)

 #slower
 s3 <- Vectorize(function(x) x1[, time] > x)(x2[, x]) & Vectorize(function(y) x1[, 
time] < y)(x2[, V2])
 indx <- rep(names(list2), sapply(list2, dim)[1, ])
 indx2 <- seq(1, nrow(x1), by = 100)
 lst1 <- split(seq_len(ncol(s3)), indx)
 res1 <- setNames(lapply(seq_along(indx2), function(i) data.frame(time = list1[[i]][, 
1], score = rowSums(s3[indx2[i]:(indx2[i] + 99), lst1[[i]]]))), names(list1))

 identical(res,res1)
 #[1] TRUE

Answer 2

如果我正确理解问题，这可能会快一点。您至少可以通过矢量化删除一组循环。

windows = rbind(list2[[1]], list2[[2]])
# for each time, look at all windows and see if the time t falls outsize every single window:
list1[[1]]$score = sapply(list1[[1]]$time, FUN=function(t){
    all(t > windows[,1] | t < windows[,2])
}) 
# same thing for the second dataframe in list1
# TRUE = in a window, FALSE = not in a window. Use as.numeric() to coerce to 0's and 1's.

Answer 3

可能还有更好的方法，但可以肯定的是，内存紧缩的重要部分是df1 的许多副本（在适当的情况下，每个score 值都有几个1 而不是0）。另一种方法是使用df1 的单个副本，只要时间匹配，我们就会增加相应的条目。此外，这种方法无需在最后用总和重新创建 df1。
换句话说：

# alternative to original tesetfxn1() function
#   The idea is to increment the value in the qualifying rows in-situ rather
#   than producing as many copies of df1 as there are rows in df2 and having to
#   sum these up at the end.
testfxn1 <-function(df1, df2)
{
    for (x in 1:nrow(df2))  # I find this more explicit that 1:dim(df2)[1]
    {
        # Get "list" of qualifying rows
        selectRows <- which(df1[1] > df2[x,1] & df1[1] < df2[x,2])
        # Increment the corresponding row's score value
        if (length(selectRows) > 0) {
          df1[selectRows, 2] <- df1[selectRows, 2] + 1
          # or more explicitly...
          # df1[selectRows, ]$score <- df1[selectRows, ]$score + 1
        }
    }

    df1
}

Answer 4

@HillarySanders 的回答给了我一个想法。

出于我的目的，此答案产生与 testfxn1 相同的相关信息，尽管此处需要一个后处理步骤才能将此处的输出与原始 list1 时间即时数据相结合。

testfxn2 <- function(df1, df2)
  {
  sapply(df1$time, function(g)
    {
    any(g > df2[,1] & g < df2[,2])
    })
  }

然后sapply它：

sapply(names(list1), simplify=FALSE, function(x) testfxn2(list1[[x]], list2[[x]]))