R/memory_chunk_size.R

In opdisDownsampling: Optimal Distribution Preserving Down-Sampling of Bio-Medical Data

#' Calculate Optimal Chunk Size for Memory-Efficient Processing
#'
#' This internal helper determines an appropriate chunk size for processing
#' downsampling trials based on data dimensions, available memory, and the
#' number of worker processes.
#'
#' @param n_rows Number of rows in the dataset.
#' @param n_cols Number of columns in the dataset, excluding the class column.
#' @param nTrials Total number of trials to process.
#' @param nProc Number of processor cores available.
#'
#' @return An integer representing the selected chunk size.
#'
#' @details The function considers:
#' \itemize{
#'   \item estimated data size and temporary memory use per trial,
#'   \item available system memory on Linux systems,
#'   \item the number of processor cores,
#'   \item the trade-off between memory use and processing overhead.
#' }
#'
#' @keywords internal
calculate_optimal_chunk_size <- function(n_rows, n_cols, nTrials, nProc) {
  # Calculate data characteristics
  data_size_mb <- (n_rows * n_cols * 8) / (1024^2) # Approximate size in MB (8 bytes per double)

  # Estimate memory usage per trial
  # Each trial creates copies of subsets, so memory scales with data size
  memory_per_trial_mb <- data_size_mb * 1.5 # Factor for temporary objects and operations

  # Get available memory (rough estimate)
  # Try to use at most 25% of available memory for chunking
  available_mem_mb <- tryCatch(
    {
      if (Sys.info()[["sysname"]] == "Linux") {
        # On Linux, try to read from /proc/meminfo
        meminfo <- readLines("/proc/meminfo", n = 3)
        available_line <- meminfo[grep("MemAvailable|MemFree", meminfo)[1]]
        if (length(available_line) > 0) {
          available_mem_kb <- as.numeric(sub(".*?([0-9]+).*", "\\1", available_line))
          available_mem_kb / 1024 * 0.25 # Use 25% of available memory
        } else {
          # Fallback if parsing fails
          max(1000, data_size_mb * 10)
        }
      } else {
        # Fallback for non-Linux systems: assume reasonable amount based on data size
        max(1000, data_size_mb * 10) # At least 1GB or 10x data size
      }
    },
    error = function(e) {
      # If memory detection fails, use conservative estimate
      max(1000, data_size_mb * 5)
    }
  )

  # Calculate optimal chunk size based on memory constraints
  if (memory_per_trial_mb > 0) {
    max_parallel_trials <- max(1, floor(available_mem_mb / (memory_per_trial_mb * nProc)))
    JobSize_memory <- min(nTrials, max_parallel_trials)
  } else {
    JobSize_memory <- 50 # Default fallback
  }

  # Balance memory constraints with computational efficiency
  JobSize <- if (nTrials <= 10) {
    nTrials # Process all small jobs at once
  } else if (nTrials <= 50) {
    max(10, min(JobSize_memory, nTrials))
  } else if (nTrials <= 500) {
    # Medium datasets: balance between memory and overhead
    max(20, min(JobSize_memory, ceiling(nTrials / max(2, nProc))))
  } else {
    # Large datasets: prioritize memory efficiency
    if (data_size_mb > 500) { # Large data (>500MB)
      max(10, min(25, JobSize_memory))
    } else if (data_size_mb > 100) { # Medium data (100-500MB)
      max(20, min(50, JobSize_memory))
    } else { # Smaller data (<100MB)
      max(50, min(100, JobSize_memory))
    }
  }

  # Ensure JobSize is reasonable
  JobSize <- max(1, min(JobSize, nTrials))

  return(JobSize)
}

#' Print Chunk Size Diagnostics
#'
#' Internal helper for printing diagnostic information about chunk-size selection.
#' This is used when \code{verbose = TRUE}.
#'
#' @param n_rows Number of rows in the dataset.
#' @param n_cols Number of columns in the dataset, excluding the class column.
#' @param nTrials Total number of trials.
#' @param JobSize Selected chunk size.
#' @param verbose Logical, whether to print diagnostics.
#'
#' @return Invisible \code{NULL}.
#'
#' @keywords internal
print_chunk_diagnostics <- function(n_rows, n_cols, nTrials, JobSize, verbose = FALSE) {
  if (verbose) {
    data_size_mb <- (n_rows * n_cols * 8) / (1024^2)
    memory_per_trial_mb <- data_size_mb * 1.5
    n_chunks <- ceiling(nTrials / JobSize)

    message(sprintf("Chunk size diagnostics:"))
    message(sprintf("  Data: %d rows x %d cols (%.1f MB)", n_rows, n_cols, data_size_mb))
    message(sprintf("  Estimated memory per trial: %.1f MB", memory_per_trial_mb))
    message(sprintf(
      "  Trials: %d, Chunk size: %d, Number of chunks: %d",
      nTrials, JobSize, n_chunks
    ))
  }
  invisible(NULL)
}