#' Convert an unevaluted pipeline into a function.
#'
#' Convert an unevaluted pipeline into a function of "."
#'
#' Note: writes "." into env.
#'
#' @param pipeline a un-evaluated wrapr pipeline.
#' @param env envirnonment to work in.
#' @return single function with signature (., env = parent.frame())
#'
#' @examples
#'
#' f <- as_dot_fn(sin(.) %.>% cos(.))
#' f(1:3)
#'
#' g <- as_dot_fn(. %.>% sin(.) %.>% cos(.))
#' g(1:3)
#'
#' @export
#'
as_dot_fn <- function(pipeline, env = parent.frame()) {
force(env)
pipeline <- substitute(pipeline)
f <- function(., env = parent.frame()) {
force(env)
assign(".", ., envir = env)
eval(pipeline, envir = env, enclos = env)
}
f_env = new.env(parent = env)
assign("pipeline", pipeline, envir = f_env)
environment(f) <- f_env
class(f) <- "wrapr_as_dot_fn"
f
}
#' @export
format.wrapr_as_dot_fn <- function(x, ...) {
format(get("pipeline", environment(x), inherits = FALSE))
}
#' @export
print.wrapr_as_dot_fn <- function(x, ...) {
print(get("pipeline", environment(x), inherits = FALSE))
}
#' Convert a pipeable object into a function.
#'
#' Convert a pipeable object into a function of "."
#'
#' Note: writes "." into env.
#'
#' @param pipeable a wrapr dot-pipe pipeable object
#' @param env envirnonment to work in.
#' @return single function with signature (., env = parent.frame())
#'
#' @examples
#'
#' p <- pkgfn("base::sin", "x")
#' f <- as_fn(p)
#' f(5)
#'
#'
#' @export
#'
as_fn <- function(pipeable, env = parent.frame()) {
force(env)
right_arg_name = "pipeable"
ps <- substitute(pipeable)
if(is.name(ps)) {
right_arg_name <- as.character(substitute(ps))
}
f <- function(., env = parent.frame()) {
force(env)
left_arg_name = "."
ds <- substitute(.)
if(is.name(ds)) {
left_arg_name <- as.character(ds)
}
assign(".", ., envir = env)
wrapr::apply_right(pipe_left_arg = .,
pipe_right_arg = pipeable,
pipe_environment = env,
left_arg_name = left_arg_name,
pipe_string = "%.>%",
right_arg_name = right_arg_name)
}
f_env = new.env(parent = env)
assign("pipeable", pipeable, envir = f_env)
assign("right_arg_name", right_arg_name, envir = f_env)
environment(f) <- f_env
class(f) <- "wrapr_as_fn"
f
}
#' @export
format.wrapr_as_fn <- function(x, ...) {
format(get("pipeable", environment(x), inherits = FALSE))
}
#' @export
print.wrapr_as_fn <- function(x, ...) {
print(get("pipeable", environment(x), inherits = FALSE))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.