Nothing
get_dot_data <- function(x, qs) {
if (sjmisc::is_empty(qs))
x
else
# In case dots are not empty, get subdataframe of dots selection in function build_dot_data
build_dot_data(x, qs)
}
build_dot_data <- function(x, qs) {
# below lapply goes through each of the expressions in dots data
# and the corresponding subdataframes got with build_col are saved in list out
out <- lapply(qs, function(dot_expr) build_col(x, dot_expr))
out <- dplyr::bind_cols(out)
attr(out, "row.names") <- attr(x, "row.names")
out
}
# depending on the dots expressions, old variables are selected or new ones are computed with transmute
build_col <- function(x, qs_expr) {
if (check_qs(rlang::get_expr(qs_expr))) {
suppressMessages(dplyr::select(x, !!qs_expr))
} else {
suppressMessages(dplyr::transmute(x, !!qs_expr))
}
}
# name or numeric expressions, regular sequences or those looked for with select helpers are selected
# otherwise, they are transmuted
check_qs <- function(is_expr) {
if (!inherits(is_expr, "call")) {
TRUE
} else if (as.character(is_expr)[1] == ":") {
TRUE
} else if (as.character(is_expr)[1] %in% paste0(c(rep("",length(tidyselect::vars_select_helpers)),rep("dplyr::",length(tidyselect::vars_select_helpers)),rep("tidyselect::",length(tidyselect::vars_select_helpers))),names(tidyselect::vars_select_helpers))) {
TRUE
} else {
FALSE
}
}
data_frame <- function(...) {
x <- data.frame(..., stringsAsFactors = FALSE)
rownames(x) <- NULL
x
}
n_unique <- function(x, na.rm = TRUE) {
x <- as.vector(x)
if (na.rm) x <- stats::na.omit(x)
length(unique(x))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.