动态创建函数和表达式
Dynamically creating functions and expressions
我目前正在处理一个问题。我正在为一些特定的发行版开发一个包,其中我想创建一个函数来适应某些数据的混合。为此,我想使用 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)
所以它可以调用 optim
或 fitdistr
。
一个明显的解决方案是使用大量的 paste
+eval
+parse
但我认为这不是最优雅的解决方案。一个很好的解决方案可能隐藏在非标准评估和表达式操作的某个地方,但我在这个问题上的技能不够。
P.S。参数可以用作优化器的起始值。
在 R 中使用 as.call
和 bquote
等函数构建表达式相对简单,而且函数是 R 中的第一个 class 对象。使用动态签名构建函数是一个有点棘手。这是一些可能有帮助的功能
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))
它 returns 一个接受 x
和命名参数列表的函数。你可以这样称呼它
ff(0, list(mean=3, sd=2, df=2))
# [1] 0.2823794
returns 与
的值相同
x <- 0
0.5 * dnorm(x, mean = 3, sd = 2) + 0.5 * dchisq(x, df = 2)
# [1] 0.2823794
我目前正在处理一个问题。我正在为一些特定的发行版开发一个包,其中我想创建一个函数来适应某些数据的混合。为此,我想使用 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)
所以它可以调用 optim
或 fitdistr
。
一个明显的解决方案是使用大量的 paste
+eval
+parse
但我认为这不是最优雅的解决方案。一个很好的解决方案可能隐藏在非标准评估和表达式操作的某个地方,但我在这个问题上的技能不够。
P.S。参数可以用作优化器的起始值。
在 R 中使用 as.call
和 bquote
等函数构建表达式相对简单,而且函数是 R 中的第一个 class 对象。使用动态签名构建函数是一个有点棘手。这是一些可能有帮助的功能
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))
它 returns 一个接受 x
和命名参数列表的函数。你可以这样称呼它
ff(0, list(mean=3, sd=2, df=2))
# [1] 0.2823794
returns 与
的值相同x <- 0
0.5 * dnorm(x, mean = 3, sd = 2) + 0.5 * dchisq(x, df = 2)
# [1] 0.2823794