Подготовка и реализация flatten
Ну, есть много других ответов, которые в принципе совпадают.
Я тем временем реализовал для забавы уплощениевложенные списки.
Так как я думаю на Лиспе:
Реализованы сначала car и cdr из lisp.
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)