Merge pull request #86 from keaven/issue-84-SPRT-vignette

Add SPRT vignette

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: gsDesign
-Version: 3.4.0
+Version: 3.4.0.9000
 Title: Group Sequential Design
 Authors@R: person(given = "Keaven", family = "Anderson", email =
           "keaven_anderson@merck.com", role = c('aut','cre'))
@@ -20,25 +20,25 @@ Imports:
     dplyr,
     ggplot2 (>= 0.9.2),
     graphics,
+    gt,
     magrittr,
     methods,
     rlang,
     stats,
+    tibble,
     tidyr,
     tools,
     xtable
 Suggests:
     covr,
     gridExtra,
-    gt,
     kableExtra,
     knitr,
     mvtnorm,
     ragg,
     rmarkdown,
     scales,
     testthat,
-    tibble,
     utils
 VignetteBuilder:
     knitr

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as_gt,gsBinomialExactTable)
+S3method(as_table,gsBinomialExact)
 S3method(plot,gsBinomialExact)
 S3method(plot,gsDesign)
 S3method(plot,gsProbability)
@@ -15,7 +17,10 @@ S3method(summary,gsDesign)
 S3method(summary,spendfn)
 S3method(xtable,gsDesign)
 S3method(xtable,gsSurv)
+export("%>%")
 export(Power.ssrCP)
+export(as_gt)
+export(as_table)
 export(binomialSPRT)
 export(checkLengths)
 export(checkRange)
@@ -95,6 +100,7 @@ importFrom(dplyr,mutate)
 importFrom(dplyr,n)
 importFrom(dplyr,select)
 importFrom(dplyr,summarise)
+importFrom(dplyr,summarize)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,geom_abline)
 importFrom(ggplot2,geom_line)
@@ -131,6 +137,13 @@ importFrom(graphics,points)
 importFrom(graphics,strwidth)
 importFrom(graphics,text)
 importFrom(grid,unit)
+importFrom(gt,cols_label)
+importFrom(gt,fmt_number)
+importFrom(gt,fmt_percent)
+importFrom(gt,gt)
+importFrom(gt,html)
+importFrom(gt,tab_header)
+importFrom(gt,tab_spanner)
 importFrom(magrittr,"%>%")
 importFrom(methods,is)
 importFrom(rlang,"!!")
@@ -151,6 +164,7 @@ importFrom(stats,qt)
 importFrom(stats,rbinom)
 importFrom(stats,reshape)
 importFrom(stats,uniroot)
+importFrom(tibble,as_tibble)
 importFrom(tidyr,pivot_longer)
 importFrom(xtable,xtable)
 useDynLib(gsDesign,gsbound)

R/as_gt.R

@@ -0,0 +1,79 @@
+#' Print a summary table using gt
+#'
+#' Create print a table created with \code{\link{as_table}} to summarize
+#' an object and print it using \code{\link[gt]{gt}}; currently only
+#' implemented for \code{\link{gsBinomialExact}}.
+#'
+#' @param x   Object to be printed using \code{\link[gt]{gt}}.
+#' @param ... Other parameters that may be specific the object.
+#'
+#' @return A `gt` object that may be extended by overloaded versions of
+#'   \code{\link{as_gt}}.
+#'
+#' @seealso \code{vignette("binomialSPRTExample")}
+#'
+#' @details
+#' Currently only implemented for \code{\link{gsBinomialExact}} objects.
+#' Creates a table to summarize an object.
+#' For \code{\link{gsBinomialExact}}, this summarized operating characteristics
+#' across a range of effect sizes.
+#'
+#' @export
+#'
+#' @examples
+#' safety_design <- binomialSPRT(p0 = .04, p1 = .1, alpha = .04, beta = .2, minn = 4, maxn = 75)
+#' safety_power <- gsBinomialExact(
+#'   k = length(safety_design$n.I),
+#'   theta = seq(.02, .16, .02),
+#'   n.I = safety_design$n.I,
+#'   a = safety_design$lower$bound,
+#'   b = safety_design$upper$bound
+#' )
+#' safety_power %>%
+#'   as_table() %>%
+#'   as_gt(
+#'     theta_label = gt::html("Underlying<br>AE rate"),
+#'     prob_decimals = 3,
+#'     bound_label = c("low rate", "high rate")
+#'   )
+as_gt <- function(x, ...) UseMethod("as_gt")
+
+#' @rdname as_gt
+#'
+#' @param title Table title.
+#' @param subtitle Table subtitle.
+#' @param theta_label Label for theta.
+#' @param bound_label Label for bounds.
+#' @param prob_decimals Number of decimal places for probability of crossing.
+#' @param en_decimals Number of decimal places for expected number of
+#'   observations when bound is crossed or when trial ends without crossing.
+#' @param rr_decimals Number of decimal places for response rates.
+#'
+#' @importFrom gt gt tab_spanner cols_label html fmt_number fmt_percent tab_header
+#'
+#' @export
+as_gt.gsBinomialExactTable <-
+  function(x,
+           title = "Operating Characteristics for the Truncated SPRT Design",
+           subtitle = "Assumes trial evaluated sequentially after each response",
+           theta_label = html("Underlying<br>response rate"),
+           bound_label = c("Futility bound", "Efficacy bound"),
+           prob_decimals = 2,
+           en_decimals = 1,
+           rr_decimals = 0,
+           ...) {
+    out_gt <- x %>%
+      gt() %>%
+      tab_spanner(label = "Probability of crossing", columns = c(Lower, Upper)) %>%
+      cols_label(
+        theta = theta_label,
+        Lower = bound_label[1],
+        Upper = bound_label[2],
+        en = html("Average<br>sample size")
+      ) %>%
+      fmt_number(columns = c(Lower, Upper), decimals = prob_decimals) %>%
+      fmt_number(columns = en, decimals = en_decimals) %>%
+      fmt_percent(columns = theta, decimals = rr_decimals) %>%
+      tab_header(title = title, subtitle = subtitle)
+    return(out_gt)
+  }

R/as_table.R

@@ -0,0 +1,60 @@
+#' Create a summary table
+#'
+#' Create a tibble to summarize an object; currently only implemented for
+#' \code{\link{gsBinomialExact}}.
+#'
+#' @param x Object to be summarized.
+#' @param ... Other parameters that may be specific to the object.
+#'
+#' @return A tibble which may have an extended class to enable further output processing.
+#'
+#' @seealso \code{vignette("binomialSPRTExample")}
+#'
+#' @details
+#' Currently only implemented for \code{\link{gsBinomialExact}} objects.
+#' Creates a table to summarize an object.
+#' For \code{\link{gsBinomialExact}}, this summarized operating characteristics
+#' across a range of effect sizes.
+#'
+#' @importFrom tibble as_tibble
+#' @importFrom tidyr pivot_longer
+#' @importFrom dplyr group_by summarize left_join mutate
+#'
+#' @export
+#'
+#' @examples
+#' b <- binomialSPRT(p0 = .1, p1 = .35, alpha = .08, beta = .2, minn = 10, maxn = 25)
+#' b_power <- gsBinomialExact(
+#'   k = length(b$n.I), theta = seq(.1, .45, .05), n.I = b$n.I,
+#'   a = b$lower$bound, b = b$upper$bound
+#' )
+#' b_power %>%
+#'   as_table() %>%
+#'   as_gt()
+as_table <- function(x, ...) UseMethod("as_table")
+
+#' @rdname as_table
+#' @export
+as_table.gsBinomialExact <- function(x, ...) {
+  sum_lower <- t(x$lower$prob)
+  theta <- as.double(names(t(x$lower$prob)[, 1]))
+  sum_lower <- sum_lower %>%
+    as_tibble() %>%
+    mutate(theta = theta) %>%
+    pivot_longer(cols = !theta, names_to = "Analysis", values_to = "Probability") %>%
+    group_by(theta) %>%
+    summarize(Lower = sum(Probability))
+
+  sum_upper <- t(x$upper$prob)
+  sum_upper <- sum_upper %>%
+    as_tibble() %>%
+    mutate(theta = theta) %>%
+    pivot_longer(cols = !theta, names_to = "Analysis", values_to = "Probability") %>%
+    group_by(theta) %>%
+    summarize(Upper = sum(Probability))
+
+  tab <- left_join(sum_lower, sum_upper, by = "theta")
+  tab$en <- x$en
+  class(tab) <- c(class(tab), "gsBinomialExactTable")
+  return(tab)
+}

R/globals.R

@@ -0,0 +1,8 @@
+utils::globalVariables(
+  unique(
+    c(
+      # From `as_gt.gsBinomialExactTable()`
+      c("Lower", "Upper", "en")
+    )
+  )
+)

R/gsBinomialExact.R

@@ -445,3 +445,6 @@ binomialPP <- function(a = .2, b = .8, theta = c(.2, .4), p1 = .4, PP = c(.025,
   class(y) <- c("binomialPP", "gsBinomialExact", "gsProbability")
   return(y)
 }
+
+
+

R/utils-pipe.R

@@ -0,0 +1,14 @@
+#' Pipe operator
+#'
+#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details.
+#'
+#' @name %>%
+#' @rdname pipe
+#' @keywords internal
+#' @export
+#' @importFrom magrittr %>%
+#' @usage lhs \%>\% rhs
+#' @param lhs A value or the magrittr placeholder.
+#' @param rhs A function call using the magrittr semantics.
+#' @return The result of calling `rhs(lhs)`.
+NULL

_pkgdown.yml

@@ -103,6 +103,12 @@ reference:
 - title: Testing multiple hypotheses
   contents:
   - hGraph
+- title: Summary tables
+  contents:
+  - as_table
+  - as_table.gsBinomialExact
+  - as_gt
+  - as_gt.gsBinomialExactTable
 
 articles:
   - title: "Designing for time-to-event endpoints"
@@ -121,3 +127,4 @@ articles:
       - hGraph
       - GraphicalMultiplicity
       - VaccineEfficacy
+      - binomialSPRTExample