From a402e0d796b1595ba630e97a6439d8f2debeae2f Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Thu, 18 Jan 2024 15:58:02 +0100
Subject: [PATCH 1/4] extract strata more directly in ggplot2 3.5.0

---
 R/add_highlight.R | 37 +++++++++++++++++++++----------------
 1 file changed, 21 insertions(+), 16 deletions(-)

diff --git a/R/add_highlight.R b/R/add_highlight.R
index 4b03b5e8..7460d382 100644
--- a/R/add_highlight.R
+++ b/R/add_highlight.R
@@ -84,26 +84,31 @@ add_highlight.ggsurvfit <- function(gg = NULL,
 
   # Extract names of strata objects
   gg_gb <- ggplot2::ggplot_build(gg)
-  gg_gtable <- ggplot2::ggplot_gtable(gg_gb)
-  gg_guidebox_id <- base::which(base::sapply(
-    gg_gtable$grobs,
-    function(x) x$name
-  ) == "guide-box")
-  gg_table_grob <- gg_gtable$grobs[[gg_guidebox_id]]$grobs[[1]]
 
-  # Get IDs of elements containing strata labels
-  strata_label_ids <- base::grep("label", gg_table_grob$layout$name)
+  if ("get_guide_data" %in% getNamespaceExports("ggplot2")) {
+    strata_labels <- ggplot2::get_guide_data(gg_gb, "colour")$.label
+  } else {
+    gg_gtable <- ggplot2::ggplot_gtable(gg_gb)
+    gg_guidebox_id <- base::which(base::sapply(
+      gg_gtable$grobs,
+      function(x) x$name
+    ) == "guide-box")
+    gg_table_grob <- gg_gtable$grobs[[gg_guidebox_id]]$grobs[[1]]
 
-  extract_strata_name_by_id <- function(gg_table_grob, id) {
-    label <- gg_table_grob$grobs[[id]]$children[[1]]$children[[1]]$label
+    # Get IDs of elements containing strata labels
+    strata_label_ids <- base::grep("label", gg_table_grob$layout$name)
 
-    return(label)
-  }
+    extract_strata_name_by_id <- function(gg_table_grob, id) {
+      label <- gg_table_grob$grobs[[id]]$children[[1]]$children[[1]]$label
+
+      return(label)
+    }
 
-  strata_labels <- base::sapply(strata_label_ids,
-    extract_strata_name_by_id,
-    gg_table_grob = gg_table_grob
-  )
+    strata_labels <- base::sapply(strata_label_ids,
+                                  extract_strata_name_by_id,
+                                  gg_table_grob = gg_table_grob
+    )
+  }
 
   base::sapply(c(strata), function(s) {
     if (!(s %in% strata_labels)) {

From bfc804683a542700172ed16a9ec9b1f61b8ffa02 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Thu, 18 Jan 2024 15:58:17 +0100
Subject: [PATCH 2/4] update `get_legend_title()` helper

---
 tests/testthat/helper.R | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
index f8ccd161..3ea11c57 100644
--- a/tests/testthat/helper.R
+++ b/tests/testthat/helper.R
@@ -207,6 +207,11 @@ get_legend_title <- function(gg) {
   ggb <- ggplot2::ggplot_build(gg)
   ggt <- ggplot2::ggplot_gtable(ggb)
 
+  if (inherits(ggb$plot$guides, "Guides")) {
+    params <- ggb$plot$guides$get_params(1)
+    return(params$title)
+  }
+
   legend_grob_id <- which(sapply(ggt$grobs, function(x) x$name) == "guide-box")
   legend_grob <- ggt$grobs[[legend_grob_id]]
 

From e23d91723abe781342f31e61638d4127a962394b Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Thu, 18 Jan 2024 15:58:40 +0100
Subject: [PATCH 3/4] skip test on newer ggplot2 version

---
 tests/testthat/test-utils_visR.R | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/tests/testthat/test-utils_visR.R b/tests/testthat/test-utils_visR.R
index 3a62d217..85f1d187 100644
--- a/tests/testthat/test-utils_visR.R
+++ b/tests/testthat/test-utils_visR.R
@@ -92,6 +92,10 @@ testthat::test_that("T1.3 An error when a list containing non-`ggplot` objects i
 testthat::context("utils_visr - T2. `align_plots()` aligns multiple `ggplot` objects, taking the legend into account.")
 
 testthat::test_that("T2.1 Columns are added to the grob-converted plot.", {
+  # From ggplot2 3.5.0 onwards ggplots have stable gtable dimensions with
+  # regards to legend placement
+  skip_if(utils::packageVersion("ggplot2") >= "3.5.0")
+
   gg_sex <- adtte %>%
     visR::estimate_KM("SEX") %>%
     visR::visr()

From edac04699596f7792b3a40ff709b535b85cc62fe Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Thu, 18 Jan 2024 21:52:53 +0100
Subject: [PATCH 4/4] Avoid missing or unexported object error

---
 R/add_highlight.R | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/R/add_highlight.R b/R/add_highlight.R
index 7460d382..771d28d9 100644
--- a/R/add_highlight.R
+++ b/R/add_highlight.R
@@ -86,7 +86,8 @@ add_highlight.ggsurvfit <- function(gg = NULL,
   gg_gb <- ggplot2::ggplot_build(gg)
 
   if ("get_guide_data" %in% getNamespaceExports("ggplot2")) {
-    strata_labels <- ggplot2::get_guide_data(gg_gb, "colour")$.label
+    get_guide_data <- get("get_guide_data", asNamespace("ggplot2"))
+    strata_labels  <- get_guide_data(gg_gb, "colour")$.label
   } else {
     gg_gtable <- ggplot2::ggplot_gtable(gg_gb)
     gg_guidebox_id <- base::which(base::sapply(