R - Как удалить из списка и объединить

Question

Используя lapply, я ввел вектор входных данных в функцию, которая для каждого входа возвращает список из двух векторов - возможных n-грамм и их вероятностей.Я получаю список списков (смеется) с такой структурой:

> str(lol)
List of 3
 $ :List of 2
  ..$ np1  : chr [1:7] "a" "years" "the" "my" ...
  ..$ probs: num [1:7] 0.1481 0.1357 0.0841 0.0698 0.0522 ...
 $ :List of 2
  ..$ np1  : chr [1:167] "the" "a" "my" "years" ...
  ..$ probs: num [1:167] 0.2745 0.0924 0.0605 0.0437 0.0334 ...
 $ :List of 2
  ..$ np1  : chr [1:9493] "the" "a" "my" "this" ...
  ..$ probs: num [1:9493] 0.267 0.0777 0.0239 0.0169 0.0158 ...

Но я стремлюсь к единственному списку, в котором все векторы $np1 объединены и все $probs векторыкак хорошо.Я попытался использовать unlist(..., recursive = F), чтобы получить список из двух векторов, и это приблизило меня к тому, что я ищу, чем использование unlist без рекурсивного флага.

> str(unlist(lapply(inputs.list, function(x){...}), recursive = F))
List of 6
 $ np1  : chr [1:7] "a" "years" "the" "my" ...
 $ probs: num [1:7] 0.1481 0.1357 0.0841 0.0698 0.0522 ...
 $ np1  : chr [1:167] "the" "a" "my" "years" ...
 $ probs: num [1:167] 0.2745 0.0924 0.0605 0.0437 0.0334 ...
 $ np1  : chr [1:9493] "the" "a" "my" "this" ...
 $ probs: num [1:9493] 0.267 0.0777 0.0239 0.0169 0.0158 ...

Но не совсем там ...

Есть ли способ, который поможет мне еще больше объединить сведенный список в список только из двух векторов, как описано?

Вот воспроизводимый пример для работы:

example1 <- list("time in"=list(np1=c("the", "a", "my", "years"), probs=c(0.2745, 0.0924, 0.0605, 0.0437)),"in"=list(np1=c("the", "a", "my", "this"), probs=c(0.267, 0.0777, 0.0239, 0.0169)))
> str(example1)
List of 2
 $ time in:List of 2
  ..$ np1  : chr [1:4] "the" "a" "my" "years"
  ..$ probs: num [1:4] 0.2745 0.0924 0.0605 0.0437
 $ in     :List of 2
  ..$ np1  : chr [1:4] "the" "a" "my" "this"
  ..$ probs: num [1:4] 0.267 0.0777 0.0239 0.0169

Answer 1

Два списка могут быть объединены по вашему желанию с Map, как в

Map(c, example1[[1]], example1[[2]])
# $np1
# [1] "the"   "a"     "my"    "years" "the"   "a"     "my"    "this" 
#
# $probs
# [1] 0.2745 0.0924 0.0605 0.0437 0.2670 0.0777 0.0239 0.0169

Итак, чтобы объединить весь список списков, мы можем сделать

Reduce(function(...) Map(c, ...), example1[c(1, 1, 2)])
# $np1
#  [1] "the"   "a"     "my"    "years" "the"   "a"     "my"    "years" "the"   "a"     "my"    "this" 
#
# $probs
#  [1] 0.2745 0.0924 0.0605 0.0437 0.2745 0.0924 0.0605 0.0437 0.2670 0.0777 0.0239 0.0169

, где я специально сделал ввод длины 3, чтобы продемонстрировать функциональность. В вашем случае нам нужно

Reduce(function(...) Map(c, ...), lol)

Answer 2

Вот решение с использованием purrr:

library(tidyverse)

transpose(example1) %>% map(flatten) %>% map(unlist)

Выход:

$np1
[1] "the"   "a"     "my"    "years" "the"   "a"     "my"    "this" 

$probs
[1] 0.2745 0.0924 0.0605 0.0437 0.2670 0.0777 0.0239 0.0169

Answer 3

Вот решение "unlist", которое похоже на то, над чем вы работали.Он зависит от векторов, которые вас интересуют, всегда чередуясь (например, это всегда nth, а затем probs. Удачи и дайте мне знать, если это не работает для вас!

unlist_ed <- unlist(example1, recursive = F)

list(
  np1 = unlist(unlist_ed[c(T, F)]),
  probs = unlist(unlist_ed[c(F, T)])
)

$np1
time in.np11 time in.np12 time in.np13 time in.np14      in.np11      in.np12      in.np13      in.np14 
       "the"          "a"         "my"      "years"        "the"          "a"         "my"       "this" 

$probs
time in.probs1 time in.probs2 time in.probs3 time in.probs4      in.probs1      in.probs2      in.probs3 
        0.2745         0.0924         0.0605         0.0437         0.2670         0.0777         0.0239 
     in.probs4 
        0.0169 

РЕДАКТИРОВАТЬ: Я подумал о другом решении, которое опирается на одинаковые имена векторов, но это гораздо быстрее (не в этом цель). Хотел обновить!

dplyr::bind_rows(example1)
# A tibble: 8 x 2
  np1    probs
  <chr>  <dbl>
1 the   0.274 
2 a     0.0924
3 my    0.0605
4 years 0.0437
5 the   0.267 
6 a     0.0777
7 my    0.0239
8 this  0.0169

Не идеальный тест:

example1 <- rapply(example1, function(x) rep(x, 1e4), how = "list")
example1 <- rep(example1, 100)

microbenchmark::microbenchmark(

o1 = {
    Reduce(function(...) Map(c, ...), example1)
  },
  o2 = {
    unlist_ed <- unlist(example1, recursive = F)

    list(
      nth = unlist(unlist_ed[c(T, F)]),
      probs = unlist(unlist_ed[c(F, T)])
    )
  },
  o3 = {
    transpose(example1) %>% map(flatten) %>% map(unlist)
  },
  o4 = {
    binded <- dplyr::bind_rows(example1)

    list(binded$np1,
         binded$probs)
  },
  times = 1

)

Unit: milliseconds
 expr        min         lq       mean     median         uq        max neval
   o1 5022.25495 5022.25495 5022.25495 5022.25495 5022.25495 5022.25495     1
   o2 5146.75265 5146.75265 5146.75265 5146.75265 5146.75265 5146.75265     1
   o3 2491.21422 2491.21422 2491.21422 2491.21422 2491.21422 2491.21422     1
   o4   83.32919   83.32919   83.32919   83.32919   83.32919   83.32919     1