From d889ec8786e5143bf149eda13eb1b004045ff04d Mon Sep 17 00:00:00 2001 From: Hannah Frick Date: Mon, 10 Jun 2024 19:33:33 +0100 Subject: [PATCH] remove obsolete helpers --- R/aaa_survival_prob.R | 105 ------------------------------------------ 1 file changed, 105 deletions(-) diff --git a/R/aaa_survival_prob.R b/R/aaa_survival_prob.R index cee210b..9683334 100644 --- a/R/aaa_survival_prob.R +++ b/R/aaa_survival_prob.R @@ -116,111 +116,6 @@ available_survfit_summary_elements <- function(object) { ) } -survfit_summary_patch_infinite_time <- function(object, eval_time) { - time_neg_inf <- is.infinite(eval_time) & (eval_time < 0) - time_inf <- is.infinite(eval_time) & (eval_time > 0) - - patch_neg_inf <- function(x, value, n_patch) { - rbind( - matrix(value, nrow = n_patch, ncol = ncol(x)), - x - ) - } - patch_inf <- function(x, value, n_patch) { - rbind( - x, - matrix(value, nrow = n_patch, ncol = ncol(x)) - ) - } - - # glmnet does not provide standard errors etc - has_std_error <- "std.err" %in% names(object) - - if (any(time_neg_inf)) { - object$surv <- patch_neg_inf( - object$surv, - value = 1, - n_patch = sum(time_neg_inf) - ) - object$cumhaz <- patch_neg_inf( - object$cumhaz, - value = 0, - n_patch = sum(time_neg_inf) - ) - if (has_std_error) { - object$std.err <- patch_neg_inf( - object$std.err, - value = NA_real_, - n_patch = sum(time_neg_inf) - ) - object$lower <- patch_neg_inf( - object$lower, - value = NA_real_, - n_patch = sum(time_neg_inf) - ) - object$upper <- patch_neg_inf( - object$upper, - value = NA_real_, - n_patch = sum(time_neg_inf) - ) - object$std.chaz <- patch_neg_inf( - object$std.chaz, - value = NA_real_, - n_patch = sum(time_neg_inf) - ) - } - } - if (any(time_inf)) { - object$surv <- patch_inf(object$surv, value = 0, n_patch = sum(time_inf)) - object$cumhaz <- patch_inf( - object$cumhaz, - value = 1, - n_patch = sum(time_inf) - ) - if (has_std_error) { - object$std.err <- patch_inf( - object$std.err, - value = NA_real_, - n_patch = sum(time_inf) - ) - object$lower <- patch_inf( - object$lower, - value = NA_real_, - n_patch = sum(time_inf) - ) - object$upper <- patch_inf( - object$upper, - value = NA_real_, - n_patch = sum(time_inf) - ) - object$std.chaz <- patch_inf( - object$std.chaz, - value = NA_real_, - n_patch = sum(time_inf) - ) - } - } - - object -} - -survfit_summary_restore_time_order <- function(object, eval_time) { - # preserve original order of `eval_time` because `summary()` returns a result for - # an ordered vector of finite time - # Note that this requires a survfit summary object which has already been - # patched for infinite time points - original_order_time <- match(eval_time, sort(eval_time)) - - elements <- available_survfit_summary_elements(object) - - # restore original order of prediction time points - for (i in elements) { - object[[i]] <- object[[i]][original_order_time, , drop = FALSE] - } - - object -} - survfit_summary_patch_missings <- function(object, index_missing, eval_time, n_obs) { if (is.null(index_missing)) { return(object)