![](/img/trans.png)
[英]Accessing grouping variables in purrr::map() with nested dataframes
[英]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
該解決方案至少假設兩件事。 但是考慮到我最初的用途,這兩個假設都很好。
您可以使用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.