R/consolidate_partial_results.R

In CAISEr: Comparison of Algorithms with Iterative Sample Size Estimation

#' Consolidate results from partial files
#'
#' Consolidates results from a set of partial files (each generated by an
#' individual call to [calc_nreps()]) into a single output structure, similar
#' (but not identical) to the output of [run_experiment()]. This is useful
#' e.g., to consolidate the results from interrupted experiments.
#'
#' @param Configuration a named list containing all parameters
#'                      required in a call to [run_experiment()] except
#'                      `instances` and `algorithms`. See the parameter list
#'                      and default values in [run_experiment()]. Notice that
#'                      this is always returned as part of the output structure
#'                      of [run_experiment()], so it generally easier to just
#'                      retrieve it from previously saved results.
#'
#' @param folder folder where the partial files are located.
#'
#' @return a list object containing the following fields:
#' \itemize{
#'    \item \code{data.raw} - data frame containing all observations generated
#'    \item \code{data.summary} - data frame summarizing the experiment.
#'    \item \code{N} - number of instances sampled
#'    \item \code{total.runs} - total number of algorithm runs performed
#'    \item \code{instances.sampled} - names of the instances sampled
#' }
#'
#' @export
#'

consolidate_partial_results <- function(Configuration,
                                        folder = "./nreps_files")
{

  # Error checking
  assertthat::assert_that(is.character(folder),
                          length(folder) == 1)

  # Get filenames from folder
  filenames <- dir(path = normalizePath(folder), pattern = ".rds")

  if(length(filenames) == 0){
    cat("No files to load in folder", normalizePath(folder))
    invisible(-1)
  }

  # Read results from files
  my.results <- vector(mode = "list", length = length(filenames))
  for (i in seq(length(filenames))){
    my.results[[i]] <- readRDS(file = paste0(folder, "/", filenames[i]))
  }

  # Consolidate raw results
  data.raw <- lapply(X   = my.results,
                     FUN = function(x){
                       inst  <- x$instance
                       nj    <- sum(x$Nk)
                       data.frame(Algorithm = do.call(what = c,
                                                      mapply(rep,
                                                             names(x$Nk),
                                                             x$Nk,
                                                             SIMPLIFY = FALSE)),
                                  Instance = rep(inst, nj),
                                  Observation = do.call(c, x$Xk),
                                  stringsAsFactors = FALSE)})

  data.raw <- do.call(rbind, data.raw)

  # Consolidate summary data
  data.summary <- lapply(X   = my.results,
                         FUN = function(x){
                           cbind(Instance = rep(x$instance, nrow(x$Diffk)),
                                 x$Diffk)})

  data.summary <- do.call(rbind, data.summary)

  # ============ Assemble output ============ #
  n.algs        <- length(unique(data.raw$Algorithm))
  n.comparisons <- switch(Configuration$comparisons,
                          all.vs.all   = n.algs * (n.algs - 1) / 2,
                          all.vs.first = n.algs - 1)

  if ("alternative.side" %in% names(Configuration)){
    altsid <- Configuration$alternative.side
  } else {
    altsid <- Configuration$alternative
    if (altsid != "two.sided") altsid <- "one.sided"
  }

  ss.calc <- calc_instances(ncomparisons = n.comparisons,
                            d            = Configuration$d,
                            ninstances   = length(unique(data.raw$Instance)),
                            sig.level    = Configuration$sig.level,
                            alternative.side = altsid,
                            test         = Configuration$test,
                            power.target = Configuration$power.target)

  output <- list(Configuration = Configuration,
                 data.raw      = data.raw,
                 data.summary  = data.summary,
                 N             = length(unique(data.raw$Instance)),
                 N.star        = NA,
                 Underpowered  = NA,
                 total.runs    = nrow(data.raw),
                 instances.sampled = unique(data.raw$Instance),
                 samplesize.calc   = ss.calc)

  # Return output
  class(output) <- c("CAISEr", "list")
  return(output)
}