R/load_results_dir.R

In thomasWeise/aitoaEvaluate: An R Package for Evaluating the aitoa Results

#' @title Load a Directory with all Results
#' @description Load all the log files in an results directory recursively
#' @param results.dir the results directory
#' @param keep.columns the columns to keep, any vector containing elements
#'   \code{"t"} (for time), \code{"f"} (for the objective value), and
#'   \code{"fes"} (for the consumed FEs)
#' @param make.time.unique should we make the time indices unique (except maybe
#'   for the first and last point)? This makes sense when we want to plot
#'   diagrams over a time axis, as we then have removed redundant points right
#'   away. If \code{make.time.unique==FALSE}, then there may be multiple
#'   improvements at the same time index due to the resolution of the computer
#'   clock (while each improvement will definitely have a unique FE).
#' @param f.must.be.improving \code{true} if the logged objective values must be
#'   strictly improving? This is the default way logs are generated by aitoa.
#'   However, you can also create a log where every single sampled solution is
#'   logged, so then you must set \code{f.must.be.improving=FALSE} to load the
#'   data.
#' @return a list of list of list of data frames, each loaded via
#'   \link{aitoa.load.algo.dir}, where the names are the instance IDs
#' @export aitoa.load.results.dir
#' @include load_algorithm_dir.R
#' @include utils.R
#' @seealso \link{aitoa.load.algo.dir}
aitoa.load.results.dir <- function(results.dir,
                                   keep.columns = c("fes", "t", "f"),
                                   make.time.unique=FALSE,
                                   f.must.be.improving=TRUE) {
  old.options <- options(warn=2);

  stopifnot(!is.null(results.dir),
            is.character(results.dir),
            length(results.dir) == 1L,
            !is.na(results.dir),
            !is.null(keep.columns),
            is.character(keep.columns),
            length(keep.columns) > 0L,
            !any(is.na(keep.columns)),
            !is.null(make.time.unique),
            is.logical(make.time.unique),
            length(make.time.unique) == 1L,
            isTRUE(make.time.unique) || isFALSE(make.time.unique),
            !is.null(f.must.be.improving),
            is.logical(f.must.be.improving),
            length(f.must.be.improving) == 1L,
            isTRUE(f.must.be.improving) || isFALSE(f.must.be.improving));

  keep.columns <- unique(keep.columns);
  stopifnot(length(keep.columns) > 0L,
            all(keep.columns %in% c("fes", "t", "f")));

  results.dir <- .dir.exists(results.dir);
  results.dir <- force(results.dir);
  stopifnot(dir.exists(results.dir));

  algoDirs <- list.dirs(path=results.dir,
                        full.names = TRUE,
                        recursive = FALSE);
  algoDirs <- sort(algoDirs);

  stopifnot(length(algoDirs) > 0L,
            length(unique(algoDirs)) == length(algoDirs));

  data <- lapply(algoDirs, aitoa.load.algo.dir,
                 keep.columns=keep.columns,
                 make.time.unique=make.time.unique,
                 f.must.be.improving=f.must.be.improving);
  stopifnot(length(data) == length(algoDirs));

## verify results
  for(a in data) {
    stopifnot(is.list(a),
              length(a) > 0L);
    for(id in a) {
      stopifnot(is.list(id),
                length(id) > 0L);
      for(r in id) {
        stopifnot(is.data.frame(r),
                  colnames(r) == keep.columns,
                  nrow(r) > 0L);
      }
    }
  }

  algorithms <- vapply(data, function(n) attr(n[[1L]][[1L]], "algorithm"), NA_character_);
  stopifnot(length(algorithms) == length(data),
            length(unique(algorithms)) == length(data),
            all(nchar(algorithms) > 0L));
  names(data) <- algorithms;

  options(old.options);

  return(data);
}