Ch stacked labels

DESCRIPTION

@@ -3,12 +3,12 @@ Type: Package
 Title: Create Graphs in the Grattan Institute Style
 Version: 1.1.0
 Authors@R: c(
-    person("Matt", "Cowgill", email = "matthew.cowgill@grattaninstitute.edu.au", 
+    person("Matt", "Cowgill", email = "matthew.cowgill@grattaninstitute.edu.au",
                 role = c("aut")),
     person(given = "Will", family = "Mackey", email = "william.mackey@grattaninstitute.edu.au",
                 role = c("aut", "cre")))
-Description: Enables the user to create ggplot2 charts that conform 
-    to the Grattan Institute style guide. 
+Description: Enables the user to create ggplot2 charts that conform
+    to the Grattan Institute style guide.
 License: MIT + file LICENSE
 Depends: R (>= 3.5.0)
 Imports:

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+export("%>%")
+export(ch_add_stacked_labels)
 export(check_chart_aspect_ratio)
 export(colour_text)
 export(create_fullslide)

NEWS.md

@@ -115,7 +115,7 @@ information about the chart types in the grattantheme package.
 * Bug fixes and improvements to save_chartdata() function
 
 # grattantheme 0.5.1
-* Charts without a subtitle that are saved as "fullslide" or similar will now vertically expand the plot to fill the space of the absent subtitle 
+* Charts without a subtitle that are saved as "fullslide" or similar will now vertically expand the plot to fill the space of the absent subtitle
 * save_chartdata() function added
 * New 'faded' versions of the Grattan palette available
 

R/grattantheme-package.R

@@ -0,0 +1,12 @@
+#' @importFrom rlang %||%
+#' @importFrom rlang :=
+
+
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+## usethis namespace: end
+NULL
+
+

R/legend_helpers.R

@@ -42,3 +42,124 @@ colour_text <- function(colour, text, is_note = FALSE, bold_labs = TRUE) {
 
   return(ret)
 }
+
+
+#' Add stacked labels to the right of a chart
+#'
+#' This function adds \code{\link[ggrepel]{geom_text_repel}} to a chart. It
+#' requires you to specify the label aesthetic in the original ggplot. It also
+#' extends the x-axis by a certain amount (20\% by default) so the labels have
+#' space. Most of the arguments get passed directly to
+#' \code{\link[ggrepel]{geom_label_repel}}. This expansion will combine with any
+#' other expansion present in the plot, such as arguments based to
+#' \code{scale_x_continuous}. It needs to be used with a \code{\%\>\%} and not a
+#' \code{\+}.
+#'
+#' If you get a warning about Aesthetics not being the right length for size,
+#' that's a cryptic message telling you to set the size argument. Setting it to
+#' 3 usually looks alright.
+#'
+#' @param .plot (a \code{ggplot2} object) with the \code{label} aesthetic
+#'   specified.
+#' @param pct_extend (numeric, default = \code{1.2}) how much to expand the
+#'   x-axis. The existing x-axis range will be multiplied by this value, so the
+#'   default expands by 20\%.
+#' @param nudge_x (numeric; default = NULL) how much to nudge by
+#' @param segment.colour (character; default = NA) colour of the line segment,
+#'   NA means no line segment
+#' @param segment.alpha (number; default = 0.5) the transparency of the line
+#'   segment
+#' @param segment.size (number; default = 0.1) the size of the line segment
+#' @param hjust (default = "right") the horizontal justification of the label
+#' @param size (number, default = 3) the size of the text in the label
+#' @param ... other arguments passed to \code{geom_text_repel}
+#' @inheritParams ggrepel::geom_text_repel
+#'
+#' @return a \code{ggplot2} object
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#'  base_plot <- ggplot(ggplot2::txhousing, aes(x = date, y = volume, colour = city, label = city)) +
+#'  geom_line() +
+#'  theme_grattan()
+#'
+#'  base_plot %>%
+#'  ch_add_stacked_labels
+#'
+#' }
+ch_add_stacked_labels <- function(.plot,
+                                  pct_extend = 1.2,
+                                  nudge_x = NULL,
+                                  # nolint start
+                                  segment.colour = NA,
+                                  min.segment.length = 0.1,
+                                  max.overlaps = 20,
+                                  segment.alpha = 0.5,
+                                  segment.size = 0.1,
+                                  # nolint end
+                                  hjust = "right",
+                                  direction = "y",
+                                  size = 3,
+                                  ...) {
+
+  # Extract elements from the plot
+  x <- .plot$mapping$x
+  y <- .plot$mapping$y
+  size_map <- .plot$mapping$size
+  group <- .plot$mapping$group %||% .plot$mapping$colour
+  col <- .plot$mapping$colour
+  labs <- .plot$mapping$label
+
+  # Get x range
+  first_x <- .plot$data %>%
+    dplyr::pull(!!x) %>%
+    min(na.rm = TRUE)
+
+  last_x <- .plot$data %>%
+    dplyr::pull(!!x) %>%
+    max(na.rm = TRUE)
+
+  range_x <- last_x - first_x
+
+  # Artificially push the labels to the right x%
+  new_last <- first_x + (range_x * pct_extend)
+
+
+  # Filter the internal plot data to the max x
+  df_labels <- .plot$data %>%
+    dplyr::select(!!group,
+                  !!col,
+                  !!size_map,
+                  !!x,
+                  !!y,
+                  !!labs) %>%
+    dplyr::group_by(!!group) %>%
+    dplyr::slice_max(!!x) %>%
+    dplyr::ungroup() %>%
+    dplyr::mutate(!!rlang::quo_name(x) := last_x)
+
+  # Create a vector of nudge amounts to push all the values to the extended point
+  # but this doesnt mean they will necessarily stay there
+  nudge <- nudge_x %||% (new_last - dplyr::pull(df_labels, !!x))
+  size_text <- size %||% size_map
+
+  # add the labels
+  .plot +
+    ggrepel::geom_text_repel(
+      data               = df_labels,
+      nudge_x            = as.numeric(nudge),
+      segment.colour = segment.colour,
+      min.segment.length = min.segment.length,
+      max.overlaps       = max.overlaps,
+      segment.alpha      = segment.alpha,
+      segment.size       = segment.size,
+      hjust              = hjust,
+      direction          = direction,
+      size               = size_text,
+      show.legend = FALSE,
+      ...) +
+    # add a blank geom to expand
+    ggplot2::geom_blank(ggplot2::aes(x = new_last))
+
+}

R/utils-pipe.R

@@ -0,0 +1,16 @@
+#' Pipe operator
+#'
+#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details.
+#'
+#' @name %>%
+#' @rdname pipe
+#' @keywords internal
+#' @export
+#' @importFrom magrittr %>%
+#' @usage lhs \%>\% rhs
+#' @param lhs A value or the magrittr placeholder.
+#' @param rhs A function call using the magrittr semantics.
+#' @return The result of calling `rhs(lhs)`.
+NULL
+
+#' @importFrom rlang %||%

tests/testthat/test-ch_add_stacked_labels.R

@@ -0,0 +1,10 @@
+base_plot <- ggplot(ggplot2::txhousing, aes(x = date, y = volume, colour = city, label = city)) +
+  geom_line() +
+  theme_grattan()
+
+p <- base_plot %>%
+  ch_add_stacked_labels()
+
+test_that("plot with ch_add_stacked_labels() is a ggplot2 object",{
+  expect_is(p, "gg")
+})