R/get_attribute.R

In tylermorganwall/skpr: Design of Experiments Suite: Generate and Evaluate Optimal Designs

#'@title Get attribute values
#'
#'@description Returns one or more of underlying attributes used in design generation/evaluation
#'
#'@param output The output of either `gen_design()` or `eval_design()`/`eval_design_mc()``
#'@param attr Default `NULL`. Return just the specific value requested.
#'Potential values are `model.matrix` for model used, `moments.matrix`, `variance.matrix`, `alias.matrix`,
#'`correlation.matrix`, and `model` for the model used in the evaluation/generation of the design.
#'@param round Default `TRUE`. Rounds off values smaller than the magnitude `1e-15`` in the `correlation.matrix` and `alias.matrix` matrix attributes.
#'@return A list of attributes.
#'@export
#'@examples
#'# We can extract the attributes of a design from either the output of `gen_design()`
#'# or the output of `eval_design()`
#'
#'factorialcoffee = expand.grid(cost = c(1, 2),
#'                              type = as.factor(c("Kona", "Colombian", "Ethiopian", "Sumatra")),
#'                              size = as.factor(c("Short", "Grande", "Venti")))
#'
#'designcoffee = gen_design(factorialcoffee, ~cost + size + type, trials = 29,
#'                          optimality = "D", repeats = 100)
#'
#'#Extract a list of all attributes
#'get_attribute(designcoffee)
#'
#'#Get just one attribute
#'get_attribute(designcoffee,"model.matrix")
#'
#'# Extract from `eval_design()` output
#'power_output = eval_design(designcoffee, model = ~cost + size + type,
#'                           alpha = 0.05, detailedoutput = TRUE)
#'
#'get_attribute(power_output,"correlation.matrix")
get_attribute = function(output, attr = NULL, round = TRUE) {
  attr_list = list()
  attr_list[["model.matrix"]] = attr(output, "model.matrix")
  attr_list[["moments.matrix"]] = attr(output, "moments.matrix")
  attr_list[["variance.matrix"]] = attr(output, "variance.matrix")
  if (!is.null(attr(output, "alias.matrix"))) {
    attr_list[["alias.matrix"]] = attr(output, "alias.matrix")
  }
  attr_list[["correlation.matrix"]] = attr(output, "correlation.matrix")
  attr_list[["model"]] = attr(output, "generating.model")
  if (round) {
    attr_list[["correlation.matrix"]][
      abs(attr_list[["correlation.matrix"]]) < 1e-15
    ] = 0
    if (!is.null(attr_list[["alias.matrix"]])) {
      attr_list[["alias.matrix"]][abs(attr_list[["alias.matrix"]]) < 1e-15] = 0
    }
  }

  if (!is.null(attr) && !is.null(attr_list[[attr]])) {
    if (
      !attr %in%
        c(
          "model.matrix",
          "moments.matrix",
          "variance.matrix",
          "alias.matrix",
          "correlation.matrix",
          "model"
        )
    ) {
      stop(
        "skpr: attribute `",
        attr,
        "` not in ",
        paste0(
          c(
            "model.matrix",
            "moments.matrix",
            "variance.matrix",
            "alias.matrix",
            "correlation.matrix",
            "model"
          ),
          collapse = ", "
        )
      )
    }
    return(attr_list[[attr]])
  }
  attr_list
}