fix: fixed the bug for the wrapping finally

NEWS.md

@@ -16,6 +16,7 @@
 * Fixed bug for linear scaling factor (`scale` parameter) being applied to response but not to rate in `h_glm_count` while all distributions have logarithmic link function.
 * Fixed bug in `decorate_grob` that did not handle well empty strings or `NULL` values for title and footers.
 * Fixed bug in `g_km` that caused an error when multiple records in the data had estimates at max time.
+* Fixed issue with wrong wrapping due to different `\n` and vector behavior that did not cope well with `split_string()`.
 
 ### Miscellaneous
 * Began deprecation of the confusing functions `summary_formats` and `summary_labels`.

R/decorate_grob.R

@@ -306,7 +306,7 @@ split_text_grob <- function(text,
                             name = NULL,
                             gp = grid::gpar(),
                             vp = NULL) {
-  text <- paste0(text, collapse = "\n") # necessary for c("", "a a")
+  text <- gsub("\\\\n", "\n", text) # fixing cases of mixed behavior (\n and \\n)
 
   if (!grid::is.unit(x)) x <- grid::unit(x, default.units)
   if (!grid::is.unit(y)) y <- grid::unit(y, default.units)
@@ -316,8 +316,16 @@ split_text_grob <- function(text,
   if (grid::unitType(width) %in% c("sum", "min", "max")) width <- grid::convertUnit(width, default.units)
 
   if (length(gp) > 0) { # account for effect of gp on text width -> it was bugging when text was empty
-    width <- width * grid::convertWidth(grid::grobWidth(grid::textGrob(text)), "npc", valueOnly = TRUE) /
-      grid::convertWidth(grid::grobWidth(grid::textGrob(text, gp = gp)), "npc", valueOnly = TRUE)
+    horizontal_npc_width_no_gp <- grid::convertWidth(
+      grid::grobWidth(
+        grid::textGrob(
+          paste0(text, collapse = "\n"))), "npc", valueOnly = TRUE)
+    horizontal_npc_width_with_gp <- grid::convertWidth(grid::grobWidth(
+      grid::textGrob(
+        paste0(text, collapse = "\n"), gp = gp)), "npc", valueOnly = TRUE)
+
+    # Adapting width to the input gpar (it is normalized so does not matter what is text)
+    width <- width * horizontal_npc_width_no_gp / horizontal_npc_width_with_gp
   }
 
   ## if it is a fixed unit then we do not need to recalculate when viewport resized
@@ -326,8 +334,17 @@ split_text_grob <- function(text,
     attr(text, "fixed_text") <- paste(vapply(text, split_string, character(1), width = width), collapse = "\n")
   }
 
+  # Fix for split_string in case of residual \n (otherwise is counted as character)
+  text2 <- unlist(
+    strsplit(
+      paste0(text, collapse = "\n"), # for "" cases
+      "\n"
+    )
+  )
+
+  # Final grid text with cat-friendly split_string
   grid::grid.text(
-    label = split_string(text, width),
+    label = split_string(text2, width),
     x = x, y = y,
     just = just,
     hjust = hjust,

R/utils_rtables.R

@@ -48,7 +48,7 @@ to_string_matrix <- function(x, widths = NULL, max_width = NULL,
 
   # Producing the matrix to test
   if (with_spaces) {
-    out <- strsplit(toString(tx, widths = widths, tf_wrap = tf_wrap, max_width = max_width, hsep = hsep), "\\n")[[1]]
+    out <- strsplit(toString(tx, widths = widths, tf_wrap = tf_wrap, max_width = max_width, hsep = hsep), "\n")[[1]]
   } else {
     out <- tx$strings
   }

tests/testthat/test-decorate_grob.R

@@ -142,3 +142,25 @@ testthat::test_that("Edge cases work for titles and footers in split_text_grob",
     split_text_grob(c("", "a a"))
   )
 })
+
+testthat::test_that("Wrapping works consistently", {
+  g <- ggplot2::ggplot(iris) +
+    ggplot2::geom_point(aes(x = Sepal.Length, y = Sepal.Width))
+
+  titles <- paste(
+    rep("issues come in long pairs", 10),
+    collapse = " "
+  )
+  subtitles <- c("something\nwith\\n", "", "and such")
+  out <- split_text_grob(c(titles, subtitles),  x = 0, y = 1,
+                         just = c("left", "top"),
+                         width = grid::unit(11.63, "inches") - grid::unit(1.5, "cm"),
+                         vp = grid::viewport(layout.pos.row = 1, layout.pos.col = 1),
+                         gp = grid::gpar()
+                         )
+
+  expect_equal(
+    nchar(strsplit(out$label, "\n")[[1]]),
+    c(149, 109, 9, 4, 0, 0, 8)
+  )
+})