CODEWITHSUNDEEP
rfunctionexpressioneval
K. Keeper
K. Keeper

Reputation: 33

Dynamically creating functions and expressions

I am currently dealing with a problem. I am working on a package for some specific distributions where among other things I would like to create a function that will fit an mixture to some data. For this I would like to use for example the fitdistr function. The problem is that I don't know from what distributions and weights and number of components the mixture will be composed of. Hence I need a function that will dynamically create an density function of some specified mixture so the fitdistr function can use it. For example if the user will call:

fitmix(data,dist=c(norm,chisq),params=list(c(mean=0,sd=3),df=2),wights=c(0.5,0.5))

to use ML method the code needs to create an density function

function(x,mean,sd,df) 0.5*dnorm(x,mean,sd)+0.5*dchisq(x,df)

so it can call optim or fitdistr.

An obvious solution is to use a lot of paste+eval+parse but I don't think this is the most elegant solution. A nice solution is probably hiding somewhere in non-standard evaluation and expression manipulation, but I have not enough skills in this problematic.

P.S. the params can be used as starting values for the optimizer.

Upvotes: 3

Views: 2264

Answers (1)

MrFlick
MrFlick

Reputation: 206232

Building expressions is relatively straight forward in R with functions like as.call and bquote and the fact that functions are first class objects in R. Building functions with dynamic signatures is a bit trickier. Here's a pass at some function that might help

to_params <- function(l) {
    z <- as.list(l)
      setNames(lapply(names(z), function(x) bquote(args[[.(x)]])), names(z))
}

add_exprs <- function(...) {
      x <- list(...)
    Reduce(function(a,b) bquote(.(a) + .(b)), x)
}

get_densities <- function(f) {
    lapply(paste0("d", f), as.name)
}

weight_expr <- function(w, e) {
    bquote(.(w) * .(e))
}
add_params <- function(x, p) {
    as.call(c(as.list(x), p))
}
call_with_x <- function(fn) {
    as.call(list(fn, quote(x)))
} 

fitmix <- function(data, dist, params, weights) {
    fb <- Reduce( add_exprs, Map(function(d, p, w) {
        weight_expr(w, add_params(call_with_x(d), to_params(p)))
    }, get_densities(dist), params, weights))
    f <- function(x, args) {}
    body(f) <- fb
    f
}

Note that I changed the types of some of your parameters. The distributions should be strings. The parameters should be a list of named vectors. It would work with a call like this

ff <- fitmix(data, dist=c("norm","chisq"), params=list(c(mean=0,sd=3),c(df=2)), 
    weights=c(0.5,0.5))

It returns a function that takes an x and a list of named arguments. You could call it like

ff(0, list(mean=3, sd=2, df=2))
# [1] 0.2823794

which returns the same value as

x <- 0
0.5 * dnorm(x, mean = 3, sd = 2) + 0.5 * dchisq(x, df = 2)
# [1] 0.2823794

Upvotes: 4

Related Questions