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: r-help-boun...@r-project.org
> [mailto:r-help-boun...@r-project.org] On Behalf Of
> w...@mtmail.mtsu.edu
> Sent: Sunday, August 01, 2010 8:02 PM
> To: R-help@r-project.org
> 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
>
> ______________________________________________
> R-help@r-project.org 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.
>
______________________________________________
R-help@r-project.org 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.
