rlang::flatten() 的基本等价物是什么？

【问题标题】：What is the base equivalent of rlang::flatten()?rlang::flatten() 的基本等价物是什么？
【发布时间】：2020-09-27 13:48:30
【问题描述】：

假设我有一个嵌套列表

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) 几乎可以让我到达那里，但并不完全。

【问题讨论】：

  • 只是好奇，我们可以期待一个 {poorman} 版本的 {purrr} 还是你需要它作为辅助函数？

标签： r rlang


【解决方案1】：

这个函数似乎可以满足我的需要

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)
}

【讨论】：

    【解决方案2】：

    不确定它是否适用于所有情况，但更简单的方法是使用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 月 3 日创建

    下面我将你的函数定义为flatten2。

    以下是一些需要考虑的极端情况：

    1. 输入是深度为 1 的 list，但有一个例外
      这里 flatten2 混淆了排序。
    2. 输入是深度为 1 的 list
      这里 unlist 返回一个向量，而两个 flatten 函数按原样返回列表。我们需要在这里进行某种检查，以防止 unlist 处理深度为 1 的列表。
    3. 输入是一个简单的data.frame。
      这里所有三个函数都返回不同的值：flatten 将每个单元格作为一个（长）list 的元素返回。 flatten2 将data.frame 返回为list，每一列是一个列表元素，unlist 返回一个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 月 3 日创建

    更新

    在考虑了上面的边缘情况之后，我们可以在 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 月 3 日创建

    【讨论】：

    • 不起作用，因为 data.frame 被展平了。
    • 请查看我的更新，其中包含一些需要解决的边缘情况（不仅适用于unlist，还适用于基础 R flatten）。
    • unlist_once 现在解决了大部分提到的边缘情况。
    • 可能需要考虑，例如，公式？
    • 似乎purrr::flatten 不适用于包含一级公式的公式或列表。
    猜你喜欢
    • 2014-05-08
    • 2014-06-12
    • 1970-01-01
    • 2022-11-28
    • 1970-01-01
    • 2018-07-10
    • 2023-04-10
    • 2011-01-19
    • 2010-12-07
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode