Вложенная карта через столбцы - PullRequest
Новая
       63

Вложенная карта через столбцы

2 голосов
/ 18 октября 2019

Я получил функцию, которая была решена здесь.
Эта функция берет столбец, заполненный аннотациями, и другой столбец группировки и распространяет аннотацию в строки с пропущенными значениями. 

f1 <- function(data, group_col, expand_col){
  data %>%
    dplyr::group_by({{group_col}}) %>%
    dplyr::mutate( 
      {{expand_col}} := dplyr::case_when(
        !is.na({{expand_col}}) ~ 
          {{expand_col}} ,
      any( !is.na({{expand_col}})  ) & is.na({{expand_col}}) ~ 
        paste(unique(unlist(str_split(na.omit({{expand_col}}), " ")) ), 
                         collapse = " "),
      TRUE ~ 
        NA_character_  
    ))  %>%
    dplyr::ungroup()
}

Теперь я хотел бы сделать это через множество столбцов, группирующих столбцы (group_col) и столбцы аннотаций (expand_col).
Так что, если у меня есть это df: 

t <- tibble(a = c("a", "b", "c", "d", "e", "f", "g", "h"), 
            b = c(  1,   1,   1,   1,   2,   2,   2,   2),
            c = c(  1,   1,   2,   2,   3,   3,   4,   4),
            d = c( NA,  NA,  NA, "D", "E",  NA,  NA,  NA),
            e = c("A",  NA, "C",  NA,  NA,  NA, "G", "H")
            )

Я могу применить его следующим образом 

> t %>%
+   f1(c,e) %>%
+   f1(b,e) %>%
+   f1(c,d) %>%
+   f1(b,d)
# A tibble: 8 x 5
  a         b     c d     e    
  <chr> <dbl> <dbl> <chr> <chr>
1 a         1     1 D     A    
2 b         1     1 D     A    
3 c         1     2 D     C    
4 d         1     2 D     C    
5 e         2     3 E     G H  
6 f         2     3 E     G H  
7 g         2     4 E     G    
8 h         2     4 E     H

Итак, у меня есть 3 группы столбцов, идентификаторы, столбцы группировки (2: 3) и столбцы аннотаций (4: 5).
Так как я вызываю функцию много раз, я хотел бы знать, как использовать функцию map для передачи индексов столбцов для применения функции, как в примере выше.

Я пытался что-то подобное 

3:2 %>% 
  map(
    function(x) 4:5 %>% 
      map(
        function(y) f1(
          t, 
          !!(colnames(t)[x]) , 
          !!(colnames(t)[y])
        ) 
      )
  )

Но результатом является неправильный беспорядок.

Заранее спасибо

Ответы [ 2 ]

1 голос
/ 18 октября 2019

Поскольку f1 принимает имена столбцов, вам необходимо сначала преобразовать ваши индексы в символы: 

v1 <- rlang::syms( colnames(t)[3:2] )
v2 <- rlang::syms( colnames(t)[4:5] )

Теперь вы можете использовать tidyr::crossing(), чтобы получить все возможные пары ваших символов, и purrr::reduce2() последовательно применять f1() с этими символами: 

V <- tidyr::crossing( v1, v2 )
Res <- purrr::reduce2( V$v1, V$v2, f1, .init=t )

# Validation
Res2 <- t %>% f1(c,e) %>% f1(b,e) %>% f1(c,d) %>% f1(b,d)
identical(Res, Res2)   # TRUE
1 голос
/ 18 октября 2019

Это можно легко сделать в цикле for 

i1 <- rep(names(t)[3:2], 2)
i2 <- rep(names(t)[4:5], each = 2)
for(i in seq_along(i1))
t <- f1(t, !! rlang::sym(i1[i]), !! rlang::sym(i2[i]))
t
# A tibble: 8 x 5
#  a         b     c d     e    
#  <chr> <dbl> <dbl> <chr> <chr>
#1 a         1     1 D     A    
#2 b         1     1 D     A    
#3 c         1     2 D     C    
#4 d         1     2 D     C    
#5 e         2     3 E     G H  
#6 f         2     3 E     G H  
#7 g         2     4 E     G    
#8 h         2     4 E     H
...