@@ -63,6 +63,11 @@ trunc_probs <- function(probs, trunc = 0.01) {
63
63
}
64
64
65
65
.check_censor_model <- function (x ) {
66
+ if (x $ spec $ mode != " censored regression" ) {
67
+ cli :: cli_abort(
68
+ " The model needs to be for mode 'censored regression', not for mode '{x$spec$mode}'."
69
+ )
70
+ }
66
71
nms <- names(x )
67
72
if (! any(nms == " censor_probs" )) {
68
73
rlang :: abort(" Please refit the model with parsnip version 1.0.4 or greater." )
@@ -245,14 +250,17 @@ add_graf_weights_vec <- function(object, .pred, surv_obj, trunc = 0.05, eps = 10
245
250
num_times <- vctrs :: list_sizes(.pred )
246
251
y <- vctrs :: list_unchop(.pred )
247
252
y $ surv_obj <- vctrs :: vec_rep_each(surv_obj , times = num_times )
253
+
248
254
names(y )[names(y ) == " .time" ] <- " .eval_time" # Temporary
255
+
249
256
# Compute the actual time of evaluation
250
257
y $ .weight_time <- graf_weight_time_vec(y $ surv_obj , y $ .eval_time , eps = eps )
251
258
# Compute the corresponding probability of being censored
252
259
y $ .pred_censored <- predict(object $ censor_probs , time = y $ .weight_time , as_vector = TRUE )
253
260
y $ .pred_censored <- trunc_probs(y $ .pred_censored , trunc = trunc )
254
261
# Invert the probabilities to create weights
255
262
y $ .weight_censored = 1 / y $ .pred_censored
263
+
256
264
# Convert back the list column format
257
265
y $ surv_obj <- NULL
258
266
vctrs :: vec_chop(y , sizes = num_times )
0 commit comments