Skip to content

Commit a67d8bc

Browse files
neilstatsneilstats
authored
fixes
2 parents 5ece5ff + 2304061 commit a67d8bc

File tree

9 files changed

+64
-61
lines changed

9 files changed

+64
-61
lines changed

‎DESCRIPTION

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@ Title: Create CKB Plots
33
Description: ckbplotr provides functions to help create and style plots in R.
44
It is being developed by, and primarily for, China Kadoorie Biobank
55
researchers.
6-
Version: 0.8.1
6+
Version: 0.8.2
77
Authors@R:
88
person(given = "Neil",
99
family = "Wright",

‎NEWS.md

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
# ckbplotr 0.8.2
2+
3+
* Fixes.
4+
15
# ckbplotr 0.8.1
26

37
* blankrows argument of forest_plot() now allows decimals and negative numbers.

‎R/forest-plot-parts.R

Lines changed: 22 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -32,10 +32,9 @@ forest.cicolourcode <- function(scale,
3232
stroke,
3333
panel.width,
3434
shape,
35-
cicolours,
35+
cicolour,
3636
panel.names) {
3737

38-
if(!inherits(panel.width, "unit")){return(NULL)}
3938
panel.width.mm <- as.numeric(grid::convertUnit(panel.width, "mm"))
4039

4140
x <- c(
@@ -49,24 +48,24 @@ forest.cicolourcode <- function(scale,
4948
(inv_tf(xto) - inv_tf(xfrom)) * (pointsize + 2 * stroke) / panel.width.mm, c(shape$arg, column_name(shape$aes)))),
5049
'dplyr::mutate(cicolour = dplyr::case_when('))
5150

52-
if(is.list(cicolours)){
53-
for (i in 1:length(cicolours)){
51+
if(is.list(cicolour$colours)){
52+
for (i in 1:length(cicolour$colours)){
5453
x<- c(x,
5554
indent(27,
5655
sprintf('panel == %s & narrowci ~ %s,',
5756
quote_string(panel.names[[i]]),
58-
cicolours[[i]][length(cicolours[[i]])]),
57+
cicolour$colours[[i]][length(cicolour$colours[[i]])]),
5958
sprintf('panel == %s & !narrowci ~ %s,',
6059
quote_string(panel.names[[i]]),
61-
cicolours[[i]][1])))
60+
cicolour$colours[[i]][1])))
6261
}
6362
x <- c(x,
6463
indent(27, 'TRUE ~ "black"))'),
6564
'')
6665
} else {
6766
x <- c(x,
68-
indent(27, sprintf('narrowci ~ %s,', cicolours[length(cicolours)]),
69-
sprintf('TRUE ~ %s))', cicolours[1])),
67+
indent(27, sprintf('narrowci ~ %s,', cicolour$colours[length(cicolour$colours)]),
68+
sprintf('TRUE ~ %s))', cicolour$colours[1])),
7069
'')
7170
}
7271
x
@@ -106,7 +105,9 @@ forest.ciundercode <- function(ciunder) {
106105

107106
#' code for preparing data for diamonds
108107
#' @noRd
109-
forest.diamondscode <- function(diamond, col.diamond, panel.width, cicolours, panel.names) {
108+
forest.diamondscode <- function(diamond,
109+
col.diamond,
110+
panel.names) {
110111
if (!is.null(diamond)){
111112
x <- c(
112113
'# Create data frame for diamonds to be plotted',
@@ -150,7 +151,7 @@ forest.diamondscode <- function(diamond, col.diamond, panel.width, cicolours, pa
150151
'dplyr::mutate(y = - row + c(0, -0.25, 0, 0.25))'),
151152
'',
152153
'# Remove plotting of points if a diamond is to be used',
153-
sprintf('if (any(datatoplot[["%s"]])) {', col.diamond),
154+
sprintf('if (any(datatoplot[["%s"]], na.rm = TRUE)) {', col.diamond),
154155
indent(2,
155156
sprintf(' datatoplot[!is.na(datatoplot[["%s"]]) & datatoplot[["%s"]],]$estimate_transformed <- NA', col.diamond, col.diamond),
156157
sprintf(' datatoplot[!is.na(datatoplot[["%s"]]) & datatoplot[["%s"]],]$lci_transformed <- NA', col.diamond, col.diamond),
@@ -159,41 +160,20 @@ forest.diamondscode <- function(diamond, col.diamond, panel.width, cicolours, pa
159160
''
160161
)
161162
}
162-
163-
if(inherits(panel.width, "mm") && is.list(cicolours)){
164-
x <- c(
165-
x,
166-
'## Add colour',
167-
'diamonds <- diamonds %>%',
168-
indent(2,
169-
'dplyr::mutate(cicolour = dplyr::case_when(')
170-
)
171-
172-
for (i in 1:length(cicolours)){
173-
x <- c(x,
174-
indent(27,
175-
sprintf('panel == %s ~ %s,',
176-
quote_string(panel.names[[i]]),
177-
cicolours[[i]][1])))
178-
}
179-
x <- c(x,
180-
indent(27, 'TRUE ~ "black"))'),
181-
'')
182-
}
183163
x
184164
}
185165

186166
#' code for plotting diamonds
187167
#' @noRd
188-
forest.plotdiamondscode <- function(cicolour, fill, stroke) {
168+
forest.plotdiamondscode <- function(colour, fill, stroke) {
189169
make_layer(
190170
'# Add diamonds',
191171
f = 'geom_polygon',
192172
aes = c('x = x, y = y, group = row',
193-
sprintf('colour = %s', column_name(cicolour$aes[1])),
173+
sprintf('colour = %s', column_name(colour$aes)),
194174
sprintf('fill = %s', column_name(fill$aes))),
195175
arg = c('data = diamonds',
196-
sprintf('colour = %s', quote_string(cicolour$arg[1])),
176+
sprintf('colour = %s', quote_string(colour$arg)),
197177
sprintf('fill = %s', quote_string(fill$arg)),
198178
sprintf('linewidth = %s', stroke))
199179
)
@@ -277,6 +257,8 @@ forest.plot.points <- function(addaes,
277257
#' code for plotting confidence interval lines
278258
#' @noRd
279259
forest.cis <- function(addaes, cicolour, addarg, ciunder, base_line_size,
260+
xfrom,
261+
xto,
280262
type = c("all", "before", "after", "null")) {
281263
if (type == "null"){return(NULL)}
282264
make_layer(
@@ -286,8 +268,8 @@ forest.cis <- function(addaes, cicolour, addarg, ciunder, base_line_size,
286268
"after" = '# Plot the CIs - after plotting points'),
287269
f = 'geom_errorbar',
288270
aes = c(addaes$ci,
289-
'xmin = lci_transformed',
290-
'xmax = uci_transformed',
271+
sprintf('xmin = pmin(pmax(lci_transformed, %s), %s)', xfrom, xto),
272+
sprintf('xmax = pmin(pmax(uci_transformed, %s), %s)', xfrom, xto),
291273
sprintf('colour = %s', column_name(cicolour$aes[1]))),
292274
arg = c(addarg$ci,
293275
switch(type,
@@ -586,16 +568,14 @@ forest.xlab.panel.headings <- function(addaes, xmid, addarg, text_size, plotcolo
586568

587569
#' code to set panel width and/or height
588570
#' @noRd
589-
forest.panel.size <- function(panel.width, panel.height) {
590-
if(!inherits(panel.width, "unit") &
591-
!inherits(panel.height, "unit")){return(NULL)}
592-
571+
forest.panel.size <- function(panel.width,
572+
panel.height) {
593573
make_layer(
594574
'# Fix panel size',
595575
f = 'ggh4x::force_panelsizes',
596576
arg = c(sprintf('cols = unit(%s, "%s")',
597-
as.numeric(panel.width),
598-
makeunit(panel.width)),
577+
as.numeric(panel.width),
578+
makeunit(panel.width)),
599579
sprintf('rows = unit(%s, "%s")',
600580
as.numeric(panel.height),
601581
makeunit(panel.height))),

‎R/forest-plot.R

Lines changed: 33 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -624,6 +624,9 @@ forest_plot <- function(
624624

625625

626626
# Check arguments ----
627+
fixed_panel_width <- !missing(panel.width)
628+
fixed_panel_height <- !missing(panel.height)
629+
627630
if (!missing(col.diamond) && !missing(diamond)) stop("Use either col.diamond or diamond, not both.")
628631

629632
for (c in c(col.left, col.right)){
@@ -633,7 +636,7 @@ forest_plot <- function(
633636
}
634637

635638
## check if cicolour is a list (or longer than 1) but not using panel.width
636-
if ((is.list(cicolour) | length(cicolour) > 1) & missing(panel.width)){
639+
if ((is.list(cicolour) | length(cicolour) > 1) & !fixed_panel_width){
637640
stop("cicolour should be a list (or longer than 1) only when using panel.width")
638641
}
639642

@@ -862,13 +865,14 @@ forest_plot <- function(
862865
if (is.null(xticks)) { xticks <- pretty(c(xfrom, xto)) }
863866

864867

865-
# Aesthetic adjustments when using panel.width ----
866-
if (!missing(panel.width)) {
868+
# Panel.width + Aesthetic adjustments ----
869+
if (fixed_panel_width) {
867870
if (!inherits(panel.width, "unit")){
868871
panel.width <- grid::unit(panel.width, "mm")
869872
}
870873
cicolours <- c(quote_string(cicolour$arg), column_name(cicolour$aes))
871-
cicolour <- list(aes = "cicolour")
874+
cicolour <- list(aes = "cicolour",
875+
colours = cicolours)
872876

873877
if (missing(ciunder)) {
874878
ciunder <- c(TRUE, FALSE)
@@ -886,7 +890,7 @@ forest_plot <- function(
886890
}
887891

888892
# Panel.height ----
889-
if (!missing(panel.height) & !inherits(panel.height, "unit")){
893+
if (fixed_panel_height & !inherits(panel.height, "unit")){
890894
panel.height <- grid::unit(panel.height, "mm")
891895
}
892896

@@ -961,20 +965,24 @@ forest_plot <- function(
961965

962966
# code for preparing data for diamonds
963967
if(!is.null(col.diamond) || !is.null(diamond)){
964-
forest.diamondscode(diamond, col.diamond, panel.width, cicolours, panel.names)
968+
forest.diamondscode(diamond,
969+
col.diamond,
970+
panel.names)
965971
},
966972

967973
# code for CI colours if using panel.width
968-
forest.cicolourcode(scale,
969-
inv_tf,
970-
xto,
971-
xfrom,
972-
pointsize,
973-
stroke,
974-
panel.width,
975-
shape,
976-
cicolours,
977-
panel.names),
974+
if (fixed_panel_width) {
975+
forest.cicolourcode(scale,
976+
inv_tf,
977+
xto,
978+
xfrom,
979+
pointsize,
980+
stroke,
981+
panel.width,
982+
shape,
983+
cicolour,
984+
panel.names)
985+
},
978986

979987
## code for CI under - if using panel.width
980988
if (exists("ciunder_orig")) {
@@ -1002,6 +1010,8 @@ forest_plot <- function(
10021010
addarg,
10031011
ciunder,
10041012
base_line_size,
1013+
xfrom,
1014+
xto,
10051015
type = ci_order[[1]]),
10061016

10071017
# code to plot points
@@ -1021,14 +1031,16 @@ forest_plot <- function(
10211031
addarg,
10221032
ciunder,
10231033
base_line_size,
1034+
xfrom,
1035+
xto,
10241036
type = ci_order[[2]]),
10251037

10261038
# code to add arrows to CIs
10271039
forest.arrows(addaes, cicolour, addarg, base_line_size, xfrom, xto),
10281040

10291041
# code for plotting diamonds
10301042
if(!is.null(col.diamond) || !is.null(diamond)){
1031-
forest.plotdiamondscode(cicolour, fill, stroke)
1043+
forest.plotdiamondscode(colour, fill, stroke)
10321044
},
10331045

10341046
# code for scales and coordinates
@@ -1106,7 +1118,10 @@ forest_plot <- function(
11061118
forest.axes(scale, xticks, bottom.space),
11071119

11081120
# code for panel size
1109-
forest.panel.size(panel.width, panel.height),
1121+
if (fixed_panel_width | fixed_panel_height){
1122+
forest.panel.size(panel.width,
1123+
panel.height)
1124+
},
11101125

11111126
# code for the plot title
11121127
if (title != ""){forest.title(title)},

‎R/utils.R

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ column_name <- function(x){
3535
#' @noRd
3636
#'
3737
quote_string <- function(x){
38+
if(is.null(x)){return(x)}
3839
if(is.list(x)){return(lapply(x, quote_string))}
3940
paste0('\"', x, '\"')
4041
}

‎_pkgdown.yml

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,3 +40,6 @@ news:
4040
href: https://github.com/neilstats/ckbplotr/releases/latest
4141

4242
url: https://neilstats.github.io/ckbplotr/
43+
44+
figures:
45+
dpi: 320

‎man/figures/README-a-plot-1.png

130 KB
Loading

‎man/figures/README-example-forest-plot-1.png

207 KB
Loading

‎man/figures/README-example-shape-plot-1.png

56.9 KB
Loading

0 commit comments

Comments
 (0)