动态创建函数和表达式

时间:2017-02-21 22:15:50

标签: r function expression eval

我目前正在处理一个问题。我正在为一些特定的发行版开发一个包,其中我想创建一个适合某些数据混合的函数。为此我想使用例如fitdistr函数。问题是我不知道混合物的分布,重量和组分数量。因此,我需要一个能够动态创建某个指定混合的密度函数的函数,以便fitdistr函数可以使用它。例如,如果用户将致电:

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

使用ML方法代码需要创建密度函数

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

因此可以拨打optimfitdistr

一个明显的解决方案是使用大量paste + eval + parse,但我不认为这是最优雅的解决方案。一个很好的解决方案可能隐藏在非标准的评估和表达式操作中,但我在这个问题上没有足够的技能。

P.S。 params可以用作优化器的起始值。

1 个答案:

答案 0 :(得分:3)

在R中使用as.callbquote等函数构建表达式相对简单,并且函数是R中的第一类对象。使用动态签名构建函数有点棘手。这是一个可能有帮助的函数的传递

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
}

请注意,我更改了某些参数的类型。分布应该是字符串。参数应该是命名向量的列表。它适用于这样的调用

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

它返回一个带有x和命名参数列表的函数。你可以称之为

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

返回与

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