R语言magrittr管道%>%转原生管道|>的函数改写问题

将代码中magrittr管道操作符%>%替换为R原生管道操作符|>的改写过程中，遇到两类问题，附完整可复现代码如下：

• 改写剔除tibble不完整行的complete_data()函数为原生管道版本时，通过试错写出了可正常运行的complete_data_native()版本，但最初编写的complete_data_native_wrong()版本运行结果不符合预期，无法定位失败原因。
• 改写移动tibble指定行位置的move_row()函数时，目前采用提前计算数据框行数的临时方案实现需求，但该方案无法泛化到同类场景：使用magrittr管道时，可通过.占位符配合nrow(.)直接传入管道当前步骤的tibble行数，需要了解原生管道下实现同等效果的方法。

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

## 剔除tibble不完整行的magrittr版本
complete_data <- function(data){
res <- data %>% filter(complete.cases(.))
return(res)
}

## 试错得到的可正常运行的原生管道版本
complete_data_native <- function(data){
res <- data |>  (\(data) filter(data, complete.cases(data)))()
return(res)
}

## 最初编写的错误原生管道版本
complete_data_native_wrong <- function(data){
res <- data |>  (\(x) filter(x, complete.cases(x)))()
return(res)
}


df <- structure(list(x = c(1, 2, NA, 4), y = c(NA, NA, 3, 4)), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -4L))


df
#> # A tibble: 4 × 2
#>       x     y
#>   <dbl> <dbl>
#> 1     1    NA
#> 2     2    NA
#> 3    NA     3
#> 4     4     4

df |> complete_data()
#> # A tibble: 1 × 2
#>       x     y
#>   <dbl> <dbl>
#> 1     4     4

df |> complete_data_native()
#> # A tibble: 1 × 2
#>       x     y
#>   <dbl> <dbl>
#> 1     4     4

df |> complete_data_native_wrong() # 运行异常，返回3行结果
#> # A tibble: 3 × 2
#>       x     y
#>   <dbl> <dbl>
#> 1     1    NA
#> 2     2    NA
#> 3     4     4


## 移动tibble指定行位置的magrittr版本
move_row <- function(df, ini_pos, fin_pos){
    row_pick <- slice(df, ini_pos)
    if (fin_pos=="last"){
           res <- df   %>%
        slice(-ini_pos)  %>% 
        add_row(row_pick, .before = nrow(.))    
 
        
} else{
    
    res <- df   %>%
        slice(-ini_pos)  %>% 
        add_row(row_pick, .before = fin_pos)    
}
    return(res)
}


## 临时方案实现的原生管道版本（提前计算行数，无法泛化）
move_row_native_attempt <-  function(df, ini_pos, fin_pos){
    ll <- nrow(df) 
    
row_pick <- slice(df, ini_pos)
    if (fin_pos=="last"){
           res <- df  |>  
        slice(-ini_pos) |> 
            add_row(row_pick, .before = ll) 
 
        
} else{
    
    res <- df |>  
        slice(-ini_pos) |>  
        add_row(row_pick, .before = fin_pos)    
}
    return(res)
}



df
#> # A tibble: 4 × 2
#>       x     y
#>   <dbl> <dbl>
#> 1     1    NA
#> 2     2    NA
#> 3    NA     3
#> 4     4     4

df |> move_row(1,"last")
#> # A tibble: 4 × 2
#>       x     y
#>   <dbl> <dbl>
#> 1     2    NA
#> 2    NA     3
#> 3     1    NA
#> 4     4     4


df |> move_row_native_attempt(1,"last") # 可运行但写法不通用
#> # A tibble: 4 × 2
#>       x     y
#>   <dbl> <dbl>
#> 1     2    NA
#> 2    NA     3
#> 3     4     4
#> 4     1    NA


print(sessionInfo())
#> R version 4.2.1 (2022-06-23)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Debian GNU/Linux 11 (bullseye)
#> 
#> Matrix products: default
#> BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
#> LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
#> 
#> locale:
#>  [1] LC_CTYPE=en_GB.UTF-8       LC_NUMERIC=C              
#>  [3] LC_TIME=en_GB.UTF-8        LC_COLLATE=en_GB.UTF-8    
#>  [5] LC_MONETARY=en_GB.UTF-8    LC_MESSAGES=en_GB.UTF-8   
#>  [7] LC_PAPER=en_GB.UTF-8       LC_NAME=C                 
#>  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
#> [11] LC_MEASUREMENT=en_GB.UTF-8 LC_IDENTIFICATION=C       
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#> [1] dplyr_1.0.9
#> 
#> loaded via a namespace (and not attached):
#>  [1] knitr_1.39       magrittr_2.0.3   tidyselect_1.1.2 R6_2.5.1        
#>  [5] rlang_1.0.2      fastmap_1.1.0    fansi_1.0.3      stringr_1.4.0   
#>  [9] highr_0.9        tools_4.2.1      xfun_0.31        utf8_1.2.2      
#> [13] DBI_1.1.3        cli_3.3.0        withr_2.5.0      htmltools_0.5.2 
#> [17] ellipsis_0.3.2   assertthat_0.2.1 yaml_2.3.5       digest_0.6.29   
#> [21] tibble_3.1.7     lifecycle_1.0.1  crayon_1.5.1     purrr_0.3.4     
#> [25] vctrs_0.4.1      fs_1.5.2         glue_1.6.2       evaluate_0.15   
#> [29] rmarkdown_2.14   reprex_2.0.1     stringi_1.7.6    compiler_4.2.1  
#> [33] pillar_1.7.0     generics_0.1.2   pkgconfig_2.0.3

1. complete_data_native_wrong()运行错误的原因 #

你贴出的两个原生管道版本仅匿名函数的形参命名不同（前者用data，后者用x），逻辑完全等价，正常运行应该返回完全一致的结果。你运行时得到错误的3行结果，大概率是编写错误版本时存在笔误：最常见的情况是写原生管道时直接沿用了magrittr的.占位符，比如写成data |> filter(complete.cases(.))，此时原生管道不会把.替换为上一步传入的data对象，complete.cases()会在全局环境搜索.对应的变量，返回长度不匹配的逻辑向量，最终过滤出错误的行。
你用匿名函数显式接收入参的写法，是原生管道下规避这类传参错误、dplyr数据掩码冲突的标准方案。

2. 原生管道下引用当前步骤对象的实现方法 #

R 4.2版本的原生管道没有内置magrittr的.占位符，要实现引用管道上一步输出的效果，直接沿用你写complete_data_native()的匿名函数思路即可，不需要提前计算行数，适配所有同类场景：

move_row_native <- function(df, ini_pos, fin_pos){
  row_pick <- slice(df, ini_pos)
  if (fin_pos == "last"){
    res <- df |> 
      slice(-ini_pos) |> 
      (\(cur_data) add_row(cur_data, row_pick, .before = nrow(cur_data)))()
  } else {
    res <- df |> 
      slice(-ini_pos) |> 
      add_row(row_pick, .before = fin_pos)
  }
  return(res)
}

匿名函数的形参（示例里的cur_data）就等价于magrittr的.占位符，所有需要用到当前管道传入对象的位置，都用这个形参代替即可。
如果是R 4.3及以上版本，原生管道新增了_占位符，但注意_只能作为命名参数的直接传入值，不能用于嵌套函数调用（比如不能直接写nrow(_)），这类场景下匿名函数写法的兼容性最好。

内容的提问来源于stack exchange，提问作者larry77