从数据框列表中提取数据框，并执行计算

Question

我在数据框rand_sample 中有一个列，它是数据框列表。我想只提取数据帧以在该数据帧中执行计算，然后将这些计算作为新列添加到rand_sample

str(rand_sample[1, ]$times)
List of 1
 $ :'data.frame':   13 obs. of  2 variables:
  ..$ white: num [1:13] 1800 1834 1875 1897 1887 ...
  ..$ black: num [1:13] 1800 1860 1946 2031 2114 ...

第一个索引如下所示：

> rand_sample[1:10,]$times
[[1]]
   white black
1   1800  1800
2   1834  1860
3   1875  1946
4   1897  2031
5   1887  2114
6   1839  2203
7   1835  2282
8   1880  2370
9   1875  2400
10  1892  2323
11  1612  2356
12  1622  2370
13  1619  2370

本质上，我想做的可以用这个for循环来表达：

for (i in 1:nrow(rand_sample)) {
  current <- rand_sample[i, ]$times[[1]]
  mW <- abs(diff(current$white))
  mB <- abs(diff(current$black))
  maxWhite <- max(mW)
  minWhite <- min(mW)
  maxBlack <- max(mB)
  minBlack <- min(mB)
  sdWhite <- sd(mW)
  sdBlack <- sd(mB)
  avgW <- mean(mW)
  avgB <- mean(mB)

  rand_sample[i, ]$maxWhite <- maxWhite
  rand_sample[i, ]$minWhite <- minWhite
  rand_sample[i, ]$maxBlack <- maxBlack
  rand_sample[i, ]$minBlack <- minBlack
  rand_sample[i, ]$sdWhite <- sdWhite
  rand_sample[i, ]$sdBlack <- sdBlack
  rand_sample[i, ]$avgTimeWhite <- avgW
  rand_sample[i, ]$avgTimeBlack <- avgB
}

两个问题：

1. 如何从$timestamp 中的每个列表中仅提取数据框？

   rand_sample$times[[1]]
   

   让我只是第一行。我希望能够做类似的事情

   rand_samples$dataFrameTimes <- rand_sample$times[[1]]
   

   因此，新列只是一列数据框，而不是包含数据框的列表。

2. 如何通过更快的机制模拟for 循环？运行 for 循环每行大约需要 1 秒。我有一个包含数千行的数据集，所以这是站不住脚的。

Answer 1

考虑将for 循环转换为lapply 用于数据帧列表（等于rand_sample 的行。然后在列表上运行do.call(rbind, ...) 到一个数据帧中，最后cbind 到rand_sample。末尾的transform 是删除现在不需要的times 列：

dfList <- lapply(rand_sample$times, function(current) {

  mW <- abs(diff(current[[1]]$white))
  mB <- abs(diff(current[[1]]$black))

  data.frame(
    maxWhite = max(mW),
    minWhite = min(mW),
    maxBlack = max(mB),
    minBlack = min(mB),
    sdWhite = sd(mW),
    sdBlack = sd(mB),
    avgW = mean(mW),
    avgB = mean(mB)
  )
})

all_times <- do.call(rbind, dfList)

finaldf <- transform(cbind(rand_sample, all_times), times=NULL)

示例输入

rand_sample <- data.frame(
  ID = vapply(seq(50), function(i) sample(seq(15), 1, replace=TRUE), integer(1)),
  GROUP = vapply(seq(50), function(i) sample(LETTERS, 1, replace=TRUE), character(1))
)

rand_sample$times <- lapply(1:50, function(i) 
                            list(data.frame(white=sample(1000:2000, 50), 
                                            black=sample(1000:2000, 50))))

输出

head(finaldf)

#   ID GROUP maxWhite minWhite maxBlack minBlack  sdWhite  sdBlack     avgW     avgB
# 1  3     N      807        3      778       32 212.5353 177.5051 327.4082 297.3469
# 2 12     Q      858        2      892        7 261.3543 222.4173 356.1837 366.7143
# 3  6     R      749       13      910        8 208.5439 233.3391 324.6735 348.2041
# 4  5     V      892        8      886       20 246.3769 261.3922 356.7347 329.5306
# 5  4     O      842        5      886        2 200.1235 257.9464 350.2653 300.7347
# 6  3     T      790       17      908       53 204.7842 235.0276 319.7959 385.1224