Created
October 26, 2019 13:44
-
-
Save gshotwell/5b1c84e441e40675581c6d3e75ea0d0b to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
call <- substitute(ifelse(v == 1, | |
"banana", | |
ifelse(v == 2, | |
2, | |
NA)) | |
) | |
parse_ifelse <- function(call) { | |
if (deparse(call[[3]][[1]]) == "ifelse") { | |
top_call <- deparse(call[[2]]) | |
return( | |
paste0(top_call, " & ", | |
parse_ifelse(call[[3]])) | |
) | |
} | |
top_call <- paste0(deparse(call[[2]]), " ~ ", deparse(call[[3]])) | |
if (deparse(call[[4]][[1]]) == "ifelse") { | |
return(c(top_call, | |
parse_ifelse(call[[4]]))) | |
} | |
return(paste0(deparse(call[[2]]), " ~ ", deparse(call[[3]]))) | |
} | |
getTerminalCase <- function(call) { | |
if (deparse(call[[4]][[1]]) == "ifelse") { | |
return(getTerminalCase(call[[4]])) | |
} else { | |
return(paste0( "TRUE ~ ", deparse(call[[4]]))) | |
} | |
} | |
makeCaseWhen <- function(call) { | |
cases <- c( | |
parse_ifelse(call), | |
getTerminalCase(call) | |
) | |
out <- c( | |
"dplyr::case_when(", | |
paste0(cases, collapse = ",\n"), | |
")" | |
) | |
paste0(out, collapse = "\n") | |
} | |
cat(makeCaseWhen(call)) |
Awesome!
…On Sat., Oct. 26, 2019, 11:39 a.m. Dewey Dunnington, < ***@***.***> wrote:
This was a great Saturday morning coffee challenge! No judgement, just
having fun with rlang:
library(rlang)
cases <- function(x, cases = list()) {
if (is_call(x, "ifelse")) {
test <- x[[2]]
if_true <- x[[3]]
if_false <- x[[4]]
c(
cases,
call2("~", test, if_true),
cases(if_false)
)
} else {
list(call2("~", TRUE, x))
}
}
x <- expr(ifelse(a == 12, "twelve", ifelse(a == 13, "thirteen", "not twelve or 13")))
call2("case_when", !!!cases(x))#> case_when(a == 12 ~ "twelve", a == 13 ~ "thirteen", TRUE ~ "not twelve or 13")
Created on 2019-10-26 by the reprex package <https://reprex.tidyverse.org>
(v0.2.1)
—
You are receiving this because you authored the thread.
Reply to this email directly, view it on GitHub
<https://gist.github.com/5b1c84e441e40675581c6d3e75ea0d0b?email_source=notifications&email_token=ACAG7FDTTVEATX545DMR2XTQQRJDVA5CNFSM4JFNQN62YY3PNVWWK3TUL52HS4DFVNDWS43UINXW23LFNZ2KUY3PNVWWK3TUL5UWJTQAF3FMK#gistcomment-3066565>,
or unsubscribe
<https://github.com/notifications/unsubscribe-auth/ACAG7FBL2KAAS2ZTOSLSWETQQRJDVANCNFSM4JFNQN6Q>
.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This was a great Saturday morning coffee challenge! No judgement, just having fun with
rlang
:Created on 2019-10-26 by the reprex package (v0.2.1)