R Evaluación condicional cuando se utiliza el operador de tubería%>%

Cuando se utiliza el operador de la tubería %>%con paquetes tales como dplyr, ggvis, dycharts, etc, ver cómo lo hago un paso condicional? Por ejemplo;

step_1 %>%
step_2 %>%

if(condition)
step_3

Estos enfoques no parecen funcionar:

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

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

Queda un largo camino:

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

¿Existe una mejor manera sin toda la redundancia?

A continuación, se muestra un ejemplo rápido que aprovecha .y ifelse:

X<-1
Y<-T

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

En ifelse, if Yes TRUEif agregará 1, de lo contrario, solo devolverá el último valor de X. El .es un sustituto de la función que le dice que la salida de la etapa anterior de la cadena va, para que pueda usarlo en ambas ramas.

Editar Como señaló @BenBolker, es posible que no desee ifelse, así que aquí hay una ifversión.

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

Gracias a @Frank por señalar que debería usar {llaves alrededor de mis declaraciones ify ifelsepara continuar la cadena.

Creo que eso es un caso purrr::when. Resumamos algunos números si su suma es inferior a 25; de lo contrario, devuelva 0.

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

whendevuelve el valor resultante de la acción de la primera condición válida. Pon la condición a la izquierda de~ y la acción a la derecha. Arriba, solo usamos una condición (y luego otro caso), pero puede tener muchas condiciones.

Puede integrarlo fácilmente en una tubería más larga.

Aquí hay una variación de la respuesta proporcionada por @JohnPaul. Esta variación usa la `if`función en lugar de una if ... else ...declaración compuesta .

library(magrittr)

X <- 1
Y <- TRUE

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

Tenga en cuenta que, en este caso, las llaves no son necesarias alrededor de la `if`función, ni alrededor de una ifelsefunción, solo alrededor de la if ... else ...declaración. Sin embargo, si el marcador de posición de punto aparece solo en una llamada de función anidada, entonces magrittr por defecto canalizará el lado izquierdo al primer argumento del lado derecho. Este comportamiento se reemplaza encerrando la expresión entre llaves. Note la diferencia entre estas dos cadenas:

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

El marcador de posición de punto está anidado dentro de una llamada de función las dos veces que aparece en la `if`función, ya que . + 1y . + 2se interpretan como `+`(., 1)y `+`(., 2), respectivamente. Entonces, la primera expresión devuelve el resultado de `if`(1, TRUE, 1 + 1, 1 + 2), (curiosamente, `if`no se queja de argumentos adicionales no utilizados), y la segunda expresión devuelve el resultado de`if`(TRUE, 1 + 1, 1 + 2) , que es el comportamiento deseado en este caso.

Para obtener más información sobre cómo el operador de tubería magrittr trata el marcador de posición de punto, consulte el archivo de ayuda para %>%, en particular la sección "Uso del punto para propósitos secundarios".

Me parecería más fácil alejarme un poco de las tuberías (aunque estaría interesado en ver otras soluciones), por ejemplo:

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

Esta es una ligera modificación de la respuesta de @ JohnPaul (es posible que realmente no desee ifelse, que evalúa sus dos argumentos y está vectorizada). Sería bueno modificar esto para que regrese .automáticamente si la condición es falsa ... ( precaución : creo que esto funciona pero realmente no lo he probado / pensado demasiado ...)

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

Me gustan purrr::wheny las otras soluciones base proporcionadas aquí son geniales, pero quería algo más compacto y flexible, así que diseñé la función pif(tubería si), vea el código y el documento al final de la respuesta.

Los argumentos pueden ser expresiones de funciones (se admite la notación de fórmulas) y la entrada se devuelve sin cambios de forma predeterminada si la condición es FALSE .

Utilizado en ejemplos de otras respuestas:

## 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

Otros ejemplos :

## 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

Función

#' 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
  }
}