geposan/R/analyze.R

#' Analyze genes based on position data.
#'
#' @param preset The preset to use which should be created using [preset()].
#' @param progress A function to be called for progress information. The
#'   function should accept a number between 0.0 and 1.0 for the current
#'   progress. If no function is provided, a simple text progress bar will be
#'   shown.
#' @param include_results Whether to include the detailed results. If this is
#'   set to `FALSE`, only the `scores` are available.
#'
#' @returns An object containing the results of the analysis with the following
#'   items:
#'   \describe{
#'     \item{`preset`}{The preset that was used.}
#'     \item{`scores`}{Table containing all scores for each gene.}
#'     \item{`results`}{Results from the different methods including details.}
#'   }
#'
#' @export
analyze <- function(preset, progress = NULL, include_results = TRUE) {
  if (!inherits(preset, "geposan_preset")) {
    stop("Preset is invalid. Use geposan::preset() to create one.")
  }

  if (is.null(progress)) {
    progress_bar <- progress::progress_bar$new()
    progress_bar$update(0.0)

    progress <- function(progress_value) {
      if (!progress_bar$finished) {
        progress_bar$update(progress_value)
        if (progress_value >= 1.0) {
          progress_bar$terminate()
        }
      }
    }
  }

  progress_buffer <- 0.0
  method_count <- length(preset$methods)

  method_progress <- function(progress_value) {
    progress(progress_buffer + progress_value / method_count)
  }

  scores <- data.table(gene = preset$gene_id)
  results <- list()

  for (method in preset$methods) {
    method_results <- method$func(preset, method_progress)

    scores <- merge(scores, method_results$scores, by = "gene")
    setnames(scores, "score", method$id)

    results <- c(results, list(method_results))

    progress_buffer <- progress_buffer + 1 / method_count
    progress(progress_buffer)
  }

  structure(
    list(
      preset = preset,
      scores = scores,
      results = if (include_results) results else NULL
    ),
    class = "geposan_analysis"
  )
}

#' Print an analysis object.
#'
#' @param x The analysis to print.
#' @param ... Other parameters.
#'
#' @seealso [analyze()]
#'
#' @export
print.geposan_analysis <- function(x, ...) {
  cat("geposan analysis:\n\n")
  print(x$preset)
  cat("\n")

  for (result in x$results) {
    print(result)
    cat("\n")
  }

  invisible(x)
}