Skip to content
Merged
Show file tree
Hide file tree
Changes from 8 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
1 change: 1 addition & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ Imports:
doFuture,
foreach,
future,
lt,
methods,
mvtnorm,
stats,
Expand Down
3 changes: 3 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
S3method(as_gt,fixed_design)
S3method(as_gt,gs_design)
S3method(as_gt,simtrial_gs_wlr)
S3method(lt::lt,simtrial_gs_wlr)
S3method(summary,simtrial_gs_wlr)
S3method(wlr,counting_process)
S3method(wlr,default)
Expand All @@ -18,6 +19,7 @@ export(fh)
export(fit_pwexp)
export(get_analysis_date)
export(get_cut_date_by_event)
export(lt)
export(maxcombo)
export(mb)
export(milestone)
Expand Down Expand Up @@ -56,6 +58,7 @@ importFrom(future,
nbrOfWorkers,
plan
)
importFrom(lt,lt)
importFrom(methods,is)
importFrom(mvtnorm,
GenzBretz,
Expand Down
4 changes: 4 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,9 @@
# simtrial 1.0.2

## Major changes

- The heavy **gt** dependency is replaced by the lightweight **lt** package for rendering summary tables (#371). The `lt()` generic is re-exported so `summary()` output can be rendered with `lt()` after only loading simtrial. `as_gt()` is deprecated but kept for one release; it still returns a `gt_tbl` object and now requires the suggested **gt** package to be installed.

## Bug fixes

- `sim_gs_n()` is updated to provide updated efficacy bound when it is one-sided design (#348, thanks to @LittleBeannie).
Expand Down
29 changes: 28 additions & 1 deletion R/as_gt.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,23 +18,48 @@

#' Convert summary table to a gt object
#'
#' `as_gt()` is deprecated in favor of [lt()], which produces a lightweight
#' HTML table without the heavy \pkg{gt} dependency. `as_gt()` is kept for one
#' release so existing code that customizes the output with \pkg{gt} functions
#' keeps working; it still returns a `gt_tbl` object and requires \pkg{gt} to be
#' installed. New code should use [lt()]; see [lt-methods] for details.
#'
#' @param x A summary object of a fixed or group sequential design.
#' @param ... Additional arguments (not used).
#'
#' @return A gt table.
#'
#' @seealso [lt()], [lt-methods]
#'
#' @export
as_gt <- function(x, ...) {
.Deprecated("lt", package = "simtrial",
msg = paste(
"as_gt() is deprecated and will be removed in a future release;",
"please use lt() instead."
))
UseMethod("as_gt", x)
}

# stop with an informative message when gt is not installed, since it is only
# a suggested (optional) dependency now that as_gt() is deprecated
assert_gt_installed <- function() {
if (!requireNamespace("gt", quietly = TRUE)) stop(
"The 'gt' package is required by the deprecated as_gt(); ",
"install it with install.packages('gt'), or use lt() instead.",
call. = FALSE
)
}


#' @param x A object returned by [summary()].
#' @param title Title of the gt table.
#' @param subtitle Subtitle of the gt table.
#' @param ... Additional parameters (not used).
#'
#' @return A gt table summarizing the simulation results.
#' @return A gt table summarizing the simulation results. This method is
#' deprecated; use [lt()] instead. It still returns a `gt_tbl` object for one
#' release and requires \pkg{gt} to be installed.
#' @export
#' @rdname as_gt
#'
Expand Down Expand Up @@ -101,6 +126,8 @@ as_gt <- function(x, ...) {
as_gt.simtrial_gs_wlr <- function(x,
title = "Summary of simulation results by WLR tests",
subtitle = NULL, ...){
assert_gt_installed()

# get the default subtitle
if (is.null(subtitle)) {
subtitle <- paste0("Weighted by ", attributes(x)$method)
Expand Down
188 changes: 188 additions & 0 deletions R/lt.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,188 @@
# Copyright (c) 2026 Merck & Co., Inc., Rahway, NJ, USA and its affiliates.
# All rights reserved.
#
# This file is part of the simtrial program.
#
# simtrial is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.

# Re-export the lt() generic so users can call lt() on a simulation summary after
# only loading simtrial (without also attaching lt or qualifying with lt::).
# This also makes S3 dispatch robust regardless of package load order.
# See https://github.com/yihui/lt/issues/4.

#' @importFrom lt lt
#' @export
lt::lt

#' Create an lt table from a simulation summary
#'
#' S3 method for [lt()] that converts a group sequential simulation summary
#' (a `simtrial_gs_wlr` object returned by [summary()]) into a formatted lt
#' table. This is the lightweight replacement for the deprecated [as_gt()].
#'
#' @param data A summary object returned by [summary()].
#' @param title Title of the lt table.
#' @param subtitle Subtitle of the lt table.
#' @param ... Additional arguments (not used).
#'
#' @return An `lt_tbl` object summarizing the simulation results.
#'
#' @name lt-methods
#'
#' @seealso [as_gt()]
#'
#' @exportS3Method lt::lt
#'
#' @examples
#'
#' # Parameters for enrollment
#' enroll_rampup_duration <- 4 # Duration for enrollment ramp up
#' enroll_duration <- 16 # Total enrollment duration
#' enroll_rate <- gsDesign2::define_enroll_rate(
#' duration = c(
#' enroll_rampup_duration, enroll_duration - enroll_rampup_duration),
#' rate = c(10, 30))
#'
#' # Parameters for treatment effect
#' delay_effect_duration <- 3 # Delay treatment effect in months
#' median_ctrl <- 9 # Survival median of the control arm
#' median_exp <- c(9, 14) # Survival median of the experimental arm
#' dropout_rate <- 0.001
#' fail_rate <- gsDesign2::define_fail_rate(
#' duration = c(delay_effect_duration, 100),
#' fail_rate = log(2) / median_ctrl,
#' hr = median_ctrl / median_exp,
#' dropout_rate = dropout_rate)
#'
#' # Other related parameters
#' alpha <- 0.025 # Type I error
#' beta <- 0.1 # Type II error
#' ratio <- 1 # Randomization ratio (experimental:control)
#'
#' # Build a one-sided group sequential design
#' design <- gsDesign2::gs_design_ahr(
#' enroll_rate = enroll_rate, fail_rate = fail_rate,
#' ratio = ratio, alpha = alpha, beta = beta,
#' analysis_time = c(12, 24, 36),
#' upper = gsDesign2::gs_spending_bound,
#' upar = list(sf = gsDesign::sfLDOF, total_spend = alpha),
#' lower = gsDesign2::gs_b,
#' lpar = rep(-Inf, 3))
#'
#' # Define cuttings of 2 IAs and 1 FA
#' ia1_cut <- create_cut(target_event_overall = ceiling(design$analysis$event[1]))
#' ia2_cut <- create_cut(target_event_overall = ceiling(design$analysis$event[2]))
#' fa_cut <- create_cut(target_event_overall = ceiling(design$analysis$event[3]))
#'
#' # Run simulations
#' simulation <- sim_gs_n(
#' n_sim = 3,
#' sample_size = ceiling(design$analysis$n[3]),
#' enroll_rate = design$enroll_rate,
#' fail_rate = design$fail_rate,
#' test = wlr,
#' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut),
#' weight = fh(rho = 0, gamma = 0.5))
#'
#' # Summarize simulations
#' simulation |>
#' summary(bound = gsDesign::gsDesign(k = 3, test.type = 1, sfu = gsDesign::sfLDOF)$upper$bound) |>
#' lt()
#'
#' # Summarize simulations and compare with the planned design
#' simulation |>
#' summary(design = design) |>
#' lt()
lt.simtrial_gs_wlr <- function(data,
title = "Summary of simulation results by WLR tests",
subtitle = NULL, ...){
x <- data

# The raw output of sim_gs_n() also carries the "simtrial_gs_wlr" class but is
# not a summary (it lacks the attributes added by summary()). In that case fall
# back to a plain lt table, mirroring how bare gt() used to render it.
if (is.null(attributes(x)$compare_with_design)) {
return(lt::lt(as.data.frame(x), ...))
}

# get the default subtitle
if (is.null(subtitle)) {
subtitle <- paste0("Weighted by ", attributes(x)$method)
}

# if it is not compared with the design
if (attributes(x)$compare_with_design == "no") {
as.data.frame(x) |>
lt::lt() |>
lt::lt_label(sim_time = "Time", sim_n = "N", sim_event = "Event", sim_upper_prob = "Crossing probability") |>
lt::lt_move(columns = c("sim_time", "sim_n", "sim_event"), after = "analysis") |>
lt::lt_header(title = title, subtitle = subtitle)
Comment thread
yihui marked this conversation as resolved.
} else {
# get the design type, either one-sided or two-sided
design_type <- attributes(x)$design_type

# lt has no tidyselect, so enumerate the columns of each spanner explicitly.
# The columns must be listed in the same paired order (asymptotic before
# simulated) that lt_move() lays them out below, because lt matches a
# spanner to the visual position of its first column and then spans the
# next length(columns) columns; listing them in any other order would
# misalign the spanners (and silently drop later ones).
time_cols <- c("asy_time", "sim_time")
n_cols <- c("asy_n", "sim_n")
event_cols <- c("asy_event", "sim_event")
upper_cols <- c("asy_upper_prob", "sim_upper_prob")
lower_cols <- c("asy_lower_prob", "sim_lower_prob")

# build an lt table as return, moving the paired asymptotic/simulated columns
# right after `analysis` so each spanner covers a contiguous block
ans <- as.data.frame(x) |>
lt::lt() |>
lt::lt_move(
columns = c(time_cols, n_cols, event_cols),
after = "analysis")

# for a two-sided design, keep the efficacy (upper) and futility (lower)
# probability columns contiguous within their own spanners
if (design_type == "two-sided") {
ans <- ans |>
lt::lt_move(
columns = c(upper_cols, lower_cols),
after = "sim_event")
}

ans <- ans |>
lt::lt_spanner(label = "Time", columns = time_cols) |>
lt::lt_spanner(label = "Events", columns = event_cols) |>
lt::lt_spanner(label = "N", columns = n_cols) |>
lt::lt_spanner(
label = "Probability of crossing efficacy bounds under H1",
columns = upper_cols)

if (design_type == "two-sided") {
ans <- ans |> lt::lt_spanner(
label = "Probability of crossing futility bounds under H1",
columns = lower_cols)
}

# label the asymptotic/simulated/analysis columns, mirroring the
# starts_with()/matches() rules used by gt::cols_label() in as_gt()
labels <- ifelse(
startsWith(names(x), "asy"), "Asymptotic",
ifelse(startsWith(names(x), "sim"), "Simulated", "Analysis"))
labels <- stats::setNames(as.list(labels), names(x))

do.call(lt::lt_label, c(list(ans), labels)) |>
lt::lt_header(title = title, subtitle = subtitle)
Comment thread
yihui marked this conversation as resolved.
}
}
1 change: 1 addition & 0 deletions _pkgdown.yml
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,7 @@ reference:
- title: "Summarize simulations"
contents:
- summary.simtrial_gs_wlr
- lt.simtrial_gs_wlr
- as_gt.simtrial_gs_wlr

- title: "Randomization algorithms"
Expand Down
13 changes: 11 additions & 2 deletions man/as_gt.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading