Add inherit.blank argument to element constructors (#1754)

Fixes #1555, #1557, #1565, and #1567

* Add inherit.blank argument to element constructors

* Look for inherit.blank when combining

* Set inherit.blank = TRUE automatically when theme is complete

.gitignore

@@ -4,3 +4,7 @@
 inst/doc
 .httr-oauth
 .*.Rnb.cached
+
+man/.Rapp.history
+
+.DS_Store

NEWS.md

@@ -50,6 +50,9 @@
     I have also very slightly increased the inner margins of axis titles,
     and removed the outer margins. 
 
+* Theme element inheritance is now more easy to work with. Modification now
+  overrides default `element_blank` elements (#1555, #1557, #1565, #1567)
+  
 * Themes are more homogeneous visually, and match `theme_grey` better.
   (@jiho, #1679)
 

R/theme-defaults.r

@@ -76,9 +76,9 @@ theme_grey <- function(base_size = 11, base_family = "") {
                             margin = margin(), debug = FALSE
                          ),
 
-    axis.line =          element_line(),
-    axis.line.x =        element_blank(),
-    axis.line.y =        element_blank(),
+    axis.line =          element_blank(),
+    axis.line.x =        NULL,
+    axis.line.y =        NULL,
     axis.text =          element_text(size = rel(0.8), colour = "grey30"),
     axis.text.x =        element_text(margin = margin(t = 0.8 * half_line / 2), vjust = 1),
     axis.text.x.top =    element_text(margin = margin(b = 0.8 * half_line / 2), vjust = 0),
@@ -185,7 +185,9 @@ theme_bw <- function(base_size = 11, base_family = "") {
       # contour strips to match panel contour
       strip.background = element_rect(fill = "grey85", colour = "grey20"),
       # match legend key to background
-      legend.key       = element_rect(fill = "white", colour=NA)
+      legend.key       = element_rect(fill = "white", colour=NA),
+
+      complete = TRUE
     )
 }
 
@@ -209,7 +211,9 @@ theme_linedraw <- function(base_size = 11, base_family = "") {
 
       # strips with black background and white text
       strip.background = element_rect(fill = "black"),
-      strip.text       = element_text(colour = "white", size = rel(0.8))
+      strip.text       = element_text(colour = "white", size = rel(0.8)),
+
+      complete = TRUE
     )
 }
 
@@ -235,7 +239,9 @@ theme_light <- function(base_size = 11, base_family = "") {
 
       # dark strips with light text (inverse contrast compared to theme_grey)
       strip.background = element_rect(fill = "grey70", colour = NA),
-      strip.text       = element_text(colour = "white", size = rel(0.8))
+      strip.text       = element_text(colour = "white", size = rel(0.8)),
+
+      complete = TRUE
     )
 
 }
@@ -261,7 +267,9 @@ theme_dark <- function(base_size = 11, base_family = "") {
 
       # dark strips with light text (inverse contrast compared to theme_grey)
       strip.background = element_rect(fill = "grey15", colour = NA),
-      strip.text       = element_text(colour = "grey90", size = rel(0.8))
+      strip.text       = element_text(colour = "grey90", size = rel(0.8)),
+
+      complete = TRUE
     )
 }
 
@@ -271,14 +279,15 @@ theme_minimal <- function(base_size = 11, base_family = "") {
   # Starts with theme_bw and remove most parts
   theme_bw(base_size = base_size, base_family = base_family) %+replace%
     theme(
-      axis.ticks.x      = element_blank(),
-      axis.ticks.y      = element_blank(),
+      axis.ticks      = element_blank(),
       legend.background = element_blank(),
       legend.key        = element_blank(),
       panel.background  = element_blank(),
       panel.border      = element_blank(),
       strip.background  = element_blank(),
-      plot.background   = element_blank()
+      plot.background   = element_blank(),
+
+      complete = TRUE
     )
 }
 
@@ -293,15 +302,16 @@ theme_classic <- function(base_size = 11, base_family = ""){
       panel.grid.minor = element_blank(),
 
       # show axes
-      axis.line.x      = element_line(colour = "black", size = 0.5),
-      axis.line.y      = element_line(colour = "black", size = 0.5),
+      axis.line      = element_line(colour = "black", size = 0.5),
 
       # match legend key to panel.background
       legend.key       = element_blank(),
 
       # simple, black and white strips
-      strip.background = element_rect(fill = "white", colour = "black", size = 1)
+      strip.background = element_rect(fill = "white", colour = "black", size = 1),
       # NB: size is 1 but clipped, it looks like the 0.5 of the axes
+
+      complete = TRUE
     )
 }
 
@@ -319,10 +329,8 @@ theme_void <- function(base_size = 11, base_family = "") {
                             lineheight = 0.9, hjust = 0.5, vjust = 0.5, angle = 0,
                             margin = margin(), debug = FALSE
                          ),
-    axis.text.x =        element_blank(),
-    axis.text.y =        element_blank(),
-    axis.title.x =       element_blank(),
-    axis.title.y =       element_blank(),
+    axis.text =        element_blank(),
+    axis.title =       element_blank(),
     legend.text =        element_text(size = rel(0.8)),
     legend.title =       element_text(hjust = 0),
     strip.text =         element_text(size = rel(0.8)),

R/theme-elements.r

@@ -13,6 +13,11 @@
 #' @param fill Fill colour.
 #' @param colour,color Line/border colour. Color is an alias for colour.
 #' @param size Line/border size in mm; text size in pts.
+#' @param inherit.blank Should this element inherit the existence of an
+#' element_blank among its parents? If \code{TRUE} the existence of a blank
+#' element among its parents will cause this element to be blank as well. If
+#' \code{FALSE} any blank parent element will be ignored when calculating final
+#' element state.
 #' @name element
 #' @return An S3 object of class \code{element}.
 #' @examples
@@ -49,11 +54,12 @@ element_blank <- function() {
 #' @export
 #' @rdname element
 element_rect <- function(fill = NULL, colour = NULL, size = NULL,
-  linetype = NULL, color = NULL) {
+  linetype = NULL, color = NULL, inherit.blank = FALSE) {
 
   if (!is.null(color))  colour <- color
   structure(
-    list(fill = fill, colour = colour, size = size, linetype = linetype),
+    list(fill = fill, colour = colour, size = size, linetype = linetype,
+         inherit.blank = inherit.blank),
     class = c("element_rect", "element")
   )
 }
@@ -67,13 +73,13 @@ element_rect <- function(fill = NULL, colour = NULL, size = NULL,
 #' @param lineend Line end Line end style (round, butt, square)
 #' @param arrow Arrow specification, as created by \code{\link[grid]{arrow}}
 element_line <- function(colour = NULL, size = NULL, linetype = NULL,
-  lineend = NULL, color = NULL, arrow = NULL) {
+  lineend = NULL, color = NULL, arrow = NULL, inherit.blank = FALSE) {
 
   if (!is.null(color))  colour <- color
   if (is.null(arrow)) arrow <- FALSE
   structure(
     list(colour = colour, size = size, linetype = linetype, lineend = lineend,
-      arrow = arrow),
+      arrow = arrow, inherit.blank = inherit.blank),
     class = c("element_line", "element")
   )
 }
@@ -95,13 +101,13 @@ element_line <- function(colour = NULL, size = NULL, linetype = NULL,
 #' @rdname element
 element_text <- function(family = NULL, face = NULL, colour = NULL,
   size = NULL, hjust = NULL, vjust = NULL, angle = NULL, lineheight = NULL,
-  color = NULL, margin = NULL, debug = NULL) {
+  color = NULL, margin = NULL, debug = NULL, inherit.blank = FALSE) {
 
   if (!is.null(color))  colour <- color
   structure(
     list(family = family, face = face, colour = colour, size = size,
       hjust = hjust, vjust = vjust, angle = angle, lineheight = lineheight,
-      margin = margin, debug = debug),
+      margin = margin, debug = debug, inherit.blank = inherit.blank),
     class = c("element_text", "element")
   )
 }

R/theme.r

@@ -239,7 +239,9 @@ print.theme <- function(x, ...) utils::str(x)
 #'   existing theme.
 #' @param complete set this to TRUE if this is a complete theme, such as
 #'   the one returned \code{by theme_grey()}. Complete themes behave
-#'   differently when added to a ggplot object.
+#'   differently when added to a ggplot object. Also, when setting
+#'   \code{complete = TRUE} all elements will be set to inherit from blank
+#'   elements.
 #' @param validate TRUE to run validate_element, FALSE to bypass checks.
 #'
 #' @seealso \code{\link{+.gg}}
@@ -423,6 +425,15 @@ theme <- function(..., complete = FALSE, validate = TRUE) {
     mapply(validate_element, elements, names(elements))
   }
 
+  # If complete theme set all non-blank elements to inherit from blanks
+  if (complete) {
+    elements <- lapply(elements, function(el) {
+      if (inherits(el, "element") && !inherits(el, "element_blank")) {
+        el$inherit.blank <- TRUE
+      }
+      el
+    })
+  }
   structure(elements, class = c("theme", "gg"),
             complete = complete, validate = validate)
 }
@@ -641,10 +652,15 @@ calc_element <- function(element, theme, verbose = FALSE) {
 combine_elements <- function(e1, e2) {
 
   # If e2 is NULL, nothing to inherit
-  if (is.null(e2))  return(e1)
-
-  # If e1 is NULL, or if e2 is element_blank, inherit everything from e2
-  if (is.null(e1) || inherits(e2, "element_blank"))  return(e2)
+  if (is.null(e2) || inherits(e1, "element_blank"))  return(e1)
+  # If e1 is NULL inherit everything from e2
+  if (is.null(e1)) return(e2)
+  # If e2 is element_blank, and e1 inherits blank inherit everything from e2,
+  # otherwise ignore e2
+  if (inherits(e2, "element_blank")) {
+    if (e1$inherit.blank) return(e2)
+    else return(e1)
+  }
 
   # If e1 has any NULL properties, inherit them from e2
   n <- vapply(e1[names(e2)], is.null, logical(1))

tests/testthat/test-theme.r

@@ -51,6 +51,8 @@ test_that("Adding theme object to ggplot object with + operator", {
   expect_true(p$theme$text$colour == 'red')
   tt <- theme_grey()$text
   tt$colour <- 'red'
+  expect_true(tt$inherit.blank)
+  tt$inherit.blank <- FALSE
   expect_identical(p$theme$text, tt)
 
 })
@@ -188,3 +190,23 @@ test_that("theme(validate=FALSE) means do not validate_element", {
   red.before <- p + red.text + theme(animint.width = 500, validate = FALSE)
   expect_equal(red.before$theme$animint.width, 500)
 })
+
+test_that("All elements in complete themes have inherit.blank=TRUE", {
+  inherit_blanks <- function(theme) {
+    all(vapply(theme, function(el) {
+      if (inherits(el, "element") && !inherits(el, "element_blank")) {
+        el$inherit.blank
+      } else {
+        TRUE
+      }
+    }, logical(1)))
+  }
+  expect_true(inherit_blanks(theme_grey()))
+  expect_true(inherit_blanks(theme_bw()))
+  expect_true(inherit_blanks(theme_classic()))
+  expect_true(inherit_blanks(theme_dark()))
+  expect_true(inherit_blanks(theme_light()))
+  expect_true(inherit_blanks(theme_linedraw()))
+  expect_true(inherit_blanks(theme_minimal()))
+  expect_true(inherit_blanks(theme_void()))
+})