Update plotgsPower() to use offset arg for Future Analysis legend

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: gsDesign
-Version: 3.6.0.1
+Version: 3.6.0.2
 Title: Group Sequential Design
 Authors@R: person(given = "Keaven", family = "Anderson", email =
           "[email protected]", role = c('aut','cre'))

R/gsqplot.R

@@ -812,13 +812,25 @@ plotASN <- function(x, xlab = NULL, ylab = NULL, main = NULL, theta = NULL, xval
 #' @importFrom ggplot2 ggplot aes geom_line ylab guides guide_legend xlab scale_linetype_manual scale_color_manual scale_y_continuous ggtitle scale_x_continuous scale_colour_manual geom_text
 #' @importFrom rlang !! sym
 #' @importFrom graphics plot axis lines strwidth text
+#' @param offset Integer to offset the numeric labels of the "Analysis" legend
+#'   (default: 0). Only relevant for \code{outtype = 1}. By default will change
+#'   legend title to "Future Analysis". To customize the title, pass the label
+#'   to the argument \code{titleAnalysisCustom}
+#' @param titleAnalysisCustom Label to use as the title for the "Analysis"
+#'   legend (default: NULL)
 # plotgsPower function [sinew] ----
 plotgsPower <- function(x, main = "Boundary crossing probabilities by effect size",
                         ylab = "Cumulative Boundary Crossing Probability",
                         xlab = NULL, lty = NULL, col = NULL, lwd = 1, cex = 1,
                         theta = if (inherits(x, "gsDesign")) seq(0, 2, .05) * x$delta else x$theta,
-                        xval = NULL, base = FALSE, outtype = 1, ...) {
+                        xval = NULL, base = FALSE, outtype = 1, offset = 0,
+                        titleAnalysisCustom = NULL, ...) {
 
+  stopifnot(
+    is.numeric(offset) && length(offset) == 1,
+    is.null(titleAnalysisCustom) ||
+      (is.character(titleAnalysisCustom) && length(titleAnalysisCustom) == 1)
+  )
   if (is.null(xval)) {
     if (inherits(x, "gsDesign")) {
       xval <- x$delta0 + (x$delta1 - x$delta0) * theta / x$delta
@@ -860,8 +872,17 @@ plotgsPower <- function(x, main = "Boundary crossing probabilities by effect siz
 
     y2$Probability[y2$Bound == "1-Lower bound"] <- 1 - y2$Probability[y2$Bound == "1-Lower bound"]
 
-    y2$Analysis <- factor(y$id)
+    y2$Analysis <- factor(y$id + offset)
 
+    # Determine title of Analysis legend
+    titleAnalysis <- "Analysis"
+    if (offset > 0) {
+      titleAnalysis <- "Future Analysis"
+    }
+    if (!is.null(titleAnalysisCustom)) {
+      titleAnalysis <- titleAnalysisCustom
+    }
+
     y2$delta <- xval[y$thetaidx]
 
     p <- ggplot2::ggplot(y2, 
@@ -875,11 +896,11 @@ plotgsPower <- function(x, main = "Boundary crossing probabilities by effect siz
       ggplot2::ylab(ylab) +
       ggplot2::guides(color = ggplot2::guide_legend(title = "Probability")) + 
       ggplot2::xlab(xlab) +
-      ggplot2::scale_linetype_manual(values = lty) +
+      ggplot2::scale_linetype_manual(values = lty, name = titleAnalysis) +
       ggplot2::scale_color_manual(values = getColor(col)) +
       ggplot2::scale_y_continuous(breaks = seq(0, 1, .2))
 
-      return(p + ggplot2::ggtitle(label = main))
+    return(p + ggplot2::ggtitle(label = main))
   }
   if (is.null(col)) {
     if (base || outtype == 2) {

tests/testthat/test-independent-test-plotgsPower.R

@@ -55,7 +55,7 @@ test_that(desc = 'check plot data values,
 
   res_upper <- subset(plotobj$data, delta == 0 & Analysis == 3 &
                   Bound == 'Upper bound')$Probability
-  res_lower <- subset(plotobj$data, delta == 0 & Analysis == 3 & 
+  res_lower <- subset(plotobj$data, delta == 0 & Analysis == 3 &
                   Bound == '1-Lower bound')$Probability
   res <- 1 - res_lower + res_upper
   expect_lte(abs(res - 0.05000001), 1e-6)
@@ -70,7 +70,7 @@ test_that(desc = 'check plot data values,
 
   res_upper <- subset(plotobj$data, delta == .15 & Analysis == 3 &
                         Bound == 'Upper bound')$Probability
-  res_lower <- subset(plotobj$data, delta == .15 & Analysis == 3 & 
+  res_lower <- subset(plotobj$data, delta == .15 & Analysis == 3 &
                         Bound == '1-Lower bound')$Probability
   res <- 1 - res_lower + res_upper
   expect_lte(abs(res - 0.36688393), 1e-3)
@@ -85,7 +85,7 @@ test_that(desc = 'check plot data values,
 
    res_upper <- subset(plotobj$data, delta == .45 & Analysis == 3 &
                          Bound == 'Upper bound')$Probability
-   res_lower <- subset(plotobj$data, delta == .45 & Analysis == 3 & 
+   res_lower <- subset(plotobj$data, delta == .45 & Analysis == 3 &
                          Bound == '1-Lower bound')$Probability
    res <- 1 - res_lower + res_upper
    expect_lte(abs(res - 0.99808417), 1e-3)
@@ -102,4 +102,51 @@ test_that(desc = 'Test: plotgsPower graphs are correctly rendered,test.type = 1'
   local_edition(3)
 
   expect_snapshot_file(save_plot_obj, "plotgsPower_2.png")
-})
+})
+
+test_that(desc = 'Test: plotgsPower graphs can use offset arg for Future Analysis legend',
+          code = {
+  x <- gsDesign(k = 3, test.type = 1, alpha = 0.025, beta = 0.1,
+                delta1 = 0.3, sfu = sfLDOF)
+
+  # Without offset
+  plotobj <- plotgsPower(x)
+
+  expect_equal(
+    levels(plotobj$data$Analysis),
+    as.character(1:3)
+  )
+
+  expect_equal(
+    plotobj[["plot_env"]][["titleAnalysis"]],
+    "Analysis"
+  )
+
+  # With offset
+  plotobj <- plotgsPower(x, offset = 1)
+
+  expect_equal(
+    levels(plotobj$data$Analysis),
+    as.character(2:4)
+  )
+
+  expect_equal(
+    plotobj[["plot_env"]][["titleAnalysis"]],
+    "Future Analysis"
+  )
+
+  # Enable custom legend title
+  plotobj <- plotgsPower(x, titleAnalysisCustom = "custom")
+
+  expect_equal(
+    plotobj[["plot_env"]][["titleAnalysis"]],
+    "custom"
+  )
+
+  plotobj <- plotgsPower(x, offset = 1, titleAnalysisCustom = "custom")
+
+  expect_equal(
+    plotobj[["plot_env"]][["titleAnalysis"]],
+    "custom"
+  )
+})