R通过列嵌套映射答案

【问题标题】：R nested map through columnsR通过列嵌套映射
【发布时间】：2023-03-10 04:05:01
【问题描述】：

我得到了一个在这里解决的函数。
此函数采用一个填充了注释的列和另一个分组列，并将注释传播到具有缺失值的行。

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 组列，ID、分组列 (2:3) 和注释列 (4:5)。
由于我多次调用该函数，我想知道如何使用 map 函数传递列索引以应用函数，如上例所示。

我试过这样的

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

但结果是一团糟。

提前致谢

【问题讨论】：

您是否需要将c、e 作为带引号的字符串传递。另外，这是函数的顺序应用吗
是的，这是函数的顺序应用。我认为应该引用它，因为t %>% f1(3, 5) 不起作用。但我想作为列索引传递，如第 3 列和第 5 列，但我认为 dplyr 不接受它。
实际上，我发现它可以工作t %>% f1( !!(colnames(t)[3]) , !!(colnames(t)[5]) )。所以我只需要了解如何按顺序使用 map （或可能应用）。
map 的问题是它不是连续的，之后你可能需要做一个coalesce。我会检查?compose
我认为for 循环使它更容易。 i1 <- 3:2; i2 <- 4:5; for(i in seq_along(i1)) t <- f1(!! rlang::sym(names(t)[.x]), !! rlang::sym(names(t)[.y])

标签： r loops apply tidyverse purrr

【解决方案1】：

这可以在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

【讨论】：

我不知道为什么，但它不起作用。另外，我想避免副作用。但无论如何我尝试过这种方式for(i in 4:5){ for(j in 3:2){ t <- f1(t, !!(colnames(t)[j]), !!(colnames(t)[i])) } }
@AurelianoGuedes。一个我忘记添加的右括号
Error in !rlang::sym(names(t)[i]) : invalid argument type 4. eval(lhs, parent, parent) 3. eval(lhs, parent, parent) 2. data %>% dplyr::group_by({ { group_col } ... 1. f1(!!rlang::sym(names(t)[i]), !!rlang::sym(names(t)[i]))
已更新> packageVersion('rlang'); packageVersion('dplyr'); [1] ‘0.4.0’ [1] ‘0.8.3’
@AurelianoGuedes。抱歉，忘记了“i1”和“i2”

【解决方案2】：

由于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

【讨论】：