Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 4 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ Imports:
data.table,
dplyr,
gsDesign,
gt,
lt,
methods,
mvtnorm,
npsurvSS (>= 1.1.0),
Expand All @@ -67,5 +67,7 @@ VignetteBuilder:
knitr
LinkingTo:
Rcpp
Remotes:
yihui/lt
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.3
Config/roxygen2/version: 8.0.0
6 changes: 3 additions & 3 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,8 +1,7 @@
# Generated by roxygen2: do not edit by hand

S3method(as_gt,fixed_design_summary)
S3method(as_gt,gs_design_summary)
S3method(as_gt,simtrial_gs_wlr)
S3method(as_lt,fixed_design_summary)
S3method(as_lt,gs_design_summary)
S3method(as_rtf,fixed_design_summary)
S3method(as_rtf,gs_design_summary)
S3method(print,fixed_design)
Expand All @@ -14,6 +13,7 @@ S3method(to_integer,gs_design)
export(ahr)
export(ahr_blinded)
export(as_gt)
export(as_lt)
export(as_rtf)
export(define_enroll_rate)
export(define_fail_rate)
Expand Down
265 changes: 11 additions & 254 deletions R/as_gt.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,256 +16,22 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.

#' Convert summary table of a fixed or group sequential design object to a gt object
#' Deprecated: superseded by [as_lt()]
#'
#' @param x A summary object of a fixed or group sequential design.
#' @param ... Additional arguments (not used).
#'
#' @return A `gt_tbl` object.
#'
#' @export
as_gt <- function(x, ...) {
UseMethod("as_gt", x)
}
Copy link
Copy Markdown
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Since as_gt() is an exported function, should we have at least one release where it is marked as deprecated before we actually remove it?

#' @export
as_gt <- function(x, ...) {
  .Deprecated("as_lt")
  UseMethod("as_gt", x)
}


#' @rdname as_gt
#'
#' @export
#'
#' @examples
#' # Fixed design examples ----
#'
#' # Enrollment rate
#' enroll_rate <- define_enroll_rate(
#' duration = 18,
#' rate = 20
#' )
#'
#' # Failure rates
#' fail_rate <- define_fail_rate(
#' duration = c(4, 100),
#' fail_rate = log(2) / 12,
#' dropout_rate = .001,
#' hr = c(1, .6)
#' )
#'
#' # Study duration in months
#' study_duration <- 36
#' `as_gt()` is deprecated; use [as_lt()] instead. It now calls [as_lt()].
#'
#' # Experimental / Control randomization ratio
#' ratio <- 1
#'
#' # 1-sided Type I error
#' alpha <- 0.025
#' @param x A summary object of a fixed or group sequential design.
#' @param ... Additional arguments passed to [as_lt()].
#'
#' # Type II error (1 - power)
#' beta <- 0.1
#' @return An `lt_tbl` object.
#'
#' # Example 1 ----
#' fixed_design_ahr(
#' alpha = alpha, power = 1 - beta,
#' enroll_rate = enroll_rate, fail_rate = fail_rate,
#' study_duration = study_duration, ratio = ratio
#' ) |>
#' summary() |>
#' as_gt()
#'
#' # Example 2 ----
#' fixed_design_fh(
#' alpha = alpha, power = 1 - beta,
#' enroll_rate = enroll_rate, fail_rate = fail_rate,
#' study_duration = study_duration, ratio = ratio
#' ) |>
#' summary() |>
#' as_gt()
as_gt.fixed_design_summary <- function(x, title = NULL, footnote = NULL, ...) {
if (is.null(title)) title <- attr(x, "title")
if (is.null(footnote)) footnote <- attr(x, "footnote")

ans <- gt::gt(x) |>
gt::tab_header(title = title)

if (!isFALSE(footnote)) {
ans <- ans |>
gt::tab_footnote(
footnote = footnote,
locations = gt::cells_title(group = "title")
)
}

return(ans)
}

#' @rdname as_gt
#'
#' @param title A string to specify the title of the gt table.
#' @param subtitle A string to specify the subtitle of the gt table.
#' @param colname_spanner A string to specify the spanner of the gt table.
#' @param colname_spannersub A vector of strings to specify the spanner details
#' of the gt table.
#' @param footnote A list containing `content`, `location`, and `attr`.
#' `content` is a vector of string to specify the footnote text; `location` is
#' a vector of string to specify the locations to put the superscript of the
#' footnote index; `attr` is a vector of string to specify the attributes of
#' the footnotes, for example, `c("colname", "title", "subtitle", "analysis",
#' "spanner")`; users can use the functions in the `gt` package to customize
#' the table. To disable footnotes, use `footnote = FALSE`.
#' @param display_bound A vector of strings specifying the label of the bounds.
#' The default is `c("Efficacy", "Futility")`.
#' @param display_columns A vector of strings specifying the variables to be
#' displayed in the summary table.
#' @param display_inf_bound Logical, whether to display the +/-inf bound.
#' @seealso [as_lt()]
#'
#' @export
#'
#' @examples
#' \donttest{
#' # Group sequential design examples ---
#'
#' # Example 1 ----
#' # The default output
#'
#' gs_design_ahr() |>
#' summary() |>
#' as_gt()
#'
#' gs_power_ahr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) |>
#' summary() |>
#' as_gt()
#'
#' gs_design_wlr() |>
#' summary() |>
#' as_gt()
#'
#' gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) |>
#' summary() |>
#' as_gt()
#'
#' gs_power_combo() |>
#' summary() |>
#' as_gt()
#'
#' gs_design_rd() |>
#' summary() |>
#' as_gt()
#'
#' gs_power_rd() |>
#' summary() |>
#' as_gt()
#'
#' # Example 2 ----
#' # Usage of title = ..., subtitle = ...
#' # to edit the title/subtitle
#' gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) |>
#' summary() |>
#' as_gt(
#' title = "Bound Summary",
#' subtitle = "from gs_power_wlr"
#' )
#'
#' # Example 3 ----
#' # Usage of colname_spanner = ..., colname_spannersub = ...
#' # to edit the spanner and its sub-spanner
#' gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) |>
#' summary() |>
#' as_gt(
#' colname_spanner = "Cumulative probability to cross boundaries",
#' colname_spannersub = c("under H1", "under H0")
#' )
#'
#' # Example 4 ----
#' # Usage of footnote = ...
#' # to edit the footnote
#' gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) |>
#' summary() |>
#' as_gt(
#' footnote = list(
#' content = c(
#' "approximate weighted hazard ratio to cross bound.",
#' "wAHR is the weighted AHR.",
#' "the crossing probability.",
#' "this table is generated by gs_power_wlr."
#' ),
#' location = c("~wHR at bound", NA, NA, NA),
#' attr = c("colname", "analysis", "spanner", "title")
#' )
#' )
#'
#' # Example 5 ----
#' # Usage of display_bound = ...
#' # to either show efficacy bound or futility bound, or both(default)
#' gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) |>
#' summary() |>
#' as_gt(display_bound = "Efficacy")
#'
#' # Example 6 ----
#' # Usage of display_columns = ...
#' # to select the columns to display in the summary table
#' gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) |>
#' summary() |>
#' as_gt(display_columns = c("Analysis", "Bound", "Nominal p", "Z", "Probability"))
#' }
as_gt.gs_design_summary <- function(
x,
title = NULL,
subtitle = NULL,
colname_spanner = "Cumulative boundary crossing probability",
colname_spannersub = c("Alternate hypothesis", "Null hypothesis"),
footnote = NULL,
display_bound = c("Efficacy", "Futility"),
display_columns = NULL,
display_inf_bound = FALSE,
...) {

x_old <- x
parts <- gsd_parts(
x, title, subtitle, colname_spannersub, footnote,
display_bound, display_columns, display_inf_bound
)

x <- parts$x |>
group_by(Analysis) |>
gt::gt() |>
gt::tab_spanner(
columns = all_of(colname_spannersub),
label = colname_spanner
) |>
gt::tab_header(title = parts$title, subtitle = parts$subtitle)

# Add footnotes ----
add_footnote <- !isFALSE(footnote)
footnote <- parts$footnote
for (i in seq_along(footnote$content)) {
att <- footnote$attr[i]
loc <- if (att == "colname") {
# footnotes are added on the colnames
gt::cells_column_labels(columns = footnote$location[i])
} else if (att %in% c("title", "subtitle")) {
# on the title/subtitle
gt::cells_title(group = att)
} else if (att == "analysis") {
# on the analysis summary row, which is a grouping variable, i.e., Analysis
gt::cells_row_groups(groups = dplyr::starts_with("Analysis"))
} else if (att == "spanner") {
# on the column spanner
gt::cells_column_spanners(spanners = colname_spanner)
}
if (!is.null(loc))
x <- gt::tab_footnote(x, footnote = footnote$content[i], locations = loc)
}

# add footnote for non-binding design
footnote_nb <- if (add_footnote) gsd_footnote_nb(x_old, parts$alpha)
if (!is.null(footnote_nb)) x <- gt::tab_footnote(
x,
footnote = footnote_nb,
locations = gt::cells_body(
columns = colname_spannersub[2],
rows = gsd_footnote_row(parts$x, display_bound[1])
)
)

return(x)
as_gt <- function(x, ...) {
.Deprecated("as_lt", package = "gsDesign2",
msg = "as_gt() is deprecated; please use as_lt() instead.")
as_lt(x, ...)
}

# get different default columns to display
Expand Down Expand Up @@ -349,7 +115,7 @@ gsd_footnote_row <- function(x, bound) {
i & x$Bound == bound
}

# a list of information for `as_[gt|rtf].gs_design()` methods: the transformed
# a list of information for `as_[lt|rtf].gs_design()` methods: the transformed
# data, title, and footnote, etc.
gsd_parts <- function(
x, title, subtitle, spannersub, footnote, bound, columns, inf_bound,
Expand Down Expand Up @@ -388,12 +154,3 @@ gsd_parts <- function(
alpha = max(filter(x, Bound == bound[1])[["Null hypothesis"]])
)
}

# Only purpose of the method below is to fix S3 redirection when gsDesign2 is
# loaded after simtrial, which masks the as_gt() generic from simtrial

#' @export
as_gt.simtrial_gs_wlr <- function(x, ...) {
f <- getFromNamespace("as_gt.simtrial_gs_wlr", "simtrial")
f(x, ...)
}
Loading
Loading