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
food <- tibble(item=c("apple","baguette","zucchini","mushrooms")) | |
multi_case_when <- function(.x,.names,...) { | |
require(rlang) | |
require(magrittr) | |
require(purrr) | |
.dots <- enquos(...) | |
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
show_function <- function(fun){ | |
tmp_dir <- tempdir() | |
fun_expr <- enexpr(fun) | |
if(rlang::is_call(fun_expr) && | |
(identical(fun_expr[[1]],quote(`::`)) || identical(fun_expr[[1]],quote(`:::`)))) { | |
fun_name <- rlang::as_name(fun_expr[[3]]) | |
} else { | |
fun_name <- rlang::as_name(fun_expr) | |
} | |
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
`[[.data.table` <- function(data,subset){ | |
subset(data,eval(subset,data)) | |
} | |
subsetter <- function(x){ | |
new_subsetter(substitute(x)) | |
} | |
new_subsetter <- function(x){ |
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
mutate_s <- function(.data,...){ | |
if(!inherits(.data,"data.frame")) stop("mutate_s() can only act on data.frames") | |
require(rlang) | |
.dots <- rlang::enexprs(...) | |
lhs <- names(.dots) | |
k <- length(.dots) | |
p_env <- parent.frame() | |
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
#install.packages(here) | |
#install.packages(crayon) | |
p <- function(str){ | |
structure(str,class=c("path","character")) | |
} | |
`/.path` <- function(a,b){ | |
p(paste(a,b,sep="/")) | |
} |
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
mutate_where <- function(x,predicate,...){ | |
full_x <- mutate(x,..row_ids = 1:n()) | |
.predicate <- enquo(predicate) | |
predicated_x <- filter(full_x,!!.predicate) | |
other_x <- filter(full_x,!(!!.predicate)|is.na(!!.predicate)) | |
mutated_x <- mutate(predicated_x,!!!enquos(...)) |
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
pseudosurv2 <- function (time, event, tmax) | |
{ | |
if (any(is.na(time))) | |
stop("missing values in 'time' vector") | |
if (any(time < 0)) | |
stop("'time' must be nonnegative") | |
if (any(is.na(event))) | |
stop("missing values in 'event' vector") |
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
`[[.data.frame` <- function(x,...,exact=TRUE) { | |
na <- nargs() - !missing(exact) | |
if (!all(names(sys.call()) %in% c("", "exact"))) | |
warning("named arguments other than 'exact' are discouraged") | |
if (na < 3L) | |
{ | |
(function(x, i, exact) | |
{ | |
if (is.matrix(i)) | |
{ |
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
library(rlang) | |
library(remotes) | |
print.historic_defaults <- function(x,...){ | |
v_list_str <- ls(x) | |
v_list <- as.numeric_version(v_list_str) | |
v_list_ordered <- v_list_str[order(v_list)] | |
for(i in 1:length(v_list_ordered)){ | |
c_v_list <- v_list_ordered[[i]] | |
cat("Version:",c_v_list,"\n") |
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
try_na <- function(...){ | |
f_list <- purrr::map(list(...),rlang::as_function) | |
f_len <- length(f_list) | |
function(.x) { | |
out <- rep(NA,length(.x)) | |
i <- 1 | |
while(any(is.na(out)) & i <= f_len){ | |
out[is.na(out)] <- f_list[[i]](.x[is.na(out)]) | |
i <- i + 1 | |
} |
OlderNewer