diff --git a/DESCRIPTION b/DESCRIPTION index 22e5582..30a67a8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,7 @@ Imports: checkmate, colorspace, data.table, - ggplot2, + ggplot2 (>= 4.0.0), ggsci, htmlwidgets, magick, diff --git a/NAMESPACE b/NAMESPACE index 3254898..6d812e7 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 02aa47c..1473b38 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ # vistool 0.5.1 * Added `options(vistool.mathjax = c("cdn", "local", ""))` 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 diff --git a/R/Visualizer.R b/R/Visualizer.R index 1367aec..9c124ab 100644 --- a/R/Visualizer.R +++ b/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 diff --git a/R/theme.R b/R/theme.R index c130763..7d5779a 100644 --- a/R/theme.R +++ b/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) +} diff --git a/man/ggplot_add.vistool_theme.Rd b/man/ggplot_add.vistool_theme.Rd new file mode 100644 index 0000000..6d0c0b7 --- /dev/null +++ b/man/ggplot_add.vistool_theme.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme.R +\name{ggplot_add.vistool_theme} +\alias{ggplot_add.vistool_theme} +\title{Add vistool theme to ggplot2} +\usage{ +\method{ggplot_add}{vistool_theme}(object, plot, ...) +} +\arguments{ +\item{object}{A vistool_theme object.} + +\item{plot}{A ggplot object.} + +\item{...}{Additional arguments (unused).} +} +\description{ +Add vistool theme to ggplot2 +} +\keyword{internal} diff --git a/man/theme_vistool.Rd b/man/theme_vistool.Rd new file mode 100644 index 0000000..d7c86b5 --- /dev/null +++ b/man/theme_vistool.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme.R +\name{theme_vistool} +\alias{theme_vistool} +\title{ggplot2 theme matching vistool defaults} +\usage{ +theme_vistool(theme = NULL, ...) +} +\arguments{ +\item{theme}{Optional vistool theme object. Falls back to the active +\code{vistool_theme()} (global default) when \code{NULL}.} + +\item{...}{Additional arguments passed to \code{ggplot2::theme()} to override +defaults for a specific plot.} +} +\value{ +A \code{\link[ggplot2:theme]{ggplot2::theme}} object that can be composed via \code{+} or passed to +\code{ggplot2::theme_set()}. +} +\description{ +ggplot2 theme matching vistool defaults +} +\examples{ +ggplot2::theme_set(theme_vistool()) + +ggplot2::ggplot(mtcars, ggplot2::aes(wt, mpg)) + + ggplot2::geom_point() + + theme_vistool(legend.position = "bottom") +} diff --git a/man/vistool_palette_theme.Rd b/man/vistool_palette_theme.Rd new file mode 100644 index 0000000..efbcc6c --- /dev/null +++ b/man/vistool_palette_theme.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme.R +\name{vistool_palette_theme} +\alias{vistool_palette_theme} +\title{Build ggplot2 palette theme elements} +\usage{ +vistool_palette_theme(palette) +} +\description{ +Build ggplot2 palette theme elements +} +\keyword{internal} diff --git a/man/vistool_theme.Rd b/man/vistool_theme.Rd index 34dd109..85c9fc1 100644 --- a/man/vistool_theme.Rd +++ b/man/vistool_theme.Rd @@ -40,7 +40,15 @@ vistool_theme( } \description{ Lightweight theme model and helpers to manage plotting style in a single place. +Can be used with vistool visualizers via \code{set_theme()} or added directly to +ggplot2 plots using the \code{+} operator. } \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() } diff --git a/tests/testthat/test_theme.R b/tests/testthat/test_theme.R index 1aae803..b8121b8 100644 --- a/tests/testthat/test_theme.R +++ b/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) +})