R/search_design.R

In JedStephens/ExpertChoice: Design of Discrete Choice and Conjoint Analysis

#' Search Full Factorial for Fractional Factorial Design
#'
#' @description Returns a consistent fractional factorial design from the input fractional factorial design. The key advantage of this function is that it ensures factors are coded and enchances the attributes of the output.
#'
#' @param full_factorial a `data.table` generated by the `full_factorial` function
#' @param fractional_factorial_design a means of creating a fractional design using either orthogonal arrays or Federov. See the tutorial for examples.
#'
#' @return a `data.frame` with only the rows of your chosen fractional factorial design.
#' @export
#'
#' @examples
#' # The use of this function depends on what the input to the argument fractional_factorial_design
#' # will be. See Step 4 of Practical Introduction to ExpertChoice vignette.
#'
#' # Step 1
#' attrshort  = list(condition = c("0", "1", "2"),
#' technical =c("0", "1", "2"),
#' provenance = c("0", "1"))
#'
#' #Step 2
#' # ff stands for "full fatorial"
#'  ff  <-  full_factorial(attrshort)
#'  af  <-  augment_levels(ff)
#' # af stands for "augmented factorial"
#'
#' # Step 3
#' # Choose a design type: Federov or Orthogonal. Here an Orthogonal one is used.
#' nlevels <- unlist(purrr::map(ff, function(x){length(levels(x))}))
#' fractional_factorial <- DoE.base::oa.design(nlevels = nlevels, columns = "min34")
#'
#' # Step 4! - The search_design function.
#' # The functional draws out the rows from the original augmented full factorial design.
#' colnames(fractional_factorial) <- colnames(ff)
#' fractional <- search_design(ff, fractional_factorial)


search_design <- function(full_factorial, fractional_factorial_design) {
  if (any(c("oa", "design") %in% class(fractional_factorial_design))) {
    # The objects of class oa and design use 1 to mark the base level. Subtracing 1 places all factors at base of zero.
    # The input needs to be coerced into another form...
    fractional_factorial_design <- dplyr::mutate_all(dplyr::as_tibble(fractional_factorial_design), as.integer) - (1 - attr(full_factorial, "factor_base_level"))
    #return(fractional_factorial_design)
  }
  # The reason that the arugments are coerced into a tibble is to remove attributes of the input types which muck with this function.
  whole_index <- duplicated(rbind(
    dplyr::as_tibble(fractional_factorial_design),
    dplyr::as_tibble(full_factorial)
  ))
  # return(whole_index)
  # Start by keeping all
  keeping_index <- rep(TRUE, length(whole_index))
  # Then remove the rows that came in the factorial design.
  keeping_index[1:nrow(fractional_factorial_design)] <- FALSE

  row_index <- whole_index[keeping_index]
  out <- full_factorial[row_index, ]

  # Add X_main
  attr(out, "X_main") <- stats::model.matrix(stats::as.formula(
    paste("", paste(attributes(out)$names, collapse = " + "), sep = " ~ ")
  ), out)

  # Add check key
  attr(out, "searched") <- TRUE
  return(dplyr::as_tibble(out))
}