R/renderOptPathPlot.R

In ParamHelpers: Helpers for Parameters in Black-Box Optimization, Tuning and Machine Learning

#' @title Function for plotting optimization paths.
#'
#' @description
#' Same as [plotOptPath()], but renders the plots for just 1 iteration
#' and returns a list of plots instead of printing the plot. Useful, if you want
#' to extract single plots or to edit the ggplots by yourself.
#'
#' @param op [OptPath]\cr
#'   Optimization path.
#' @param iter (`integer(1)`)\cr
#'   Selected iteration of `x` to render plots for.
#' @param x.over.time (`list` | NULL)\cr
#'   List of vectors of x-variables, either specified via name or id.
#'   If specified via names, also extra measurements from the opt.path can be
#'   selected.
#'   Maximum length for each vector is 5. For each list-element a line-plot iteration versus variable is generated.
#'   If the vector has length > 2 only mean values per iteration are plotted as lines, if vector has length 1 every point is plotted.
#'   Default is to plot all variables into as few plots as possible.
#'   Note that discrete variables are converted to numeric, if specified in the same vector with numerics.
#'   Moreover, if more than 1 point per iteration exists, mean values are calculated.
#'   This is also done for factor variables! We recommend you to specify  this argument in a useful way.
#' @param y.over.time (`list` | NULL)\cr
#'   List of vectors of y-variables, either specified via name or id.
#'   If specified via names, also extra measurements from the opt.path can be selected.
#'   Maximum length for each vector is 5.
#'   For each list-element a line-plot iteration versus variable is generated.
#'   If the vector has length > 2 only mean values per iteration are plotted as lines, if vector has length 1 every point is plotted.
#'   Default is to plot all variables into as few plots as possible.
#'   Note that discrete variables are converted to numeric, if specified in the same vector with numerics.
#'   Moreover, if more than 1 point per iteration exists, mean values are calculated.
#'   This is also done for factor variables! We recommend you to specify  this argument in a useful way.
#' @param contour.name (`character(1)` | NULL)\cr
#'   It is possible to overlay the XSpace plot with an contour plot. This is
#'   only possible, if the XSpace has exact 2 numeric and 0 discrete variable.
#'   Consider subsetting your variables to use this feature! contour.name is the
#'   name of the target variable that will be used for the contour lines.
#'   Default is to use the first target variable, if it is possible to add
#'   contour lines.
#' @template arg_opplotter_lims
#' @param alpha (`logical(1)`)\cr
#'   Activates or deactivates the alpha fading for the plots. Default is `TRUE`.
#' @param log [character]\cr
#'   Vector of variable names. All of this variable logarithmized in every plot.
#'   Default is NULL - no logarithm is applied. Note that, if an variable has
#'   only negative value, it is multiplied with -1. For variables with both
#'   positive and negative values you have to do your own data preprocessing.
#' @param colours (`character(4)`)\cr
#'   Colours of the points/lines for the four point types init, seq, prob and
#'   marked. Default is red for init, blue for seq, green for prob and orange
#'   for marked.
#' @param size.points (`numeric(4)` | NULL)\cr
#'   Size of points in the plot, default is 3.
#' @param size.lines (`numeric(4)` | NULL)\cr
#'   Size of lines in the plots, default is 1.5.
#' @param impute.scale (`numeric(1)`)\cr
#'   Numeric missing values will be replaced by `max + impute.scale * (max - min)`.
#'   Default is `1`.
#' @param impute.value (`character(1)`)\cr
#'   Factor missing values will be replaced by `impute.value`. Default is `missing`.
#' @param scale (`character(1)`)\cr
#'   Parameter `scale` from the function [GGally::ggparcoord()] which is used for
#'   the multiD-case. Default is `std`.
#' @param ggplot.theme
#'   Theme for the ggplots. Can be generated by [ggplot2::theme()]. Default is
#'   `ggplot2::theme(legend.position = "top")`.
#' @param marked (`integer` | `character(1)` | NULL)\cr
#'    \dQuote{best} or indices of points that should be marked in the plots.
#'    If `marked = "best"` the best point for single crit optimization
#'    respectively the pareto front for multi crit optimization is marked.
#'    Default is `NULL` (no points are marked).
#' @param subset.obs [integer]\cr
#'   Vector of indices to subset of observations to be plotted, default is all
#'   observations. All indices must be available in the opt.path. But, to enable
#'   subsetting over multiple iterations, not all indices must be available in
#'   the current iteration. Indices not available in the current iteration will
#'   be ignored. Default is all observations.
#' @param subset.vars (`integer` | `character`)\cr
#'   Subset of variables (x-variables) to be plotted. Either vector of indices
#'   or names. Default is all variables.
#' @param subset.targets (`integer` | `character`)\cr
#'   Subset of target variables (y-variables) to be plotted. Either vector of
#'   indices or names. Default is all variables
#' @param short.x.names [character]\cr
#'   Short names for x variables that are used as axis labels. Note you can
#'   only give shortnames for variables you are using in `subset.vars`
#' @param short.y.names [character]\cr
#'   Short names for y variables that are used as axis labels. Note you can
#'   only give shortnames for variables you are using in `subset.targets`
#' @param short.rest.names [character]\cr
#'   Short names for rest variables that are used as axis labels. Note you can
#'   only give shortnames for variables you are used in `x.over.time`
#'   or `y.over.time`.
#' @return List of plots. List has up to elements:
#'   plot.x: Plot for XSpace. If both X and Y are 1D, Plot for both
#'   plot.y: Plot for YSpace. If both X and Y are 1D, NULL.
#'   plot.x.over.time: List of plots for x over time. Can also be NULL.
#'   plot.y.over.time: List of plots for y over time. Can also be NULL.
#' @export
renderOptPathPlot = function(op, iter, x.over.time, y.over.time, contour.name = NULL,
  xlim = list(), ylim = list(), alpha = TRUE, log = NULL,
  colours = c("red", "blue", "green", "orange"), size.points = 3, size.lines = 1.5, impute.scale = 1,
  impute.value = "missing", scale = "std", ggplot.theme = ggplot2::theme(legend.position = "top"),
  marked = NULL, subset.obs, subset.vars, subset.targets, short.x.names, short.y.names, short.rest.names) {

  requirePackages(c("GGally", "ggplot2"), why = "renderOptPathPlot", default.method = "load")

  iters.max = max(getOptPathDOB(op))
  assertClass(op, "OptPath")
  assertInt(iter, lower = 0L, upper = iters.max)
  assertFlag(alpha)
  assertCharacter(colours, len = 4L)
  assertNumber(size.points)
  assertNumber(size.points)
  assertNumber(impute.scale)
  assertCharacter(impute.value, len = 1L)
  assertChoice(scale, choices = c("std", "robust", "uniminmax", "globalminmax", "center", "centerObs"))
  assertClass(ggplot.theme, classes = c("theme", "gg"))

  if (!is.null(marked)) {
    if (is.character(marked)) {
      if (marked != "best") {
        stop("Marked must either be 'best' or an integerish vector.")
      }
    } else {
      marked = asInteger(marked)
    }
  }

  # Get Plotting Data and extract everything from the helper
  data = getAndSubsetPlotData(op, iter, subset.obs, subset.vars, subset.targets,
    marked, alpha, impute.scale, impute.value)
  op.x = data$op.x
  op.y = data$op.y
  op.rest = data$op.rest
  dob = data$dob
  .alpha = data$.alpha
  .type = data$.type
  x.names = data$x.names
  y.names = data$y.names
  rest.names = data$rest.names
  dim.x = length(data$x.names)
  dim.y = length(data$y.names)


  assertSubset(log, choices = c(x.names, y.names, rest.names))

  # set defaults for the short names in x, y and rest
  if (missing(short.x.names)) {
    short.x.names = x.names
  } else {
    assertCharacter(short.x.names, len = dim.x)
  }

  if (missing(short.y.names)) {
    short.y.names = y.names
  } else {
    assertCharacter(short.y.names, len = dim.y)
  }

  if (missing(short.rest.names)) {
    short.rest.names = rest.names
  } else {
    assertCharacter(short.rest.names, len = length(rest.names))
  }

  # set and check x and y lims, if needed
  lims = getOptPathLims(xlim, ylim, op.x, op.y, iter, 0.05)
  xlim = lims$xlim
  ylim = lims$ylim

  # Set defaults for the over time plots or check the given params
  if (missing(x.over.time)) {
    x.over.time = split(x.names, rep(1:ceiling(dim.x / 5), each = 5,
      length.out = dim.x))
  } else {
    if (!is.null(x.over.time)) {
      if (!is.list(x.over.time)) {
        x.over.time = list(x.over.time)
      }
      assertList(x.over.time)
      for (vec in x.over.time) {
        if (is.character(vec)) {
          assertSubset(x = vec, choices = c(x.names, rest.names), empty.ok = FALSE)
        } else {
          assertNumeric(x = vec, lower = 1L, upper = dim.x, any.missing = FALSE, unique = TRUE)
        }
      }
    }
  }

  if (missing(y.over.time)) {
    y.over.time = split(y.names, rep(1:ceiling(dim.y / 5), each = 5,
      length.out = dim.y))
  } else {
    if (!is.null(y.over.time)) {
      if (!is.list(y.over.time)) {
        y.over.time = list(y.over.time)
      }
      assertList(y.over.time)
      for (vec in y.over.time) {
        if (is.character(vec)) {
          assertSubset(x = vec, choices = c(y.names, rest.names), empty.ok = FALSE)
        } else {
          assertNumeric(x = vec, lower = 1L, upper = dim.y, any.missing = FALSE, unique = TRUE)
        }
      }
    }
  }

  if (!is.null(contour.name)) {
    if (length(x.names) != 2 || any(apply(op.x, 2, class) != "numeric")) {
      stop("Contour lines can only be applied if there are exacr 2 numeric x variables. Consider subsetting your variables.")
    }
    assertChoice(contour.name, y.names)
  } else {
    if (length(x.names) == 2 && all(apply(op.x, 2, class) == "numeric")) {
      contour.name = y.names[1L]
    }
  }


  # get classes of params (numeric or factor)
  classes.x = BBmisc::vcapply(op.x, function(x) class(x))
  classes.y = BBmisc::vcapply(op.y, function(x) class(x))

  # So much for the data and the input, now the plots

  # Special case: X and Y are 1D
  if (dim.x == 1L && dim.y == 1L) {
    pl1 = plot2D(cbind(x = op.x, y = op.y), .alpha, .type, log, names = c(x.names, y.names),
      short.names = c(short.x.names, short.y.names), space = "both", iter = iter,
      classes = c(classes.x, classes.y), xlim = xlim[["XSpace"]], ylim = xlim[["YSpace"]],
      colours = colours, size = size.points, ggplot.theme = ggplot.theme)
    pl2 = NULL
  } else {

    # plot 1: x-space
    if (dim.x == 1L && classes.x == "numeric") {
      pl1 = plot1DNum(op.x, .alpha, .type, log, names = x.names, short.names = short.x.names,
        space = "x", iter = iter, xlim = xlim[["XSpace"]], colours = colours,
        ggplot.theme = ggplot.theme)
    }
    if (dim.x == 1L && classes.x == "factor") {
      pl1 = plot1DDisc(op.x, .alpha, .type, log, names = x.names, short.names = short.x.names,
        space = "x", iter = iter, ylim = ylim[["XSpace"]], colours = colours,
        ggplot.theme = ggplot.theme)
    }

    if (dim.x == 2L) {
      pl1 = plot2D(op.x, .alpha, .type, log, names = x.names, short.names = short.x.names,
        y.name = contour.name, op.y = op.y, space = "x", iter = iter, classes = classes.x, xlim = xlim[["XSpace"]],
        ylim = ylim[["XSpace"]], colours = colours, size = size.points, ggplot.theme = ggplot.theme)
    }
    if (dim.x > 2L) {
      pl1 = plotMultiD(op.x, .alpha, .type, log, names = x.names, short.names = short.x.names,
        space = "x", iter = iter, colours = colours, size = size.lines, scale = scale,
        ggplot.theme = ggplot.theme)
    }

    # plot 2: y-space
    if (dim.y == 1L && classes.y == "numeric") {
      pl2 = plot1DNum(op.y, .alpha, .type, log, names = y.names, short.names = short.y.names,
        space = "y", iter = iter, xlim = xlim[["YSpace"]], colours = colours,
        ggplot.theme = ggplot.theme)
    }
    if (dim.y == 1L && classes.y == "factor") {
      pl2 = plot1DDisc(op.y, .alpha, .type, log, names = y.names, short.names = short.y.names,
        space = "y", iter = iter, ylim = ylim[["YSpace"]], colours = colours,
        ggplot.theme = ggplot.theme)
    }

    if (dim.y == 2L) {
      pl2 = plot2D(op.y, .alpha, .type, log, names = y.names, short.names = short.y.names,
        space = "y", iter = iter, classes = classes.y, xlim = xlim[["YSpace"]],
        ylim = ylim[["YSpace"]], colours = colours, size = size.points, ggplot.theme = ggplot.theme)
    }
    if (dim.y > 2L) {
      pl2 = plotMultiD(op.y, .alpha, .type, log, names = y.names, short.names = short.y.names,
        space = "y", iter = iter, colours = colours, size = size.lines, scale = scale,
        ggplot.theme = ggplot.theme)
    }
  }

  # plot 3: x space over time
  pl3 = vector(mode = "list", length = length(x.over.time))
  for (i in seq_along(x.over.time)) {
    # extract variable information from over.time
    vars = x.over.time[[i]]
    # if specified via character vector, convert to numeric
    if (is.character(vars)) {
      var.inds = which(c(names(op.x), names(op.rest)) %in% vars)
    }
    names = c(x.names, rest.names)[var.inds]
    short.names = c(short.x.names, short.rest.names)[var.inds]

    if (length(vars) == 1) {
      pl3[[i]] = oneVariableOverTime(op = cbind(op.x, op.rest),
        .alpha = .alpha, .type = .type, dob = dob, log = log,
        names = names, short.names = short.names, iter = iter,
        colours = colours, size.points = size.points,
        size.lines = size.lines, ggplot.theme = ggplot.theme)
    } else {
      pl3[[i]] = multiVariablesOverTime(op = cbind(op.x, op.rest), .alpha = .alpha,
        dob = dob, log = log, names = names, short.names = short.names, space = "XSpace",
        iter = iter, colours = colours, ggplot.theme = ggplot.theme)
    }
  }
  if (length(pl3) == 0) {
    pl3 = NULL
  }


  # plot 4: y space over time
  pl4 = vector(mode = "list", length = length(y.over.time))
  for (i in seq_along(y.over.time)) {
    # extract variable information from over.time
    vars = y.over.time[[i]]
    # if specified via character vector, convert to numeric
    if (is.character(vars)) {
      var.inds = which(c(names(op.y), names(op.rest)) %in% vars)
    }
    names = c(y.names, rest.names)[var.inds]
    short.names = c(short.y.names, short.rest.names)[var.inds]

    if (length(vars) == 1) {
      pl4[[i]] = oneVariableOverTime(op = cbind(op.y, op.rest),
        .alpha = .alpha, .type = .type, dob = dob, log = log,
        names = names, short.names = short.names, iter = iter,
        colours = colours, size.points = size.points,
        size.lines = size.lines, ggplot.theme = ggplot.theme)
    } else {
      pl4[[i]] = multiVariablesOverTime(op = cbind(op.y, op.rest), .alpha = .alpha,
        dob = dob, log = log, names = names, short.names = short.names, space = "YSpace",
        iter = iter, colours = colours, ggplot.theme = ggplot.theme)
    }
  }

  if (length(pl4) == 0) {
    pl4 = NULL
  }

  return(list(plot.x = pl1, plot.y = pl2, plot.x.over.time = pl3, plot.y.over.time = pl4))
}