# R/expandFun.R In mosaic: Project MOSAIC Statistics and Mathematics Teaching Utilities

#### Documented in expandFun

```#'Expand the left-hand side of a formula
#'
#'Expands the contents of functions used in a formula.
#'
#'@rdname expandFun
#'@name expandFun
#'@aliases expandFun
#'
#'@param formula A mathematical expression (see examples and [plotFun()])
#'
#'@return A list with the new expanded formula and the combined formals
#'
#'
#'@examples
#'f=makeFun(x^2~x)
#'expandFun(f(z)~z) #Returns z^2~z
#' @export

expandFun <- function(formula,...){
exp = lhs(formula)
#See if first operator is a primitive
#Check if first operation is an arithmetic operator
if(is.primitive(eval(exp[[1]]))&&getGroup(toString(exp[[1]]))[[1]]=="Arith"){
##Recursively replace variables
if(class(exp[[2]]) == "call"){
form2 = formula
form2[[2]] = exp[[2]]
lside = Recall(form2)
exp[[2]] = lside\$formula[[2]]
}
if(class(exp[[3]]) == "call"){
form3 = formula
form3[[2]] = exp[[3]]
rside = Recall(form3)
exp[[3]] = rside\$formula[[2]]
}
newcall = paste("(",deparse(exp[[2]]),")",deparse(exp[[1]]),"(",deparse(exp[[3]]),")")
newcall = parse(text = newcall)[[1]]
formula[[2]]=newcall
return(list(formula=formula, formals=
as.pairlist(c(lside\$formals, rside\$formals))))
}
##Save function to somehwere
func =eval(exp[[1]])  # get the function itself
body=body(func)
formals=formals(func)
vars = all.vars(body)

##Replace body with match.call and evaluate to find out which params map to what
fnew = func
body(fnew)=parse(text="as.list(match.call())")
exp[[1]] <- as.name("fnew")
argmap = eval(exp)
#Substitute new variables into the body.
if("{"==class(body)){#If there is more than one call in the function, takes the last call.
body=body[[length(body)]]
}
sformals = deparse(formals)
sbody = deparse(body)
for (pattern in vars) { # loop over the names of the formals
if(!is.null(argmap[[pattern]])){
replacement = deparse(argmap[[pattern]])
sformals = gsub(pattern, replacement, sformals)
replacement = paste("(",replacement,")") #To preserve order of operations
newbody = gsub(pattern,replacement, sbody)
sbody = newbody
}
}
#Substitute lhs of formula for new expression

# old version -- conflicts with changes to formals()
# newbody=parse(text=newbody)
# formula[[2]] = newbody[[1]]
# #update formals
# sformals = strsplit(sformals, "[[\\(\\)]]*")[[1]][2]
# sformals = paste("as.pairlist(alist(", sformals, "))", sep="")
# formals(func) = eval(parse(text=sformals))
# formals=formals(func)

# replacement code
newbody <- parse(text = newbody)
formula[[2]] <- newbody[[1]]
#update formals
sformals <- gsub(pattern = "^as.pairlist\\(alist", replacement = "pairlist", sformals)
sformals <- strsplit(sformals, "[[\\(\\)]]*")[[1]][2]
sformals <- paste("as.pairlist(alist(", sformals, "))", sep="")
formals(func) <- eval(parse(text = sformals))

return(list(formula = formula, formals = formals))
}
```

## Try the mosaic package in your browser

Any scripts or data that you put into this service are public.

mosaic documentation built on Jan. 13, 2019, 1:04 a.m.