I prefer to treat expressions as language
objects as much as possible instead of converting
them to text strings, using gsub() on the
text strings, and then parsing the modified
text strings.
The following uses text processing to convert
variable names like b3 to calls like b[3] but
otherwise manipulates the language objects
as language objects.
varN2varSubN <- function(expr, varN = all.vars(expr))
{
# In expr, convert non-function names of form "v<number>"
# to subscrip calls of form "v[<number>]".
varSubN <- gsub("([[:digit:]]+)$", "[\\1]", varN)
changed <- varSubN != varN
changeList <- lapply(varSubN[changed],
function(x)parse(text=x)[[1]])
names(changeList) <- varN[changed]
do.call(substitute, list(expr, changeList))
}
LHS <- function(expr)
{
stopifnot(is.call(expr) && identical(expr[[1]], as.name("~")))
expr[[2]]
}
RHS <- function(expr)
{
stopifnot(is.call(expr) && identical(expr[[1]], as.name("~")))
expr[[3]]
}
formula2ResidualFunction <- function(expr=parse(text=text), text) {
stopifnot(is.call(expr) && identical(expr[[1]], as.name("~")))
expr <- varN2varSubN (expr)
argNames <- c(all.vars(LHS(expr)), all.vars(RHS(expr)))
args <- lapply(argNames,
function(argName)call("stop", paste("missing argument:",
argName)))
names(args) <- argNames
# above 2 lines are because I don't know how to
# create a function from a list where the arguments
# have no default values.
residualExpr <- call("-", LHS(expr), RHS(expr))
as.function(c(args, list(residualExpr)))
}
E.g.,
> exprtext<-"y~b1/(1+b2*exp(-b3*T))"
> expr <- parse(text=exprtext)[[1]]
> rf <- formula2ResidualFunction(expr)
> rf
function (y = stop("missing argument: y"), b = stop("missing argument:
b"),
T = stop("missing argument: T"))
y - b[1]/(1 + b[2] * exp(-b[3] * T))
Bill Dunlap
Spotfire, TIBCO Software
wdunlap tibco.com
> -----Original Message-----
> From: [email protected]
> [mailto:[email protected]] On Behalf Of
> [email protected]
> Sent: Sunday, August 01, 2010 8:02 PM
> To: [email protected]
> Subject: [R] Convert an expression to a function
>
> Hi John,
>
> Here is my code practicing. Please give me some advises. Thank you.
>
> Wu Gong
>
> # Extract the function string
> f.str <- sub("y~","",exprtext)
> # Get arglist from the text
> sp1 <- paste("\\",c(getGroupMembers(Arith),"(",")"),sep="")
> sp2 <- getGroupMembers(Math)
> sps <- paste(c(sp1,sp2),sep="",collapse="|")
> agl <- gsub("^[0123456789]+$","",strsplit(f.str,sps)[[1]])
> agl.u <- unique(agl[agl != "" & agl != "pi"])
> # The command string making the function
> c.str <- paste("f <-
> function(",paste(agl.u,sep="",collapse=", "),") ",f.str,sep="")
> eval(parse(text=c.str))
> f
>
> ______________________________________________
> [email protected] mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
> http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
______________________________________________
[email protected] mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
