as_call <- function(x) {
if (is.null(x)) {
return(x)
}
if (inherits(x, "formula")) {
stopifnot(length(x) == 2)
x[[2]]
} else if (is.atomic(x) || is.name(x) || is.call(x)) {
x
} else {
stop("Unknown input")
}
}
#' @importFrom methods substituteDirect
interpolate <- function(code, ..., comment = character(),
`_env` = parent.frame(2)) {
if (length(list(...)) > 0) {
args <- lapply(list(...), as_call)
expr <- methods::substituteDirect(as_call(code), args)
} else {
expr <- as_call(code)
}
res <- eval(expr, `_env`)
if (length(comment) > 0) {
comment <- paste("##", comment)
}
attr(res, "code") <- c(comment, capture.output(expr))
res
}
#' Used to grab code from a data.frame generated by this package.
#'
#' This is simply a helper function to grab the contents
#' of the `code` attribute contained in the data object.
#'
#' @title Get Data's Code
#' @param data dataset you want to extract the code from
#' @return The code used to generate the data.frame, if available (else NULL)
#' @author Tom Elliott
#' @export
code <- function(data) {
code <- attr(data, "code")
if (is.null(code)) {
return(NULL)
}
class(code) <- c("inzcode", class(code))
code
}
#' @export
print.inzcode <- function(x, ...) {
c <- paste(x, collapse = " ")
c <- tidy_all_code(c, ...)
cat(c, sep = "\n")
cat("\n")
invisible(NULL)
}
#' Tidy-printing of the code attached to an object
#'
#' @param x a dataframe with code attached
#' @param ... additional arguments passed to tidy_all_code()
#' @return Called for side-effect of printing code to the console.
#' @export
#' @examples
#' iris_agg <- aggregate_data(iris, group_vars = "Species", summaries = "mean")
#' print_code(iris_agg)
print_code <- function(x, ...) {
c <- code(x)
if (is.null(c)) {
message("No code attached to this object.")
return(invisible(NULL))
}
print(c, ...)
}
replaceVars <- function(exp, ...) {
sub_list <- list(...)
exp_str <- as.character(exp)
for (i in seq_along(sub_list)) {
exp_str <- gsub(names(sub_list)[i],
sub_list[i],
exp_str,
fixed = TRUE
)
}
exp <- as.formula(paste(exp_str, collapse = " "))
exp
}
pasteFormulae <- function(formulae, sep = " %>% ") {
combined_formulae <- c()
for (i in seq_along(formulae)) {
combined_formulae[i] <- as.character(formulae[[i]])[2]
}
output_formula <- as.formula(
paste("~",
paste(combined_formulae, collapse = sep),
collapse = " "
)
)
output_formula
}
#' Create variable name
#'
#' Convert a given string to a valid R variable name,
#' converting spaces to underscores (_) instead of dots.
#'
#' @param x a string to convert
#' @return a string, which is also a valid variable name
#' @author Tom Elliott
#' @export
#' @examples
#' create_varname("a new variable")
#' create_varname("8d4-2q5")
create_varname <- function(x) {
# create a valid R variable name from a given string
x <- gsub("\\(|\\)", "", gsub(" ", "_", x))
make.names(x)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.