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正在混淆顺序。
输入是深度为1的list。
此处unlist返回一个向量，而两个flatten函数则按原样返回列表。我们需要在此处进行某种检查，以防止unlist处理深度为1的列表。
输入是简单的data.frame。
这三个函数都返回不同的值：flatten返回每个单元格作为一个（长）list的元素。 flatten2以data.frame的形式返回list，每一列都是一个列表元素，而unlist返回一个vector。

最后，这取决于您要模仿flatten的行为的程度以及更容易适应flatten2或unlist(recursive = FALSE)的情况。

library(purrr)

flatten2 <- function(lst) {
  nested <- vapply(lst,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创建}

更新

在考虑了上述极端情况之后，我们可以借助unlist_once的基本R版本vec_depth来定义check_depth。列表元素的命名仍然略有不同。

library(purrr)

tmp <- list(
  a = 1,])
)

tmp2 <- list(a = 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创建}

r r rlang