File: OptPath_plotter.R

package info (click to toggle)
r-cran-paramhelpers 1.14.2-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 992 kB
  • sloc: ansic: 102; sh: 13; makefile: 2
file content (154 lines) | stat: -rw-r--r-- 5,039 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
#' @title Plot method for optimization paths.
#'
#' @description Plot method for every type of optimization path, containing any
#' numbers and types of variables. For every iteration up to 4 types of plots
#' can be generated: One plot for the distribution of points in X and Y space
#' respectively and plots for the trend of specified X variables, Y variables
#' and extra measures over the time.
#'
#' @param op (`OptPath`)\cr
#'   Optimization path.
#' @param iters (`integer` | NULL)\cr
#'   Vector of iterations which should be plotted one after another. If `NULL`,
#'   which is the default, only the last iteration is plotted. Iteration 0 plots
#'   all elements with dob = 0. Note that the plots for iteration i contains all
#'   observations alive in iteration i.
#' @param pause (`logical(1)`)\cr
#'   Should the process be paused after each iteration?
#'   Default is `TRUE`.
#' @template arg_opplotter_lims
#' @param title (`character(1)`)\cr
#'   Main title for the arranged plots, default is Optimization Path Plots.
#' @param ...
#'   Additional parameters for [renderOptPathPlot()].
#' @return NULL
#' @export
#'
plotOptPath = function(op, iters, pause = TRUE, xlim = list(), ylim = list(),
  title = "Optimization Path Plots", ...) {

  requirePackages(c("grid", "gridExtra"), why = "plotOptPath")

  if (missing(iters)) {
    iters = max(getOptPathDOB(op))
  }

  assertClass(op, "OptPath")
  assertIntegerish(iters, lower = 0L, upper = max(getOptPathDOB(op)), any.missing = FALSE)
  assertFlag(pause)
  assertCharacter(title, len = 1L)

  # Set and check x and y lims, if needed
  # Consider only points alive during at least 1 plotted iteration
  # Set and check x and y lims, if needed
  data = getAndSubsetPlotData(op, iters, ...)
  lims = getOptPathLims(xlim, ylim, data$op.x, data$op.y, iters, 0.05)
  xlim = lims$xlim
  ylim = lims$ylim

  # Helper to arrange plot via gridExtra and pause process
  arrangePlots = function(plots, iter, iters) {

    # align plots
    plots = toGTable(plots)
    max.width = getMaxPlotWidth(plots)
    plots = toAlignedGTable(plots, max.width)

    if (!is.null(plots$plot.x.over.time)) {
      plots$plot.x.over.time = gridExtra::arrangeGrob(grobs = plots$plot.x.over.time, ncol = 1L)
    }

    if (!is.null(plots$plot.y.over.time)) {
      plots$plot.y.over.time = gridExtra::arrangeGrob(grobs = plots$plot.y.over.time, ncol = 1L)
    }

    plot.top = Filter(Negate(is.null), list(plots$plot.x, plots$plot.y))
    plot.top = gridExtra::arrangeGrob(grobs = plot.top, nrow = 1L)

    plot.bottom = Filter(Negate(is.null), list(plots$plot.x.over.time, plots$plot.y.over.time))

    if (length(plot.bottom) > 0L) {
      plot.bottom = do.call(gridExtra::arrangeGrob, c(plot.bottom, nrow = 1L))
      plots = list(plot.top, plot.bottom)
    } else {
      plots = list(plot.top)
    }

    gridExtra::grid.arrange(grobs = plots, ncol = 1L, main = title)
    if (pause && iter != getLast(iters)) {
      pause()
    }
  }

  # Get rendered data and plot it for every iteration
  for (iter in iters) {
    plots = renderOptPathPlot(op, iter = iter, xlim = xlim, ylim = ylim, ...)
    arrangePlots(plots, iter, iters)
  }

  return(invisible(NULL))
}

# Helper functions to ensure nice plot alignment.
#
# If plots are aligned in a grid via gridExtra::grid.arrange we are frequently
# faced with the ugly cosmetic problem, that the plot areas are unaligned if
# different plots have different y-axis scales.
#
# The following helper functions ensure nice alignment by doing three things:
# 1) transform ggplot objects to gtable objects.
# 2) extract the maximum left margin width of the gtables as a unit object.
# 3) Assign the maximum left margin width determined in 2) to all gtable
#
# All three functions operate on lists of lists of ggplot objects and can
# handle NULL objects.
#
# NOTE: the alignment procedure fails if there is at least one plot with facets!


# Transform ggplot objects to gtable objects.
#
# @param pls [list of (lists of) ggplot object(s)]
toGTable = function(pls) {
  lapply(pls, function(pl) {
    if (inherits(pl, "ggplot")) {
      return(ggplot2::ggplot_gtable(ggplot2::ggplot_build(pl)))
    }
    if (inherits(pl, "gtable") || is.null(pl)) {
      return(pl)
    }
    return(toGTable(pl))
  })
}

# Determine maximal left margin width of gtables recursively.
#
# @param pls [list of (lists of) gtable object(s)]
getMaxPlotWidth = function(pls) {
  do.call(grid::unit.pmax, lapply(pls, function(pl) {
    if (is.null(pl)) {
      return(pl)
    }
    if (!inherits(pl, "gtable")) {
      return(getMaxPlotWidth(pl))
    }
    return(pl$widths[2:3])
  }))
}

# Set left margin width of gtables recursively.
#
# @param pls [list of (lists of) gtable object(s)]
# @param pls [list of units]
toAlignedGTable = function(pls, max.width) {
  lapply(pls, function(pl) {
    if (is.null(pl)) {
      return(pl)
    }
    if (!inherits(pl, "gtable")) {
      return(toAlignedGTable(pl, max.width))
    }
    pl$widths[2:3] = max.width
    return(pl)
  })
}