diff --git a/DESCRIPTION b/DESCRIPTION
index f5c9655..f1c44fe 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -3,7 +3,7 @@ Title: Create CKB Plots
Description: ckbplotr provides functions to help create and style plots in R.
It is being developed by, and primarily for, China Kadoorie Biobank
researchers.
-Version: 0.8.0
+Version: 0.8.1
Authors@R:
person(given = "Neil",
family = "Wright",
@@ -26,10 +26,11 @@ Imports:
grid,
gridExtra,
ggtext,
- gridtext (>= 0.1.5),
+ gridtext (>= 0.1.5),
knitr,
rmarkdown,
- ggh4x
+ ggh4x,
+ lifecycle
RoxygenNote: 7.2.3
Roxygen: list(markdown = TRUE)
Suggests:
diff --git a/NAMESPACE b/NAMESPACE
index 94bfaeb..c4e2503 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -15,6 +15,7 @@ export(shape_plot)
export(theme_ckb)
import(ggplot2)
importFrom(ggtext,element_markdown)
+importFrom(lifecycle,deprecated)
importFrom(magrittr,"%>%")
importFrom(rlang,.data)
importFrom(utils,compareVersion)
diff --git a/NEWS.md b/NEWS.md
index bf141be..31addfa 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,14 @@
+# ckbplotr 0.8.1
+
+* blankrows argument of forest_plot() now allows decimals and negative numbers.
+* Added panel.height argument to forest_plot() and width argument to shape_plot().
+* Added data.function argument to forest_plot().
+* Small fixes and improvements.
+ * Corrected calculation of text size on plots.
+ * Upper and lower confidence interval limits used to imply SE where necessary.
+ * Refactoring.
+ * Updated documentation.
+
# ckbplotr 0.8.0
* 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).
diff --git a/R/ckbplotr-package.R b/R/ckbplotr-package.R
new file mode 100644
index 0000000..425b3c1
--- /dev/null
+++ b/R/ckbplotr-package.R
@@ -0,0 +1,7 @@
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+#' @importFrom lifecycle deprecated
+## usethis namespace: end
+NULL
diff --git a/R/fix-panel.R b/R/fix-panel.R
index 0ea5228..6125377 100644
--- a/R/fix-panel.R
+++ b/R/fix-panel.R
@@ -1,6 +1,11 @@
#' Fix panel width and height of a forest plot
#'
-#' \code{fix_panel} fixes the panel width and height of a forest plot
+#' @description
+#' `r lifecycle::badge('deprecated')`
+#'
+#' plot_like_ckb() and shape_plot() have width and height arguments and
+#' forest_plot() has panel.width and panel.height arguments. These use
+#' ggh4x::force_panelsizes() to fix panel sizes.
#'
#' @param plot A plot (created by forest_plot()).
#' @param width Width of panels. (e.g unit(50, "mm"))
@@ -8,12 +13,17 @@
#'
#' @return A gtable object
#'
-#' @import ggplot2
+#' @keywords internal
#' @export
fix_panel <- function(plot, width = NULL, height = NULL){
+ lifecycle::deprecate_warn("0.8.1",
+ "fix_panel()",
+ "ggh4x::force_panelsizes()",
+ details = "forest_plot(), shape_plot(), and plot_like_ckb() alo have arguments for setting panel width and height.")
+
# generate grob from ggplot2 plot
gtable <- ggplot2::ggplotGrob(plot)
diff --git a/R/forest-plot-parts.R b/R/forest-plot-parts.R
index e9a749e..e737cd1 100644
--- a/R/forest-plot-parts.R
+++ b/R/forest-plot-parts.R
@@ -12,52 +12,15 @@ forest.axes <- function(scale, xticks, bottom.space) {
make_layer(
'# Set the scale for the y axis (the rows)',
f = "scale_y_continuous",
- arg = c('breaks = -1:-max(datatoplot$row)',
- 'labels = rowlabels',
- sprintf('limits = c(-max(datatoplot$row) - %s, NA)',
+ arg = c('breaks = -attr(datatoplot, "rowlabels")$row',
+ 'labels = attr(datatoplot, "rowlabels")$row.label',
+ sprintf('limits = c(-max(attr(datatoplot, "rowlabels")$row) - %s, NA)',
deparse(bottom.space)),
'expand = c(0,0)')
)
)
}
-#' code for row labels vector
-#' @noRd
-forest.row.labels.vec <- function(bold.labels) {
- c(
- '# Get a character vector of the row labels, so these can be used in the plot',
- 'rowlabels <- datatoplot %>%',
- indent(14,
- 'dplyr::group_by(row) %>%',
- 'dplyr::summarise(row.label = dplyr::first(row.label),',
- indent(17, sprintf('bold = all(is.na(estimate_transformed) | all(key %%in%% %s)),',
- ds(bold.labels)),
- '.groups = "drop") %>%'),
- 'dplyr::mutate(row.label = dplyr::if_else(bold & row.label != "",',
- indent(41, 'paste0("**", row.label, "**"),',
- 'as.character(row.label))) %>% '),
- 'dplyr::arrange(row) %>%',
- 'dplyr::pull(row.label)'),
- ''
- )
-}
-
-#' code for indentifying CIx that extend outside axis limits
-#' @noRd
-forest.check.cis <- function(xto, xfrom) {
- c(
- '# Identify any CIs that extend outside axis limits',
- 'datatoplot <- datatoplot %>%',
- indent(16,
- sprintf('dplyr::mutate(cioverright = (uci_transformed > %s),', xto),
- indent(14,
- sprintf('uci_transformed = pmin(uci_transformed, %s),', xto),
- sprintf('lci_transformed = pmin(lci_transformed, %s),', xto),
- sprintf('cioverleft = (lci_transformed < %s),', xfrom),
- sprintf('lci_transformed = pmax(lci_transformed, %s),', xfrom),
- sprintf('uci_transformed = pmax(uci_transformed, %s))', xfrom))),
- '')
-}
#' code for CI colours if using panel.width
#' @noRd
@@ -252,7 +215,7 @@ forest.facet <- function() {
make_layer(
'# Put the different panels in side-by-side plots using facets',
f = 'facet_wrap',
- arg = c('~panel, nrow = 1')
+ arg = c('vars(panel), nrow = 1')
)
}
@@ -360,18 +323,18 @@ forest.scales.coords <- function(xfrom, xto) {
#' code to add arrows to CIs
#' @noRd
-forest.arrows <- function(addaes, cicolour, addarg, base_line_size) {
+forest.arrows <- function(addaes, cicolour, addarg, base_line_size, xfrom, xto) {
c(make_layer(
'# Add tiny segments with arrows when the CIs go outside axis limits',
f = 'geom_segment',
aes = c(addaes$ci,
'y = -row',
'yend = -row',
- 'x = uci_transformed-0.000001',
- 'xend = uci_transformed',
+ sprintf('x = %s', xto - 1e-6),
+ sprintf('xend = %s', xto),
sprintf('colour = %s', column_name(cicolour$aes[1]))),
arg = c(addarg$ci,
- 'data = ~ dplyr::filter(.x, cioverright == TRUE)',
+ sprintf('data = ~ dplyr::filter(.x, uci_transformed > %s)', xto),
sprintf('colour = %s', quote_string(cicolour$arg[1])),
sprintf('linewidth = %s', base_line_size),
sprintf('arrow = arrow(type = "closed", length = unit(%s, "pt"))', 8 * base_line_size),
@@ -383,11 +346,11 @@ forest.arrows <- function(addaes, cicolour, addarg, base_line_size) {
aes = c(addaes$ci,
'y = -row',
'yend = -row',
- 'x = lci_transformed+0.000001',
- 'xend = lci_transformed',
+ sprintf('x = %s', xfrom + 1e-6),
+ sprintf('xend = %s', xfrom),
sprintf('colour = %s', column_name(cicolour$aes[1]))),
arg = c(addarg$ci,
- 'data = ~ dplyr::filter(.x, cioverleft == TRUE)',
+ sprintf('data = ~ dplyr::filter(.x, lci_transformed < %s)', xfrom),
sprintf('colour = %s', quote_string(cicolour$arg[1])),
sprintf('linewidth = %s', base_line_size),
sprintf('arrow = arrow(type = "closed", length = unit(%s, "pt"))', 8 * base_line_size),
@@ -408,7 +371,7 @@ forest.col.right.line <- function(col.right.all,
addarg,
xto,
xfrom,
- base_size,
+ text_size,
plotcolour,
col.heading.space,
panel.names,
@@ -446,7 +409,7 @@ forest.col.right.line <- function(col.right.all,
arg = c(..10[..10!=""],
sprintf('move_x = unit(%s, "%s")', ..2, ..3),
sprintf('hjust = %s', ..5),
- sprintf('size = %s', base_size/(11/3)),
+ sprintf('size = %s', text_size),
sprintf('colour = %s', quote_string(plotcolour)),
'na.rm = TRUE',
sprintf('parse = %s', ..7)),
@@ -459,7 +422,7 @@ forest.col.right.line <- function(col.right.all,
'label = title'),
arg = c(sprintf('move_x = unit(%s, "%s")', ..2, ..3),
sprintf('hjust = %s', ..5),
- sprintf('size = %s', base_size/(11/3)),
+ sprintf('size = %s', text_size),
sprintf('colour = %s', quote_string(plotcolour)),
'fontface = "bold"',
sprintf('data = dplyr::tibble(panel = factor(%s', paste(deparse(panel.names), collapse = '')),
@@ -479,7 +442,7 @@ forest.col.right.line <- function(col.right.all,
#' code for columns to left of panels
#' @noRd
-forest.col.left.line <- function(col.left, col.left.pos, col.left.heading, col.left.hjust, col.bold, col.left.space, addaes, addarg, xfrom, xto, base_size, plotcolour, col.heading.space, panel.names, tf, inv_tf) {
+forest.col.left.line <- function(col.left, col.left.pos, col.left.heading, col.left.hjust, col.bold, col.left.space, addaes, addarg, xfrom, xto, text_size, plotcolour, col.heading.space, panel.names, tf, inv_tf) {
x <- unlist(purrr::pmap(
list(col.left,
as.numeric(col.left.pos),
@@ -506,7 +469,7 @@ forest.col.left.line <- function(col.left, col.left.pos, col.left.heading, col.l
arg = c(..9[..9!=""],
sprintf('move_x = unit(-%s, "%s")', ..2, ..3),
sprintf('hjust = %s', ..5),
- sprintf('size = %s', base_size/(11/3)),
+ sprintf('size = %s', text_size),
sprintf('colour = %s', quote_string(plotcolour)),
'na.rm = TRUE'),
br = FALSE
@@ -518,7 +481,7 @@ forest.col.left.line <- function(col.left, col.left.pos, col.left.heading, col.l
'label = title'),
arg = c(sprintf('move_x = unit(-%s, "%s")', ..2, ..3),
sprintf('hjust = %s', ..5),
- sprintf('size = %s', base_size/(11/3)),
+ sprintf('size = %s', text_size),
sprintf('colour = %s', quote_string(plotcolour)),
'fontface = "bold"',
sprintf('data = dplyr::tibble(panel = factor(%s', paste(deparse(panel.names), collapse = '')),
@@ -544,7 +507,7 @@ forest.addtext <- function(xto,
col.right.parse,
col.right.pos,
col.right.hjust,
- base_size,
+ text_size,
plotcolour,
tf,
inv_tf) {
@@ -571,7 +534,7 @@ forest.addtext <- function(xto,
as.numeric(col.right.pos[[1]]),
makeunit(col.right.pos[[1]])),
sprintf('hjust = %s', col.right.hjust[[1]]),
- sprintf('size = %s', base_size/(11/3)),
+ sprintf('size = %s', text_size),
sprintf('colour = %s', quote_string(plotcolour)),
'na.rm = TRUE',
'parse = TRUE')
@@ -579,9 +542,9 @@ forest.addtext <- function(xto,
}
-#' ccode for x-axis labels and panel headings
+#' code for x-axis labels and panel headings
#' @noRd
-forest.xlab.panel.headings <- function(addaes, xmid, addarg, base_size, plotcolour, panel.names, xlab, panel.headings, col.heading.space) {
+forest.xlab.panel.headings <- function(addaes, xmid, addarg, text_size, plotcolour, panel.names, xlab, panel.headings, col.heading.space) {
c(
make_layer(
'# Add xlab below each axis',
@@ -590,7 +553,7 @@ forest.xlab.panel.headings <- function(addaes, xmid, addarg, base_size, plotcolo
sprintf('y = -Inf, x = %s, label = xlab', xmid)),
arg = c(addarg$xlab,
'hjust = 0.5',
- sprintf('size = %s', base_size/(11/3)),
+ sprintf('size = %s', text_size),
sprintf('colour = %s', quote_string(plotcolour)),
'vjust = 4.4',
'fontface = "bold"',
@@ -608,7 +571,7 @@ forest.xlab.panel.headings <- function(addaes, xmid, addarg, base_size, plotcolo
arg = c(addarg$panel.name,
'hjust = 0.5',
'nudge_y = 2',
- sprintf('size = %s', base_size/(11/3)),
+ sprintf('size = %s', text_size),
sprintf('colour = %s', quote_string(plotcolour)),
'fontface = "bold"',
sprintf('data = dplyr::tibble(panel = factor(%s', paste(deparse(panel.names), collapse = '')),
@@ -621,17 +584,21 @@ forest.xlab.panel.headings <- function(addaes, xmid, addarg, base_size, plotcolo
}
-#' code to set panel width
+#' code to set panel width and/or height
#' @noRd
-forest.panel.width <- function(panel.width) {
- if(!inherits(panel.width, "unit")){return(NULL)}
+forest.panel.size <- function(panel.width, panel.height) {
+ if(!inherits(panel.width, "unit") &
+ !inherits(panel.height, "unit")){return(NULL)}
make_layer(
- '# Fix panel width',
+ '# Fix panel size',
f = 'ggh4x::force_panelsizes',
- arg = sprintf('cols = unit(%s, "%s")',
+ arg = c(sprintf('cols = unit(%s, "%s")',
as.numeric(panel.width),
makeunit(panel.width)),
+ sprintf('rows = unit(%s, "%s")',
+ as.numeric(panel.height),
+ makeunit(panel.height))),
plus = TRUE
)
}
diff --git a/R/forest-plot.R b/R/forest-plot.R
index 4d0b45f..3969afc 100644
--- a/R/forest-plot.R
+++ b/R/forest-plot.R
@@ -89,7 +89,8 @@ forest_data <- function(
addtext = NULL,
cols = panels,
headings = NULL,
- colnames = NULL
+ colnames = NULL,
+ bold.labels = NULL
){
# legacy arguments
@@ -163,8 +164,10 @@ forest_data <- function(
if (is.null(row.labels)) {
out <- panels[[1]] %>%
dplyr::mutate(row.label = !!rlang::sym(col.key),
- key = !!rlang::sym(col.key)) %>%
- dplyr::select(.data$row.label, .data$key)
+ key = !!rlang::sym(col.key),
+ row.height = NA,
+ spacing_row = FALSE) %>%
+ dplyr::select(.data$row.label, .data$key, .data$row.height, .data$spacing_row)
} else {
if (is.null(rows)) stop("argument rows must be given if row.labels is used")
@@ -199,27 +202,29 @@ forest_data <- function(
## function to add headings/subheadings for row labels
add_heading <- function(data, heading, blank_after_heading, blank_after_section){
+ out <- tibble::add_row(data,
+ row.label = !!heading,
+ spacing_row = FALSE,
+ .before = 1) %>%
+ tibble::add_row(row.label = "",
+ row.height = blank_after_heading,
+ spacing_row = TRUE,
+ .before = 2)
if(all(is.na(data$row.label))){
out <- dplyr::mutate(data, row.label = !!heading)
- } else {
- out <- dplyr::add_row(data, row.label = !!heading, .before = 1)
- if (blank_after_heading > 0){
- for (i in 1:blank_after_heading) {
- out <- tibble::add_row(out, row.label = "", .before = 2)
- }
- }
- }
- if (blank_after_section > 0){
- for (i in 1:blank_after_section) {
- out <- tibble::add_row(out, row.label = "")
- }
}
+ out <- tibble::add_row(out,
+ row.label = "",
+ row.height = blank_after_section,
+ spacing_row = TRUE)
out
}
## add headings/subheadings for row labels
out <- row.labels %>%
- dplyr::mutate(row.label = .data$heading3) %>%
+ dplyr::mutate(row.label = .data$heading3,
+ row.height = NA,
+ spacing_row = FALSE) %>%
dplyr::group_by(.data$heading1, .data$heading2) %>%
tidyr::nest() %>%
dplyr::mutate(res = purrr::map(.data$data,
@@ -248,6 +253,7 @@ forest_data <- function(
out <- out %>%
dplyr::add_row(row.label = "",
extrarowkey = paste0(extrarowkeys[[k]]),
+ spacing_row = FALSE,
.after = which(out$key == extrarowkeys[[k]]))
}
}
@@ -263,7 +269,8 @@ forest_data <- function(
}
out <- out %>%
- dplyr::mutate(row = 1:dplyr::n()) %>%
+ dplyr::mutate(row = cumsum(dplyr::coalesce(.data$row.height, 1))) %>%
+ dplyr::filter(!.data$spacing_row) %>%
dplyr::select(.data$row, .data$row.label, .data$key, .data$extrarowkey, .data$addtextrow)
# make datatoplot
@@ -329,11 +336,11 @@ forest_data <- function(
uci_transformed = tf(.data$uci)
)
if (is.null(minse)){
- minse <- min((datatoplot$estimate - datatoplot$lci)/1.96, na.rm = TRUE)
+ minse <- min((datatoplot$uci - datatoplot$lci)/(2*1.96), na.rm = TRUE)
} else {
- if (minse > min((datatoplot$estimate - datatoplot$lci)/1.96, na.rm = TRUE)) stop("minse is larger than the minimum standard error in the data")
+ if (minse > min((datatoplot$uci - datatoplot$lci)/(2*1.96), na.rm = TRUE)) stop("minse is larger than the minimum standard error in the data")
}
- datatoplot$size <- 1.96*minse/(datatoplot$estimate - datatoplot$lci)
+ datatoplot$size <- 2*1.96*minse/(datatoplot$uci - datatoplot$lci)
} else {
datatoplot <- datatoplot %>%
dplyr::mutate(estimate_transformed = tf(.data$estimate),
@@ -364,6 +371,19 @@ forest_data <- function(
datatoplot$size <- 1
}
+ rowlabels <- datatoplot %>%
+ dplyr::group_by(.data$row) %>%
+ dplyr::summarise(row.label = dplyr::first(.data$row.label),
+ bold = all(is.na(.data$estimate_transformed) | all(.data$key %in% bold.labels)),
+ .groups = "drop") %>%
+ dplyr::mutate(row.label = dplyr::if_else(.data$bold & .data$row.label != "",
+ paste0("**", .data$row.label, "**"),
+ as.character(.data$row.label))) %>%
+ dplyr::arrange(.data$row) %>%
+ dplyr::select(.data$row, .data$row.label)
+
+ attr(datatoplot, "rowlabels") <- rowlabels
+
return(datatoplot)
}
@@ -463,10 +483,12 @@ make_forest_data <- forest_data
#' @param plot.margin Plot margin, given as margin(top, right, bottom, left, units). (Default: margin(8, 8, 8, 8, "mm"))
#' @param panel.width Panel width to set and apply different formatting to narrow CIs. A grid::unit object, if a numeric is given assumed to be in mm.
+#' @param panel.height Set height of panels. A grid::unit object, if a numeric is given assumed to be in mm.
#' @param stroke Size of outline of shapes. (Default: 0)
#' @param quiet Set to TRUE to not print the plot nor show generated code in the RStudio 'Viewer' pane. (Default: FALSE)
#' @param printplot Print the plot. (Default: !quiet)
#' @param showcode Show the ggplot2 code to generate the plot in RStudio 'Viewer' pane. (Default: !quiet)
+#' @param data.function Name of a function to apply to data frame before plotting.
#' @param addcode A character vector of code to add to the generated code.
#' The first element should be a regular expression.
#' The remaining elements are added to the generated code just before the first match of a line (trimmed of whitespace) with the regular expression. (Default: NULL)
@@ -550,12 +572,14 @@ forest_plot <- function(
mid.space = unit(5, "mm"),
plot.margin = margin(8, 8, 8, 8, "mm"),
panel.width = NULL,
+ panel.height = NULL,
base_size = 11,
base_line_size = base_size/22,
stroke = 0,
quiet = FALSE,
printplot = !quiet,
showcode = !quiet,
+ data.function = NULL,
addcode = NULL,
addaes = NULL,
addarg = NULL,
@@ -702,6 +726,12 @@ forest_plot <- function(
+ # Text size ----
+ text_size <- round(base_size_to_text_size(base_size), 6)
+
+
+
+
# Spacing ----
## handle old methods for horizontal spacing and column positioning >>>
@@ -855,6 +885,10 @@ forest_plot <- function(
fill <- list(aes = "fill")
}
+ # Panel.height ----
+ if (!missing(panel.height) & !inherits(panel.height, "unit")){
+ panel.height <- grid::unit(panel.height, "mm")
+ }
# Code for preparing data for plotting using forest_data() ----
prep.data.code <- make_layer(
@@ -896,6 +930,7 @@ forest_plot <- function(
argset(blankrows),
argset(scalepoints),
argset(minse),
+ argset(bold.labels),
if (!identical(addtext,
eval(formals(ckbplotr::forest_data)[["addtext"]]))){
sprintf('addtext = %s',
@@ -921,12 +956,6 @@ forest_plot <- function(
# code to prepare data for plotting using forest_data()
prep.data.code,
- # code to create a vector of row labels
- forest.row.labels.vec(bold.labels),
-
- # code to identify CIs that extend outside axis limits
- forest.check.cis(xto, xfrom),
-
# fill may be a list
if (exists("fill_orig")){forest.fillcode(fill_orig, panel.names)},
@@ -952,6 +981,10 @@ forest_plot <- function(
forest.ciundercode(ciunder_orig)
},
+ # code for user function on datatoplot
+ sprintf('datatoplot <- %s(datatoplot)', data.function),
+ '',
+
# code to initiate the ggplot
forest.start.ggplot(),
@@ -983,7 +1016,6 @@ forest_plot <- function(
pointsize),
# code for CI lines plotted after points
- # code for CI lines plotted before points
forest.cis(addaes,
cicolour,
addarg,
@@ -992,7 +1024,7 @@ forest_plot <- function(
type = ci_order[[2]]),
# code to add arrows to CIs
- forest.arrows(addaes, cicolour, addarg, base_line_size),
+ forest.arrows(addaes, cicolour, addarg, base_line_size, xfrom, xto),
# code for plotting diamonds
if(!is.null(col.diamond) || !is.null(diamond)){
@@ -1016,7 +1048,7 @@ forest_plot <- function(
addarg,
xto,
xfrom,
- base_size,
+ text_size,
plotcolour,
col.heading.space,
panel.names,
@@ -1036,7 +1068,7 @@ forest_plot <- function(
addarg,
xfrom,
xto,
- base_size,
+ text_size,
plotcolour,
col.heading.space,
panel.names,
@@ -1053,7 +1085,7 @@ forest_plot <- function(
col.right.parse,
col.right.pos,
col.right.hjust,
- base_size,
+ text_size,
plotcolour,
tf,
inv_tf)
@@ -1063,7 +1095,7 @@ forest_plot <- function(
forest.xlab.panel.headings(addaes,
xmid,
addarg,
- base_size,
+ text_size,
plotcolour,
panel.names,
xlab,
@@ -1073,8 +1105,8 @@ forest_plot <- function(
# code for the axes
forest.axes(scale, xticks, bottom.space),
- # code for panel width
- forest.panel.width(panel.width),
+ # code for panel size
+ forest.panel.size(panel.width, panel.height),
# code for the plot title
if (title != ""){forest.title(title)},
diff --git a/R/geom-text-move.R b/R/geom-text-move.R
index bc28b51..d6ecadc 100644
--- a/R/geom-text-move.R
+++ b/R/geom-text-move.R
@@ -55,45 +55,20 @@ geom_text_move <- function(mapping = NULL, data = NULL,
#' @format NULL
#' @usage NULL
GeomTextMove <- ggproto("GeomTextMove", GeomText,
- default_aes = aes(
- colour = "black", size = 3.88, angle = 0, hjust = 0.5,
- vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2),
-
draw_panel = function(data, panel_params, coord, parse = FALSE,
na.rm = FALSE, check_overlap = FALSE,
move_x = unit(0, "pt"),
move_y = unit(0, "pt")) {
- lab <- data$label
- if (parse) {
- lab <- ggplot2:::parse_safe(as.character(lab))
- }
-
- data <- coord$transform(data, panel_params)
-
- if (is.character(data$vjust)) {
- data$vjust <- compute_just(data$vjust, data$y)
- }
- if (is.character(data$hjust)) {
- data$hjust <- compute_just(data$hjust, data$x)
- }
-
- grid::textGrob(
- lab,
- grid::unit.c(unit(data$x, "native") + move_x), grid::unit.c(unit(data$y, "native") + move_y), default.units = "native",
- hjust = data$hjust, vjust = data$vjust,
- rot = data$angle,
- gp = grid::gpar(
- col = alpha(data$colour, data$alpha),
- fontsize = data$size * .pt,
- fontfamily = data$family,
- fontface = data$fontface,
- lineheight = data$lineheight
- ),
- check.overlap = check_overlap
- )
- },
-
- draw_key = draw_key_text
+ text_grob <- ggplot2::GeomText$draw_panel(data = data,
+ panel_params = panel_params,
+ coord = coord,
+ parse = parse,
+ na.rm = na.rm,
+ check_overlap = check_overlap)
+ text_grob$x <- text_grob$x + move_x
+ text_grob$y <- text_grob$y + move_y
+ return(text_grob)
+ }
)
diff --git a/R/shape-plot-parts.R b/R/shape-plot-parts.R
index 81359af..a024bd4 100644
--- a/R/shape-plot-parts.R
+++ b/R/shape-plot-parts.R
@@ -181,7 +181,7 @@ shape.estimates.text <- function(addaes,
uci_string,
est_string,
addarg,
- base_size,
+ text_size,
plotcolour,
digits) {
make_layer(
@@ -195,7 +195,7 @@ shape.estimates.text <- function(addaes,
digits)),
arg = c(addarg$estimates,
'vjust = -0.8',
- sprintf('size = %s', base_size/(11/3)),
+ sprintf('size = %s', text_size),
sprintf('colour = %s', quote_string(plotcolour)))
)
}
@@ -206,7 +206,7 @@ shape.n.events.text <- function(addaes,
lci_string,
col.n,
addarg,
- base_size,
+ text_size,
plotcolour) {
make_layer(
'# Plot n events text',
@@ -216,7 +216,7 @@ shape.n.events.text <- function(addaes,
sprintf('label = %s', col.n)),
arg = c(addarg$n,
'vjust = 1.8',
- sprintf('size = %s', base_size/(11/3)),
+ sprintf('size = %s', text_size),
sprintf('colour = %s', quote_string(plotcolour)))
)
}
@@ -276,6 +276,7 @@ shape.plot.like.ckb <- function(xlims,
gap,
ext,
ratio,
+ width,
height,
base_size,
base_line_size,
@@ -289,6 +290,9 @@ shape.plot.like.ckb <- function(xlims,
sprintf('gap = %s', gap),
sprintf('ext = %s', ext),
sprintf('ratio = %s', ratio),
+ sprintf('width = unit(%s, "%s")',
+ as.numeric(width),
+ makeunit(width)),
sprintf('height = unit(%s, "%s")',
as.numeric(height),
makeunit(height)),
diff --git a/R/shape-plot.R b/R/shape-plot.R
index b294c77..05d464c 100644
--- a/R/shape-plot.R
+++ b/R/shape-plot.R
@@ -37,6 +37,7 @@
#' @param xlims A numeric vector of length two. The limits of the x-axis.
#' @param ylims A numeric vector of length two. The limits of the y-axis.
#' @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.
+#' @param width Panel width.A grid::unit() object, or if numeric is assumed to be in mm.
#' @param xbreaks Breaks for the x axis. Passed to ggplots::scale_x_continuous. (Default: NULL)
#' @param ybreaks Breaks for the y axis. Passed to ggplots::scale_y_continuous. (Default: NULL)
#' @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))
@@ -87,7 +88,8 @@ shape_plot <- function(data,
lines = FALSE,
xlims,
ylims,
- height = NULL,
+ height = NULL,
+ width = NULL,
gap = c(0.025, 0.025),
ext = c(0.025, 0.025),
ratio = 1.5,
@@ -174,7 +176,7 @@ shape_plot <- function(data,
# String for point size aesthetic
if (scalepoints) {
if (!is.null(col.lci)) {
- size <- sprintf('1.96/(%s - %s)', column_name(col.estimate), column_name(col.lci))
+ size <- sprintf('2*1.96/(%s - %s)', column_name(col.uci), column_name(col.lci))
} else {
size <- sprintf('1/%s', column_name(col.stderr))
}
@@ -183,6 +185,16 @@ shape_plot <- function(data,
}
+
+
+ # Text size ----
+ text_size <- round(base_size_to_text_size(base_size), 6)
+
+
+
+
+
+
# Log scale and exponentiate estimates ----
if (logscale == TRUE){
scale <- "log"
@@ -237,6 +249,12 @@ shape_plot <- function(data,
}
+ # Width ----
+ if (!missing(width) & !inherits(width, "unit")){
+ width <- grid::unit(width, "mm")
+ }
+
+
# Using groups ----
if (!is.null(col.group)) {
@@ -337,7 +355,7 @@ shape_plot <- function(data,
uci_string,
est_string,
addarg,
- base_size,
+ text_size,
plotcolour,
digits),
@@ -347,7 +365,7 @@ shape_plot <- function(data,
lci_string,
col.n,
addarg,
- base_size,
+ text_size,
plotcolour)
},
@@ -376,6 +394,7 @@ shape_plot <- function(data,
deparse(gap),
deparse(ext),
deparse(ratio),
+ width,
height,
base_size,
base_line_size,
diff --git a/R/utils.R b/R/utils.R
index 7cf4c57..e5e71d7 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -164,3 +164,16 @@ makeunit <- function(x){
}
+
+
+
+#' Turn font size in pt into mm and multiply
+#'
+#' multiply 0.8 to match default size of axis text in ggplot
+#'
+#' @keywords internal
+#' @noRd
+
+base_size_to_text_size <- function(x, m = 0.8){
+ m * x/.pt
+}
diff --git a/README.Rmd b/README.Rmd
index f11d8b9..f56ffe2 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -86,6 +86,13 @@ ckbplot <- plot_like_ckb(plot = plot, xlims = c(0, 8), ylims = c(10, 50))
grid.arrange(plot, arrow, ckbplot, ncol = 3, widths = c(1, 0.25, 1))
```
+## Key features
+
+Functions that create plots (such as `shape_plot()` and `forest_plot()`) return both:
+
+- A **ggplot2 plot**. This allows users to further manipulate the plot using ggplot2 code, such as `+ theme()` to customise the plot.
+- The **ggplot2 code used to create the plot**. This allows uses 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.)
+
## Installation
@@ -109,7 +116,3 @@ remotes::install_github('neilstats/ckbplotr')
Read `vignette("ckbplotr")` to see how to use the `shape_plot()`, `forest_plot()`, and `plot_like_ckb()` functions.
-
-## ggplot2 code
-
-The `shape_plot()` and `forest_plot()` functions return both a plot and the ggplot2 code used to create the plot. In RStudio the ggplot2 code used to create the plot will be shown in the Viewer pane.
diff --git a/README.md b/README.md
index 363f8f8..f1d9ec7 100644
--- a/README.md
+++ b/README.md
@@ -32,6 +32,17 @@ levels…
…and convert other ggplots to CKB style.
+## Key features
+
+Functions that create plots (such as `shape_plot()` and `forest_plot()`)
+return both:
+
+- A **ggplot2 plot**. This allows users to further manipulate the plot
+ using ggplot2 code, such as `+ theme()` to customise the plot.
+- The **ggplot2 code used to create the plot**. This allows uses 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.)
+
## Installation
### From R-universe
@@ -60,9 +71,3 @@ remotes::install_github('neilstats/ckbplotr')
Read `vignette("ckbplotr")` to see how to use the `shape_plot()`,
`forest_plot()`, and `plot_like_ckb()` functions.
-
-## ggplot2 code
-
-The `shape_plot()` and `forest_plot()` functions return both a plot and
-the ggplot2 code used to create the plot. In RStudio the ggplot2 code
-used to create the plot will be shown in the Viewer pane.
diff --git a/man/ckbplotr-package.Rd b/man/ckbplotr-package.Rd
index 4f100c2..97e1fb9 100644
--- a/man/ckbplotr-package.Rd
+++ b/man/ckbplotr-package.Rd
@@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/ckbplotr.R
+% Please edit documentation in R/ckbplotr-package.R, R/ckbplotr.R
\docType{package}
\name{ckbplotr-package}
\alias{ckbplotr}
@@ -8,6 +8,10 @@
\description{
\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
+ckbplotr provides functions to help create and style plots in R. It is being developed by, and primarily for, China Kadoorie Biobank researchers.
+
+\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
+
ckbplotr provides functions to help create and style plots in R. It is being developed by, and primarily for, China Kadoorie Biobank researchers.
}
\seealso{
@@ -17,6 +21,13 @@ Useful links:
\item Report bugs at \url{https://github.com/neilstats/ckbplotr/issues}
}
+
+Useful links:
+\itemize{
+ \item \url{https://neilstats.github.io/ckbplotr/}
+ \item Report bugs at \url{https://github.com/neilstats/ckbplotr/issues}
+}
+
}
\author{
\strong{Maintainer}: Neil Wright \email{neil.wright@ndph.ox.ac.uk}
diff --git a/man/figures/README-a-plot-1.png b/man/figures/README-a-plot-1.png
index 716bbc2..d5e20f7 100644
Binary files a/man/figures/README-a-plot-1.png and b/man/figures/README-a-plot-1.png differ
diff --git a/man/figures/README-example-forest-plot-1.png b/man/figures/README-example-forest-plot-1.png
index e24150a..ec8f49f 100644
Binary files a/man/figures/README-example-forest-plot-1.png and b/man/figures/README-example-forest-plot-1.png differ
diff --git a/man/figures/README-example-shape-plot-1.png b/man/figures/README-example-shape-plot-1.png
index aeaa185..796a5ac 100644
Binary files a/man/figures/README-example-shape-plot-1.png and b/man/figures/README-example-shape-plot-1.png differ
diff --git a/man/figures/lifecycle-archived.svg b/man/figures/lifecycle-archived.svg
new file mode 100644
index 0000000..48f72a6
--- /dev/null
+++ b/man/figures/lifecycle-archived.svg
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/man/figures/lifecycle-defunct.svg b/man/figures/lifecycle-defunct.svg
new file mode 100644
index 0000000..01452e5
--- /dev/null
+++ b/man/figures/lifecycle-defunct.svg
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/man/figures/lifecycle-deprecated.svg b/man/figures/lifecycle-deprecated.svg
new file mode 100644
index 0000000..4baaee0
--- /dev/null
+++ b/man/figures/lifecycle-deprecated.svg
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/man/figures/lifecycle-experimental.svg b/man/figures/lifecycle-experimental.svg
new file mode 100644
index 0000000..d1d060e
--- /dev/null
+++ b/man/figures/lifecycle-experimental.svg
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/man/figures/lifecycle-maturing.svg b/man/figures/lifecycle-maturing.svg
new file mode 100644
index 0000000..df71310
--- /dev/null
+++ b/man/figures/lifecycle-maturing.svg
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/man/figures/lifecycle-questioning.svg b/man/figures/lifecycle-questioning.svg
new file mode 100644
index 0000000..08ee0c9
--- /dev/null
+++ b/man/figures/lifecycle-questioning.svg
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/man/figures/lifecycle-stable.svg b/man/figures/lifecycle-stable.svg
new file mode 100644
index 0000000..e015dc8
--- /dev/null
+++ b/man/figures/lifecycle-stable.svg
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/man/figures/lifecycle-superseded.svg b/man/figures/lifecycle-superseded.svg
new file mode 100644
index 0000000..75f24f5
--- /dev/null
+++ b/man/figures/lifecycle-superseded.svg
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/man/fix_panel.Rd b/man/fix_panel.Rd
index 7bb6f8e..832654a 100644
--- a/man/fix_panel.Rd
+++ b/man/fix_panel.Rd
@@ -17,5 +17,10 @@ fix_panel(plot, width = NULL, height = NULL)
A gtable object
}
\description{
-\code{fix_panel} fixes the panel width and height of a forest plot
+\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
+
+plot_like_ckb() and shape_plot() have width and height arguments and
+forest_plot() has panel.width and panel.height arguments. These use
+ggh4x::force_panelsizes() to fix panel sizes.
}
+\keyword{internal}
diff --git a/man/forest_data.Rd b/man/forest_data.Rd
index 5ebbf54..2d03013 100644
--- a/man/forest_data.Rd
+++ b/man/forest_data.Rd
@@ -28,7 +28,8 @@ forest_data(
addtext = NULL,
cols = panels,
headings = NULL,
- colnames = NULL
+ colnames = NULL,
+ bold.labels = NULL
)
make_forest_data(
@@ -54,7 +55,8 @@ make_forest_data(
addtext = NULL,
cols = panels,
headings = NULL,
- colnames = NULL
+ colnames = NULL,
+ bold.labels = NULL
)
}
\arguments{
diff --git a/man/forest_plot.Rd b/man/forest_plot.Rd
index 15666f0..592ca1f 100644
--- a/man/forest_plot.Rd
+++ b/man/forest_plot.Rd
@@ -59,12 +59,14 @@ forest_plot(
mid.space = unit(5, "mm"),
plot.margin = margin(8, 8, 8, 8, "mm"),
panel.width = NULL,
+ panel.height = NULL,
base_size = 11,
base_line_size = base_size/22,
stroke = 0,
quiet = FALSE,
printplot = !quiet,
showcode = !quiet,
+ data.function = NULL,
addcode = NULL,
addaes = NULL,
addarg = NULL,
@@ -138,12 +140,14 @@ make_forest_plot(
mid.space = unit(5, "mm"),
plot.margin = margin(8, 8, 8, 8, "mm"),
panel.width = NULL,
+ panel.height = NULL,
base_size = 11,
base_line_size = base_size/22,
stroke = 0,
quiet = FALSE,
printplot = !quiet,
showcode = !quiet,
+ data.function = NULL,
addcode = NULL,
addaes = NULL,
addarg = NULL,
@@ -306,6 +310,8 @@ given in the col.key column.}
\item{panel.width}{Panel width to set and apply different formatting to narrow CIs. A grid::unit object, if a numeric is given assumed to be in mm.}
+\item{panel.height}{Set height of panels. A grid::unit object, if a numeric is given assumed to be in mm.}
+
\item{base_size}{base font size, given in pts.}
\item{base_line_size}{base size for line elements}
@@ -318,6 +324,8 @@ given in the col.key column.}
\item{showcode}{Show the ggplot2 code to generate the plot in RStudio 'Viewer' pane. (Default: !quiet)}
+\item{data.function}{Name of a function to apply to data frame before plotting.}
+
\item{addcode}{A character vector of code to add to the generated code.
The first element should be a regular expression.
The remaining elements are added to the generated code just before the first match of a line (trimmed of whitespace) with the regular expression. (Default: NULL)}
diff --git a/man/shape_plot.Rd b/man/shape_plot.Rd
index 92f21b0..75a1fab 100644
--- a/man/shape_plot.Rd
+++ b/man/shape_plot.Rd
@@ -30,6 +30,7 @@ shape_plot(
xlims,
ylims,
height = NULL,
+ width = NULL,
gap = c(0.025, 0.025),
ext = c(0.025, 0.025),
ratio = 1.5,
@@ -77,6 +78,7 @@ make_shape_plot(
xlims,
ylims,
height = NULL,
+ width = NULL,
gap = c(0.025, 0.025),
ext = c(0.025, 0.025),
ratio = 1.5,
@@ -152,6 +154,8 @@ estimates. (Default: 3)}
\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.}
+\item{width}{Panel width.A grid::unit() object, or if numeric is assumed to be in mm.}
+
\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))}
\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))}
diff --git a/vignettes/adding_editing_code.Rmd b/vignettes/adding_editing_code.Rmd
index a6d6e14..8b30b4f 100644
--- a/vignettes/adding_editing_code.Rmd
+++ b/vignettes/adding_editing_code.Rmd
@@ -109,20 +109,30 @@ The argument should be a character vector. The first element defines where the c
### Example
We wish to use `geom_segment()` to add dashed lines to the plot, and these should be added to the plot before the point estimates:
```{r}
-forest_plot(panels = list(resultsA, resultsB),
- col.key = "variable",
- panel.headings = c("Analysis A", "Analysis B"),
- exponentiate = TRUE,
- colour = "grey",
- addcode = c("# Plot points at the transformed estimates",
- "# Plot dashed line",
- "geom_segment(aes(x = estimate_transformed, xend = estimate_transformed, y= -row, yend = -1),",
- "linetype = 'dashed',",
- "data = ~ dplyr::filter(.,row.label=='nmr_s_vldl_tg')) +",
- ""))
+code_to_add <- c('# Add vertical dashed lines',
+ 'geom_segment(aes(x = estimate_transformed,',
+ ' xend = estimate_transformed,',
+ ' yend = -0.7),',
+ ' linetype = "dashed",',
+ ' colour = "grey40",',
+ ' data = ~ dplyr::filter(diamonds, key %in% c("nmr_s_vldl_tg"))) +',
+ '')
+
+
+forestplot1 <- make_forest_plot(panels = list(resultsA),
+ col.key = "variable",
+ exponentiate = TRUE,
+ panel.names = c("Analysis A"),
+ diamond = c("nmr_s_vldl_tg"),
+ addcode = c("# Plot points at the transformed estimates",
+ code_to_add))
```
+## The data.function argument
+
+In `forest_plot()`, the `data.function` argument can be used to apply a defined function to the data frame immediately before the ggplot2 code.
+
### Example
We want to manipulate the plot data before creating the plot:
```{r}
@@ -136,8 +146,7 @@ forest_plot(panels = list(resultsA, resultsB),
col.key = "variable",
panel.headings = c("Analysis A", "Analysis B"),
exponentiate = TRUE,
- addcode = c("# Create the ggplot",
- "datatoplot <- change_plot_data(datatoplot)"))
+ data.function = "change_plot_data")
```