Динамическое создание функций и выражений

Question

В настоящее время я имею дело с проблемой. Я работаю над пакетом для некоторых конкретных дистрибутивов, среди прочего, я хотел бы создать функцию, которая будет соответствовать смеси некоторым данным. Для этого я хотел бы использовать, например, функцию 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. параметры могут использоваться как начальные значения для оптимизатора.

Answer 1

Выражения построения относительно прямые в R с функциями, такими как as.call и bquote, и тот факт, что функции являются объектами первого класса в 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