R Evaluasi bersyarat saat menggunakan operator pipa%>%

Bila menggunakan operator pipa %>%dengan paket seperti dplyr, ggvis, dycharts, dll, bagaimana saya melakukan langkah bersyarat? Sebagai contoh;

step_1 %>%
step_2 %>%

if(condition)
step_3

Pendekatan ini sepertinya tidak berhasil:

step_1 %>%
step_2 
if(condition) %>% step_3

step_1 %>%
step_2 %>%
if(condition) step_3

Ada jalan panjang:

if(condition)
{
step_1 %>%
step_2 
}else{
step_1 %>%
step_2 %>%
step_3
}

Apakah ada cara yang lebih baik tanpa semua redundansi?

Berikut adalah contoh cepat yang memanfaatkan .dan ifelse:

X<-1
Y<-T

X %>% add(1) %>% { ifelse(Y ,add(.,1), . ) }

Di ifelse, jika Yadalah TRUEjika akan menambahkan 1, jika tidak maka hanya akan mengembalikan nilai terakhir X. Ini .adalah stand-in yang memberi tahu fungsi di mana output dari langkah rantai sebelumnya pergi, jadi saya bisa menggunakannya di kedua cabang.

Edit Seperti yang ditunjukkan @BenBolker, Anda mungkin tidak menginginkannya ifelse, jadi ini adalah ifversinya.

X %>% 
add(1) %>% 
 {if(Y) add(.,1) else .}

Terima kasih kepada @Frank karena telah menunjukkan bahwa saya harus menggunakan {kawat gigi di sekitar pernyataan ifdan saya ifelseuntuk melanjutkan rantai.

Saya pikir itu kasusnya purrr::when. Mari kita simpulkan beberapa angka jika jumlahnya di bawah 25, jika tidak, kembalikan 0.

library("magrittr")
1:3 %>% 
  purrr::when(sum(.) < 25 ~ sum(.), 
              ~0
  )
#> [1] 6

whenmengembalikan nilai yang dihasilkan dari tindakan kondisi valid pertama. Letakkan ketentuan di sebelah kiri ~, dan tindakan di sebelah kanannya. Di atas, kami hanya menggunakan satu ketentuan (dan kemudian kasus lain), tetapi Anda dapat memiliki banyak ketentuan.

Anda dapat dengan mudah mengintegrasikannya ke dalam pipa yang lebih panjang.

Berikut adalah variasi jawaban yang diberikan oleh @JohnPaul. Variasi ini menggunakan `if`fungsi sebagai pengganti if ... else ...pernyataan gabungan .

library(magrittr)

X <- 1
Y <- TRUE

X %>% `if`(Y, . + 1, .) %>% multiply_by(2)
# [1] 4

Perhatikan bahwa dalam kasus ini kurung kurawal tidak diperlukan di sekitar `if`fungsi, atau di sekitar ifelsefungsi — hanya di sekitar if ... else ...pernyataan. Namun, jika placeholder titik hanya muncul dalam panggilan fungsi bersarang, maka magrittr secara default akan menyalurkan sisi kiri ke argumen pertama dari sisi kanan. Perilaku ini diganti dengan menyertakan ekspresi dalam tanda kurung kurawal. Perhatikan perbedaan antara kedua rantai ini:

X %>% `if`(Y, . + 1, . + 2)
# [1] TRUE
X %>% {`if`(Y, . + 1, . + 2)}
# [1] 4

Placeholder titik bertumpuk dalam panggilan fungsi kedua kali muncul dalam `if`fungsi, karena . + 1dan . + 2ditafsirkan sebagai `+`(., 1)dan `+`(., 2), masing-masing. Jadi, ekspresi pertama mengembalikan hasil `if`(1, TRUE, 1 + 1, 1 + 2), (anehnya, `if`tidak mengeluh tentang argumen ekstra yang tidak terpakai), dan ekspresi kedua mengembalikan hasil `if`(TRUE, 1 + 1, 1 + 2), yang merupakan perilaku yang diinginkan dalam kasus ini.

Untuk informasi lebih lanjut tentang bagaimana operator pipa magrittr memperlakukan placeholder titik, lihat file bantuan untuk %>%, khususnya bagian tentang "Menggunakan titik untuk tujuan sekunder".

Tampaknya paling mudah bagi saya untuk mundur dari pipa sedikit kecil (walaupun saya akan tertarik untuk melihat solusi lain), misalnya:

library("dplyr")
z <- data.frame(a=1:2)
z %>% mutate(b=a^2) -> z2
if (z2$b[1]>1) {
    z2 %>% mutate(b=b^2) -> z2
}
z2 %>% mutate(b=b^2) -> z3

Ini adalah sedikit modifikasi dari jawaban @ JohnPaul (Anda mungkin tidak benar-benar menginginkannya ifelse, yang mengevaluasi kedua argumennya dan dalam bentuk vektorisasi). Alangkah baiknya untuk memodifikasi ini untuk mengembalikan .secara otomatis jika kondisinya salah ... ( hati-hati : Saya pikir ini berfungsi tetapi belum benar-benar menguji / terlalu memikirkannya ...)

iff <- function(cond,x,y) {
    if(cond) return(x) else return(y)
}

z %>% mutate(b=a^2) %>%
    iff(cond=z2$b[1]>1,mutate(.,b=b^2),.) %>%
 mutate(b=b^2) -> z4

Saya suka purrr::whendan solusi dasar lain yang disediakan di sini semuanya hebat tetapi saya menginginkan sesuatu yang lebih kompak dan fleksibel jadi saya merancang fungsi pif(pipa jika), lihat kode dan dokumen di akhir jawaban.

Argumen dapat berupa ekspresi fungsi (notasi rumus didukung), dan input dikembalikan secara default jika kondisinya adalah FALSE.

Digunakan pada contoh dari jawaban lain:

## from Ben Bolker
data.frame(a=1:2) %>% 
  mutate(b=a^2) %>%
  pif(~b[1]>1, ~mutate(.,b=b^2)) %>%
  mutate(b=b^2)
#   a  b
# 1 1  1
# 2 2 16

## from Lorenz Walthert
1:3 %>% pif(sum(.) < 25,sum,0)
# [1] 6

## from clbieganek 
1 %>% pif(TRUE,~. + 1) %>% `*`(2)
# [1] 4

# from theforestecologist
1 %>% `+`(1) %>% pif(TRUE ,~ .+1)
# [1] 3

Contoh lain:

## using functions
iris %>% pif(is.data.frame, dim, nrow)
# [1] 150   5

## using formulas
iris %>% pif(~is.numeric(Species), 
             ~"numeric :)",
             ~paste(class(Species)[1],":("))
# [1] "factor :("

## using expressions
iris %>% pif(nrow(.) > 2, head(.,2))
#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
# 1          5.1         3.5          1.4         0.2  setosa
# 2          4.9         3.0          1.4         0.2  setosa

## careful with expressions
iris %>% pif(TRUE, dim,  warning("this will be evaluated"))
# [1] 150   5
# Warning message:
# In inherits(false, "formula") : this will be evaluated
iris %>% pif(TRUE, dim, ~warning("this won't be evaluated"))
# [1] 150   5

Fungsi

#' Pipe friendly conditional operation
#'
#' Apply a transformation on the data only if a condition is met, 
#' by default if condition is not met the input is returned unchanged.
#' 
#' The use of formula or functions is recommended over the use of expressions
#' for the following reasons :
#' 
#' \itemize{
#'   \item If \code{true} and/or \code{false} are provided as expressions they 
#'   will be evaluated wether the condition is \code{TRUE} or \code{FALSE}.
#'   Functions or formulas on the other hand will be applied on the data only if
#'   the relevant condition is met
#'   \item Formulas support calling directly a column of the data by its name 
#'   without \code{x$foo} notation.
#'   \item Dot notation will work in expressions only if `pif` is used in a pipe
#'   chain
#' }
#' 
#' @param x An object
#' @param p A predicate function, a formula describing such a predicate function, or an expression.
#' @param true,false Functions to apply to the data, formulas describing such functions, or expressions.
#'
#' @return The output of \code{true} or \code{false}, either as expressions or applied on data as functions
#' @export
#'
#' @examples
#'# using functions
#'pif(iris, is.data.frame, dim, nrow)
#'# using formulas
#'pif(iris, ~is.numeric(Species), ~"numeric :)",~paste(class(Species)[1],":("))
#'# using expressions
#'pif(iris, nrow(iris) > 2, head(iris,2))
#'# careful with expressions
#'pif(iris, TRUE, dim,  warning("this will be evaluated"))
#'pif(iris, TRUE, dim, ~warning("this won't be evaluated"))
pif <- function(x, p, true, false = identity){
  if(!requireNamespace("purrr")) 
    stop("Package 'purrr' needs to be installed to use function 'pif'")

  if(inherits(p,     "formula"))
    p     <- purrr::as_mapper(
      if(!is.list(x)) p else update(p,~with(...,.)))
  if(inherits(true,  "formula"))
    true  <- purrr::as_mapper(
      if(!is.list(x)) true else update(true,~with(...,.)))
  if(inherits(false, "formula"))
    false <- purrr::as_mapper(
      if(!is.list(x)) false else update(false,~with(...,.)))

  if ( (is.function(p) && p(x)) || (!is.function(p) && p)){
    if(is.function(true)) true(x) else true
  }  else {
    if(is.function(false)) false(x) else false
  }
}