Nothing
#' Calculate the probabilities of the design
#'
#' Will take the design object and calculate the probabilities of each
#' alternative and choice tasks.
#'
#' Using Bayesian priors the average across the prior distribution will be used.
#'
#' Using the specific type of model, either the MNL or RPL probs will be
#' returned.
#'
#' @param x An 'spdesign' object.
#'
#' @return A matrix of probabilities for each alternative and choice task.
#'
#' @export
probabilities <- function(x) {
pr_j <- switch(
x$model,
mnl = probabilities_mnl(x)
)
return(
pr_j
)
}
#' Calculate the MNL probabilities
#'
#' @inheritParams probabilities
#'
#' @return A matrix of probabilities for each alternative and choice task. With
#' Bayesian priors the return is the average probabilites over the prior
#' distribution
probabilities_mnl <- function(x) {
db_env <- new.env()
list2env(as.list(as.data.frame(x$design)), envir = db_env)
pr_j <- lapply(x$prior_values, function(p) {
list2env(as.list(p), envir = db_env)
obs_utility <- lapply(update_utility(x$utility), function(v) eval(parse(text = v), envir = db_env))
exp_utility <- lapply(obs_utility, exp)
sum_utility <- Reduce("+", exp_utility)
pr_j <- lapply(exp_utility, function(v) {
v <- v / sum_utility
v[is.na(v)] <- 0
as.vector(v)
})
return(do.call(cbind, pr_j))
})
return(
Reduce("+", pr_j) / length(pr_j)
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.