rlang::flatten() 的基本等价物是什么？
What is the base equivalent of rlang::flatten()?
假设我有一个嵌套列表
tmp <- list(
a = 1,
list(list(x = 1, y = "a"), list(z = 2)),
mtcars[1:3, ],
list(mtcars[4:6, ], mtcars[7:10, ])
)
我想复制 rlang::flatten() 所做的事情。
> rlang::flatten(tmp)
$a
[1] 1
[[2]]
[[2]]$x
[1] 1
[[2]]$y
[1] "a"
[[3]]
[[3]]$z
[1] 2
[[4]]
mpg cyl disp hp drat wt qsec vs am gear carb
Mazda RX4 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
Mazda RX4 Wag 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
Datsun 710 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
[[5]]
mpg cyl disp hp drat wt qsec vs am gear carb
Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
Valiant 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1
[[6]]
mpg cyl disp hp drat wt qsec vs am gear carb
Duster 360 14.3 8 360.0 245 3.21 3.57 15.84 0 0 3 4
Merc 240D 24.4 4 146.7 62 3.69 3.19 20.00 1 0 4 2
Merc 230 22.8 4 140.8 95 3.92 3.15 22.90 1 0 4 2
Merc 280 19.2 6 167.6 123 3.92 3.44 18.30 1 0 4 4
即我想把一切都提升一个层次。 Reduce(c, tmp) 几乎让我到达那里，但不完全是。
看起来这个函数可以满足我的需要
flatten <- function(lst) {
nested <- vapply(lst, function(x) inherits(x[1L], "list"), FALSE)
res <- c(lst[!nested], unlist(lst[nested], recursive = FALSE))
if (sum(nested)) Recall(res) else return(res)
}
不确定它是否适用于所有情况，但更简单的方法是使用 unlist(tmp, recursive = FALSE).
library(purrr)
tmp <- list(
a = 1,
list(list(x = 1, y = "a"), list(z = 2)),
mtcars[1:3, ],
list(mtcars[4:6, ], mtcars[7:10, ])
)
unlist(tmp, recursive = FALSE)
#> $a
#> [1] 1
#>
#> [[2]]
#> [[2]]$x
#> [1] 1
#>
#> [[2]]$y
#> [1] "a"
#>
#>
#> [[3]]
#> [[3]]$z
#> [1] 2
#>
#>
#> $mpg
#> [1] 21.0 21.0 22.8
#>
#> $cyl
#> [1] 6 6 4
#>
#> $disp
#> [1] 160 160 108
#>
#> $hp
#> [1] 110 110 93
#>
#> $drat
#> [1] 3.90 3.90 3.85
#>
#> $wt
#> [1] 2.620 2.875 2.320
#>
#> $qsec
#> [1] 16.46 17.02 18.61
#>
#> $vs
#> [1] 0 0 1
#>
#> $am
#> [1] 1 1 1
#>
#> $gear
#> [1] 4 4 4
#>
#> $carb
#> [1] 4 4 1
#>
#> [[15]]
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
#> Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
#> Valiant 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1
#>
#> [[16]]
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> Duster 360 14.3 8 360.0 245 3.21 3.57 15.84 0 0 3 4
#> Merc 240D 24.4 4 146.7 62 3.69 3.19 20.00 1 0 4 2
#> Merc 230 22.8 4 140.8 95 3.92 3.15 22.90 1 0 4 2
#> Merc 280 19.2 6 167.6 123 3.92 3.44 18.30 1 0 4 4
identical(unlist(tmp, recursive = FALSE),
flatten(tmp))
#> [1] TRUE
由 reprex package (v0.3.0)
于 2020-10-03 创建
下面我将你的函数定义为flatten2。
这里有一些需要考虑的极端情况：
- 输入是深度为 1 的
list，只有一个例外
这里 flatten2 混淆了顺序。
- 输入是一个
list深度1
这里unlistreturn是一个向量，而两个flatten函数return按原样列出。我们需要在这里进行某种检查以防止 unlist 在深度为 1 的列表上工作。
- 输入是一个简单的
data.frame.
这里所有三个函数return一个不同的值：flattenreturns每个单元格作为元素一（长）list。 flatten2 return 将 data.frame 作为 list，每列是一个列表元素，unlist return 是一个 vector.
最终取决于你想模仿flatten行为的程度，以及flatten2或unlist(recursive = FALSE).
更容易适应的行为
library(purrr)
flatten2 <- function(lst) {
nested <- vapply(lst, function(x) inherits(x[1L], "list"), FALSE)
res <- c(lst[!nested], unlist(lst[nested], recursive = FALSE))
if (sum(nested)) Recall(res) else return(res)
}
tmp2 <- list(a = 1, b = list(y = 10, x = 20), c = 3)
tmp3 <- list(a = 1, b = 1, c = 3)
tmp2 %>% flatten %>% str
#> List of 4
#> $ a: num 1
#> $ y: num 10
#> $ x: num 20
#> $ c: num 3
tmp2 %>% flatten2 %>% str
#> List of 4
#> $ a : num 1
#> $ c : num 3
#> $ b.y: num 10
#> $ b.x: num 20
tmp2 %>% unlist(recursive = FALSE) %>% str
#> List of 4
#> $ a : num 1
#> $ b.y: num 10
#> $ b.x: num 20
#> $ c : num 3
tmp3 %>% flatten %>% str
#> List of 3
#> $ a: num 1
#> $ b: num 1
#> $ c: num 3
tmp3 %>% flatten2 %>% str
#> List of 3
#> $ a: num 1
#> $ b: num 1
#> $ c: num 3
tmp3 %>% unlist(recursive = FALSE) %>% str
#> Named num [1:3] 1 1 3
#> - attr(*, "names")= chr [1:3] "a" "b" "c"
mtcars %>% head(2) %>% flatten %>% str
#> List of 22
#> $ : num 21
#> $ : num 21
#> $ : num 6
#> $ : num 6
#> $ : num 160
#> $ : num 160
#> $ : num 110
#> $ : num 110
#> $ : num 3.9
#> $ : num 3.9
#> $ : num 2.62
#> $ : num 2.88
#> $ : num 16.5
#> $ : num 17
#> $ : num 0
#> $ : num 0
#> $ : num 1
#> $ : num 1
#> $ : num 4
#> $ : num 4
#> $ : num 4
#> $ : num 4
mtcars %>% head(2) %>% flatten2 %>% str
#> List of 11
#> $ mpg : num [1:2] 21 21
#> $ cyl : num [1:2] 6 6
#> $ disp: num [1:2] 160 160
#> $ hp : num [1:2] 110 110
#> $ drat: num [1:2] 3.9 3.9
#> $ wt : num [1:2] 2.62 2.88
#> $ qsec: num [1:2] 16.5 17
#> $ vs : num [1:2] 0 0
#> $ am : num [1:2] 1 1
#> $ gear: num [1:2] 4 4
#> $ carb: num [1:2] 4 4
mtcars %>% head(2) %>% unlist(recursive = FALSE) %>% str
#> Named num [1:22] 21 21 6 6 160 160 110 110 3.9 3.9 ...
#> - attr(*, "names")= chr [1:22] "mpg1" "mpg2" "cyl1" "cyl2" ...
由 reprex package (v0.3.0)
于 2020-10-03 创建
更新
考虑到上述边缘情况后，我们可以借助 vec_depth 的基础 R 版本定义 unlist_once，此处称为 check_depth。列表元素的命名仍然略有不同。
library(purrr)
tmp <- list(
a = 1,
list(list(x = 1, y = "a"), list(z = 2)),
mtcars[1:3, ],
list(mtcars[4:6, ], mtcars[7:10, ])
)
tmp2 <- list(a = 1, b = list(y = 10, x = 20), c = 3)
tmp3 <- list(a = 1, b = 1, c = 3)
tmp4 <- head(mtcars, 2)
check_depth <- function (x)
{
if (is_null(x)) {
0L
}
else if (is.atomic(x)) {
1L
}
else if (is.list(x)) {
depths <- as.integer(unlist(lapply(x, check_depth)))
1L + max(depths, 0L)
}
else {
stop("`x` must be a vector")
}
}
unlist_once <- function(x) {
if (is.data.frame(x)) {
return(lapply(unname(unlist(x)), function(x) c(x)))
} else if (check_depth(x) <= 2L) {
return(x)
} else {
unlist(x, recursive = FALSE)
}
}
identical(flatten(tmp), unlist_once(tmp))
#> [1] TRUE
# in the case of tmp2 the list names are slightly different
identical(flatten(tmp2), unlist_once(tmp2))
#> [1] FALSE
identical(flatten(tmp3), unlist_once(tmp3))
#> [1] TRUE
identical(flatten(tmp4), unlist_once(tmp4))
#> [1] TRUE
由 reprex package (v0.3.0)
于 2020-10-03 创建
假设我有一个嵌套列表
tmp <- list(
a = 1,
list(list(x = 1, y = "a"), list(z = 2)),
mtcars[1:3, ],
list(mtcars[4:6, ], mtcars[7:10, ])
)
我想复制 rlang::flatten() 所做的事情。
> rlang::flatten(tmp)
$a
[1] 1
[[2]]
[[2]]$x
[1] 1
[[2]]$y
[1] "a"
[[3]]
[[3]]$z
[1] 2
[[4]]
mpg cyl disp hp drat wt qsec vs am gear carb
Mazda RX4 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
Mazda RX4 Wag 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
Datsun 710 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
[[5]]
mpg cyl disp hp drat wt qsec vs am gear carb
Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
Valiant 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1
[[6]]
mpg cyl disp hp drat wt qsec vs am gear carb
Duster 360 14.3 8 360.0 245 3.21 3.57 15.84 0 0 3 4
Merc 240D 24.4 4 146.7 62 3.69 3.19 20.00 1 0 4 2
Merc 230 22.8 4 140.8 95 3.92 3.15 22.90 1 0 4 2
Merc 280 19.2 6 167.6 123 3.92 3.44 18.30 1 0 4 4
即我想把一切都提升一个层次。 Reduce(c, tmp) 几乎让我到达那里，但不完全是。
看起来这个函数可以满足我的需要
flatten <- function(lst) {
nested <- vapply(lst, function(x) inherits(x[1L], "list"), FALSE)
res <- c(lst[!nested], unlist(lst[nested], recursive = FALSE))
if (sum(nested)) Recall(res) else return(res)
}
不确定它是否适用于所有情况，但更简单的方法是使用 unlist(tmp, recursive = FALSE).
library(purrr)
tmp <- list(
a = 1,
list(list(x = 1, y = "a"), list(z = 2)),
mtcars[1:3, ],
list(mtcars[4:6, ], mtcars[7:10, ])
)
unlist(tmp, recursive = FALSE)
#> $a
#> [1] 1
#>
#> [[2]]
#> [[2]]$x
#> [1] 1
#>
#> [[2]]$y
#> [1] "a"
#>
#>
#> [[3]]
#> [[3]]$z
#> [1] 2
#>
#>
#> $mpg
#> [1] 21.0 21.0 22.8
#>
#> $cyl
#> [1] 6 6 4
#>
#> $disp
#> [1] 160 160 108
#>
#> $hp
#> [1] 110 110 93
#>
#> $drat
#> [1] 3.90 3.90 3.85
#>
#> $wt
#> [1] 2.620 2.875 2.320
#>
#> $qsec
#> [1] 16.46 17.02 18.61
#>
#> $vs
#> [1] 0 0 1
#>
#> $am
#> [1] 1 1 1
#>
#> $gear
#> [1] 4 4 4
#>
#> $carb
#> [1] 4 4 1
#>
#> [[15]]
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
#> Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
#> Valiant 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1
#>
#> [[16]]
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> Duster 360 14.3 8 360.0 245 3.21 3.57 15.84 0 0 3 4
#> Merc 240D 24.4 4 146.7 62 3.69 3.19 20.00 1 0 4 2
#> Merc 230 22.8 4 140.8 95 3.92 3.15 22.90 1 0 4 2
#> Merc 280 19.2 6 167.6 123 3.92 3.44 18.30 1 0 4 4
identical(unlist(tmp, recursive = FALSE),
flatten(tmp))
#> [1] TRUE
由 reprex package (v0.3.0)
于 2020-10-03 创建下面我将你的函数定义为flatten2。
这里有一些需要考虑的极端情况：
- 输入是深度为 1 的
list，只有一个例外
这里flatten2混淆了顺序。 - 输入是一个
list深度1
这里unlistreturn是一个向量，而两个flatten函数return按原样列出。我们需要在这里进行某种检查以防止unlist在深度为 1 的列表上工作。 - 输入是一个简单的
data.frame.
这里所有三个函数return一个不同的值：flattenreturns每个单元格作为元素一（长）list。flatten2return 将data.frame作为list，每列是一个列表元素，unlistreturn 是一个vector.
最终取决于你想模仿flatten行为的程度，以及flatten2或unlist(recursive = FALSE).
library(purrr)
flatten2 <- function(lst) {
nested <- vapply(lst, function(x) inherits(x[1L], "list"), FALSE)
res <- c(lst[!nested], unlist(lst[nested], recursive = FALSE))
if (sum(nested)) Recall(res) else return(res)
}
tmp2 <- list(a = 1, b = list(y = 10, x = 20), c = 3)
tmp3 <- list(a = 1, b = 1, c = 3)
tmp2 %>% flatten %>% str
#> List of 4
#> $ a: num 1
#> $ y: num 10
#> $ x: num 20
#> $ c: num 3
tmp2 %>% flatten2 %>% str
#> List of 4
#> $ a : num 1
#> $ c : num 3
#> $ b.y: num 10
#> $ b.x: num 20
tmp2 %>% unlist(recursive = FALSE) %>% str
#> List of 4
#> $ a : num 1
#> $ b.y: num 10
#> $ b.x: num 20
#> $ c : num 3
tmp3 %>% flatten %>% str
#> List of 3
#> $ a: num 1
#> $ b: num 1
#> $ c: num 3
tmp3 %>% flatten2 %>% str
#> List of 3
#> $ a: num 1
#> $ b: num 1
#> $ c: num 3
tmp3 %>% unlist(recursive = FALSE) %>% str
#> Named num [1:3] 1 1 3
#> - attr(*, "names")= chr [1:3] "a" "b" "c"
mtcars %>% head(2) %>% flatten %>% str
#> List of 22
#> $ : num 21
#> $ : num 21
#> $ : num 6
#> $ : num 6
#> $ : num 160
#> $ : num 160
#> $ : num 110
#> $ : num 110
#> $ : num 3.9
#> $ : num 3.9
#> $ : num 2.62
#> $ : num 2.88
#> $ : num 16.5
#> $ : num 17
#> $ : num 0
#> $ : num 0
#> $ : num 1
#> $ : num 1
#> $ : num 4
#> $ : num 4
#> $ : num 4
#> $ : num 4
mtcars %>% head(2) %>% flatten2 %>% str
#> List of 11
#> $ mpg : num [1:2] 21 21
#> $ cyl : num [1:2] 6 6
#> $ disp: num [1:2] 160 160
#> $ hp : num [1:2] 110 110
#> $ drat: num [1:2] 3.9 3.9
#> $ wt : num [1:2] 2.62 2.88
#> $ qsec: num [1:2] 16.5 17
#> $ vs : num [1:2] 0 0
#> $ am : num [1:2] 1 1
#> $ gear: num [1:2] 4 4
#> $ carb: num [1:2] 4 4
mtcars %>% head(2) %>% unlist(recursive = FALSE) %>% str
#> Named num [1:22] 21 21 6 6 160 160 110 110 3.9 3.9 ...
#> - attr(*, "names")= chr [1:22] "mpg1" "mpg2" "cyl1" "cyl2" ...
由 reprex package (v0.3.0)
于 2020-10-03 创建更新
考虑到上述边缘情况后，我们可以借助 vec_depth 的基础 R 版本定义 unlist_once，此处称为 check_depth。列表元素的命名仍然略有不同。
library(purrr)
tmp <- list(
a = 1,
list(list(x = 1, y = "a"), list(z = 2)),
mtcars[1:3, ],
list(mtcars[4:6, ], mtcars[7:10, ])
)
tmp2 <- list(a = 1, b = list(y = 10, x = 20), c = 3)
tmp3 <- list(a = 1, b = 1, c = 3)
tmp4 <- head(mtcars, 2)
check_depth <- function (x)
{
if (is_null(x)) {
0L
}
else if (is.atomic(x)) {
1L
}
else if (is.list(x)) {
depths <- as.integer(unlist(lapply(x, check_depth)))
1L + max(depths, 0L)
}
else {
stop("`x` must be a vector")
}
}
unlist_once <- function(x) {
if (is.data.frame(x)) {
return(lapply(unname(unlist(x)), function(x) c(x)))
} else if (check_depth(x) <= 2L) {
return(x)
} else {
unlist(x, recursive = FALSE)
}
}
identical(flatten(tmp), unlist_once(tmp))
#> [1] TRUE
# in the case of tmp2 the list names are slightly different
identical(flatten(tmp2), unlist_once(tmp2))
#> [1] FALSE
identical(flatten(tmp3), unlist_once(tmp3))
#> [1] TRUE
identical(flatten(tmp4), unlist_once(tmp4))
#> [1] TRUE
由 reprex package (v0.3.0)
于 2020-10-03 创建