Сложите вложенные списки фреймов данных с purrr

Question

У меня есть список списков фреймов данных, что-то вроде этого:

Я только что отредактировал, чтобы изменить данные так, чтобы длина списка и вложенного списка не были равны.

test <- list(list(cars1 = head(mtcars), iris1 = head(iris)),
             list(cars2 = tail(mtcars), iris2 = tail(iris)),
             list(cars3 = tail(mtcars), iris3 = tail(iris)))

Это дает мне то, что я хочу, со смесью lapply() и purrr.

lapply(1:2, function(x) purrr::map_dfr(test, ~ .[[x]]))

Есть ли способ сделать это более эффективно в одной строке только в purrr? Это кажется довольно распространенной задачей.

Answer 1

Вот вариант с purrr

library(dplyr)
library(stringr)
library(purrr)
test %>%
   flatten %>%
   split(str_remove(names(.), '\\d+')) %>%
   map(bind_rows)
#$cars
#    mpg cyl  disp  hp drat    wt  qsec vs am gear carb
#1  21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
#2  21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
#3  22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
#4  21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
#5  18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
#6  18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
#7  26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
#8  30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
#9  15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
#10 19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
#11 15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
#12 21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
#13 26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
#14 30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
#15 15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
#16 19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
#17 15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
#18 21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2

#$iris
#   Sepal.Length Sepal.Width Petal.Length Petal.Width   Species
#1           5.1         3.5          1.4         0.2    setosa
#2           4.9         3.0          1.4         0.2    setosa
#3           4.7         3.2          1.3         0.2    setosa
#4           4.6         3.1          1.5         0.2    setosa
#5           5.0         3.6          1.4         0.2    setosa
#6           5.4         3.9          1.7         0.4    setosa
#7           6.7         3.3          5.7         2.5 virginica
#8           6.7         3.0          5.2         2.3 virginica
#9           6.3         2.5          5.0         1.9 virginica
#10          6.5         3.0          5.2         2.0 virginica
#11          6.2         3.4          5.4         2.3 virginica
#12          5.9         3.0          5.1         1.8 virginica
#13          6.7         3.3          5.7         2.5 virginica
#14          6.7         3.0          5.2         2.3 virginica
#15          6.3         2.5          5.0         1.9 virginica
#16          6.5         3.0          5.2         2.0 virginica
#17          6.2         3.4          5.4         2.3 virginica
#18          5.9         3.0          5.1         1.8 virginica

---

Или другой вариант

map_dfr(test, enframe) %>%
     group_split(name = str_remove(name, "\\d+")) %>%
     map( ~ unnest(.x, value))

Answer 2

Вы можете попробовать решение с базовым R.

sapply(seq(el(lengths(test))), function(x) do.call(rbind, lapply(test, `[[`, x)))
# [[1]]
# mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# Mazda RX4         21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
# Mazda RX4 Wag     21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
# Datsun 710        22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
# Hornet 4 Drive    21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
# Hornet Sportabout 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
# Valiant           18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
# Porsche 914-2     26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
# Lotus Europa      30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
# Ford Pantera L    15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
# Ferrari Dino      19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
# Maserati Bora     15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
# Volvo 142E        21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
# Porsche 914-21    26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
# Lotus Europa1     30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
# Ford Pantera L1   15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
# Ferrari Dino1     19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
# Maserati Bora1    15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
# Volvo 142E1       21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
# 
# [[2]]
# Sepal.Length Sepal.Width Petal.Length Petal.Width   Species
# 1             5.1         3.5          1.4         0.2    setosa
# 2             4.9         3.0          1.4         0.2    setosa
# 3             4.7         3.2          1.3         0.2    setosa
# 4             4.6         3.1          1.5         0.2    setosa
# 5             5.0         3.6          1.4         0.2    setosa
# 6             5.4         3.9          1.7         0.4    setosa
# 145           6.7         3.3          5.7         2.5 virginica
# 146           6.7         3.0          5.2         2.3 virginica
# 147           6.3         2.5          5.0         1.9 virginica
# 148           6.5         3.0          5.2         2.0 virginica
# 149           6.2         3.4          5.4         2.3 virginica
# 150           5.9         3.0          5.1         1.8 virginica
# 1451          6.7         3.3          5.7         2.5 virginica
# 1461          6.7         3.0          5.2         2.3 virginica
# 1471          6.3         2.5          5.0         1.9 virginica
# 1481          6.5         3.0          5.2         2.0 virginica
# 1491          6.2         3.4          5.4         2.3 virginica
# 1501          5.9         3.0          5.1         1.8 virginica

Хотя это медленно. Что касается производительности, то стоит взглянуть на data.table.

sapply(seq(el(lengths(test))), function(x) data.table::rbindlist(lapply(test, `[[`, x)))

Или --- немного неловко, но быстро:

Map(function(x) 
  data.table::rbindlist(unlist(test, recursive=F)[x]), list(c(1, 3, 5), c(1, 3, 5) + 1))

И вот идет микробенчмарк:

library(dplyr)
library(stringr)
library(purrr)
microbenchmark::microbenchmark(
  OP=lapply(seq(el(lengths(test))), function(x) purrr::map_dfr(test, ~ .[[x]])),
  sapply=sapply(seq(el(lengths(test))), function(x) 
    do.call(rbind, lapply(test, `[[`, x))),
  stringr=test %>%
    flatten %>%
    split(str_remove(names(.), '\\d+')) %>%
    map(bind_rows),
  unlistDT=Map(function(x) do.call(rbind, unlist(test, recursive=F)[x]), list(c(1, 3, 5), c(1, 3, 5) + 1)),
  sapplyDT=sapply(seq(el(lengths(test))), function(x) 
    data.table::rbindlist(lapply(test, `[[`, x))),
  MapUnlistDT=Map(function(x) data.table::rbindlist(unlist(test, recursive=F)[x]), list(c(1, 3, 5), c(1, 3, 5) + 1))
)
# Unit: microseconds
#                expr      min        lq      mean    median        uq      max neval  cld
# OP          504.664  522.6505  557.3472  530.6880  542.0415 2328.392   100  b  
# sapply     1003.970 1022.8495 1083.9883 1038.2850 1061.5030 3638.017   100    d
# stringr     740.156  788.6325  812.7278  805.7265  824.3520 1164.452   100   c 
# unlistDT    997.591 1015.1950 1069.0347 1031.2690 1042.7505 3659.193   100    d
# sapplyDT    319.178  334.4860  455.9246  348.7740  361.4040 8678.784   100 ab  
# MapUnlistDT 285.244  305.5285  347.5572  321.0920  331.8080 2772.333   100 a   

Answer 3

Это решение предполагает как минимум две вещи. Но оба предположения хороши, учитывая мое первоначальное использование.

1. все элементы подсписка названы одинаково
2. список имеет только два уровня

Вы можете перевернуть список наизнанку с transpose() и затем map() для связывания строк.

library(purrr)

test <- list(list(cars = head(mtcars), iris = head(iris)),
             list(cars = tail(mtcars), iris = tail(iris)),
             list(cars = tail(mtcars), iris = tail(iris)))

map(transpose(test), bind_rows)