diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 7ba86a77..4e544f50 100644 --- 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 index 692b30be..4c4de977 100644 --- 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 index f3e338f6..86a07bb7 100644 --- 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 index fd93336a..ea3455a6 100644 --- 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 index 9cb9f83a..08573497 100644 --- 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 index 961f439c..b3c2fd84 100644 --- 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 index 5679e21d..d15185bd 100644 --- 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 index 7a161670..92bd57ef 100644 --- 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 index 72baf277..f8ccd706 100644 --- 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 index 8379e1c9..8d2bff48 100644 --- 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 index 2a35a784..c795c6dd 100644 --- a/SEQTaRget/man/SEQopts.Rd +++ b/SEQTaRget/man/SEQopts.Rd @@ -72,6 +72,7 @@ SEQopts( weight.preexpansion = TRUE, weight.spline = FALSE, weight.spline.df = 4L, + weight.stabilized = TRUE, weight.upper = Inf, weighted = FALSE ) @@ -179,9 +180,9 @@ SEQopts( \item{selection.first_trial}{Logical: selects only the first eligible trial in the expanded dataset, default \code{FALSE}} -\item{selection.prob}{Numeric: percent of total IDs to select for \code{selection.random}, should be bound [0, 1], default is \code{0.8}} +\item{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 \code{0.8}} -\item{selection.random}{Logical: randomly selects IDs with replacement to run analysis, default \code{FALSE}} +\item{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 \code{FALSE}} \item{subgroup}{Character: Column name to stratify outcome models on} @@ -211,6 +212,8 @@ SEQopts( \item{weight.spline.df}{Integer: degrees of freedom passed to \code{splines::ns()} when \code{weight.spline = TRUE}. With \code{df = k}, \code{ns()} places \code{k - 1} interior knots at quantiles of the term. Must be \verb{>= 1}; \code{df = 1} is equivalent to a linear term and is generally not what you want. Default is \code{4} (3 interior knots)} +\item{weight.stabilized}{Logical: use stabilized IP weights, default is \code{TRUE}. \code{FALSE} fits no numerator models, so the treatment weights are cumulative products of \code{1 / denominator} and any \code{numerator} is ignored; LTFU and visit weights keep their numerators} + \item{weight.upper}{Numeric: weights truncated at upper end at this weight, default is \code{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.} \item{weighted}{Logical: whether or not to perform weighted analysis, default is \code{FALSE}} diff --git a/SEQTaRget/tests/testthat/test_misc.R b/SEQTaRget/tests/testthat/test_misc.R index f58e94d7..90a2067f 100644 --- 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 index e183d6ea..ba25978e 100644 --- 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) diff --git a/SEQTaRget/tests/testthat/test_unstabilized.R b/SEQTaRget/tests/testthat/test_unstabilized.R new file mode 100644 index 00000000..4dd0ff4f --- /dev/null +++ b/SEQTaRget/tests/testthat/test_unstabilized.R @@ -0,0 +1,61 @@ +# Unstabilized IP weights: weight.stabilized = FALSE fixes the treatment-weight +# numerator at 1, so the weights are cumulative products of 1/denominator. + +test_that("weight.stabilized = FALSE gives numerator-1 weights from the same denominators", { + skip_on_cran() + run <- function(...) suppressWarnings(SEQuential(copy(SEQdata), "ID", "time", "eligible", "tx_init", "outcome", + list("N", "L", "P"), list("sex"), method = "censoring", + options = SEQopts(weighted = TRUE, seed = 1636, denominator = "N+L+P+sex", + data.return = TRUE, ...), verbose = FALSE)) + stab <- run(numerator = "sex") + unstab <- run(weight.stabilized = FALSE) + + key <- c("ID", "trial", "period") + merged <- merge(stab@DT[, c(key, "numerator", "denominator"), with = FALSE], + unstab@DT[, c(key, "numerator", "denominator"), with = FALSE], + by = key, suffixes = c(".stab", ".unstab")) + expect_true(merged[, all(numerator.unstab == 1)]) + # Same denominator model, so identical denominators; only the numerator differs + expect_equal(merged$denominator.stab, merged$denominator.unstab) + + # Weights are the running product of 1/denominator within each trial + d <- unstab@DT[ID == unstab@DT$ID[1]][trial == trial[1]][order(followup)] + expect_equal(d$weight, cumprod(fifelse(d$followup == 0, 1, 1 / d$denominator))) + + # No numerator model is fit, and the reported numerator formula is the constant 1 + expect_true(all(is.na(unstab@weight.statistics[[1]][[1]]$coef.numerator))) + expect_equal(unstab@numerator, "tx_init~1") + expect_output(show(unstab)) +}) + +test_that("weight.stabilized = FALSE warns where it cannot apply, and when numerator is supplied", { + params <- parameter.setter(copy(SEQdata), DT = data.table(), "ID", "time", "eligible", "outcome", "tx_init", + list("N", "L", "P"), list("sex"), method = "ITT", verbose = TRUE, + opts = SEQopts(weight.stabilized = FALSE)) + expect_warning(parameter.simplifier(params), "has no effect") + + capture.output(expect_warning( + SEQuential(copy(SEQdata), "ID", "time", "eligible", "tx_init", "outcome", + list("N", "L", "P"), list("sex"), method = "censoring", + options = SEQopts(weighted = TRUE, weight.stabilized = FALSE, + numerator = "sex", denominator = "N+L+P+sex"), verbose = TRUE), + "'numerator' is ignored")) +}) + +test_that("weight.stabilized = FALSE keeps the denominators in the excused and multinomial weights", { + skip_on_cran() + check <- function(data, ...) { + run <- function(stab) suppressWarnings(SEQuential(copy(data), "ID", "time", "eligible", "tx_init", "outcome", + list("N", "L", "P"), list("sex"), method = "censoring", verbose = FALSE, + options = SEQopts(weighted = TRUE, weight.preexpansion = FALSE, data.return = TRUE, + seed = 1636, weight.stabilized = stab, ...))) + key <- c("ID", "trial", "period") + merged <- merge(run(TRUE)@DT[, c(key, "denominator"), with = FALSE], + run(FALSE)@DT[, c(key, "numerator", "denominator"), with = FALSE], + by = key, suffixes = c(".stab", ".unstab")) + expect_true(merged[, all(numerator == 1)]) + expect_equal(merged$denominator.stab, merged$denominator.unstab) + } + check(SEQdata, excused = TRUE, excused.cols = c("excusedZero", "excusedOne")) + check(SEQdata.multitreatment, multinomial = TRUE, treat.level = c(0, 1, 2)) +}) diff --git a/SEQTaRget/vignettes/seqopts.Rmd b/SEQTaRget/vignettes/seqopts.Rmd index e14b1c15..22753da0 100644 --- a/SEQTaRget/vignettes/seqopts.Rmd +++ b/SEQTaRget/vignettes/seqopts.Rmd @@ -53,8 +53,8 @@ data.table::setDTthreads(2) | `risk.times` | Follow-up times (in follow-up units) at which to report risk difference and risk ratio when `km.curves = TRUE`; each is snapped to the latest follow-up at or before it and the final time is always included (`NA` reports only the final time) | Numeric vector | `c(36, 120)` | | `seed` | Starting seed for random number generators | Integer | `1636` | | `selection.first_trial` | Selects only the first eligible trial in the expanded dataset | Logical | `TRUE` | -| `selection.prob` | Subsample of total IDs to select | Numeric double [0, 1] | `0.8` | -| `selection.random` | Whether to randomly select IDs with replacement to run analysis | Logical | `FALSE` | +| `selection.prob` | Proportion of the trials starting on the first level of `treat.level` to keep when `selection.random = TRUE` | Numeric double (0, 1] | `0.8` | +| `selection.random` | Whether to randomly subsample, without replacement, the trials starting on the first level of `treat.level` (e.g. the untreated), keeping all other trials | Logical | `FALSE` | | `subgroup` | Column name for subgroup analysis | Character | `"sex"` | | `survival.max` | Maximum value for Risk/Survival curves | Numeric double | `60` | | `trial.include` | Whether to include `trial` and `trial_squared` in outcome models | Logical | `TRUE` | @@ -80,6 +80,7 @@ In general these only affect analytic methods of 'dose-response' and 'censoring' | `weight.lower` | Lower truncation for weight values | Numeric double | `0.0` | | `weight.p99` | Whether to truncate weights at the 1st and 99th percentiles | Logical | `TRUE` | | `weight.preexpansion` | Whether weighting should be done on pre-expanded data | Logical | `TRUE` | +| `weight.stabilized` | Use stabilized IP weights; `FALSE` fits no numerator models, giving unstabilized treatment weights | Logical | `TRUE` | | `weight.spline` | Whether the default weight models should model time with a natural cubic spline rather than a quadratic | Logical | `TRUE` | | `weight.spline.df` | Degrees of freedom passed to `splines::ns()` when `weight.spline = TRUE` | Integer | `4L` | | `weight.upper` | Upper truncation for weight values | Numeric double | `10.0` | diff --git a/justfile b/justfile index e9162cec..2337913f 100644 --- a/justfile +++ b/justfile @@ -12,3 +12,5 @@ dev: readme: Rscript -e "rmarkdown::render('README.Rmd', output_options = list(html_preview = FALSE))" cp README.md ../README.md +test: + Rscript -e "devtools::test()"