R/methods.R

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

#'@title Print evaluation information
#'
#'@description Prints design evaluation information below the data.frame of power values
#'
#'Note: If options("skpr.ANSI") is `NULL` or `TRUE`, ANSI codes will be used during printing
#'to prettify the output. If this is `FALSE`, only ASCII will be used.
#'
#'@param x The x of the evaluation functions in skpr
#'@param ... Additional arguments.
#'@import graphics grDevices
#'@export
#'@examples
#'#Generate/evaluate a design and print its information
#'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)
#'
#'eval_design(designcoffee)
print.skpr_eval_output = function(x, ...) {
  class(x) = "data.frame"
  print(x)
  if (
    (is.null(getOption("skpr.ANSI")) || getOption("skpr.ANSI")) &&
      !is_rendering_in_knitr()
  ) {
    boldstart = "\u001b[1m"
    formatend = "\u001b[0m"
    bullet = "\u2022"
  } else {
    boldstart = ""
    formatend = ""
    bullet = "*"
  }
  generate_text = function(label, output) {
    sprintf("%s%s %s = %s%s ", boldstart, bullet, label, formatend, output)
  }

  alphatext = generate_text("Alpha", as.character(attr(x, "alpha")))
  trialtext = generate_text("Trials", nrow(attr(x, "runmatrix")))

  blocking = FALSE
  if (!is.null(attr(x, "blocking"))) {
    blocking = attr(x, "blocking")
  }
  if (!is.null(attr(x, "splitplot"))) {
    blocking = blocking || attr(x, "splitplot")
  }
  x2 = rbind(as.matrix(x), colnames(x))
  row_width_char = max(nchar(rownames(x)))
  x2[is.na(x2)] = "NA"
  total_width = sum(apply(x2, 2, (function(x) max(nchar(x))))) +
    row_width_char +
    length(colnames(x))
  blocktext = generate_text("Blocked", as.character(blocking))
  totalline = paste0(alphatext, trialtext, blocktext)
  designinfo = "Evaluation Info"
  linewidth = total_width
  if (linewidth > nchar(designinfo)) {
    difference = linewidth - nchar(designinfo)
    if (difference %% 2 == 0) {
      firstspacer = difference / 2
      secondspacer = difference / 2
    } else {
      firstspacer = (difference - 1) / 2
      secondspacer = (difference - 1) / 2 + 1
    }
    titlex = paste0(
      c(
        paste0(rep("=", firstspacer), collapse = ""),
        designinfo,
        paste0(rep("=", secondspacer), collapse = "")
      ),
      collapse = ""
    )
    cat(titlex, sep = "\n")
  } else {
    cat(paste0(rep("=", linewidth), collapse = ""), sep = "\n")
  }
  cat(paste0(totalline, collapse = ""), sep = "\n")
  cat(
    generate_text(
      "Evaluating Model",
      paste(as.character(attr(x, "generating.model")), collapse = "")
    ),
    sep = "\n"
  )
  if (all(attr(x, "anticoef") %in% c(-1, 0, 1))) {
    anticoef_str = sprintf(
      "c(%s)",
      paste0(
        unlist(lapply("%1.0f", sprintf, attr(x, "anticoef"))),
        collapse = ", "
      )
    )
    cat(generate_text("Anticipated Coefficients", anticoef_str), sep = "\n")
  } else {
    anticoef_str = sprintf(
      "c(%s)",
      paste0(
        unlist(lapply("%1.3f", sprintf, attr(x, "anticoef"))),
        collapse = ", "
      )
    )
    cat(generate_text("Anticipated Coefficients", anticoef_str), sep = "\n")
  }
  if (!is.null(attr(x, "z.matrix.list")) && blocking) {
    number_blocks = unlist(lapply(attr(x, "z.matrix.list"), ncol))
    block_str = paste(
      paste(
        "Level ",
        seq_len(length(number_blocks)),
        ": ",
        number_blocks,
        sep = ""
      ),
      collapse = ", "
    )
    cat(generate_text("Number of Blocks", block_str), sep = "\n")
  }
  if (!is.null(attr(x, "varianceratios")) && blocking) {
    vr = attr(x, "varianceratios")
    vr_str = paste(paste(
      "Level ",
      seq_len(length(vr)),
      ": ",
      as.character(vr),
      sep = "",
      collapse = ", "
    ))
    cat(generate_text("Variance Ratios ", vr_str), sep = "\n")
  }
  if (!is.null(attr(x, "contrast_string"))) {
    cat(generate_text("Contrasts", attr(x, "contrast_string")), sep = "\n")
  }
  if (!is.null(attr(x, "parameter_analysis_method_string"))) {
    if (nchar(attr(x, "parameter_analysis_method_string")) > 0) {
      cat(
        generate_text(
          "Parameter Analysis Method",
          attr(x, "parameter_analysis_method_string")
        ),
        sep = "\n"
      )
    }
  }
  if (!is.null(attr(x, "effect_analysis_method_string"))) {
    if (nchar(attr(x, "effect_analysis_method_string")) > 0) {
      cat(
        generate_text(
          "Effect Analysis Method",
          attr(x, "effect_analysis_method_string")
        ),
        sep = "\n"
      )
    }
  }
  if (!is.null(attr(x, "mc.conf.int"))) {
    cat(
      generate_text(
        "MC Power CI Confidence",
        sprintf("%0.0f%%", 100 * attr(x, "mc.conf.int"))
      ),
      sep = "\n"
    )
  }
}

#'@title Print evaluation information
#'
#'@description Prints design evaluation information below the data.frame of power values
#'
#'Note: If options("skpr.ANSI") is `NULL` or `TRUE`, ANSI codes will be used during printing
#'to prettify the output. If this is `FALSE`, only ASCII will be used.
#'
#'@param x The x of the evaluation functions in skpr
#'@param ... Additional arguments.
#'@import graphics grDevices
#'@export
#'@examples
#'#Generate/evaluate a design and print its information
#'factorialcoffee = expand.grid(cost = c(1, 2),
#'                               type = as.factor(c("Kona",
#'                                                  "Colombian",
#'                                                  "Ethiopian",
#'                                                  "Sumatra")),
#'                               size = as.factor(c("Short",
#'                                                  "Grande",
#'                                                  "Venti")))
#'
#'coffee_curves = calculate_power_curves(candidateset = factorialcoffee,
#'                                       model = ~(cost + size + type)^2,
#'                                       trials = 30:40, plot_results = FALSE)
#'coffee_curves
print.skpr_power_curve_output = function(x, ...) {
  curve_warn_error = attr(x, "output")
  class(x) = "data.frame"
  print(x)
  if (
    (is.null(getOption("skpr.ANSI")) || getOption("skpr.ANSI")) &&
      !is_rendering_in_knitr()
  ) {
    boldstart = "\u001b[1m"
    formatend = "\u001b[0m"
  } else {
    boldstart = ""
    formatend = ""
  }
  if (!(length(find.package("cli", quiet = TRUE)) > 0)) {
    warning("{cli} package required for color annotations on output")
    col_red = col_blue = col_magenta = col_green = function(x) x
  } else {
    col_red = cli::col_red
    col_blue = cli::col_blue
    col_magenta = cli::col_magenta
    col_green = cli::col_green
  }
  curve_warn_error$gen_errors = unique(curve_warn_error$gen_errors[
    curve_warn_error$gen_errors$err != "",
  ])
  curve_warn_error$gen_warnings = unique(curve_warn_error$gen_warnings[
    curve_warn_error$gen_warnings$warn != "",
  ])
  curve_warn_error$eval_errors = unique(curve_warn_error$eval_errors[
    curve_warn_error$eval_errors$err != "",
  ])
  curve_warn_error$eval_warnings = unique(curve_warn_error$eval_warnings[
    curve_warn_error$eval_warnings$warn != "",
  ])

  unique_gen_errors = table(curve_warn_error$gen_errors$err)
  unique_gen_warnings = table(curve_warn_error$gen_warnings$warn)
  unique_eval_errors = table(curve_warn_error$eval_errors$err)
  unique_eval_warnings = table(curve_warn_error$eval_warnings$warn)
  unique_vals = c(
    unique_gen_errors,
    unique_gen_warnings,
    unique_eval_errors,
    unique_eval_warnings
  )
  if (length(unique_vals) > 0) {
    max_num = max(unique_vals, na.rm = TRUE)
    max_width = max(c(ceiling(log10(max_num)), 1))
    cat(
      sprintf(
        col_red(
          "%sPower curve generation captured the following warning/error messages:%s"
        ),
        boldstart,
        formatend
      ),
      sep = "\n"
    )
    cat(
      sprintf(
        col_blue("%s%0.*s | %.4s | %.*s%s | Message%s"),
        boldstart,
        10,
        "Function        ",
        "Type     ",
        max_width,
        "N",
        paste0(rep(" ", max_width - 1), collapse = ""),
        formatend
      ),
      sep = "\n"
    )
    if (length(unique_gen_errors) > 0) {
      msg_val = names(unique_gen_errors)
      names(unique_gen_errors) = NULL
      for (i in seq_len(length(msg_val))) {
        pad = max_width - nchar(as.character(unique_gen_errors[i]))
        pad_str = ifelse(pad <= 0, "", paste0(rep(" ", pad), collapse = ""))
        cat(
          sprintf(
            "%s%.10s | %.4s | %.*s%s | Message:%s '%s'",
            boldstart,
            "Generation",
            "Err ",
            max_width,
            as.character(unique_gen_errors[i]),
            pad_str,
            formatend,
            col_red(msg_val[i])
          ),
          sep = "\n"
        )
      }
    }
    if (length(unique_gen_warnings) > 0) {
      msg_val = names(unique_gen_warnings)
      names(unique_gen_warnings) = NULL
      for (i in seq_len(length(msg_val))) {
        pad = max_width - nchar(as.character(unique_gen_warnings[i]))
        pad_str = ifelse(pad <= 0, "", paste0(rep(" ", pad), collapse = ""))
        cat(
          sprintf(
            "%s%.10s | %.4s | %.*s%s | Message:%s '%s'",
            boldstart,
            "Generation",
            "Warn",
            max_width,
            as.character(unique_gen_warnings[i]),
            pad_str,
            formatend,
            col_magenta(msg_val[i])
          ),
          sep = "\n"
        )
      }
    }
    if (length(unique_eval_errors) > 0) {
      msg_val = names(unique_eval_errors)
      names(unique_eval_errors) = NULL
      for (i in seq_len(length(msg_val))) {
        pad = max_width - nchar(as.character(unique_eval_errors[i]))
        pad_str = ifelse(pad <= 0, "", paste0(rep(" ", pad), collapse = ""))
        cat(
          sprintf(
            "%s%.10s | %.4s | %.*s%s | Message:%s '%s'",
            boldstart,
            "Evaluation",
            "Err ",
            max_width,
            as.character(unique_eval_errors[i]),
            pad_str,
            formatend,
            col_red(msg_val[i])
          ),
          sep = "\n"
        )
      }
    }
    if (length(unique_eval_warnings) > 0) {
      msg_val = names(unique_eval_warnings)
      names(unique_eval_warnings) = NULL
      for (i in seq_len(length(msg_val))) {
        pad = max_width - nchar(as.character(unique_eval_warnings[i]))
        pad_str = ifelse(pad <= 0, "", paste0(rep(" ", pad), collapse = ""))
        cat(
          sprintf(
            "%s%.10s | %.4s | %.*s%s | Message:%s '%s'",
            boldstart,
            "Evaluation",
            "Warn",
            max_width,
            as.character(unique_eval_warnings[i]),
            pad_str,
            formatend,
            col_magenta(msg_val[i])
          ),
          sep = "\n"
        )
      }
    }
  } else {
    cat(
      sprintf(
        col_green(
          "%sNo errors or warnings encountered during power curve generation!%s"
        ),
        boldstart,
        formatend
      ),
      sep = "\n"
    )
  }
}