Compatibility with ggplot2 4.0.0

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ggsurvfit
 Title: Flexible Time-to-Event Figures
-Version: 1.1.0.9002
+Version: 1.1.0.9003
 Authors@R: c(
     person("Daniel D.", "Sjoberg", , "danield.sjoberg@gmail.com", role = c("aut", "cre", "cph"),
            comment = c(ORCID = "0000-0003-0862-2018")),
@@ -28,7 +28,7 @@ Imports:
     broom (>= 1.0.0),
     cli (>= 3.0.0),
     dplyr (>= 1.0.3),
-    ggplot2 (>= 3.5.0),
+    ggplot2 (>= 3.5.2.9002),
     glue (>= 1.6.0),
     gtable,
     patchwork (>= 1.1.0),
@@ -47,6 +47,7 @@ Suggests:
     withr
 VignetteBuilder: 
     knitr
+Remotes: tidyverse/ggplot2
 Config/Needs/website: cowplot, ggeasy, gghighlight
 Config/testthat/edition: 3
 Encoding: UTF-8

NEWS.md

@@ -8,7 +8,7 @@
 
 * Correcting an argument name partial match in `ggplot2::scale_*(labels)`. (#211, @DanChaltiel)
 
-
+* Updates to account for changes in ggplot2 v4.0.0. (#241)
 
 # ggsurvfit 1.1.0
 

R/add_censor_mark.R

@@ -25,7 +25,7 @@ add_censor_mark <- function(...) {
 }
 
 #' @export
-ggplot_add.add_censor_mark <- function (object, plot, object_name) {
+ggplot_add.add_censor_mark <- function (object, plot, ...) {
   update_add_censor_mark(plot, object)
 }
 

R/add_confidence_interval.R

@@ -31,7 +31,7 @@ add_confidence_interval <- function(type = c("ribbon", "lines"), ...) {
 }
 
 #' @export
-ggplot_add.add_confidence_interval <- function (object, plot, object_name) {
+ggplot_add.add_confidence_interval <- function (object, plot, ...) {
   update_add_confidence_interval(plot, object)
 }
 

R/add_legend_title.R

@@ -2,7 +2,7 @@
 #'
 #' Add a default or custom title to the figure legend.
 #'
-#' @param title a string to override the default legend title. Default is `NULL`
+#' @param title a string to override the default legend title. Default is NULL
 #'
 #' @return a ggplot2 figure
 #' @export
@@ -19,7 +19,7 @@ add_legend_title <- function(title = NULL) {
 }
 
 #' @export
-ggplot_add.add_legend_title <- function (object, plot, object_name) {
+ggplot_add.add_legend_title <- function (object, plot, object_name, ...) {
   update_add_legend_title(plot, object)
 }
 
@@ -35,15 +35,36 @@ update_add_legend_title <- function(p, add_legend_title_empty_list) {
   lst_labs <- list()
   p_build <- suppressWarnings(ggplot2::ggplot_build(p))
 
-  # if colour or fill present add the title for those aes()
-  if ("colour" %in% names(p_build$plot$labels)) {
+  # Get aesthetics that are actually mapped to variables
+  mapped_aes <- c()
+
+  # Check main plot mapping for aesthetics mapped to actual variables
+  for (aes_name in names(p$mapping)) {
+    if (aes_name != "is_ggsurvfit") {  # Exclude internal ggsurvfit aesthetic
+      mapped_aes <- c(mapped_aes, aes_name)
+    }
+  }
+
+  # Check layer mappings for aesthetics mapped to actual variables
+  for (layer in p$layers) {
+    for (aes_name in names(layer$mapping)) {
+      if (aes_name != "is_ggsurvfit") {  # Exclude internal ggsurvfit aesthetic
+        mapped_aes <- c(mapped_aes, aes_name)
+      }
+    }
+  }
+
+  mapped_aes <- unique(mapped_aes)
+
+  # Only set labels for aesthetics that are actually mapped
+  if ("colour" %in% mapped_aes) {
     lst_labs[["colour"]] <- legend_title
   }
-  if ("fill" %in% names(p_build$plot$labels)) {
+  if ("fill" %in% mapped_aes) {
     lst_labs[["fill"]] <- legend_title
   }
   # if there is a linetype aes() AND it's not from ggcuminc() with multiple outcomes, add title
-  if ("linetype" %in% names(p_build$plot$labels) && (!inherits(p, "ggcuminc") || !length(unique(p$data$outcome)) > 1L)) {
+  if ("linetype" %in% mapped_aes && (!inherits(p, "ggcuminc") || !length(unique(p$data$outcome)) > 1L)) {
     lst_labs[["linetype"]] <- legend_title
   }
 

R/add_pvalue.R

@@ -52,7 +52,7 @@ add_pvalue <- function(location = c("caption", "annotation"),
 }
 
 #' @export
-ggplot_add.add_pvalue <- function (object, plot, object_name) {
+ggplot_add.add_pvalue <- function (object, plot, ...) {
   update_add_pvalue(plot, object)
 }
 

R/add_quantile.R

@@ -37,7 +37,7 @@ add_quantile <- function(y_value = NULL, x_value = NULL, ...) {
 }
 
 #' @export
-ggplot_add.add_quantile <- function (object, plot, object_name) {
+ggplot_add.add_quantile <- function (object, plot, ...) {
   update_add_quantile(plot, object)
 }
 

R/add_risktable.R

@@ -138,7 +138,7 @@ add_risktable <- function(times = NULL,
 }
 
 #' @export
-ggplot_add.add_risktable <- function (object, plot, object_name) {
+ggplot_add.add_risktable <- function (object, plot, ...) {
   update_add_risktable(plot, object)
 }
 

R/add_risktable_strata_symbol.R

@@ -40,7 +40,7 @@ add_risktable_strata_symbol <- function(symbol = NULL, size = 15, face = "bold",
 }
 
 #' @export
-ggplot_add.add_risktable_strata_symbol <- function (object, plot, object_name) {
+ggplot_add.add_risktable_strata_symbol <- function (object, plot, ...) {
   update_add_risktable_strata_symbol(plot, object)
 }
 
@@ -102,32 +102,7 @@ update_add_risktable_strata_symbol <- function(p, add_risktable_strata_symbol_em
     ),
     ggplot2::theme(
       axis.text.y.left =
-        element_text2(color = rev(color_block_mapping), ...)
+        ggplot2::element_text(color = rev(color_block_mapping), ...)
     )
   )
 }
-
-# taken from SO https://stackoverflow.com/questions/73293798
-element_text2 <- function(..., color = NULL) {
-  # Explicitly don't pass colour
-  # Note: user can still pass `colour`, but I'm not here to write perfect code,
-  # just to give a working example
-  elem <- ggplot2::element_text(...)
-  elem$colour <- color # Assign after element is constructed
-  class(elem) <- c("element_text2", "element_text", "element") # Re-class
-  elem
-}
-
-# these lines were not getting hit on code covereage so i comment them out and it still works :)
-# # S3 Method for your custom class' drawing code
-# element_grob.element_text2 <- function(element, label = "", ...,
-#                                        colour = NULL) {
-#   # Repeat colour to match length of label, if colour exists
-#   if (length(colour)) {
-#     colour <- rep_len(colour, length(label))
-#   }
-#   # Re-class to old class
-#   class(element) <- c("element_text", "element")
-#   # Call element_grob.element_text method
-#   ggplot2::element_grob(element, label = label, ..., colour = colour)
-# }

R/scale_ggsurvfit.R

@@ -55,7 +55,7 @@ scale_ggsurvfit <- function(x_scales = list(), y_scales = list()){
 
 
 #' @export
-ggplot_add.scale_ggsurvfit <- function (object, plot, object_name) {
+ggplot_add.scale_ggsurvfit <- function (object, plot, ...) {
   update_scale_ggsurvfit(plot, object)
 }