├── LICENSE ├── README.md ├── .Rbuildignore ├── NAMESPACE ├── CRAN-SUBMISSION ├── R ├── rlang-imports.R └── waterfall.R ├── cran-comments.md ├── waterfall.Rproj ├── waterfalls.Rproj ├── .gitignore ├── NEWS.md ├── DESCRIPTION ├── .github └── workflows │ └── r.yml └── man └── waterfall.Rd /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2017 2 | COPYRIGHT HOLDER: Hugh Parsonage 3 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # waterfalls 2 | R package to create waterfall charts 3 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^cran-comments\.md$ 4 | ^CRAN-SUBMISSION$ 5 | ^\.github$ 6 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(waterfall) 4 | importFrom(rlang,.data) 5 | -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 1.0.0 2 | Date: 2022-11-20 12:14:13 UTC 3 | SHA: aa4f649fdb718f11646701427bf508d726eb4cb0 4 | -------------------------------------------------------------------------------- /R/rlang-imports.R: -------------------------------------------------------------------------------- 1 | #' Internal rlang imports 2 | #' 3 | #' @keywords internal 4 | #' @importFrom rlang .data 5 | NULL 6 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Test environments 2 | * local Windows install, R 3.4.3 3 | * ubuntu 14.04 (on travis-ci), R 3.4.3 4 | * win-builder (devel) 5 | 6 | ## R CMD check results 7 | 8 | 0 errors | 0 warnings | 0 notes 9 | -------------------------------------------------------------------------------- /waterfall.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageCheckArgs: --as-cran 19 | PackageRoxygenize: rd,collate,namespace 20 | -------------------------------------------------------------------------------- /waterfalls.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageCheckArgs: --as-cran 19 | PackageRoxygenize: rd,collate,namespace 20 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | <<<<<<< HEAD 2 | .Rproj.user 3 | .Rhistory 4 | .RData 5 | .Ruserdata 6 | ======= 7 | # History files 8 | .Rhistory 9 | .Rapp.history 10 | 11 | # Session Data files 12 | .RData 13 | 14 | # Example code in package build process 15 | *-Ex.R 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | 20 | # produced vignettes 21 | vignettes/*.html 22 | vignettes/*.pdf 23 | 24 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 25 | .httr-oauth 26 | >>>>>>> 598fe50fd8d5ee6f24a48bcc23e46f84ac2a5a0d 27 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # waterfalls 1.1.1 2 | 3 | * Replace usage of deprecated `ggplot2::aes_string()` with `ggplot2::aes()` to maintain compatibility with current ggplot2 releases. 4 | 5 | # waterfalls 1.1.0 6 | 7 | * Experimental support for `rect_text_labels_anchor` 8 | * Support for duplicate `labels` thanks to `gregleleu` (#8) 9 | 10 | 11 | # waterfalls 1.0.0 12 | 13 | * Added a `NEWS.md` file to track changes to the package. 14 | * `rect_border` now vectorized thanks to a PR by robert-koetsier. 15 | * Package stable enough for v1.0.0 16 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: waterfalls 2 | Type: Package 3 | Title: Create Waterfall Charts using 'ggplot2' Simply 4 | Version: 1.1.1 5 | Author: Hugh Parsonage 6 | Maintainer: Hugh Parsonage 7 | Description: A not uncommon task for quants is to create 'waterfall charts'. There seems to be no simple way to do this in 'ggplot2' currently. This package contains a single function (waterfall) that simply draws a waterfall chart in a 'ggplot2' object. Some flexibility is provided, though often the object created will need to be modified through a theme. 8 | License: MIT + file LICENSE 9 | URL: https://github.com/hughparsonage/waterfalls 10 | Encoding: UTF-8 11 | Imports: 12 | ggplot2 (>= 2.0.0), 13 | grDevices, 14 | rlang 15 | RoxygenNote: 7.2.0 16 | -------------------------------------------------------------------------------- /.github/workflows/r.yml: -------------------------------------------------------------------------------- 1 | # .github/workflows/R-CMD-check.yaml 2 | name: R-CMD-check 3 | 4 | on: 5 | push: 6 | branches: [main, master] 7 | pull_request: 8 | branches: [main, master] 9 | 10 | jobs: 11 | R-CMD-check: 12 | runs-on: ${{ matrix.config.os }} 13 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 14 | strategy: 15 | fail-fast: false 16 | matrix: 17 | config: 18 | - {os: macos-latest, r: 'release'} 19 | - {os: windows-latest, r: 'release'} 20 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 21 | - {os: ubuntu-latest, r: 'release'} 22 | - {os: ubuntu-latest, r: 'oldrel-1'} 23 | 24 | env: 25 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 26 | R_KEEP_PKG_SOURCE: yes 27 | 28 | steps: 29 | - uses: actions/checkout@v4 30 | 31 | - uses: r-lib/actions/setup-pandoc@v2 32 | 33 | - uses: r-lib/actions/setup-r@v2 34 | with: 35 | r-version: ${{ matrix.config.r }} 36 | http-user-agent: ${{ matrix.config.http-user-agent }} 37 | use-public-rspm: true 38 | 39 | - uses: r-lib/actions/setup-r-dependencies@v2 40 | with: 41 | extra-packages: any::rcmdcheck 42 | needs: check 43 | 44 | - uses: r-lib/actions/check-r-package@v2 45 | with: 46 | upload-snapshots: true 47 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 48 | -------------------------------------------------------------------------------- /man/waterfall.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/waterfall.R 3 | \name{waterfall} 4 | \alias{waterfall} 5 | \title{Create waterfall charts} 6 | \usage{ 7 | waterfall( 8 | .data = NULL, 9 | values, 10 | labels, 11 | rect_text_labels = values, 12 | rect_text_size = 1, 13 | rect_text_labels_anchor = "centre", 14 | put_rect_text_outside_when_value_below = 0.05 * (max(cumsum(values)) - 15 | min(cumsum(values))), 16 | calc_total = FALSE, 17 | total_axis_text = "Total", 18 | total_rect_text = sum(values), 19 | total_rect_color = "black", 20 | total_rect_border_color = "black", 21 | total_rect_text_color = "white", 22 | fill_colours = NULL, 23 | fill_by_sign = TRUE, 24 | rect_width = 0.7, 25 | rect_border = "black", 26 | draw_lines = TRUE, 27 | lines_anchors = c("right", "left"), 28 | linetype = "dashed", 29 | draw_axis.x = "behind", 30 | theme_text_family = "", 31 | scale_y_to_waterfall = TRUE, 32 | print_plot = FALSE, 33 | ggplot_object_name = "mywaterfall" 34 | ) 35 | } 36 | \arguments{ 37 | \item{.data}{a \code{data.frame} containing two columns, one with the values, the other with the labels} 38 | 39 | \item{values}{a numeric vector making up the heights of the rectangles in the waterfall} 40 | 41 | \item{labels}{the labels corresponding to each vector, marked on the x-axis} 42 | 43 | \item{rect_text_labels}{(character) a character vector of the same length as values that are placed on the rectangles} 44 | 45 | \item{rect_text_size}{size of the text in the rectangles} 46 | 47 | \item{rect_text_labels_anchor}{(character) How should \code{rect_text_labels} be positioned? In future releases, we might have support for north or south anchors, or for directed positioning (negative down, positive up) etc. For now, only centre is supported.} 48 | 49 | \item{put_rect_text_outside_when_value_below}{(numeric) the text labels accompanying a rectangle of this height will be placed outside the box: below if it's negative; above if it's positive.} 50 | 51 | \item{calc_total}{(logical, default: \code{FALSE}) should the final pool of the waterfall be calculated (and placed on the chart)} 52 | 53 | \item{total_axis_text}{(character) the text appearing on the axis underneath the total rectangle} 54 | 55 | \item{total_rect_text}{(character) the text in the middle of the rectangle of the total rectangle} 56 | 57 | \item{total_rect_color}{the color of the final rectangle} 58 | 59 | \item{total_rect_border_color}{the border color of the total rectangle} 60 | 61 | \item{total_rect_text_color}{the color of the final rectangle's label text} 62 | 63 | \item{fill_colours}{Colours to be used to fill the rectangles, in order. Disregarded if \code{fill_by_sign} is \code{TRUE} (the default).} 64 | 65 | \item{fill_by_sign}{(logical, default: \code{TRUE}) should positive and negative values each have the same colour?} 66 | 67 | \item{rect_width}{(numeric) the width of the rectangle, relative to the space between each label factor} 68 | 69 | \item{rect_border}{the border colour around the rectangles. Provide either a single color, that will be used for each rectangle, or one color for each rectangle. Choose \code{NA} if no border is desired.} 70 | 71 | \item{draw_lines}{(logical, default: \code{TRUE}) should lines be drawn between successive rectangles} 72 | 73 | \item{lines_anchors}{a character vector of length two specifying the horizontal placement of the drawn lines relative to the preceding and successive rectangles, respectively} 74 | 75 | \item{linetype}{the linetype for the draw_lines} 76 | 77 | \item{draw_axis.x}{(character) one of "none", "behind", "front" whether to draw an x.axis line and whether to draw it behind or in front of the rectangles, default is behind} 78 | 79 | \item{theme_text_family}{(character) Passed to the \code{text} argument in \code{ggplot2::theme}.} 80 | 81 | \item{scale_y_to_waterfall}{(logical, default: \code{TRUE}) Should the default range of the y-axis be from the bottom of the lowest pool to the top of the highest? If \code{FALSE}, which was the only option before version 0.1.2, the range of the plot is more balanced around the y-axis.} 82 | 83 | \item{print_plot}{(logical) Whether or not the plot should be printed. By default, \code{TRUE}, which means it cannot be assigned.} 84 | 85 | \item{ggplot_object_name}{(character) A quoted valid object name to which ggplot layers may be added after the function has run. Ignored if \code{print} is \code{FALSE}.} 86 | } 87 | \description{ 88 | Create waterfall charts 89 | } 90 | \examples{ 91 | waterfall(values = round(rnorm(5), 1), labels = letters[1:5], calc_total = TRUE) 92 | waterfall(.data = data.frame(category = letters[1:5], 93 | value = c(100, -20, 10, 20, 110)), 94 | fill_colours = colorRampPalette(c("#1b7cd6", "#d5e6f2"))(5), 95 | fill_by_sign = FALSE) 96 | } 97 | \author{ 98 | Based on \code{grattan_waterfall} from the 'grattanCharts' package (\url{https://github.com/HughParsonage/grattanCharts}). 99 | } 100 | -------------------------------------------------------------------------------- /R/waterfall.R: -------------------------------------------------------------------------------- 1 | #' Create waterfall charts 2 | #' 3 | #' @name waterfall 4 | #' @author Based on \code{grattan_waterfall} from the 'grattanCharts' package (\url{https://github.com/HughParsonage/grattanCharts}). 5 | #' @param .data a \code{data.frame} containing two columns, one with the values, the other with the labels 6 | #' @param values a numeric vector making up the heights of the rectangles in the waterfall 7 | #' @param labels the labels corresponding to each vector, marked on the x-axis 8 | #' @param rect_text_labels (character) a character vector of the same length as values that are placed on the rectangles 9 | #' @param rect_text_size size of the text in the rectangles 10 | #' @param rect_text_labels_anchor (character) How should \code{rect_text_labels} be positioned? In future releases, we might have support for north or south anchors, or for directed positioning (negative down, positive up) etc. For now, only centre is supported. 11 | #' @param put_rect_text_outside_when_value_below (numeric) the text labels accompanying a rectangle of this height will be placed outside the box: below if it's negative; above if it's positive. 12 | #' @param calc_total (logical, default: \code{FALSE}) should the final pool of the waterfall be calculated (and placed on the chart) 13 | #' @param total_axis_text (character) the text appearing on the axis underneath the total rectangle 14 | #' @param total_rect_text (character) the text in the middle of the rectangle of the total rectangle 15 | #' @param total_rect_color the color of the final rectangle 16 | #' @param total_rect_border_color the border color of the total rectangle 17 | #' @param total_rect_text_color the color of the final rectangle's label text 18 | #' @param fill_colours Colours to be used to fill the rectangles, in order. Disregarded if \code{fill_by_sign} is \code{TRUE} (the default). 19 | #' @param fill_by_sign (logical, default: \code{TRUE}) should positive and negative values each have the same colour? 20 | #' @param rect_width (numeric) the width of the rectangle, relative to the space between each label factor 21 | #' @param rect_border the border colour around the rectangles. Provide either a single color, that will be used for each rectangle, or one color for each rectangle. Choose \code{NA} if no border is desired. 22 | #' @param draw_lines (logical, default: \code{TRUE}) should lines be drawn between successive rectangles 23 | #' @param linetype the linetype for the draw_lines 24 | #' @param lines_anchors a character vector of length two specifying the horizontal placement of the drawn lines relative to the preceding and successive rectangles, respectively 25 | #' @param draw_axis.x (character) one of "none", "behind", "front" whether to draw an x.axis line and whether to draw it behind or in front of the rectangles, default is behind 26 | #' @param theme_text_family (character) Passed to the \code{text} argument in \code{ggplot2::theme}. 27 | #' @param scale_y_to_waterfall (logical, default: \code{TRUE}) Should the default range of the y-axis be from the bottom of the lowest pool to the top of the highest? If \code{FALSE}, which was the only option before version 0.1.2, the range of the plot is more balanced around the y-axis. 28 | #' @param print_plot (logical) Whether or not the plot should be printed. By default, \code{TRUE}, which means it cannot be assigned. 29 | #' @param ggplot_object_name (character) A quoted valid object name to which ggplot layers may be added after the function has run. Ignored if \code{print} is \code{FALSE}. 30 | #' @examples 31 | #' waterfall(values = round(rnorm(5), 1), labels = letters[1:5], calc_total = TRUE) 32 | #' waterfall(.data = data.frame(category = letters[1:5], 33 | #' value = c(100, -20, 10, 20, 110)), 34 | #' fill_colours = colorRampPalette(c("#1b7cd6", "#d5e6f2"))(5), 35 | #' fill_by_sign = FALSE) 36 | #' @export 37 | 38 | 39 | waterfall <- function(.data = NULL, 40 | values, labels, 41 | rect_text_labels = values, 42 | rect_text_size = 1, 43 | rect_text_labels_anchor = "centre", 44 | put_rect_text_outside_when_value_below = 0.05*(max(cumsum(values)) - min(cumsum(values))), 45 | calc_total = FALSE, 46 | total_axis_text = "Total", 47 | total_rect_text = sum(values), 48 | total_rect_color = "black", 49 | total_rect_border_color = "black", 50 | total_rect_text_color = "white", 51 | fill_colours = NULL, 52 | fill_by_sign = TRUE, 53 | rect_width = 0.7, 54 | rect_border = "black", 55 | draw_lines = TRUE, 56 | lines_anchors = c("right", "left"), 57 | linetype = "dashed", 58 | draw_axis.x = "behind", 59 | theme_text_family = "", 60 | scale_y_to_waterfall = TRUE, 61 | print_plot = FALSE, 62 | ggplot_object_name = "mywaterfall") { 63 | if (!is.null(.data)) { 64 | 65 | if (!is.data.frame(.data)) { 66 | stop("`.data` was a ", class(.data)[1], ", but must be a data.frame.") 67 | } 68 | 69 | if (ncol(.data) < 2L) { 70 | stop("`.data` had fewer than two columns, yet two are required: labels and values.") 71 | } 72 | 73 | dat <- as.data.frame(.data) 74 | char_cols <- vapply(dat, is.character, FALSE) 75 | factor_cols <- vapply(dat, is.factor, FALSE) 76 | num_cols <- vapply(dat, is.numeric, FALSE) 77 | 78 | if (!xor(num_cols[1], num_cols[2]) || 79 | sum(char_cols[1:2], factor_cols[1:2], num_cols[1:2]) != 2L) { 80 | const_width_name <- function(noms) { 81 | if (is.data.frame(noms)) { 82 | noms <- names(noms) 83 | } 84 | max_width <- max(nchar(noms)) 85 | formatC(noms, width = max_width) 86 | } 87 | 88 | stop("`.data` did not contain exactly one numeric column and exactly one character or factor ", 89 | "column in its first two columns.\n\t", 90 | "1st column: '", const_width_name(dat)[1], "'\t", sapply(dat, class)[1], "\n\t", 91 | "2nd column: '", const_width_name(dat)[2], "'\t", sapply(dat, class)[2]) 92 | } 93 | 94 | if (num_cols[1L]) { 95 | .data_values <- .subset2(dat, 1L) 96 | .data_labels <- .subset2(dat, 2L) 97 | } else { 98 | .data_values <- .subset2(dat, 2L) 99 | .data_labels <- .subset2(dat, 1L) 100 | } 101 | 102 | if (!missing(values) && !missing(labels)) { 103 | warning(".data and values and labels supplied, .data ignored") 104 | } else { 105 | values <- .data_values 106 | labels <- as.character(.data_labels) 107 | } 108 | } 109 | 110 | if (!(length(values) == length(labels) && 111 | length(values) == length(rect_text_labels))) { 112 | stop("values, labels, fill_colours, and rect_text_labels must all have same length") 113 | } 114 | 115 | if (rect_width > 1) 116 | warning("rect_Width > 1, your chart may look terrible") 117 | 118 | number_of_rectangles <- length(values) 119 | north_edge <- cumsum(values) 120 | south_edge <- c(0, cumsum(values)[-length(values)]) 121 | 122 | # fill by sign means rectangles' fill colour is given by whether they are going up or down 123 | gg_color_hue <- function(n) { 124 | hues = seq(15, 375, length = n + 1) 125 | grDevices::hcl(h = hues, l = 65, c = 100)[seq_len(n)] 126 | } 127 | if(fill_by_sign){ 128 | if (!is.null(fill_colours)){ 129 | warning("fill_colours is given but fill_by_sign is TRUE so fill_colours will be ignored.") 130 | } 131 | fill_colours <- ifelse(values >= 0, 132 | gg_color_hue(2)[2], 133 | gg_color_hue(2)[1]) 134 | } else { 135 | if (is.null(fill_colours)){ 136 | fill_colours <- gg_color_hue(number_of_rectangles) 137 | } 138 | } 139 | 140 | # Check if length of rectangle border colors matches the number of rectangles 141 | rect_border_matching <- length(rect_border) == number_of_rectangles 142 | if (!(rect_border_matching || length(rect_border) == 1)) { 143 | stop("rect_border must be a single colour or one colour for each rectangle") 144 | } 145 | 146 | if(!(grepl("^[lrc]", lines_anchors[1]) && grepl("^[lrc]", lines_anchors[2]))) # left right center 147 | stop("lines_anchors must be a pair of any of the following: left, right, centre") 148 | 149 | if (grepl("^l", lines_anchors[1])) 150 | anchor_left <- rect_width / 2 151 | if (grepl("^c", lines_anchors[1])) 152 | anchor_left <- 0 153 | if (grepl("^r", lines_anchors[1])) 154 | anchor_left <- -1 * rect_width / 2 155 | 156 | if (grepl("^l", lines_anchors[2])) 157 | anchor_right <- -1 * rect_width / 2 158 | if (grepl("^c", lines_anchors[2])) 159 | anchor_right <- 0 160 | if (grepl("^r", lines_anchors[2])) 161 | anchor_right <- rect_width / 2 162 | 163 | if (!calc_total) { 164 | p <- 165 | if (scale_y_to_waterfall) { 166 | ggplot2::ggplot(data.frame(x = c(factor(1:length(labels)), factor(1:length(labels))), 167 | y = c(south_edge, north_edge)), 168 | ggplot2::aes(x = .data$x, y = .data$y)) 169 | } else { 170 | ggplot2::ggplot(data.frame(x = factor(1:length(labels)), y = values), 171 | ggplot2::aes(x = .data$x, y = .data$y)) 172 | } 173 | p <- p + 174 | ggplot2::geom_blank() + 175 | ggplot2::theme(axis.title = ggplot2::element_blank()) 176 | } else { 177 | p <- 178 | if (scale_y_to_waterfall) { 179 | ggplot2::ggplot(data.frame(x = c(factor(1:length(labels)), total_axis_text, 180 | factor(1:length(labels)), total_axis_text), 181 | y = c(south_edge, north_edge, 182 | south_edge[number_of_rectangles], 183 | north_edge[number_of_rectangles])), 184 | ggplot2::aes(x = .data$x, y = .data$y)) 185 | } else { 186 | ggplot2::ggplot(data.frame(x = c(factor(1:length(labels)), total_axis_text), 187 | y = c(values, north_edge[number_of_rectangles])), 188 | ggplot2::aes(x = .data$x, y = .data$y)) 189 | } 190 | p <- p + 191 | ggplot2::geom_blank() + 192 | ggplot2::theme(axis.title = ggplot2::element_blank()) 193 | } 194 | 195 | if (grepl("behind", draw_axis.x)){ 196 | p <- p + ggplot2::geom_hline(yintercept = 0) 197 | } 198 | 199 | for (i in seq_along(values)){ 200 | p <- p + ggplot2::annotate("rect", 201 | xmin = i - rect_width/2, 202 | xmax = i + rect_width/2, 203 | ymin = south_edge[i], 204 | ymax = north_edge[i], 205 | colour = rect_border[[if (rect_border_matching) i else 1]], 206 | fill = fill_colours[i]) 207 | if (i > 1 && draw_lines){ 208 | p <- p + ggplot2::annotate("segment", 209 | x = i - 1 - anchor_left, 210 | xend = i + anchor_right, 211 | linetype = linetype, 212 | y = south_edge[i], 213 | yend = south_edge[i]) 214 | } 215 | } 216 | 217 | # rect_text_labels 218 | 219 | for (i in seq_along(values)){ 220 | if (rect_text_labels_anchor == "centre" || 221 | rect_text_labels_anchor == "center") { 222 | if(abs(values[i]) > put_rect_text_outside_when_value_below){ 223 | p <- p + ggplot2::annotate("text", 224 | x = i, 225 | y = 0.5 * (north_edge[i] + south_edge[i]), 226 | family = theme_text_family, 227 | label = ifelse(rect_text_labels[i] == values[i], 228 | ifelse(values[i] < 0, 229 | paste0("\U2212", -1 * values[i]), 230 | values[i]), 231 | rect_text_labels[i]), 232 | size = rect_text_size/(5/14)) 233 | } else { 234 | p <- p + ggplot2::annotate("text", 235 | x = i, 236 | y = north_edge[i], 237 | family = theme_text_family, 238 | label = ifelse(rect_text_labels[i] == values[i], 239 | ifelse(values[i] < 0, 240 | paste0("\U2212", -1 * values[i]), 241 | values[i]), 242 | rect_text_labels[i]), 243 | vjust = ifelse(values[i] >= 0, -0.2, 1.2), 244 | size = rect_text_size/(5/14)) 245 | } 246 | } else if (rect_text_labels_anchor == "bottom") { 247 | p <- p + ggplot2::annotate("text", 248 | x = i, 249 | y = north_edge[i], 250 | family = theme_text_family, 251 | label = ifelse(rect_text_labels[i] == values[i], 252 | ifelse(values[i] < 0, 253 | paste0("\U2212", -1 * values[i]), 254 | values[i]), 255 | rect_text_labels[i]), 256 | vjust = 1.2, 257 | size = rect_text_size/(5/14)) 258 | 259 | } else if (rect_text_labels_anchor == "top") { 260 | p <- p + ggplot2::annotate("text", 261 | x = i, 262 | y = north_edge[i], 263 | family = theme_text_family, 264 | label = ifelse(rect_text_labels[i] == values[i], 265 | ifelse(values[i] < 0, 266 | paste0("\U2212", -1 * values[i]), 267 | values[i]), 268 | rect_text_labels[i]), 269 | vjust = -0.2, 270 | size = rect_text_size/(5/14)) 271 | 272 | } else { 273 | stop("rect_text_labels_anchor = ", rect_text_labels_anchor[1], ". Only centre, bottom, and top are supported.") 274 | } 275 | } 276 | 277 | if (calc_total){ 278 | p <- p + ggplot2::annotate("rect", 279 | xmin = number_of_rectangles + 1 - rect_width/2, 280 | xmax = number_of_rectangles + 1 + rect_width/2, 281 | ymin = 0, 282 | ymax = north_edge[number_of_rectangles], 283 | colour = total_rect_border_color, 284 | fill = total_rect_color) + 285 | ggplot2::annotate("text", 286 | x = number_of_rectangles + 1, 287 | y = 0.5 * north_edge[number_of_rectangles], 288 | family = theme_text_family, 289 | label = ifelse(total_rect_text == sum(values), 290 | ifelse(north_edge[number_of_rectangles] < 0, 291 | paste0("\U2212", -1 * north_edge[number_of_rectangles]), 292 | north_edge[number_of_rectangles]), 293 | total_rect_text), 294 | color = total_rect_text_color, 295 | size = rect_text_size/(5/14)) + 296 | ggplot2::scale_x_discrete(labels = c(labels, total_axis_text)) 297 | if (draw_lines){ 298 | p <- p + ggplot2::annotate("segment", 299 | x = number_of_rectangles - anchor_left, 300 | xend = number_of_rectangles + 1 + anchor_right, 301 | y = north_edge[number_of_rectangles], 302 | yend = north_edge[number_of_rectangles], 303 | linetype = linetype) 304 | } 305 | } else { 306 | p <- p + ggplot2::scale_x_discrete(labels = labels) 307 | } 308 | 309 | if (grepl("front", draw_axis.x)){ 310 | p <- p + ggplot2::geom_hline(yintercept = 0) 311 | } 312 | if (print_plot){ 313 | # Allow modifications beyond the function call 314 | if (ggplot_object_name %in% ls(.GlobalEnv)) 315 | warning("Overwriting ", ggplot_object_name, " in global environment.") 316 | assign(ggplot_object_name, p, inherits = TRUE) 317 | print(p) 318 | } else { 319 | return(p) 320 | } 321 | } 322 | --------------------------------------------------------------------------------