Update of g_lineplot to have line type, error bar width, and avoid empty levels in

NEWS.md

@@ -1,7 +1,11 @@
 # tern 0.9.5.9002
+### Enhancements
+* Added `errorbar_width` and `linetype` parameters to `g_lineplot`.
 
 ### Bug Fixes
 * Fixed a bug in `a_surv_time` that threw an error when split only has `"is_event"`.
+* Empty levels on `g_lineplot` x-axis are not shown in either plots.
+* Fixed disappearing line in `g_lineplot` when using only one group or strata level.
 
 # tern 0.9.5
 

R/g_lineplot.R

@@ -69,7 +69,9 @@
 #'   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.
 #' @param newpage `r lifecycle::badge("deprecated")` not used.
-#' @param col (`character`)\cr color(s).
+#' @param col (`character`)\cr color(s). See `?ggplot2::aes_colour_fill_alpha` for example values.
+#' @param linetype (`character`)\cr line type(s). See `?ggplot2::aes_linetype_size_shape` for example values.
+#' @param errorbar_width (`numeric(1)`)\cr width of the error bars.
 #'
 #' @return A `ggplot` line plot (and statistics table if applicable).
 #'
@@ -158,15 +160,19 @@ g_lineplot <- function(df,
                        table_format = get_formats_from_stats(table),
                        table_labels = get_labels_from_stats(table),
                        table_font_size = 3,
+                       errorbar_width = 0.45,
                        newpage = lifecycle::deprecated(),
-                       col = NULL) {
+                       col = NULL,
+                       linetype = NULL) {
   checkmate::assert_character(variables, any.missing = TRUE)
   checkmate::assert_character(mid, null.ok = TRUE)
   checkmate::assert_character(interval, null.ok = TRUE)
   checkmate::assert_character(col, null.ok = TRUE)
+  checkmate::assert_character(linetype, null.ok = TRUE)
   checkmate::assert_numeric(xticks, null.ok = TRUE)
   checkmate::assert_numeric(xlim, finite = TRUE, any.missing = FALSE, len = 2, sorted = TRUE, null.ok = TRUE)
   checkmate::assert_numeric(ylim, finite = TRUE, any.missing = FALSE, len = 2, sorted = TRUE, null.ok = TRUE)
+  checkmate::assert_number(errorbar_width, lower = 0)
   checkmate::assert_string(title, null.ok = TRUE)
   checkmate::assert_string(subtitle, null.ok = TRUE)
 
@@ -224,13 +230,19 @@ g_lineplot <- function(df,
   ####################################### |
   # ---- Compute required statistics ----
   ####################################### |
+  # Remove unused levels for x-axis
+  if (is.factor(df[[x]])) {
+    df[[x]] <- droplevels(df[[x]])
+  }
+
   if (!is.null(facet_var) && !is.null(group_var)) {
     df_grp <- tidyr::expand(df, .data[[facet_var]], .data[[group_var]], .data[[x]]) # expand based on levels of factors
   } else if (!is.null(group_var)) {
     df_grp <- tidyr::expand(df, .data[[group_var]], .data[[x]]) # expand based on levels of factors
   } else {
     df_grp <- tidyr::expand(df, NULL, .data[[x]])
   }
+
   df_grp <- df_grp %>%
     dplyr::full_join(y = df[, c(facet_var, group_var, x, y)], by = c(facet_var, group_var, x), multiple = "all") %>%
     dplyr::group_by_at(c(facet_var, group_var, x))
@@ -331,10 +343,8 @@ g_lineplot <- function(df,
       p <- p + ggplot2::geom_point(position = position, size = mid_point_size, na.rm = TRUE)
     }
 
-    # lines
-    # further conditions in if are to ensure that not all of the groups consist of only one observation
-    if (grepl("l", mid_type, fixed = TRUE) && !is.null(group_var) &&
-      !all(dplyr::summarise(df_grp, count_n = dplyr::n())[["count_n"]] == 1L)) { # nolint
+    # lines - plotted only if there is a strata grouping (group_var)
+    if (grepl("l", mid_type, fixed = TRUE) && !is.null(strata_N)) { # nolint
       p <- p + ggplot2::geom_line(position = position, na.rm = TRUE)
     }
   }
@@ -344,7 +354,7 @@ g_lineplot <- function(df,
     p <- p +
       ggplot2::geom_errorbar(
         ggplot2::aes(ymin = .data[[whiskers[1]]], ymax = .data[[whiskers[max(1, length(whiskers))]]]),
-        width = 0.45,
+        width = errorbar_width,
         position = position
       )
 
@@ -383,6 +393,10 @@ g_lineplot <- function(df,
     p <- p +
       ggplot2::scale_color_manual(values = col)
   }
+  if (!is.null(linetype)) {
+    p <- p +
+      ggplot2::scale_linetype_manual(values = linetype)
+  }
 
   if (!is.null(facet_var)) {
     p <- p +

tests/testthat/test-g_lineplot.R

@@ -142,3 +142,94 @@ testthat::test_that("control_lineplot_vars works", {
   # Deprecation warnings work
   lifecycle::expect_deprecated(lifecycle::expect_deprecated(control_lineplot_vars(strata = NA, cohort_id = NA)))
 })
+
+testthat::test_that("g_lineplot works with no strata (group_var) and allows points when only one strata is provided", {
+  adlb2 <- adlb |>
+    dplyr::filter(USUBJID == "AB12345-BRA-1-id-105")
+
+  adsl2 <- adsl |>
+    dplyr::filter(USUBJID == "AB12345-BRA-1-id-105")
+
+  g_lineplot_no_strata <- withr::with_options(
+    opts_partial_match_old,
+    g_lineplot(
+      adlb2,
+      adsl2,
+      variables = control_lineplot_vars(group_var = NULL)
+    )
+  )
+  testthat::expect_false( # no group variable
+    any(
+      vapply(
+        g_lineplot_no_strata$layers, function(x) {
+          any(grepl(class(x$geom), pattern = "line", ignore.case = TRUE))
+        },
+        logical(1L)
+      )
+    )
+  )
+  g_lineplot_strata <- withr::with_options(
+    opts_partial_match_old,
+    g_lineplot(
+      adlb2
+    )
+  )
+  testthat::expect_true(
+    any(
+      vapply(
+        g_lineplot_strata$layers, function(x) {
+          any(grepl(class(x$geom), pattern = "line", ignore.case = TRUE))
+        },
+        logical(1L)
+      )
+    )
+  )
+  g_lineplot_single_strata <- withr::with_options(
+    opts_partial_match_old,
+    g_lineplot(
+      adlb2,
+      adsl2
+    )
+  )
+  testthat::expect_true( # only one group variable
+    any(
+      vapply(
+        g_lineplot_single_strata$layers, function(x) {
+          any(grepl(class(x$geom), pattern = "line", ignore.case = TRUE))
+        },
+        logical(1L)
+      )
+    )
+  )
+})
+
+testthat::test_that("linetype works as well as col with manual scaling and other options (errorbar_width)", {
+  # Regression test issues #1235 #1236 #1081
+  g_lineplot_linetype <- testthat::expect_silent(
+    withr::with_options(
+      opts_partial_match_old,
+      g_lineplot(
+        adlb,
+        adsl,
+        variables = control_lineplot_vars(group_var = "ARM"),
+        col = c("blue", "black", "blue"),
+        linetype = c("dashed", "solid", "dashed"), # Visual testing necessary here
+        errorbar_width = 1.6 # Visual testing necessary here
+      )
+    )
+  )
+})
+
+testthat::test_that("NA values are removed also from the table plot", {
+  # Regression test issues teal.modules.clinical#1197
+  levels(adlb$AVISIT) <- c(levels(adlb$AVISIT), "Not present")
+  g_lineplot_linetype <- testthat::expect_silent(
+    withr::with_options(
+      opts_partial_match_old,
+      g_lineplot(
+        adlb,
+        table = "n" # Visual testing necessary here
+      )
+    )
+  )
+})