Merge pull request #74 from neilstats/dev

minor updates
neilstats · Jun 6, 2022 · 1611216 · 1611216
2 parents 838e0f8 + 1181c01
commit 1611216
Show file tree

Hide file tree

Showing 13 changed files with 195 additions and 97 deletions.
diff --git 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.6.4
+Version: 0.6.5
 Authors@R: 
     person(given = "Neil",
            family = "Wright",
@@ -25,13 +25,12 @@ Imports:
     utils,
     stringi,
     grid,
-    ggtext
-RoxygenNote: 7.1.2
-Suggests: 
+    ggtext,
     knitr,
     rmarkdown,
+RoxygenNote: 7.1.2
+Suggests:
     gridExtra,
-    highlight,
     covr,
     testthat
 VignetteBuilder: knitr

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,8 @@
+# ckbplotr 0.6.5
+* Added arguments to control the colour of non-data components of a plot.
+* Use R markdown to render plot code to display in Viewer pane of RStudio. (Replacing use of highlight package.)
+* Updates to vignettes.
+
 # ckbplotr 0.6.4
 
 * Added legend.name and legend.position arguments to make_shape_plot().

diff --git a/R/make_forest_plot.R b/R/make_forest_plot.R
@@ -431,9 +431,10 @@ make_forest_data <- function(
 #' @param pointsize The (largest) size of box to use for plotting point
 #'                  estimates. (Default: 3)
 #' @param shape Shape of points. An integer, or name of a column of integers. (Default will use shape 22 - squares with fill.)
-#' @param colour Colour of points. Name of a colour, or name of a column of colour names. (Default will use black.)
-#' @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 black.)
-#' @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 black.)
+#' @param plotcolour Colour for all parts of the plot. (Default: "black")
+#' @param colour Colour of points. Name of a colour, or name of a column of colour names. (Default will use plotcolour.)
+#' @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.)
+#' @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.)
 #' @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.)
 #' @param col.diamond Plot estimates and CIs as diamonds. Name of a column of logical values.
 #' @param diamond Alternative to col.diamond. A character vectors identify the rows
@@ -520,6 +521,7 @@ make_forest_plot <- function(
   minse         = NULL,
   pointsize     = 3,
   shape     = NULL,
+  plotcolour = "black",
   colour    = NULL,
   cicolour  = colour,
   fill      = NULL,
@@ -627,9 +629,11 @@ make_forest_plot <- function(
     shape <- NULL
   }
 
+  plotcolour <- fixq(plotcolour)
+
   cicolour.aes <- NULL
   if (is.null(cicolour)) {
-    cicolour <- fixq("black")
+    cicolour <- plotcolour
   }
   else if (all(cicolour %in% names(panels[[1]]))){
     cicolour.aes <- fixsp(cicolour)
@@ -640,7 +644,7 @@ make_forest_plot <- function(
 
   colour.aes <- NULL
   if (is.null(colour)) {
-    colour <- fixq("black")
+    colour <- plotcolour
   } else if (all(colour %in% names(panels[[1]]))){
     colour.aes <- fixsp(colour)
     colour <- NULL
@@ -650,7 +654,7 @@ make_forest_plot <- function(
 
   fill.aes <- NULL
   if (is.null(fill)) {
-    fill <- fixq("black")
+    fill <- plotcolour
   } else if (fill %in% names(panels[[1]])){
     fill.aes <- fixsp(fill)
     fill <- NULL
@@ -710,7 +714,7 @@ make_forest_plot <- function(
 
   ## calculate automatic col.right.pos and col.right.space
   if (is.null(right.space) | is.null(col.right.pos) | is.null(left.space) | is.null(col.left.pos)){
-    codetext$spacing <- "## Automatically calculated horizontal spacing and positioning:"
+    text_auto_spacing <- "Automatically calculated horizontal spacing and positioning:\n"
   }
   ### get maximum width of each columns (incl. heading)
   colspaces <- gettextwidths(lapply(col.right, function(y) c(sapply(panels, function(x) x[[y]]))))
@@ -737,12 +741,12 @@ make_forest_plot <- function(
   colspaceauto <-  round(0.8 * base_size/grid::get.gpar()$fontsize * colspaceauto, 1)
   if (is.null(right.space)){
     right.space <- unit(colspaceauto[length(colspaceauto)], "mm")
-    codetext$spacing <- c(codetext$spacing, paste0("## right.space   = ", printunit(right.space)))
+    text_auto_spacing <- c(text_auto_spacing, paste0("- right.space   = ", printunit(right.space)))
   }
   if (length(colspaceauto) > 1){colspaceauto <- colspaceauto[-length(colspaceauto)]}
   if (is.null(col.right.pos)){
     col.right.pos <- unit(colspaceauto, "mm")
-    codetext$spacing <- c(codetext$spacing, paste0("## col.right.pos = ", printunit(col.right.pos)))
+    text_auto_spacing <- c(text_auto_spacing, paste0("- col.right.pos = ", printunit(col.right.pos)))
   }
 
   ## calculate automatic col.left.pos and col.left.space
@@ -762,12 +766,12 @@ make_forest_plot <- function(
   colspaceauto <-  round(0.8 * base_size/grid::get.gpar()$fontsize * colspaceauto, 1)
   if (is.null(left.space)){
     left.space <- unit(colspaceauto[length(colspaceauto)], "mm")
-    codetext$spacing <- c(codetext$spacing, paste0("## left.space    = ", printunit(left.space)))
+    text_auto_spacing <- c(text_auto_spacing, paste0("- left.space    = ", printunit(left.space)))
   }
   if (length(colspaceauto) > 1){colspaceauto <- colspaceauto[-length(colspaceauto)]}
   if (is.null(col.left.pos)){
     col.left.pos <- unit(colspaceauto, "mm")
-    codetext$spacing <- c(codetext$spacing, paste0("## col.left.pos  = ", printunit(col.left.pos)))
+    text_auto_spacing <- c(text_auto_spacing, paste0("- col.left.pos  = ", printunit(col.left.pos)))
   }
 
 
@@ -1028,7 +1032,8 @@ make_forest_plot <- function(
       arg = c('geom = "segment"',
               'y = -0.7, yend = -Inf',
               sprintf('x = %s, xend = %s', nullval, nullval),
-              sprintf('size = %s', base_line_size))
+              sprintf('size = %s', base_line_size),
+              sprintf('colour = %s', plotcolour))
     )
   }
 
@@ -1204,6 +1209,7 @@ make_forest_plot <- function(
                   sprintf('move_x = unit(%s, "%s")', ..2, ..3),
                   sprintf('hjust = %s', ..5),
                   sprintf('size  = %s', base_size/(11/3)),
+                  sprintf('colour  = %s', plotcolour),
                   'na.rm = TRUE',
                   sprintf('parse = %s', ..7)),
           br = FALSE
@@ -1216,6 +1222,7 @@ make_forest_plot <- function(
           arg = c(sprintf('move_x = unit(%s, "%s")', ..2, ..3),
                   sprintf('hjust    = %s', ..5),
                   sprintf('size     = %s', base_size/(11/3)),
+                  sprintf('colour  = %s', plotcolour),
                   'fontface = "bold"',
                   sprintf('data = dplyr::tibble(panel = factor(%s', paste(deparse(panel.names), collapse = '')),
                   indent(36,
@@ -1259,6 +1266,7 @@ make_forest_plot <- function(
                       makeunit(col.right.pos[[1]])),
               sprintf('hjust = %s', col.right.hjust[[1]]),
               sprintf('size  = %s', base_size/(11/3)),
+              sprintf('colour  = %s', plotcolour),
               'na.rm = TRUE',
               'parse = TRUE')
     )
@@ -1293,6 +1301,7 @@ make_forest_plot <- function(
                   sprintf('move_x = unit(-%s, "%s")', ..2, ..3),
                   sprintf('hjust = %s', ..5),
                   sprintf('size  = %s', base_size/(11/3)),
+                  sprintf('colour  = %s', plotcolour),
                   'na.rm = TRUE'),
           br = FALSE
         ),
@@ -1304,6 +1313,7 @@ make_forest_plot <- function(
           arg = c(sprintf('move_x = unit(-%s, "%s")', ..2, ..3),
                   sprintf('hjust    = %s', ..5),
                   sprintf('size     = %s', base_size/(11/3)),
+                  sprintf('colour  = %s', plotcolour),
                   'fontface = "bold"',
                   sprintf('data = dplyr::tibble(panel = factor(%s', paste(deparse(panel.names), collapse = '')),
                   indent(36,
@@ -1332,6 +1342,7 @@ make_forest_plot <- function(
       arg = c(addarg$xlab,
               'hjust = 0.5',
               sprintf('size  = %s', base_size/(11/3)),
+              sprintf('colour  = %s', plotcolour),
               'vjust = 4.4',
               'fontface = "bold"',
               sprintf('data = dplyr::tibble(panel = factor(%s', paste(deparse(panel.names), collapse = '')),
@@ -1349,6 +1360,7 @@ make_forest_plot <- function(
                 'hjust = 0.5',
                 'nudge_y = 2',
                 sprintf('size  = %s', base_size/(11/3)),
+                sprintf('colour  = %s', plotcolour),
                 'fontface = "bold"',
                 sprintf('data = dplyr::tibble(panel = factor(%s', paste(deparse(panel.names), collapse = '')),
                 indent(36, sprintf('levels = %s', paste(deparse(panel.names), collapse = ''))),
@@ -1374,7 +1386,7 @@ make_forest_plot <- function(
   codetext$theme <- make_layer(
     '# Control the overall look of the plots',
     f = 'theme',
-    arg = c(sprintf('text             = element_text(size = %s)', base_size),
+    arg = c(sprintf('text             = element_text(size = %s, colour = %s)', base_size, plotcolour),
             sprintf('line             = element_line(size = %s)', base_line_size),
             'panel.background = element_blank()',
             'panel.grid.major = element_blank()',
@@ -1384,19 +1396,19 @@ make_forest_plot <- function(
             } else {
               'plot.title.position = "plot"'
             },
-            sprintf('axis.line.x      = element_line(size = %s, lineend = "round")',
-                    base_line_size),
+            sprintf('axis.line.x      = element_line(colour = %s, size = %s, lineend = "round")',
+                    plotcolour, base_line_size),
             'axis.title       = element_blank()',
-            'axis.ticks.x     = element_line(colour = "black")',
-            'axis.text.x      = element_text(colour = "black"',
+            sprintf('axis.ticks.x     = element_line(colour = %s)', plotcolour),
+            sprintf('axis.text.x      = element_text(colour = %s,', plotcolour),
             indent(32,
                    sprintf('margin = margin(t = %s)',base_size/(11/4.4)),
                    'vjust  = 1)'),
             'axis.ticks.y     = element_blank()',
             'axis.line.y      = element_blank()',
             'axis.text.y      = ggtext::element_markdown(hjust  = 0',
             indent(44,
-                   'colour = "black"',
+                   sprintf('colour = %s', plotcolour),
                    sprintf('margin = margin(r = %s, unit = "%s"))',
                            as.numeric(left.space), makeunit(left.space))),
             'panel.border     = element_blank()',
@@ -1421,8 +1433,6 @@ make_forest_plot <- function(
 
   # Create the plot code
   plotcode <- c(
-    codetext$spacing,
-    '',
     'library(ggplot2)',
     '',
     codetext$prep.data,
@@ -1457,7 +1467,7 @@ make_forest_plot <- function(
   }
 
   # Show code in RStudio viewer.
-  if (showcode){ displaycode(plotcode) }
+  if (showcode){ displaycode(plotcode, text_auto_spacing) }
 
 
   # Create plot and print

diff --git a/R/make_shape_plot.R b/R/make_shape_plot.R
@@ -13,9 +13,10 @@
 #' @param col.n Name of column that provides number to be plotted below CIs.
 #' @param col.group Name of column that groups the estimates. (Default: NULL)
 #' @param shape Shape of points. An integer, or name of a column of integers. (Default will use shape 22 - squares with fill.)
-#' @param colour Colour of points. Name of a colour, or name of a column of colour names. (Default will use black.)
-#' @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 black.)
-#' @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 black.)
+#' @param plotcolour Colour for non-data aspects of the plot. (Default: "black")
+#' @param colour Colour of points. Name of a colour, or name of a column of colour names. (Default will use plotcolour)
+#' @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)
+#' @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)
 #' @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.)
 #' @param lines Plot lines (linear fit through estimates, weighted by inverse variance). (Default: FALSE)
 #' @param exponentiate Exponentiate estimates (and CIs) before plotting,
@@ -73,6 +74,7 @@ make_shape_plot <- function(data,
                             pointsize     = 3,
                             col.group     = NULL,
                             shape         = NULL,
+                            plotcolour    = "black",
                             colour        = NULL,
                             cicolour      = colour,
                             fill          = NULL,
@@ -126,9 +128,11 @@ make_shape_plot <- function(data,
     shape <- NULL
   }
 
+  plotcolour <- fixq(plotcolour)
+
   cicolour.aes <- NULL
   if (is.null(cicolour)) {
-    cicolour <- fixq("black")
+    cicolour <- plotcolour
   }
   else if (cicolour %in% names(data)){
     cicolour.aes <- fixsp(cicolour)
@@ -139,7 +143,7 @@ make_shape_plot <- function(data,
 
   colour.aes <- NULL
   if (is.null(colour)) {
-    colour <- fixq("black")
+    colour <- plotcolour
   } else if (colour %in% names(data)){
     colour.aes <- fixsp(colour)
     colour <- NULL
@@ -149,7 +153,7 @@ make_shape_plot <- function(data,
 
   fill.aes <- NULL
   if (is.null(fill)) {
-    fill <- fixq("black")
+    fill <- plotcolour
   } else if (fill %in% names(data)){
     fill.aes <- fixsp(fill)
     fill <- NULL
@@ -266,7 +270,7 @@ make_shape_plot <- function(data,
               'method   = "glm"',
               'formula  = y ~ x',
               'se       = FALSE',
-              'colour   = "black"',
+              sprintf('colour = %s', plotcolour),
               'linetype = "dashed"',
               'size     = 0.25')
     )
@@ -308,7 +312,8 @@ make_shape_plot <- function(data,
             sprintf('label = format(round(%s, 2), nsmall = 2)', est_string)),
     arg = c(addarg$estimates,
             'vjust = -0.8',
-            sprintf('size  = %s', base_size/(11/3)))
+            sprintf('size  = %s', base_size/(11/3)),
+            sprintf('colour = %s', plotcolour))
   )
 
 
@@ -322,7 +327,8 @@ make_shape_plot <- function(data,
               sprintf('label = %s', col.n)),
       arg = c(addarg$n,
               'vjust = 1.8',
-              sprintf('size  = %s', base_size/(11/3)))
+              sprintf('size  = %s', base_size/(11/3)),
+              sprintf('colour = %s', plotcolour))
     )
   }
 
@@ -395,15 +401,16 @@ make_shape_plot <- function(data,
             sprintf('ext            = %s', ext),
             sprintf('ratio          = %s', ratio),
             sprintf('base_size      = %s', base_size),
-            sprintf('base_line_size = %s', base_line_size)),
+            sprintf('base_line_size = %s', base_line_size),
+            sprintf('colour         = %s', plotcolour)),
     plus = TRUE
   )
 
   # Write code for theme
   codetext$theme <- make_layer(
     '# Add theme',
     f = "theme",
-    arg = c(sprintf('legend.position = %s', ds(legend.position))),
+    arg = c(sprintf('legend.position = %s', deparse(legend.position))),
     plus = FALSE
   )
 
@@ -421,8 +428,7 @@ make_shape_plot <- function(data,
            codetext$cis.after,
            codetext$scales,
            codetext$axes,
-           codetext$titles,
-           codetext$theme),
+           codetext$titles),
     codetext$plot.like.ckb,
     indent(2, codetext$theme)
   )