Enable passing named vector of analysis_decimals to summary.gs_design()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gsDesign2
 Title: Group Sequential Design with Non-Constant Effect
-Version: 1.1.2.7
+Version: 1.1.2.8
 Authors@R: c(
     person("Keaven", "Anderson", email = "[email protected]", role = c("aut")),
     person("Yilong", "Zhang", email = "[email protected]", role = c("aut")),

R/summary.R

@@ -147,6 +147,9 @@ summary.fixed_design <- function(object, ...) {
 #'
 #' @param analysis_vars The variables to be put at the summary header of each analysis.
 #' @param analysis_decimals The displayed number of digits of `analysis_vars`.
+#'   If the vector is unnamed, it must match the length of `analysis_vars`. If
+#'   the vector is named, you only have to specify the number of digits for the
+#'   variables you want to be displayed differently than the defaults.
 #' @param col_vars The variables to be displayed.
 #' @param col_decimals The decimals to be displayed for the displayed variables in `col_vars`.
 #' @param bound_names Names for bounds; default is `c("Efficacy", "Futility")`.
@@ -362,23 +365,54 @@ summary.gs_design <- function(object,
   # get the
   # (1) analysis variables to be displayed on the header
   # (2) decimals to be displayed for the analysis variables in (3)
+  if (method %in% c("ahr", "wlr")) {
+    analysis_vars_default <- c("time", "n", "event", "ahr", "info_frac")
+    analysis_decimals_default <- c(1, 1, 1, 2, 2)
+  }
+  if (method == "combo") {
+    analysis_vars_default <- c("time", "n", "event", "ahr", "event_frac")
+    analysis_decimals_default <- c(1, 1, 1, 2, 2)
+  }
+  if (method == "rd") {
+    analysis_vars_default <- c("n", "rd", "info_frac")
+    analysis_decimals_default <- c(1, 4, 2)
+  }
+
+  # Filter analysis variables and update decimal places
+  names(analysis_decimals_default) <- analysis_vars_default
   if (is.null(analysis_vars) && is.null(analysis_decimals)) {
-    if (method %in% c("ahr", "wlr")) {
-      analysis_vars <- c("time", "n", "event", "ahr", "info_frac")
-      analysis_decimals <- c(1, 1, 1, 2, 2)
-    }
-    if (method == "combo") {
-      analysis_vars <- c("time", "n", "event", "ahr", "event_frac")
-      analysis_decimals <- c(1, 1, 1, 2, 2)
+    # Use default values
+    analysis_vars <- analysis_vars_default
+    analysis_decimals <- analysis_decimals_default
+  } else if (!is.null(analysis_vars) && is.null(analysis_decimals)) {
+    # Only drop/rearrange variables
+    analysis_decimals <- analysis_decimals_default[
+      match(analysis_vars, names(analysis_decimals_default))
+    ]
+  } else if (is.null(analysis_vars) && !is.null(analysis_decimals)) {
+    # Only update decimals - must be named vector
+    if (is.null(names(analysis_decimals))) {
+      stop("summary: analysis_decimals must be a named vector if analysis_vars is not provided")
     }
-    if (method == "rd") {
-      analysis_vars <- c("n", "rd", "info_frac")
-      analysis_decimals <- c(1, 4, 2)
+    analysis_vars <- analysis_vars_default
+    analysis_decimals_tmp <- analysis_decimals_default
+    analysis_decimals_tmp[names(analysis_decimals)] <- analysis_decimals
+    analysis_decimals <- analysis_decimals_tmp
+  } else if (!is.null(analysis_vars) && !is.null(analysis_decimals)) {
+    # Update variables and decimals
+    if (is.null(names(analysis_decimals))) {
+      # vectors must be same length if analysis_decimals is unnamed
+      if (length(analysis_vars) != length(analysis_decimals)) {
+        stop("summary: please input analysis_vars and analysis_decimals in pairs!")
+      }
+    } else {
+      analysis_decimals_tmp <- analysis_decimals_default
+      analysis_decimals_tmp[names(analysis_decimals)] <- analysis_decimals
+      analysis_decimals <- analysis_decimals_tmp
+      analysis_decimals <- analysis_decimals[
+        match(analysis_vars, names(analysis_decimals))
+      ]
     }
-  } else if (is.null(analysis_vars) && !is.null(analysis_decimals)) {
-    stop("summary: please input analysis_vars and analysis_decimals in pairs!")
-  } else if (!is.null(analysis_vars) && is.null(analysis_decimals)) {
-    stop("summary: please input analysis_vars and analysis_decimals in pairs!")
   }
 
   # set the analysis summary header

tests/testthat/helper-developer-summary.R

@@ -0,0 +1,3 @@
+# Helper functions used by test-developer-summary.R
+
+extract_summary_analysis <- function(x) x[["Analysis"]][1]

tests/testthat/test-developer-summary.R

@@ -0,0 +1,123 @@
+# See helper functions in helper-developer-summary.R
+
+# Maintain previous behavior
+test_that("summary.gs_design() accepts same-length vectors for analysis_vars and analysis_decimals", {
+  x <- gs_design_ahr(analysis_time = c(12, 24))
+
+  # default decimals
+  observed <- x |>
+    summary() |>
+    attr("groups") |>
+    extract_summary_analysis()
+  expect_identical(
+    observed,
+    "Analysis: 1 Time: 12 N: 707.3 Event: 160.4 AHR: 0.81 Information fraction: 0.42"
+  )
+
+  # specify the decimals for each variable
+  observed <- x |>
+    summary(
+      analysis_vars = c("time", "n", "event", "ahr", "info_frac"),
+      analysis_decimals = c(2, 0, 0, 4, 4)
+    ) |>
+    attr("groups") |>
+    extract_summary_analysis()
+  expect_identical(
+    observed,
+    "Analysis: 1 Time: 12 N: 707 Event: 160 AHR: 0.8108 Information fraction: 0.4191"
+  )
+
+  # Drop variables and also specify the decimals
+  observed <- x |>
+    summary(
+      analysis_vars = c("ahr", "info_frac"),
+      analysis_decimals = c(4, 4)
+    ) |>
+    attr("groups") |>
+    extract_summary_analysis()
+  expect_identical(
+    observed,
+    "Analysis: 1 AHR: 0.8108 Information fraction: 0.4191"
+  )
+
+  # Rearrange variables
+  observed <- x |>
+    summary(
+      analysis_vars = c("info_frac", "ahr", "event", "n", "time"),
+      analysis_decimals = c(4, 4, 0, 0, 2)
+    ) |>
+    attr("groups") |>
+    extract_summary_analysis()
+  expect_identical(
+    observed,
+    "Analysis: 1 Information fraction: 0.4191 AHR: 0.8108 Event: 160 N: 707 Time: 12"
+  )
+
+  # Throw error if unnamed analysis_decimals does not match length of analysis_vars
+  expect_error(
+    summary(
+      x,
+      analysis_vars = c("info_frac", "ahr", "event", "n", "time"),
+      analysis_decimals = c(4, 4),
+    ),
+    "summary: please input analysis_vars and analysis_decimals in pairs!"
+  )
+})
+
+test_that("summary.gs_design() accepts a named vector for analysis_decimals", {
+  x <- gs_design_ahr(analysis_time = c(12, 24))
+
+  # Specify decimals
+  observed <- x |>
+    summary(analysis_decimals = c(ahr = 4, info_frac = 4)) |>
+    attr("groups") |>
+    extract_summary_analysis()
+  expect_identical(
+    observed,
+    "Analysis: 1 Time: 12 N: 707.3 Event: 160.4 AHR: 0.8108 Information fraction: 0.4191"
+  )
+
+  # Specify decimals and also drop some variables
+  observed <- x |>
+    summary(
+      analysis_vars = c("event", "ahr", "info_frac"),
+      analysis_decimals = c(ahr = 4, info_frac = 4)
+    ) |>
+    attr("groups") |>
+    extract_summary_analysis()
+  expect_identical(
+    observed,
+    "Analysis: 1 Event: 160.4 AHR: 0.8108 Information fraction: 0.4191"
+  )
+
+  # Specify decimals and rearrange some variables
+  observed <- x |>
+    summary(
+      analysis_vars = c("info_frac", "ahr", "event"),
+      analysis_decimals = c(ahr = 4, info_frac = 4)
+    ) |>
+    attr("groups") |>
+    extract_summary_analysis()
+  expect_identical(
+    observed,
+    "Analysis: 1 Information fraction: 0.4191 AHR: 0.8108 Event: 160.4"
+  )
+
+  # Only drop variables
+  observed <- x |>
+    summary(
+      analysis_vars = c("info_frac", "ahr", "event")
+    ) |>
+    attr("groups") |>
+    extract_summary_analysis()
+  expect_identical(
+    observed,
+    "Analysis: 1 Information fraction: 0.42 AHR: 0.81 Event: 160.4"
+  )
+
+  # Throw error is analysis_decimals is unnamed
+  expect_error(
+    summary(x, analysis_decimals = c(4, 4)),
+    "summary: analysis_decimals must be a named vector if analysis_vars is not provided"
+  )
+})