set default theme for all plots

NAMESPACE

@@ -388,7 +388,6 @@ export(stack_freeh)
 export(stack_freev)
 export(stack_layout)
 export(stack_switch)
-export(theme_ggalign)
 export(theme_no_axes)
 export(unit)
 export(with_quad)
@@ -408,6 +407,7 @@ importFrom(ggplot2,element_grob)
 importFrom(ggplot2,element_line)
 importFrom(ggplot2,element_rect)
 importFrom(ggplot2,element_render)
+importFrom(ggplot2,element_text)
 importFrom(ggplot2,find_panel)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,ggplotGrob)
@@ -418,6 +418,7 @@ importFrom(ggplot2,ggproto_parent)
 importFrom(ggplot2,margin)
 importFrom(ggplot2,merge_element)
 importFrom(ggplot2,register_theme_elements)
+importFrom(ggplot2,rel)
 importFrom(ggplot2,resolution)
 importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_classic)

R/align-.R

@@ -86,9 +86,7 @@ align <- function(align, data, params = list(), plot = NULL,
     data <- allow_lambda(data)
     assert_bool(facet, call = call)
     assert_bool(limits, call = call)
-    schemes <- schemes %|w|% new_schemes(
-        new_scheme_data(if (is.waive(data)) waiver() else NULL)
-    )
+    schemes <- schemes %|w|% default_schemes(data)
 
     # Warn about extra params or missing parameters ---------------
     all <- align$parameters()

R/align-dendrogram.R

@@ -123,7 +123,7 @@ align_dendro <- function(mapping = aes(), ...,
         plot_data = plot_data, theme = theme,
         no_axes = no_axes, active = active,
         size = size,
-        schemes = new_schemes(),
+        schemes = default_schemes(th = theme_no_panel()),
         data = data,
         plot = ggplot(mapping = mapping)
     )

R/align-gg.R

@@ -113,7 +113,7 @@ align_gg <- function(data = waiver(), mapping = aes(), size = NULL,
     align(AlignGg,
         plot = ggplot(mapping = mapping),
         size = size, data = data,
-        schemes = waiver(),
+        schemes = default_schemes(data, th = theme_no_panel()),
         free_guides = free_guides,
         free_labs = free_labs, free_spaces = free_spaces,
         plot_data = plot_data, theme = theme,

R/align-hclust.R

@@ -79,7 +79,7 @@ align_hclust <- function(distance = "euclidean",
             merge_dendro = FALSE
         ),
         active = active,
-        schemes = new_schemes(),
+        schemes = default_schemes(),
         data = data,
         plot = NULL
     )

R/align-link.R

@@ -74,7 +74,7 @@ align_line <- function(data = waiver(), mapping = aes(),
         plot = ggplot(mapping = mapping),
         size = size, data = data,
         params = list(lines = lines, position = position),
-        schemes = new_schemes(),
+        schemes = default_schemes(th = theme_add_panel()),
         active = active
     )
 }
@@ -343,10 +343,7 @@ AlignLinkProto <- ggproto("AlignLinkProto", AlignGg,
         params
     },
     setup_plot = function(self, plot, layout_data, layout_coords, layout_name) {
-        ggadd_default(plot, theme = theme(
-            panel.border = element_rect(fill = NA, colour = "grey20"),
-            panel.background = element_rect(fill = "white", colour = NA)
-        ))
+        plot
     },
 
     #' @importFrom stats reorder

R/align-range.R

@@ -22,7 +22,7 @@ align_range <- function(data = waiver(), mapping = aes(),
         plot = ggplot(mapping = mapping),
         size = size, data = data,
         params = list(ranges = ranges, position = position),
-        schemes = new_schemes(),
+        schemes = default_schemes(th = theme_add_panel()),
         active = active
     )
 }

R/cross-gg.R

@@ -40,6 +40,7 @@ cross_gg <- function(mapping = aes(), size = NULL,
     cross(
         cross = CrossGg,
         plot = ggplot(mapping = mapping),
+        schemes = default_schemes(th = theme_no_panel()),
         size = size, no_axes = no_axes, active = active
     )
 }

R/ggplot-theme.R

@@ -1,56 +1,42 @@
-#' Theme for Layout Plots
-#'
-#' Default theme for `r rd_layout()`.
-#'
-#' @details
-#' You can change the default theme using the option
-#' `r code_quote(sprintf("%s.default_theme", pkg_nm()))`. This option should be
-#' set to a function that returns a [`theme()`][ggplot2::theme] object.
-#'
-#' @inheritDotParams ggplot2::theme_classic
-#' @return A [`theme()`][ggplot2::theme] object.
-#' @examples
-#' # Setting a new default theme
-#' old <- options(ggalign.default_theme = function() theme_bw())
-#'
-#' # Creating a heatmap with the new theme
-#' ggheatmap(matrix(rnorm(81), nrow = 9)) +
-#'     anno_top() +
-#'     align_dendro(k = 3L)
-#'
-#' # Restoring the old default theme
-#' options(old)
 #' @importFrom ggplot2 theme_classic
-#' @export
-theme_ggalign <- function(...) {
-    theme_classic(...) +
-        theme(
-            axis.line = element_blank(),
-            strip.text = element_blank(),
-            strip.background = element_blank(),
-            plot.background = element_blank()
-        )
+default_theme <- function() theme_classic()
+
+#' @importFrom ggplot2 rel element_line element_rect element_text
+theme_add_panel <- function(base_size = 11) {
+    half_line <- base_size / 2
+    theme(
+        panel.border = element_rect(fill = NA, colour = "grey20"),
+        panel.grid = element_line(colour = "grey92"),
+        panel.grid.minor = element_line(linewidth = rel(0.5)),
+        panel.background = element_rect(fill = "white", colour = NA),
+        strip.background = element_rect(
+            fill = "white", colour = "black", linewidth = rel(2)
+        ),
+        strip.clip = "inherit",
+        strip.text = element_text(
+            colour = "grey10", size = rel(0.8),
+            margin = margin(
+                0.8 * half_line, 0.8 * half_line,
+                0.8 * half_line, 0.8 * half_line
+            )
+        ),
+        strip.text.x = NULL,
+        strip.text.y = element_text(angle = -90),
+        strip.text.y.left = element_text(angle = 90)
+    )
 }
 
-default_theme <- function() {
-    opt <- sprintf("%s.default_theme", pkg_nm())
-    if (is.null(ans <- getOption(opt, default = NULL))) {
-        return(theme_ggalign())
-    }
-    if (is.function(ans <- allow_lambda(ans))) {
-        if (!inherits(ans <- rlang::exec(ans), "theme")) {
-            cli_abort(c(
-                "{.arg {opt}} must return a {.fn theme} object",
-                i = "You have provided {.obj_type_friendly {ans}}"
-            ))
-        }
-    } else {
-        cli_abort(c(
-            "{.arg {opt}} must be a {.cls function}",
-            i = "You have provided {.obj_type_friendly {ans}}"
-        ))
-    }
-    ans
+#' @importFrom ggplot2 element_blank
+theme_no_panel <- function(...) {
+    theme(
+        panel.border = element_blank(),
+        panel.grid.major = element_blank(),
+        panel.grid.minor = element_blank(),
+        axis.line = element_blank(),
+        strip.text = element_blank(),
+        strip.background = element_blank(),
+        plot.background = element_blank()
+    )
 }
 
 #' Remove axis elements

R/layout-quad-.R

@@ -299,8 +299,9 @@ new_quad_layout <- function(name, data, horizontal, vertical,
     # since `QuadLayout` must have data, and won't be waiver()
     # if inherit from the parent layout data, we'll inherit
     # the action data function
-    schemes <- new_schemes(
-        new_scheme_data(if (is.null(data)) waiver() else NULL)
+    schemes <- default_schemes(
+        if (is.null(data)) waiver() else NULL,
+        th = theme_no_panel()
     )
 
     # check arguments -----------------------------------
@@ -317,7 +318,7 @@ new_quad_layout <- function(name, data, horizontal, vertical,
         plot_active = update_active(active, new_active(use = TRUE)),
         name = name,
         # used by the main body
-        body_schemes = new_schemes(new_scheme_data(waiver())),
+        body_schemes = default_schemes(waiver()),
         # following parameters can be controlled by `quad_switch`
         width = width, height = height,
         # following parameters are used internally

R/layout-quad-add.R

@@ -129,9 +129,7 @@ quad_layout_add.quad_anno <- function(object, quad, object_name) {
                 # the layout parameters should be the same with `quad_layout()`
                 layout = layout_coords,
                 # we'll inherit the action data function when
-                schemes = new_schemes(
-                    scheme_data(if (is.null(data)) NULL else waiver())
-                )
+                schemes = default_schemes(if (is.null(data)) NULL else waiver())
             )
             stack@heatmap$position <- position
         }

R/layout-stack-.R

@@ -98,7 +98,7 @@ stack_align.default <- function(data = NULL, direction = NULL, ...,
     # from matrix
     data <- data %|w|% NULL
     data <- fortify_matrix(data = data, ...)
-    schemes <- new_schemes()
+    schemes <- default_schemes()
     if (!is.null(data) && !is.function(data)) {
         # if we have provided data, we initialize the `nobs`
         nobs <- vec_size(data)
@@ -149,7 +149,7 @@ stack_free.default <- function(data = NULL, direction = NULL, ...,
                                theme = NULL, sizes = NA) {
     data <- data %|w|% NULL
     data <- fortify_data_frame(data = data, ...)
-    schemes <- new_schemes()
+    schemes <- default_schemes()
     new_stack_layout(
         data = data, direction = direction, layout = NULL,
         schemes = schemes, theme = theme, sizes = sizes

R/plot-.R

@@ -67,7 +67,7 @@ new_ggalign_plot <- function(..., plot = NULL, active = NULL, size = NULL,
     new(
         class,
         ...,
-        schemes = schemes %||% new_schemes(),
+        schemes = schemes %||% default_schemes(),
         plot = plot,
         active = active,
         size = size

R/plot-free-gg.R

@@ -70,9 +70,7 @@ new_free_gg <- function(plot, data, size, active,
     new_free_plot(
         plot = plot, data = data,
         size = size, active = active,
-        schemes = new_schemes(
-            new_scheme_data(if (is.waive(data)) waiver() else NULL)
-        ),
+        schemes = default_schemes(data),
         class = "ggalign_free_gg",
         call = call
     )

R/scheme-.R

@@ -26,6 +26,15 @@ ggalign_scheme_name <- function(x) {
     attr(x, "__ggalign.scheme_name__", exact = TRUE)
 }
 
+#' @importFrom ggplot2 theme
+default_schemes <- function(data = NULL, th = theme()) {
+    if (!is.waive(data)) data <- NULL
+    new_schemes(
+        new_scheme_data(data),
+        new_scheme_theme(th)
+    )
+}
+
 ###############################################################
 #' Used to update global data
 #' @noRd

_pkgdown.yml

@@ -127,7 +127,6 @@ reference:
   - geom_draw
   - scale_draw_manual
   - draw_key_draw
-  - theme_ggalign
   - element_polygon
 
 - title: helpers