R/plot_moead.R

In MOEADr: Component-Wise MOEA/D Implementation

#' plot.moead
#'
#' S3 method for plotting _moead_ objects (the output of [moead()]).
#'
#' @param x list object of class _moead_
#'                     (generated by [moead()])
#' @param useArchive logical flag to use information from `x$Archive`.
#'                   Only used if x$Archive is not `NULL`.
#' @param feasible.only logical flag to use only feasible points in the plots.
#' @param viol.threshold threshold of tolerated constraint violation, used to
#'                       determine feasibility if `feasible.only == TRUE`.
#' @param nondominated.only logical flag to use only nondominated points in the
#'                          plots.
#' @param plot.weights logical flag to plot the weight vectors for 2 and
#'                     3-objective problems.
#' @param which.objectives integer vector of which objectives to plot.
#'                         Defaults to `NULL` (use all objectives)
#' @param color.by.obj integer, determines which objective is used as the basis
#'                     for coloring the parallel coordinates plot.
#' @param suppress.pause logical flag to prevent pause messages from being show after every image.
#'                         Defaults to `FALSE` (show pause messages)
#' @param ... other parameters to be passed down to specific plotting functions (currently unused)
#'
#' @examples
#' problem.1 <- list(name = "example_problem",
#'                   xmin = rep(-1,30),
#'                   xmax = rep(1,30),
#'                   m    = 2)
#' out <- moead(preset    = preset_moead("original2"),
#'              problem   = problem.1,
#'              stopcrit  = list(list(name = "maxiter",
#'                                    maxiter = 100)),
#'              showpars  = list(show.iters = "dots",
#'                               showevery  = 10))
#' plot(out, suppress.pause = TRUE)
#'
#' @export
#'
#' @section References:
#' F. Campelo, L.S. Batista, C. Aranha (2020): The {MOEADr} Package: A
#' Component-Based Framework for Multiobjective Evolutionary Algorithms Based on
#' Decomposition. Journal of Statistical Software \doi{10.18637/jss.v092.i06}\cr
#'
plot.moead <- function(x,
                       ...,
                       useArchive        = FALSE,
                       feasible.only     = TRUE,
                       viol.threshold    = 1e-6,
                       nondominated.only = TRUE,
                       plot.weights      = FALSE,
                       which.objectives  = NULL,
                       suppress.pause    = FALSE,
                       color.by.obj      = 1)
  {

  # Error checking
  assertthat::assert_that(
    "moead" %in% class(x),
    is.logical(useArchive),
    is.logical(feasible.only),
    is.logical(nondominated.only),
    is.logical(plot.weights),
    is.numeric(viol.threshold) && viol.threshold >= 0,
    is.numeric(color.by.obj),
    color.by.obj %in% seq(1, ncol(x$Y)),
    is.null(which.objectives) || all(which.objectives > 0),
    is.null(which.objectives) || all(which.objectives == round(which.objectives)))

  # ===========================================================================
  # Preprocess data for plotting

  Y <- x$Y
  X <- x$X
  V <- x$V
  W <- x$W

  if(useArchive && !is.null(x$Archive)){
    Y <- x$Archive$Y
    X <- x$Archive$X
    V <- x$Archive$V
  }

  if(feasible.only && !is.null(V)){
    feas.indx <- rowSums(V$Vmatrix > viol.threshold) == 0
    Y         <- Y[feas.indx, ]
    X         <- X[feas.indx, ]

    V$Cmatrix <- V$Cmatrix[feas.indx, ]
    V$Vmatrix <- V$Vmatrix[feas.indx, ]
    V$v       <- V$v[feas.indx]
  }

  if(nondominated.only){
    nd.indx   <- find_nondominated_points(Y)
    Y         <- Y[nd.indx, ]
    X         <- X[nd.indx, ]

    if(!is.null(V)){
      V$Cmatrix <- V$Cmatrix[nd.indx, ]
      V$Vmatrix <- V$Vmatrix[nd.indx, ]
      V$v       <- V$v[nd.indx]
    }
  }

  if (!is.null(which.objectives)){
    Y <- Y[, which.objectives]
    W <- W[, which.objectives]
  }

  ideal <- apply(Y, 2, min)
  nadir <- apply(Y, 2, max)

  # ===========================================================================
  # Determine what is to be plotted
  nobj <- ncol(Y)

  # for 2-objectives, plot points (+ weights, if needed)
  if (nobj == 2){
    grDevices::dev.hold()
    graphics::plot(Y[, 1], Y[, 2],
                   type = "p",
                   xlab = colnames(Y)[1],
                   ylab = colnames(Y)[2],
                   pch  = 16,
                   main = "Objectives plot",
                   las  = 1)

    if(plot.weights){
      for (i in 1:nrow(W)){
        termpt <- 1.1 * W[i, ] * (nadir - ideal)
        graphics::points(x    = c(ideal[1], termpt[1]),
                         y    = c(ideal[2], termpt[2]),
                         type = "l",
                         lwd  = 0.5)
      }
    }
    grDevices::dev.flush()

    if (!suppress.pause) invisible(readline(prompt = "Press [enter] to continue"))
  }

  # for 3-objectives, plot points (+ weights, if needed - looks bad though)
  if (nobj == 3){
    if("scatterplot3d" %in% rownames(utils::installed.packages())){
      grDevices::dev.hold()
      s3d <- scatterplot3d::scatterplot3d(Y,
                                          pch  = 20,
                                          main = "Objectives plot",
                                          las  = 1)
      if(plot.weights){
        for (i in 1:nrow(W)){
          termpt <- 1.1 * W[i, ] * (nadir - ideal)
          s3d$points3d(x = c(ideal[1], termpt[1]),
                       y = c(ideal[2], termpt[2]),
                       z = c(ideal[3], termpt[3]),
                       type = "l",
                       lwd = 0.5)
        }
      }
      grDevices::dev.flush()
      if (!suppress.pause) invisible(readline(prompt = "Press [enter] to continue"))
    } else {
      cat("Please install package 'scatterplot3d' to generate scatter plot.")
    }
  }


  # for 3+ objectives, plot parallel coordinates and 2-D projections
  if(nobj > 2){
    if("MASS" %in% rownames(utils::installed.packages())){
      grDevices::dev.hold()
      rbPal <- grDevices::colorRampPalette(c('green','purple'))
      cols  <- rbPal(nrow(Y))

      MASS::parcoord(Y[order(Y[, color.by.obj]), ],
                     lwd       = 0.6,
                     var.label = TRUE,
                     col       = cols,
                     main      = "Parallel coordinates plot",
                     las       = 1)
      grDevices::dev.flush()
      if (!suppress.pause) invisible(readline(prompt = "Press [enter] to continue"))
    } else {
      cat("Please install package 'MASS' to generate parallel coordinates plot.")
    }

    grDevices::dev.hold()
    graphics::pairs(Y,
                    upper.panel = NULL,
                    pch         = 20,
                    main        = "2-objective projections")
    grDevices::dev.flush()
  }
  if (!suppress.pause) invisible()
}