Nothing
#' Evaluate the design candidate
#'
#' The evaluation of the design candidate is independent of the optimization
#' algorithm used.
#'
#' @param utility A utility function
#' @param design_candidate The current design candidate
#' @inheritParams generate_design
#' @inheritParams calculate_efficiency
#'
#' @return A named vector with efficiency criteria of the current design
#' candidate. If Bayesian prior_values are used, then it returns the average
#' error.
evaluate_design_candidate <- function(utility,
design_candidate,
prior_values,
design_env,
model,
dudx,
return_all,
significance) {
# Define x_j for the analytical derivatives
x_j <- define_x_j(utility, design_candidate)
design_candidate_with_names <- x_j
for (i in seq_along(design_candidate_with_names)) {
colnames(design_candidate_with_names[[i]]) <- paste(names(design_candidate_with_names[i]), colnames(design_candidate_with_names[[i]]), sep = "_")
}
# Update the design environment NB! Using design_candidate because we are
# evaluating the expression in context and don't need the interaction cols
list2env(
# c(as.list(as.data.frame(do.call(cbind, define_base_x_j(utility, design_candidate)))),
c(as.list(as.data.frame(do.call(cbind, design_candidate_with_names))),
list(x_j = x_j)),
envir = design_env
)
# Over prior_values to consider bayesian!!!
efficiency_outputs <- lapply(prior_values,
calculate_efficiency,
design_env,
model,
dudx,
return_all,
significance)
# Get the average efficiency criteria (can be extended to allow for medians)
efficiency_measures <- matrixStats::colMeans2(
do.call(rbind, lapply(efficiency_outputs, function(x) return(x[[1L]]))),
na.rm = TRUE
)
names(efficiency_measures) <- c("a-error", "c-error", "d-error", "s-error")
# Averaging over the variance-covariance matrices to consider Bayesian
dims <- c(rep(length(prior_values[[1]]), 2), length(efficiency_outputs))
design_vcov <- array(unlist(lapply(efficiency_outputs, function(x) return(x[[2L]]))), dims)
design_vcov <- rowMeans(design_vcov, na.rm = TRUE, dims = 2)
dimnames(design_vcov) <- list(names(prior_values[[1]]), names(prior_values[[1]]))
return(
list(
efficiency_measures = efficiency_measures,
vcov = design_vcov
)
)
}
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.