Каков базовый эквивалент rlang::flatten() ?

ProgramBox

Каков базовый эквивалент rlang::flatten() ?

Post author:admin
Запись опубликована:16 марта, 2023
Post category:Вопросы по программированию

#r #rlang

Вопрос:

Допустим, у меня есть вложенный список

 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) я почти добрался туда, но не совсем.

Ответ №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

^{Создано 2020-10-03 пакетом reprex (версия 0.3.0)}

Ниже я определил вашу функцию как flatten2 .

Вот несколько крайних случаев, о которых стоит подумать:

входные данные имеют list глубину 1, за одним исключением
, это flatten2 путаница в упорядочении.
ввод list — это значение глубины 1
unlist , которое возвращает вектор, тогда как две flatten функции возвращают список как есть. Здесь нам понадобится какая-то проверка, чтобы предотвратить unlist работу со списками глубиной 1.
ввод простой data.frame .
Здесь все три функции возвращают разное значение: flatten возвращает каждую ячейку как элемент единицы (long) list . flatten2 возвращает data.frame as 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" ...

^{Создано 2020-10-03 пакетом reprex (версия 0.3.0)}

Обновить

После учета крайних случаев, приведенных выше, мы могли бы определить unlist_once с помощью базовой R-версии vec_depth here called 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

^{Создано 2020-10-03 пакетом reprex (версия 0.3.0)}

1. Не работает, потому что data.frame становится сплющенным.

2. Пожалуйста, ознакомьтесь с моим обновлением с некоторыми крайними случаями, которые необходимо разрешить (не только для unlist , но и для базового R flatten ).

3. unlist_once теперь учитывает большинство упомянутых граничных случаев.

4. Может потребоваться рассмотреть, например, формулы?

5. Похоже purrr::flatten , что это не работает с формулами или списками, содержащими формулы на первом уровне.