1#' Quote variables to create a list of unevaluated expressions for later 2#' evaluation. 3#' 4#' This function is similar to \code{\link{~}} in that it is used to 5#' capture the name of variables, not their current value. This is used 6#' throughout plyr to specify the names of variables (or more complicated 7#' expressions). 8#' 9#' Similar tricks can be performed with \code{\link{substitute}}, but when 10#' functions can be called in multiple ways it becomes increasingly tricky 11#' to ensure that the values are extracted from the correct frame. Substitute 12#' tricks also make it difficult to program against the functions that use 13#' them, while the \code{quoted} class provides 14#' \code{as.quoted.character} to convert strings to the appropriate 15#' data structure. 16#' 17#' @param ... unevaluated expressions to be recorded. Specify names if you 18#' want the set the names of the resultant variables 19#' @param .env environment in which unbound symbols in \code{...} should be 20#' evaluated. Defaults to the environment in which \code{.} was executed. 21#' @return list of symbol and language primitives 22#' @aliases . quoted is.quoted 23#' @export . is.quoted 24#' @rdname quoted 25#' @examples 26#' .(a, b, c) 27#' .(first = a, second = b, third = c) 28#' .(a ^ 2, b - d, log(c)) 29#' as.quoted(~ a + b + c) 30#' as.quoted(a ~ b + c) 31#' as.quoted(c("a", "b", "c")) 32#' 33#' # Some examples using ddply - look at the column names 34#' ddply(mtcars, "cyl", each(nrow, ncol)) 35#' ddply(mtcars, ~ cyl, each(nrow, ncol)) 36#' ddply(mtcars, .(cyl), each(nrow, ncol)) 37#' ddply(mtcars, .(log(cyl)), each(nrow, ncol)) 38#' ddply(mtcars, .(logcyl = log(cyl)), each(nrow, ncol)) 39#' ddply(mtcars, .(vs + am), each(nrow, ncol)) 40#' ddply(mtcars, .(vsam = vs + am), each(nrow, ncol)) 41. <- function(..., .env = parent.frame()) { 42 structure(as.list(match.call()[-1]), env = .env, class="quoted") 43} 44 45is.quoted <- function(x) inherits(x, "quoted") 46 47#' Print quoted variables. 48#' 49#' Display the \code{\link{str}}ucture of quoted variables 50#' 51#' @keywords internal 52#' @export 53print.quoted <- function(x, ...) utils::str(x) 54 55#' Compute names of quoted variables. 56#' 57#' Figure out names of quoted variables, using specified names if they exist, 58#' otherwise converting the values to character strings. This may create 59#' variable names that can only be accessed using \code{``}. 60#' 61#' @keywords internal 62#' @export 63names.quoted <- function(x) { 64 deparse2 <- function(x) paste(deparse(x), collapse = "") 65 part_names <- unlist(lapply(x, deparse2)) 66 user_names <- names(unclass(x)) 67 68 if (!is.null(user_names)) { 69 part_names[user_names != ""] <- user_names[user_names != ""] 70 } 71 72 unname(part_names) 73} 74 75#' Evaluate a quoted list of variables. 76#' 77#' Evaluates quoted variables in specified environment 78#' 79#' @return a list 80#' @keywords internal 81#' @param expr quoted object to evalution 82#' @param try if TRUE, return \code{NULL} if evaluation unsuccesful 83#' @export 84eval.quoted <- function(exprs, envir = NULL, enclos = NULL, try = FALSE) { 85 if (is.numeric(exprs)) return(envir[exprs]) 86 87 if (!is.null(envir) && !is.list(envir) && !is.environment(envir)) { 88 stop("envir must be either NULL, a list, or an environment.") 89 } 90 91 qenv <- if (is.quoted(exprs)) attr(exprs, "env") else parent.frame() 92 if (is.null(envir)) envir <- qenv 93 if (is.data.frame(envir) && is.null(enclos)) enclos <- qenv 94 95 if (try) { 96 results <- lapply(exprs, failwith(NULL, eval, quiet = TRUE), 97 envir = envir, enclos = enclos) 98 } else { 99 results <- lapply(exprs, eval, envir = envir, enclos = enclos) 100 } 101 names(results) <- names(exprs) 102 103 results 104} 105 106#' Convert input to quoted variables. 107#' 108#' Convert characters, formulas and calls to quoted .variables 109#' 110#' This method is called by default on all plyr functions that take a 111#' \code{.variables} argument, so that equivalent forms can be used anywhere. 112#' 113#' Currently conversions exist for character vectors, formulas and 114#' call objects. 115#' 116#' @return a list of quoted variables 117#' @seealso \code{\link[=quoted]{.}} 118#' @param x input to quote 119#' @param env environment in which unbound symbols in expression should be 120#' evaluated. Defaults to the environment in which \code{as.quoted} was 121#' executed. 122#' @export 123#' @examples 124#' as.quoted(c("a", "b", "log(d)")) 125#' as.quoted(a ~ b + log(d)) 126as.quoted <- function(x, env = parent.frame()) UseMethod("as.quoted") 127 128#' @export 129as.quoted.call <- function(x, env = parent.frame()) { 130 structure(as.list(x)[-1], env = env, class = "quoted") 131} 132 133#' @export 134as.quoted.character <- function(x, env = parent.frame()) { 135 structure( 136 lapply(x, function(x) parse(text = x)[[1]]), 137 env = env, class = "quoted" 138 ) 139} 140 141#' @export 142as.quoted.numeric <- function(x, env = parent.frame()) { 143 structure(x, env = env, class = c("quoted", "numeric")) 144} 145 146#' @export 147as.quoted.formula <- function(x, env = parent.frame()) { 148 simplify <- function(x) { 149 if (length(x) == 2 && x[[1]] == as.name("~")) { 150 return(simplify(x[[2]])) 151 } 152 if (length(x) < 3) return(list(x)) 153 op <- x[[1]]; a <- x[[2]]; b <- x[[3]] 154 155 if (op == as.name("+") || op == as.name("*") || op == as.name("~")) { 156 c(simplify(a), simplify(b)) 157 } else if (op == as.name("-")) { 158 c(simplify(a), bquote(-.(x), list(x=simplify(b)))) 159 } else { 160 list(x) 161 } 162 } 163 164 structure(simplify(x), env = env, class = "quoted") 165} 166 167#' @export 168as.quoted.quoted <- function(x, env = parent.frame()) x 169 170#' @export 171as.quoted.NULL <- function(x, env = parent.frame()) { 172 structure(list(), env = env, class = "quoted") 173} 174 175#' @export 176as.quoted.name <- function(x, env = parent.frame()) { 177 structure(list(x), env = env, class = "quoted") 178} 179 180#' @export 181as.quoted.factor <- function(x, env = parent.frame()) { 182 as.quoted(as.character(x), env) 183} 184 185#' @export 186c.quoted <- function(..., recursive = FALSE) { 187 structure(NextMethod("c"), class = "quoted", 188 env = attr(list(...)[[1]], "env")) 189} 190 191#' @export 192"[.quoted" <- function(x, i, ...) { 193 structure(NextMethod("["), env = attr(x, "env"), class = "quoted") 194} 195