Merge pull request #22 from CHOP-CGTInformatics/theme_ggswim

theme_ggswim()

NAMESPACE

@@ -9,6 +9,7 @@ export(build_ggswim)
 export(ggsave)
 export(ggswim)
 export(grid.draw)
+export(theme_ggswim)
 importFrom(checkmate,check_character)
 importFrom(checkmate,check_data_frame)
 importFrom(checkmate,check_integerish)
@@ -23,8 +24,13 @@ importFrom(dplyr,bind_rows)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)
 importFrom(ggplot2,"%+%")
+importFrom(ggplot2,"%+replace%")
 importFrom(ggplot2,aes)
 importFrom(ggplot2,arrow)
+importFrom(ggplot2,element_blank)
+importFrom(ggplot2,element_line)
+importFrom(ggplot2,element_rect)
+importFrom(ggplot2,element_text)
 importFrom(ggplot2,geom_col)
 importFrom(ggplot2,geom_label)
 importFrom(ggplot2,geom_point)
@@ -34,7 +40,10 @@ importFrom(ggplot2,ggsave)
 importFrom(ggplot2,guide_legend)
 importFrom(ggplot2,guides)
 importFrom(ggplot2,layer_data)
+importFrom(ggplot2,margin)
 importFrom(ggplot2,scale_color_manual)
+importFrom(ggplot2,theme)
+importFrom(ggplot2,theme_minimal)
 importFrom(ggplot2,unit)
 importFrom(grid,grid.draw)
 importFrom(rlang,":=")

R/add_marker.R

@@ -59,14 +59,17 @@
 #' @export
 #'
 #' @examples
-#' add_marker(data = adverse_events,
-#'            mapping = aes(x = time_of_event,
-#'                          y = subject_id,
-#'                          color = adverse_event_name,
-#'                          shape = adverse_event_name),
-#'             size = 5)
+#' add_marker(
+#'   data = adverse_events,
+#'   mapping = aes(
+#'     x = time_of_event,
+#'     y = subject_id,
+#'     color = adverse_event_name,
+#'     shape = adverse_event_name
+#'   ),
+#'   size = 5
+#' )
 #'
-
 add_marker <- function(
     data = NULL,
     mapping = aes(),

R/build_ggswim.R

@@ -23,12 +23,15 @@
 #' @export
 #'
 #' @examples
-#' ggswim_obj <- ggswim(data = patient_status,
-#'                      mapping = aes(x = value,
-#'                                    y = subject_id,
-#'                                    fill = cohort))
+#' ggswim_obj <- ggswim(
+#'   data = patient_status,
+#'   mapping = aes(
+#'     x = value,
+#'     y = subject_id,
+#'     fill = cohort
+#'   )
+#' )
 #' build_ggswim(ggswim_obj)
-
 build_ggswim <- function(ggswim_obj) {
   # Set up initial capture variables ----
   # Indices for layer positions in ggswim_obj

R/checks.R

@@ -122,7 +122,6 @@ check_supported_mapping_aes <- function(mapping,
 #' @keywords internal
 
 check_marker_label_aes <- function(mapping) {
-
   msg <- c(
     "!" = "Label mapping detected but no colour aes supplied.",
     "i" = "Label icons may not appear in the legend without a colour aesthetic."
@@ -131,9 +130,11 @@ check_marker_label_aes <- function(mapping) {
 
   if ("label" %in% names(mapping)) {
     if (!any(c("color", "colour") %in% names(mapping))) {
-      cli_warn(message = msg,
-               call = caller_env(),
-               class = cond_class)
+      cli_warn(
+        message = msg,
+        call = caller_env(),
+        class = cond_class
+      )
     }
   }
 }
@@ -153,16 +154,17 @@ check_marker_label_aes <- function(mapping) {
 #' @keywords internal
 
 check_arrow_fill_type <- function(arrow_type, arrow_fill) {
-
   msg <- c(
     "!" = "Arrow fill color supplied for an open arrow type.",
     "i" = "Fill colors will only appear for 'closed' arrows types."
   )
   cond_class <- c("ggswim_cond", "arrow_fill_type")
 
   if (arrow_type != "closed" && !is.null(arrow_fill)) {
-    cli_warn(message = msg,
-             call = caller_env(),
-             class = cond_class)
+    cli_warn(
+      message = msg,
+      call = caller_env(),
+      class = cond_class
+    )
   }
 }

R/ggswim-package.R

@@ -2,6 +2,8 @@
 #' @aliases ggswim-package
 #' @importFrom ggplot2 aes geom_point geom_label layer_data ggplot geom_col
 #'   guides guide_legend scale_color_manual geom_segment arrow unit
+#'   %+replace% theme_minimal theme element_text element_blank margin
+#'   element_line element_rect
 #' @importFrom cli cli_abort cli_vec cli_warn
 #' @importFrom rlang caller_arg caller_env as_label is_atomic get_expr .data
 #'   is_empty := enquo

R/ggswim.R

@@ -41,11 +41,14 @@
 #' @export
 #'
 #' @examples
-#' ggswim(data = patient_status,
-#'        mapping = aes(x = value,
-#'                      y = subject_id,
-#'                      fill = cohort))
-
+#' ggswim(
+#'   data = patient_status,
+#'   mapping = aes(
+#'     x = value,
+#'     y = subject_id,
+#'     fill = cohort
+#'   )
+#' )
 ggswim <- function(
     data,
     mapping = aes(),
@@ -83,14 +86,16 @@ ggswim <- function(
   # Handle arrows ----
   arrow <- enquo(arrow) |> get_expr()
   if (!is.null(arrow)) {
-    out <- add_arrows(data = data,
-                      ggswim_obj = out,
-                      mapping = mapping,
-                      arrow = arrow,
-                      arrow_colour = arrow_colour,
-                      arrow_type = arrow_type,
-                      arrow_fill = arrow_fill,
-                      arrow_length = arrow_length)
+    out <- add_arrows(
+      data = data,
+      ggswim_obj = out,
+      mapping = mapping,
+      arrow = arrow,
+      arrow_colour = arrow_colour,
+      arrow_type = arrow_type,
+      arrow_fill = arrow_fill,
+      arrow_length = arrow_length
+    )
   }
 
   # Return object
@@ -147,13 +152,18 @@ add_arrows <- function(data,
 
   out <- ggswim_obj +
     geom_segment(true_arrow_data,
-                 mapping = aes(x = xend, # nolint: object_usage_linter
-                               y = .data[[mapping$y |> get_expr()]],
-                               yend = .data[[mapping$y |> get_expr()]],
-                               xend = xend + 2), colour = arrow_colour,
-                 arrow = arrow(type = arrow_type,
-                               length = arrow_length),
-                 arrow.fill = arrow_fill)
+      mapping = aes(
+        x = xend, # nolint: object_usage_linter
+        y = .data[[mapping$y |> get_expr()]],
+        yend = .data[[mapping$y |> get_expr()]],
+        xend = xend + 2
+      ), colour = arrow_colour,
+      arrow = arrow(
+        type = arrow_type,
+        length = arrow_length
+      ),
+      arrow.fill = arrow_fill
+    )
 
   current_layer <- length(out$layers) # The max length can be considered the current working layer
 

R/griddraw.R

@@ -13,12 +13,15 @@
 #' @name grid.draw.ggswim_obj
 #'
 #' @examples
-#'   ggswim(data = patient_status,
-#'          mapping = aes(x = value,
-#'                        y = subject_id,
-#'                        fill = cohort)) |>
+#' ggswim(
+#'   data = patient_status,
+#'   mapping = aes(
+#'     x = value,
+#'     y = subject_id,
+#'     fill = cohort
+#'   )
+#' ) |>
 #'   grid.draw()
-
 NULL
 
 

R/patient_data.R

@@ -28,7 +28,6 @@
 #' adverse_events
 #'
 #' medication_administration
-
 "patient_data"
 
 #' @rdname patient_data

R/print.R

@@ -8,10 +8,14 @@
 #' @keywords internal
 #'
 #' @examples
-#'   ggswim(data = patient_status,
-#'          mapping = aes(x = value,
-#'                        y = subject_id,
-#'                        fill = cohort)) |>
+#' ggswim(
+#'   data = patient_status,
+#'   mapping = aes(
+#'     x = value,
+#'     y = subject_id,
+#'     fill = cohort
+#'   )
+#' ) |>
 #'   print()
 NULL
 

R/theme_ggswim.R

@@ -0,0 +1,82 @@
+#' @title ggswim Theme
+#'
+#' @description
+#' An alternative theme for ggswim plots.
+#'
+#' @export
+#'
+#' @examples
+#' ggswim(
+#'   data = patient_status,
+#'   mapping = aes(
+#'     x = value,
+#'     y = subject_id,
+#'     fill = cohort
+#'   )
+#' ) +
+#' theme_ggswim()
+
+theme_ggswim <- function() {
+  font <- "serif"
+
+  theme_minimal() %+replace%
+
+    theme(
+      # Grid Elements ----
+      axis.ticks = element_line(color = "steelblue2", size = 1),
+      panel.grid.major.x = element_line(color = "gray60", size = 0.3),
+      panel.grid.minor.x = element_line(color = "gray80", size = 0.1),
+      panel.grid.major.y = element_line(color = "gray60", size = 0.3),
+      panel.grid.minor.y = element_blank(),
+      axis.line = element_line(
+        color = "steelblue3", size = 1,
+        arrow = arrow(
+          type = "closed",
+          length = unit(0.08, "inches")
+        )
+      ),
+
+
+      # Text Elements ----
+      plot.title = element_text(
+        family = font,
+        size = 16,
+        face = "bold",
+        hjust = .5,
+        vjust = 2
+      ),
+      plot.subtitle = element_text(
+        family = font,
+        size = 12
+      ),
+      plot.caption = element_text(
+        family = font,
+        size = 9,
+        hjust = 1
+      ),
+      axis.title = element_text(
+        face = "bold",
+        family = font,
+        size = 12
+      ),
+      axis.text = element_text(
+        family = font,
+        size = 9
+      ),
+
+      # Legend Elements ----
+      legend.background = element_rect(
+        fill = "white",
+        linewidth = 4,
+        colour = "white"
+      ),
+      legend.text = element_text(
+        family = font
+      ),
+      legend.title = element_text(
+        hjust = 0,
+        family = font,
+        face = "bold"
+      )
+    )
+}

README.Rmd

@@ -65,25 +65,36 @@ Each of these tibbles are also available to call individually. Let's load the da
 ```{r, message=FALSE}
 library(ggswim)
 
-ggswim(data = patient_status,
-       mapping = aes(x = value,
-                     y = subject_id,
-                     fill = cohort)) +
-  add_marker(data = adverse_events,
-             mapping = aes(x = time_of_event,
-                           y = subject_id,
-                           color = adverse_event_name,
-                           shape = adverse_event_name),
-             size = 5) +
-  add_marker(data = medication_administration,
-             mapping = aes(x = time_of_event,
-                           y = subject_id,
-                           label = medication,
-                           color = name),
-             label.size = NA, fill = NA, size = 5) +
+ggswim(
+  data = patient_status,
+  mapping = aes(
+    x = value,
+    y = subject_id,
+    fill = cohort
+  )
+) +
+  add_marker(
+    data = adverse_events,
+    mapping = aes(
+      x = time_of_event,
+      y = subject_id,
+      color = adverse_event_name,
+      shape = adverse_event_name
+    ),
+    size = 5
+  ) +
+  add_marker(
+    data = medication_administration,
+    mapping = aes(
+      x = time_of_event,
+      y = subject_id,
+      label = medication,
+      color = name
+    ),
+    label.size = NA, fill = NA, size = 5
+  ) +
   ggplot2::labs(x = "Time", y = "Subject ID", color = "Markers") +
   ggplot2::ggtitle("My Swim Plot") +
-  ggplot2::theme_minimal() +
   ggplot2::scale_color_manual(
     name = "Markers",
     values = c("firebrick", "forestgreen", NA, NA, "purple")
@@ -95,5 +106,6 @@ ggswim(data = patient_status,
   ggplot2::scale_fill_manual(
     name = "Lanes",
     values = c("steelblue1", "goldenrod1")
-  )
+  ) +
+  theme_ggswim()
 ```