如何在 R / tidyverse 中使用管道函数的进度条

Question

我有一个主要功能，它对某些数据执行一些各种复杂（且长时间运行）的计算，它使用来自 tidyverse / magrittr 的管道执行这些步骤。我想要一个进度条来报告处理的阶段，但是，我很茫然。我看过

cli

、

progress

和

progressr

包，从中我只能让

cli

工作（从某种意义上说。

这是一个最小的例子：

library(tidyverse)
library(cli)

main_fun <- function() {
  cli_progress_step(msg = "Running main function")
  tibble(a = 1:5) %>% 
    fun1() %>% 
    fun2() %>% 
    fun3()
}

fun1 <- function(data) {
  cli_progress_step(msg = "Doing sub function 1")
  Sys.sleep(2)

  return(data)
}
fun2 <- function(data) {
  cli_progress_step(msg = "Doing sub function 2")
  Sys.sleep(1)

  return(data)
}
fun3 <- function(data) {
  cli_progress_step(msg = "Doing sub function 3")
  Sys.sleep(3)

  return(data)
}

main_fun()
#> ℹ Running main function
#> ℹ Doing sub function 3
#> ℹ Doing sub function 2
#> ℹ Doing sub function 1
#> ✔ Doing sub function 1 [2s]
#> 
#> ℹ Doing sub function 2✔ Doing sub function 2 [3s]
#> 
#> ℹ Doing sub function 3✔ Doing sub function 3 [6.1s]
#> 
#> ℹ Running main function✔ Running main function [6.1s]
#> # A tibble: 10 × 1
#>        a
#>    <int>
#>  1     1
#>  2     2
#>  3     3
#>  4     4
#>  5     5

这会显示进度条，但按“相反”顺序显示，即 3 然后 2 然后 1。一旦全部完成，就会显示所有内容，这是我唯一满意的一点。

Answer 1

这是因为在管道中函数不是从左到右求值的。适用于评估的常规 R 语义。 你的电话看起来像：

fun3(fun2(fun1(tibble(a = 1:5))))

进入和退出功能时显示的另一个示例。

library(magrittr)
f1 <- \(x) {message("IN 1"); x$b <- 1; message("OUT 1"); x}
f2 <- \(x) {message("IN 2"); x$c <- 2; message("OUT 2"); x}

data.frame(a=0) %>% f1 %>% f2
#IN 2
#IN 1
#OUT 1
#OUT 2
#  a b c
#1 0 1 2

data.frame(a=0) |> f1() |> f2()
#IN 2
#IN 1
#OUT 1
#OUT 2
#  a b c
#1 0 1 2

f2(f1(data.frame(a=0)))
#IN 2
#IN 1
#OUT 1
#OUT 2
#  a b c
#1 0 1 2

. <- data.frame(a=0)
. <- f1(.)
#IN 1
#OUT 1
. <- f2(.)
#IN 2
#OUT 2
.
#  a b c
#1 0 1 2

---

您可以

force

在函数的第一行评估函数参数，结果将如您所料。

library(tidyverse)
library(cli)

main_fun <- function() {
  cli_progress_step(msg = "Running main function")
  tibble(a = 1:5) %>% 
    fun1() %>% 
    fun2() %>% 
    fun3()
}

fun1 <- function(data) {
  force(data)
  cli_progress_step(msg = "Doing sub function 1")
  Sys.sleep(2)

  return(data)
}
fun2 <- function(data) {
  force(data)
  cli_progress_step(msg = "Doing sub function 2")
  Sys.sleep(1)

  return(data)
}
fun3 <- function(data) {
  force(data)
  cli_progress_step(msg = "Doing sub function 3")
  Sys.sleep(3)

  return(data)
}

main_fun()
#✔ Doing sub function 1 [2s]
#✔ Doing sub function 2 [1s]
#✔ Doing sub function 3 [3s]
#✔ Running main function [6.1s]
## A tibble: 5 × 1
#      a
#  <int>
#1     1
#2     2
#3     3
#4     4
#5     5

---

另一种方法可能是编写自定义管道函数。

`:=` <- function(lhs, rhs) eval(substitute(rhs), list(. = lhs))

main_fun <- function() {
  cli_progress_step(msg = "Running main function")
  tibble(a = 1:5) :=
    fun1(.) :=
    fun2(.) :=
    fun3(.)
}
main_fun()
#✔ Doing sub function 1 [2s]
#✔ Doing sub function 2 [1s]
#✔ Doing sub function 3 [3s]
#✔ Running main function [6.1s]
## A tibble: 5 × 1nction
#      a
#  <int>
#1     1
#2     2
#3     3
#4     4
#5     5