version 0.2.1

DESCRIPTION

@@ -1,18 +1,18 @@
 Package: utile.visuals
 Title: Create Visuals for Publication
-Version: 0.2.0
+Version: 0.2.1
 Authors@R: c(person('Eric', 'Finnesgard', email = 'finnesgard.eric@mayo.edu', role = c('aut', 'cre')))
 Description: A small set of functions for making visuals for publication in 'ggplot2'. Key functions include geom_stepconfint() for drawing a step confidence interval on a Kaplan-Meier curve and theme_white()/theme_black() which are minimalist 'ggplot2' themes with transparent backgrounds.
 License: LGPL (>= 2)
 Encoding: UTF-8
 LazyData: TRUE
 Depends: R (>= 3.4.0)
-Imports: ggplot2, purrr, utile.tools (>= 0.2.0), gridExtra
+Imports: ggplot2, purrr, utile.tools (>= 0.2.0), gridExtra, dplyr
 Suggests: survival, broom, grid
 RoxygenNote: 6.1.1
 NeedsCompilation: no
-Packaged: 2019-07-11 02:26:07 UTC; m130239
+Packaged: 2019-09-20 14:48:14 UTC; m130239
 Author: Eric Finnesgard [aut, cre]
 Maintainer: Eric Finnesgard <finnesgard.eric@mayo.edu>
 Repository: CRAN
-Date/Publication: 2019-07-11 04:22:59 UTC
+Date/Publication: 2019-09-20 15:10:02 UTC

MD5

@@ -1,14 +1,16 @@
-0374acb944fc7039e631ae29c0c424e0 *DESCRIPTION
-f942bf723d0e40fff5ba6225eeefbe2a *NAMESPACE
-81277c986bc5eb272e126c138fd94ef2 *NEWS.md
-9ceb70de873e5b391f5f151c707ec356 *R/append.R
+e6a3f484fc0ee3240dff97bf8efe3798 *DESCRIPTION
+41f88c1f58d0008d2930873366f4af4c *NAMESPACE
+de979e4570c9ab378d0c89602504beec *NEWS.md
+4eddc50505f36b1c8cbf6fe203866867 *R/append.R
+a330db441e636b4cf7adca52290348ba *R/connect.R
 67d6a7d934ebb182e8ff54752a5631d2 *R/geoms.R
-7572c243158d36f947dad5c0346c3154 *R/gg.R
-1ce9d03000d6d5af9a57dcbd527731ab *R/themes.R
-c682f2e17207cb5f27cdc29fa12730d7 *README.md
-05f4f1da912a6e6e26664ec413f224ad *man/append_table.Rd
+72c81dc34dd9f21c6164c3691beb8187 *R/gg.R
+2b29859bd8603e51a55328fd666de1bd *R/themes.R
+e110996bbf2254f5248c71cc377a2e5f *README.md
+674af1e01f380845d2d22cf37473174c *man/append_table.Rd
+f978f089572f529a8b89ad3549d8dda2 *man/connect_origin.Rd
 2bebde8bffb81f5e6f22d3c367a0380c *man/geom_stepconfint.Rd
-a92862e989ce2a7951299daecbc1e778 *man/ggrisktable.Rd
+d865a6bceb1d36ff251ad19a5d7fa867 *man/ggrisktable.Rd
 0b952005bf45718a01a314d2243a6103 *man/theme_black.Rd
 b7f6ac38b887063a2bec681120e378fe *man/theme_risk_black.Rd
 b9cf1047afc2f5534900fff09e71b1e4 *man/theme_risk_white.Rd

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(append_table)
+export(connect_origin)
 export(geom_stepconfint)
 export(ggrisktable)
 export(theme_black)

NEWS.md

@@ -1,3 +1,10 @@
+# utile.visuals 0.2.1
+* `append_table()`: Legend extraction can now be toggled with the new `extract.legend` option. Extraction may not be a desired behavior if the legend is already embedded within plot area.
+* `ggrisktable()`:
+  - New option `strata.order` added to allow reordering of strata in final table.
+  - Now includes hard stops for invalid option data.
+* Added `connect_origin` for connecting KM curves to a plot origin.
+
 # utile.visuals 0.2.0
 * Added `ggrisktable()` for creating a ggplot2 risk table from a survival::survfit() model.
 * Added `theme_risk_black()` and `theme_risk_white()` for risk table formatting.

R/append.R

@@ -11,10 +11,14 @@
 #' to 0.1.
 #' @param plot.width Optional. Numeric. Width of plot relative to legend. Ignored
 #' if no legend present in plot. Defaults to 1.
+#' @param extract.legend Optional. Logical. Indicates whether to extract the legend
+#' from the plot and reinsert it adjacent to the final combined plot. May be undesired
+#' if legend already embedded within the plot area. Defaults to TRUE.
 #' @param legend.width Optional. Numeric. Width of legend relative to plot. Ignored
-#' if no legend present in plot. Defaults 0.2.
+#' if no legend present in plot or 'extract.legend'=FALSE. Defaults 0.2.
 #' @param legend.offset Optional. Numeric. Vertical offset of legend. Used to raise
-#' or lower. Ignored if no legend present in plot. Defaults to -15.
+#' or lower. Ignored if no legend present in plot or 'extract.legend'=FALSE. Defaults
+#' to -15.
 #' @return A ggplot2 tableGrob object. Use grid::grid.draw() to open in RStudio viewer.
 #' Works with ggplot2::ggsave() out of the box.
 #' @note To ensure proper alignment, double check that both plots use the same scale
@@ -68,8 +72,8 @@
 #' @export
 append_table <- function(
   plot = NULL, table = NULL, plot.height = 1,
-  table.height = 0.1, plot.width = 1, legend.width = 0.2,
-  legend.offset = -15
+  table.height = 0.1, plot.width = 1, extract.legend = TRUE,
+  legend.width = 0.2, legend.offset = -15
 ) {
 
   # Hard stops
@@ -79,19 +83,27 @@ append_table <- function(
     stop('Both plot and table heights must be specified. Check \'plot.height\', \'table.height\'.')
 
   # Convert plots to grobs
-  grob_plot <- ggplot2::ggplotGrob(plot + ggplot2::theme(legend.margin = ggplot2::margin(legend.offset, 0, 0, 0, unit = 'mm')))
+  if (extract.legend) plot <- plot +
+      ggplot2::theme(
+        legend.margin = ggplot2::margin(legend.offset, 0, 0, 0, unit = 'mm'),
+        legend.justification = NULL,
+        legend.position = NULL
+      )
+  grob_plot <- ggplot2::ggplotGrob(plot)
   grob_tbl <- ggplot2::ggplotGrob(table + ggplot2::theme(legend.position = 'none')) # drop table legend
 
   # Extract legend, if present
-  legend_row <- which(purrr::map_chr(grob_plot$grobs, ~ .x$name) == 'guide-box')
-  if (length(legend_row) > 0) {
+  if (extract.legend) {
+    legend_row <- which(purrr::map_chr(grob_plot$grobs, ~ .x$name) == 'guide-box')
+    if (length(legend_row) > 0) {
 
-    # Hard stop
-    if (!is.numeric(plot.width) | !is.numeric(legend.width))
-      stop('Widths for both plot & legend required. Check [\'legend.width\', \'plot.width\'].')
+      # Hard stop
+      if (!is.numeric(plot.width) | !is.numeric(legend.width))
+        stop('Widths for both plot & legend required. Check [\'legend.width\', \'plot.width\'].')
 
-    grob_legend <- grob_plot$grobs[[legend_row]]
-    grob_plot <- ggplot2::ggplotGrob(plot + ggplot2::theme(legend.position = 'none'))
+      grob_legend <- grob_plot$grobs[[legend_row]]
+      grob_plot <- ggplot2::ggplotGrob(plot + ggplot2::theme(legend.position = 'none'))
+    }
   }
 
   # Combine plot grobs
@@ -105,7 +117,7 @@ append_table <- function(
   grob_combined$heights[panels[2]] <- ggplot2::unit(table.height, "null") # Set table height
 
   # Return new arrangement
-  if (!is.null(grob_legend))
+  if (extract.legend & exists('grob_legend'))
     gridExtra::arrangeGrob(
       grob_combined,
       grob_legend,

R/connect.R

@@ -0,0 +1,34 @@
+utils::globalVariables(c('strata', 'n.risk'))
+
+#' @title Connect tidy'd survival::survfit data to the origin of a plot
+#' @description Occasionally when tidy'd survfit data is graphed in ggplot2::geom_step(),
+#' the KM curve will not connect with the origin of the plot. This tool appends data
+#' connecting the lines to the origin.
+#' @param data Required. tibble::tibble() object. survival::survfit data that has been
+#' tidy'd with broom::tidy().
+#' @return A tibble containing the original data with appended points that connect the
+#' curve with to the plot origin.
+#' @note Adapted from an unexported function called .connect2origin() in the survminer
+#' package created by Alboukadel Kassambara.
+#' @examples
+#' library(survival)
+#' library(broom) # tidy() model data
+#'
+#' # Data with group names specified
+#' data_diabetic <- diabetic
+#' data_diabetic$trt <- as.factor(data_diabetic$trt)
+#' levels(data_diabetic$trt) <- c('None', 'Laser')
+#'
+#' # Survival Model
+#' fit <- survfit(Surv(time, status) ~ trt, data = data_diabetic)
+#' fit_data <- tidy(fit)
+#'
+#' connect_origin(fit_data)
+#' @export
+connect_origin <- function (data) {
+  if ('n.risk' %in% colnames(data)) data <- dplyr::arrange(.data = data, dplyr::desc(n.risk))
+  origin <- dplyr::distinct(.data = data, strata, .keep_all = TRUE)
+  origin[intersect(c('time', 'n.censor', 'std.error', "n.event"), colnames(origin))] <- 0
+  origin[c('estimate', 'conf.high', 'conf.low')] <- 1.0
+  dplyr::bind_rows(origin, data)
+}

R/gg.R

@@ -7,18 +7,43 @@ utils::globalVariables(c('time', 'strata', 'n.risk'))
 #' @param fit Required. survival::survfit() object.
 #' @param times Required. Numeric. One or more time points to calculate
 #' the number at risk for.
+#' @param strata.order Optional. Character. Ordered names of strata factor
+#' levels.
 #' @return An unformatted ggplot2 table showing the number at risk.
 #' @examples
 #' library(survival)
 #'
 #' fit <- survfit(Surv(time, status) ~ trt, data = diabetic)
 #'
-#' ggrisktable(fit, c(0, 10, 20, 30, 40, 50)) +
-#'   theme_risk_black()
+#' ggrisktable(
+#'    fit = fit,
+#'    times = c(0, 10, 20, 30, 40, 50),
+#'    strata.order = c('0', '1')
+#' ) + theme_risk_black()
 #' @export
-ggrisktable <- function (fit, times) {
+ggrisktable <- function (fit = NULL, times = NULL, strata.order = NULL) {
+
+  # Hard stops
+  if (is.null(fit) | class(fit) != 'survfit') stop('No valid fit object provided. [Check: \'fit\']')
+  if (is.null(times) | !is.numeric(times)) stop('No valid time points provided. [Check: \'times\']')
+  if (!is.null(strata.order) & !is.character(strata.order)) stop('Invalid strata order data provided. [Check: \'strata.order\']')
+
+  # Generate risk table and order
+  risk_table <- utile.tools::tabulate_at_risk(fit, times)
+
+  # Reorder strata
+  if (is.character(strata.order))
+    risk_table$strata <- factor(
+      risk_table$strata,
+      levels = unique(c(
+        rev(strata.order[strata.order %in% levels(risk_table$strata)]),
+        levels(risk_table$strata)
+      ))
+    )
+
+  # Return plotted table
   ggplot2::ggplot(
-    utile.tools::tabulate_at_risk(fit, times),
+    risk_table,
     ggplot2::aes(x = time, y = strata, label = n.risk)
   ) + ggplot2::geom_text()
 }

R/themes.R

@@ -32,6 +32,7 @@ theme_white <- function(
       axis.title.y = ggplot2::element_text(margin = ggplot2::unit(c(0, 4, 0, 0), "mm")),
       axis.text = ggplot2::element_text(color = 'white'),
       legend.title = ggplot2::element_text(color = 'white', face = 'bold'),
+      legend.title.align = 0,
       legend.text = ggplot2::element_text(color = 'white'),
       legend.background = ggplot2::element_blank(),
       legend.key = ggplot2::element_blank(),
@@ -79,6 +80,7 @@ theme_black <- function(
       axis.title.y = ggplot2::element_text(angle = 90, margin = ggplot2::unit(c(0, 4, 0, 0), "mm")),
       axis.text = ggplot2::element_text(color = 'black'),
       legend.title = ggplot2::element_text(color = 'black', face = 'bold'),
+      legend.title.align = 0,
       legend.text = ggplot2::element_text(color = 'black'),
       legend.background = ggplot2::element_blank(),
       legend.key = ggplot2::element_blank(),

README.md

@@ -1,21 +1,26 @@
-# The `utile.visuals` package
+# utile.visuals
 [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/utile.visuals)](https://CRAN.R-project.org/package=utile.visuals)
 [![Total Downloads](https://cranlogs.r-pkg.org/badges/grand-total/utile.visuals)](https://CRAN.R-project.org/package=utile.visuals)
 
 ## Overview
-A small set of functions for making visuals for publication in ggplot2. Key functions include geom_stepconfint() for drawing a step confidence interval on a ggplot2 KM curve and theme_white()/theme_black() which are minimalist ggplot2 themes with transparent backgrounds.
+A small set of functions for making visuals for publication in ggplot2. Key functions include `geom_stepconfint()` for drawing a step confidence interval on a ggplot2 KM curve and `theme_white()`/`theme_black()` which are minimalist ggplot2 themes with transparent backgrounds.
 
-## The `gg` Functions
-- **ggrisktable()**: A simple wrapper function which calculates the numbers at risk for a survival model and a given set of time points then creates a ggplot2 table with them.
+## Functions
+### > gg
+- `ggrisktable()`: A simple wrapper function which calculates the numbers at risk for a survival model and a given set of time points then creates a ggplot2 table with them.
 
-## The `geom_` Functions
-- **geom_stepconfint()**: Produces a step function confidence interval for survival curves. Essentially the geom_step() for confidence intervals which ggplot2 elects not to provide.
+### > geom_
+- `geom_stepconfint()`: Produces a step function confidence interval for survival curves. Essentially the `ggplot2::geom_step()` for confidence intervals which ggplot2 elects not to provide.
 
-## The `theme_` Functions:
-- **theme_white()**: A ggplot2 theme which removes most background elements and makes all text/lines white.
-- **theme_black()**: A ggplot2 theme which removes most background elements and makes all text/lines black.
-- **theme_risk_white()**: Minimalist ggplot2 theme which removes most background elements and makes all text/lines white.
-- **theme_risk_black()**: Minimalist ggplot2 theme which removes most background elements and makes all text/lines black.
+### > theme_
+- `theme_white()`: A ggplot2 theme which removes most background elements and makes all text/lines white.
+- `theme_black()`: A ggplot2 theme which removes most background elements and makes all text/lines black.
+- `theme_risk_white()`: Minimalist ggplot2 theme which removes most background elements and makes all text/lines white.
+- `theme_risk_black()`: Minimalist ggplot2 theme which removes most background elements and makes all text/lines black.
+
+### > append_
+- `append_table()`: Aligns axes and combines a ggplot2 plot and table into a single plot. Can handle legends.
+
+### > connect_
+- `connect_origin()`: Connects tidy'd survival::survfit data to the origin of a plot.
 
-## The `append_table` Functions
-- **append_table()**: Aligns axes and combines a ggplot2 plot and table into a single plot. Can handle legends.