Skip to content

Commit

Permalink
fix: resolves #35 by forcing bounds and performing iso_reg on all boo…
Browse files Browse the repository at this point in the history 
…tstrap samples individually
  • Loading branch information
@RobinDenz1
RobinDenz1 committed Aug 14, 2024
1 parent e20a742 commit 4331d0c
Show file tree
Hide file tree
Showing 4 changed files with 122 additions and 7 deletions.
19 changes: 16 additions & 3 deletions R/adjustedcif.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -318,7 +318,8 @@ adjustedcif <- function(data, variable, ev_time, event, cause, method,
adjustedcif_boot(data=data, variable=variable, ev_time=ev_time,
event=event, method=method, times=times, i=i,
cif_fun=cif_fun, cause=cause,
na.action=na.action, ...)
na.action=na.action, force_bounds=force_bounds,
iso_reg=iso_reg, ...)
}
parallel::stopCluster(cl)

Expand All @@ -331,7 +332,9 @@ adjustedcif <- function(data, variable, ev_time, event, cause, method,
method=method,
times=times, i=i, cause=cause,
cif_fun=cif_fun,
na.action=na.action, ...)
na.action=na.action,
force_bounds=force_bounds,
iso_reg=iso_reg, ...)
}
}

Expand Down Expand Up @@ -412,7 +415,8 @@ adjustedcif <- function(data, variable, ev_time, event, cause, method,

## perform one bootstrap iteration
adjustedcif_boot <- function(data, variable, ev_time, event, cause, method,
times, i, cif_fun, na.action, ...) {
times, i, cif_fun, na.action, force_bounds,
iso_reg, ...) {

# draw sample
indices <- sample(x=rownames(data), size=nrow(data), replace=TRUE)
Expand Down Expand Up @@ -452,6 +456,15 @@ adjustedcif_boot <- function(data, variable, ev_time, event, cause, method,

method_results <- R.utils::doCall(cif_fun, args=args, .ignoreUnusedArgs=FALSE)
adj_boot <- method_results$plotdata

if (force_bounds) {
adj_boot <- force_bounds_est(adj_boot)
}

if (iso_reg) {
adj_boot <- iso_reg_est(adj_boot, na_ignore=TRUE)
}

adj_boot$boot <- i

return(adj_boot)
Expand Down
17 changes: 15 additions & 2 deletions R/adjustedsurv.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -333,7 +333,8 @@ adjustedsurv <- function(data, variable, ev_time, event, method,
adjustedsurv_boot(data=data, variable=variable, ev_time=ev_time,
event=event, method=method,
times=times, i=i, surv_fun=surv_fun,
na.action=na.action, ...)
na.action=na.action, force_bounds=force_bounds,
iso_reg=iso_reg, ...)
}
parallel::stopCluster(cl)

Expand All @@ -347,6 +348,8 @@ adjustedsurv <- function(data, variable, ev_time, event, method,
times=times, i=i,
surv_fun=surv_fun,
na.action=na.action,
force_bounds=force_bounds,
iso_reg=iso_reg,
...)
}
}
Expand Down Expand Up @@ -437,7 +440,8 @@ adjustedsurv <- function(data, variable, ev_time, event, method,

## perform one bootstrap iteration
adjustedsurv_boot <- function(data, variable, ev_time, event, method,
times, i, surv_fun, na.action, ...) {
times, i, surv_fun, na.action, force_bounds,
iso_reg, ...) {

# draw sample
indices <- sample(x=rownames(data), size=nrow(data), replace=TRUE)
Expand Down Expand Up @@ -485,6 +489,15 @@ adjustedsurv_boot <- function(data, variable, ev_time, event, method,
method_results <- R.utils::doCall(surv_fun, args=args,
.ignoreUnusedArgs=FALSE)
adj_boot <- method_results$plotdata

if (force_bounds) {
adj_boot <- force_bounds_est(adj_boot)
}

if (iso_reg) {
adj_boot <- iso_reg_est(adj_boot, na_ignore=TRUE)
}

adj_boot$boot <- i

return(adj_boot)
Expand Down
13 changes: 11 additions & 2 deletions R/helper_functions.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -499,13 +499,17 @@ add_rows_with_zero <- function(plotdata, mode="surv") {
}

## perform isotonic regression on survival / CIF estimates
iso_reg_est <- function(plotdata) {
iso_reg_est <- function(plotdata, na_ignore=FALSE) {

mode <- ifelse("surv" %in% colnames(plotdata), "surv", "cif")

if (anyNA(plotdata[, mode])) {
any_mis <- anyNA(plotdata[, mode])
if (any_mis & !na_ignore) {
stop("Isotonic Regression cannot be used when there are missing",
" values in the final estimates.")
} else if (any_mis & na_ignore) {
plotdata_na <- plotdata[is.na(plotdata[, mode]), ]
plotdata <- plotdata[!is.na(plotdata[, mode]), ]
}

for (lev in levels(plotdata$group)) {
Expand All @@ -527,6 +531,11 @@ iso_reg_est <- function(plotdata) {
}
}

if (any_mis & na_ignore) {
plotdata <- rbind(plotdata, plotdata_na)
plotdata <- plotdata[order(plotdata$group, plotdata$time), ]
}

return(plotdata)
}

Expand Down
80 changes: 80 additions & 0 deletions tests/testthat/test_general_stuff.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -251,3 +251,83 @@ test_that("adjustedcif, NA in relevant data when using weights", {
" 'treatment_model' argument if there are missing",
" values in relevant columns of 'data'."))
})

test_that("adjustedsurv, using force_bounds and iso_reg with bootstrapping", {
set.seed(435)
adj_without <- adjustedsurv(data=sim_dat,
variable="group",
ev_time="time",
event="event",
method="iptw_pseudo",
treatment_model=group ~ x1 + x2,
bootstrap=TRUE,
n_boot=10,
force_bounds=FALSE,
iso_reg=FALSE,
conf_int=FALSE,
na.action="na.omit")
min_without <- min(adj_without$boot_data$surv, na.rm=TRUE)
max_without <- max(adj_without$boot_data$surv, na.rm=TRUE)

set.seed(435)
adj_with <- adjustedsurv(data=sim_dat,
variable="group",
ev_time="time",
event="event",
method="iptw_pseudo",
treatment_model=group ~ x1 + x2,
bootstrap=TRUE,
n_boot=10,
force_bounds=TRUE,
iso_reg=TRUE,
conf_int=FALSE,
na.action="na.omit")
min_with <- min(adj_with$boot_data$surv, na.rm=TRUE)
max_with <- max(adj_with$boot_data$surv, na.rm=TRUE)

expect_true(min_without < 0)
expect_true(max_without > 1)
expect_true(min_with==0)
expect_true(max_with==1)
})

test_that("adjustedcif, using force_bounds and iso_reg with bootstrapping", {
set.seed(435)
adj_without <- suppressWarnings(adjustedcif(data=sim_dat,
variable="group",
ev_time="time",
event="event",
method="iptw_pseudo",
treatment_model=group ~ x1 + x2,
bootstrap=TRUE,
n_boot=10,
force_bounds=FALSE,
iso_reg=FALSE,
conf_int=FALSE,
na.action="na.omit",
cause=1))
min_without <- min(adj_without$boot_data$cif, na.rm=TRUE)
max_without <- max(adj_without$boot_data$cif, na.rm=TRUE)

set.seed(435)
adj_with <- suppressWarnings(adjustedcif(data=sim_dat,
variable="group",
ev_time="time",
event="event",
method="iptw_pseudo",
treatment_model=group ~ x1 + x2,
bootstrap=TRUE,
n_boot=10,
force_bounds=TRUE,
iso_reg=TRUE,
conf_int=FALSE,
na.action="na.omit",
cause=1))
min_with <- min(adj_with$boot_data$cif, na.rm=TRUE)
max_with <- max(adj_with$boot_data$cif, na.rm=TRUE)

expect_true(min_without < 0)
expect_true(max_without > 1)
expect_true(min_with==0)
expect_true(max_with==1)
})

0 comments on commit 4331d0c

Please sign in to comment.