Question

我有列表，其中包含data.frames，我希望 只选择几行 < / strong>即可。我可以在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))) )

但是如果列表包含多个列表，则会尝试将结果（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

我会把整个事情搞得一团糟，然后在干净的清单上工作。

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
...

Answer 2

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

Answer 3

以下是从这里提到的自定义“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 4

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

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，则会添加唯一标识符来对其进行索引。如果它是一个列表，那么它会在列表的每个元素上调用它自己（递增一个深度计数器，如果这很有用，也可以添加一个'group'计数器），然后对这些元素进行行绑定。我使用内部函数，以便我可以使用变量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 5

考虑一个递归调用，有条件地检查第一项是 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)

从嵌套列表中高效采样

5 个答案: