Создайте аккуратную функцию многократного уменьшения

Я хотел бы заменить это (want) функцией:

library(tidyverse)
library(rlang)

set.seed(1)
create_a <- function() {
      list(x = 1:10, y = data.frame(aa = round(rnorm(10, 2000, 10), 0),
                                bb = sample(letters[3:8], 10, replace = T),
                                stringsAsFactors = F))
}

create_b <- function() {
  list(x = 1:10, y = data.frame(aa = round(rnorm(10, 10, 1), 0),
                                bb = sample(letters[3:8], 10, replace = T),
                                stringsAsFactors = F))
}  

want <- list(x = reduce(map(list(create_a(), create_b()), 1), c),
             y = reduce(map(list(create_a(), create_b()), 2), rbind)) # or bind_rows

Существует несколько функций (create_a и create_b), которые создают выходные списки с элементами с одинаковыми именами. В отличие от приведенных выше примеров расчеты в реальных функциях совсем другие. Функция должна выглядеть так:

multiple_reduce <- function(...) {
  # ????
}
want <- multiple_reduce(create_a(), 
                        create_b())

Как вы делаете это, используя аккуратный подход?

want должен выглядеть так в обоих случаях:

$x
 [1]  1  2  3  4  5  6  7  8  9 10  1  2  3  4  5  6  7  8  9 10

$y
     aa bb
1  2014  e
2  1999  g
3  2004  e
4  1999  d
5  1986  g
6  1996  d
7  1996  g
8  1999  c
9  2011  d
10 2008  c
11    9  h
12   10  g
13   11  e
14   10  e
15   11  c
16   10  c
17    9  g
18   10  c
19    9  e
20   11  f

r tidyverse purrr rlang
person r.user.05apr    schedule 07.06.2019    source источник
comment
Не могли бы вы предоставить текущий и ожидаемый результат? В настоящее время это проблема XY.   -  person NelsonGon    schedule 07.06.2019
comment
Вы хотите объединить их на основе одного имени? Или на основе того же типа?   -  person Ronak Shah    schedule 07.06.2019
comment
Я хотел бы объединить x (или позиции 1 в разных списках) с одним агрегированным x, а y с y. Порядок и имена списков результатов функций, которые я хочу агрегировать, одинаковы.   -  person r.user.05apr    schedule 07.06.2019
comment
Это близко: map2(create_a(),create_b(),function(x,y) rbind(x,y))?   -  person NelsonGon    schedule 07.06.2019
comment
Да, за исключением того, что векторы должны быть объединены (c). pmap(create_a(),create_b(), create_b(),function(...) rbind(...)) с другой стороны, похоже, не работает.   -  person r.user.05apr    schedule 07.06.2019
comment
Вы имеете в виду первый выход (x, верно?)   -  person NelsonGon    schedule 07.06.2019
comment
Да, функция агрегирования должна быть c для переменной x и bind_rows или rbind для y фреймов данных.   -  person r.user.05apr    schedule 07.06.2019
comment
Были проблемы с seed, поэтому, возможно, вы также могли бы попробовать: map2(create_a(),create_b(),function(x,y) rbind(x,y)) %>% modify_at("x",function(x) x[!duplicated(x)])   -  person NelsonGon    schedule 07.06.2019

Ответы (1)


arrow_upward
3
arrow_downward

Возможно, одним из способов было бы объединить все входные данные вместе и разделить их на основе их имен, чтобы у нас был список с похожими именами вместе. Затем мы можем проверить, имеют ли списки атомарный тип, и соответственно объединить их в один вектор или фрейм данных.

library(tidyverse)

multiple_reduce <- function(a, b, ...) {
   combine_list <- c(a, b, ...)
   new_list <- split(combine_list, names(combine_list))
   list(x = map(new_list, ~keep(., is.atomic)) %>% flatten %>% reduce(c),
        y = map(new_list, ~discard(., is.atomic)) %>% flatten %>% bind_rows)
}

multiple_reduce(create_a(), create_b())

#$x
# [1]  1  2  3  4  5  6  7  8  9 10  1  2  3  4  5  6  7  8  9 10

#$y
#     aa bb
#1  2001  g
#2  1998  h
#3  2003  g
#4  1971  h
#5  1998  h
#6  2001  f
#7  1993  d
#8  1990  c
#9  2009  d
#10 2019  d
#11   10  h
#12    9  d
#13   10  g
#14    8  f
#15   11  e
#16    9  c
#17   12  c
#18   10  f
#19   10  c
#20    8  h

Это также будет работать с несколькими такими списками

multiple_reduce(create_a(), create_b(), create_a(), create_b())
person Ronak Shah    schedule 07.06.2019