Repository: insightsengineering/tern
Pull request #1421: 1418 [Bug]: g_lineplot doesn't work with a format as a function
Author: login: yurovska
Created: 2025-05-17T10:10:31Z | Merged: 2025-05-20T14:23:02Z

Fixes #1418


Linked issue #1418: [Bug]: g_lineplot doesn't work with a format as a function
### What happened?

The bug is in `tern::h_format_row()`:

```R
library(tern)

x <- list(mean = 0.5, mean_ci = c(0.15, 1.15))

format <- list(
  mean = function (x, ...) {
    ifelse(x < 1, round_fmt(x, digits = 2), round_fmt(x, digits = 1))
  },
  mean_ci = "(xx.xx, xx.xx)"
)

formatted_row <- h_format_row(x, format)
print(formatted_row)
```

```
Error in if (is.na(fc)) { : argument is of length zero
```
<br/>

![Image](https://github.com/user-attachments/assets/457f85b0-e6f7-44f7-a9ad-014209b9b9f6)


### sessionInfo()

```R

```

### Relevant log output

```R

```

### Code of Conduct

- [x] I agree to follow this project's Code of Conduct.

### Contribution Guidelines

- [x] I agree to follow this project's Contribution Guidelines.

### Security Policy

- [x] I agree to follow this project's Security Policy.
Linked issue comments: user: login: Melkiades
created_at: 2025-05-12T08:33:49Z
body: Nice spotting!! Thank you for finding this and the nice desc. If you can propose a PR, I will be assisting you in merging it asap :)
author_association: CONTRIBUTOR

Diff:
diff --git a/NEWS.md b/NEWS.md
index 0d03e47a84..279c5373bd 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,9 @@
 # tern 0.9.8.9001
 
+### Bug Fixes
+* Fixed bug in `g_lineplot()` where `table_format` and `table_labels` arguments were ignored.
+* Fixed bug in `g_lineplot()` not being able to take a function as a format for table stats.
+
 # tern 0.9.8
 
 ### Enhancements
diff --git a/R/g_lineplot.R b/R/g_lineplot.R
index 59c0e23fa7..692890e62e 100644
--- a/R/g_lineplot.R
+++ b/R/g_lineplot.R
@@ -62,9 +62,10 @@
 #' @param subtitle_add_unit (`flag`)\cr whether the y-axis unit, i.e. `unique(df[[variables["y_unit"]]])` should be
 #'   added to the plot's subtitle (`subtitle`).
 #' @param caption (`string`)\cr optional caption below the plot.
-#' @param table_format (named `character` or `NULL`)\cr format patterns for descriptive statistics used in the
-#'   (optional) table appended to the plot. It is passed directly to the `h_format_row` function through the `format`
-#'   parameter. Names of `table_format` must match the names of statistics returned by `sfun` function.
+#' @param table_format (named `vector` or `NULL`)\cr custom formats for descriptive statistics used instead of defaults
+#'   in the (optional) table appended to the plot. It is passed directly to the `h_format_row` function through
+#'   the `format` parameter. Names of `table_format` must match the names of statistics returned by `sfun` function.
+#'   Can be a character vector with values from [formatters::list_valid_format_labels()] or custom format functions.
 #' @param table_labels (named `character` or `NULL`)\cr labels for descriptive statistics used in the (optional) table
 #'   appended to the plot. Names of `table_labels` must match the names of statistics returned by `sfun` function.
 #' @param table_font_size (`numeric(1)`)\cr font size of the text in the table.
@@ -129,6 +130,23 @@
 #'   title = "Plot of Mean and 80% Confidence Limits by Visit"
 #' )
 #'
+#' # Mean with CI, table with customized formats/labels
+#' g_lineplot(
+#'   adlb,
+#'   adsl,
+#'   table = c("n", "mean", "mean_ci"),
+#'   table_format = list(
+#'     mean = function(x, ...) {
+#'       ifelse(x < 20, round_fmt(x, digits = 3), round_fmt(x, digits = 2))
+#'     },
+#'     mean_ci = "(xx.xxx, xx.xxx)"
+#'   ),
+#'   table_labels = list(
+#'     mean = "mean",
+#'     mean_ci = "95% CI"
+#'   )
+#' )
+#'
 #' # Mean with CI, table, filtered data
 #' adlb_f <- dplyr::filter(adlb, ARMCD != "ARM A" | AVISIT == "BASELINE")
 #' g_lineplot(adlb_f, table = c("n", "mean"))
@@ -185,8 +203,8 @@ g_lineplot <- function(df,
   checkmate::assert_logical(as_list)
 
   if (!is.null(table)) {
-    table_format <- get_formats_from_stats(table)
-    table_labels <- get_labels_from_stats(table) %>% .unlist_keep_nulls()
+    table_format <- get_formats_from_stats(table, formats_in = table_format)
+    table_labels <- get_labels_from_stats(table, labels_in = table_labels) %>% .unlist_keep_nulls()
   }
 
   extra_args <- list(...)
@@ -538,7 +556,7 @@ g_lineplot <- function(df,
 h_format_row <- function(x, format, labels = NULL) {
   # cell: one row, one column data.frame
   format_cell <- function(x, format, label = NULL) {
-    fc <- format_rcell(x = x, format = unlist(format))
+    fc <- format_rcell(x = x, format = format)
     if (is.na(fc)) {
       fc <- "NA"
     }
@@ -556,7 +574,7 @@ h_format_row <- function(x, format, labels = NULL) {
   row <- do.call(
     cbind,
     lapply(
-      names(x), function(xn) format_cell(x[[xn]], format = format[xn], label = labels[xn])
+      names(x), function(xn) format_cell(x[[xn]], format = format[[xn]], label = labels[xn])
     )
   )
 
diff --git a/man/g_lineplot.Rd b/man/g_lineplot.Rd
index 4d1f8d84d3..4b387c71fd 100644
--- a/man/g_lineplot.Rd
+++ b/man/g_lineplot.Rd
@@ -135,9 +135,10 @@ added to the plot's subtitle (\code{subtitle}).}
 
 \item{caption}{(\code{string})\cr optional caption below the plot.}
 
-\item{table_format}{(named \code{character} or \code{NULL})\cr format patterns for descriptive statistics used in the
-(optional) table appended to the plot. It is passed directly to the \code{h_format_row} function through the \code{format}
-parameter. Names of \code{table_format} must match the names of statistics returned by \code{sfun} function.}
+\item{table_format}{(named \code{vector} or \code{NULL})\cr custom formats for descriptive statistics used instead of defaults
+in the (optional) table appended to the plot. It is passed directly to the \code{h_format_row} function through
+the \code{format} parameter. Names of \code{table_format} must match the names of statistics returned by \code{sfun} function.
+Can be a character vector with values from \code{\link[formatters:list_formats]{formatters::list_valid_format_labels()}} or custom format functions.}
 
 \item{table_labels}{(named \code{character} or \code{NULL})\cr labels for descriptive statistics used in the (optional) table
 appended to the plot. Names of \code{table_labels} must match the names of statistics returned by \code{sfun} function.}
@@ -216,6 +217,23 @@ g_lineplot(
   title = "Plot of Mean and 80\% Confidence Limits by Visit"
 )
 
+# Mean with CI, table with customized formats/labels
+g_lineplot(
+  adlb,
+  adsl,
+  table = c("n", "mean", "mean_ci"),
+  table_format = list(
+    mean = function(x, ...) {
+      ifelse(x < 20, round_fmt(x, digits = 3), round_fmt(x, digits = 2))
+    },
+    mean_ci = "(xx.xxx, xx.xxx)"
+  ),
+  table_labels = list(
+    mean = "mean",
+    mean_ci = "95\% CI"
+  )
+)
+
 # Mean with CI, table, filtered data
 adlb_f <- dplyr::filter(adlb, ARMCD != "ARM A" | AVISIT == "BASELINE")
 g_lineplot(adlb_f, table = c("n", "mean"))
diff --git a/tests/testthat/test-g_lineplot.R b/tests/testthat/test-g_lineplot.R
index 8ca60f1c81..be44fba0e6 100644
--- a/tests/testthat/test-g_lineplot.R
+++ b/tests/testthat/test-g_lineplot.R
@@ -249,3 +249,26 @@ testthat::test_that("g_lineplot as_list argument works", {
   expect_snapshot_ggplot("g_lineplot_plot_only", g_lineplot_plot_only, width = 10, height = 4)
   expect_snapshot_ggplot("g_lineplot_table_only", g_lineplot_table_only, width = 9, height = 3)
 })
+
+testthat::test_that("g_lineplot works with custom table formats/labels", {
+  testthat::expect_silent(g_lineplot_custom_fmt <- withr::with_options(
+    opts_partial_match_old,
+    g_lineplot(
+      adlb,
+      adsl,
+      table = c("n", "mean", "mean_ci"),
+      table_format = list(
+        mean = function(x, ...) {
+          ifelse(x < 20, round_fmt(x, digits = 3), round_fmt(x, digits = 2))
+        },
+        mean_ci = "(xx.xxx, xx.xxx)"
+      ),
+      table_labels = list(
+        mean = "mean",
+        mean_ci = "95% CI"
+      )
+    )
+  ))
+
+  expect_snapshot_ggplot(title = "g_lineplot_custom_fmt", fig = g_lineplot_custom_fmt, width = 10, height = 8)
+})


Reviews:
user: login: Melkiades
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-05-19T15:06:32Z
user: login: Melkiades
body: It looks very good!! Can I ask you to add into the function reference about the possible `function` input? Thanks! :)
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-05-19T15:08:58Z
user: login: yurovska
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-05-19T20:17:04Z
user: login: yurovska
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-05-19T20:18:48Z
user: login: Melkiades
body: Looks great! Good to go. Thanks for the terrific job :)
state: APPROVED
author_association: CONTRIBUTOR
submitted_at: 2025-05-20T08:47:00Z

Review comments:
diff_hunk: @@ -185,8 +185,8 @@ g_lineplot <- function(df,
   checkmate::assert_logical(as_list)
 
   if (!is.null(table)) {
-    table_format <- get_formats_from_stats(table)
-    table_labels <- get_labels_from_stats(table) %>% .unlist_keep_nulls()
+    table_format <- get_formats_from_stats(table) %>% modifyList(table_format %||% list())
+    table_labels <- get_labels_from_stats(table) %>% modifyList(table_labels %||% list()) %>% .unlist_keep_nulls()
path: R/g_lineplot.R
user: login: Melkiades
body: Could you use the std format input? `tern::get_formats_from_stats(formats_in = )` you can also not force it in a list
created_at: 2025-05-19T15:06:32Z
author_association: CONTRIBUTOR
diff_hunk: @@ -185,8 +185,8 @@ g_lineplot <- function(df,
   checkmate::assert_logical(as_list)
 
   if (!is.null(table)) {
-    table_format <- get_formats_from_stats(table)
-    table_labels <- get_labels_from_stats(table) %>% .unlist_keep_nulls()
+    table_format <- get_formats_from_stats(table) %>% modifyList(table_format %||% list())
+    table_labels <- get_labels_from_stats(table) %>% modifyList(table_labels %||% list()) %>% .unlist_keep_nulls()
path: R/g_lineplot.R
user: login: yurovska
body: Good point, thanks.
created_at: 2025-05-19T20:17:04Z
author_association: CONTRIBUTOR
diff_hunk: @@ -185,8 +185,8 @@ g_lineplot <- function(df,
   checkmate::assert_logical(as_list)
 
   if (!is.null(table)) {
-    table_format <- get_formats_from_stats(table)
-    table_labels <- get_labels_from_stats(table) %>% .unlist_keep_nulls()
+    table_format <- get_formats_from_stats(table) %>% modifyList(table_format %||% list())
+    table_labels <- get_labels_from_stats(table) %>% modifyList(table_labels %||% list()) %>% .unlist_keep_nulls()
path: R/g_lineplot.R
user: login: yurovska
body: Done
created_at: 2025-05-19T20:18:48Z
author_association: CONTRIBUTOR

PR comments:
user: login: yurovska
created_at: 2025-05-17T11:05:34Z
body: @Melkiades I've also fixed `table_format` and `table_labels` args, which were completely ignored in the `g_lineplot`.

Ready for review.
author_association: CONTRIBUTOR
user: login: yurovska
created_at: 2025-05-19T20:39:29Z
body: > It looks very good!! Can I ask you to add into the function reference about the possible `function` input? Thanks! :)

Thanks for your comment. Documentation has been slightly updated.
author_association: CONTRIBUTOR
user: login: yurovska
created_at: 2025-05-20T11:35:16Z
body: > Looks great! Good to go. Thanks for the terrific job :)

@Melkiades Thanks for the review. I do not have permission to merge, so please do so.
author_association: CONTRIBUTOR