R/plan_sample_size.R

In sprtt: Sequential Probability Ratio Tests Toolbox

#' @title Generates HTML reports for sample size planning for sequential ANOVAs.
#'
#' @description
#' `r lifecycle::badge("experimental")`
#'
#' Renders a parameterized R Markdown report that helps plan sample size for the sequential ANOVA.
#' The function takes expected effect size (`f_expected`), number of groups (`k_groups`),
#' the power, and decision rate, then generates a reproducible HTML report summarizing the simulation-based
#' sample size recommendations. The alpha level is always 0.05.
#'
#' The template is located under:
#' `inst/rmarkdown/templates/report_sample_size/skeleton/skeleton.Rmd`.
#'
#' @param f_expected Numeric scalar. The expected standardized effect size (e.g., Cohen's f).
#'   Must be between 0.1 and 0.4 (increments of 0.05).
#' @param k_groups Integer scalar. The number of groups to compare. Must be between 2 and 4.
#' @param beta Numeric scalar (default = 0.05). Desired beta error rate (Type II error).
#'   Possible values are 0.20, 0.10, and 0.05.
#' @param decision_rate Numeric scalar (default = 0.85). Desired chance to reach a decision.
#'   Must be between 0.75 and 0.95 (increments of 0.05).
#' @param output_dir Character string. Directory in which to save the rendered HTML report.
#'   Defaults to a temporary directory (`tempdir()`).
#' @param output_file Character string. File name of the generated HTML report.
#'   Defaults to `"sprtt-report-sample-size-planning.html"`.
#' @param open Logical (default = `interactive()`). If `TRUE`, the generated report is opened
#'   in the system's default web browser after rendering.
#' @param overwrite Logical (default = `FALSE`). If `FALSE` and the target file already exists,
#'   the user is prompted interactively whether to overwrite it. In non-interactive sessions,
#'   an error is raised unless `overwrite = TRUE`.
#'
#' @details
#' This function is a front-end utility for rendering a pre-defined R Markdown report using
#' `rmarkdown::render()`.
#'
#' @return
#' Invisibly returns the path to the rendered HTML file (character string).
#' The report is optionally opened in the default browser.
#'
#' @section File Overwrite Behavior:
#' - If the specified output file already exists:
#'   - and `overwrite = FALSE`, the user is asked whether to overwrite (in interactive sessions);
#'     otherwise, an error is thrown.
#'   - If `overwrite = TRUE`, the file is replaced silently.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' # Generate and open an SPRT sample size planning report:
#' plan_sample_size(
#'   f_expected = 0.25,
#'   k_groups = 3,
#'   decision_rate = 0.9
#' )
#'
#' # Prevent overwriting an existing file:
#' plan_sample_size(0.25, 3, overwrite = FALSE)
#' }
plan_sample_size <- function(f_expected,
                             k_groups,
                             beta = 0.05,
                             decision_rate = 0.85,
                             output_dir = tempdir(),
                             output_file = "sprtt-report-sample-size-planning.html",
                             open = interactive(),
                             overwrite = FALSE) {
  # Basic validation
  stopifnot(length(f_expected) == 1, is.numeric(f_expected))
  stopifnot(length(beta) == 1, is.numeric(beta), beta > 0, beta < 1)
  stopifnot(length(k_groups) == 1, is.numeric(k_groups), k_groups >= 2)

  power <- NULL  # suppress R CMD check note

  # check input parameters
  if (!decision_rate %in% c(0.75, 0.80, 0.85, 0.90, 0.95)) {
    stop(
      glue("`decision_rate` = {decision_rate} is not available. Please choose one of {glue_collapse(shQuote(c(0.75,0.80,0.85,0.90,0.95)), ', ', last = ' or ')}")
    )
  }

  # Load data — may trigger download prompt
  loaded <- load_sample_size_data()
  if (is.null(loaded)) {
    stop(
      "The simulation data is required to generate the report.\n",
      "Please run `download_sample_size_data()` and accept the download.",
      call. = FALSE
    )
  }
  df_all       <- loaded$data
  data_version <- loaded$version
  data_created <- loaded$created

  df <- df_all %>%
    distinct(f_expected, power, k_groups)

  if (!f_expected %in% df$f_expected) {
    stop(
      glue("`f_expected` = {f_expected} is not available. Please choose one of {glue_collapse(shQuote(sort(unique(df$f_expected))), ', ', last = ' or ')}")
    )
  }
  if (!beta %in% c(0.20, 0.10, 0.05)) {
    stop(
      glue("`beta` = {beta} is not available. Please choose one of {glue_collapse(shQuote(c(0.20,0.10,0.05)), ', ', last = ' or ')}")
    )
  }
  if (!k_groups %in% df$k_groups) {
    stop(
      glue("`k_groups` = {k_groups} is not available. Please choose one of {glue_collapse(shQuote(sort(unique(df$k_groups))), ', ', last = ' or ')}")
    )
  }

  # Construct full output path
  output_path <- file.path(output_dir, output_file)

  # Check for existing file
  # Skip overwrite check if the report is meant to be opened immediately
  if (!open && file.exists(output_path)) {
    if (!overwrite) {
      if (interactive()) {
        answer <- utils::menu(c("Yes", "No"),
                              title = sprintf("File '%s' already exists. Overwrite?", output_file)
        )
        if (answer != 1) {
          message("Aborted - file not overwritten.")
          return(invisible(NULL))
        }
      } else {
        stop(sprintf("Output file '%s' already exists. Use overwrite = TRUE to replace it.",
                     output_file),
             call. = FALSE)
      }
    }
  }

  # Locate the Rmd template
  rmd_path <- system.file(
    "rmarkdown", "templates", "report_sample_size", "skeleton", "skeleton.Rmd",
    package = "sprtt", mustWork = TRUE
  )

  # Render the report
  output <- rmarkdown::render(
    rmd_path,
    params = list(
      f_expected   = f_expected,
      beta         = beta,
      k_groups     = k_groups,
      df_all       = df_all,
      decision_rate = decision_rate,
      data_version = data_version,
      data_created = data_created
    ),
    output_file = output_file,
    output_dir  = output_dir,
    envir = new.env(parent = globalenv())
  )

  if (open) utils::browseURL(output)
  invisible(output)
}