### =========================================================================
### Expression objects
### -------------------------------------------------------------------------
###
### Represents a target of the translate() generic.
###
setClassUnion("Expression", "language")
setClass("SimpleExpression",
representation(expr="character"),
prototype(expr=""),
validity=function(object) {
if (!isSingleString(object@expr)) {
"'expr' must be a single, non-NA string"
}
})
setIs("SimpleExpression", "Expression")
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Symbols
###
### We define a Symbol as an atom in a language that refers to a field
### or variable. A specific type of Symbol is mapped to a specific
### type of Promise, which in turn generates a specific type of
### Expression.
###
setClassUnion("Symbol", "name")
setIs("Symbol", "Expression")
setClass("SimpleSymbol",
representation(name="character"),
validity=function(object) {
if (!isSingleString(object@name))
"'name' must be a single, non-NA string"
})
setIs("SimpleSymbol", "Symbol")
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Translation
###
setGeneric("translate", function(x, target, ...) standardGeneric("translate"))
setMethod("translate", c("ANY", "Expression"),
function(x, target, context, ...) {
if (is(x, class(target))) {
return(x)
}
symbolFactory(context) <- SymbolFactory(target, ...)
translation <- eval(x, context)
if (is(translation, "Promise")) {
if (!compatible(context(translation), frame(context))) {
stop("target context incompatible with source context")
}
translation <- expr(translation)
}
as(translation, class(target), strict=FALSE)
})
setClass("SymbolFactory", contains = "function")
setClass("TranslationRequest",
representation(src="Expression",
target="Expression"))
setMethod("translate", c("TranslationRequest", "missing"),
function(x, target, ...) {
translate(x@src, x@target, ...)
})
setMethod("as.character", "TranslationRequest", function(x) as.character(x@src))
setMethod("show", "TranslationRequest", function(object) {
cat("'", as.character(object@src), "' => '", class(object@target),
"'\n", sep="")
})
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Utilities
###
preprocessExpression <- function(expr, env) {
while(!identical(expr, expr <- bquote2(expr, env))) { }
### FIXME: is this .field() thing needed? Could just .(as.name())...?
callsToNames(expr, quote(.field), env)
}
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Coercion
###
setMethod("as.character", "SimpleExpression", function(x) {
x@expr
})
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Show
###
setMethod("show", "Expression", function(object) {
cat(class(object), ": ", as.character(object), "\n", sep="")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.