-
Notifications
You must be signed in to change notification settings - Fork 14
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #86 from keaven/issue-84-SPRT-vignette
Add SPRT vignette
- Loading branch information
Showing
13 changed files
with
512 additions
and
3 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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) | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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) | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,8 @@ | ||
utils::globalVariables( | ||
unique( | ||
c( | ||
# From `as_gt.gsBinomialExactTable()` | ||
c("Lower", "Upper", "en") | ||
) | ||
) | ||
) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
Oops, something went wrong.