R การประเมินตามเงื่อนไขเมื่อใช้ตัวดำเนินการท่อ%>%

เมื่อใช้ประกอบท่อ%>%กับแพคเกจเช่นdplyr, ggvis, dychartsฯลฯ ทำวิธีที่ผมทำขั้นตอนเงื่อนไข? ตัวอย่างเช่น;

step_1 %>%
step_2 %>%

if(condition)
step_3

วิธีการเหล่านี้ดูเหมือนจะไม่ได้ผล:

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

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

มีทางยาว:

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

มีวิธีที่ดีกว่าโดยไม่ต้องใช้ความซ้ำซ้อนทั้งหมดหรือไม่?

นี่คือตัวอย่างสั้น ๆ ที่ใช้ประโยชน์จาก.และifelse:

X<-1
Y<-T

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

ในifelseif Yis TRUEif จะเพิ่ม 1 มิฉะนั้นจะส่งคืนค่าสุดท้ายของX. .เป็นสแตนด์ที่บอกว่าฟังก์ชั่นที่ส่งออกจากขั้นตอนก่อนหน้าของห่วงโซ่ไปเพื่อให้สามารถใช้งานได้ทั้งบนกิ่งไม้

แก้ไข ตามที่ @BenBolker ชี้ให้เห็นคุณอาจไม่ต้องการifelseดังนั้นนี่คือifเวอร์ชัน

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

ขอบคุณ @Frank ที่ชี้ให้เห็นว่าฉันควรใช้{วงเล็บปีกกาifและifelseงบเพื่อดำเนินการต่อ

purrr::whenผมคิดว่าเป็นกรณีที่หา ลองสรุปตัวเลขสองสามตัวหากผลรวมของพวกเขาต่ำกว่า 25 มิฉะนั้นจะส่งกลับ 0

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

whenส่งคืนค่าที่เกิดจากการกระทำของเงื่อนไขแรกที่ถูกต้อง วางเงื่อนไขไว้ทางซ้ายของ~และการดำเนินการทางด้านขวาของเงื่อนไข ข้างต้นเราใช้เงื่อนไขเดียวเท่านั้น (แล้วก็อีกกรณีหนึ่ง) แต่คุณสามารถมีเงื่อนไขได้มากมาย

คุณสามารถรวมเข้ากับท่อที่ยาวขึ้นได้อย่างง่ายดาย

นี่คือรูปแบบของคำตอบที่ให้ไว้โดย @JohnPaul รูปแบบนี้ใช้`if`ฟังก์ชันแทนif ... else ...คำสั่งผสม

library(magrittr)

X <- 1
Y <- TRUE

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

โปรดทราบว่าในกรณีนี้ไม่จำเป็นต้องใช้วงเล็บปีกการอบ ๆ`if`ฟังก์ชันหรือรอบ ๆifelseฟังก์ชัน - เฉพาะรอบ ๆif ... else ...คำสั่งเท่านั้น อย่างไรก็ตามหากตัวยึดจุดปรากฏเฉพาะในการเรียกใช้ฟังก์ชันที่ซ้อนกันmagrittrจะไปป์ทางด้านซ้ายมือเป็นอาร์กิวเมนต์แรกของด้านขวามือโดยค่าเริ่มต้น พฤติกรรมนี้ถูกแทนที่โดยการใส่นิพจน์ในวงเล็บปีกกา สังเกตความแตกต่างระหว่างโซ่ทั้งสองนี้:

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

ตัวยึดจุดจะซ้อนอยู่ภายในการเรียกใช้ฟังก์ชันทั้งสองครั้งที่ปรากฏใน`if`ฟังก์ชันเนื่องจาก. + 1และ. + 2ถูกตีความเป็น`+`(., 1)และ`+`(., 2)ตามลำดับ ดังนั้นนิพจน์แรกจะส่งคืนผลลัพธ์ของ`if`(1, TRUE, 1 + 1, 1 + 2)(แปลกมากพอที่`if`จะไม่บ่นเกี่ยวกับอาร์กิวเมนต์ที่ไม่ได้ใช้เพิ่มเติม) และนิพจน์ที่สองจะส่งคืนผลลัพธ์`if`(TRUE, 1 + 1, 1 + 2)ซึ่งเป็นพฤติกรรมที่ต้องการในกรณีนี้

สำหรับข้อมูลเพิ่มเติมเกี่ยวกับวิธีที่ตัวดำเนินการไปป์magrittrปฏิบัติต่อตัวยึดจุดให้ดูไฟล์วิธีใช้สำหรับ%>%โดยเฉพาะในส่วน "การใช้จุดเพื่อวัตถุประสงค์รอง"

ดูเหมือนจะง่ายที่สุดสำหรับฉันที่จะถอยออกจากท่อเล็กน้อย (แม้ว่าฉันจะสนใจที่จะดูวิธีแก้ปัญหาอื่น ๆ ) เช่น:

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

นี่คือการปรับเปลี่ยนคำตอบของ @JohnPaul เล็กน้อย (คุณอาจไม่ต้องการจริงๆifelseซึ่งประเมินทั้งสองอาร์กิวเมนต์และเป็นเวกเตอร์) จะเป็นการดีที่จะแก้ไขสิ่งนี้ให้กลับมา .โดยอัตโนมัติหากเงื่อนไขเป็นเท็จ ... ( ข้อควรระวัง : ฉันคิดว่ามันใช้งานได้ แต่ยังไม่ได้ทดสอบ / คิดถึงมันมากเกินไป ... )

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

ฉันชอบpurrr::whenและโซลูชันพื้นฐานอื่น ๆ ที่มีให้ที่นี่นั้นยอดเยี่ยมมาก แต่ฉันต้องการบางอย่างที่กะทัดรัดและยืดหยุ่นมากขึ้นดังนั้นฉันจึงออกแบบฟังก์ชันpif(ไปป์ if) ดูโค้ดและเอกสารในตอนท้ายของคำตอบ

ข้อโต้แย้งที่สามารถแสดงออกของการทำงานอย่างใดอย่างหนึ่ง (สัญกรณ์สูตรได้รับการสนับสนุน) FALSEและการป้อนข้อมูลจะถูกส่งกลับไม่เปลี่ยนแปลงโดยค่าเริ่มต้นถ้าเงื่อนไขเป็น

ใช้กับตัวอย่างจากคำตอบอื่น ๆ :

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

ตัวอย่างอื่น ๆ :

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

ฟังก์ชัน

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