remlapmot · Oct 27, 2026 · Oct 12, 2026 · Oct 12, 2026 · Oct 12, 2026 · Oct 15, 2026
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -20,11 +20,11 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macos-latest,   r: 'release'}
-          - {os: windows-latest, r: 'release'}
+          - {os: macos-latest,   r: 'release', rspm: 'false'}
+          - {os: windows-latest, r: 'release', rspm: 'false'}
           # - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
-          - {os: ubuntu-latest,   r: 'release'}
-          - {os: ubuntu-latest,   r: 'oldrel-1'}
+          - {os: ubuntu-latest,   r: 'release', rspm: 'true'}
+          - {os: ubuntu-latest,   r: 'oldrel-1', rspm: 'true'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
@@ -40,7 +40,7 @@ jobs:
           working-directory: SEQTaRget
           r-version: ${{ matrix.config.r }}
           http-user-agent: ${{ matrix.config.http-user-agent }}
-          use-public-rspm: true
+          use-public-rspm: ${{ matrix.config.rspm }}
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:

diff --git a/CITATION.cff b/CITATION.cff
@@ -22,7 +22,7 @@ authors:
     affiliation: "CAUSALab, Department of Epidemiology, Harvard T.H. Chan School of Public Health; Department of Biostatistics, Harvard T.H. Chan School of Public Health"
     orcid: https://orcid.org/0000-0003-1619-8456
 title: "SEQTaRget: Sequential Target Trial Emulation"
-version: 1.4.5
+version: 1.4.5.9000
 url: https://causalinference.github.io/SEQTaRget/
 repository-code: https://github.com/CausalInference/SEQTaRget
 repository: https://cran.r-project.org/package=SEQTaRget

diff --git a/SEQTaRget/DESCRIPTION b/SEQTaRget/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: SEQTaRget
 Type: Package
 Title: Sequential Trial Emulation
-Version: 1.4.5
+Version: 1.4.5.9000
 Authors@R: c(person(given = "Ryan",
                     family = "O'Dea",
                     role = c("aut", "cre"),

diff --git a/SEQTaRget/NEWS.md b/SEQTaRget/NEWS.md
@@ -1,3 +1,9 @@
+# SEQTaRget (development version)
+
+* Fix memory use growing with `bootstrap.nboot`. The outcome and weight models kept from every bootstrap iteration each held a vector with one entry per row of the data they were fitted on (fastglm's `n`), so a weighted analysis kept about 14 bytes per expanded row per bootstrap iteration until the end of the run, and returned them in `outcome.model` and `weight.statistics`. These vectors are now dropped. Estimates are unchanged. (thanks @ekawabata for reporting)
+* Correct the documentation of `selection.random` and `selection.prob`. It said `selection.random` selects IDs with replacement; it keeps all trials except those starting on the first level of `treat.level` (e.g. the untreated), and keeps a proportion `selection.prob` of those, sampled without replacement.
+* Add `weight.stabilized` to `SEQopts()` (default `TRUE`). `weight.stabilized = FALSE` gives unstabilized treatment weights: no numerator models are fit, so the weights are cumulative products of `1 / denominator`. LTFU and visit weights keep their numerators.
+
 # SEQTaRget v1.4.5
 
 * Drop the unused `doFuture` and `doRNG` dependencies.

diff --git a/SEQTaRget/R/SEQopts.R b/SEQTaRget/R/SEQopts.R
@@ -51,8 +51,8 @@
 #' @param risk.times Numeric vector: follow-up times (in the data's follow-up units) at which to report risk difference and risk ratio when \code{km.curves = TRUE}. Each requested time is snapped to the latest available follow-up at or before it. The final follow-up time is always included; because the follow-up grid is zero-indexed (\code{followup} runs \code{0:survival.max}), this final time is \code{survival.max + 1}, so e.g. \code{survival.max = 120} reports a row at 121. Default `NA` reports only the final follow-up time.
 #' @param seed Integer: starting seed; the default `NULL` draws a single random integer when `SEQopts()` is called, so set this explicitly for reproducible bootstrap results
 #' @param selection.first_trial Logical: selects only the first eligible trial in the expanded dataset, default `FALSE`
-#' @param selection.prob Numeric: percent of total IDs to select for \code{selection.random}, should be bound \[0, 1\], default is `0.8`
-#' @param selection.random Logical: randomly selects IDs with replacement to run analysis, default `FALSE`
+#' @param selection.prob Numeric: proportion of the trials starting on the first treatment level in \code{treat.level} to keep when \code{selection.random = TRUE}, should be in (0, 1\], default is `0.8`
+#' @param selection.random Logical: randomly subsample the trials starting on the first treatment level in \code{treat.level} (e.g. the untreated), keeping a proportion \code{selection.prob} of them, sampled without replacement, and all other trials. The sampled trials are not reweighted. Ignored when \code{selection.first_trial = TRUE}, default `FALSE`
 #' @param subgroup Character: Column name to stratify outcome models on
 #' @param survival.max Numeric: maximum time for survival curves, default is `Inf` (no maximum)
 #' @param treat.level List: treatment levels to compare, default is `c(0, 1)`
@@ -65,6 +65,7 @@
 #' @param weight.lag_condition Logical: whether weights should be conditioned on treatment lag value, default `TRUE`
 #' @param weight.p99 Logical: forces weight truncation at 1st and 99th percentile weights, will override provided \code{weight.upper} and \code{weight.lower}. The percentiles are taken from the untruncated weight distribution (as reported in \code{weight.statistics}), and as with \code{weight.lower}/\code{weight.upper} the truncation affects only the weights used to fit the outcome model.
 #' @param weight.preexpansion Logical: whether weighting should be done on pre-expanded data, default `TRUE`
+#' @param weight.stabilized Logical: use stabilized IP weights, default is `TRUE`. `FALSE` fits no numerator models, so the treatment weights are cumulative products of `1 / denominator` and any `numerator` is ignored; LTFU and visit weights keep their numerators
 #' @param weight.spline Logical: model time in the default weight models with a natural cubic spline (`splines::ns()`) instead of a quadratic, default is `FALSE`. This makes the baseline hazard of treatment (and of censoring, for the `cense` and `visit` models) a flexible function of time rather than one that can only rise or flatten off. The terms replaced are `trial`/`trial_sq` and `followup`/`followup_sq` when `weight.preexpansion = FALSE`, and the time column and its square when `weight.preexpansion = TRUE`. Ignored for weight models whose formula is supplied through \code{numerator}, \code{denominator}, \code{cense.numerator}, \code{cense.denominator}, \code{visit.numerator} or \code{visit.denominator} - write `ns()` terms into those formulas directly for finer control (e.g. a spline in `followup` only). Knots of any `ns(x, df = N)` term are fixed from the full data before fitting, so the basis is the same at fit and prediction time and across bootstrap resamples
 #' @param weight.spline.df Integer: degrees of freedom passed to `splines::ns()` when `weight.spline = TRUE`. With `df = k`, `ns()` places `k - 1` interior knots at quantiles of the term. Must be `>= 1`; `df = 1` is equivalent to a linear term and is generally not what you want. Default is `4` (3 interior knots)
 #' @param weight.upper Numeric: weights truncated at upper end at this weight, default is `Inf`. As with \code{weight.lower}, truncation affects only the weights used to fit the outcome model, not those reported in \code{weight.statistics} or the returned data.
@@ -90,7 +91,7 @@ SEQopts <- function(bootstrap = FALSE, bootstrap.nboot = 100, bootstrap.sample =
                     visit = NA, visit.denominator = NA, visit.numerator = NA,
                     weight.eligible_cols = c(),
                     weight.lower = 0, weight.lag_condition = TRUE, weight.p99 = FALSE, weight.preexpansion = TRUE,
-                    weight.spline = FALSE, weight.spline.df = 4L, weight.upper = Inf, weighted = FALSE) {
+                    weight.spline = FALSE, weight.spline.df = 4L, weight.stabilized = TRUE, weight.upper = Inf, weighted = FALSE) {
   # Standardization =============================================================
   parallel <- as.logical(parallel)
   nthreads <- as.integer(nthreads)
@@ -151,6 +152,7 @@ SEQopts <- function(bootstrap = FALSE, bootstrap.nboot = 100, bootstrap.sample =
 
   weighted <- as.logical(weighted)
   weight.preexpansion <- as.logical(weight.preexpansion)
+  weight.stabilized <- as.logical(weight.stabilized)
   weight.spline <- as.logical(weight.spline)
   weight.spline.df <- as.integer(weight.spline.df)
   if (length(weight.spline.df) != 1L || is.na(weight.spline.df) || weight.spline.df < 1L)
@@ -263,6 +265,7 @@ SEQopts <- function(bootstrap = FALSE, bootstrap.nboot = 100, bootstrap.sample =
       weight.upper = weight.upper,
       weight.p99 = weight.p99,
       weight.preexpansion = weight.preexpansion,
+      weight.stabilized = weight.stabilized,
       weight.spline = weight.spline,
       weight.spline.df = weight.spline.df,
       excused = excused,

diff --git a/SEQTaRget/R/SEQuential.R b/SEQTaRget/R/SEQuential.R
@@ -135,7 +135,11 @@ SEQuential <- function(data, id.col, time.col, eligible.col, treatment.col, outc
 
   if (is.na(params@covariates)) params@covariates <- create.default.covariates(params)
   if (params@weighted && params@method != "ITT") {
-    if (all(is.na(params@numerator))) params@numerator <- create.default.weight.covariates(params, "numerator")
+    if (!params@weight.stabilized) {
+      # No numerator model is fit; "1" is for display only
+      if (!all(is.na(params@numerator))) warning("'numerator' is ignored when weight.stabilized = FALSE")
+      params@numerator <- "1"
+    } else if (all(is.na(params@numerator))) params@numerator <- create.default.weight.covariates(params, "numerator")
     if (all(is.na(params@denominator))) params@denominator <- create.default.weight.covariates(params, "denominator")
   }
   if (params@LTFU) {

diff --git a/SEQTaRget/R/class_definitions.R b/SEQTaRget/R/class_definitions.R
@@ -33,6 +33,7 @@ setClass("SEQopts",
     weight.p99 = "logical",
     weight.eligible_cols = "list",
     weight.preexpansion = "logical",
+    weight.stabilized = "logical",
     weight.spline = "logical",
     weight.spline.df = "integer",
     excused = "logical",
@@ -102,6 +103,7 @@ setClass("SEQopts",
     weight.upper = Inf,
     weight.p99 = FALSE,
     weight.preexpansion = TRUE,
+    weight.stabilized = TRUE,
     weight.spline = FALSE,
     weight.spline.df = 4L,
     excused = FALSE,

diff --git a/SEQTaRget/R/class_setters.R b/SEQTaRget/R/class_setters.R
@@ -39,6 +39,7 @@ parameter.setter <- function(data, DT,
     end_of_fup.window = opts@end_of_fup.window,
     weighted = opts@weighted,
     weight.preexpansion = opts@weight.preexpansion,
+    weight.stabilized = opts@weight.stabilized,
     weight.spline = opts@weight.spline,
     weight.spline.df = opts@weight.spline.df,
     excused = opts@excused,
@@ -159,6 +160,9 @@ parameter.simplifier <- function(params) {
     params@weighted <- TRUE
   }
 
+  if (!params@weight.stabilized && (!params@weighted || params@method == "ITT"))
+    warning("'weight.stabilized = FALSE' only affects the treatment weights of a weighted, non-ITT analysis and has no effect here")
+
   if (params@method == "ITT" && params@weighted && !params@LTFU && is.na(params@visit)) {
     warning("Without LTFU or Visit, weighted ITT model is not supported, automatically changed to weighted = FALSE")
     params@weighted <- FALSE

diff --git a/SEQTaRget/R/internal_glmHelpers.R b/SEQTaRget/R/internal_glmHelpers.R
@@ -258,6 +258,7 @@ clean_fastglm <- function(model) {
     m$weights <- NULL
     m$prior.weights <- NULL
     m$qr <- NULL
+    m$n <- NULL
     m
   }
   if (!is.null(model$models)) {

diff --git a/SEQTaRget/R/internal_weights.R b/SEQTaRget/R/internal_weights.R
@@ -115,8 +115,8 @@ internal.weights <- function(DT, data, params, cache) {
         eligible_col <- params@weight.eligible_cols[[i]]
         level_data <- if (!is.na(eligible_col)) model.data[get(eligible_col) == 1, ] else model.data
 
-        # Fit numerator model (skip if excused & preexpansion)
-        if (!((params@excused || params@deviation.excused) && params@weight.preexpansion)) {
+        # Fit numerator model (skip if unstabilized, or excused & preexpansion)
+        if (params@weight.stabilized && !((params@excused || params@deviation.excused) && params@weight.preexpansion)) {
           n.data <- prepare.data_cached(level_data, params, type = "numerator", model = level, case = "default", cache)
           if (length(unique(n.data$y)) < 2L) {
             numerator_models[[i]] <- list(skip = TRUE)
@@ -146,18 +146,18 @@ internal.weights <- function(DT, data, params, cache) {
       if (!(params@excused || params@deviation.excused)) {
         for (i in seq_along(params@treat.level)) {
           level <- params@treat.level[[i]]
-          if (isTRUE(numerator_models[[i]]$skip) || isTRUE(denominator_models[[i]]$skip)) {
+          if ((params@weight.stabilized && isTRUE(numerator_models[[i]]$skip)) || isTRUE(denominator_models[[i]]$skip)) {
             out[tx_lag == level, `:=`(numerator = 1, denominator = 1)]
           } else {
             out[tx_lag == level, `:=`(
-              numerator = inline.pred(numerator_models[[i]], .SD, params, "numerator", multi = params@multinomial, target = level, cache = cache),
+              numerator = if (params@weight.stabilized) inline.pred(numerator_models[[i]], .SD, params, "numerator", multi = params@multinomial, target = level, cache = cache) else 1,
               denominator = inline.pred(denominator_models[[i]], .SD, params, "denominator", multi = params@multinomial, target = level, cache = cache))]
 
             # Flip P(A = 1) or P(A = level) to the probability of the treatment actually received,
             # independently of level's position in treat.level
             pred.level <- if (params@multinomial) level else 1
-            out[tx_lag == level & get(params@treatment) != pred.level,
-                `:=` (numerator = 1 - numerator, denominator = 1 - denominator)]
+            out[tx_lag == level & get(params@treatment) != pred.level, denominator := 1 - denominator]
+            if (params@weight.stabilized) out[tx_lag == level & get(params@treatment) != pred.level, numerator := 1 - numerator]
           }
         }
       } else {
@@ -184,7 +184,7 @@ internal.weights <- function(DT, data, params, cache) {
           }
         }
 
-        if (params@weight.preexpansion) {
+        if (params@weight.preexpansion || !params@weight.stabilized) {
           out[, numerator := 1]
         } else {
           if (params@multinomial && !params@weight.preexpansion) multi <- FALSE else multi <- params@multinomial
@@ -224,7 +224,7 @@ internal.weights <- function(DT, data, params, cache) {
 
     weight.info <- new("SEQweights", weights = out)
 
-    if (!((params@excused || params@deviation.excused) && params@weight.preexpansion) && params@method != "ITT") {
+    if (params@weight.stabilized && !((params@excused || params@deviation.excused) && params@weight.preexpansion) && params@method != "ITT") {
       coef.numerator <- vector("list", length(params@treat.level))
       for (i in seq_along(params@treat.level)) {
         coef.numerator[[i]] <- if (!isTRUE(numerator_models[[i]]$skip)) clean_fastglm(numerator_models[[i]]) else NULL

diff --git a/SEQTaRget/man/SEQopts.Rd b/SEQTaRget/man/SEQopts.Rd
diff --git a/SEQTaRget/tests/testthat/test_misc.R b/SEQTaRget/tests/testthat/test_misc.R
@@ -489,3 +489,19 @@ test_that("Subgroup risks and hazard ratios are standardized over the subgroup's
                  unname(run(alone, hazard = TRUE, fixed = list())@hazard[[1]][1]))
   }
 })
+
+test_that("Stored outcome and weight models keep no per-row vectors", {
+  # fastglm stores n as a vector with one entry per row of the model's data;
+  # every model kept per bootstrap iteration made memory grow with the expanded
+  # data times bootstrap.nboot
+  model <- suppressWarnings(SEQuential(copy(SEQdata), "ID", "time", "eligible", "tx_init", "outcome",
+    list("N", "L", "P"), list("sex"), method = "censoring", verbose = FALSE,
+    options = SEQopts(weighted = TRUE, bootstrap = TRUE, bootstrap.nboot = 2)
+  ))
+  ws <- model@weight.statistics[[1]]
+  stored <- c(model@outcome.model[[1]],
+              unlist(lapply(ws, function(w) c(w$coef.numerator, w$coef.denominator)), recursive = FALSE))
+  expect_length(stored, 3 * 5)
+  longest <- max(vapply(stored, function(m) max(lengths(unclass(m))), numeric(1)))
+  expect_lt(longest, 100)
+})
diff --git a/SEQTaRget/tests/testthat/test_survival.R b/SEQTaRget/tests/testthat/test_survival.R
@@ -118,9 +118,9 @@ test_that("risk.times reports RD/RR at requested follow-up times plus the final
 
 test_that("risk.times default reports only the final follow-up time", {
   data <- data.table::copy(SEQdata)
-  model <- SEQuential(data, "ID", "time", "eligible", "tx_init", "outcome",
-                      list("N", "L", "P"), list("sex"),
-                      method = "ITT", options = SEQopts(km.curves = TRUE), verbose = FALSE)
+  model <- suppressWarnings(SEQuential(data, "ID", "time", "eligible", "tx_init", "outcome",
+                                       list("N", "L", "P"), list("sex"),
+                                       method = "ITT", options = SEQopts(km.curves = TRUE), verbose = FALSE))
   rc <- risk_comparison(model)
   final <- max(model@survival.data[[1]]$followup)
   expect_equal(unique(rc$Followup), final)