├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── check-release.yaml │ └── pkgdown.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── ckb-style.R ├── ckbplotr-package.R ├── fix-panel.R ├── forest-data.R ├── forest-plot-list-xlim.R ├── forest-plot-parts.R ├── forest-plot.R ├── geom-text-move.R ├── save-figure.R ├── shape-plot-parts.R ├── shape-plot.R ├── utils-pipe.R ├── utils.R └── zzz.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── ckbplotr.Rproj ├── man ├── ckb_style.Rd ├── ckbplotr-package.Rd ├── figures │ ├── README-a-plot-1.png │ ├── README-example-forest-plot-1.png │ ├── README-example-shape-plot-1.png │ ├── lifecycle-archived.svg │ ├── lifecycle-defunct.svg │ ├── lifecycle-deprecated.svg │ ├── lifecycle-experimental.svg │ ├── lifecycle-maturing.svg │ ├── lifecycle-questioning.svg │ ├── lifecycle-stable.svg │ ├── lifecycle-superseded.svg │ └── logo.png ├── fix_panel.Rd ├── forest_data.Rd ├── forest_plot.Rd ├── geom_text_move.Rd ├── ggpreview.Rd ├── pipe.Rd ├── plot_like_ckb.Rd ├── prepare_figure.Rd ├── save_figure.Rd ├── shape_plot.Rd └── theme_ckb.Rd ├── pkgdown └── favicon │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ ├── apple-touch-icon-180x180.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon.png │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ └── favicon.ico ├── tests ├── testthat.R └── testthat │ ├── test-forest-data.R │ ├── test-forest-plot.R │ ├── test-geom-text-move.R │ ├── test-plot-like-ckb.R │ ├── test-shape-plot-parts.R │ └── test-utils.R └── vignettes ├── .gitignore ├── ckb_style.Rmd ├── ckbplotr.Rmd ├── customising_plots.Rmd ├── forest_plots.Rmd ├── ggplot2.Rmd ├── page_layouts.Rmd ├── save_plots.Rmd ├── shape_plots.Rmd └── web-only └── generated_code.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^README\.Rmd$ 2 | ^ckbplotr\.Rproj$ 3 | ^\.Rproj\.user$ 4 | ^_pkgdown\.yml$ 5 | ^docs$ 6 | ^pkgdown$ 7 | ^\.github$ 8 | ^doc$ 9 | ^Meta$ 10 | ^codecov\.yml$ 11 | ^data-raw$ 12 | ^LICENSE\.md$ 13 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/check-release.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | R_KEEP_PKG_SOURCE: yes 17 | steps: 18 | - uses: actions/checkout@v3 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::rcmdcheck 27 | needs: check 28 | 29 | - uses: r-lib/actions/check-r-package@v2 30 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | release: 5 | types: [published] 6 | workflow_dispatch: 7 | 8 | name: pkgdown.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | pkgdown: 14 | runs-on: ubuntu-latest 15 | # Only restrict concurrency for non-PR jobs 16 | concurrency: 17 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 18 | env: 19 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 20 | permissions: 21 | contents: write 22 | steps: 23 | - uses: actions/checkout@v4 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@v4.5.0 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | Thumbs.db 3 | inst/doc 4 | *.DS_Store 5 | docs 6 | doc 7 | Meta 8 | /doc/ 9 | /Meta/ 10 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ckbplotr 2 | Title: Create CKB Plots 3 | Description: ckbplotr provides functions to help create and style plots in R. 4 | It is being developed by, and primarily for, China Kadoorie Biobank 5 | researchers. 6 | Version: 0.11.4 7 | Authors@R: 8 | person(given = "Neil", 9 | family = "Wright", 10 | role = c("aut", "cre"), 11 | email = "neil.wright@ndph.ox.ac.uk") 12 | Encoding: UTF-8 13 | LazyData: true 14 | Depends: 15 | ggplot2 (>= 3.4.0), 16 | R (>= 2.10) 17 | Imports: 18 | magrittr, 19 | dplyr, 20 | tibble, 21 | rlang, 22 | purrr, 23 | tidyr, 24 | utils, 25 | stringi, 26 | grid, 27 | gridExtra, 28 | ggtext, 29 | gridtext (>= 0.1.5), 30 | knitr, 31 | rmarkdown, 32 | ggh4x, 33 | lifecycle, 34 | glue, 35 | cli 36 | RoxygenNote: 7.2.3 37 | Roxygen: list(markdown = TRUE) 38 | Suggests: 39 | patchwork, 40 | testthat 41 | VignetteBuilder: knitr 42 | URL: https://neilstats.github.io/ckbplotr/, https://doi.org/10.5281/zenodo.6382217 43 | BugReports: https://github.com/neilstats/ckbplotr/issues 44 | License: GPL (>= 3) 45 | Config/testthat/edition: 3 46 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(ggplot_add,ckbplot) 4 | export("%>%") 5 | export(ckb_style) 6 | export(fix_panel) 7 | export(forest_data) 8 | export(forest_plot) 9 | export(geom_text_move) 10 | export(ggpreview) 11 | export(plot_like_ckb) 12 | export(prepare_figure) 13 | export(save_figure) 14 | export(shape_plot) 15 | export(theme_ckb) 16 | import(ggplot2) 17 | importFrom(ggtext,element_markdown) 18 | importFrom(lifecycle,deprecated) 19 | importFrom(magrittr,"%>%") 20 | importFrom(rlang,":=") 21 | importFrom(rlang,.data) 22 | importFrom(stats,na.omit) 23 | importFrom(utils,compareVersion) 24 | importFrom(utils,packageVersion) 25 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # ckbplotr 0.11.4 2 | 3 | * Subheadings in forest_plot() row labels can be excluded by appending "@nolabel". 4 | * Minor fix to generated code. 5 | 6 | # ckbplotr 0.11.3 7 | 8 | * Modified the default vertical positioning of column and panel headings, and x-axis label, in forest_plot() 9 | * Added argument panel.headings.align to forest_plot() to control centring of panel headings. 10 | * Added argument col.heading.rule to forest_plot() to add a horizontal rule below column headings. 11 | * Added argument axis.title.margin to theme_ckb() and ckb_style(). 12 | 13 | # ckbplotr 0.11.2 14 | 15 | * Fixes. 16 | 17 | # ckbplotr 0.11.1 18 | 19 | * fix error from get_horizontal_spacing() when right.space, left.space, col.right.pos and col.left.pos arguments are all specified. 20 | 21 | # ckbplotr 0.11.0 22 | 23 | * addaes/addarg in forest_plot() can now also be used for column headings and diamonds. 24 | * addtext in forest_plot() can be used to display plotmath. 25 | * valign and halign arguments added to prepare_figure() and save_figure() 26 | * Fixes: use lineheight=1 for column headings; panel.headings in forest_plot_list_xlim(); add title after plot in prepare_figure(); automatic CI colour when using white fill in forest_plot(); improve calculations for narrow confidence interval lines; remove unneeded spacing for y axis tick marks. 27 | 28 | # ckbplotr 0.10.2 29 | 30 | * Fix dimensions for cropped figure in save_figure(). 31 | 32 | # ckbplotr 0.10.1 33 | 34 | * Fix xlab and column headings when xlim is a list in forest_plot(). 35 | 36 | # ckbplotr 0.10.0 37 | 38 | * Added ggpreview() and preview argument in save_figure(). 39 | * forest_plot() can handle lists for xlim (axis limits). 40 | * Added arguments to forest_plot() to control column spacing. 41 | * Improved generated code. 42 | * Fixes. 43 | 44 | # ckbplotr 0.9.2 45 | 46 | * Fix incorrect argument name in shape_plot(). 47 | 48 | # ckbplotr 0.9.1 49 | 50 | * Fix error when using col.lci and col.uci arguments in shape_plot() and forest_plot(). 51 | 52 | # ckbplotr 0.9.0 53 | 54 | * `+ ckb_style()` can now be used to make a ggplot into CKB style (instead of using plot_like_ckb()). 55 | * add argument added to forest_plot() and shape_plot() for adding layers (and other ggplot2 objects) to plots. 56 | * If a named list is used for the panels argument on forest_plot(), the names are used as panel headings. 57 | * row.labels.heading argument can be used to add a heading above the row labels in forest_plot(). 58 | * The rows (and their order) included in a forest_plot() plot is set by the row.labels data frame. (Though the rows argument can still be used to select the rows to include.) 59 | * forest_plot() will work if a single data frame (instead of a list) is used. 60 | * forest_plot() will automatically match more column names for the estimates (estimate/est/beta/loghr) and standard errors (stderr/std.err/se). 61 | * Improvements to the code generated by forest_plot() and shape_plot(). 62 | * Old arguments for specifying spacing, and make_shape_plot() and make_forest_plot() functions, removed. 63 | * Other minor changes. 64 | * Various fixes and refactoring. 65 | 66 | # ckbplotr 0.8.2 67 | 68 | * Fixes. 69 | 70 | # ckbplotr 0.8.1 71 | 72 | * blankrows argument of forest_plot() now allows decimals and negative numbers. 73 | * Added panel.height argument to forest_plot() and width argument to shape_plot(). 74 | * Added data.function argument to forest_plot(). 75 | * Small fixes and improvements. 76 | * Corrected calculation of text size on plots. 77 | * Upper and lower confidence interval limits used to imply SE where necessary. 78 | * Refactoring. 79 | * Updated documentation. 80 | 81 | # ckbplotr 0.8.0 82 | 83 | * In shape_plot() and forest_plot() the height and panel.width arguments, respectively, will set the size of the plotting panels (so fix_panel() no longer needs to used). 84 | * Arguments height and width have been added to plot_like_ckb(). 85 | * The above two points were achieved using the ggh4x package which is now a dependency. 86 | * Improvements to save_figure(). 87 | * Minor internal improvements. 88 | 89 | # ckbplotr 0.7.1 90 | 91 | * By default, shape_plot() and forest_plot() now use a new environment, with the same parent as the function call, to evaluate plot code. This should mean the functions work better when called from user-defined functions. 92 | * shape_plot() now has a digits argument to specify number of decimal places to estimates text. 93 | * shape_plot() default shape is now 16 (square) or 22 (filled square) if col.group is set. 94 | * Added argument axes to plot_like_ckb() to control which axis lines should be added. 95 | * Update for ggplot2 3.4.0 96 | * Minor fixes and improvements. 97 | 98 | # ckbplotr 0.7.0 99 | 100 | * Added save_figure() function to help save plots as PDF files. 101 | * make_shape_plot() is now called shape_plot() and make_forest_plot() is now called forest_plot(). (But the original names still work.) 102 | * In forest_plot(), fill and cicolour (when using panel.width) can now be lists. 103 | * In shape_plot(), confidence intervals shorter than plotted points can be a different colour (and plotted before/after the points) by using the panel.height argument. 104 | * plot_like_ckb() now removes panel background and puts small top margin on plot. 105 | * Added gridtext version requirement (>=0.1.5) so that text formatting works for R versions >= 4.2.0 . 106 | * Internal changes made to improve structure. 107 | * Other minor fixes and updates. 108 | 109 | # ckbplotr 0.6.6 110 | 111 | * make_forest_plot() addtext argument can now add multiple tests results and/or text under the same row. 112 | * README updated. 113 | 114 | # ckbplotr 0.6.5 115 | 116 | * Added arguments to control the colour of non-data components of a plot. 117 | * Use R markdown to render plot code to display in Viewer pane of RStudio. (Replacing use of highlight package.) 118 | * Updates to vignettes. 119 | 120 | # ckbplotr 0.6.4 121 | 122 | * Added legend.name and legend.position arguments to make_shape_plot(). 123 | * Added DOI badge and R-universe installation instructions. 124 | * Updated license (and add ggplot2 reference) 125 | 126 | # ckbplotr 0.6.3 127 | 128 | * Removed make_jasper_forest_plot function. 129 | * Minor improvements to make_forest_plot(). 130 | 131 | # ckbplotr 0.6.2 132 | 133 | * Allow use of vectors for col.left and col.right in the addaes and addarg arguments. (So that different aesthetics and arguments can be added for each column.) 134 | * Add digits argument to make_forest_data() and make_forest_plot(). 135 | * make_forest_plot() will report the results of automatic horizontal column positioning and spacing. 136 | * Various minor fixes. 137 | 138 | # ckbplotr 0.6.1 139 | 140 | * Fixes 141 | 142 | # ckbplotr 0.6.0 143 | 144 | * New spacing and column positioning arguments added to make_forest_plot(). By default, these will be calculated automatically. 145 | * New argument addcode in make_forest_plot() which inserts code into the generated plot code. 146 | * New arguments addaes and addarg in make_shape_plot() and make_forest_plot() which can be used to specify additional aesthetics and arguments for some ggplot layers. 147 | * New argument col.right.parse in make_forest_plot() which controls if columns are parsed into expressions when plotted. 148 | * New argument `row.labels.levels` in make_forest_plot() and make_forest_data() to specify which columns of row.labels data frame to use. And better handling of missing values. 149 | * make_forest_plot() no longer returns data. But the plot data is available at .\$plot\$data 150 | * New argument envir added to make_shape_plot (allows the user to specify the environment for evaluating the plot code). 151 | * ggtext::element_markdown() now used for y-axis labels in make_forest_plot() 152 | * fix_panel_width() replaced by fix_panel() 153 | * Improved handling of unicode characters. 154 | * Updated documentation. 155 | * Fixes and internal code improvements. 156 | 157 | # ckbplotr 0.5.0 158 | 159 | * In make_forest_plot(), confidence intervals narrower than plotted points can be a different colour (and plotted before/after the points) by using the panel.width argument. 160 | * A new function fix_panel_width() can then be used to fix the width of panels in a forest plot. 161 | * A new argument envir in make_forest_plot() allows the user to specify the environment for evaluating the plotcode. (Helpful if using make_forest_plot() inside another function.) 162 | 163 | # ckbplotr 0.4.1 164 | 165 | * Fixed make_jasper_forest_plot. 166 | 167 | # ckbplotr 0.4.0 168 | 169 | * Name of arguments in make_forest_plot(), make_forest_data(), and make_jasper_forest_plot() have changed. The old names should still work for now and a message is displayed to tell you the new names. Hopefully the new names are more meaningful. 170 | * The code returned by make_forest_plot() will now run entirely on its own with editing. (i.e. It includes code to prepare data for plotting, so you do not need to run make_forest_plot() for it to work.) 171 | * Use of coord_flip() has been removed from make_forest_plot(), and x and y have been switched where needed. 172 | * The x positions for axis labels, text columns, and panel headings in make_forest_plot() are rounded to six decimal places. 173 | * Point estimates and CIs outside the axis limits will not be plotted with make_forest_plot(). 174 | 175 | # ckbplotr 0.3.2 176 | 177 | * Arguments col.right.headings and col.left.headings in make_forest_plot will now accept lists, so that different headings can be used between plots. 178 | 179 | # ckbplotr 0.3.1 180 | 181 | * New argument stroke in make_shape_plot and make_forest_plot. 182 | * New argument nullval in make_forest_plot, which adds a vertical reference line at this value. (By default a line is still added at 1 if using log scale.) 183 | * New argument minse in make_shape_plot and make_forest_plot which sets the minimum standard error to use when scaling point size. This allows scaling to be made consistent between plots. 184 | * Argument col.keep available in make_forest_plot() to keep columns in the returned data frame. 185 | * Using the addtext argument of make_forest_plot(), you now need to include an equals or less than sign with the p-value. 186 | 187 | # ckbplotr 0.3.0 188 | 189 | * New arguments for setting aesthetics overall (by value) or per-point (by specifying a column name). 190 | * Size of text and lines etc. can be controlled by base_size and base_line_size. 191 | * Fitted lines can be added to shape plots with the lines argument. 192 | * Log scale on plots can be controlled with the logscale argument. 193 | * Added vignettes and improved documentation. 194 | * Other small fixes. 195 | 196 | # ckbplotr 0.2.0 197 | 198 | * Update version number before changes that are not backwards compatible may be introduced. 199 | * Added a `NEWS.md` file to track changes to the package. 200 | -------------------------------------------------------------------------------- /R/ckb-style.R: -------------------------------------------------------------------------------- 1 | #' CKB ggplot theme 2 | #' 3 | #' Based on theme_bw 4 | #' 5 | #' @param base_size base font size, given in pts. 6 | #' @param base_line_size base size for line elements 7 | #' @param colour Colour for non-data aspects of the plot. (Default: "black") 8 | #' @param axis.title.margin Margin between axis titles and plot. (Default: 1) 9 | #' @param plot.margin Margin around entire plot (Default: margin(0.5, 0, 0.5, 0, "lines")) 10 | #' 11 | #' @export 12 | 13 | theme_ckb <- function(base_size = 11, 14 | base_line_size = base_size/22, 15 | colour = "black", 16 | axis.title.margin = 1, 17 | plot.margin = margin(0.5, 1.5, 0.5, 0.5, "lines")){ 18 | theme_bw(base_size = base_size, 19 | base_line_size = base_line_size) %+replace% 20 | theme(panel.grid = element_blank(), 21 | panel.border = element_blank(), 22 | panel.background = element_blank(), 23 | axis.ticks = element_line(colour = colour), 24 | axis.text = element_text(colour = colour), 25 | axis.text.x = element_text(margin = margin(t = base_size/(11/4.4)), vjust = 1), 26 | axis.text.x.top = element_text(margin = margin(b = base_size/(11/4.4)), vjust = 0), 27 | axis.text.y = element_text(margin = margin(r = base_size/(11/4.4)), hjust = 1), 28 | axis.text.y.right = element_text(margin = margin(l = base_size/(11/4.4)), hjust = 0), 29 | axis.title = element_text(face = "bold", colour = colour), 30 | axis.title.x = element_text(margin = unit(c(axis.title.margin,0,0,0), "lines")), 31 | axis.title.y = element_text(margin = unit(c(0,axis.title.margin,0,0), "lines"), angle = 90), 32 | legend.background = element_blank(), 33 | strip.background = element_blank(), 34 | strip.text = element_text(face = "bold", colour = colour), 35 | plot.margin = plot.margin, 36 | plot.background = element_blank(), 37 | plot.title = element_text(hjust = 0.5, face = "bold", colour = colour), 38 | complete = TRUE) 39 | } 40 | 41 | 42 | 43 | 44 | 45 | 46 | #' Make a ggplot into CKB style 47 | #' 48 | #' 49 | #' @inheritParams theme_ckb 50 | #' @param xlims A numeric vector of length two. The limits of the x-axis. 51 | #' @param ylims A numeric vector of length two. The limits of the y-axis. 52 | #' @param gap A numeric vector of length two. The gap between plotting area and axis to the left and bottom of the plot, as a proportion of the x-axis length. (Default: c(0.025, 0.025)) 53 | #' @param ext A numeric vector of length two. The extensions to add to the right and top of the plot, as a proportion of the x-axis length. (Default: c(0, 0)) 54 | #' @param ratio The ratio (y-axis:x-axis) to use for the plot. Ignored if both width and height are set. (Default: 1.5) 55 | #' @param width A `grid::unit` object to set the width of the plot (not including the gap or extension). 56 | #' @param height A `grid::unit` object to set the height of the plot (not including the gap or extension). 57 | #' @param axes Choice of axis lines to add to the plot, one of "both", "x" or "y". (Default: "both") 58 | #' 59 | #' 60 | #' @import ggplot2 61 | #' @export 62 | 63 | ckb_style <- function( 64 | xlims = NULL, 65 | ylims = NULL, 66 | gap = c(0.025,0.025), 67 | ext = c(0,0), 68 | ratio = 1.5, 69 | width = NULL, 70 | height = NULL, 71 | base_size = 11, 72 | base_line_size = base_size/22, 73 | colour = "black", 74 | axis.title.margin = 1, 75 | plot.margin = margin(0.5, 1.5, 0.5, 0.5, "lines"), 76 | axes = "both" 77 | ){ 78 | 79 | # check arguments 80 | if (!axes %in% c("both", "x", "y", "none")){ 81 | rlang::abort("axes should be one of 'both', 'x', 'y' or 'none'.") 82 | } 83 | 84 | if (length(gap) != 2){ 85 | rlang::abort("gap must be a vector of length 2") 86 | } 87 | 88 | if (length(ext) != 2){ 89 | rlang::abort("ext must be a vector of length 2") 90 | } 91 | 92 | # panel sizes 93 | if (missing(width) & missing(height)){ 94 | full_width <- 1 95 | full_height <- (ratio + gap[[2]] + ext[[2]]) / (1 + gap[[1]] + ext[[1]]) 96 | } else if (!missing(width) & missing(height)){ 97 | full_width <- width * (1 + gap[[1]] + ext[[1]]) 98 | full_height <- width * (ratio + gap[[2]] + ext[[2]]) 99 | } else if (missing(width) & !missing(height)){ 100 | full_width <- height / ratio * (1 + gap[[1]] + ext[[1]]) 101 | full_height <- height / ratio * (ratio + gap[[2]] + ext[[2]]) 102 | } else if (!missing(width) & !missing(height)){ 103 | full_width <- width * (1 + gap[[1]] + ext[[1]]) 104 | full_height <- height + width * (gap[[2]] + ext[[2]]) 105 | ratio <- as.numeric(grid::convertUnit(height, "mm")) / as.numeric(grid::convertUnit(width, "mm")) 106 | } 107 | 108 | 109 | return(structure(list(xlims = xlims, 110 | ylims = ylims, 111 | gap = gap, 112 | ext = ext, 113 | ratio = ratio, 114 | full_height = full_height, 115 | full_width = full_width, 116 | base_line_size = base_line_size, 117 | base_size = base_size, 118 | colour = colour, 119 | axis.title.margin = axis.title.margin, 120 | plot.margin = plot.margin, 121 | axes = axes), 122 | class = "ckbplot")) 123 | } 124 | 125 | #' @noRd 126 | #' @export 127 | #' @keywords internal 128 | ggplot_add.ckbplot <- function(object, plot, object_name) { 129 | # get plot axis transformations 130 | tf_x <- ggplot_build(plot)$layout$panel_scales_x[[1]]$trans$transform 131 | invtf_x <- ggplot_build(plot)$layout$panel_scales_x[[1]]$trans$inverse 132 | tf_y <- ggplot_build(plot)$layout$panel_scales_y[[1]]$trans$transform 133 | invtf_y <- ggplot_build(plot)$layout$panel_scales_y[[1]]$trans$inverse 134 | tf_x <- ifelse(is.null(tf_x), identity, tf_x) 135 | invtf_x <- ifelse(is.null(invtf_x), identity, invtf_x) 136 | tf_y <- ifelse(is.null(tf_y), identity, tf_y) 137 | invtf_y <- ifelse(is.null(invtf_y), identity, invtf_y) 138 | 139 | # if xlims or ylims not given as argument, get axis limits from range in ggplot plot 140 | if (is.null(object$xlims)){ 141 | if (!is.null(ggplot_build(plot)$layout$panel_scales_x[[1]]$limits)){ 142 | xlims <- ggplot_build(plot)$layout$panel_scales_x[[1]]$limits 143 | } else { 144 | xlims <- ggplot_build(plot)$layout$panel_scales_x[[1]]$range$range 145 | } 146 | xlims <- range(pretty(xlims)) 147 | } else { 148 | xlims <- object$xlims 149 | } 150 | 151 | if (is.null(object$ylims)){ 152 | if (!is.null(ggplot_build(plot)$layout$panel_scales_y[[1]]$limits)){ 153 | ylims <- ggplot_build(plot)$layout$panel_scales_y[[1]]$limits 154 | } else { 155 | ylims <- ggplot_build(plot)$layout$panel_scales_y[[1]]$range$range 156 | } 157 | ylims <- range(pretty(ylims)) 158 | } else { 159 | ylims <- object$ylims 160 | } 161 | 162 | # calculate plot limits 163 | limits <- list(xaxis = xlims, yaxis = ylims) 164 | 165 | ## check for infinite values in transformed axis limits 166 | if (any(!is.finite(tf_x(limits[["xaxis"]])))) { 167 | rlang::abort("Infinite or NaN values in x-axis. Provide axis limits and check transformation of x scale.") 168 | } 169 | if (any(!is.finite(tf_y(limits[["yaxis"]])))) { 170 | rlang::abort("Infinite or NaN values in y-axis. Provide axis limits and check transformation of y scale.") 171 | } 172 | 173 | addtox <- c(object$gap[[1]]*diff(range(tf_x(limits[["xaxis"]]))), 174 | object$ext[[1]]*diff(range(tf_x(limits[["xaxis"]])))) 175 | addtoy <- c((1/object$ratio)*object$gap[[2]]*diff(range(tf_y(limits[["yaxis"]]))), 176 | (1/object$ratio)*object$ext[[2]]*diff(range(tf_y(limits[["yaxis"]])))) 177 | limits[["x"]] <- invtf_x(tf_x(limits[["xaxis"]]) + c(-1, 1)*addtox) 178 | limits[["y"]] <- invtf_y(tf_y(limits[["yaxis"]]) + c(-1, 1)*addtoy) 179 | 180 | 181 | # update plot 182 | plot <- plot + 183 | coord_cartesian(xlim = limits[["x"]], 184 | ylim = limits[["y"]], 185 | expand = FALSE, 186 | clip = "off") + 187 | ggh4x::force_panelsizes(rows = object$full_height, 188 | cols = object$full_width, 189 | respect = TRUE) + 190 | theme_ckb(base_size = object$base_size, 191 | base_line_size = object$base_line_size, 192 | colour = object$colour, 193 | axis.title.margin = object$axis.title.margin, 194 | plot.margin = object$plot.margin) 195 | 196 | # add axis lines to plot 197 | if (object$axes %in% c("both", "y")){ 198 | plot <- plot + 199 | annotate(geom = "segment", 200 | x = limits[["x"]][[1]], 201 | xend = limits[["x"]][[1]], 202 | y = limits[["yaxis"]][[1]], 203 | yend = limits[["yaxis"]][[2]], 204 | linewidth = object$base_line_size, 205 | lineend = "round", 206 | colour = object$colour) 207 | } 208 | 209 | if (object$axes %in% c("both", "x")){ 210 | plot <- plot + 211 | annotate(geom = "segment", 212 | x = limits[["xaxis"]][[1]], 213 | xend = limits[["xaxis"]][[2]], 214 | y = limits[["y"]][[1]], 215 | yend = limits[["y"]][[1]], 216 | linewidth = object$base_line_size, 217 | lineend = "round", 218 | colour = object$colour) 219 | } 220 | 221 | return(plot) 222 | } 223 | 224 | 225 | 226 | 227 | 228 | 229 | #' Make a ggplot into CKB style 230 | #' 231 | #' @param plot A ggplot2 plot 232 | #' @param ... Arguments passed to ckb_style() 233 | #' 234 | #' @return A ggplot2 plot. 235 | #' 236 | #' @import ggplot2 237 | #' @export 238 | 239 | plot_like_ckb <- function(plot, ...){ 240 | plot <- plot + ckb_style(...) 241 | return(plot) 242 | } 243 | 244 | -------------------------------------------------------------------------------- /R/ckbplotr-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | ## usethis namespace: start 5 | #' @importFrom lifecycle deprecated 6 | ## usethis namespace: end 7 | #' @importFrom stats na.omit 8 | #' @importFrom ggtext element_markdown 9 | #' @importFrom rlang := 10 | NULL 11 | -------------------------------------------------------------------------------- /R/fix-panel.R: -------------------------------------------------------------------------------- 1 | #' Fix panel width and height of a forest plot 2 | #' 3 | #' @description 4 | #' `r lifecycle::badge('deprecated')` 5 | #' 6 | #' ckb_style(), plot_like_ckb() and shape_plot() have width and height arguments and 7 | #' forest_plot() has panel.width and panel.height arguments. These use 8 | #' ggh4x::force_panelsizes() to fix panel sizes. 9 | #' 10 | #' @param plot A plot (created by forest_plot()). 11 | #' @param width Width of panels. (e.g unit(50, "mm")) 12 | #' @param height Height of panels. (e.g unit(150, "mm")) 13 | #' 14 | #' @return A gtable object 15 | #' 16 | #' @keywords internal 17 | #' @export 18 | 19 | 20 | fix_panel <- function(plot, width = NULL, height = NULL){ 21 | 22 | lifecycle::deprecate_warn("0.8.1", 23 | "fix_panel()", 24 | "ggh4x::force_panelsizes()", 25 | details = "forest_plot(), shape_plot(), and ckb_style() also have arguments for setting panel width and height.") 26 | 27 | # generate grob from ggplot2 plot 28 | gtable <- ggplot2::ggplotGrob(plot) 29 | 30 | # check arguments 31 | if (!missing(width) & !missing(height) & gtable$respect){rlang::abort("Can only specificy one of width and height to maintain aspect ratio.)")} 32 | 33 | ## calculate ratio from numeric part of panel height / width 34 | ## assumes they are the same unit (probably "null" because created by ggplot) 35 | ratio <- as.numeric(gtable$heights[gtable$layout$t[grepl("panel", gtable$layout$name)]]) / as.numeric(gtable$widths[gtable$layout$l[grepl("panel", gtable$layout$name)]]) 36 | 37 | if(!is.null(width)){ 38 | gtable$widths[gtable$layout$l[grepl("panel", gtable$layout$name)]] <- width 39 | if (gtable$respect){ 40 | ## respect aspect ratio 41 | gtable$heights[gtable$layout$t[grepl("panel", gtable$layout$name)]] <- width * ratio 42 | } 43 | } 44 | if(!is.null(height)){ 45 | gtable$heights[gtable$layout$t[grepl("panel", gtable$layout$name)]] <- height 46 | if (gtable$respect){ 47 | ## respect aspect ratio 48 | gtable$widths[gtable$layout$l[grepl("panel", gtable$layout$name)]] <- height / ratio 49 | } 50 | } 51 | gtable 52 | } 53 | -------------------------------------------------------------------------------- /R/forest-data.R: -------------------------------------------------------------------------------- 1 | #' Prepares data set for a forest plot 2 | #' 3 | #' 4 | #' @param panels 5 | #' A list of data frames. These should include columns or point 6 | #' estimates, and standard errors or confidence interval limits. If you 7 | #' specify a row.labels data frame, then they must also all contain a key column 8 | #' with the same name (which can be specified by col.key). 9 | #' @param col.key 10 | #' Name of column that links the results given in each data frame 11 | #' provided in panels and the labels given in row.labels. 12 | #' If row.labels data frame is not given, then this column will be used as row labels. 13 | #' (Default: "key") 14 | #' @param row.labels 15 | #' A data frame that contains the labels to be used for the 16 | #' rows of the plot. Use NA if a lower level heading is not required for a given row. 17 | #' @param row.labels.levels 18 | #' A character vector. The names of columns in row.labels 19 | #' to use as headings/subheadings/labels for labelling rows. 20 | #' @param rows 21 | #' If set, then only rows matching these labels (at the first level) will be included. 22 | #' @param row.labels.space 23 | #' A numeric vector specifying the space 24 | #' after a row label heading, at the end of a row label heading 'section'. (Default: c(0, 1, 0, 0)) 25 | #' @param panel.names 26 | #' A character vector. The names to be used for each forest plot panel. 27 | #' If none provided, then they will be numbered 1, 2, 3 ... 28 | #' @param col.estimate,col.stderr,col.lci,col.uci 29 | #' Names of columns for: point estimates, standard errors, lower and upper limits of confidence intervals. 30 | #' @param col.left,col.right 31 | #' Names of columns to be printed to the left/right of the plot. 32 | #' @param col.keep 33 | #' Names of additional columns to be kept in returned data frame. 34 | #' @param ci.delim 35 | #' Character string to separate lower and upper limits of confidence interval. (Default: ", ") 36 | #' @param digits 37 | #' Number of digits after decimal point to show for estimates and confidence intervals. (Default: 2) 38 | #' @param exponentiate 39 | #' Exponentiate estimates (and CIs) before plotting. (Default: TRUE) 40 | #' @param scalepoints 41 | #' Should the points be scaled by inverse of the standard error? (Default: FALSE) 42 | #' @param minse 43 | #' Minimum standard error to use when scaling point size. (Default will use minimum in the data.) 44 | #' @param addtext 45 | #' A list of data frames. List must be the same length as panels. 46 | #' Data frames should contain a column with the name specified in col.key, 47 | #' and one or more of: 48 | #' 49 | #' 1. a column named 'text' containing character strings 50 | #' 51 | #' 2. columns named 'het_dof', 'het_stat', and 'het_p' containing character strings 52 | #' 53 | #' 3. columns names 'trend_stat' and 'trend_p' containing character strings 54 | #' 55 | #' The character strings, heterogeneity test, and trend test results will 56 | #' be plotted in the column of estimates and CIs, below the row with the key 57 | #' given in the col.key column. 58 | #' @param col.diamond 59 | #' Plot estimates and CIs as diamonds. Name of a column of logical values. 60 | #' @param diamond 61 | #' Alternative to col.diamond. A character vectors identify the rows 62 | #' (using the key values) for which the estimate and CI should be plotted using a diamond. 63 | #' @param bold.labels 64 | #' A character vector identifying row labels (using key values) which should additionally be bold. (Default: NULL) 65 | #' 66 | #' @return A dataset from which a forest plot can be generated. 67 | #' 68 | #' 69 | #' @keywords internal 70 | #' 71 | #' @importFrom rlang .data 72 | #' @importFrom utils compareVersion 73 | #' @importFrom utils packageVersion 74 | #' 75 | #' @export 76 | 77 | forest_data <- function( 78 | panels, 79 | panel.names = NULL, 80 | col.key = "key", 81 | col.estimate = "estimate", 82 | col.stderr = "stderr", 83 | col.lci = NULL, 84 | col.uci = NULL, 85 | col.left = NULL, 86 | col.right = NULL, 87 | col.keep = NULL, 88 | row.labels = NULL, 89 | row.labels.levels = NULL, 90 | rows = NULL, 91 | row.labels.space = c(0, 1, 0, 0), 92 | ci.delim = ", ", 93 | digits = 2, 94 | exponentiate = TRUE, 95 | scalepoints = FALSE, 96 | minse = NULL, 97 | addtext = NULL, 98 | diamond = NULL, 99 | col.diamond = NULL, 100 | bold.labels = NULL 101 | ){ 102 | 103 | # check function arguments 104 | if (is.data.frame(panels)) { 105 | panels <- list(panels) 106 | } 107 | if (is.data.frame(addtext)) { 108 | addtext <- list(addtext) 109 | } 110 | 111 | ## check columns in addtext are character 112 | for (addtextframe in addtext){ 113 | for (textcol in c("text", "expr", "het_dof", "het_stat", "het_p", "trend_stat", "trend_p")){ 114 | if (!is.null(addtextframe[[textcol]]) && !is.character(addtextframe[[textcol]])){ 115 | rlang::abort(glue::glue("'{textcol}' in addtext is not character")) 116 | } 117 | } 118 | } 119 | 120 | if (is.null(panel.names)) { panel.names <- as.character(1:length(panels)) } 121 | 122 | column_names_in_data <- purrr::reduce(lapply(panels, names), intersect) 123 | 124 | if (!col.key %in% column_names_in_data) { 125 | if (col.key != "key") { 126 | rlang::inform(glue::glue("col.key '{col.key}' not found, using row number as row labels.")) 127 | col.key <- "key" 128 | } 129 | for (i in seq_along(panels)){ 130 | panels[[i]][["key"]] <- seq_len(nrow(panels[[i]])) 131 | } 132 | } 133 | 134 | if (is.null(row.labels.levels)) { 135 | row.labels.levels <- names(row.labels) 136 | row.labels.levels <- row.labels.levels[!row.labels.levels == col.key] 137 | } 138 | 139 | if (!is.null(col.lci) && is.null(col.uci)) { 140 | rlang::abort("col.lci and col.uci must both be specified") 141 | } 142 | if (is.null(col.lci) && !is.null(col.uci)){ 143 | rlang::abort("col.lci and col.uci must both be specified") 144 | } 145 | if (!is.character(panel.names)) { 146 | rlang::abort("panel.names must be a character vector") 147 | } 148 | if (!all(!duplicated(panel.names))) { 149 | rlang::abort("panel.names must be unique") 150 | } 151 | if (length(panels) != length(panel.names)) { 152 | rlang::abort("panels and panel.names must be the same length") 153 | } 154 | if (!(length(row.labels.space) >= 2*(length(row.labels.levels) - 1))) { 155 | rlang::abort("row.labels.space must be at least 2*(length(row.labels.levels)-1)") 156 | } 157 | if (!is.null(row.labels) && !all(row.labels.levels %in% names(row.labels))) { 158 | rlang::abort("row.labels.levels must be columns in row.labels") 159 | } 160 | if(!is.null(row.labels) && !all(sapply(row.labels[row.labels.levels], is.character))) { 161 | rlang::abort("row.labels.levels columns must be character") 162 | } 163 | 164 | 165 | # filter row.labels according to rows argument 166 | if (!is.null(rows)) { 167 | row.labels <- row.labels %>% 168 | dplyr::filter(.data[[row.labels.levels[[1]]]] %in% rows) 169 | } 170 | 171 | # Make vector of keys after which extra rows are added for addtext 172 | addtextcols <- tibble::tibble(text = character(), 173 | expr = character(), 174 | het_dof = character(), 175 | het_stat = character(), 176 | het_p = character(), 177 | trend_stat = character(), 178 | trend_p = character()) 179 | extrarowkeys <- c() 180 | if (!is.null(addtext)) { 181 | for (i in 1:length(addtext)) { 182 | addtext[[i]] <- dplyr::bind_rows(addtextcols, addtext[[i]]) %>% 183 | dplyr::mutate(addtext = dplyr::case_when( 184 | !is.na(text) ~ paste0("'", text, "'"), 185 | !is.na(expr) ~ expr, 186 | !is.na(het_stat) ~ make_heterogeneity_string(het_dof, het_stat, het_p), 187 | !is.na(trend_stat) ~ make_trend_string(trend_stat, trend_p) 188 | )) %>% 189 | dplyr::select(key = !!rlang::sym(col.key), 190 | .data$addtext) %>% 191 | dplyr::mutate(key = as.character(.data$key)) %>% 192 | dplyr::group_by(.data$key) %>% 193 | dplyr::mutate(addtextrow = 1:dplyr::n() - 1) %>% 194 | dplyr::ungroup() 195 | } 196 | extrarowkeys <- purrr::reduce(purrr::map(addtext, 197 | ~ dplyr::count(., .data$key)), 198 | dplyr::bind_rows) %>% 199 | dplyr::group_by(.data$key) %>% 200 | dplyr::summarise(n = max(.data$n)) 201 | extrarowkeys <- rep(extrarowkeys$key, extrarowkeys$n) 202 | } 203 | 204 | # create data frame of row numbers and labels 205 | if (is.null(row.labels)) { 206 | 207 | keys <- unique(unlist(lapply(panels, function(x) x[[col.key]]))) 208 | out <- tibble::tibble(row.label = keys, 209 | key = keys, 210 | row.height = NA, 211 | spacing_row = FALSE) %>% 212 | dplyr::select(.data$row.label, .data$key, .data$row.height, .data$spacing_row) 213 | } else { 214 | 215 | if (!col.key %in% names(row.labels)) rlang::abort(glue::glue("{col.key} must be a column in {deparse(substitute(row.labels))}")) 216 | 217 | for (panel in panels) { 218 | if (!col.key %in% names(panel)) rlang::abort(glue::glue("{col.key} must be a column in every data frame given in panels")) 219 | } 220 | 221 | ## number of levels of row labels 222 | n_row_label_levels <- length(row.labels.levels) 223 | 224 | ## add key column 225 | row.labels <- row.labels %>% 226 | dplyr::mutate(key = !!sym(col.key)) 227 | 228 | ## make sure levels with smaller indices are not NA 229 | for (i in 1:n_row_label_levels){ 230 | row.labels <- row.labels %>% 231 | dplyr::rowwise() %>% 232 | dplyr::mutate( 233 | "row_label_level_{i}" := { 234 | non_missing_values <- na.omit(dplyr::c_across(dplyr::all_of(row.labels.levels))) 235 | ifelse(length(non_missing_values) >= 1, non_missing_values[i], NA) 236 | }) 237 | } 238 | 239 | ## create out data frame using last level of row labels 240 | out <- row.labels %>% 241 | dplyr::mutate(row.label = .data[[paste0("row_label_level_", n_row_label_levels)]], 242 | row.height = NA, 243 | spacing_row = FALSE) 244 | 245 | ## iterate over row_label_level_ columns to add headings 246 | if (n_row_label_levels > 1){ 247 | for (i in (n_row_label_levels - 1):1) { 248 | out <- out %>% 249 | dplyr::group_by(!!!syms(paste0("row_label_level_", 1:i))) %>% 250 | tidyr::nest() %>% 251 | dplyr::mutate(res = purrr::map(.data$data, 252 | ~ add_row_label_above(., 253 | .data[[paste0("row_label_level_", i)]], 254 | row.labels.space[[i*2-1]], 255 | row.labels.space[[i*2]]))) %>% 256 | dplyr::select(-.data$data) %>% 257 | tidyr::unnest(cols = "res") %>% 258 | dplyr::ungroup() 259 | } 260 | } 261 | } 262 | 263 | # Add extra rows for addtext 264 | out <- dplyr::mutate(out, extrarowkey = NA_character_) 265 | if (!is.null(addtext)) { 266 | for (k in 1:length(extrarowkeys)) { 267 | out <- out %>% 268 | dplyr::add_row(row.label = "", 269 | extrarowkey = paste0(extrarowkeys[[k]]), 270 | spacing_row = FALSE, 271 | .after = which(out$key == extrarowkeys[[k]])) 272 | } 273 | } 274 | 275 | out <- out %>% 276 | dplyr::group_by(.data$extrarowkey) %>% 277 | dplyr::mutate(addtextrow = 1:dplyr::n() - 1) %>% 278 | dplyr::ungroup() 279 | 280 | # remove any blank rows at bottom if needed 281 | while (utils::tail(out$row.label, 1) == "" & is.na(utils::tail(out$extrarowkey, 1))) { 282 | out <- dplyr::slice(out, 1:(dplyr::n() - 1)) 283 | } 284 | 285 | # handle row.labels that start with "+" 286 | out$row.label <- gsub("^\\+", "+", out$row.label) 287 | 288 | # create row number and select only needed rows and columns 289 | out <- out %>% 290 | dplyr::mutate(row = cumsum(dplyr::coalesce(.data$row.height, 1))) %>% 291 | dplyr::filter(!.data$spacing_row) %>% 292 | dplyr::select(.data$row, .data$row.label, .data$key, .data$extrarowkey, .data$addtextrow) 293 | 294 | # make datatoplot 295 | datatoplot <- tibble::tibble() 296 | 297 | for (i in 1:length(panels)) { 298 | if (!is.null(col.lci)) { 299 | panels[[i]] <- panels[[i]] %>% 300 | dplyr::select(key = !!rlang::sym(col.key), 301 | !!!rlang::syms(col.left), 302 | estimate = !!rlang::sym(col.estimate), 303 | lci = !!rlang::sym(col.lci), 304 | uci = !!rlang::sym(col.uci), 305 | !!!rlang::syms(col.right), 306 | !!!rlang::syms(col.keep)) 307 | } else { 308 | panels[[i]] <- panels[[i]] %>% 309 | dplyr::select(key = !!rlang::sym(col.key), 310 | !!!rlang::syms(col.left), 311 | estimate = !!rlang::sym(col.estimate), 312 | stderr = !!rlang::sym(col.stderr), 313 | !!!rlang::syms(col.right), 314 | !!!rlang::syms(col.keep)) 315 | } 316 | 317 | out1 <- merge(out, panels[[i]], by = "key", all.x = TRUE) %>% 318 | dplyr::mutate(panel = panel.names[[i]]) 319 | 320 | if (!is.null(addtext)){ 321 | out1 <- merge(out1, addtext[[i]], 322 | by.x = c("extrarowkey", "addtextrow"), 323 | by.y = c("key", "addtextrow"), 324 | all.x = TRUE) 325 | } else { 326 | out1 <- dplyr::mutate(out1, addtext = as.character(NA)) 327 | } 328 | 329 | datatoplot <- dplyr::bind_rows(datatoplot, out1) 330 | } 331 | 332 | 333 | if (exponentiate == TRUE) { 334 | tf <- exp 335 | inv_tf <- log 336 | } else { 337 | tf <- identity 338 | inv_tf <- identity 339 | } 340 | 341 | # Make 'panel' a factor, so that facet panels will be in the correct order 342 | datatoplot <- datatoplot %>% 343 | dplyr::mutate(panel = factor(panel, 344 | levels = panel.names, 345 | labels = panel.names, 346 | ordered = TRUE)) 347 | 348 | 349 | # Calculate transformed estimates, confidence intervals, and point size 350 | if (!is.null(col.lci)) { 351 | datatoplot <- datatoplot %>% 352 | dplyr::mutate(estimate_transformed = tf(.data$estimate), 353 | lci_transformed = tf(.data$lci), 354 | uci_transformed = tf(.data$uci) 355 | ) 356 | if (is.null(minse)){ 357 | minse <- min((datatoplot$uci - datatoplot$lci)/(2*1.96), na.rm = TRUE) 358 | } else { 359 | if (minse > min((datatoplot$uci - datatoplot$lci)/(2*1.96), na.rm = TRUE)) rlang::abort("minse is larger than the minimum standard error in the data") 360 | } 361 | if (scalepoints){ 362 | datatoplot$size <- 2*1.96*minse/(datatoplot$uci - datatoplot$lci) 363 | } 364 | } else { 365 | datatoplot <- datatoplot %>% 366 | dplyr::mutate(estimate_transformed = tf(.data$estimate), 367 | lci_transformed = tf(.data$estimate - 1.96*.data$stderr), 368 | uci_transformed = tf(.data$estimate + 1.96*.data$stderr) 369 | ) 370 | if (is.null(minse)){ 371 | minse <- min(datatoplot$stderr, na.rm = TRUE) 372 | } else { 373 | if (minse > min(datatoplot$stderr, na.rm = TRUE)) rlang::abort("minse is larger than the minimum standard error in the data") 374 | } 375 | if (scalepoints) { 376 | datatoplot$size <- minse/datatoplot$stderr 377 | } 378 | } 379 | 380 | # Create auto_estcolumn column (text of estimates and CIs) 381 | datatoplot <- datatoplot %>% 382 | dplyr::mutate(auto_estcolumn = dplyr::if_else( 383 | !is.na(.data$estimate), 384 | make_auto_estcolumn_text(.data$estimate_transformed, 385 | .data$lci_transformed, 386 | .data$uci_transformed, 387 | digits, 388 | ci.delim), 389 | NA_character_)) %>% 390 | dplyr::select(-.data$extrarowkey, -.data$addtextrow) %>% 391 | dplyr::arrange(panel, row) 392 | 393 | # Create diamonds_polygon column 394 | datatoplot$as_diamond <- FALSE 395 | if (!is.null(diamond) | !is.null(col.diamond)){ 396 | datatoplot <- datatoplot %>% 397 | dplyr::rowwise() %>% 398 | dplyr::mutate( 399 | diamond_polygon = list(data.frame(x = c(.data$lci_transformed, 400 | .data$estimate_transformed, 401 | .data$uci_transformed, 402 | .data$estimate_transformed), 403 | y = c(0, -0.25, 0, 0.25)))) %>% 404 | dplyr::ungroup() 405 | 406 | if (!is.null(col.diamond)){ 407 | datatoplot <- datatoplot %>% 408 | dplyr::mutate(diamond_polygon = dplyr::if_else(.data$key %in% diamond | .data[[col.diamond]], .data$diamond_polygon, NA)) 409 | } else { 410 | datatoplot <- datatoplot %>% 411 | dplyr::mutate(diamond_polygon = dplyr::if_else(.data$key %in% diamond, .data$diamond_polygon, NA)) 412 | } 413 | datatoplot$as_diamond <- !sapply(datatoplot$diamond_polygon, is.null) 414 | } 415 | 416 | 417 | # Create rowlabels data frame and add as attribute to datatoplot data frame 418 | ## Add bold formatting to row labels (if there is no estimate, or key is in bold.labels) 419 | rowlabels <- datatoplot %>% 420 | dplyr::group_by(.data$row) %>% 421 | dplyr::summarise(row.label = dplyr::first(.data$row.label), 422 | bold = all(is.na(.data$estimate_transformed) | all(.data$key %in% bold.labels)), 423 | .groups = "drop") %>% 424 | dplyr::mutate(row.label = dplyr::if_else(.data$bold & .data$row.label != "", 425 | paste0("**", .data$row.label, "**"), 426 | as.character(.data$row.label))) %>% 427 | dplyr::arrange(.data$row) %>% 428 | dplyr::select(.data$row, .data$row.label) 429 | 430 | attr(datatoplot, "rowlabels") <- rowlabels 431 | 432 | 433 | 434 | return(datatoplot) 435 | } 436 | 437 | 438 | 439 | 440 | #' Create heterogeneity string 441 | #' 442 | #' @keywords internal 443 | #' @noRd 444 | make_heterogeneity_string <- function(het_dof, het_stat, het_p) { 445 | paste0("paste('Heterogeneity: ', chi[", 446 | het_dof, 447 | "]^2,'=", 448 | het_stat, 449 | " (p", 450 | het_p, 451 | ")', sep='')") 452 | } 453 | 454 | 455 | 456 | 457 | #' Create trend string 458 | #' 459 | #' @keywords internal 460 | #' @noRd 461 | make_trend_string <- function(trend_stat, trend_p) { 462 | paste0("paste('Trend: ', chi[1]^2,'=", 463 | trend_stat, 464 | " (p", 465 | trend_p, 466 | ")', sep='')") 467 | } 468 | 469 | 470 | 471 | 472 | #' Add 'heading' above row label data 473 | #' 474 | #' @keywords internal 475 | #' @noRd 476 | add_row_label_above <- function(data, 477 | heading, 478 | blank_after_heading, 479 | blank_after_section){ 480 | if (!grepl("@nolabel$", heading)) { 481 | out <- tibble::add_row(data, 482 | row.label = !!heading, 483 | spacing_row = FALSE, 484 | .before = 1) %>% 485 | tibble::add_row(row.label = "", 486 | row.height = blank_after_heading, 487 | spacing_row = TRUE, 488 | .before = 2) 489 | if(all(is.na(data$row.label))){ 490 | out <- dplyr::mutate(data, row.label = !!heading) 491 | } 492 | } else { 493 | out <- data 494 | } 495 | out <- tibble::add_row(out, 496 | row.label = "", 497 | row.height = blank_after_section, 498 | spacing_row = TRUE) 499 | out 500 | } 501 | 502 | 503 | #' Create text for the auto-generated estimate column 504 | #' 505 | #' @keywords internal 506 | #' @noRd 507 | make_auto_estcolumn_text <- function(estimate_transformed, 508 | lci_transformed, 509 | uci_transformed, 510 | digits, 511 | ci.delim) { 512 | est <- format(round(estimate_transformed, digits), nsmall = digits, trim = T) 513 | lci <- format(round(lci_transformed, digits), nsmall = digits, trim = T) 514 | uci <- format(round(uci_transformed, digits), nsmall = digits, trim = T) 515 | text <- glue::glue("{est} ({lci}{ci.delim}{uci})") 516 | text[lci == "NA" | uci == "NA"] <- est[lci == "NA" | uci == "NA"] 517 | return(text) 518 | } 519 | 520 | -------------------------------------------------------------------------------- /R/forest-plot-list-xlim.R: -------------------------------------------------------------------------------- 1 | #' forest plots when xlim is a list 2 | #' @noRd 3 | forest_plot_list_xlim <- function( 4 | ## original arguments passed to 5 | ## separate forest_plot() calls 6 | original_arguments, 7 | ## arguments that need to evaluated first 8 | ## because they are used by 9 | xlim, 10 | xticks, 11 | panels, 12 | xlab, 13 | col.left.heading, 14 | col.right.heading, 15 | panel.headings, 16 | ## the new environment in which to evaluate forest_plot() 17 | envir 18 | ){ 19 | 20 | ## check arguments 21 | if (!is.list(xlim) | !is.list(xticks) | !is.list(panels)){ 22 | rlang::abort("panels, xlim and xticks must be lists") 23 | } 24 | if (length(unique(c(length(xlim), length(xticks), length(panels)))) != 1){ 25 | rlang::abort("panels, xlim and xticks must be lists of the same length") 26 | } 27 | if (!is.null(panel.headings) && length(panel.headings) != length(panels)){ 28 | rlang::abort("panel.headings must be same length as panels") 29 | } 30 | 31 | ## make lists 32 | xlab <- as.list(xlab) 33 | if (length(xlab) < length(xlim)){ 34 | xlab <- rep(xlab, length(xlim)) 35 | } 36 | if (!is.list(col.left.heading)){ 37 | col.left.heading <- rep(list(col.left.heading), length(xlim)) 38 | } 39 | if (!is.list(col.right.heading)){ 40 | col.right.heading <- rep(list(col.right.heading), length(xlim)) 41 | } 42 | 43 | 44 | ## create arguments for plot.margin and mid.space 45 | plot.margin <- eval(original_arguments$plot.margin) 46 | if (is.null(plot.margin)){ 47 | plot.margin <- eval(formals(forest_plot)$plot.margin) 48 | } 49 | mid.space <- eval(original_arguments$mid.space) 50 | if (is.null(mid.space)){ 51 | mid.space <- eval(formals(forest_plot)$mid.space) 52 | } 53 | 54 | ## create list of plots (one for each panel) 55 | plots_list <- lapply(1:length(xlim), \(i) { 56 | 57 | ## adjust right plot.margin for all but last panel 58 | plot_margin <- plot.margin 59 | if (i != length(xlim)){ 60 | plot_margin[[2]] <- mid.space 61 | } 62 | 63 | update_args <- list(panels = panels[i], 64 | xlim = xlim[[i]], 65 | xticks = xticks[[i]], 66 | plot.margin = plot_margin, 67 | quiet = TRUE) 68 | 69 | if (!is.null(xlab[i]) && length(xlab) > 0){ 70 | update_args$xlab <- xlab[[i]] 71 | } 72 | if (!is.null(col.left.heading[i])){ 73 | update_args$col.left.heading <- col.left.heading[[i]] 74 | } 75 | if (!is.null(col.right.heading[i])){ 76 | update_args$col.right.heading <- col.right.heading[[i]] 77 | } 78 | if (!is.null(panel.headings)){ 79 | update_args$panel.headings <- panel.headings[[i]] 80 | } 81 | 82 | forest <- do.call("forest_plot", 83 | utils::modifyList(original_arguments, update_args), 84 | envir = envir) 85 | 86 | ## adjust left plot.margin for all but first panel 87 | if (i != 1){ 88 | forest$plot$theme$plot.margin[[4]] <- forest$plot$theme$axis.text.y$margin[[2]] 89 | forest$plot <- forest$plot + theme(axis.text.y = element_blank()) 90 | } 91 | 92 | return(forest$plot) 93 | }) 94 | 95 | ## create figure by combining plots 96 | figure <- do.call(gridExtra::gtable_cbind, 97 | lapply(plots_list, ggplotGrob)) 98 | 99 | return(invisible(list(figure = figure, 100 | plots = plots_list))) 101 | } 102 | -------------------------------------------------------------------------------- /R/geom-text-move.R: -------------------------------------------------------------------------------- 1 | #' Text that can be moved 2 | #' 3 | #' This geom adds a fixed horizontal and/or vertical move to ggplot2::geom_text() 4 | #' 5 | #' @section Aesthetics: 6 | #' 7 | #' `geom_text_move()` understands the same aesthetics as `ggplot2::geom_text()` 8 | #' 9 | #' @inheritParams ggplot2::geom_text 10 | #' @param move_x Unit value to move text horizontally (Default: unit(0, "pt")) 11 | #' @param move_y Unit value to move text vertically (Default: unit(0, "pt")) 12 | #' @export 13 | 14 | geom_text_move <- function(mapping = NULL, data = NULL, 15 | stat = "identity", position = "identity", 16 | ..., 17 | parse = FALSE, 18 | nudge_x = 0, 19 | nudge_y = 0, 20 | move_x = unit(0, "pt"), 21 | move_y = unit(0, "pt"), 22 | check_overlap = FALSE, 23 | na.rm = FALSE, 24 | show.legend = NA, 25 | inherit.aes = TRUE) 26 | { 27 | if (!missing(nudge_x) || !missing(nudge_y)) { 28 | if (!missing(position)) { 29 | rlang::abort("You must specify either `position` or `nudge_x`/`nudge_y`.") 30 | } 31 | 32 | position <- position_nudge(nudge_x, nudge_y) 33 | } 34 | 35 | layer( 36 | data = data, 37 | mapping = mapping, 38 | stat = stat, 39 | geom = GeomTextMove, 40 | position = position, 41 | show.legend = show.legend, 42 | inherit.aes = inherit.aes, 43 | params = list( 44 | parse = parse, 45 | check_overlap = check_overlap, 46 | na.rm = na.rm, 47 | move_x = move_x, 48 | move_y = move_y, 49 | ... 50 | ) 51 | ) 52 | } 53 | 54 | #' @rdname geom_text_move 55 | #' @format NULL 56 | #' @usage NULL 57 | GeomTextMove <- ggproto("GeomTextMove", GeomText, 58 | draw_panel = function(data, panel_params, coord, parse = FALSE, 59 | na.rm = FALSE, check_overlap = FALSE, 60 | move_x = unit(0, "pt"), 61 | move_y = unit(0, "pt")) { 62 | text_grob <- ggplot2::GeomText$draw_panel(data = data, 63 | panel_params = panel_params, 64 | coord = coord, 65 | parse = parse, 66 | na.rm = na.rm, 67 | check_overlap = check_overlap) 68 | text_grob$x <- text_grob$x + move_x 69 | text_grob$y <- text_grob$y + move_y 70 | return(text_grob) 71 | } 72 | ) 73 | 74 | 75 | 76 | 77 | 78 | # The geom_text_move() function and GeomTextMove ggproto were developed from the 79 | # geom_text() function and GeomText ggproto in the ggplot2 package, found at 80 | # https://github.com/tidyverse/ggplot2 81 | # The ggplot2 package is released with the following license: 82 | # 83 | # 84 | # # MIT License 85 | # 86 | # Copyright (c) 2020 ggplot2 authors 87 | # 88 | # Permission is hereby granted, free of charge, to any person obtaining a copy 89 | # of this software and associated documentation files (the "Software"), to deal 90 | # in the Software without restriction, including without limitation the rights 91 | # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 92 | # copies of the Software, and to permit persons to whom the Software is 93 | # furnished to do so, subject to the following conditions: 94 | # 95 | # The above copyright notice and this permission notice shall be included in all 96 | # copies or substantial portions of the Software. 97 | # 98 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 99 | # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 100 | # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 101 | # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 102 | # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 103 | # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 104 | # SOFTWARE. 105 | -------------------------------------------------------------------------------- /R/save-figure.R: -------------------------------------------------------------------------------- 1 | #' Prepare figure for saving 2 | #' 3 | #' @param figure Plot (or graphical object). 4 | #' @param title Title to be added to the page. (Default: "") 5 | #' @param title.pos Position of the title text. Default is 1/4 inch from top left of page. 6 | #' (Default: unit.c(unit(1.27/2, "cm"), unit(1, "npc") - unit(1.27/2, "cm"))) 7 | #' @param title.just Justification of the title text. (Default: c(0, 1)) 8 | #' @param title.gpar Graphical parameters for title. (Default: list(fontsize = 12, fontface = "bold")) 9 | #' @param footer Footer to be added to the page. (Default: "") 10 | #' @param footer.pos Position of the footer text. 11 | #' Default is 1/6 inch from bottom and 1/4 inch from left of page. 12 | #' (Default: unit.c(unit(1.27/2, "cm"), unit(1.27/3, "cm"))) 13 | #' @param footer.just Justification of the footer text. (Default: c(0, 0)) 14 | #' @param footer.gpar Graphical parameters for footer. (Default: list(fontsize = 9)) 15 | #' @param margin Margin to be placed around the plot. 16 | #' Default is 2.27cm top, 1.27cm (1/2 inch) other sides. 17 | #' (Default: unit(c(2.27, 1.27, 1.27, 1.27), units = "cm")) 18 | #' @param size A unit vector of length two (width, height). 19 | #' Size of plot (a width/height larger than page weight/height minus margins will be 20 | #' ignored), centred within margins. 21 | #' By default, plot will fill the space within margins. 22 | #' @param valign If size is set, where to place figure within margins. 1 = top, 0.5 = middle, 0 = bottom. (Default: 0.5) 23 | #' @param halign If size is set, where to place figure within margins. 1 = right, 0.5 = middle, 0 = left (Default: 0.5) 24 | #' @param pagesize Page size of output: "A4" or "A5". (Default: "A4") 25 | #' @param landscape Landscape page orientation? (Default: False) 26 | #' @param pagedim Dimensions (width, height) of output. Overrides pagesize and landscape arguments if used. 27 | #' 28 | #' @export 29 | #' 30 | 31 | prepare_figure <- function(figure, 32 | title = "", 33 | title.pos = grid::unit.c(unit(1.27/2, "cm"), 34 | unit(1, "npc") - unit(1.27/2, "cm")), 35 | title.just = c(0, 1), 36 | title.gpar = list(fontsize = 12, 37 | fontface = "bold"), 38 | footer = "", 39 | footer.pos = grid::unit.c(unit(1.27/2, "cm"), 40 | unit(1.27/3, "cm")), 41 | footer.just = c(0, 0), 42 | footer.gpar = list(fontsize = 9), 43 | margin = unit(c(2.27, 1.27, 1.27, 1.27), units = "cm"), 44 | size = NULL, 45 | valign = 0.5, 46 | halign = 0.5, 47 | pagesize = c("A4", "A5"), 48 | landscape = FALSE, 49 | pagedim = NULL){ 50 | 51 | ## Check it figure is a patchwork object, and convert to gtable 52 | if (inherits(figure, "patchwork")){ 53 | figure <- patchwork::patchworkGrob(figure) 54 | } 55 | 56 | ## Set page dimensions 57 | pagesize <- match.arg(pagesize) 58 | if (missing(pagedim)){ 59 | pagedim <- switch(pagesize, 60 | A4 = unit(c(210, 297), "mm"), 61 | A5 = unit(c(148, 210), "mm"), 62 | rlang::abort("Invalid pagesize value.")) 63 | } 64 | 65 | if (landscape){ 66 | pagedim <- rev(pagedim) 67 | } 68 | 69 | 70 | ## Increase margins so that figure will fit dimensions given by size argument 71 | ## (Do not decrease margins) 72 | if (!missing(size)){ 73 | add_to_width_margins <- pagedim[[1]] - size[[1]] - margin[[2]] - margin[[4]] 74 | add_to_width_margins <- grid::unit.pmax(unit(0, "mm"), 75 | grid::convertUnit(add_to_width_margins, "mm")) 76 | margin[[2]] <- margin[[2]] + (1 - halign) * add_to_width_margins 77 | margin[[4]] <- margin[[4]] + halign * add_to_width_margins 78 | add_to_height_margins <- pagedim[[2]] - size[[2]] - margin[[1]] - margin[[3]] 79 | add_to_height_margins <- grid::unit.pmax(unit(0, "mm"), 80 | grid::convertUnit(add_to_height_margins, "mm")) 81 | margin[[1]] <- margin[[1]] + (1 - valign) * add_to_height_margins 82 | margin[[3]] <- margin[[3]] + valign * add_to_height_margins 83 | } 84 | 85 | 86 | ## Arrange figure with page margins 87 | ### Layout matrix 88 | layout <- rbind(c(NA, NA, NA), 89 | c(NA, 1, NA), 90 | c(NA, NA, NA)) 91 | 92 | ## Figure with page margins 93 | figure_with_margins <- gridExtra::arrangeGrob( 94 | figure, 95 | layout_matrix = layout, 96 | widths = grid::unit.c(margin[4], 97 | pagedim[1] - margin[4] - margin[2], 98 | margin[2]), 99 | heights = grid::unit.c(margin[1], 100 | pagedim[2] - margin[1] - margin[3], 101 | margin[3])) 102 | 103 | ## Create title grob 104 | titleGrob <- gridtext::textbox_grob( 105 | title, 106 | gp = do.call(grid::gpar, title.gpar), 107 | x = title.pos[1], 108 | y = title.pos[2], 109 | hjust = title.just[1], 110 | vjust = title.just[2], 111 | maxwidth = pagedim[1] - 2 * title.pos[1]) 112 | 113 | ## Create footer grob 114 | footerGrob <- gridtext::textbox_grob( 115 | footer, 116 | gp = do.call(grid::gpar, footer.gpar), 117 | x = footer.pos[1], 118 | y = footer.pos[2], 119 | hjust = footer.just[1], 120 | vjust = footer.just[2], 121 | maxwidth = pagedim[1] - 2 * footer.pos[1]) 122 | 123 | ## Arrange page with title and footer 124 | page <- grid::gList(figure_with_margins, 125 | titleGrob, 126 | footerGrob) 127 | 128 | ## Dimensions 129 | attr(page, "width") <- grid::convertUnit(pagedim[[1]], "mm") 130 | attr(page, "height") <- grid::convertUnit(pagedim[[2]], "mm") 131 | 132 | attr(figure, "width") <- grid::convertUnit(pagedim[[1]] - margin[[4]] - margin[[2]], "mm") 133 | attr(figure, "height") <- grid::convertUnit(pagedim[[2]] - margin[[1]] - margin[[3]], "mm") 134 | 135 | return(list(page = page, 136 | figure = figure)) 137 | } 138 | 139 | 140 | 141 | 142 | #' Output plots as files 143 | #' 144 | #' @inheritParams prepare_figure 145 | #' @param filename Name of file to create. 146 | #' @param cropped Name of second output file of the figure without margins or title. 147 | #' @param args List of arguments passed to `ggplot2::ggsave()` for the main figure. 148 | #' @param args_cropped List of arguments passed to `ggplot2::ggsave()` for the cropped figure. 149 | #' @param preview Preview the output in the RStudio Viewer pane. (Default: False) 150 | #' @param ... Other arguments passed to \link{prepare_figure}. 151 | #' 152 | #' 153 | #' @export 154 | #' 155 | save_figure <- function(figure, 156 | filename, 157 | cropped = NULL, 158 | args = NULL, 159 | args_cropped = NULL, 160 | preview = FALSE, 161 | ...){ 162 | 163 | # Prepare figure 164 | figure <- prepare_figure(figure, ...) 165 | 166 | # Save to file 167 | figargs <- list(filename = filename, 168 | plot = figure$page, 169 | width = attr(figure$page, "width"), 170 | height = attr(figure$page, "height"), 171 | units = "mm", 172 | bg = "transparent") 173 | if(!is.null(args)){figargs <- utils::modifyList(figargs, args)} 174 | 175 | if (preview) { 176 | do.call("ggpreview", figargs) 177 | return(invisible(filename)) 178 | } 179 | 180 | do.call("ggsave", figargs) 181 | 182 | ## Save cropped figure to PNG file 183 | if (!is.null(cropped)){ 184 | if (!is.character(cropped)) {rlang::abort("cropped should be a file name.")} 185 | figargs <- list(filename = cropped, 186 | plot = figure$figure, 187 | width = attr(figure$figure, "width"), 188 | height = attr(figure$figure, "height"), 189 | units = "mm", 190 | bg = "transparent") 191 | if(!is.null(args_cropped)){figargs <- utils::modifyList(figargs, args_cropped)} 192 | do.call("ggsave", figargs) 193 | } 194 | 195 | return(invisible(filename)) 196 | } 197 | 198 | 199 | 200 | 201 | 202 | 203 | #' Create a plot preview and display it in the Viewer pane. 204 | #' 205 | #' This function saves a ggplot2 plot to a temporary PNG file and then embeds it in an HTML 206 | #' page, which is opened in the Viewer pane. 207 | #' 208 | #' @details # Device 209 | #' The plot is saved using `ggsave` with the `png` device, regardless of what is specified in 210 | #' the call, so any arguments not used by `ggsave` or `png` are ignored. 211 | #' 212 | #' @param ... Arguments passed to `ggsave` and the PNG device function. 213 | #' 214 | #' @export 215 | #' 216 | ggpreview <- function(...) { 217 | ## create temporary files 218 | temp_img <- tempfile() 219 | temp_html <- tempfile(fileext = ".html") 220 | 221 | ## save using png device 222 | call <- as.list(match.call())[-1] 223 | call <- utils::modifyList(call, 224 | list(filename = temp_img, 225 | device = "png")) 226 | call <- call[names(call) %in% c(names(formals(ggsave)), 227 | names(formals(grDevices::png)))] 228 | do.call("ggsave", call) 229 | 230 | ## create html file 231 | html <- c("", 232 | "", 233 | "Plot preview", 234 | "", 235 | "", 236 | glue::glue("", 243 | "") 244 | con <- file(temp_html, open = "w", encoding = "UTF-8") 245 | writeLines( 246 | html, 247 | con = con, 248 | sep = "\n") 249 | close(con) 250 | 251 | ## show html file in Viewer pane 252 | viewer <- getOption("viewer", default = function(url){}) 253 | viewer(temp_html) 254 | } 255 | -------------------------------------------------------------------------------- /R/shape-plot-parts.R: -------------------------------------------------------------------------------- 1 | #' code for CI colours if using height 2 | #' @noRd 3 | shape.cicolourcode <- function(scale, 4 | ylims, 5 | lci_string, 6 | uci_string, 7 | pointsize, 8 | size, 9 | stroke, 10 | height, 11 | ratio, 12 | gap, 13 | ext, 14 | shape, 15 | cicolours, 16 | col.group) { 17 | 18 | if(!inherits(height, "unit")){return(NULL)} 19 | 20 | height.mm <- as.numeric(grid::convertUnit(height, "mm")) 21 | 22 | ymin <- ylims[[1]] 23 | ymax <- ylims[[2]] 24 | if (scale == "log"){ 25 | ymin <- log(ymin) 26 | ymax <- log(ymax) 27 | lci_string <- paste0(scale, '(', lci_string, ')') 28 | uci_string <- paste0(scale, '(', uci_string, ')') 29 | } 30 | 31 | adjust_size <- (ymax - ymin) * (pointsize + 2 * stroke) / height.mm 32 | 33 | x <- c( 34 | '# Create column for CI colour', 35 | 'datatoplot <- datatoplot %>%', 36 | indent(2, 37 | glue::glue('dplyr::mutate(narrowci = (({uci_string}) - ({lci_string})) <= '), 38 | indent(26, 39 | glue::glue('({size})/max({size}) * {adjust_size} * dplyr::recode({c(shape$arg, column_name(shape$aes))}, `22` = sqrt(pi / 4) * 0.7528125, .default = 0.7528125)) %>%')), 40 | 'dplyr::mutate(cicolour = dplyr::case_when(')) 41 | 42 | if(!is.null(col.group)){ 43 | x <- c(x, 44 | indent(27, 45 | glue::glue('as.numeric({col.group}) / length(levels({col.group})) > 0.5 ~ "black",'), 46 | 'narrowci ~ "white",', 47 | 'TRUE ~ "black"))'), 48 | '') 49 | } else { 50 | x <- c(x, 51 | indent(27, 52 | glue::glue('narrowci ~ {cicolours[length(cicolours)]},'), 53 | glue::glue('TRUE ~ {cicolours[1]}))')), 54 | '') 55 | } 56 | x 57 | } 58 | 59 | 60 | #' code for CI under if using height 61 | #' @noRd 62 | shape.ciundercode <- function(height) { 63 | 64 | if(!inherits(height, "unit")){return(NULL)} 65 | 66 | c('# Create column for CI under', 67 | 'datatoplot <- datatoplot %>%', 68 | indent(2, 69 | 'dplyr::mutate(ciunder = dplyr::if_else(narrowci, FALSE, TRUE))'), 70 | '') 71 | } 72 | 73 | 74 | 75 | #' code to start ggplot 76 | #' @noRd 77 | shape.start.ggplot <- function(col.x, est_string, group_string) { 78 | c('# Create the plot with main aesthetics', 79 | glue::glue('plot <- ggplot(datatoplot, aes(x = {col.x}, y = {est_string}{group_string})) +'), 80 | '') 81 | } 82 | 83 | #' code for axis scales 84 | #' @noRd 85 | shape.axes <- function(xbreaks, scale, ybreaks) { 86 | c(if (!is.null(xbreaks) && xbreaks != "NULL"){ 87 | c('# Set the x-axis scale', 88 | glue::glue('scale_x_continuous(breaks = {xbreaks}) +'), 89 | '') 90 | }, 91 | if (ybreaks == "NULL" & scale != "identity") { 92 | c('# Set the y-axis scale', 93 | glue::glue('scale_y_continuous(trans = "{scale}") +'), 94 | '') 95 | } else if (scale != "identity") { 96 | c('# Set the y-axis scale', 97 | glue::glue('scale_y_continuous(trans = "{scale}",'), 98 | glue::glue(' breaks = {ybreaks}) +'), 99 | '') 100 | }) 101 | } 102 | 103 | 104 | #' code for scales 105 | #' @noRd 106 | shape.scales <- function(one_over_minse, pointsize, scale_fill_string) { 107 | c(make_layer( 108 | '# Set the scale for the size of boxes', 109 | f = "scale_radius", 110 | arg = c('guide = "none"', 111 | 'limits = c(0, {one_over_minse})', 112 | 'range = c(0, {pointsize})') 113 | ), 114 | '# Use identity for aesthetic scales', 115 | 'scale_shape_identity() +', 116 | 'scale_colour_identity() +', 117 | scale_fill_string, 118 | '') 119 | } 120 | 121 | #' code for lines 122 | #' @noRd 123 | shape.lines <- function(addaes, 124 | col.lci, 125 | col.estimate, 126 | col.stderr, 127 | addarg, 128 | plotcolour) { 129 | make_layer('# Plot lines (linear fit through estimates, weighted by inverse variance)', 130 | f = "stat_smooth", 131 | aes = c(addaes$lines, 132 | if (!is.null(col.lci)) { 133 | 'weight = 1/(({column_name(col.estimate)} - {column_name(col.lci)})^2)' 134 | } else { 135 | 'weight = 1/({column_name(col.stderr)}^2)' 136 | }), 137 | arg = c(addarg$lines, 138 | 'method = "glm"', 139 | 'formula = y ~ x', 140 | 'se = FALSE', 141 | 'colour = {quote_string(plotcolour)}', 142 | 'linetype = "dashed"', 143 | 'linewidth = 0.25') 144 | ) 145 | } 146 | 147 | 148 | #' code for points at estimates 149 | #' @noRd 150 | shape.estimates.points <- function(addaes, 151 | size, 152 | shape, 153 | fill_string, 154 | colour, 155 | addarg, 156 | stroke) { 157 | make_layer( 158 | '# Plot the point estimates', 159 | f = "geom_point", 160 | aes = c( 161 | addaes$point, 162 | 'size = {size}', 163 | 'shape = {column_name(shape$aes)}', 164 | '{fill_string$aes}', 165 | 'colour = {column_name(colour$aes)}'), 166 | arg = c(addarg$point, 167 | 'shape = {shape$arg}', 168 | 'colour = {quote_string(colour$arg)}', 169 | '{fill_string$arg}', 170 | 'stroke = {stroke}') 171 | ) 172 | } 173 | 174 | #' code for text above points 175 | #' @noRd 176 | shape.estimates.text <- function(addaes, 177 | uci_string, 178 | est_string, 179 | addarg, 180 | text_size, 181 | plotcolour, 182 | digits) { 183 | make_layer( 184 | '# Plot point estimates text', 185 | f = "geom_text", 186 | aes = c(addaes$estimates, 187 | 'y = {uci_string}', 188 | 'label = format(round({est_string}, {digits}), nsmall = {digits})'), 189 | arg = c(addarg$estimates, 190 | 'vjust = -0.8', 191 | 'size = {text_size}', 192 | 'colour = {quote_string(plotcolour)}') 193 | ) 194 | } 195 | 196 | #' code for text below points 197 | #' @noRd 198 | shape.n.events.text <- function(addaes, 199 | lci_string, 200 | col.n, 201 | addarg, 202 | text_size, 203 | plotcolour) { 204 | make_layer( 205 | '# Plot n events text', 206 | f = "geom_text", 207 | aes = c(addaes$n, 208 | 'y = {lci_string}', 209 | 'label = {col.n}'), 210 | arg = c(addarg$n, 211 | 'vjust = 1.8', 212 | 'size = {text_size}', 213 | 'colour = {quote_string(plotcolour)}') 214 | ) 215 | } 216 | 217 | 218 | 219 | #' code for confidence interval lines 220 | #' @noRd 221 | shape.cis <- function(addaes, 222 | lci_string, 223 | uci_string, 224 | cicolour, 225 | addarg, 226 | ciunder, 227 | base_line_size, 228 | type = c("all", "before", "after", "null")) { 229 | if (type == "null"){return(NULL)} 230 | make_layer( 231 | '# Plot the CIs', 232 | f = "geom_linerange", 233 | aes = c(addaes$ci, 234 | 'ymin = {lci_string}', 235 | 'ymax = {uci_string}', 236 | 'colour = {column_name(cicolour$aes)}'), 237 | arg = c(addarg$ci, 238 | switch(type, 239 | "all" = NULL, 240 | "before" = 'data = ~ dplyr::filter(.x, {column_name(ciunder)})', 241 | "after" = 'data = ~ dplyr::filter(.x, !{column_name(ciunder)})'), 242 | 'colour = {quote_string(cicolour$arg)}', 243 | 'linewidth = {base_line_size}') 244 | ) 245 | } 246 | 247 | 248 | 249 | #' code for titles 250 | #' @noRd 251 | shape.titles <- function(xlab, title, ylab) { 252 | c( 253 | '# Add titles', 254 | glue::glue('xlab("{xlab}") +'), 255 | glue::glue('ylab("{ylab}") +'), 256 | if (!is.null(title) && !title %in% c("", NA)){ 257 | glue::glue('ggtitle("{title}") +') 258 | }, 259 | '' 260 | ) 261 | } 262 | 263 | #' code for ckb_style() 264 | #' @noRd 265 | shape.plot.like.ckb <- function(xlims, 266 | ylims, 267 | gap, 268 | ext, 269 | ratio, 270 | width, 271 | height, 272 | base_size, 273 | base_line_size, 274 | plotcolour, 275 | axis.title.margin) { 276 | make_layer( 277 | '# Plot like a CKB plot', 278 | f = "ckbplotr::ckb_style", 279 | arg = c('xlims = {xlims}', 280 | 'ylims = {ylims}', 281 | 'gap = {gap}', 282 | 'ext = {ext}', 283 | 'ratio = {ratio}', 284 | 'width = {printunit(width)}', 285 | 'height = {printunit(height)}', 286 | 'base_size = {base_size}', 287 | 'base_line_size = {base_line_size}', 288 | 'colour = {quote_string(plotcolour)}', 289 | 'axis.title.margin = {axis.title.margin}'), 290 | plus = TRUE 291 | ) 292 | } 293 | 294 | #' code for theme 295 | #' @noRd 296 | shape.theme <- function(legend.position, add) { 297 | make_layer( 298 | '# Add theme', 299 | f = "theme", 300 | arg = 'legend.position = {deparse(legend.position)}', 301 | plus = !is.null(add$end) 302 | ) 303 | } 304 | 305 | -------------------------------------------------------------------------------- /R/shape-plot.R: -------------------------------------------------------------------------------- 1 | 2 | #' Make a shape plot with ggplot2 3 | #' 4 | #' 5 | #' @inheritParams ckb_style 6 | #' 7 | #' @param data The data frame containing estimates to be plotted. 8 | #' @param col.x Name of column that provides the x-axis value (e.g. exposure, risk factor, dependent variable). (Default: "x") 9 | #' @param col.estimate Name of column that provides point estimates. 10 | #' (Default: "estimate") 11 | #' @param col.stderr Name of column that provides standard errors. (Default: "stderr") 12 | #' @param col.lci Name of column that provides lower limit of confidence intervals. 13 | #' @param col.uci Name of column that provides upper limit of confidence intervals. 14 | #' @param col.n Name of column that provides number to be plotted below CIs. 15 | #' @param col.group Name of column that groups the estimates. (Default: NULL) 16 | #' @param shape Shape of points. An integer, or name of a column of integers. (Default: 15) 17 | #' @param plotcolour Colour for non-data aspects of the plot. (Default: "black") 18 | #' @param colour Colour of points. Name of a colour, or name of a column of colour names. (Default will use plotcolour) 19 | #' @param cicolour Colour of CI lines. Colour of CI lines. Name of a colour, or name of a column of colour names. (Default will use plotcolour) 20 | #' @param fill Fill colour of points. Fill colour of points. Name of a colour, or name of a column of colour names. (Default will use plotcolour) 21 | #' @param ciunder Plot CI lines before points. A logical value, or name of a column of logical values. (Default will plot CI lines after points.) 22 | #' @param lines Plot lines (linear fit through estimates, weighted by inverse variance). (Default: FALSE) 23 | #' @param exponentiate Exponentiate estimates (and CIs) before plotting, 24 | #' use log scale on the axis. (Default: FALSE) 25 | #' @param logscale Use log scale for vertical axis. (Default: exponentiate) 26 | #' @param scalepoints Should the points be scaled by inverse of the standard 27 | #' error? (Default: FALSE) 28 | #' @param digits Number of digits to use in text of estimates. 29 | #' @param minse Minimum standard error to use when scaling point size. (Default will use minimum in the data.) 30 | #' @param pointsize The (largest) size of box to use for plotting point 31 | #' estimates. (Default: 3) 32 | #' @param xlab Label for x-axis. (Default: "Risk factor") 33 | #' @param ylab Label for y-axis. (Default: "Estimate (95% CI)") 34 | #' @param legend.name The name of the colour scale/legend for groups. (Default: "") 35 | #' @param legend.position Position of the legend for groups ("none", "left", "right", "bottom", "top", or two-element numeric vector). (Default: "top") 36 | #' @param title Plot title. (Default: NULL) 37 | #' @param xlims A numeric vector of length two. The limits of the x-axis. 38 | #' @param ylims A numeric vector of length two. The limits of the y-axis. 39 | #' @param height Panel height to use and apply different formatting to short CIs. A grid::unit() object, or if numeric is assumed to be in mm. 40 | #' @param width Panel width.A grid::unit() object, or if numeric is assumed to be in mm. 41 | #' @param xbreaks Breaks for the x axis. Passed to ggplots::scale_x_continuous. (Default: NULL) 42 | #' @param ybreaks Breaks for the y axis. Passed to ggplots::scale_y_continuous. (Default: NULL) 43 | #' @param gap A numeric vector of length two. The gap between plotting area and axis to the left and bottom of the plot, as a proportion of the x-axis length. (Default: c(0.025, 0.025)) 44 | #' @param ext A numeric vector of length two. The extensions to add to the right and top of the plot, as a proportion of the x-axis length. (Default: c(0.025, 0.025)) 45 | #' @param ratio The ratio (y-axis:x-axis) to use for the plot. (Default: 1.5) 46 | #' @param stroke Size of outline of shapes. (Default: base_size/22) 47 | #' @param quiet Set to TRUE to not print the plot nor show generated code in the RStudio 'Viewer' pane. (Default: FALSE) 48 | #' @param printplot Print the plot. (Default: !quiet) 49 | #' @param showcode Show the ggplot2 code to generate the plot in RStudio 'Viewer' pane. (Default: !quiet) 50 | #' @param addaes,addarg,add 51 | #' Methods for customising the plot. See documentation for details. 52 | #' @param envir Environment in which to evaluate the plot code. May be useful when calling this function inside another function. 53 | #' 54 | #' @return A list: 55 | #' \describe{ 56 | #' \item{plot}{the plot} 57 | #' \item{code}{ggplot2 code to generate the plot} 58 | #'} 59 | #' 60 | #' @import ggplot2 61 | #' @export 62 | 63 | 64 | 65 | shape_plot <- function(data, 66 | col.x = "x", 67 | col.estimate = c("estimate", "est", "beta", "loghr"), 68 | col.stderr = c("stderr", "std.err", "se"), 69 | col.lci = NULL, 70 | col.uci = NULL, 71 | col.n = NULL, 72 | exponentiate = FALSE, 73 | logscale = exponentiate, 74 | scalepoints = FALSE, 75 | digits = 2, 76 | minse = NA, 77 | pointsize = 3, 78 | col.group = NULL, 79 | shape = 15, 80 | plotcolour = "black", 81 | colour = plotcolour, 82 | cicolour = colour, 83 | fill = colour, 84 | ciunder = NULL, 85 | lines = FALSE, 86 | xlims, 87 | ylims, 88 | height = NULL, 89 | width = NULL, 90 | gap = c(0.025, 0.025), 91 | ext = c(0.025, 0.025), 92 | ratio = 1.5, 93 | base_size = 11, 94 | base_line_size = base_size/22, 95 | stroke = base_size/22, 96 | axis.title.margin = 1, 97 | xbreaks = NULL, 98 | ybreaks = NULL, 99 | xlab = "Risk factor", 100 | ylab = "Estimate (95% CI)", 101 | legend.name = "", 102 | legend.position = "top", 103 | title = NULL, 104 | quiet = FALSE, 105 | printplot = !quiet, 106 | showcode = !quiet, 107 | addaes = NULL, 108 | addarg = NULL, 109 | add = NULL, 110 | envir = NULL){ 111 | 112 | # Check arguments ---- 113 | if (!is.null(col.lci) && is.null(col.uci)) rlang::abort("col.lci and col.uci must both be specified") 114 | if ( is.null(col.lci) && !is.null(col.uci)) rlang::abort("col.lci and col.uci must both be specified") 115 | if (!is.null(col.group) && !missing(fill)) rlang::abort("col.group and fill both control fill, so do not specify both") 116 | if (missing(xlims)) rlang::abort("xlims must be specified") 117 | if (missing(ylims)) rlang::abort("ylims must be specified") 118 | 119 | ## check if confidence intervals may be hidden 120 | if (missing(height)){ 121 | rlang::inform(c('i' = 'Narrow confidence interval lines may become hidden in the shape plot.', 122 | 'i' = 'Please check your final output carefully and see vignette("shape_confidence_intervals") for more details.'), 123 | use_cli_format = TRUE, 124 | .frequency = "once", 125 | .frequency_id = "shape_narrow_cis") 126 | } 127 | 128 | if(!missing(height) && !missing(col.group) && !missing(cicolour)){ 129 | warning("cicolour is ignored if using height and col.group") 130 | } 131 | 132 | 133 | 134 | # Match estimate and stderr column names ---- 135 | column_names_in_data <- names(data) 136 | if (length(col.estimate[col.estimate %in% column_names_in_data]) == 0) { 137 | rlang::abort(glue::glue("Column '{col.estimate}' does not exist in panels data frame.")) 138 | } 139 | col.estimate <- col.estimate[col.estimate %in% column_names_in_data][[1]] 140 | 141 | if (!is.null(col.lci) | !is.null(col.uci)) { 142 | for (x in c(col.lci, col.uci)){ 143 | if (!x %in% column_names_in_data){ 144 | rlang::abort(glue::glue("Column '{x}' does not exist in panels data frame.")) 145 | } 146 | } 147 | } else { 148 | if (length(col.stderr[col.stderr %in% column_names_in_data]) == 0) { 149 | rlang::abort(glue::glue("Column '{col.stderr}' does not exist in panels data frame.")) 150 | } 151 | col.stderr <- col.stderr[col.stderr %in% column_names_in_data][[1]] 152 | } 153 | 154 | 155 | 156 | 157 | 158 | # Aesthetics ---- 159 | ## match column name, or use argument itself 160 | 161 | ### shape 162 | if (missing(shape) && !is.null(col.group)){ 163 | shape <- 22 164 | } 165 | if (!missing(shape) && shape %in% names(data)){ 166 | shape <- list(aes = shape) 167 | } else { 168 | shape <- list(arg = shape) 169 | } 170 | 171 | ### cicolour 172 | if (all(cicolour %in% names(data))){ 173 | cicolour <- list(aes = cicolour) 174 | } else { 175 | if (missing(cicolour)) { 176 | cicolour <- c(cicolour, "white") 177 | if (fill == "white") { 178 | cicolour <- c(cicolour[[1]], cicolour[[1]]) 179 | } 180 | } 181 | cicolour <- list(arg = cicolour) 182 | } 183 | 184 | ### colour 185 | if (!missing(colour) && colour %in% names(data)){ 186 | colour <- list(aes = colour) 187 | } else { 188 | colour <- list(arg = colour) 189 | } 190 | 191 | ### fill 192 | if (fill %in% names(data)){ 193 | fill <- list(aes = fill) 194 | } else { 195 | fill <- list(arg = fill) 196 | } 197 | 198 | 199 | # String for point size aesthetic 200 | if (scalepoints) { 201 | if (!is.null(col.lci)) { 202 | size <- glue::glue('2*1.96/({column_name(col.uci)} - {column_name(col.lci)})') 203 | } else { 204 | size <- glue::glue('1/{column_name(col.stderr)}') 205 | } 206 | } else { 207 | size <- '1' 208 | } 209 | 210 | 211 | 212 | 213 | # Text size ---- 214 | text_size <- round(base_size_to_text_size(base_size), 6) 215 | 216 | 217 | 218 | 219 | 220 | 221 | # Log scale and exponentiate estimates ---- 222 | if (logscale == TRUE){ 223 | scale <- "log" 224 | } else { 225 | scale <- "identity" 226 | } 227 | if (exponentiate == TRUE) { 228 | est_string <- paste0('exp(', column_name(col.estimate), ')') 229 | if (!is.null(col.lci)) { 230 | lci_string <- paste0('exp(', column_name(col.lci), ')') 231 | uci_string <- paste0('exp(', column_name(col.uci), ')') 232 | } else { 233 | lci_string <- paste0('exp(', 234 | column_name(col.estimate), 235 | '-1.96*', 236 | column_name(col.stderr), 237 | ')') 238 | uci_string <- paste0('exp(', 239 | column_name(col.estimate), 240 | '+1.96*', 241 | column_name(col.stderr), 242 | ')') 243 | } 244 | } else { 245 | est_string <- column_name(col.estimate) 246 | if (!is.null(col.lci)) { 247 | lci_string <- column_name(col.lci) 248 | uci_string <- column_name(col.uci) 249 | } else { 250 | lci_string <- paste0(column_name(col.estimate), 251 | '-1.96*', 252 | column_name(col.stderr)) 253 | uci_string <- paste0(column_name(col.estimate), 254 | '+1.96*', 255 | column_name(col.stderr)) 256 | } 257 | } 258 | 259 | 260 | # Aesthetic adjustments when using height ---- 261 | if (!missing(height)) { 262 | if (!inherits(height, "unit")){ 263 | height <- grid::unit(height, "mm") 264 | } 265 | cicolours <- c(quote_string(cicolour$arg), column_name(cicolour$aes)) 266 | cicolour <- list(aes = "cicolour") 267 | } 268 | 269 | if (!missing(height)) { 270 | if (!missing(ciunder)) warning("ciunder ignored when using height") 271 | ciunder <- "ciunder" 272 | } 273 | 274 | 275 | # Width ---- 276 | if (!missing(width) & !inherits(width, "unit")){ 277 | width <- grid::unit(width, "mm") 278 | } 279 | 280 | 281 | # Using groups ---- 282 | if (!is.null(col.group)) { 283 | 284 | if(!is.factor(data[[col.group]])) rlang::abort("col.group must be factor") 285 | group_string <- glue::glue(', group = {column_name(col.group)}') 286 | scale_fill_string <- c('', 287 | make_layer('# Set the scale for fill colours', 288 | f = "scale_fill_grey", 289 | arg = c("start = 0", 290 | "end = 1", 291 | 'name = "{legend.name}"'), 292 | br = FALSE)) 293 | fill_string <- list(aes = glue::glue('fill = {column_name(col.group)}')) 294 | } else { 295 | group_string <- '' 296 | scale_fill_string <- 'scale_fill_identity() +' 297 | fill_string <- list(aes = glue::glue('fill = {column_name(fill$aes)}'), 298 | arg = glue::glue('fill = {quote_string(fill$arg)}')) 299 | } 300 | 301 | 302 | # Order for plotting CIs and points ---- 303 | ci_order <- c("all", "null") 304 | if (isFALSE(ciunder) || is.null(ciunder)){ 305 | ci_order <- c("null", "all") 306 | } 307 | if (is.character(ciunder)){ 308 | ci_order <- c("before", "after") 309 | } 310 | 311 | 312 | # Create the plot code ---- 313 | plotcode <- c( 314 | 'library(ggplot2)', 315 | '', 316 | 317 | # start with data 318 | paste0('datatoplot <- ', deparse(substitute(data))), 319 | '', 320 | 321 | # code for CI colours if using height 322 | shape.cicolourcode(scale, 323 | ylims, 324 | lci_string, 325 | uci_string, 326 | pointsize, 327 | size, 328 | stroke, 329 | height, 330 | ratio, 331 | gap, 332 | ext, 333 | shape, 334 | cicolours, 335 | col.group), 336 | 337 | ## code for CI under - if using height 338 | shape.ciundercode(height), 339 | 340 | ## start ggplot 341 | shape.start.ggplot(column_name(col.x), 342 | est_string, 343 | group_string), 344 | 345 | indent(2, 346 | 347 | # add$start 348 | if (!is.null(add$start)){ 349 | c("# Additional layer", 350 | paste(c(deparse(substitute(add)$start), " +"), collapse = ""), 351 | "") 352 | }, 353 | 354 | ## add lines 355 | if(lines){ 356 | shape.lines(addaes, 357 | col.lci, 358 | col.estimate, 359 | col.stderr, 360 | addarg, 361 | plotcolour) 362 | }, 363 | 364 | # CI lines plotted before points 365 | shape.cis(addaes, 366 | lci_string, 367 | uci_string, 368 | cicolour, 369 | addarg, 370 | ciunder, 371 | base_line_size, 372 | type = ci_order[[1]]), 373 | 374 | # points for estimates 375 | shape.estimates.points(addaes, 376 | size, 377 | shape, 378 | fill_string, 379 | colour, 380 | addarg, 381 | stroke), 382 | 383 | # text above points 384 | shape.estimates.text(addaes, 385 | uci_string, 386 | est_string, 387 | addarg, 388 | text_size, 389 | plotcolour, 390 | digits), 391 | 392 | # number below points 393 | if (!is.null(col.n)){ 394 | shape.n.events.text(addaes, 395 | lci_string, 396 | col.n, 397 | addarg, 398 | text_size, 399 | plotcolour) 400 | }, 401 | 402 | # CI lines plotted after points 403 | shape.cis(addaes, 404 | lci_string, 405 | uci_string, 406 | cicolour, 407 | addarg, 408 | ciunder, 409 | base_line_size, 410 | type = ci_order[[2]]), 411 | 412 | # scales 413 | shape.scales(deparse(1/minse), pointsize, scale_fill_string), 414 | 415 | # axes 416 | shape.axes(deparse(xbreaks), scale, deparse(ybreaks)), 417 | 418 | # titles 419 | shape.titles(xlab, title, ylab), 420 | 421 | # ckb_style() 422 | shape.plot.like.ckb(deparse(xlims), 423 | deparse(ylims), 424 | deparse(gap), 425 | deparse(ext), 426 | deparse(ratio), 427 | width, 428 | height, 429 | base_size, 430 | base_line_size, 431 | plotcolour, 432 | axis.title.margin)), 433 | 434 | # theme 435 | indent(2, shape.theme(legend.position, add)), 436 | 437 | # add$end 438 | if (!is.null(add$end)){ 439 | c("# Additional layer", 440 | paste(deparse(substitute(add)$end), collapse = ""), 441 | "") 442 | } 443 | 444 | ) 445 | 446 | 447 | 448 | # Show code in RStudio viewer. 449 | if (showcode){ displaycode(plotcode) } 450 | 451 | 452 | # If envir not provided, make new environment 453 | # with parent frame same as function call 454 | if(missing(envir)){envir <- new.env(parent = parent.frame())} 455 | 456 | # Create the plot 457 | plot <- eval(parse(text = plotcode), envir = envir) 458 | if (printplot){ 459 | print(plot) 460 | } 461 | 462 | 463 | return(invisible(list(plot = plot, 464 | code = plotcode))) 465 | } 466 | 467 | -------------------------------------------------------------------------------- /R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{magrittr::\link[magrittr]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | NULL 12 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' prepend character string with space 2 | #' 3 | #' @keywords internal 4 | #' @noRd 5 | #' 6 | 7 | indent <- function(n, ...){ 8 | if (rlang::is_empty(c(...))){return (NULL)} 9 | paste0(paste0(rep(" ", n), 10 | collapse = ""), 11 | c(...)) 12 | } 13 | 14 | 15 | #' put backticks around character string if contains a blank 16 | #' 17 | #' @keywords internal 18 | #' @noRd 19 | #' 20 | 21 | column_name <- function(x){ 22 | if(is.null(x)){ return(NULL) } 23 | for (i in 1:length(x)){ 24 | if (grepl("[[:blank:]]|[[:punct:]]", x[[i]])){ 25 | x[[i]] <- paste0("`", x[[i]], "`") 26 | } 27 | } 28 | x 29 | } 30 | 31 | 32 | #' put escaped quotes around character string 33 | #' 34 | #' @keywords internal 35 | #' @noRd 36 | #' 37 | quote_string <- function(x){ 38 | if(is.null(x)){return(x)} 39 | if(is.list(x)){return(lapply(x, quote_string))} 40 | paste0('\"', x, '\"') 41 | } 42 | 43 | #. Write code for preparing data using make_forest_data 44 | #' 45 | #' @keywords internal 46 | #' @noRd 47 | #' 48 | argset <- function(x){ 49 | name <- paste(deparse(substitute(x)), collapse = '') 50 | value <- paste(deparse(x), collapse = '') 51 | if (!identical(x, eval(formals(ckbplotr::forest_data)[[name]]))){ 52 | glue::glue('{name} = {value}') 53 | } 54 | } 55 | 56 | 57 | #' write ggplot layer code 58 | #' 59 | #' @keywords internal 60 | #' @noRd 61 | #' 62 | make_layer <- function(name = NULL, 63 | f, 64 | aes = NULL, 65 | arg = NULL, 66 | plus = TRUE, 67 | br = TRUE, 68 | duplicates = FALSE, 69 | glue_environment = parent.frame()){ 70 | 71 | if (!is.null(aes)){ 72 | aes <- na.omit(purrr::map_chr(aes, \(x){y <- glue::glue(x, .envir = glue_environment); ifelse(length(y) == 1, y, NA)})) 73 | } 74 | if (!is.null(arg)){ 75 | arg <- na.omit(purrr::map_chr(arg, \(x){y <- glue::glue(x, .envir = glue_environment); ifelse(length(y) == 1, y, NA)})) 76 | } 77 | 78 | if (!duplicates){ 79 | aes <- aes[!duplicated(trimws(sub("=.*", "", aes)))] 80 | arg <- arg[!duplicated(trimws(sub("=.*", "", c(aes, arg))))[(length(aes) + 1):(length(aes) + length(arg))]] 81 | } 82 | 83 | if (length(aes) > 0){ 84 | aes <- indent(4, paste0(aes, ",")) 85 | aes[[1]] <- paste0("aes(", trimws(aes[[1]])) 86 | aes[[length(aes)]] <- sub(",$", "),", aes[[length(aes)]]) 87 | } else { 88 | aes <- NULL 89 | } 90 | if (length(arg) > 0){ 91 | arg <- paste0(arg, ",") 92 | } else { 93 | arg <- NULL 94 | } 95 | args <- indent(nchar(f)+1, c(aes, arg)) 96 | args[[1]] <- paste0(f, "(", trimws(args[[1]])) 97 | args[[length(args)]] <- paste0(sub(",$", "", args[[length(args)]]), ")", if(plus){" +"}) 98 | c(name, args, if(br){''}) 99 | } 100 | 101 | 102 | #' Write the ggplot2 code to a file in temp directory, and show in RStudio viewer 103 | #' 104 | #' @keywords internal 105 | #'@noRd 106 | #' 107 | displaycode <- function(plotcode, note = ""){ 108 | 109 | if (!is.null(knitr::opts_knit$get("out.format"))){ 110 | return(NULL) 111 | } 112 | 113 | text <- c("---", 114 | "title: 'Generated R code'", 115 | "output:", 116 | " html_document:", 117 | " highlight: kate", 118 | "---", 119 | "```{css, echo=FALSE}", 120 | ".no-border {border: 0px;}", 121 | "```", 122 | note, 123 | "```{r plotcode, class.source='no-border', eval = FALSE}", 124 | plotcode, 125 | "```") 126 | 127 | temprmd <- tempfile(fileext = ".Rmd") 128 | con <- file(temprmd, open = "w", encoding = "UTF-8") 129 | writeLines( 130 | text, 131 | con = con, 132 | sep = "\n") 133 | close(con) 134 | 135 | rmarkdown::render(temprmd, 136 | output_file = "plotcode.html", 137 | quiet = TRUE) 138 | 139 | viewer <- getOption("viewer", default = function(url){}) 140 | viewer(file.path(tempdir(), "plotcode.html")) 141 | } 142 | 143 | 144 | #' Use deparse, escape and unescape unicode, and collapse to a single string 145 | #' 146 | #' @keywords internal 147 | #'@noRd 148 | #' 149 | ds <- function(x){ 150 | paste( 151 | stringi::stri_unescape_unicode( 152 | deparse( 153 | stringi::stri_escape_unicode(x) 154 | ) 155 | ), 156 | collapse = '') 157 | } 158 | 159 | 160 | #' Turn unit object into a string 161 | #' 162 | #' @keywords internal 163 | #' @noRd 164 | printunit <- function(x){ 165 | if(is.null(x)){return(NULL)} 166 | glue::glue('unit({deparse(as.numeric(x))}, {makeunit(x)})') 167 | } 168 | 169 | 170 | #' Turn unit object into name of unit 171 | #' 172 | #' @keywords internal 173 | #' @noRd 174 | makeunit <- function(x){ 175 | 176 | if(is.null(x)){return(NULL)} 177 | ## handle different unit object types (for grid>=4.0) 178 | if (compareVersion(as.character(packageVersion("grid")), "4.0") >= 0){ 179 | ds(grid::unitType(x)) 180 | } else { 181 | ds(attr(x, "unit")) 182 | } 183 | 184 | } 185 | 186 | 187 | 188 | 189 | #' Turn font size in pt into mm and multiply 190 | #' 191 | #' multiply 0.8 to match default size of axis text in ggplot 192 | #' 193 | #' @keywords internal 194 | #' @noRd 195 | 196 | base_size_to_text_size <- function(x, m = 0.8){ 197 | m * x/.pt 198 | } 199 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | .onAttach <- function(...) { 2 | packageStartupMessage( 3 | cli::format_inline( 4 | "See {.href [https://neilstats.github.io/ckbplotr](https://neilstats.github.io/ckbplotr)} for details on using this package." 5 | ) 6 | ) 7 | } 8 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | github_document: 4 | html_preview: false 5 | --- 6 | 7 | 8 | 9 | ```{r setup, include = FALSE} 10 | knitr::opts_chunk$set( 11 | collapse = TRUE, 12 | comment = "#>", 13 | fig.path = "man/figures/README-", 14 | fig.width = 16, 15 | fig.height = 16, 16 | fig.align = "center", 17 | dpi = 300) 18 | library(ckbplotr) 19 | library(grid) 20 | library(gridExtra) 21 | ``` 22 | # ckbplotr 23 | 24 | [![R build status](https://github.com/neilstats/ckbplotr/workflows/R-CMD-check/badge.svg)](https://github.com/neilstats/ckbplotr/actions) 25 | [![runiverse-name](https://neilstats.r-universe.dev/badges/:name)](https://neilstats.r-universe.dev) 26 | [![runiverse-package](https://neilstats.r-universe.dev/badges/ckbplotr)](https://neilstats.r-universe.dev/ckbplotr) 27 | [![DOI](https://zenodo.org/badge/189028664.svg)](https://zenodo.org/badge/latestdoi/189028664) 28 | 29 | `ckbplotr` helps create and style plots in R. It is 30 | developed by, and primarily for, [China Kadoorie Biobank](http://www.ckbiobank.org) 31 | researchers. 32 | 33 | ## Key features 34 | 35 | The package can be used to apply CKB style and to create plots by generating ggplot2 code. Functions that create plots (such as `shape_plot()` and `forest_plot()`) return both: 36 | 37 | - **A ggplot2 plot**. 38 | - **The ggplot2 code used to create the plot**, allowing users to see exactly how the plot has been created and adapt the code for other uses. In RStudio the code will also be shown in the Viewer pane. 39 | 40 | 41 | 42 | ## Installation 43 | 44 | Install the latest version of `ckbplotr` from the neilstats R-universe: 45 | ```{r install from runiverse, eval = FALSE} 46 | install.packages('ckbplotr', 47 | repos = c('https://neilstats.r-universe.dev', 48 | 'https://cloud.r-project.org')) 49 | ``` 50 | This will also install dependencies from the CRAN repository. 51 | 52 | 53 | 54 | ## Get started 55 | 56 | Read `vignette("ckbplotr")` to get started. 57 | 58 | 59 | 60 | ## Citing ckbplotr 61 | 62 | If you find this package useful, please consider citing as: 63 | 64 | Wright N (2024). ckbplotr: Create CKB Plots. https://neilstats.github.io/ckbplotr/, https://doi.org/10.5281/zenodo.6382217. 65 | 66 | 67 | 68 | ## Package development 69 | 70 | This package is under development. If you find an error or bug or have a suggestion for improvement please [create an issue on GitHub](https://github.com/neilstats/ckbplotr/issues) or contact the author at [\@NeilStats\@fediscience.org](https://fediscience.org/@neilstats). 71 | 72 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # ckbplotr 5 | 6 | [![R build 7 | status](https://github.com/neilstats/ckbplotr/workflows/R-CMD-check/badge.svg)](https://github.com/neilstats/ckbplotr/actions) 8 | [![runiverse-name](https://neilstats.r-universe.dev/badges/:name)](https://neilstats.r-universe.dev) 9 | [![runiverse-package](https://neilstats.r-universe.dev/badges/ckbplotr)](https://neilstats.r-universe.dev/ckbplotr) 10 | [![DOI](https://zenodo.org/badge/189028664.svg)](https://zenodo.org/badge/latestdoi/189028664) 11 | 12 | `ckbplotr` helps create and style plots in R. It is developed by, and 13 | primarily for, [China Kadoorie Biobank](http://www.ckbiobank.org) 14 | researchers. 15 | 16 | ## Key features 17 | 18 | The package can be used to apply CKB style and to create plots by 19 | generating ggplot2 code. Functions that create plots (such as 20 | `shape_plot()` and `forest_plot()`) return both: 21 | 22 | - **A ggplot2 plot**. 23 | - **The ggplot2 code used to create the plot**, allowing users to see 24 | exactly how the plot has been created and adapt the code for other 25 | uses. In RStudio the code will also be shown in the Viewer pane. 26 | 27 | ## Installation 28 | 29 | Install the latest version of `ckbplotr` from the neilstats R-universe: 30 | 31 | ``` r 32 | install.packages('ckbplotr', 33 | repos = c('https://neilstats.r-universe.dev', 34 | 'https://cloud.r-project.org')) 35 | ``` 36 | 37 | This will also install dependencies from the CRAN repository. 38 | 39 | ## Get started 40 | 41 | Read `vignette("ckbplotr")` to get started. 42 | 43 | ## Citing ckbplotr 44 | 45 | If you find this package useful, please consider citing as: 46 | 47 | Wright N (2024). ckbplotr: Create CKB Plots. 48 | , 49 | . 50 | 51 | ## Package development 52 | 53 | This package is under development. If you find an error or bug or have a 54 | suggestion for improvement please [create an issue on 55 | GitHub](https://github.com/neilstats/ckbplotr/issues) or contact the 56 | author at 57 | [@NeilStats@fediscience.org](https://fediscience.org/@neilstats). 58 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | 3 | development: 4 | mode: auto 5 | 6 | template: 7 | bootstrap: 5 8 | bootswatch: cosmo 9 | bslib: 10 | primary: "#011e41" 11 | base_font: {google: {family: "Source Sans Pro", wght: [400, 600], ital: [0, 1]}} 12 | code_font: {google: "Source Code Pro"} 13 | font_scale: 1 14 | border-radius: 0 15 | pkgdown-nav-height: 78px 16 | line-height-base: 1.6 17 | 18 | articles: 19 | - title: Introduction 20 | navbar: ~ 21 | contents: 22 | - ckbplotr 23 | - title: Plots 24 | navbar: ~ 25 | contents: 26 | - ckb_style 27 | - forest_plots 28 | - shape_plots 29 | - customising_plots 30 | - title: Saving plots 31 | navbar: ~ 32 | contents: 33 | - save_plots 34 | - title: Related packages 35 | contents: 36 | - ggplot2 37 | - page_layouts 38 | - title: Generated code 39 | contents: 40 | - web-only/generated_code 41 | 42 | news: 43 | releases: 44 | - text: "Latest" 45 | href: https://github.com/neilstats/ckbplotr/releases/latest 46 | 47 | url: https://neilstats.github.io/ckbplotr/ 48 | 49 | figures: 50 | dpi: 320 51 | -------------------------------------------------------------------------------- /ckbplotr.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 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 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/ckb_style.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ckb-style.R 3 | \name{ckb_style} 4 | \alias{ckb_style} 5 | \title{Make a ggplot into CKB style} 6 | \usage{ 7 | ckb_style( 8 | xlims = NULL, 9 | ylims = NULL, 10 | gap = c(0.025, 0.025), 11 | ext = c(0, 0), 12 | ratio = 1.5, 13 | width = NULL, 14 | height = NULL, 15 | base_size = 11, 16 | base_line_size = base_size/22, 17 | colour = "black", 18 | axis.title.margin = 1, 19 | plot.margin = margin(0.5, 1.5, 0.5, 0.5, "lines"), 20 | axes = "both" 21 | ) 22 | } 23 | \arguments{ 24 | \item{xlims}{A numeric vector of length two. The limits of the x-axis.} 25 | 26 | \item{ylims}{A numeric vector of length two. The limits of the y-axis.} 27 | 28 | \item{gap}{A numeric vector of length two. The gap between plotting area and axis to the left and bottom of the plot, as a proportion of the x-axis length. (Default: c(0.025, 0.025))} 29 | 30 | \item{ext}{A numeric vector of length two. The extensions to add to the right and top of the plot, as a proportion of the x-axis length. (Default: c(0, 0))} 31 | 32 | \item{ratio}{The ratio (y-axis:x-axis) to use for the plot. Ignored if both width and height are set. (Default: 1.5)} 33 | 34 | \item{width}{A \code{grid::unit} object to set the width of the plot (not including the gap or extension).} 35 | 36 | \item{height}{A \code{grid::unit} object to set the height of the plot (not including the gap or extension).} 37 | 38 | \item{base_size}{base font size, given in pts.} 39 | 40 | \item{base_line_size}{base size for line elements} 41 | 42 | \item{colour}{Colour for non-data aspects of the plot. (Default: "black")} 43 | 44 | \item{axis.title.margin}{Margin between axis titles and plot. (Default: 1)} 45 | 46 | \item{plot.margin}{Margin around entire plot (Default: margin(0.5, 0, 0.5, 0, "lines"))} 47 | 48 | \item{axes}{Choice of axis lines to add to the plot, one of "both", "x" or "y". (Default: "both")} 49 | } 50 | \description{ 51 | Make a ggplot into CKB style 52 | } 53 | -------------------------------------------------------------------------------- /man/ckbplotr-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ckbplotr-package.R 3 | \docType{package} 4 | \name{ckbplotr-package} 5 | \alias{ckbplotr} 6 | \alias{ckbplotr-package} 7 | \title{ckbplotr: Create CKB Plots} 8 | \description{ 9 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 10 | 11 | ckbplotr provides functions to help create and style plots in R. It is being developed by, and primarily for, China Kadoorie Biobank researchers. 12 | } 13 | \seealso{ 14 | Useful links: 15 | \itemize{ 16 | \item \url{https://neilstats.github.io/ckbplotr/} 17 | \item \doi{10.5281/zenodo.6382217} 18 | \item Report bugs at \url{https://github.com/neilstats/ckbplotr/issues} 19 | } 20 | 21 | } 22 | \author{ 23 | \strong{Maintainer}: Neil Wright \email{neil.wright@ndph.ox.ac.uk} 24 | 25 | } 26 | \keyword{internal} 27 | -------------------------------------------------------------------------------- /man/figures/README-a-plot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/man/figures/README-a-plot-1.png -------------------------------------------------------------------------------- /man/figures/README-example-forest-plot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/man/figures/README-example-forest-plot-1.png -------------------------------------------------------------------------------- /man/figures/README-example-shape-plot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/man/figures/README-example-shape-plot-1.png -------------------------------------------------------------------------------- /man/figures/lifecycle-archived.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecyclearchivedarchived -------------------------------------------------------------------------------- /man/figures/lifecycle-defunct.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecycledefunctdefunct -------------------------------------------------------------------------------- /man/figures/lifecycle-deprecated.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecycledeprecateddeprecated -------------------------------------------------------------------------------- /man/figures/lifecycle-experimental.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecycleexperimentalexperimental -------------------------------------------------------------------------------- /man/figures/lifecycle-maturing.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecyclematuringmaturing -------------------------------------------------------------------------------- /man/figures/lifecycle-questioning.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecyclequestioningquestioning -------------------------------------------------------------------------------- /man/figures/lifecycle-stable.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecyclestablestable -------------------------------------------------------------------------------- /man/figures/lifecycle-superseded.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecyclesupersededsuperseded -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/man/figures/logo.png -------------------------------------------------------------------------------- /man/fix_panel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fix-panel.R 3 | \name{fix_panel} 4 | \alias{fix_panel} 5 | \title{Fix panel width and height of a forest plot} 6 | \usage{ 7 | fix_panel(plot, width = NULL, height = NULL) 8 | } 9 | \arguments{ 10 | \item{plot}{A plot (created by forest_plot()).} 11 | 12 | \item{width}{Width of panels. (e.g unit(50, "mm"))} 13 | 14 | \item{height}{Height of panels. (e.g unit(150, "mm"))} 15 | } 16 | \value{ 17 | A gtable object 18 | } 19 | \description{ 20 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} 21 | 22 | ckb_style(), plot_like_ckb() and shape_plot() have width and height arguments and 23 | forest_plot() has panel.width and panel.height arguments. These use 24 | ggh4x::force_panelsizes() to fix panel sizes. 25 | } 26 | \keyword{internal} 27 | -------------------------------------------------------------------------------- /man/forest_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/forest-data.R 3 | \name{forest_data} 4 | \alias{forest_data} 5 | \title{Prepares data set for a forest plot} 6 | \usage{ 7 | forest_data( 8 | panels, 9 | panel.names = NULL, 10 | col.key = "key", 11 | col.estimate = "estimate", 12 | col.stderr = "stderr", 13 | col.lci = NULL, 14 | col.uci = NULL, 15 | col.left = NULL, 16 | col.right = NULL, 17 | col.keep = NULL, 18 | row.labels = NULL, 19 | row.labels.levels = NULL, 20 | rows = NULL, 21 | row.labels.space = c(0, 1, 0, 0), 22 | ci.delim = ", ", 23 | digits = 2, 24 | exponentiate = TRUE, 25 | scalepoints = FALSE, 26 | minse = NULL, 27 | addtext = NULL, 28 | diamond = NULL, 29 | col.diamond = NULL, 30 | bold.labels = NULL 31 | ) 32 | } 33 | \arguments{ 34 | \item{panels}{A list of data frames. These should include columns or point 35 | estimates, and standard errors or confidence interval limits. If you 36 | specify a row.labels data frame, then they must also all contain a key column 37 | with the same name (which can be specified by col.key).} 38 | 39 | \item{panel.names}{A character vector. The names to be used for each forest plot panel. 40 | If none provided, then they will be numbered 1, 2, 3 ...} 41 | 42 | \item{col.key}{Name of column that links the results given in each data frame 43 | provided in panels and the labels given in row.labels. 44 | If row.labels data frame is not given, then this column will be used as row labels. 45 | (Default: "key")} 46 | 47 | \item{col.estimate, col.stderr, col.lci, col.uci}{Names of columns for: point estimates, standard errors, lower and upper limits of confidence intervals.} 48 | 49 | \item{col.left, col.right}{Names of columns to be printed to the left/right of the plot.} 50 | 51 | \item{col.keep}{Names of additional columns to be kept in returned data frame.} 52 | 53 | \item{row.labels}{A data frame that contains the labels to be used for the 54 | rows of the plot. Use NA if a lower level heading is not required for a given row.} 55 | 56 | \item{row.labels.levels}{A character vector. The names of columns in row.labels 57 | to use as headings/subheadings/labels for labelling rows.} 58 | 59 | \item{rows}{If set, then only rows matching these labels (at the first level) will be included.} 60 | 61 | \item{row.labels.space}{A numeric vector specifying the space 62 | after a row label heading, at the end of a row label heading 'section'. (Default: c(0, 1, 0, 0))} 63 | 64 | \item{ci.delim}{Character string to separate lower and upper limits of confidence interval. (Default: ", ")} 65 | 66 | \item{digits}{Number of digits after decimal point to show for estimates and confidence intervals. (Default: 2)} 67 | 68 | \item{exponentiate}{Exponentiate estimates (and CIs) before plotting. (Default: TRUE)} 69 | 70 | \item{scalepoints}{Should the points be scaled by inverse of the standard error? (Default: FALSE)} 71 | 72 | \item{minse}{Minimum standard error to use when scaling point size. (Default will use minimum in the data.)} 73 | 74 | \item{addtext}{A list of data frames. List must be the same length as panels. 75 | Data frames should contain a column with the name specified in col.key, 76 | and one or more of: 77 | \enumerate{ 78 | \item a column named 'text' containing character strings 79 | \item columns named 'het_dof', 'het_stat', and 'het_p' containing character strings 80 | \item columns names 'trend_stat' and 'trend_p' containing character strings 81 | } 82 | 83 | The character strings, heterogeneity test, and trend test results will 84 | be plotted in the column of estimates and CIs, below the row with the key 85 | given in the col.key column.} 86 | 87 | \item{diamond}{Alternative to col.diamond. A character vectors identify the rows 88 | (using the key values) for which the estimate and CI should be plotted using a diamond.} 89 | 90 | \item{col.diamond}{Plot estimates and CIs as diamonds. Name of a column of logical values.} 91 | 92 | \item{bold.labels}{A character vector identifying row labels (using key values) which should additionally be bold. (Default: NULL)} 93 | } 94 | \value{ 95 | A dataset from which a forest plot can be generated. 96 | } 97 | \description{ 98 | Prepares data set for a forest plot 99 | } 100 | \keyword{internal} 101 | -------------------------------------------------------------------------------- /man/forest_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/forest-plot.R 3 | \name{forest_plot} 4 | \alias{forest_plot} 5 | \title{Make a forest plot with ggplot2} 6 | \usage{ 7 | forest_plot( 8 | panels, 9 | row.labels = NULL, 10 | row.labels.levels = NULL, 11 | rows = NULL, 12 | row.labels.heading = NULL, 13 | row.labels.space = c(0, 1, 0, 0), 14 | exponentiate = TRUE, 15 | logscale = exponentiate, 16 | panel.names = NULL, 17 | panel.headings = NULL, 18 | panel.headings.align = c("panel", "plot"), 19 | col.key = "key", 20 | col.estimate = c("estimate", "est", "beta", "loghr"), 21 | col.stderr = c("stderr", "std.err", "se"), 22 | col.lci = NULL, 23 | col.uci = NULL, 24 | col.left = NULL, 25 | col.right = NULL, 26 | col.right.parse = FALSE, 27 | col.left.heading = "", 28 | col.right.heading = as.list(xlab), 29 | col.left.pos = NULL, 30 | col.right.pos = NULL, 31 | col.left.hjust = 1, 32 | col.right.hjust = 0, 33 | col.left.gap = c("I", "W"), 34 | col.right.gap = c("I", "W"), 35 | col.heading.space = 0, 36 | col.heading.rule = FALSE, 37 | estcolumn = TRUE, 38 | col.keep = NULL, 39 | ci.delim = ", ", 40 | digits = 2, 41 | title = "", 42 | xlab = "HR (95\% CI)", 43 | xlim = NULL, 44 | xticks = NULL, 45 | nullval = NULL, 46 | col.diamond = NULL, 47 | diamond = NULL, 48 | col.bold = NULL, 49 | bold.labels = NULL, 50 | scalepoints = FALSE, 51 | minse = NULL, 52 | pointsize = 3, 53 | shape = 15, 54 | plotcolour = "black", 55 | colour = plotcolour, 56 | cicolour = colour, 57 | fill = colour, 58 | ciunder = NULL, 59 | addtext = NULL, 60 | bottom.space = 0.7, 61 | left.space = NULL, 62 | right.space = NULL, 63 | mid.space = unit(5, "mm"), 64 | plot.margin = margin(2, 8, 2, 8, "mm"), 65 | panel.width = NULL, 66 | panel.height = NULL, 67 | base_size = 11, 68 | base_line_size = base_size/22, 69 | stroke = 0, 70 | diamonds.linewidth = base_line_size, 71 | quiet = FALSE, 72 | printplot = !quiet, 73 | showcode = !quiet, 74 | data.function = NULL, 75 | addaes = NULL, 76 | addarg = NULL, 77 | add = NULL, 78 | envir = NULL, 79 | blankrows = NULL 80 | ) 81 | } 82 | \arguments{ 83 | \item{panels}{A list of data frames. These should include columns or point 84 | estimates, and standard errors or confidence interval limits. If you 85 | specify a row.labels data frame, then they must also all contain a key column 86 | with the same name (which can be specified by col.key).} 87 | 88 | \item{row.labels}{A data frame that contains the labels to be used for the 89 | rows of the plot. Use NA if a lower level heading is not required for a given row.} 90 | 91 | \item{row.labels.levels}{A character vector. The names of columns in row.labels 92 | to use as headings/subheadings/labels for labelling rows.} 93 | 94 | \item{rows}{If set, then only rows matching these labels (at the first level) will be included.} 95 | 96 | \item{row.labels.heading}{Title to be placed above row labels.} 97 | 98 | \item{row.labels.space}{A numeric vector specifying the space 99 | after a row label heading, at the end of a row label heading 'section'. (Default: c(0, 1, 0, 0))} 100 | 101 | \item{exponentiate}{Exponentiate estimates (and CIs) before plotting. (Default: TRUE)} 102 | 103 | \item{logscale}{Use log scale on the axis, and add a line at null effect. (Default: exponentiate)} 104 | 105 | \item{panel.names}{A character vector. The names to be used for each forest plot panel. 106 | If none provided, then they will be numbered 1, 2, 3 ...} 107 | 108 | \item{panel.headings}{Titles to be placed above each forest plot.} 109 | 110 | \item{panel.headings.align}{Panel headings are by default centred over the plotting area ("panel"). 111 | Set to "plot" to centre over plotting area and text columns.} 112 | 113 | \item{col.key}{Name of column that links the results given in each data frame 114 | provided in panels and the labels given in row.labels. 115 | If row.labels data frame is not given, then this column will be used as row labels. 116 | (Default: "key")} 117 | 118 | \item{col.estimate, col.stderr, col.lci, col.uci}{Names of columns for: point estimates, standard errors, lower and upper limits of confidence intervals.} 119 | 120 | \item{col.left, col.right}{Names of columns to be printed to the left/right of the plot.} 121 | 122 | \item{col.right.parse}{A logical vector, the same length as col.right (+ 1 if estcolumn = TRUE). 123 | Should the contents of the columns be parsed into expressions. (Default: FALSE)} 124 | 125 | \item{col.left.heading, col.right.heading}{Headings for columns.} 126 | 127 | \item{col.left.pos, col.right.pos}{A unit vector to position col.left/col.right columns.} 128 | 129 | \item{col.left.hjust, col.right.hjust}{A numeric vector. The horizontal justification of 130 | col.left/col.right columns. (Default: 1)} 131 | 132 | \item{col.left.gap, col.right.gap}{A character vector of length two. The two characters control the gaps between 133 | the first text column and the panel, and successive text columns. 134 | (Default: c("I", "W"))} 135 | 136 | \item{col.heading.space}{Position of the titles given by col.left.heading and 137 | col.right.heading. Increase to move them up. (Default: 0)} 138 | 139 | \item{col.heading.rule}{Include a horizontal rule below column headings? (Default: FALSE)} 140 | 141 | \item{estcolumn}{Include column of estimates and confidence intervals to the 142 | right of each plot. (Default: TRUE)} 143 | 144 | \item{col.keep}{Names of additional columns to be kept in returned data frame.} 145 | 146 | \item{ci.delim}{Character string to separate lower and upper limits of confidence interval. (Default: ", ")} 147 | 148 | \item{digits}{Number of digits after decimal point to show for estimates and confidence intervals. (Default: 2)} 149 | 150 | \item{title}{Title to appear at the top of the plot.} 151 | 152 | \item{xlab}{Label to appear below the x-axis. (Default: "HR (95\% CI)")} 153 | 154 | \item{xlim}{A numeric vector. The limits of the x axis.} 155 | 156 | \item{xticks}{A numeric vector. The tick points of the x axis.} 157 | 158 | \item{nullval}{Add a vertical reference line at this value. (If logscale == TRUE then by default it will be added at 1, but use NA not to plot this line.)} 159 | 160 | \item{col.diamond}{Plot estimates and CIs as diamonds. Name of a column of logical values.} 161 | 162 | \item{diamond}{Alternative to col.diamond. A character vectors identify the rows 163 | (using the key values) for which the estimate and CI should be plotted using a diamond.} 164 | 165 | \item{col.bold}{Plot text as bold. Name of a column of logical values.} 166 | 167 | \item{bold.labels}{A character vector identifying row labels (using key values) which should additionally be bold. (Default: NULL)} 168 | 169 | \item{scalepoints}{Should the points be scaled by inverse of the standard error? (Default: FALSE)} 170 | 171 | \item{minse}{Minimum standard error to use when scaling point size. (Default will use minimum in the data.)} 172 | 173 | \item{pointsize}{The (largest) size of box to use for plotting point estimates. (Default: 3)} 174 | 175 | \item{shape}{Shape of points. An integer, or name of a column of integers. (Default: 15 (square))} 176 | 177 | \item{plotcolour}{Colour for all parts of the plot. (Default: "black")} 178 | 179 | \item{colour}{Colour of points. Name of a colour, or name of a column of colour names. (Default will use plotcolour.)} 180 | 181 | \item{cicolour}{Colour of CI lines. Colour of CI lines. Name of a colour, or name of a column of colour names. (Default will use colour.)} 182 | 183 | \item{fill}{Fill colour of points. Name of a colour, or name of a column of colour names. (Default will use colour.)} 184 | 185 | \item{ciunder}{Plot CI lines before points. A logical value, or name of a column of logical values. (Default will plot CI lines after points.)} 186 | 187 | \item{addtext}{A list of data frames. List must be the same length as panels. 188 | Data frames should contain a column with the name specified in col.key, 189 | and one or more of: 190 | \enumerate{ 191 | \item a column named 'text' containing character strings 192 | \item columns named 'het_dof', 'het_stat', and 'het_p' containing character strings 193 | \item columns names 'trend_stat' and 'trend_p' containing character strings 194 | } 195 | 196 | The character strings, heterogeneity test, and trend test results will 197 | be plotted in the column of estimates and CIs, below the row with the key 198 | given in the col.key column.} 199 | 200 | \item{bottom.space}{Space between bottom row and axis. (Default: 0.7)} 201 | 202 | \item{left.space, right.space, mid.space}{Space to the left/right/between panels. 203 | (Default mid.space: unit(5, "mm"))} 204 | 205 | \item{plot.margin}{Plot margin, given as margin(top, right, bottom, left, units). (Default: margin(8, 8, 8, 8, "mm"))} 206 | 207 | \item{panel.width, panel.height}{Set width/height of panels. A grid::unit object, if a numeric is given assumed to be in mm. 208 | If panel.width is used, will alsovapply different formatting to narrow CIs.} 209 | 210 | \item{base_size}{base font size, given in pts.} 211 | 212 | \item{base_line_size}{base size for line elements} 213 | 214 | \item{stroke}{Size of outline of shapes. (Default: 0)} 215 | 216 | \item{diamonds.linewidth}{Line width for diamonds. (Default: base_line_size)} 217 | 218 | \item{quiet}{Set to TRUE to not print the plot nor show generated code in the RStudio 'Viewer' pane. (Default: FALSE)} 219 | 220 | \item{printplot}{Print the plot. (Default: !quiet)} 221 | 222 | \item{showcode}{Show the ggplot2 code to generate the plot in RStudio 'Viewer' pane. (Default: !quiet)} 223 | 224 | \item{data.function}{Name of a function to apply to data frame before plotting.} 225 | 226 | \item{addaes, addarg, add}{Methods for customising the plot. See documentation for details.} 227 | 228 | \item{envir}{Environment in which to evaluate the plot code. 229 | May be useful when calling this function inside another function.} 230 | 231 | \item{blankrows}{DEPRECATED} 232 | } 233 | \value{ 234 | A list: 235 | \describe{ 236 | \item{plot}{the plot} 237 | \item{code}{ggplot2 code to generate the plot} 238 | } 239 | } 240 | \description{ 241 | Creates a forest plot with ggplot 242 | } 243 | \details{ 244 | The function returns the plot and ggplot2 code to create the plot. 245 | In RStudio, the ggplot2 code will be shown in the viewer. 246 | } 247 | -------------------------------------------------------------------------------- /man/geom_text_move.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-text-move.R 3 | \docType{data} 4 | \name{geom_text_move} 5 | \alias{geom_text_move} 6 | \alias{GeomTextMove} 7 | \title{Text that can be moved} 8 | \usage{ 9 | geom_text_move( 10 | mapping = NULL, 11 | data = NULL, 12 | stat = "identity", 13 | position = "identity", 14 | ..., 15 | parse = FALSE, 16 | nudge_x = 0, 17 | nudge_y = 0, 18 | move_x = unit(0, "pt"), 19 | move_y = unit(0, "pt"), 20 | check_overlap = FALSE, 21 | na.rm = FALSE, 22 | show.legend = NA, 23 | inherit.aes = TRUE 24 | ) 25 | } 26 | \arguments{ 27 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and 28 | \code{inherit.aes = TRUE} (the default), it is combined with the default mapping 29 | at the top level of the plot. You must supply \code{mapping} if there is no plot 30 | mapping.} 31 | 32 | \item{data}{The data to be displayed in this layer. There are three 33 | options: 34 | 35 | If \code{NULL}, the default, the data is inherited from the plot 36 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 37 | 38 | A \code{data.frame}, or other object, will override the plot 39 | data. All objects will be fortified to produce a data frame. See 40 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 41 | 42 | A \code{function} will be called with a single argument, 43 | the plot data. The return value must be a \code{data.frame}, and 44 | will be used as the layer data. A \code{function} can be created 45 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 46 | 47 | \item{stat}{The statistical transformation to use on the data for this 48 | layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the 49 | stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than 50 | \code{"stat_count"})} 51 | 52 | \item{position}{Position adjustment, either as a string, or the result of 53 | a call to a position adjustment function. Cannot be jointly specified with 54 | \code{nudge_x} or \code{nudge_y}.} 55 | 56 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 57 | often aesthetics, used to set an aesthetic to a fixed value, like 58 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 59 | to the paired geom/stat.} 60 | 61 | \item{parse}{If \code{TRUE}, the labels will be parsed into expressions and 62 | displayed as described in \code{?plotmath}.} 63 | 64 | \item{nudge_x, nudge_y}{Horizontal and vertical adjustment to nudge labels by. 65 | Useful for offsetting text from points, particularly on discrete scales. 66 | Cannot be jointly specified with \code{position}.} 67 | 68 | \item{move_x}{Unit value to move text horizontally (Default: unit(0, "pt"))} 69 | 70 | \item{move_y}{Unit value to move text vertically (Default: unit(0, "pt"))} 71 | 72 | \item{check_overlap}{If \code{TRUE}, text that overlaps previous text in the 73 | same layer will not be plotted. \code{check_overlap} happens at draw time and in 74 | the order of the data. Therefore data should be arranged by the label 75 | column before calling \code{geom_text()}. Note that this argument is not 76 | supported by \code{geom_label()}.} 77 | 78 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 79 | a warning. If \code{TRUE}, missing values are silently removed.} 80 | 81 | \item{show.legend}{logical. Should this layer be included in the legends? 82 | \code{NA}, the default, includes if any aesthetics are mapped. 83 | \code{FALSE} never includes, and \code{TRUE} always includes. 84 | It can also be a named logical vector to finely select the aesthetics to 85 | display.} 86 | 87 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 88 | rather than combining with them. This is most useful for helper functions 89 | that define both data and aesthetics and shouldn't inherit behaviour from 90 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 91 | } 92 | \description{ 93 | This geom adds a fixed horizontal and/or vertical move to ggplot2::geom_text() 94 | } 95 | \section{Aesthetics}{ 96 | 97 | 98 | \code{geom_text_move()} understands the same aesthetics as \code{ggplot2::geom_text()} 99 | } 100 | 101 | \keyword{datasets} 102 | -------------------------------------------------------------------------------- /man/ggpreview.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/save-figure.R 3 | \name{ggpreview} 4 | \alias{ggpreview} 5 | \title{Create a plot preview and display it in the Viewer pane.} 6 | \usage{ 7 | ggpreview(...) 8 | } 9 | \arguments{ 10 | \item{...}{Arguments passed to \code{ggsave} and the PNG device function.} 11 | } 12 | \description{ 13 | This function saves a ggplot2 plot to a temporary PNG file and then embeds it in an HTML 14 | page, which is opened in the Viewer pane. 15 | } 16 | \section{Device}{ 17 | The plot is saved using \code{ggsave} with the \code{png} device, regardless of what is specified in 18 | the call, so any arguments not used by \code{ggsave} or \code{png} are ignored. 19 | } 20 | 21 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | See \code{magrittr::\link[magrittr]{\%>\%}} for details. 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /man/plot_like_ckb.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ckb-style.R 3 | \name{plot_like_ckb} 4 | \alias{plot_like_ckb} 5 | \title{Make a ggplot into CKB style} 6 | \usage{ 7 | plot_like_ckb(plot, ...) 8 | } 9 | \arguments{ 10 | \item{plot}{A ggplot2 plot} 11 | 12 | \item{...}{Arguments passed to ckb_style()} 13 | } 14 | \value{ 15 | A ggplot2 plot. 16 | } 17 | \description{ 18 | Make a ggplot into CKB style 19 | } 20 | -------------------------------------------------------------------------------- /man/prepare_figure.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/save-figure.R 3 | \name{prepare_figure} 4 | \alias{prepare_figure} 5 | \title{Prepare figure for saving} 6 | \usage{ 7 | prepare_figure( 8 | figure, 9 | title = "", 10 | title.pos = grid::unit.c(unit(1.27/2, "cm"), unit(1, "npc") - unit(1.27/2, "cm")), 11 | title.just = c(0, 1), 12 | title.gpar = list(fontsize = 12, fontface = "bold"), 13 | footer = "", 14 | footer.pos = grid::unit.c(unit(1.27/2, "cm"), unit(1.27/3, "cm")), 15 | footer.just = c(0, 0), 16 | footer.gpar = list(fontsize = 9), 17 | margin = unit(c(2.27, 1.27, 1.27, 1.27), units = "cm"), 18 | size = NULL, 19 | valign = 0.5, 20 | halign = 0.5, 21 | pagesize = c("A4", "A5"), 22 | landscape = FALSE, 23 | pagedim = NULL 24 | ) 25 | } 26 | \arguments{ 27 | \item{figure}{Plot (or graphical object).} 28 | 29 | \item{title}{Title to be added to the page. (Default: "")} 30 | 31 | \item{title.pos}{Position of the title text. Default is 1/4 inch from top left of page. 32 | (Default: unit.c(unit(1.27/2, "cm"), unit(1, "npc") - unit(1.27/2, "cm")))} 33 | 34 | \item{title.just}{Justification of the title text. (Default: c(0, 1))} 35 | 36 | \item{title.gpar}{Graphical parameters for title. (Default: list(fontsize = 12, fontface = "bold"))} 37 | 38 | \item{footer}{Footer to be added to the page. (Default: "")} 39 | 40 | \item{footer.pos}{Position of the footer text. 41 | Default is 1/6 inch from bottom and 1/4 inch from left of page. 42 | (Default: unit.c(unit(1.27/2, "cm"), unit(1.27/3, "cm")))} 43 | 44 | \item{footer.just}{Justification of the footer text. (Default: c(0, 0))} 45 | 46 | \item{footer.gpar}{Graphical parameters for footer. (Default: list(fontsize = 9))} 47 | 48 | \item{margin}{Margin to be placed around the plot. 49 | Default is 2.27cm top, 1.27cm (1/2 inch) other sides. 50 | (Default: unit(c(2.27, 1.27, 1.27, 1.27), units = "cm"))} 51 | 52 | \item{size}{A unit vector of length two (width, height). 53 | Size of plot (a width/height larger than page weight/height minus margins will be 54 | ignored), centred within margins. 55 | By default, plot will fill the space within margins.} 56 | 57 | \item{valign}{If size is set, where to place figure within margins. 1 = top, 0.5 = middle, 0 = bottom. (Default: 0.5)} 58 | 59 | \item{halign}{If size is set, where to place figure within margins. 1 = right, 0.5 = middle, 0 = left (Default: 0.5)} 60 | 61 | \item{pagesize}{Page size of output: "A4" or "A5". (Default: "A4")} 62 | 63 | \item{landscape}{Landscape page orientation? (Default: False)} 64 | 65 | \item{pagedim}{Dimensions (width, height) of output. Overrides pagesize and landscape arguments if used.} 66 | } 67 | \description{ 68 | Prepare figure for saving 69 | } 70 | -------------------------------------------------------------------------------- /man/save_figure.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/save-figure.R 3 | \name{save_figure} 4 | \alias{save_figure} 5 | \title{Output plots as files} 6 | \usage{ 7 | save_figure( 8 | figure, 9 | filename, 10 | cropped = NULL, 11 | args = NULL, 12 | args_cropped = NULL, 13 | preview = FALSE, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{figure}{Plot (or graphical object).} 19 | 20 | \item{filename}{Name of file to create.} 21 | 22 | \item{cropped}{Name of second output file of the figure without margins or title.} 23 | 24 | \item{args}{List of arguments passed to \code{ggplot2::ggsave()} for the main figure.} 25 | 26 | \item{args_cropped}{List of arguments passed to \code{ggplot2::ggsave()} for the cropped figure.} 27 | 28 | \item{preview}{Preview the output in the RStudio Viewer pane. (Default: False)} 29 | 30 | \item{...}{Other arguments passed to \link{prepare_figure}.} 31 | } 32 | \description{ 33 | Output plots as files 34 | } 35 | -------------------------------------------------------------------------------- /man/shape_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shape-plot.R 3 | \name{shape_plot} 4 | \alias{shape_plot} 5 | \title{Make a shape plot with ggplot2} 6 | \usage{ 7 | shape_plot( 8 | data, 9 | col.x = "x", 10 | col.estimate = c("estimate", "est", "beta", "loghr"), 11 | col.stderr = c("stderr", "std.err", "se"), 12 | col.lci = NULL, 13 | col.uci = NULL, 14 | col.n = NULL, 15 | exponentiate = FALSE, 16 | logscale = exponentiate, 17 | scalepoints = FALSE, 18 | digits = 2, 19 | minse = NA, 20 | pointsize = 3, 21 | col.group = NULL, 22 | shape = 15, 23 | plotcolour = "black", 24 | colour = plotcolour, 25 | cicolour = colour, 26 | fill = colour, 27 | ciunder = NULL, 28 | lines = FALSE, 29 | xlims, 30 | ylims, 31 | height = NULL, 32 | width = NULL, 33 | gap = c(0.025, 0.025), 34 | ext = c(0.025, 0.025), 35 | ratio = 1.5, 36 | base_size = 11, 37 | base_line_size = base_size/22, 38 | stroke = base_size/22, 39 | axis.title.margin = 1, 40 | xbreaks = NULL, 41 | ybreaks = NULL, 42 | xlab = "Risk factor", 43 | ylab = "Estimate (95\% CI)", 44 | legend.name = "", 45 | legend.position = "top", 46 | title = NULL, 47 | quiet = FALSE, 48 | printplot = !quiet, 49 | showcode = !quiet, 50 | addaes = NULL, 51 | addarg = NULL, 52 | add = NULL, 53 | envir = NULL 54 | ) 55 | } 56 | \arguments{ 57 | \item{data}{The data frame containing estimates to be plotted.} 58 | 59 | \item{col.x}{Name of column that provides the x-axis value (e.g. exposure, risk factor, dependent variable). (Default: "x")} 60 | 61 | \item{col.estimate}{Name of column that provides point estimates. 62 | (Default: "estimate")} 63 | 64 | \item{col.stderr}{Name of column that provides standard errors. (Default: "stderr")} 65 | 66 | \item{col.lci}{Name of column that provides lower limit of confidence intervals.} 67 | 68 | \item{col.uci}{Name of column that provides upper limit of confidence intervals.} 69 | 70 | \item{col.n}{Name of column that provides number to be plotted below CIs.} 71 | 72 | \item{exponentiate}{Exponentiate estimates (and CIs) before plotting, 73 | use log scale on the axis. (Default: FALSE)} 74 | 75 | \item{logscale}{Use log scale for vertical axis. (Default: exponentiate)} 76 | 77 | \item{scalepoints}{Should the points be scaled by inverse of the standard 78 | error? (Default: FALSE)} 79 | 80 | \item{digits}{Number of digits to use in text of estimates.} 81 | 82 | \item{minse}{Minimum standard error to use when scaling point size. (Default will use minimum in the data.)} 83 | 84 | \item{pointsize}{The (largest) size of box to use for plotting point 85 | estimates. (Default: 3)} 86 | 87 | \item{col.group}{Name of column that groups the estimates. (Default: NULL)} 88 | 89 | \item{shape}{Shape of points. An integer, or name of a column of integers. (Default: 15)} 90 | 91 | \item{plotcolour}{Colour for non-data aspects of the plot. (Default: "black")} 92 | 93 | \item{colour}{Colour of points. Name of a colour, or name of a column of colour names. (Default will use plotcolour)} 94 | 95 | \item{cicolour}{Colour of CI lines. Colour of CI lines. Name of a colour, or name of a column of colour names. (Default will use plotcolour)} 96 | 97 | \item{fill}{Fill colour of points. Fill colour of points. Name of a colour, or name of a column of colour names. (Default will use plotcolour)} 98 | 99 | \item{ciunder}{Plot CI lines before points. A logical value, or name of a column of logical values. (Default will plot CI lines after points.)} 100 | 101 | \item{lines}{Plot lines (linear fit through estimates, weighted by inverse variance). (Default: FALSE)} 102 | 103 | \item{xlims}{A numeric vector of length two. The limits of the x-axis.} 104 | 105 | \item{ylims}{A numeric vector of length two. The limits of the y-axis.} 106 | 107 | \item{height}{Panel height to use and apply different formatting to short CIs. A grid::unit() object, or if numeric is assumed to be in mm.} 108 | 109 | \item{width}{Panel width.A grid::unit() object, or if numeric is assumed to be in mm.} 110 | 111 | \item{gap}{A numeric vector of length two. The gap between plotting area and axis to the left and bottom of the plot, as a proportion of the x-axis length. (Default: c(0.025, 0.025))} 112 | 113 | \item{ext}{A numeric vector of length two. The extensions to add to the right and top of the plot, as a proportion of the x-axis length. (Default: c(0.025, 0.025))} 114 | 115 | \item{ratio}{The ratio (y-axis:x-axis) to use for the plot. (Default: 1.5)} 116 | 117 | \item{base_size}{base font size, given in pts.} 118 | 119 | \item{base_line_size}{base size for line elements} 120 | 121 | \item{stroke}{Size of outline of shapes. (Default: base_size/22)} 122 | 123 | \item{axis.title.margin}{Margin between axis titles and plot. (Default: 1)} 124 | 125 | \item{xbreaks}{Breaks for the x axis. Passed to ggplots::scale_x_continuous. (Default: NULL)} 126 | 127 | \item{ybreaks}{Breaks for the y axis. Passed to ggplots::scale_y_continuous. (Default: NULL)} 128 | 129 | \item{xlab}{Label for x-axis. (Default: "Risk factor")} 130 | 131 | \item{ylab}{Label for y-axis. (Default: "Estimate (95\% CI)")} 132 | 133 | \item{legend.name}{The name of the colour scale/legend for groups. (Default: "")} 134 | 135 | \item{legend.position}{Position of the legend for groups ("none", "left", "right", "bottom", "top", or two-element numeric vector). (Default: "top")} 136 | 137 | \item{title}{Plot title. (Default: NULL)} 138 | 139 | \item{quiet}{Set to TRUE to not print the plot nor show generated code in the RStudio 'Viewer' pane. (Default: FALSE)} 140 | 141 | \item{printplot}{Print the plot. (Default: !quiet)} 142 | 143 | \item{showcode}{Show the ggplot2 code to generate the plot in RStudio 'Viewer' pane. (Default: !quiet)} 144 | 145 | \item{addaes, addarg, add}{Methods for customising the plot. See documentation for details.} 146 | 147 | \item{envir}{Environment in which to evaluate the plot code. May be useful when calling this function inside another function.} 148 | } 149 | \value{ 150 | A list: 151 | \describe{ 152 | \item{plot}{the plot} 153 | \item{code}{ggplot2 code to generate the plot} 154 | } 155 | } 156 | \description{ 157 | Make a shape plot with ggplot2 158 | } 159 | -------------------------------------------------------------------------------- /man/theme_ckb.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ckb-style.R 3 | \name{theme_ckb} 4 | \alias{theme_ckb} 5 | \title{CKB ggplot theme} 6 | \usage{ 7 | theme_ckb( 8 | base_size = 11, 9 | base_line_size = base_size/22, 10 | colour = "black", 11 | axis.title.margin = 1, 12 | plot.margin = margin(0.5, 1.5, 0.5, 0.5, "lines") 13 | ) 14 | } 15 | \arguments{ 16 | \item{base_size}{base font size, given in pts.} 17 | 18 | \item{base_line_size}{base size for line elements} 19 | 20 | \item{colour}{Colour for non-data aspects of the plot. (Default: "black")} 21 | 22 | \item{axis.title.margin}{Margin between axis titles and plot. (Default: 1)} 23 | 24 | \item{plot.margin}{Margin around entire plot (Default: margin(0.5, 0, 0.5, 0, "lines"))} 25 | } 26 | \description{ 27 | Based on theme_bw 28 | } 29 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/pkgdown/favicon/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/pkgdown/favicon/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/tests.html 7 | # * https://testthat.r-lib.org/reference/test_package.html#special-files 8 | 9 | library(testthat) 10 | library(ckbplotr) 11 | 12 | test_check("ckbplotr") 13 | -------------------------------------------------------------------------------- /tests/testthat/test-forest-data.R: -------------------------------------------------------------------------------- 1 | test_that("forest_data throws an error if col.lci is specified but col.uci is not", { 2 | expect_error(forest_data(panels = data.frame(), 3 | panel.names = NULL, 4 | row.labels = NULL, 5 | row.labels.levels = NULL, 6 | row.labels.space = NULL, 7 | col.lci = "a", 8 | col.uci = NULL), 9 | "col.lci and col.uci must both be specified") 10 | }) 11 | 12 | test_that("forest_data throws an error if col.uci is specified but col.lci is not", { 13 | expect_error(forest_data(panels = data.frame(), 14 | panel.names = NULL, 15 | row.labels = NULL, 16 | row.labels.levels = NULL, 17 | row.labels.space = NULL, 18 | col.lci = NULL, 19 | col.uci = "a"), 20 | "col.lci and col.uci must both be specified") 21 | }) 22 | 23 | test_that("forest_data throws an error if panel.names is not a character vector", { 24 | expect_error(forest_data(panels = data.frame(), 25 | panel.names = 1, 26 | row.labels = NULL, 27 | row.labels.levels = NULL, 28 | row.labels.space = NULL, 29 | col.lci = NULL, 30 | col.uci = NULL), 31 | "panel.names must be a character vector") 32 | }) 33 | 34 | test_that("forest_data throws an error if panel.names is not unique", { 35 | expect_error(forest_data(panels = data.frame(), 36 | panel.names = c("a", "b", "a"), 37 | row.labels = NULL, 38 | row.labels.levels = NULL, 39 | row.labels.space = NULL, 40 | col.lci = NULL, 41 | col.uci = NULL), 42 | "panel.names must be unique") 43 | }) 44 | 45 | test_that("forest_data throws an error if panels and panel.names have different lengths", { 46 | expect_error(forest_data(panels = data.frame(), 47 | panel.names = c("a", "b"), 48 | row.labels = NULL, 49 | row.labels.levels = NULL, 50 | row.labels.space = NULL, 51 | col.lci = NULL, 52 | col.uci = NULL), 53 | "panels and panel.names must be the same length") 54 | }) 55 | 56 | test_that("forest_data throws an error if row.labels.space is less than 2*(length(row.labels.levels)-1)", { 57 | expect_error(forest_data(panels = data.frame(), 58 | panel.names = "panel", 59 | row.labels = NULL, 60 | row.labels.levels = c("heading", "subheading"), 61 | row.labels.space = 1, 62 | col.lci = NULL, 63 | col.uci = NULL)) 64 | }) 65 | 66 | # Test if function throws an error if row.labels.levels is not a column in row.labels 67 | test_that("forest_data throws an error if row.labels.levels is not a column in row.labels", { 68 | expect_error(forest_data(panels = data.frame(), 69 | panel.names = "panel", 70 | row.labels = data.frame(x = 1:10), 71 | row.labels.levels = c("y"), 72 | row.labels.space = NULL, 73 | col.lci = NULL, 74 | col.uci = NULL), 75 | "row.labels.levels must be columns in row.labels") 76 | }) 77 | 78 | test_that("forest_data throws an error if row.labels.levels columns are not character", { 79 | expect_error(forest_data(panels = data.frame(), 80 | panel.names = "panel", 81 | row.labels = data.frame(y = 1:5), 82 | row.labels.levels = c("y"), 83 | row.labels.space = NULL, 84 | col.lci = NULL, 85 | col.uci = NULL), 86 | "row.labels.levels columns must be character") 87 | }) 88 | 89 | 90 | test_that("make_heterogeneity_string returns the expected string", { 91 | het_dof <- "5" 92 | het_stat <- "15.68" 93 | het_p <- "=0.0001" 94 | expected_output <- "paste('Heterogeneity: ', chi[5]^2,'=15.68 (p=0.0001)', sep='')" 95 | expect_equal( 96 | make_heterogeneity_string(het_dof, het_stat, het_p), 97 | expected_output 98 | ) 99 | }) 100 | 101 | 102 | 103 | 104 | 105 | 106 | test_that("make_trend_string returns the expected string", { 107 | trend_stat <- "10.12" 108 | trend_p <- "=0.012" 109 | expected_output <- "paste('Trend: ', chi[1]^2,'=10.12 (p=0.012)', sep='')" 110 | expect_equal( 111 | make_trend_string(trend_stat, trend_p), 112 | expected_output 113 | ) 114 | }) 115 | 116 | 117 | 118 | 119 | 120 | test_that("add_row_label_above returns the expected data frame", { 121 | data <- tibble::tribble( 122 | ~row.label, ~row.height, ~spacing_row, 123 | "A", NA, FALSE, 124 | "B", NA, FALSE 125 | ) 126 | heading <- "Heading" 127 | blank_after_heading <- 0.5 128 | blank_after_section <- 0.5 129 | expected_output <- tibble::tribble( 130 | ~row.label, ~row.height, ~spacing_row, 131 | "Heading", NA, FALSE, 132 | "", 0.5, TRUE, 133 | "A", NA, FALSE, 134 | "B", NA, FALSE, 135 | "", 0.5, TRUE 136 | ) 137 | 138 | expect_equal( 139 | add_row_label_above(data, heading, blank_after_heading, blank_after_section), 140 | expected_output 141 | ) 142 | }) 143 | 144 | 145 | 146 | 147 | 148 | 149 | test_that("make_auto_estcolumn_text returns the expected text", { 150 | est <- 1.234567 151 | lci <- 0.987654 152 | uci <- 1.543210 153 | digits <- 2 154 | ci.delim <- "-" 155 | expected_output <- "1.23 (0.99-1.54)" 156 | 157 | expect_equal( 158 | make_auto_estcolumn_text(est, lci, uci, digits, ci.delim), 159 | expected_output 160 | ) 161 | }) 162 | 163 | -------------------------------------------------------------------------------- /tests/testthat/test-forest-plot.R: -------------------------------------------------------------------------------- 1 | test_that("forest_data throws an error if column doesn't exist in every panel's data frame", { 2 | panels <- list(data.frame(a = 1:3), data.frame(a = 4:6)) 3 | expect_error(forest_plot(panels, 4 | col.left = "b"), 5 | "Column 'b' does not exist in every panels data frame.") 6 | }) 7 | 8 | test_that("forest_data throws an error if cicolour is a list or longer than 1 but not using panel.width", { 9 | panels <- list(data.frame(a = 1:3), data.frame(a = 4:6)) 10 | expect_error(forest_plot(panels = panels, 11 | cicolour = c("black", "white"))) 12 | }) 13 | 14 | -------------------------------------------------------------------------------- /tests/testthat/test-geom-text-move.R: -------------------------------------------------------------------------------- 1 | test_that("geom_text_move moves text correctly", { 2 | df <- data.frame(x = 1:5, y = 1:5, label = letters[1:5]) 3 | p1 <- ggplot(df, aes(x, y, label = label)) + 4 | geom_text_move(move_x = unit(5, "mm"), 5 | move_y = unit(10, "mm")) + 6 | geom_text() 7 | 8 | grob_text_move <- layer_grob(p1)[[1]] 9 | grob_text <- layer_grob(p1, i = 2)[[1]] 10 | 11 | # check that the text in geom_text_move is moved by 5pt horizontally and vertically 12 | expect_equal(grid::convertWidth(grob_text_move$x - grob_text$x, "mm"), 13 | unit(rep(5, 5), "mm")) 14 | expect_equal(grid::convertHeight(grob_text_move$y - grob_text$y, "mm"), 15 | unit(rep(10, 5), "mm")) 16 | }) 17 | -------------------------------------------------------------------------------- /tests/testthat/test-plot-like-ckb.R: -------------------------------------------------------------------------------- 1 | test_that("theme_ckb runs without error", { 2 | expect_no_error(theme_ckb()) 3 | }) 4 | -------------------------------------------------------------------------------- /tests/testthat/test-shape-plot-parts.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilstats/ckbplotr/048679b04d1c5bba76097bd5a08c8a72062ca118/tests/testthat/test-shape-plot-parts.R -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | test_that("indent", { 2 | expect_null(indent(1)) 3 | expect_equal(indent(2, "test text"), 4 | " test text") 5 | }) 6 | 7 | test_that("column_name", { 8 | expect_equal(column_name("x y"), "`x y`") 9 | expect_equal(column_name("x-y"), "`x-y`") 10 | expect_equal(column_name("xy"), "xy") 11 | }) 12 | 13 | test_that("quote_string", { 14 | expect_equal(quote_string("x"), "\"x\"") 15 | }) 16 | 17 | test_that("argset", { 18 | expect_equal(argset("x"), "\"x\" = \"x\"") 19 | }) 20 | 21 | test_that("ggplot layers are built correctly", { 22 | expect_equal(make_layer(name = "# add a layer", 23 | f = "some_geom", 24 | aes = c("x = 1", "y = 1"), 25 | arg = c("size = 3", "colour = 'red'")), 26 | c("# add a layer", 27 | "some_geom(aes(x = 1,", 28 | " y = 1),", 29 | " size = 3,", 30 | " colour = 'red') +", 31 | "")) 32 | }) 33 | 34 | test_that("ds handles unicode correctly", { 35 | expect_equal(ds("a \u2265 b"), 36 | "\"a \\u2265 b\"") 37 | }) 38 | 39 | test_that("printunit", { 40 | expect_equal(printunit(unit(1, "cm")), 41 | "unit(1, \"cm\")") 42 | }) 43 | 44 | test_that("makeunit", { 45 | expect_equal(makeunit(unit(1, "cm")), 46 | "\"cm\"") 47 | expect_equal(makeunit(unit(1, "in")), 48 | "\"inches\"") 49 | expect_equal(makeunit(unit(1, "null")), 50 | "\"null\"") 51 | }) 52 | 53 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/ckb_style.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "CKB style with ggplot" 3 | output: 4 | rmarkdown::html_vignette: 5 | fig_width: 4 6 | fig_height: 4 7 | toc: TRUE 8 | vignette: > 9 | %\VignetteIndexEntry{CKB style with ggplot} 10 | %\VignetteEngine{knitr::rmarkdown} 11 | %\VignetteEncoding{UTF-8} 12 | --- 13 | 14 | ```{r, include = FALSE} 15 | knitr::opts_chunk$set( 16 | collapse = TRUE, 17 | comment = "#>", 18 | fig.width = 4, 19 | fig.height = 4, 20 | fig.align = "center", 21 | out.width = '50%' 22 | ) 23 | ``` 24 | 25 | ```{r setup, include = FALSE} 26 | library(ckbplotr) 27 | ``` 28 | 29 | `+ ckb_style()` does three things to a ggplot2 plot: 30 | 31 | 1. applies a CKB theme (i.e. change the overall appearance) 32 | 2. extends the plotting area and manually adds axis lines (so that you can have a custom sized gap between the plotting area and the axes) 33 | 3. applies a fixed aspect ratio 34 | 35 | ## Examples with a scatter plot 36 | Make a scatter plot with `ggplot`. 37 | ```{r a-plot} 38 | plot <- ggplot(data = mpg, aes(x = displ, y = hwy)) + geom_point(size = 1) 39 | plot 40 | ``` 41 | 42 | Use `+ ckb_style()` to apply a CKB theme, add separated axis lines and fix the aspect ratio. 43 | ```{r plot_like_ckb-example-0} 44 | plot + ckb_style() 45 | ``` 46 | 47 | Or apply just a CKB theme and use axis lines. 48 | ```{r theme} 49 | plot + theme_ckb() + theme(axis.line = element_line()) 50 | ``` 51 | 52 | 53 | ### Axis limits 54 | Set axis limits. 55 | ```{r plot_like_ckb-example-1} 56 | plot + ckb_style(xlims = c(0, 8), ylims = c(10, 50)) 57 | ``` 58 | 59 | If you do not want a gap between the axes, set `gap = c(0, 0)`. 60 | ```{r plot_like_ckb-example-2} 61 | plot + ckb_style(xlims = c(0, 8), ylims = c(10, 50), gap = c(0, 0)) 62 | ``` 63 | 64 | ### Aspect ratio and panel sizes 65 | Change the aspect ratio of the plot. 66 | ```{r aspect-ratio, fig.width = 6} 67 | plot + ckb_style(xlims = c(0, 8), 68 | ylims = c(10, 50), 69 | ratio = 0.3) 70 | ``` 71 | 72 | Set the width of the plot (`width` controls the length of the x axis). 73 | ```{r width, fig.width = 6} 74 | plot + ckb_style(xlims = c(0, 8), 75 | ylims = c(10, 50), 76 | ratio = 1.5, 77 | width = unit(4, "cm")) 78 | ``` 79 | 80 | 81 | 82 | ### Modifying the appearance of the plot 83 | The `colour` arguments of `theme_ckb()` and `ckb_style()` can be used to change the colour of the non-data components of the plot. 84 | ```{r colour} 85 | plot + ckb_style(xlims = c(0, 8), 86 | ylims = c(10, 50), 87 | colour = "darkred") 88 | ``` 89 | 90 | The `plot.margin` arguments of `theme_ckb()` and `ckb_style()` can be used to adjust the margin around the plot. 91 | ```{r plotmargin} 92 | plot + ckb_style(xlims = c(0, 8), 93 | ylims = c(10, 50), 94 | plot.margin = margin(2, 2, 2, 2, unit = "cm")) 95 | ``` 96 | 97 | If you wish to override some aspect of the theme applied by `ckb_style()` or `theme_ckb()`, 98 | then this can be done by adding a theme after `+ ckb_style()`, 99 | ```{r plot_like_ckb-example-3} 100 | plot + ckb_style(xlims = c(0, 8), 101 | ylims = c(10, 50)) + 102 | theme(axis.title = element_text(colour = "red", face = "plain")) 103 | ``` 104 | 105 | 106 | ### Warning about axis limits 107 | If any data points you are plotting fall outside the axes, then they will still 108 | be drawn and may show up in places such as the axes, the legend, the plot title, 109 | or the plot margins. There is also no warning if data points fall outside the whole plot area. 110 | 111 | So it is best to check that your `xlim` and `ylim` values are suitable for your 112 | data before using the function. 113 | ```{r plot_like_ckb-example-4} 114 | # The xlim and ylim ranges are too narrow 115 | plot + ckb_style(xlims = c(0, 4), ylims = c(20, 50)) 116 | ``` 117 | 118 | 119 | ## Bar chart example 120 | ```{r bar-chart-example, fig.width = 6, out.width = '70%'} 121 | ggplot(mpg, aes(class)) + 122 | geom_bar() + 123 | ckb_style(xlims = c(0.5, 7.5), 124 | ylims = c(0, 70), 125 | gap = c(0.025, 0.005), 126 | ratio = 0.5) + 127 | theme(axis.ticks.x = element_blank()) 128 | ``` 129 | -------------------------------------------------------------------------------- /vignettes/ckbplotr.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Get started with ckbplotr" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Get started with ckbplotr} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | fig.width = 7, 15 | fig.height = 7, 16 | fig.align = "center" 17 | ) 18 | ``` 19 | 20 | ```{r setup, include = F} 21 | library(ckbplotr) 22 | ``` 23 | 24 | ## Introduction 25 | The `ckbplotr` R package provides functions to help create and style plots in R using the [ggplot2](https://ggplot2.tidyverse.org/) graphics package 26 | 27 | ## CKB style 28 | Use `+ ckb_style()` to apply CKB style to a ggplot. See [CKB style ggplot](ckb_style.html) for details. 29 | 30 | ## Plots 31 | Create plots of estimates against risk factor levels using `shape_plot()`. See [Shape plots](shape_plots.html) for details. 32 | 33 | Create forest plots using `forest_plot()`. See [Forest plots](forest_plots.html) for details. 34 | 35 | See [Page layouts](page_layouts.html) for tips and packages for combining separate plots. 36 | 37 | ## Saving 38 | See [Save plots to files](save_plots.html). 39 | -------------------------------------------------------------------------------- /vignettes/customising_plots.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Customising plots" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Customising plots} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | fig.width = 4, 15 | fig.height = 3, 16 | fig.align = "center", 17 | out.width = '60%', 18 | dpi = 120, 19 | message = FALSE 20 | ) 21 | library(ckbplotr) 22 | my_results <- data.frame( 23 | subgroup = c("men", "women", "35_49", "50_64", "65_79"), 24 | est = c( 0.45, 0.58, 0.09, 0.35, 0.6), 25 | se = c( 0.07, 0.06, 0.06, 0.05, 0.08) 26 | ) 27 | ``` 28 | 29 | 30 | ## Arguments 31 | In `shape_plot()` and `forest_plot()` use `base_size` to set the base font and line size (default: 11pts) and use `base_line_size` to separately set the base thickness of lines (default: base_size/22). 32 | 33 | In `forest_plot()` use `plotcolour` to change the colour for all parts of the plot. In `shape_plot()` use `plotcolour` to change the colour for non-data aspects of the plot. 34 | 35 | In `shape_plot()` and `forest_plot()` several arguments can be used to change visual properties for parts of the plot. These can be names of columns in your data or single values. In `shape_plot()` use: 36 | 37 | | argument | controls | type | 38 | |-------------|---------------------------------------------------|-----------| 39 | | shape | plotting character for points | integer | 40 | | colour | colour of points | character | 41 | | cicolour | colour of CI lines | character | 42 | | fill | fill colour of points | character | 43 | | ciunder | if the CI line should be plotted before the point | logical | 44 | 45 | In `forest_plot()` use: 46 | 47 | | argument | controls | type | 48 | |-------------|---------------------------------------------------|-----------| 49 | | shape | plotting character for points | integer | 50 | | colour | colour of points and lines | character | 51 | | fill | fill colour of points | character | 52 | | ciunder | if the CI line should be plotted before the point | logical | 53 | | col.bold | if text is bold | logical | 54 | | col.diamond | if a diamond should be plotted | logical | 55 | 56 | Note that `col.bold`, and `col.diamond` must be column names in the supplied data frames, while the others can be fixed values or column names. For diamonds, alternatively provide a character vector of keys in the `diamond` argument. 57 | 58 | For `fill` to have any effect, the shape will need to be a shape with fill e.g. `"square filled"`. 59 | 60 | 61 | ## Adding to the ggplot 62 | In `forest_plot()` and `shape_plot()` you can add additional ggplot objects to the plot with the `add` argument. The argument should be a named list, where the name `start` is an object to be included in the ggplot immediately after `ggplot()` (i.e. before anything else is added to the ggplot) and the name `end` will add to the end. 63 | 64 | This argument can be used, for example, to add additional geoms to the plot: 65 | ```{r} 66 | hr_geom <- geom_text(aes(label = auto_estcolumn), 67 | size = 3, 68 | hjust = 0, 69 | nudge_y = 0.25, 70 | colour = "red") 71 | 72 | forest_plot(my_results, 73 | estcolumn = FALSE, 74 | add = list(start = hr_geom)) 75 | ``` 76 | 77 | Or to use `theme` to customise the plot: 78 | ```{r} 79 | my_theme <- theme(axis.text.x = element_text(colour = "purple", 80 | angle = 45, 81 | hjust = 1)) 82 | forest_plot(my_results, 83 | add = list(end = my_theme)) 84 | ``` 85 | 86 | To add multiple objects, use a list: 87 | ```{r} 88 | my_parts <- list(hr_geom, 89 | my_theme) 90 | forest_plot(my_results, 91 | estcolumn = FALSE, 92 | add = list(end = my_parts)) 93 | ``` 94 | 95 | 96 | 97 | 98 | 99 | ## The data.function argument 100 | Use the `data.function` argument in `forest_plot()` to change the plot data immediately before plotting. 101 | 102 | For example, you can tweak the text in the generated estimates column: 103 | ```{r} 104 | my_func <- function(dfr){ 105 | dfr$auto_estcolumn <- sub("\\(", "[", dfr$auto_estcolumn) 106 | dfr$auto_estcolumn <- sub("\\)", "]", dfr$auto_estcolumn) 107 | return(dfr) 108 | } 109 | 110 | forest_plot(my_results, 111 | data.function = "my_func") 112 | ``` 113 | 114 | 115 | 116 | 117 | 118 | ## Adding aesthetics and arguments 119 | The addaes and addarg arguments in `shape_plot()` and `forest_plot()` can be used to add additional aesthetics and arguments code to the ggplot layers created by the functions. These arguments must be named lists of character strings, and the names of elements defines where the aesthetics/arguments code is added. 120 | 121 | In `shape_plot()` the following names will add aesthetics and arguments to layers: 122 | 123 | | name | layer that plots | 124 | |-----------|---------------------------------------| 125 | | lines | lines of linear fit through estimates | 126 | | point | point estimates | 127 | | estimates | text of estimates | 128 | | n | text of number of events (n) | 129 | | ci | confidence intervals | 130 | 131 | In `forest_plot()` the following names will add aesthetics and arguments to layers: 132 | 133 | | name | layer that plots | 134 | |------------|----------------------| 135 | | ci | confidence intervals | 136 | | point | point estimates | 137 | | diamonds | diamonds | 138 | | col.right/col.left | col.right/col.left columns | 139 | | heading.col.right/heading.col.left | col.right/col.left column headings | 140 | | xlab | x-axis label | 141 | | panel.headings (or panel.name) | headings above panels | 142 | | nullline | line at null | 143 | | addtext | 'addtext' text | 144 | 145 | Where duplicate aesthetics/arguments might be defined and created, they are kept with the priority: 146 | 147 | 1. Aesthetic arguments specified using addaes and addarg 148 | 2. Aesthetic arguments created by the function 149 | 3. Other arguments specified using addaes and addarg 150 | 4. Other arguments created by the function 151 | 152 | This can be used to 'overwrite' some of the code that would otherwise be produced by `shape_plot()` and `forest_plot()`. 153 | 154 | 155 | For example, adjusting the position and appearance of panel headings: 156 | ```{r, include = FALSE} 157 | row_labels <- data.frame( 158 | subgroup = c("women", "men", 159 | "65_79", "50_64", "35_49"), 160 | group = c("Sex", "Sex", 161 | "Age (years)", "Age (years)", "Age (years)"), 162 | label = c("Women", "Men", 163 | "65 - 79", "50 - 64", "35 - 49") 164 | ) 165 | 166 | my_resultsA <- data.frame( 167 | subgroup = c("men", "women", "35_49", "50_64", "65_79"), 168 | est = c( 0.45, 0.58, 0.09, 0.35, 0.6), 169 | se = c( 0.07, 0.06, 0.06, 0.05, 0.08) 170 | ) 171 | 172 | my_resultsB <- data.frame( 173 | subgroup = c("men", "women", "35_49", "50_64", "65_79"), 174 | est = c(0.48, 0.54, 0.06, 0.3, 0.54), 175 | se = c(0.12, 0.11, 0.11, 0.09, 0.15) 176 | ) 177 | 178 | ``` 179 | 180 | ```{r, fig.width=6.5, out.width='75%', warning=FALSE} 181 | forest_plot(list("a) Observational" = my_resultsA, 182 | "b) Genetic" = my_resultsB), 183 | col.key = "subgroup", 184 | row.labels = row_labels, 185 | addaes = list(panel.headings = "x = 0.5"), 186 | addarg = list(panel.headings = c("size = 4.5", 187 | "colour = 'navyblue'", 188 | "hjust = 0"))) 189 | ``` 190 | 191 | Changing the appearance of the line at the 'null': 192 | ```{r, fig.width=6.5, out.width='75%', warning=FALSE} 193 | forest_plot(list("a) Observational" = my_resultsA, 194 | "b) Genetic" = my_resultsB), 195 | col.key = "subgroup", 196 | row.labels = row_labels, 197 | addarg = list(nullline = c("linetype = 'dashed'", 198 | "colour = 'darkorange'"))) 199 | ``` 200 | -------------------------------------------------------------------------------- /vignettes/forest_plots.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Forest plots" 3 | output: 4 | rmarkdown::html_vignette: 5 | toc: TRUE 6 | vignette: > 7 | %\VignetteIndexEntry{Forest plots} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r, include = FALSE} 13 | knitr::opts_chunk$set( 14 | collapse = TRUE, 15 | comment = "#>", 16 | fig.width = 4, 17 | fig.height = 3, 18 | fig.align = "center", 19 | out.width = '60%', 20 | dpi = 120, 21 | message = FALSE 22 | ) 23 | library(ckbplotr) 24 | ``` 25 | 26 | 27 | ## Introduction 28 | 29 | The `forest_plot()` function creates a forest plot using the [ggplot2](https://ggplot2.tidyverse.org/) graphics package. The function returns both a plot and the ggplot2 code used to create the plot. In RStudio, the code used to create the plot will be shown in the Viewer pane (see [Plot code example] for an example). 30 | 31 | ## Basic usage 32 | 33 | Supply a data frame of estimates (by default, assumed to be log hazard ratios) and standard errors to the `forest_plot()` function: 34 | ```{r} 35 | my_results <- data.frame( 36 | subgroup = c("men", "women", "35_49", "50_64", "65_79"), 37 | est = c( 0.45, 0.58, 0.09, 0.35, 0.6), 38 | se = c( 0.07, 0.06, 0.06, 0.05, 0.08) 39 | ) 40 | 41 | forest_plot(my_results) 42 | ``` 43 | Use `col.est` and `col.stderr` to set the columns that contain estimates and standard errors. By default, the function will look for columns with names estimate/est/beta/loghr and stderr/std.err/se. If you want to supply confidence interval limits, set `col.lci` and `col.uci`. 44 | ```{r, include = FALSE} 45 | my_results2 <- data.frame( 46 | subgroup = c("men", "women", "35_49", "50_64", "65_79"), 47 | est = c( 0.45, 0.58, 0.09, 0.35, 0.6), 48 | lci = c( 0.31, 0.46, -0.03, 0.25, 0.44), 49 | uci = c( 0.59, 0.70, 0.21, 0.45, 0.76) 50 | ) 51 | 52 | forest_plot(my_results2, 53 | col.lci = "lci", 54 | col.uci = "uci") 55 | ``` 56 | 57 | 58 | If your estimates are not on the log scale, then set `exponentiate=FALSE`. 59 | 60 | 61 | 62 | 63 | ## Row labels 64 | 65 | Set `col.key` to identify the rows of the forest plot. 66 | ```{r} 67 | forest_plot(my_results, col.key = "subgroup") 68 | ``` 69 | 70 | To add row labels, create a data frame with your row labels and one column that matches the `col.key` column. 71 | ```{r} 72 | my_row_labels <- data.frame( 73 | subgroup = c("men", "women", "35_49", "50_64", "65_79"), 74 | label = c("Men", "Women", "35 - 49", "50 - 64", "65 - 79") 75 | ) 76 | 77 | forest_plot(my_results, 78 | col.key = "subgroup", 79 | row.labels = my_row_labels) 80 | ``` 81 | 82 | To quickly add subheadings, include labels with a missing col.key: 83 | ```{r} 84 | row_labels <- data.frame( 85 | subgroup = c(NA, "men", "women", 86 | NA, "35_49", "50_64", "65_79"), 87 | label = c("Sex", "Men", "Women", 88 | "Age (years)", "35 - 49", "50 - 64", "65 - 79") 89 | ) 90 | 91 | forest_plot(my_results, 92 | col.key = "subgroup", 93 | row.labels = row_labels) 94 | ``` 95 | 96 | To automatically create groupings and add subheadings, use multiple columns in the `row.labels` data frame. 97 | ```{r} 98 | row_labels <- data.frame( 99 | subgroup = c("men", "women", 100 | "35_49", "50_64", "65_79"), 101 | group = c("Sex", "Sex", 102 | "Age (years)", "Age (years)", "Age (years)"), 103 | label = c("Men", "Women", 104 | "35 - 49", "50 - 64", "65 - 79") 105 | ) 106 | 107 | forest_plot(my_results, 108 | col.key = "subgroup", 109 | row.labels = row_labels) 110 | ``` 111 | 112 | Use the `row.labels.levels` argument to choose columns for row labels and the hierarchy for grouping. (Otherwise, all character columns in the row labels data frame will be used.) 113 | ```{r} 114 | forest_plot(my_results, 115 | col.key = "subgroup", 116 | row.labels = row_labels, 117 | row.labels.levels = c("label")) 118 | ``` 119 | 120 | The order of rows is set by the `row.labels` data frame. 121 | ```{r} 122 | row_labels <- data.frame( 123 | subgroup = c("women", "men", 124 | "65_79", "50_64", "35_49"), 125 | group = c("Sex", "Sex", 126 | "Age (years)", "Age (years)", "Age (years)"), 127 | label = c("Women", "Men", 128 | "65 - 79", "50 - 64", "35 - 49") 129 | ) 130 | 131 | forest_plot(my_results, 132 | col.key = "subgroup", 133 | row.labels = row_labels) 134 | ``` 135 | 136 | To exclude a subheading add "@nolabel" to the end. 137 | ```{r} 138 | row_labels <- data.frame( 139 | subgroup = c("men", "women", 140 | "35_49", "50_64", "65_79"), 141 | group = c("Sex @nolabel", "Sex @nolabel", 142 | "Age (years)", "Age (years)", "Age (years)"), 143 | label = c("Men", "Women", 144 | "35 - 49", "50 - 64", "65 - 79") 145 | ) 146 | 147 | forest_plot(my_results, 148 | col.key = "subgroup", 149 | row.labels = row_labels) 150 | ``` 151 | 152 | Add a heading above the row labels with `row.labels.heading`: 153 | ```{r} 154 | row_labels <- data.frame( 155 | subgroup = c("men", "women", 156 | "35_49", "50_64", "65_79"), 157 | group = c("Sex", "Sex", 158 | "Age (years)", "Age (years)", "Age (years)"), 159 | label = c("Men", "Women", 160 | "35 - 49", "50 - 64", "65 - 79") 161 | ) 162 | 163 | forest_plot(my_results, 164 | col.key = "subgroup", 165 | row.labels = row_labels, 166 | row.labels.heading = "Subgroup") 167 | ``` 168 | 169 | 170 | 171 | 172 | 173 | ## Multiple panels 174 | ```{r, fig.width=6, out.width='75%'} 175 | my_resultsA <- my_results 176 | 177 | my_resultsB <- data.frame( 178 | subgroup = c("men", "women", "35_49", "50_64", "65_79"), 179 | est = c(0.48, 0.54, 0.06, 0.3, 0.54), 180 | se = c(0.12, 0.11, 0.11, 0.09, 0.15) 181 | ) 182 | 183 | forest_plot(list("Observational" = my_resultsA, 184 | "Genetic" = my_resultsB), 185 | col.key = "subgroup", 186 | row.labels = row_labels) 187 | ``` 188 | 189 | You can use `split()` to create a list of data frames from a single data frame: 190 | ```{r, fig.width=6, out.width='75%'} 191 | my_resultsAB <- data.frame( 192 | analysis = factor(c(rep("Observational", 5), rep("Genetic", 5)), 193 | levels = c("Observational", "Genetic")), 194 | subgroup = c("men", "women", "35_49", "50_64", "65_79", 195 | "men", "women", "35_49", "50_64", "65_79"), 196 | est = c( 0.45, 0.58, 0.09, 0.35, 0.6, 197 | 0.48, 0.54, 0.06, 0.3, 0.54), 198 | se = c(0.07, 0.06, 0.06, 0.05, 0.08, 199 | 0.12, 0.11, 0.11, 0.09, 0.15) 200 | ) 201 | 202 | forest_plot(split(my_resultsAB, ~ analysis), 203 | col.key = "subgroup", 204 | row.labels = row_labels) 205 | ``` 206 | 207 | 208 | 209 | ## Adding columns of text 210 | 211 | Use `col.left` and `col.right` to add columns of text either side of each panel. Use `col.left.heading` and `col.right.heading` to customise the column headings. 212 | ```{r adding-columns-of-text} 213 | my_results$n <- c(834, 923, 587, 694, 476) 214 | 215 | forest_plot(my_results, 216 | col.key = "subgroup", 217 | row.labels = row_labels, 218 | col.left = "n", 219 | col.left.heading = "No. of events") 220 | ``` 221 | Use `col.left.hjust` and `col.right.hjust` to set the horizontal justification of the columns (0 = left, 0.5 = center, 1 = right). 222 | 223 | 224 | 225 | ## Scaling point size 226 | Set `scalepoints = TRUE` to have point size (area) proportional to the inverse of the variance (SE^2^) of the estimate. 227 | ```{r} 228 | forest_plot(my_results, 229 | col.key = "subgroup", 230 | row.labels = row_labels, 231 | scalepoints = TRUE) 232 | ``` 233 | To have consistent scaling across plots, set `minse` to the same value (it must be smaller than the smallest SE). This will ensure the same size scaling is used across the plots. 234 | 235 | 236 | ## Confidence interval lines 237 | 238 | Narrow confidence interval lines can be hidden by points. Set the `panel.width` argument to change the appearance of narrow confidence interval lines. The function will by default try to change the colour and plotting order of confidence intervals so that they are not hidden. You can also supply vectors and lists to the `cicolour` argument to have more control. 239 | 240 | Note that the calculations for identifying narrow confidence intervals has has been designed to work for shapes 15/'square' (the default) and 22/'square filled', and for symmetric confidence intervals. These may not be completely accurate in all scenarios, so check your final output carefully. 241 | 242 | ```{r, fig.width=6, fig.height = 5, out.width='75%'} 243 | forest_plot(split(my_resultsAB, ~ analysis), 244 | col.key = "subgroup", 245 | row.labels = row_labels, 246 | scalepoints = TRUE, 247 | pointsize = 8, 248 | xlim = c(0.5, 3), 249 | xticks = c(0.5, 1, 2, 3), 250 | panel.width = unit(28, "mm")) 251 | ``` 252 | 253 | 254 | ```{r, fig.width=6, fig.height = 5, out.width='75%'} 255 | forest_plot(split(my_resultsAB, ~ analysis), 256 | col.key = "subgroup", 257 | row.labels = row_labels, 258 | scalepoints = TRUE, 259 | pointsize = 10, 260 | xlim = c(0.5, 8), 261 | 262 | shape = "square filled", 263 | stroke = 0.5, 264 | fill = list("black", "white"), 265 | panel.width = unit(28, "mm")) 266 | ``` 267 | 268 | 269 | 270 | 271 | 272 | 273 | 274 | 275 | 276 | 277 | ## Different limits on panels 278 | 279 | `forest_plot()` uses ggplot facets to place forest plots side-by-side. Facets cannot easily have different scales applied, but you can use `forest_plot()` for each panel then arrange them side-by-side. 280 | 281 | If `xlim`, `xticks` and `panels` are lists of the same length, then `forest_plot()` will do this automatically. The function will return a list containing "figure" (a graphic object of the whole figure) and "plots" (a list of ggplots, one for each panel). 282 | 283 | ```{r, fig.width=6, out.width='75%'} 284 | forest <- forest_plot(split(my_resultsAB, ~ analysis), 285 | col.key = "subgroup", 286 | row.labels = row_labels, 287 | xlim = list(c(0.5, 3 + 1e-10), 288 | c(0.1, 4)), 289 | xticks = list(c(0.5, 1, 2, 3), 290 | c(0.1, 1, 2, 4)), 291 | xlab = c("Hazard Ratio (95% CI)", "Odds Ratio (95% CI)"), 292 | col.right.heading = list("HR (95% CI)", "OR (95% CI)")) 293 | grid::grid.newpage() 294 | grid::grid.draw(forest$figure) 295 | ``` 296 | 297 | Use `grid::grid.draw()` to draw the figure (use `grid::grid.newpage()` to clear), and `ggsave()` or `save_figure()` to save to a file. 298 | 299 | Warnings: If `scalepoints = TRUE` (and `minse` is not specified the same for each plot) then this scaling will be on a panel-by-panel basis so box sizes are not comparable between panels. 300 | 301 | 302 | 303 | 304 | 305 | 306 | ## Adding heterogeneity and trend test results 307 | The `addtext` argument can be used to add results of heterogeneity or trend tests, or some other text, in the text column of estimates and CIs. It needs to be a list of data frames, the same length as panels. Data frames should contain a column with the name specified in col.key, and one or more of: 308 | 309 | - a column named 'text' containing character strings 310 | - a column named 'expr' containing character strings that will be parsed into expressions and displayed as described in ?plotmath 311 | - columns named 'het_dof', 'het_stat', and 'het_p' containing character strings 312 | - columns names 'trend_stat' and 'trend_p' containing character strings 313 | 314 | ```{r} 315 | het_trend_results <- data.frame( 316 | analysis = factor(c("Observational", "Observational", "Observational", "Genetic", "Genetic", "Genetic"), 317 | levels = c("Observational", "Genetic")), 318 | subgroup = c( "men", "35_49", "35_49", "men", "35_49", "35_49"), 319 | het_dof = c( "1", NA, NA, "1", NA, NA), 320 | het_stat = c( "1.99", NA, NA, "0.136", NA, NA), 321 | het_p = c("=0.16", NA, NA, "=0.71", NA, NA), 322 | trend_stat = c( NA, "27.2", NA, NA, "6.98", NA), 323 | trend_p = c( NA, "<0.001", NA, NA, "=0.008", NA), 324 | text = c( NA, NA, NA, NA, NA, "Note"), 325 | expr = c(NA, NA, "frac(-b %+-% sqrt(b^2 - 4*a*c), 2*a)", NA, NA, NA) 326 | ) 327 | ``` 328 | 329 | ```{r, fig.width=7.2, fig.height = 4.5, out.width='75%'} 330 | forest_plot(split(my_resultsAB, ~ analysis), 331 | col.key = "subgroup", 332 | row.labels = row_labels, 333 | scalepoints = TRUE, 334 | pointsize = 8, 335 | xlim = c(0.5, 3), 336 | xticks = c(0.5, 1, 2, 3), 337 | panel.width = unit(28, "mm"), 338 | right.space = unit(45, "mm"), 339 | addtext = split(het_trend_results, ~ analysis)) 340 | ``` 341 | 342 | Note that values should all be character strings, and P-values should include the necessary "=" or "<". 343 | 344 | The automatic positioning of columns and spacing of panels does not take into account this additional text, so you may need to use the `right.space` and `col.right.pos` arguments for a satisfactory layout. 345 | 346 | 347 | ## Customisation 348 | See [Customising plots](customising_plots.html) for more ways to customise forest plots. 349 | 350 | 351 | ## Notes 352 | 353 | #### Spacing 354 | The function attempts to set the positions of columns of text and spacing automatically. Where this does not produce a satisfactory layout, you can use the arguments `col.left.pos`, `col.right.pos`, `left.space`, `right.space`, and `mid.space` to control positions and spacing manually. 355 | 356 | The plot will fill the vertical space available. Use `plot.margin` to change the top and bottom margins as needed. 357 | 358 | #### Confidence intervals 359 | When standard errors are supplied to the `shape_plot()` and `forest_plot()` functions, confidence intervals are calculated as 95\% confidence intervals using the Normal approximation method (with critical value 1.96). 360 | 361 | 362 | #### Stroke 363 | The `stroke` argument sets the stroke aesthetic for plotted shapes. See https://ggplot2.tidyverse.org/articles/ggplot2-specs.html for more details. The stroke size adds to the total size of a shape, so unless `stroke = 0` the scaling of size by inverse variance will be very slightly inaccurate (but there are probably more important things to worry about). 364 | 365 | 366 | -------------------------------------------------------------------------------- /vignettes/ggplot2.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "ggplot2" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{ggplot2} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | The ggplot2 documentation can be found at . 18 | 19 | More details about using the package can be found in: 20 | 21 | - [Data Visualisation chapter of 'R for Data Science' by Hadley Wickham & Garrett Grolemund](https://r4ds.had.co.nz/data-visualisation.html) 22 | - ['ggplot2: elegant graphics for data analysis' by Hadley Wickham](https://ggplot2-book.org/) 23 | - ['Fundamentals of Data Visualization' by Claus O. Wilke](https://clauswilke.com/dataviz/) 24 | -------------------------------------------------------------------------------- /vignettes/page_layouts.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Page layouts" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Page layouts} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | library(ckbplotr) 16 | ``` 17 | 18 | The package does not currently include any functions for composing multiple plots, but these package may be useful: 19 | 20 | * grid and [gridExtra](https://cran.r-project.org/package=gridExtra) 21 | * [patchwork](https://patchwork.data-imaginist.com/) 22 | * [cowplot](https://cran.r-project.org/package=cowplot) 23 | * [egg](https://cran.r-project.org/package=egg) 24 | * [multipanelfigure](https://cran.r-project.org/package=multipanelfigure) 25 | -------------------------------------------------------------------------------- /vignettes/save_plots.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Save plots to files" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Save plots to files} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | warning = FALSE, 15 | message = FALSE 16 | ) 17 | ``` 18 | 19 | ```{r setup, include = FALSE} 20 | library(ckbplotr) 21 | ``` 22 | 23 | ## ggsave 24 | The easiest way to save a plot is to to use the `ggplot2::ggsave()` function. Remember that `shape_plot()` and `forest_plot()` both return a list of the plot and code, so you need to use `$plot` to save just the plot to a file. 25 | ```{r} 26 | my_results <- data.frame( 27 | x = c( 12, 14, 15.5, 18), 28 | est = c(0.05, 0.21, 0.15, 0.32), 29 | se = c(0.05, 0.05, 0.05, 0.05) 30 | ) 31 | 32 | my_plot <- shape_plot(my_results, 33 | xlims = c(10, 20), 34 | ylims = c(0.75, 2), 35 | exponentiate = TRUE, 36 | quiet = TRUE) 37 | ``` 38 | 39 | ```{r, eval = FALSE} 40 | ggsave("myplot.png", 41 | plot = my_plot$plot, 42 | width = 14, height = 14, units = "cm") 43 | ``` 44 | 45 | Plots created with this package have transparent backgrounds. For a png file output, you can use the `bg` argument to set the background colour: 46 | ```{r, eval = FALSE} 47 | ggsave("myplot.png", 48 | plot = my_plot$plot, 49 | width = 14, height = 14, units = "cm", 50 | bg = "white") 51 | ``` 52 | 53 | The ckbplotr function `ggpreview()` can be used in place of `ggsave()` to preview the output. 54 | 55 | ## Save with title and footnote 56 | Use `save_figure()` to add a title and footer to a plot and save to a file. The following code will save the plot (sized to 14 by 14 cm) in an A4 sized PDF file, with title and footer. 57 | ```{r save-shape-plot, eval = FALSE} 58 | save_figure(my_plot$plot, 59 | filename = "Figure 1.pdf", 60 | title = "Figure 1: My example shape plot", 61 | footer = "An example footer text.", 62 | size = unit(c(14, 14), "cm")) 63 | ``` 64 | 65 | ```{r, fig.width=8.27, fig.height=11.69, out.width='40%', out.extra='style="margin: auto; display: block; box-shadow: rgba(100, 100, 111, 0.2) 0px 7px 29px 0px;"', echo = FALSE} 66 | figure <- prepare_figure(my_plot$plot, 67 | title = "Figure 1: My example shape plot", 68 | footer = "An example footer text.", 69 | size = unit(c(14, 14), "cm")) 70 | grid::grid.draw(figure$page) 71 | ``` 72 | 73 | The function has several arguments that allow for customization of appearance and layout. For example: `valign` and `halign` to control the position of the plot (if `size` is set); `landscape = TRUE` to create a landscape page; and set `cropped` to be a file name to also save a plot without additional margins, title or footer. 74 | 75 | ## Preview the output 76 | Set `preview = TRUE` to view a preview of the output in the RStudio Viewer pane. (Instead of creating a file, the figure is saved to a temporary PNG file and shown.) 77 | ```{r preview-shape-plot, eval = FALSE} 78 | save_figure(my_plot$plot, 79 | filename = "Figure 1.pdf", 80 | title = "Figure 1: My example shape plot", 81 | footer = "An example footer text.", 82 | size = unit(c(14, 14), "cm"), 83 | preview = TRUE) 84 | ``` 85 | 86 | 87 | -------------------------------------------------------------------------------- /vignettes/shape_plots.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Shape plots" 3 | output: 4 | rmarkdown::html_vignette: 5 | toc: TRUE 6 | vignette: > 7 | %\VignetteIndexEntry{Shape plots} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r, include = FALSE} 13 | knitr::opts_chunk$set( 14 | collapse = TRUE, 15 | comment = "#>", 16 | fig.width = 4, 17 | fig.height = 4, 18 | fig.align = "center", 19 | out.width = '60%', 20 | dpi = 120, 21 | message = FALSE 22 | ) 23 | library(ckbplotr) 24 | ``` 25 | 26 | ## Introduction 27 | 28 | The `shape_plot()` function creates a plot of estimates and confidence intervals using the [ggplot2](https://ggplot2.tidyverse.org/) graphics package. The function returns both a plot and the ggplot2 code used to create the plot. In RStudio, the code used to create the plot will be shown in the Viewer pane (see [Plot code example] for an example). 29 | 30 | ## Basic usage 31 | Supply a data frame of estimates and standard errors to the `shape_plot()` function, and specify the column that contains x-axis values and axis limits. 32 | ```{r} 33 | my_results <- data.frame( 34 | risk_factor = c( 17, 20, 23.5, 25, 29), 35 | est = c( 0, 0.069, 0.095, 0.182, 0.214), 36 | se = c(0.05, 0.048, 0.045, 0.045, 0.081) 37 | ) 38 | 39 | shape_plot(my_results, 40 | col.x = "risk_factor", 41 | xlims = c(15, 30), 42 | ylims = c(-0.25, 0.5)) 43 | ``` 44 | 45 | If your estimates and standard errors are on the log scale (e.g. log hazard ratios), then set `exponentiate` to true. This will plot exp(estimates) and use a log scale for the axis. 46 | ```{r} 47 | shape_plot(my_results, 48 | col.x = "risk_factor", 49 | xlims = c(15, 30), 50 | ylims = c(0.8, 1.6), 51 | exponentiate = TRUE) 52 | ``` 53 | 54 | Set axis titles using `xlab` and `ylab`. 55 | ```{r} 56 | shape_plot(my_results, 57 | col.x = "risk_factor", 58 | xlims = c(15, 30), 59 | ylims = c(0.8, 1.6), 60 | exponentiate = TRUE, 61 | xlab = "BMI (kg/m\u00B2)", 62 | ylab = "Hazard Ratio (95% CI)") 63 | ``` 64 | 65 | 66 | ## Using groups 67 | Use `col.group` to plot results for different groups (using shades of grey for the fill colour). 68 | ```{r} 69 | my_results <- data.frame( 70 | risk_factor = c(17, 20, 23.5, 25, 29, 71 | 18, 20.5, 22.7, 24.5, 30), 72 | est = c(0, 0.069, 0.095, 0.182, 0.214, 73 | 0.32, 0.369, 0.395, 0.482, 0.514), 74 | se = c(0.05, 0.048, 0.045, 0.045, 0.061, 75 | 0.04, 0.049, 0.045, 0.042, 0.063), 76 | group = factor(rep(c("Women", "Men"), each = 5)) 77 | ) 78 | 79 | shape_plot(my_results, 80 | col.x = "risk_factor", 81 | xlims = c(15, 30), 82 | ylims = c(0.8, 2), 83 | exponentiate = TRUE, 84 | xlab = "BMI (kg/m\u00B2)", 85 | ylab = "Hazard Ratio (95% CI)", 86 | col.group = "group", 87 | ciunder = TRUE) 88 | ``` 89 | 90 | 91 | 92 | 93 | 94 | ## Adding lines 95 | Use `lines` to add lines (linear fit through estimates on plotted scale, weighted by inverse variance) for each group. 96 | ```{r} 97 | shape_plot(my_results, 98 | col.x = "risk_factor", 99 | xlims = c(15, 30), 100 | ylims = c(0.8, 2), 101 | exponentiate = TRUE, 102 | xlab = "BMI (kg/m\u00B2)", 103 | ylab = "Hazard Ratio (95% CI)", 104 | col.group = "group", 105 | ciunder = TRUE, 106 | lines = TRUE) 107 | ``` 108 | 109 | 110 | 111 | 112 | ## Categorical risk factor 113 | The risk factor can be a factor. In this case, the x-axis coordinates are 1, 2, 3, .. so suitable x-axis limits are 0.5 and number of categories plus 0.5. You may need to add position arguments so that points, intervals and text do not overlap. 114 | ```{r} 115 | smoking_results <- data.frame( 116 | smk_cat = factor(c("Never", "Ex", "Current"), 117 | levels = c("Never", "Ex", "Current")), 118 | est = c(0, 0.362, 0.814), 119 | se = c(0.05, 0.09, 0.041) 120 | ) 121 | 122 | shape_plot(smoking_results, 123 | col.x = "smk_cat", 124 | xlims = c(0.5, 3.5), 125 | ylims = c(0.5, 4), 126 | ybreaks = c(0.5, 1, 2, 4), 127 | xlab = "Smoking", 128 | ylab = "Hazard Ratio (95% CI)", 129 | exponentiate = TRUE) 130 | ``` 131 | 132 | 133 | ## Scaling point size 134 | Set `scalepoints = TRUE` to have point size (area) proportional to the inverse of the variance (SE^2^) of the estimate. 135 | ```{r} 136 | my_results <- data.frame( 137 | risk_factor = c(19, 24, 29), 138 | est = c(0, 0.095, 0.214), 139 | se = c(0.02, 0.018, 0.1) 140 | ) 141 | 142 | shape_plot(my_results, 143 | col.x = "risk_factor", 144 | xlims = c(15, 30), 145 | ylims = c(0.8, 2), 146 | exponentiate = TRUE, 147 | xlab = "BMI (kg/m\u00B2)", 148 | ylab = "Hazard Ratio (95% CI)", 149 | scalepoints = TRUE) 150 | ``` 151 | To have consistent scaling across plots, set `minse` to the same value (it must be smaller than the smallest SE). This will ensure the same size scaling is used across the plots. 152 | 153 | ## Confidence intervals 154 | Narrow confidence interval lines can be hidden by points. Set the `height` argument to change the appearance of short confidence interval lines. The function will by default try to change the colour and plotting order of confidence intervals so that they are not hidden. You can also supply vectors and lists to the `cicolour` argument to have more control. 155 | 156 | Note that the calculations for identifying narrow confidence intervals has has been designed to work for shapes 15/'square' (the default) and 22/'square filled', and for symmetric confidence intervals. These may not be completely accurate in all scenarios, so check your final output carefully. 157 | 158 | 159 | 160 | ```{r} 161 | my_results <- data.frame( 162 | risk_factor = c(19, 24, 29), 163 | est = c(0, 0.095, 0.214), 164 | se = c(0.02, 0.018, 0.1) 165 | ) 166 | 167 | shape_plot(my_results, 168 | col.x = "risk_factor", 169 | xlims = c(15, 30), 170 | ylims = c(0.8, 2), 171 | exponentiate = TRUE, 172 | xlab = "BMI (kg/m\u00B2)", 173 | ylab = "Hazard Ratio (95% CI)", 174 | scalepoints = TRUE, 175 | pointsize = 6, 176 | height = unit(5, "cm")) 177 | ``` 178 | 179 | 180 | 181 | 182 | ## Customisation 183 | See [Customising plots](customising_plots.html) for more ways to customise shape plots. 184 | 185 | 186 | 187 | ## Notes 188 | 189 | #### Stroke 190 | The `stroke` argument sets the stroke aesthetic for plotted shapes. See https://ggplot2.tidyverse.org/articles/ggplot2-specs.html for more details. The stroke size adds to total size of a shape, so unless `stroke = 0` the scaling of size by inverse variance will be slightly inaccurate (but there are probably more important things to worry about). 191 | -------------------------------------------------------------------------------- /vignettes/web-only/generated_code.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Generated code" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Generated code} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | warning = FALSE, 15 | message = FALSE 16 | ) 17 | ``` 18 | 19 | ```{r setup, include = FALSE} 20 | library(ckbplotr) 21 | ``` 22 | 23 | The `shape_plot()` and `forest_plot()` functions return both a plot and the code used to generate plot (which will be shown in the RStudio Viewer pane). Examples of generated code are shown below. 24 | 25 | ## Shape plot 26 | 27 | ```{r, shape-example} 28 | my_results <- data.frame( 29 | x = c( 12, 14, 15.5, 18), 30 | est = c(0.05, 0.21, 0.15, 0.32), 31 | se = c(0.05, 0.05, 0.05, 0.05) 32 | ) 33 | 34 | shape <- shape_plot(my_results, 35 | xlims = c(10, 20), 36 | ylims = c(0.75, 2), 37 | exponentiate = TRUE, 38 | printplot = FALSE) 39 | 40 | ``` 41 | 42 | The code now stored in `shape$code` and shown in the RStudio Viewer pane is: 43 | ```{r, shape-example-code, results ='asis', echo = FALSE} 44 | cat("", 45 | "```", 46 | shape$code, 47 | "```", 48 | sep = "\n") 49 | ``` 50 | 51 | 52 | ## Forest plot 53 | 54 | ```{r, forest-example} 55 | my_results <- data.frame( 56 | subgroup = c("men", "women", "35_49", "50_64", "65_79"), 57 | est = c( 0.45, 0.58, 0.09, 0.35, 0.6), 58 | se = c( 0.07, 0.06, 0.06, 0.05, 0.08) 59 | ) 60 | 61 | forest <- forest_plot(my_results, printplot = FALSE) 62 | ``` 63 | 64 | The code now stored in `forest$code` and shown in the RStudio Viewer pane is: 65 | ```{r, forest-example-code, results ='asis', echo = FALSE} 66 | cat("", 67 | "```", 68 | forest$code, 69 | "```", 70 | sep = "\n") 71 | ``` 72 | --------------------------------------------------------------------------------