fix grob wrapping final

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,23 @@ 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 +341,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,62 @@ 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", {
+  # ggplot
+  g <- ggplot2::ggplot(iris) +
+    ggplot2::geom_point(aes(x = Sepal.Length, y = Sepal.Width))
+
+  # decoration text
+  eg_text <- c(
+    paste( # titles
+      rep("issues come in long pairs", 10),
+      collapse = " "
+    ),
+    c( # subtitles
+      "something\nwith\\n", "", "and such"
+    )
+  )
+  # example width (it is default for A4 with 1.5cm margin)
+  eg_width <- grid::unit(11.63, "inches") - grid::unit(1.5, "cm")
+
+  # Main call to text grob split
+  out <- split_text_grob(eg_text,
+    x = 0, y = 1,
+    just = c("left", "top"),
+    width = eg_width,
+    vp = grid::viewport(layout.pos.row = 1, layout.pos.col = 1),
+    gp = grid::gpar()
+  )
+
+  # This is what (roughly w/o font correction from gpar) happens inside the split
+  eg_width <- grid::convertUnit(eg_width, "npc")
+  # Fix for split_string in case of residual \n (otherwise is counted as character)
+  text_fin <- split_string( # copied fnc (NOT formatters')
+    unlist(
+      strsplit(
+        paste0(gsub("\\\\n", "\n", eg_text), collapse = "\n"), # for "" cases
+        "\n"
+      )
+    ),
+    eg_width
+  )
+
+  # number of characters
+  nchar_lab_extracted <- nchar(strsplit(out$label, "\n")[[1]])
+  nchar_lab_test <- nchar(strsplit(text_fin, "\n")[[1]])
+  exp_nchar_lab <- c(144, 114, 9, 4, 0, 0, 8)
+
+  # Force informative error
+  if (!checkmate::check_set_equal(nchar_lab_extracted, exp_nchar_lab)) {
+    stop(
+      "width:", eg_width,
+      "\nnchar_out_label  : ", paste(nchar_lab_extracted, collapse = " "),
+      "\nnchar_label_free : ", paste(nchar_lab_test, collapse = " ")
+    )
+  }
+
+  # Default passing tests
+  testthat::expect_equal(nchar_lab_extracted, nchar_lab_test)
+  testthat::expect_equal(nchar_lab_extracted, exp_nchar_lab)
+})