File: arithmetic.R

package info (click to toggle)
r-cran-patchwork 1.3.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 6,640 kB
  • sloc: sh: 15; makefile: 2
file content (143 lines) | stat: -rw-r--r-- 4,762 bytes parent folder | download
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
#' Plot arithmetic
#'
#' In addition to the `+` operator known in `ggplot2`, `patchwork` defines logic
#' for some of the other operators that aids in building up your plot
#' composition and reduce code-reuse.
#'
#' @details
#' `patchwork` augment the `+` operator from `ggplot2` and allows the user to
#' add full `ggplot` objects together in order to compose them into the same
#' view. The last added plot is always the active one where new geoms etc. are
#' added to. Another operator that is much like it, but not quite, is `-`. It
#' also adds plots together but instead of adding the right hand side to the
#' patchwork defined in the left hand side, it puts the left hand side besides
#' the right hand side in a patchwork. This might sound confusing, but in
#' essence `-` ensures that the right and left side are put in the same nesting
#' level (`+` puts the right side *into* the left side). Using `-` might seem
#' unintuitive if you think of the operator as "subtract", but look at it as a
#' hyphen instead (the underlying reason is that `-` is the only operator in the
#' same precedence group as `+`). An alternative and more explicit way to get
#' the same effect as `-` is to use `merge()` on the left hand side.
#'
#' Often you are interested in creating single column or single row layouts.
#' `patchwork` provides `|` (besides) and `/` (over) operators to support
#' stacking and packing of plots. See the examples for their use.
#'
#' In order to reduce code repetition `patchwork` provides two operators for
#' adding ggplot elements (geoms, themes, facets, etc.) to multiple/all plots in
#' a patchwork. `*` will add the element to all plots in the current nesting
#' level, while `&` will recurse into nested patches.
#'
#' @param e1 A `ggplot` or `patchwork` object
#' @param e2 A `ggplot` or `patchwork` object in case of `/`, or a `gg` object
#' such as a geom or theme specification in case of `*` and `&`
#'
#' @return A `patchwork` object
#'
#' @name plot_arithmetic
#' @rdname plot_arithmetic
#'
#' @examples
#' library(ggplot2)
#'
#' p1 <- ggplot(mtcars) + geom_point(aes(mpg, disp))
#' p2 <- ggplot(mtcars) + geom_boxplot(aes(gear, disp, group = gear))
#' p3 <- ggplot(mtcars) + geom_bar(aes(gear)) + facet_wrap(~cyl)
#' p4 <- ggplot(mtcars) + geom_bar(aes(carb))
#'
#' # Standard addition vs division
#' p1 + p2 + p3 + plot_layout(ncol = 1)
#' p1 + p2 - p3 + plot_layout(ncol = 1)
#'
#' # Stacking and packing
#' (p1 | p2 | p3) /
#'       p4
#'
#' # Add elements to the same nesting level
#' (p1 + (p2 + p3) + p4 + plot_layout(ncol = 1)) * theme_bw()
#'
#' # Recurse into nested plots as well
#' (p1 + (p2 + p3) + p4 + plot_layout(ncol = 1)) & theme_bw()
#'
NULL

#' @importFrom grid is.grob
#' @rdname plot_arithmetic
#' @export
"-.ggplot" <- function(e1, e2) {
  if (is.null(e2)) return(e1)
  if (is.null(e1)) return(e2)
  if (should_autowrap(e2)) e2 <- wrap_elements(full = e2)
  if (!is.ggplot(e2)) cli_abort("Only knows how to fold ggplot objects together")
  patchwork <- new_patchwork()
  if (is_patchwork(e2)) {
    plot <- plot_filler()
    patchwork$plots <- list(e1, e2)
  } else {
    plot <- e2
    patchwork$plots <- list(e1)
  }
  add_patches(plot, patchwork)
}
#' @importFrom grid is.grob
#' @rdname plot_arithmetic
#' @export
"/.ggplot" <- function(e1, e2) {
  if (is.null(e2)) return(e1)
  if (is.null(e1)) return(e2)
  if (should_autowrap(e2)) e2 <- wrap_elements(full = e2)
  if (!is_patchwork(e1)) {
    e1 + e2 + plot_layout(ncol = 1)
  } else if (!is.null(e1$patches$layout$ncol) && e1$patches$layout$ncol == 1) {
    e1 + e2
  } else {
    e1 - e2 + plot_layout(ncol = 1)
  }
}
#' @importFrom grid is.grob
#' @rdname plot_arithmetic
#' @export
"|.ggplot" <- function(e1, e2) {
  if (is.null(e2)) return(e1)
  if (is.null(e1)) return(e2)
  if (should_autowrap(e2)) e2 <- wrap_elements(full = e2)
  if (!is_patchwork(e1)) {
    e1 + e2 + plot_layout(nrow = 1)
  } else if (!is.null(e1$patches$layout$nrow) && e1$patches$layout$nrow == 1) {
    e1 + e2
  } else {
    e1 - e2 + plot_layout(nrow = 1)
  }
}
#' @rdname plot_arithmetic
#' @export
"*.gg" <- function(e1, e2) {
  if (is.null(e2)) return(e1)
  if (is_patchwork(e1)) {
    e1$patches$plots <- lapply(e1$patches$plots, function(p) {
      if (!is_patchwork(p)) p <- p + e2
      p
    })
  }
  e1 + e2
}
#' @rdname plot_arithmetic
#' @importFrom ggplot2 is.theme
#' @export
"&.gg" <- function(e1, e2) {
  if (is.null(e2)) return(e1)
  if (is_patchwork(e1)) {
    if (is.theme(e2)) {
      e1$patches$annotation$theme <- e1$patches$annotation$theme + e2
    }
    e1$patches$plots <- lapply(e1$patches$plots, function(p) {
      if (is_patchwork(p)) {
        p <- p & e2
      } else {
        p <- p + e2
      }
      p
    })
  }
  e1 + e2
}