diff --git a/NEWS.md b/NEWS.md index 63d4ee5c43..f1a286f304 100644 --- a/NEWS.md +++ b/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`. diff --git a/R/decorate_grob.R b/R/decorate_grob.R index 9251e3635b..a86eb0e6ef 100644 --- a/R/decorate_grob.R +++ b/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, diff --git a/R/utils_rtables.R b/R/utils_rtables.R index 7d854d8f33..61dd4b5f3e 100644 --- a/R/utils_rtables.R +++ b/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 } diff --git a/tests/testthat/test-decorate_grob.R b/tests/testthat/test-decorate_grob.R index 16b2f224a9..2b958fb37d 100644 --- a/tests/testthat/test-decorate_grob.R +++ b/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) +})