|
1 | 1 | # ---
|
2 | 2 | # repo: tidymodels/parsnip
|
3 | 3 | # file: standalone-survival.R
|
4 |
| -# last-updated: 2023-05-18 |
| 4 | +# last-updated: 2023-06-14 |
5 | 5 | # license: https://unlicense.org
|
6 | 6 | # ---
|
7 | 7 |
|
|
14 | 14 | #
|
15 | 15 | # 2023-05-18
|
16 | 16 | # * added time to factor conversion
|
| 17 | +# |
| 18 | +# 2023-06-14 |
| 19 | +# * removed time to factor conversion |
17 | 20 |
|
18 | 21 | # @param surv A [survival::Surv()] object
|
19 | 22 | # @details
|
|
22 | 25 | #
|
23 | 26 | # `.extract_status()` will return the data as 0/1 even if the original object
|
24 | 27 | # used the legacy encoding of 1/2. See [survival::Surv()].
|
25 |
| -# |
26 |
| -# `.time_as_binary_event()` takes a Surv object and converts it to a binary |
27 |
| -# outcome (if possible). |
28 | 28 |
|
29 | 29 | # @return
|
30 | 30 | # - `.extract_surv_status()` returns a vector.
|
31 | 31 | # - `.extract_surv_time()` returns a vector when the type is `"right"` or `"left"`
|
32 | 32 | # and a tibble otherwise.
|
33 |
| -# - `.time_as_binary_event()` returns a two-level factor. |
34 | 33 | # - Functions starting with `.is_` or `.check_` return logicals although the
|
35 | 34 | # latter will fail when `FALSE`.
|
36 | 35 |
|
|
91 | 90 | }
|
92 | 91 | res
|
93 | 92 | }
|
94 |
| - |
95 |
| -.time_as_binary_event <- function(surv, eval_time) { |
96 |
| - eval_time <- eval_time[!is.na(eval_time)] |
97 |
| - eval_time <- eval_time[eval_time >= 0 & is.finite(eval_time)] |
98 |
| - eval_time <- unique(eval_time) |
99 |
| - if (length(eval_time) != 1 || !is.numeric(eval_time)) { |
100 |
| - stop("'eval_time' should be a single, complete, finite numeric value.") |
101 |
| - } |
102 |
| - |
103 |
| - event_time <- .extract_surv_time(surv) |
104 |
| - status <- .extract_surv_status(surv) |
105 |
| - is_event_before_t <- event_time <= eval_time & status == 1 |
106 |
| - # Three possible contributions to the statistic from Graf 1999 |
107 |
| - # Censoring time before eval_time, no contribution (Graf category 3) |
108 |
| - binary_res <- rep(NA_character_, length(event_time)) |
109 |
| - # A real event prior to eval_time (Graf category 1) |
110 |
| - binary_res <- ifelse(is_event_before_t, "event", binary_res) |
111 |
| - # Observed time greater than eval_time (Graf category 2) |
112 |
| - binary_res <- ifelse(event_time > eval_time, "non-event", binary_res) |
113 |
| - factor(binary_res, levels = c("event", "non-event")) |
114 |
| -} |
115 | 93 | # nocov end
|
0 commit comments