从嵌套列表中进行有效抽样

Question

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

但如果我有更深的嵌套列表，它就不再起作用了。我也确信，没有循环有更好的方法。

什么是从嵌套列表中采样的有效且通用的方法，它们的维度不同并包含 data.frames 或矩阵？

## 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)))
)

但如果一个列表包含多个列表，则尝试将结果 (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 思考：

首先从 lisp 实现 car 和 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 所必需的（用于数据框列表）

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）。这些采样数据帧在列表中是rbinded。返回结果数据帧。它由每个数据帧的采样行组成。

示例测试

## 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]

并在collect.df.samples 中输入df.sampler.fun =。然后，该函数将应用于嵌套的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)

Answer 2

考虑一个递归调用，有条件地检查第一项是 data.frame 还是 list 类。

stack_process <- function(lst){
  if(class(lst[[1]]) == "data.frame") {
    tmp <- lst[[1]]
  } 

  if(class(lst[[1]]) == "list") {
    inner <- lapply(lst, stack_process)        
    tmp <- do.call(rbind, inner)
  }

  return(tmp)
}

new_crdOrig <- lapply(crdOrig, function(x) {
  df <- stack_process(x)

  filterInd <- seq(1, nrow(df), by = filterBy)
  return(df[filterInd,])
})

final_df <- do.call(rbind, new_crdOrig)

Answer 3

我也会将列表列表展平为标准表示（并对展平的表示进行所有分析，而不仅仅是子集），但跟踪相关的索引信息，例如，

flatten_recursive = function(x) {
    i <- 0L
    .f = function(x, depth) {
        if (is.data.frame(x)) {
            i <<- i + 1L
            cbind(i, depth, x)
        } else {
            x = lapply(x, .f, depth + 1L)
            do.call(rbind, x)
        }
    }
    .f(x, 0L)
}

内部函数.f() 访问列表的每个元素。如果元素是 data.frame，它会添加一个唯一标识符来索引它。如果它是一个列表，那么它会在列表的每个元素上调用自身（增加一个深度计数器，如果这很有用，还可以添加一个“组”计数器），然后对元素进行行绑定。我使用一个内部函数，这样我就可以有一个变量i 在函数调用之间递增。最终结果是带有索引的单个数据框，用于引用原始结果。

> tbl <- flatten_recursive(crdOrig) %>% as_tibble()
> tbl %>% group_by(i, depth) %>% summarize(n())
# A tibble: 4 x 3
# Groups:   i [?]
      i depth `n()`
  <int> <int> <int>
1     1     3   100
2     2     3   100
3     3     2   300
4     4     2   100
> tbl %>% group_by(i) %>% slice(seq(1, n(), by = 10)) %>% summarize(n())
# A tibble: 4 x 2
      i `n()`
  <int> <int>
1     1    10
2     2    10
3     3    30
4     4    10

.f() 的整体模式可以针对其他数据类型进行调整，例如（省略一些细节）

.f <- function(x) {
    if (is.data.frame(x)) {
        x
    } else if (is.matrix(x)) {
        x <- as.data.frame(x)
        setNames(x, c("x", "y"))
    } else {
        do.call(rbind, lapply(x, .f))
    }
}

Answer 4

这是从此处提到的自定义“rapply”函数中借用的基本答案rapply to nested list of data frames in R

df_samples<-list()
i=1

f<-function(x) {
  i<<-i+1
  df_samples[[i]]<<-x[sample(rownames(x),10),]
}

recurse <- function (L, f) {
  if (inherits(L, "data.frame")) {
  f(L)  }
  else lapply(L, recurse, f)
}

recurse(crdOrig, f)

res<-do.call("rbind", df_samples)

Answer 5

我只会把整个该死的事情弄平，然后在一个干净的清单上工作。

library(rlist)
out <- list.flatten(y)

# prepare a vector for which columns belong together
vc <- rep(1:(length(out)/2), each = 2)
vc <- split(1:length(vc), vc)

# prepare the final list
ll <- vector("list", length(unique(vc)))
for (i in 1:length(vc)) {
  ll[[i]] <- as.data.frame(out[vc[[i]]])
}

result <- lapply(ll, FUN = function(x) {
  x[sample(1:nrow(x), size = 10, replace = FALSE), ]
})

do.call(rbind, result)

           x        y
98  10.32912 52.87113
52  16.42912 46.07026
92  18.85397 46.26403
90  12.04884 57.79290
23  18.20997 40.57904
27  18.98340 52.55919
...