@bgicli/bgicli 2.1.1 → 2.2.0

package/data/workflows/experimental-design-statistics/scripts/batch_assignment.R

@@ -0,0 +1,302 @@
+# Batch Assignment Functions
+# Create balanced batch designs preventing confounding
+# Based on: Leek et al. (2010) Nat Rev Genet and osat package
+
+#' Assign samples to batches with optimal balance
+#'
+#' @param metadata Data frame with sample metadata (must include sample IDs)
+#' @param batch_size Number of samples per batch
+#' @param balance_vars Vector of column names to balance across batches
+#' @param sample_id_col Name of sample ID column (default: "sample_id")
+#' @return Data frame with batch assignments added
+#' @export
+#' @examples
+#' # Create sample metadata
+#' metadata <- data.frame(
+#'   sample_id = paste0("S", 1:24),
+#'   condition = rep(c("Control", "Treatment"), each = 12),
+#'   sex = rep(c("M", "F"), 12),
+#'   age_group = rep(c("Young", "Old"), each = 12)
+#' )
+#'
+#' # Generate balanced batch assignment
+#' batch_design <- assign_samples_to_batches(
+#'   metadata = metadata,
+#'   batch_size = 8,
+#'   balance_vars = c("condition", "sex", "age_group")
+#' )
+assign_samples_to_batches <- function(metadata,
+                                      batch_size,
+                                      balance_vars,
+                                      sample_id_col = "sample_id") {
+
+  if (!requireNamespace("OSAT", quietly = TRUE)) {
+    stop("Package 'OSAT' is required. Install with BiocManager::install('OSAT')")
+  }
+
+  # Validate inputs
+  if (!sample_id_col %in% colnames(metadata)) {
+    stop(paste0("Column '", sample_id_col, "' not found in metadata"))
+  }
+
+  missing_vars <- balance_vars[!balance_vars %in% colnames(metadata)]
+  if (length(missing_vars) > 0) {
+    stop(paste0("Balance variables not found in metadata: ", paste(missing_vars, collapse = ", ")))
+  }
+
+  if (batch_size <= 0 || batch_size > nrow(metadata)) {
+    stop("Invalid batch_size: must be positive and <= number of samples")
+  }
+
+  # Calculate number of batches
+  n_batches <- ceiling(nrow(metadata) / batch_size)
+
+  # Prepare data for osat
+  sample_ids <- metadata[[sample_id_col]]
+
+  # Create factor variables for balancing
+  balance_data <- metadata[, balance_vars, drop = FALSE]
+
+  # Convert all balance variables to factors
+  balance_data <- as.data.frame(lapply(balance_data, as.factor))
+
+  # Use osat to generate optimal assignment
+  message("Generating optimal batch assignment...")
+
+  tryCatch({
+    # Run osat optimization
+    osat_result <- OSAT::osat(
+      x = balance_data,
+      batch.size = batch_size,
+      n.batch = n_batches
+    )
+
+    # Extract batch assignments
+    batch_assignments <- osat_result$BatchLabel
+
+    # Add batch column to metadata
+    metadata$batch <- batch_assignments
+
+    # Reorder by batch for convenience
+    metadata <- metadata[order(metadata$batch), ]
+
+    cat("\n✓ Batch design generated successfully!\n")
+    cat(sprintf("  Created %d batches with ~%d samples each\n", n_batches, batch_size))
+    cat(sprintf("  Balanced variables: %s\n", paste(balance_vars, collapse = ", ")))
+
+    return(metadata)
+
+  }, error = function(e) {
+    # If osat fails, use simple randomized block design
+    warning("osat optimization failed. Using randomized block design instead.")
+    return(assign_samples_simple(metadata, batch_size, balance_vars, sample_id_col))
+  })
+}
+
+
+#' Simple randomized block assignment (fallback if osat fails)
+#' @keywords internal
+assign_samples_simple <- function(metadata, batch_size, balance_vars, sample_id_col) {
+
+  n_samples <- nrow(metadata)
+  n_batches <- ceiling(n_samples / batch_size)
+
+  # Stratify by first balance variable (typically condition)
+  primary_var <- balance_vars[1]
+
+  # Sort by primary variable
+  metadata <- metadata[order(metadata[[primary_var]]), ]
+
+  # Assign batches in round-robin fashion to ensure balance
+  batch_assignments <- rep(1:n_batches, length.out = n_samples)
+
+  # Randomize within strata
+  set.seed(123)  # For reproducibility
+  metadata$batch <- sample(batch_assignments)
+
+  # Reorder by batch
+  metadata <- metadata[order(metadata$batch), ]
+
+  message("Simple randomized block assignment complete")
+  return(metadata)
+}
+
+
+#' Generate incomplete block design when complete balance is impossible
+#'
+#' @param metadata Data frame with sample metadata
+#' @param batch_size Number of samples per batch
+#' @param primary_var Primary variable that MUST be balanced (no confounding)
+#' @param secondary_vars Secondary variables to balance as much as possible
+#' @param constraints List of additional constraints
+#' @return Data frame with batch assignments
+#' @export
+incomplete_block_design <- function(metadata,
+                                    batch_size,
+                                    primary_var,
+                                    secondary_vars = NULL,
+                                    constraints = NULL) {
+
+  # Validate that primary variable exists
+  if (!primary_var %in% colnames(metadata)) {
+    stop(paste0("Primary variable '", primary_var, "' not found in metadata"))
+  }
+
+  # Get levels of primary variable
+  primary_levels <- unique(metadata[[primary_var]])
+  n_levels <- length(primary_levels)
+
+  # Check if complete balance is possible
+  min_samples_per_level <- min(table(metadata[[primary_var]]))
+
+  if (batch_size %% n_levels != 0) {
+    message("Batch size not evenly divisible by number of conditions.")
+    message("Creating incomplete block design...")
+  }
+
+  # Ensure each batch has all levels of primary variable
+  n_samples <- nrow(metadata)
+  n_batches <- ceiling(n_samples / batch_size)
+
+  # Create stratified assignment
+  metadata$batch <- NA
+
+  batch_num <- 1
+  samples_in_current_batch <- 0
+
+  # Cycle through conditions
+  while (any(is.na(metadata$batch))) {
+    for (level in primary_levels) {
+      # Find unassigned samples for this level
+      eligible <- which(metadata[[primary_var]] == level & is.na(metadata$batch))
+
+      if (length(eligible) > 0 && samples_in_current_batch < batch_size) {
+        # Assign one sample from this level to current batch
+        metadata$batch[eligible[1]] <- batch_num
+        samples_in_current_batch <- samples_in_current_batch + 1
+
+        if (samples_in_current_batch >= batch_size) {
+          batch_num <- batch_num + 1
+          samples_in_current_batch <- 0
+        }
+      }
+    }
+  }
+
+  message("Incomplete block design created")
+  message(paste0("Primary variable '", primary_var, "' is balanced across batches"))
+
+  return(metadata)
+}
+
+
+#' Generate randomization scheme within batches
+#'
+#' @param batch_metadata Data frame with batch assignments
+#' @param randomize_within Should samples be randomized within batches? (default: TRUE)
+#' @return Data frame with processing order added
+#' @export
+add_processing_order <- function(batch_metadata,
+                                 randomize_within = TRUE) {
+
+  if (!"batch" %in% colnames(batch_metadata)) {
+    stop("Metadata must contain 'batch' column")
+  }
+
+  # Add processing order within each batch
+  batch_metadata$processing_order <- NA
+
+  for (b in unique(batch_metadata$batch)) {
+    batch_rows <- which(batch_metadata$batch == b)
+
+    if (randomize_within) {
+      # Randomize order within batch
+      set.seed(b)  # Different seed per batch for reproducibility
+      processing_order <- sample(batch_rows)
+    } else {
+      # Keep existing order
+      processing_order <- batch_rows
+    }
+
+    batch_metadata$processing_order[batch_rows] <- seq_along(batch_rows)
+  }
+
+  # Add overall processing sequence
+  batch_metadata <- batch_metadata[order(batch_metadata$batch, batch_metadata$processing_order), ]
+  batch_metadata$overall_sequence <- 1:nrow(batch_metadata)
+
+  return(batch_metadata)
+}
+
+
+#' Add plate position assignments to avoid edge effects
+#'
+#' @param batch_metadata Data frame with batch assignments
+#' @param plate_format Plate format (default: "96-well")
+#' @return Data frame with well positions added
+#' @export
+add_plate_positions <- function(batch_metadata,
+                                plate_format = "96-well") {
+
+  if (!"batch" %in% colnames(batch_metadata)) {
+    stop("Metadata must contain 'batch' column")
+  }
+
+  # Define plate dimensions
+  plate_formats <- list(
+    "96-well" = list(rows = 8, cols = 12),
+    "384-well" = list(rows = 16, cols = 24),
+    "48-well" = list(rows = 6, cols = 8)
+  )
+
+  if (!plate_format %in% names(plate_formats)) {
+    stop(paste0("Plate format not recognized. Choose from: ", paste(names(plate_formats), collapse = ", ")))
+  }
+
+  dims <- plate_formats[[plate_format]]
+
+  # Generate well positions (avoid edges)
+  row_letters <- LETTERS[1:dims$rows]
+  col_numbers <- 1:dims$cols
+
+  # Create all positions
+  all_positions <- expand.grid(row = row_letters, col = col_numbers, stringsAsFactors = FALSE)
+  all_positions$well <- paste0(all_positions$row, sprintf("%02d", all_positions$col))
+
+  # Mark edge positions
+  all_positions$is_edge <- (
+    all_positions$row == row_letters[1] |
+    all_positions$row == row_letters[dims$rows] |
+    all_positions$col == 1 |
+    all_positions$col == dims$cols
+  )
+
+  # Assign positions to samples (prefer non-edge)
+  batch_metadata$plate <- NA
+  batch_metadata$well <- NA
+  batch_metadata$is_edge_well <- NA
+
+  plate_num <- 1
+  position_idx <- 1
+
+  # First assign non-edge positions
+  non_edge_positions <- all_positions[!all_positions$is_edge, ]
+
+  for (i in 1:nrow(batch_metadata)) {
+    if (position_idx > nrow(non_edge_positions)) {
+      # Start new plate or use edge positions
+      plate_num <- plate_num + 1
+      position_idx <- 1
+    }
+
+    batch_metadata$plate[i] <- plate_num
+    batch_metadata$well[i] <- non_edge_positions$well[position_idx]
+    batch_metadata$is_edge_well[i] <- FALSE
+    position_idx <- position_idx + 1
+  }
+
+  message(paste0("Assigned samples to ", plate_num, " plates (", plate_format, ")"))
+  message("Avoided edge wells when possible")
+
+  return(batch_metadata)
+}

package/data/workflows/experimental-design-statistics/scripts/batch_validation.R

@@ -0,0 +1,342 @@
+# Batch Design Validation Functions
+# Validate batch assignments to prevent confounding and check balance
+
+#' Internal helper to save plots in both PNG and SVG formats
+#' @param plot ggplot object
+#' @param base_path Base file path (extension will be replaced)
+#' @param width Plot width in inches
+#' @param height Plot height in inches
+#' @param dpi Resolution for PNG
+.save_plot <- function(plot, base_path, width = 8, height = 6, dpi = 300) {
+  # Always save PNG
+  png_path <- sub("\\.(svg|png)$", ".png", base_path)
+  ggplot2::ggsave(png_path, plot = plot, width = width, height = height, dpi = dpi, device = "png")
+  cat("   Saved:", png_path, "\n")
+
+  # Always try SVG - try ggsave first, fall back to svg() device
+  svg_path <- sub("\\.(svg|png)$", ".svg", base_path)
+  tryCatch({
+    ggplot2::ggsave(svg_path, plot = plot, width = width, height = height, device = "svg")
+    cat("   Saved:", svg_path, "\n")
+  }, error = function(e) {
+    # If ggsave fails, try base R svg() device directly
+    tryCatch({
+      svg(svg_path, width = width, height = height)
+      print(plot)
+      dev.off()
+      cat("   Saved:", svg_path, "\n")
+    }, error = function(e2) {
+      cat("   (SVG export failed)\n")
+    })
+  })
+}
+
+#' Check for confounding between batch and condition
+#'
+#' @param batch_assignment Data frame with batch assignments
+#' @param condition_var Name of condition variable column
+#' @param batch_var Name of batch variable column (default: "batch")
+#' @return List with test results and interpretation
+#' @export
+#' @examples
+#' # Check if batch is confounded with condition
+#' # confounding_check <- check_confounding(batch_design, "condition")
+check_confounding <- function(batch_assignment,
+                              condition_var,
+                              batch_var = "batch") {
+
+  # Validate inputs
+  if (!condition_var %in% colnames(batch_assignment)) {
+    stop(paste0("Condition variable '", condition_var, "' not found in data"))
+  }
+
+  if (!batch_var %in% colnames(batch_assignment)) {
+    stop(paste0("Batch variable '", batch_var, "' not found in data"))
+  }
+
+  # Create contingency table
+  cont_table <- table(batch_assignment[[batch_var]], batch_assignment[[condition_var]])
+
+  # Perform chi-square test
+  chi_test <- chisq.test(cont_table)
+
+  # Interpretation
+  is_confounded <- chi_test$p.value < 0.05
+
+  if (is_confounded) {
+    result_message <- paste0(
+      "WARNING: Batch is CONFOUNDED with ", condition_var, "!\n",
+      "Chi-square test p-value: ", format(chi_test$p.value, digits = 4), " < 0.05\n",
+      "This design will not allow separation of batch effects from biological effects.\n",
+      "RECOMMENDATION: Regenerate batch assignment."
+    )
+    status <- "FAILED"
+  } else {
+    result_message <- paste0(
+      "PASS: No confounding detected between batch and ", condition_var, "\n",
+      "Chi-square test p-value: ", format(chi_test$p.value, digits = 4), " > 0.05\n",
+      "Batch effects can be separated from biological effects."
+    )
+    status <- "PASSED"
+  }
+
+  result <- list(
+    status = status,
+    is_confounded = is_confounded,
+    p_value = chi_test$p.value,
+    contingency_table = cont_table,
+    message = result_message,
+    test = chi_test
+  )
+
+  # Print message
+  cat(result_message, "\n")
+
+  return(result)
+}
+
+
+#' Check balance of covariates across batches
+#'
+#' @param batch_assignment Data frame with batch assignments
+#' @param covariates Vector of covariate column names to check
+#' @param batch_var Name of batch variable column (default: "batch")
+#' @return Data frame with balance statistics for each covariate
+#' @export
+#' @examples
+#' # Check balance of sex and age across batches
+#' # balance_check <- check_balance(batch_design, c("sex", "age_group"))
+check_balance <- function(batch_assignment,
+                         covariates,
+                         batch_var = "batch") {
+
+  if (!batch_var %in% colnames(batch_assignment)) {
+    stop(paste0("Batch variable '", batch_var, "' not found in data"))
+  }
+
+  missing_covars <- covariates[!covariates %in% colnames(batch_assignment)]
+  if (length(missing_covars) > 0) {
+    stop(paste0("Covariates not found: ", paste(missing_covars, collapse = ", ")))
+  }
+
+  # Check balance for each covariate
+  balance_results <- data.frame(
+    covariate = character(),
+    chi_square_p = numeric(),
+    is_balanced = logical(),
+    interpretation = character(),
+    stringsAsFactors = FALSE
+  )
+
+  for (covar in covariates) {
+    # Create contingency table
+    cont_table <- table(batch_assignment[[batch_var]], batch_assignment[[covar]])
+
+    # Chi-square test
+    chi_test <- chisq.test(cont_table)
+
+    # Interpret balance (less stringent than confounding check)
+    is_balanced <- chi_test$p.value > 0.05
+
+    if (is_balanced) {
+      interpretation <- "Well balanced"
+    } else if (chi_test$p.value > 0.01) {
+      interpretation <- "Moderately balanced"
+    } else {
+      interpretation <- "Poorly balanced - consider regenerating"
+    }
+
+    balance_results <- rbind(balance_results, data.frame(
+      covariate = covar,
+      chi_square_p = chi_test$p.value,
+      is_balanced = is_balanced,
+      interpretation = interpretation,
+      stringsAsFactors = FALSE
+    ))
+  }
+
+  # Print summary
+  cat("\nCovariate Balance Summary:\n")
+  cat("==========================\n")
+  for (i in 1:nrow(balance_results)) {
+    cat(sprintf("%s: %s (p = %.4f)\n",
+                balance_results$covariate[i],
+                balance_results$interpretation[i],
+                balance_results$chi_square_p[i]))
+  }
+
+  return(balance_results)
+}
+
+
+#' Visualize batch design
+#'
+#' @param batch_assignment Data frame with batch assignments
+#' @param condition_var Name of condition variable
+#' @param batch_var Name of batch variable (default: "batch")
+#' @param output_file Output file path (default: NULL, displays plot)
+#' @export
+visualize_batch_design <- function(batch_assignment,
+                                   condition_var,
+                                   batch_var = "batch",
+                                   output_file = NULL) {
+
+  if (!requireNamespace("ggplot2", quietly = TRUE) || !requireNamespace("ggprism", quietly = TRUE)) {
+    stop("Packages 'ggplot2' and 'ggprism' are required for visualization.")
+  }
+
+  # Create summary table
+  summary_table <- as.data.frame(table(
+    Batch = batch_assignment[[batch_var]],
+    Condition = batch_assignment[[condition_var]]
+  ))
+
+  # Create plot
+  p <- ggplot2::ggplot(summary_table, ggplot2::aes(x = Batch, y = Freq, fill = Condition)) +
+    ggplot2::geom_bar(stat = "identity", position = "dodge") +
+    ggprism::theme_prism() +
+    ggplot2::labs(
+      title = "Batch Design: Samples per Batch by Condition",
+      x = "Batch",
+      y = "Number of Samples",
+      fill = "Condition"
+    ) +
+    ggplot2::theme(
+      legend.position = "right",
+      plot.title = ggplot2::element_text(hjust = 0.5, face = "bold")
+    )
+
+  # Save or display
+  if (!is.null(output_file)) {
+    message("Saving batch design plots:")
+    .save_plot(p, output_file, width = 8, height = 6, dpi = 300)
+  } else {
+    print(p)
+  }
+
+  return(p)
+}
+
+
+#' Generate comprehensive batch validation report
+#'
+#' @param batch_assignment Data frame with batch assignments
+#' @param condition_var Name of condition variable
+#' @param covariates Vector of covariate names (optional)
+#' @param output_file Optional file to save report (markdown format)
+#' @return List with all validation results
+#' @export
+generate_batch_report <- function(batch_assignment,
+                                  condition_var,
+                                  covariates = NULL,
+                                  output_file = NULL) {
+
+  report <- list()
+
+  # 1. Confounding check (CRITICAL)
+  cat("\n=== CRITICAL: Confounding Check ===\n")
+  report$confounding <- check_confounding(batch_assignment, condition_var)
+
+  # 2. Balance checks
+  if (!is.null(covariates)) {
+    cat("\n\n=== Covariate Balance Checks ===\n")
+    report$balance <- check_balance(batch_assignment, covariates)
+  }
+
+  # 3. Sample size summary
+  cat("\n\n=== Sample Size Summary ===\n")
+  report$sample_summary <- as.data.frame(table(
+    Batch = batch_assignment$batch,
+    Condition = batch_assignment[[condition_var]]
+  ))
+  print(report$sample_summary)
+
+  # 4. Overall summary
+  cat("\n\n=== Overall Assessment ===\n")
+  if (report$confounding$status == "PASSED") {
+    cat("✓ PASS: Design is valid (no confounding detected)\n")
+
+    if (!is.null(covariates)) {
+      all_balanced <- all(report$balance$is_balanced)
+      if (all_balanced) {
+        cat("✓ All covariates are well balanced\n")
+      } else {
+        poorly_balanced <- report$balance$covariate[!report$balance$is_balanced]
+        cat("⚠ Some covariates poorly balanced:", paste(poorly_balanced, collapse = ", "), "\n")
+        cat("  Consider: (1) regenerating assignment, or (2) including as covariates in analysis\n")
+      }
+    }
+  } else {
+    cat("✗ FAIL: Design has confounding - DO NOT USE\n")
+    cat("  MUST regenerate batch assignment\n")
+  }
+
+  # Save report if requested
+  if (!is.null(output_file)) {
+    sink(output_file)
+    cat("# Batch Design Validation Report\n\n")
+    cat("Generated:", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), "\n\n")
+    cat("## Confounding Check\n")
+    cat(report$confounding$message, "\n\n")
+    if (!is.null(covariates)) {
+      cat("## Covariate Balance\n")
+      print(report$balance)
+    }
+    sink()
+    message(paste0("Report saved to: ", output_file))
+  }
+
+  return(report)
+}
+
+
+#' Check for recommended metadata to record
+#'
+#' @param batch_assignment Data frame with batch assignments
+#' @return List of recommended metadata fields and which are present
+#' @export
+check_metadata_completeness <- function(batch_assignment) {
+
+  # Recommended metadata fields to always record
+  recommended_fields <- c(
+    "sample_id",
+    "batch",
+    "processing_date",
+    "operator",
+    "reagent_lot",
+    "instrument",
+    "plate",
+    "well",
+    "library_prep_batch",
+    "sequencing_run",
+    "flowcell"
+  )
+
+  # Check which are present
+  present_fields <- recommended_fields[recommended_fields %in% colnames(batch_assignment)]
+  missing_fields <- recommended_fields[!recommended_fields %in% colnames(batch_assignment)]
+
+  cat("\n=== Metadata Completeness Check ===\n")
+  cat("Present fields (", length(present_fields), "/", length(recommended_fields), "):\n", sep = "")
+  cat("  ", paste(present_fields, collapse = ", "), "\n\n")
+
+  if (length(missing_fields) > 0) {
+    cat("Missing recommended fields:\n")
+    cat("  ", paste(missing_fields, collapse = ", "), "\n\n")
+    cat("RECOMMENDATION: Record these fields during sample processing\n")
+    cat("They are essential for:\n")
+    cat("  1. Diagnosing batch effects if detected\n")
+    cat("  2. Batch effect correction (SVA, ComBat)\n")
+    cat("  3. Reproducibility and troubleshooting\n")
+  } else {
+    cat("✓ All recommended metadata fields present\n")
+  }
+
+  result <- list(
+    present = present_fields,
+    missing = missing_fields,
+    completeness = length(present_fields) / length(recommended_fields)
+  )
+
+  return(result)
+}