theme classic

NEWS.md

@@ -9,6 +9,7 @@
   - Restricted `trans` argument to `"identity"`, `"log10"` or "`log`".
 - For `ssd_plot()` function:
   - Added `text_size` argument.
+  - Added `theme_classic = FALSE` argument to switch classic theme.
   - Soft-deprecated `size` argument for `label_size`.
 - Turned off x-axis minor breaks for all plots (for consistency) as HC major break causing multiple minor breaks in `ssd_plot()`.
 

R/params.R

@@ -115,6 +115,7 @@
 #' @param suffix Additional text to display after the number on the y-axis.
 #' @param tails A flag or NULL specifying whether to only include distributions with both tails.
 #' @param text_size A number for the text size. 
+#' @param theme_classic A flag specifying whether to use the classic theme or the default.
 #' @param trans A string of which transformation to use. Accepted values include `"log10"`, `"log"`, and `"identity"` (`"log10"` by default).
 #' @param weight A string of the numeric column in data with positive weights less than or equal to 1,000 or NULL.
 #' @param x The object.

R/ssd-plot.R

@@ -39,14 +39,14 @@ plot_coord_scale <- function(data, xlab, ylab, trans, big.mark, suffix, xbreaks
   list(
     coord_trans(x = trans),
     scale_x_continuous(xlab,
-      breaks = xbreaks,
-      minor_breaks = NULL,
-      labels = ssd_label_fun, 
-      limits = xlimits
+                       breaks = xbreaks,
+                       minor_breaks = NULL,
+                       labels = ssd_label_fun, 
+                       limits = xlimits
     ),
     scale_y_continuous(ylab,
-      labels = label_percent(suffix = suffix), limits = c(0, 1),
-      breaks = seq(0, 1, by = 0.2), expand = c(0, 0)
+                       labels = label_percent(suffix = suffix), limits = c(0, 1),
+                       breaks = seq(0, 1, by = 0.2), expand = c(0, 0)
     )
   )
 }
@@ -70,7 +70,8 @@ ssd_plot <- function(data, pred, left = "Conc", right = left, ...,
                      bounds = c(left = 1, right = 1),
                      big.mark = ",", suffix = "%",
                      trans = "log10", xbreaks = waiver(),
-                     xlimits = NULL, text_size = 11, label_size = 2.5) {
+                     xlimits = NULL, text_size = 11, label_size = 2.5,
+                     theme_classic = FALSE) {
 
   if (lifecycle::is_present(size)) {
     lifecycle::deprecate_soft("2.1.0", "ssd_plot(size)", "ssd_plot(label_size)", id = "size")
@@ -85,20 +86,20 @@ ssd_plot <- function(data, pred, left = "Conc", right = left, ...,
   chk_null_or(linetype, vld = vld_string)
   chk_null_or(linecolor, vld = vld_string)
   check_names(data, c(unique(c(left, right)), label, shape))
-
+  
   check_names(pred, c("proportion", "est", "lcl", "ucl", unique(c(linetype, linecolor))))
   chk_numeric(pred$proportion)
   chk_range(pred$proportion)
   check_data(pred, values = list(est = 1, lcl = c(1, NA), ucl = c(1, NA)))
-
+  
   chk_number(shift_x)
   chk_range(shift_x, c(1, 1000))
   chk_number(add_x)
   chk_range(add_x, c(-1000, 1000))
-
+  
   chk_flag(ci)
   chk_flag(ribbon)
-
+  
   if (!is.null(hc)) {
     chk_vector(hc)
     chk_gt(length(hc))
@@ -111,19 +112,20 @@ ssd_plot <- function(data, pred, left = "Conc", right = left, ...,
   chk_number(text_size)
   chk_null_or(xlimits, vld = vld_numeric)
   chk_null_or(xlimits, vld = vld_length, length = 2L)
-
+  chk_flag(theme_classic)
+
   data <- process_data(data, left, right, weight = NULL)
   data <- bound_data(data, bounds)
   data$y <- ssd_ecd_data(data, "left", "right", bounds = bounds)
-
+  
   label <- if (!is.null(label)) sym(label) else label
   shape <- if (!is.null(shape)) sym(shape) else shape
   color <- if (!is.null(color)) sym(color) else color
   linetype <- if (!is.null(linetype)) sym(linetype) else linetype
   linecolor <- if (!is.null(linecolor)) sym(linecolor) else linecolor
-
+  
   gp <- ggplot(data)
-
+  
   if (ci) {
     if (ribbon) {
       gp <- gp + geom_xribbon(data = pred, aes(xmin = !!sym("lcl"), xmax = !!sym("ucl"), y = !!sym("proportion")), alpha = 0.2)
@@ -133,22 +135,22 @@ ssd_plot <- function(data, pred, left = "Conc", right = left, ...,
         geom_line(data = pred, aes(x = !!sym("ucl"), y = !!sym("proportion")), color = "darkgreen")
     }
   }
-
+  
   if (!is.null(linecolor)) {
     gp <- gp + geom_line(data = pred, aes(x = !!sym("est"), y = !!sym("proportion"), linetype = !!linetype, color = !!linecolor))
   } else if (ribbon) {
     gp <- gp + geom_line(data = pred, aes(x = !!sym("est"), y = !!sym("proportion"), linetype = !!linetype), color = "black")
   } else {
     gp <- gp + geom_line(data = pred, aes(x = !!sym("est"), y = !!sym("proportion"), linetype = !!linetype), color = "red")
   }
-
+  
   if (!is.null(hc)) {
     gp <- gp + geom_hcintersect(
       data = pred[pred$proportion %in% hc, ],
       aes(xintercept = !!sym("est"), yintercept = !!sym("proportion"))
     )
   }
-
+  
   if (!is.null(color)) {
     gp <- gp +
       geom_ssdpoint(data = data, aes(
@@ -181,16 +183,16 @@ ssd_plot <- function(data, pred, left = "Conc", right = left, ...,
         x = !!sym("left"), y = !!sym("y"), xend = !!sym("right"), yend = !!sym("y")
       ), stat = "identity")
   }
-
+  
   hc_value <- NULL
   if(!is.null(hc)){
     hc_value <- pred$est[pred$proportion %in% hc]
   }
   gp <- gp + plot_coord_scale(data,
-    xlab = xlab, ylab = ylab, big.mark = big.mark, suffix = suffix,
-    trans = trans, xbreaks = xbreaks, xlimits = xlimits, hc_value = hc_value
+                              xlab = xlab, ylab = ylab, big.mark = big.mark, suffix = suffix,
+                              trans = trans, xbreaks = xbreaks, xlimits = xlimits, hc_value = hc_value
   )
-
+  
   if (!is.null(label)) {
     data$right <- (data$right + add_x) * shift_x
     gp <- gp + geom_text(
@@ -199,11 +201,15 @@ ssd_plot <- function(data, pred, left = "Conc", right = left, ...,
     )
   }
 
+  if(theme_classic) {
+    gp <- gp + ggplot2::theme_classic()   
+  }
+
   gp <- gp + 
     theme(
       text = element_text(size = text_size),
       axis.text.x = ggtext::element_markdown()
-    ) 
-
+    )   
+  
   gp
 }

tests/testthat/test-ssd-plot.R

@@ -87,4 +87,8 @@ test_that("ssd_plot text_size", {
 
 test_that("ssd_plot label_size", {
   expect_snapshot_plot(ssd_plot(ssddata::ccme_boron, boron_pred, label_size = 5), "boron_labelsize")
-})
+})
+
+test_that("ssd_plot label_size", {
+  expect_snapshot_plot(ssd_plot(ssddata::ccme_boron, boron_pred, label_size = 5, theme_classic = TRUE), "boron_themeclassic")
+})