Add vistool_theme to ggplot2

DESCRIPTION

@@ -22,7 +22,7 @@ Imports:
     checkmate,
     colorspace,
     data.table,
-    ggplot2,
+    ggplot2 (>= 4.0.0),
     ggsci,
     htmlwidgets,
     magick,

NAMESPACE

@@ -7,6 +7,7 @@ S3method(as_visualizer,LossFunction)
 S3method(as_visualizer,Objective)
 S3method(as_visualizer,Task)
 S3method(as_visualizer,list)
+S3method(ggplot2::ggplot_add,vistool_theme)
 export(Hypothesis)
 export(LearnerRegrLMFormula)
 export(LossFunction)
@@ -45,6 +46,7 @@ export(step_size_control_decay_linear)
 export(step_size_control_decay_steps)
 export(step_size_control_decay_time)
 export(step_size_control_line_search)
+export(theme_vistool)
 export(vistool_theme)
 import(TestFunctions)
 import(checkmate)

NEWS.md

@@ -2,6 +2,7 @@
 # vistool 0.5.1
 
 * Added `options(vistool.mathjax = c("cdn", "local", "<url>"))` to control how MathJax is sourced for `plotly` widgets.
+* Added `theme_vistool()` as a bridge from `vistool_theme()` to `ggplot2` themes.
 
 # vistool 0.5.0
 

R/Visualizer.R

@@ -1568,7 +1568,8 @@ Visualizer = R6::R6Class("Visualizer",
 
     # Apply theme and styling to ggplot2 object
     apply_ggplot_theme = function(plot_obj, text_size = 11, title_size = NULL, theme = "minimal",
-                                  background = "white", show_grid = TRUE, grid_color = "gray90") {
+                                  background = "white", show_grid = TRUE, grid_color = "gray90",
+                                  palette = NULL) {
       # derive sizes
       if (is.null(title_size)) title_size = text_size + 2
 
@@ -1607,47 +1608,17 @@ Visualizer = R6::R6Class("Visualizer",
         )
       }
 
+      plot_obj = plot_obj + vistool_palette_theme(palette)
+
       return(plot_obj)
     },
 
     # Apply color scales to ggplot2 object
     apply_ggplot_color_scale = function(plot_obj, color_palette = "viridis", scale_type = "fill", discrete = FALSE) {
       if (scale_type == "fill") {
-        if (discrete) {
-          if (color_palette == "viridis") {
-            plot_obj = plot_obj + ggplot2::scale_fill_viridis_d()
-          } else if (color_palette == "plasma") {
-            plot_obj = plot_obj + ggplot2::scale_fill_viridis_d(option = "plasma")
-          } else if (color_palette == "grayscale") {
-            plot_obj = plot_obj + ggplot2::scale_fill_grey()
-          }
-        } else {
-          if (color_palette == "viridis") {
-            plot_obj = plot_obj + ggplot2::scale_fill_viridis_c()
-          } else if (color_palette == "plasma") {
-            plot_obj = plot_obj + ggplot2::scale_fill_viridis_c(option = "plasma")
-          } else if (color_palette == "grayscale") {
-            plot_obj = plot_obj + ggplot2::scale_fill_gradient(low = "black", high = "white")
-          }
-        }
+        plot_obj = plot_obj + if (discrete) ggplot2::scale_fill_discrete() else ggplot2::scale_fill_continuous()
       } else if (scale_type == "color") {
-        if (discrete) {
-          if (color_palette == "viridis") {
-            plot_obj = plot_obj + ggplot2::scale_color_viridis_d()
-          } else if (color_palette == "plasma") {
-            plot_obj = plot_obj + ggplot2::scale_color_viridis_d(option = "plasma")
-          } else if (color_palette == "grayscale") {
-            plot_obj = plot_obj + ggplot2::scale_color_grey()
-          }
-        } else {
-          if (color_palette == "viridis") {
-            plot_obj = plot_obj + ggplot2::scale_color_viridis_c()
-          } else if (color_palette == "plasma") {
-            plot_obj = plot_obj + ggplot2::scale_color_viridis_c(option = "plasma")
-          } else if (color_palette == "grayscale") {
-            plot_obj = plot_obj + ggplot2::scale_color_gradient(low = "black", high = "white")
-          }
-        }
+        plot_obj = plot_obj + if (discrete) ggplot2::scale_color_discrete() else ggplot2::scale_color_continuous()
       }
 
       return(plot_obj)
@@ -1687,7 +1658,10 @@ Visualizer = R6::R6Class("Visualizer",
     gg_apply_labels_limits_theme = function(data_structure, is_2d = FALSE) {
       eff = private$.effective_theme
       rp = private$.render_params
-      private$.plot = private$apply_ggplot_theme(private$.plot, eff$text_size, eff$title_size, eff$theme, eff$background, eff$show_grid, eff$grid_color)
+      private$.plot = private$apply_ggplot_theme(
+        private$.plot, eff$text_size, eff$title_size, eff$theme, eff$background,
+        eff$show_grid, eff$grid_color, eff$palette
+      )
       title_text = if (!is.null(rp$plot_title)) rp$plot_title else data_structure$labels$title
       x_text = if (!is.null(rp$x_lab)) rp$x_lab else data_structure$labels$x1
       y_text = if (!is.null(rp$y_lab)) rp$y_lab else if (is_2d) data_structure$labels$x2 else data_structure$labels$y

R/theme.R

@@ -2,6 +2,8 @@
 #'
 #' @description
 #' Lightweight theme model and helpers to manage plotting style in a single place.
+#' Can be used with vistool visualizers via `set_theme()` or added directly to
+#' ggplot2 plots using the `+` operator.
 #'
 #' @param palette Character. Color palette to use. One of "viridis", "plasma", or "grayscale".
 #' @param text_size Numeric. Base text size for plots.
@@ -16,6 +18,12 @@
 #'
 #' @examples
 #' th = vistool_theme(palette = "plasma", text_size = 12)
+#'
+#' # Use with ggplot2
+#' library(ggplot2)
+#' ggplot(mtcars, aes(x = wt, y = mpg)) +
+#'   geom_point() +
+#'   vistool_theme()
 #' @export
 vistool_theme = function(
   palette = "viridis",
@@ -41,6 +49,7 @@ vistool_theme = function(
     background = background
   )
   assert_vistool_theme(th)
+  class(th) = c("vistool_theme", "list")
   th
 }
 
@@ -88,3 +97,97 @@ set_pkg_theme_default = function(theme) {
   options(vistool.theme = merge_theme(vistool_theme(), theme))
   invisible(TRUE)
 }
+
+#' Build ggplot2 palette theme elements
+#' @keywords internal
+vistool_palette_theme = function(palette) {
+  palette = if (is.null(palette)) "viridis" else palette
+  checkmate::assert_choice(palette, choices = c("viridis", "plasma", "grayscale"))
+
+  discrete_key = paste0("discrete_", palette)
+  discrete_colors = .vistool_colors[[discrete_key]]
+  if (is.null(discrete_colors)) {
+    discrete_colors = .vistool_colors[["discrete"]]
+  }
+
+  scale_def = get_continuous_colorscale(palette)
+  continuous_colors = vapply(scale_def, function(entry) entry[[2]], character(1))
+
+  ggplot2::theme(
+    palette.colour.discrete = discrete_colors,
+    palette.fill.discrete = discrete_colors,
+    palette.colour.continuous = continuous_colors,
+    palette.fill.continuous = continuous_colors
+  )
+}
+
+#' ggplot2 theme matching vistool defaults
+#'
+#' @param theme Optional vistool theme object. Falls back to the active
+#'   `vistool_theme()` (global default) when `NULL`.
+#' @param ... Additional arguments passed to `ggplot2::theme()` to override
+#'   defaults for a specific plot.
+#' @return A [`ggplot2::theme`] object that can be composed via `+` or passed to
+#'   `ggplot2::theme_set()`.
+#' @examples
+#' ggplot2::theme_set(theme_vistool())
+#'
+#' ggplot2::ggplot(mtcars, ggplot2::aes(wt, mpg)) +
+#'   ggplot2::geom_point() +
+#'   theme_vistool(legend.position = "bottom")
+#' @export
+theme_vistool = function(theme = NULL, ...) {
+  if (is.null(theme)) {
+    theme = get_pkg_theme_default()
+  }
+  assert_vistool_theme(theme)
+
+  theme_func = switch(theme$theme,
+    "minimal" = ggplot2::theme_minimal,
+    "bw" = ggplot2::theme_bw,
+    "classic" = ggplot2::theme_classic,
+    "gray" = ggplot2::theme_gray,
+    "grey" = ggplot2::theme_grey,
+    "light" = ggplot2::theme_light,
+    "dark" = ggplot2::theme_dark,
+    "void" = ggplot2::theme_void,
+    ggplot2::theme_minimal
+  )
+
+  base_theme = theme_func(base_size = theme$text_size)
+
+  title_size = theme$text_size + 2
+  additions = ggplot2::theme(
+    plot.title = ggplot2::element_text(size = title_size, hjust = 0.5),
+    plot.background = ggplot2::element_rect(fill = theme$background, color = NA),
+    panel.background = ggplot2::element_rect(fill = theme$background, color = NA),
+    legend.position = theme$legend_position
+  )
+  palette_theme = vistool_palette_theme(theme$palette)
+  extra = ggplot2::theme(...)
+
+  if (!theme$show_grid) {
+    additions = additions + ggplot2::theme(
+      panel.grid.major = ggplot2::element_blank(),
+      panel.grid.minor = ggplot2::element_blank()
+    )
+  } else if (!is.null(theme$grid_color)) {
+    additions = additions + ggplot2::theme(
+      panel.grid.major = ggplot2::element_line(color = theme$grid_color),
+      panel.grid.minor = ggplot2::element_line(color = theme$grid_color, linewidth = 0.5)
+    )
+  }
+
+  base_theme + additions + palette_theme + extra
+}
+
+#' Add vistool theme to ggplot2
+#'
+#' @param object A vistool_theme object.
+#' @param plot A ggplot object.
+#' @param ... Additional arguments (unused).
+#' @keywords internal
+#' @exportS3Method ggplot2::ggplot_add
+ggplot_add.vistool_theme = function(object, plot, ...) {
+  plot + theme_vistool(object)
+}

tests/testthat/test_theme.R

@@ -91,3 +91,32 @@ test_that("merge_theme works correctly", {
   merged_null = merge_theme(base, NULL)
   expect_equal(merged_null, base)
 })
+
+test_that("theme_vistool returns ggplot theme object", {
+  th = theme_vistool()
+  expect_s3_class(th, "theme")
+
+  p = ggplot2::ggplot(mtcars, ggplot2::aes(wt, mpg)) +
+    ggplot2::geom_point() +
+    theme_vistool()
+
+  expect_s3_class(p, "ggplot")
+})
+
+test_that("theme_vistool supports ggplot2 overrides via dots", {
+  th = theme_vistool(legend.position = "bottom")
+  expect_equal(th$legend.position, "bottom")
+})
+
+test_that("theme_vistool sets palette theme elements", {
+  th = theme_vistool(vistool_theme(palette = "plasma"))
+  expect_true(is.character(th$palette.colour.discrete))
+  expect_true(is.character(th$palette.colour.continuous))
+  expect_equal(th$palette.colour.discrete[1], get_vistool_color(1, "discrete", base_palette = "plasma"))
+
+  scale_def = get_continuous_colorscale("plasma")
+  cont_colors = vapply(scale_def, function(entry) entry[[2]], character(1))
+  expect_equal(th$palette.colour.continuous, cont_colors)
+  expect_equal(th$palette.fill.discrete, th$palette.colour.discrete)
+  expect_equal(th$palette.fill.continuous, th$palette.colour.continuous)
+})