簡體   English   中英

使用 purrr 堆疊嵌套的數據幀列表

[英]Stack nested lists of dataframes with purrr

我有一個數據框列表列表,如下所示:

我剛剛編輯更改數據,使列表和嵌套列表的長度不相等。

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中的一行中更有效地做到這purrr 這似乎是一項相當普遍的任務。

這是一個帶有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))

您可以嘗試使用基本的 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   

該解決方案至少假設兩件事。 但是考慮到我最初的用途,這兩個假設都很好。

  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)

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM