从嵌套列表中高效采样

Question

我有一个包含data.frames 的列表列表,我只想从中选择几行.我可以在for循环中实现它,在那里我根据行数创建一个序列,并根据该序列仅选择行索引.

但是,如果我有更深层次的嵌套列表,它就不再起作用了.我也很确定,没有循环就有更好的方法.

从嵌套列表中抽样的有效且通用的方法是什么,它们的维度各不相同,包含data.frames或matrices？

## Dummy Data
n1=100;n2=300;n3=100
crdOrig <- list(
  list(data.frame(x = runif(n1,10,20), y = runif(n1,40,60))),
  list(data.frame(x = runif(n2,10,20), y = runif(n2,40,60))),
  list(data.frame(x = runif(n3,10,20), y = runif(n3,40,60)))
)

## Code to opimize
FiltRef <- list()
filterBy = 10
for (r in 1:length(crdOrig)) { 
  tmp <- do.call(rbind, crdOrig[[r]])
  filterInd <- seq(1,nrow(tmp), by = filterBy)
  FiltRef[[r]] <- tmp[filterInd,]
}
crdResult <- do.call(rbind, FiltRef)

# Plotting
crdOrigPl <- do.call(rbind, unlist(crdOrig, recursive = F))
plot(crdOrigPl[,1], crdOrigPl[,2], col="red", pch=20)
points(crdResult[,1], crdResult[,2], col="green", pch=20)

如果列表包含多个data.frames (下面的数据),上面的代码也可以工作.

## Dummy Data (Multiple DF)
crdOrig <- list(
  list(data.frame(x = runif(n1,10,20), y = runif(n1,40,60)),
       data.frame(x = runif(n1,10,20), y = runif(n1,40,60))),
  list(data.frame(x = runif(n2,10,20), y = runif(n2,40,60))),
  list(data.frame(x = runif(n3,10,20), y = runif(n3,40,60)))
)

但是如果列表包含多个列表,则会尝试将result(FiltRef)绑定在一起时抛出错误.

结果可以是具有2列(x,y)的data.frame crdResult或类似的一维列表FiltRef(来自第一个示例)

## Dummy Data (Multiple Lists)
crdOrig <- list(
  list(list(data.frame(x = runif(n1,10,20), y = runif(n1,40,60))),
       list(data.frame(x = runif(n1,10,20), y = runif(n1,40,60)))),
  list(data.frame(x = runif(n2,10,20), y = runif(n2,40,60))),
  list(data.frame(x = runif(n3,10,20), y = runif(n3,40,60)))
)

---

+1并感谢大家的精彩答案!他们都工作,每一个都有很多东西需要学习.我会把这个问题交给@ Gwang-Jin Kim,因为他的解决方案是最灵活和最广泛的,尽管它们都值得检查!

Answer 1

准备和实施flatten

嗯，还有很多其他答案，原则上是相同的。

同时，为了好玩，我实现了嵌套列表的扁平化。

因为我在 Lisp 中思考：

car首先从 Lisp实现cdr。

car <- function(l) {
  if(is.list(l)) {
    if (null(l)) {
      list()
    } else {
      l[[1]]
    }
  } else {
    error("Not a list.")
  }
}

cdr <- function(l) {
  if (is.list(l)) {
    if (null(l) || length(l) == 1) {
      list()
    } else {
      l[2:length(l)]
    }
  } else {
    error("Not a list.")
  }
}

一些谓词函数：

null <- function(l) length(l) == 0   
# this is Lisp's `null` checking whether list is empty (`length(l) == 0`)
# R's `is.null()` checks for the value NULL and not `length(obj) == 0`

# upon @Martin Morgan's comment removed other predicate functions
# thank you @Martin Morgan!
# instead using `is.data.frame()` and `is.list()`, since they are
# not only already there but also safer.

构建扁平化所必需的（对于数据框列表）

flatten <- function(nested.list.construct) {
  # Implemented Lisp's flatten tail call recursively. (`..flatten()`)
  # Instead of (atom l) (is.df l).
  ..flatten <- function(l, acc.l) { 
    if (null(l)) {
      acc.l
    } else if (is.data.frame(l)) {   # originally one checks here for is.atom(l)
      acc.l[[length(acc.l) + 1]] <- l
      acc.l # kind of (list* l acc.l)
    } else {
      ..flatten(car(l), ..flatten(cdr(l), acc.l))
    }
  }
  ..flatten(nested.list.construct, list())
}

# an atom is in the widest sence a non-list object

之后，使用采样函数定义实际函数。

定义采样函数

# helper function
nrow <- function(df) dim(df)[1L]

# sampling function
sample.one.nth.of.rows <- function(df, fraction = 1/10) {
  # Randomly selects a fraction of the rows of a data frame
  nr <- nrow(df) 
  df[sample(nr, fraction * nr), , drop = FALSE]
}

实际的收集器函数（来自嵌套的数据框列表）

collect.df.samples <- function(df.list.construct, fraction = 1/10) {
  do.call(rbind, 
         lapply(flatten(df.list.construct), 
                function(df) sample.one.nth.of.rows(df, fraction)
               )
        )
}
# thanks for the improvement with `do.call(rbind, [list])` @Ryan!
# and the hint that `require(data.table)`
# `data.table::rbindlist([list])` would be even faster.

collect.df.samples首先将数据帧的嵌套列表结构展df.list.construct平为数据帧的平面列表。它将函数应用于sample.one.nth.of.rows列表 ( lapply) 的每个元素。由此，它会生成采样数据帧的列表（其中包含分数 - 这里是原始数据帧行的 1/10）。这些采样的数据帧rbind在列表中进行编辑。返回结果数据帧。它由每个数据帧的采样行组成。

测试示例

## Dummy Data (Multiple Lists)
n1=100;n2=300;n3=100
crdOrig <- list(
  list(list(data.frame(x = runif(n1,10,20), y = runif(n1,40,60))),
       list(data.frame(x = runif(n1,10,20), y = runif(n1,40,60)))),
  list(data.frame(x = runif(n2,10,20), y = runif(n2,40,60))),
  list(data.frame(x = runif(n3,10,20), y = runif(n3,40,60)))
)

collect.df.samples(crdOrig, fraction = 1/10)

重构以供以后修改

通过将collect.df.samples函数写入：

# sampler function
sample.10th.fraction <- function(df) sample.one.nth.of.rows(df, fraction = 1/10)

# refactored:
collect.df.samples <- 
  function(df.list.construct, 
           df.sampler.fun = sample.10th.fraction) {
  do.call(rbind, 
          lapply(flatten(df.list.construct), df.sampler.fun))
}

可以使采样器功能可替换。（如果不是：通过更改fraction参数，可以增加或减少从每个数据帧收集的行数。）

在此定义中，采样器功能可以轻松交换

为了选择数据框中的每第 n（例如每 10）行，而不是随机采样，您可以使用采样器函数：

df[seq(from=1, to=nrow(df), by = nth), , drop = FALSE]

并将其输入df.sampler.fun =为collect.df.samples. 然后，该函数将应用于嵌套 df 列表对象中的每个数据帧，并收集到一个数据帧。

every.10th.rows <- function(df, nth = 10) {
  df[seq(from=1, to=nrow(df), by = nth), , drop = FALSE]
}

a.10th.of.all.rows <- function(df, fraction = 1/10) {
  sample.one.nth.of.rows(df, fraction)
}

collect.df.samples(crdOrig, a.10th.of.all.rows)
collect.df.samples(crdOrig, every.10th.rows)