From f87866d61708acc43821258f3853a14e43c9ca3e Mon Sep 17 00:00:00 2001 From: Marlena Bannick Date: Thu, 15 Oct 2026 14:53:28 -0700 Subject: [PATCH 1/2] Added reserved names check and test. --- R/robincar-tte.R | 9 ++++ R/utils-arg.R | 67 +++++++++++++++++++++++ tests/testthat/test-check-tte-reserved.R | 69 ++++++++++++++++++++++++ 3 files changed, 145 insertions(+) create mode 100644 tests/testthat/test-check-tte-reserved.R diff --git a/R/robincar-tte.R b/R/robincar-tte.R index a51edfc..d5de435 100644 --- a/R/robincar-tte.R +++ b/R/robincar-tte.R @@ -35,6 +35,15 @@ robincar_tte <- function(df, car_scheme="simple", return_influence=FALSE, id_col=NULL, finite_sample = FALSE){ .check.car_scheme(car_scheme, car_strata_cols) + .check.tte_reserved_names( + df=df, + treat_col=treat_col, + response_col=response_col, + event_col=event_col, + car_strata_cols=car_strata_cols, + covariate_cols=covariate_cols, + id_col=id_col + ) data <- .make.data( df=df, classname="RoboDataTTE", diff --git a/R/utils-arg.R b/R/utils-arg.R index 7a8fbb2..14a29a0 100644 --- a/R/utils-arg.R +++ b/R/utils-arg.R @@ -22,6 +22,73 @@ } } +# Names of columns that are created or overwritten internally when +# building and processing the time-to-event dataset (see adjust-tte.R, +# adjust-logrank.R, adjust-coxscore.R, adjust-covhr.R). User-supplied +# covariates with these names would be silently overwritten or clash. +.TTE.RESERVED.NAMES <- c( + # create.tte.df + "treat", "response", "event", "nu_d", "id", "carcov_z", "car_strata", + # process.tte.df + "Y", "Y0", "Y1", "trt0", "trt1", "n.events", + "cum.delta.Y0.over.Ysq", "cum.delta.Y1.over.Ysq", + "cum.delta.Y0.over.Ysq.theta_L", "cum.delta.Y1.over.Ysq.theta_L", + # get.ordered.data + "mu_t", "O.hat", "O.hat0", "O.hat1", "lin_pred", + "s0", "s1", "s0_seq", "s1_seq", + "mean_at_risk", "cumsum_at_risk", "mean_at_risk2", "cumsum_at_risk2", + "O_i", "u_i", + # calculate.adjustment and test statistics + "adjust1", "adjust0", "bsigb", + "uu_cl", "ssig_l", "U_SL_z", "var_adj", + "cond_var0", "cond_var1", "cond_mean0", "cond_mean1", "prob_z", "z_var" +) + +# Prefixes of internally generated columns (design matrix and regression betas) +.TTE.RESERVED.PREFIXES <- c("xmat_", "trt1_") + +.check.tte_reserved_names <- function(df, treat_col, response_col, event_col, + car_strata_cols=NULL, + covariate_cols=NULL, id_col=NULL){ + # Columns of df that are used as covariates are copied into the internal + # dataset, so they must not collide with internally created columns. + # Other user columns (treat, response, event, id, strata) are renamed + # internally, but we still check every column of df that is used. + used <- c(covariate_cols) + bad <- used[used %in% .TTE.RESERVED.NAMES] + prefix_pattern <- paste0("^(", paste0(.TTE.RESERVED.PREFIXES, collapse="|"), ")") + bad <- unique(c(bad, used[grepl(prefix_pattern, used)])) + if(length(bad) > 0){ + stop(paste0( + "The following covariate column(s) in df use reserved names that are ", + "overwritten internally and would produce incorrect results: ", + paste0(bad, collapse=", "), + ". Please rename these columns. Reserved names include: ", + paste0(.TTE.RESERVED.NAMES, collapse=", "), + "; and names beginning with: ", + paste0(.TTE.RESERVED.PREFIXES, collapse=", "), "." + )) + } + # Warn if the treatment/response/event/id/strata columns have reserved names + # that coincide with a *different* role (e.g. response column named "event"). + roles <- list(treat=treat_col, response=response_col, event=event_col, + id=id_col) + for(role in names(roles)){ + col <- roles[[role]] + if(!is.null(col) && col %in% .TTE.RESERVED.NAMES && col != role){ + stop(paste0("Column '", col, "' supplied as ", role, "_col has a reserved ", + "name used internally. Please rename it.")) + } + } + for(col in car_strata_cols){ + if(col %in% .TTE.RESERVED.NAMES){ + stop(paste0("car_strata column '", col, "' has a reserved name used ", + "internally. Please rename it.")) + } + } + invisible(TRUE) +} + .check.variance_type <- function(variance_type){ OPTIONS <- c(1, 2, 3) .check.options("variance_type", variance_type, OPTIONS) diff --git a/tests/testthat/test-check-tte-reserved.R b/tests/testthat/test-check-tte-reserved.R new file mode 100644 index 0000000..d71a3ea --- /dev/null +++ b/tests/testthat/test-check-tte-reserved.R @@ -0,0 +1,69 @@ +make_tte_df <- function(n=100){ + set.seed(0) + df <- data_gen( + n=n, theta=0, randomization="permuted_block", p_trt=0.5, case="case2" + ) + df$strata1 <- sample(letters[1:3], n, replace=TRUE) + df +} + +run_tte <- function(df, covariate_cols, ...){ + robincar_logrank( + df=df, + treat_col="I1", + response_col="t", + event_col="delta", + car_strata_cols="strata1", + covariate_cols=covariate_cols, + car_scheme="permuted-block", + adj_method="CL", + ... + ) +} + +test_that("covariates named s0 or s1 raise an error", { + df <- make_tte_df() + for(nm in c("s0", "s1")){ + d <- df + d[[nm]] <- d$model_z1 + expect_error(run_tte(d, c("model_z2", nm)), "reserved names") + } +}) + +test_that("all reserved covariate names raise an error", { + df <- make_tte_df() + for(nm in .TTE.RESERVED.NAMES){ + d <- df + d[[nm]] <- d$model_z1 + expect_error(run_tte(d, c("model_z2", nm)), "reserved names", info=nm) + } +}) + +test_that("reserved prefixes raise an error", { + df <- make_tte_df() + df$xmat_a <- df$model_z1 + df$trt1_a <- df$model_z1 + expect_error(run_tte(df, "xmat_a"), "reserved names") + expect_error(run_tte(df, "trt1_a"), "reserved names") +}) + +test_that("reserved names for strata and wrong roles raise an error", { + df <- make_tte_df() + df$s1 <- df$strata1 + expect_error( + robincar_logrank( + df=df, treat_col="I1", response_col="t", event_col="delta", + car_strata_cols="s1", car_scheme="permuted-block", adj_method="CL" + ), "reserved name") + df$event <- df$delta + expect_error( + robincar_logrank( + df=df, treat_col="I1", response_col="event", event_col="delta", + car_strata_cols="strata1", car_scheme="permuted-block", adj_method="CL" + ), "reserved name") +}) + +test_that("valid covariate names do not error", { + df <- make_tte_df() + expect_error(run_tte(df, c("model_z1", "model_z2")), NA) +}) From 5230de4990a93b13b81b243ca26be39f6fed0838 Mon Sep 17 00:00:00 2001 From: Marlena Bannick Date: Thu, 15 Oct 2026 15:43:16 -0700 Subject: [PATCH 2/2] Fixed tests. --- R/utils-arg.R | 3 ++- tests/testthat/test-logrank-ties.R | 6 +++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/R/utils-arg.R b/R/utils-arg.R index 14a29a0..457c7d0 100644 --- a/R/utils-arg.R +++ b/R/utils-arg.R @@ -28,7 +28,8 @@ # covariates with these names would be silently overwritten or clash. .TTE.RESERVED.NAMES <- c( # create.tte.df - "treat", "response", "event", "nu_d", "id", "carcov_z", "car_strata", + "treat", "response", "event", "nu_d", "carcov_z", "car_strata", + # note: "id" is only added when return_influence=TRUE, and is checked in model.R # process.tte.df "Y", "Y0", "Y1", "trt0", "trt1", "n.events", "cum.delta.Y0.over.Ysq", "cum.delta.Y1.over.Ysq", diff --git a/tests/testthat/test-logrank-ties.R b/tests/testthat/test-logrank-ties.R index 56b6f4b..d49d20f 100644 --- a/tests/testthat/test-logrank-ties.R +++ b/tests/testthat/test-logrank-ties.R @@ -101,7 +101,7 @@ test_that("Logrank ovarian", { # (1) Survdiff function lr <- survdiff(Surv(tte, obs) ~ rx, data = DATA) - lr_p <- lr$pvalue + lr_p <- pchisq(lr$chisq, df=1, lower.tail=FALSE) lr_num <- lr$obs[1] - lr$exp[1] lr_var <- lr$var[1, 1] / nrow(DATA) @@ -116,7 +116,7 @@ test_that("Logrank ovarian", { ) RC1res <- (2 * pnorm(abs(RC1$result$statistic), lower.tail = F)) - data <- DATA %>% select(t = tte) + data <- DATA %>% dplyr::select(t = tte) data$delta <- 1*(DATA$obs==T) data$I1 <- DATA$rx - 1 data$I0 <- 1 - data$I1 @@ -141,7 +141,7 @@ test_that("Logrank Ovarian with ties", { # (1) Survdiff function lr <- survdiff(Surv(tte, obs) ~ rx, data = DATA2) - lr_p <- lr$pvalue + lr_p <- pchisq(lr$chisq, df=1, lower.tail=FALSE) lr_num <- lr$obs[1] - lr$exp[1] lr_var <- lr$var[1, 1] / nrow(DATA)