R/set_prior.R

Defines functions gen_prior_like

#prior = alist(ws ~ norm(0, 1), meanlogs ~ norm(10, 5), sdlogs ~ norm(2, 1))
#prior = alist(meanlogs ~ norm(10, 5), sdlogs ~ norm(2, 1))

#' @export
gen_prior_like <- function(prior, pars, lb = -Inf, ub = Inf) {
   distr_name <- lapply(prior, function(x)
       as.list(as.list(x)[[3]])[[1]]
     )

   distr_pars <- lapply(prior, function(x) {
     tmp <- as.list(as.list(x)[[3]])
     tmp[[1]] <- NULL
      tmp
    })

   args_lists <- lapply(distr_name, function(x) as.list(args(get(paste0('d', x)))))

   distr_pars_n <- mapply(function(x, y) {
      y$x <- NULL
      names(x) <- names(y)[1:length(x)]
      x
   },  x = distr_pars, y = args_lists, SIMPLIFY = F)

   distr_pars_n <- mapply(function(x, y) {
     append(list(FUN = as.character(x)), y)
   }, x = distr_name, y = distr_pars_n, SIMPLIFY = F)

   distr_pars_args <- mapply(function(x, y) {
     append(list(x = x, Att = lb, rTrunc = ub), y)
   }, x = pars, y = distr_pars_n, SIMPLIFY = F)

   L <- unlist(lapply(distr_pars_args, function(x) do.call(dtrunc, args = x)))
   sum(log(L))
}
Atan1988/FlexFit documentation built on Jan. 16, 2022, 12:32 a.m.