ewenharrison / finalfit
1
#' Competing risks univariable regression: \code{finalfit} model wrapper
2
#'
3
#' Using \code{finalfit} conventions, produces univariable Competing Risks
4
#' Regression models for a set of explanatory variables.
5
#'
6
#' Uses \code{\link[cmprsk]{crr}} with \code{finalfit} modelling conventions.
7
#' Output can be passed to \code{\link{fit2df}}.
8
#'
9
#' @param .data Data frame or tibble.
10
#' @param dependent Character vector of length 1: name of survival object in
11
#'   form \code{Surv(time, status)}. \code{Status} default values should be 0
12
#'   censored (e.g. alive), 1 event of interest (e.g. died of disease of
13
#'   interest), 2 competing event (e.g. died of other cause).
14
#' @param explanatory Character vector of any length: name(s) of explanatory
15
#'   variables.
16
#' @param ... Other arguments to \code{\link[cmprsk]{crr}}
17
#' @return A list of univariable \code{\link[cmprsk]{crr}} fitted models class
18
#'   \code{crrlist}.
19
#'
20
#' @seealso \code{\link{fit2df}, \link{finalfit_merge}}
21
#' @family finalfit model wrappers
22
#' @export
23
#'
24
#' @examples
25
#' library(dplyr)
26
#' melanoma = boot::melanoma
27
#' melanoma = melanoma %>%
28
#'   mutate(
29
#'     # Cox PH to determine cause-specific hazards
30
#'     status_coxph = ifelse(status == 2, 0, # "still alive"
31
#'       ifelse(status == 1, 1, # "died of melanoma"
32
#'         0)), # "died of other causes is censored"
33
#'         
34
#'     # Fine and Gray to determine subdistribution hazards
35
#'     status_crr = ifelse(status == 2, 0, # "still alive"
36
#'       ifelse(status == 1, 1, # "died of melanoma"
37
#'         2)), # "died of other causes"
38
#'     sex = factor(sex),
39
#'     ulcer = factor(ulcer)
40
#'   )
41
#'
42
#' dependent_coxph = c("Surv(time, status_coxph)")
43
#' dependent_crr = c("Surv(time, status_crr)")
44
#' explanatory = c("sex", "age", "ulcer")
45
#' 
46
#' # Create single well-formatted table
47
#' melanoma %>%
48
#'   summary_factorlist(dependent_crr, explanatory, column = TRUE, fit_id = TRUE) %>%
49
#'   ff_merge(
50
#'     melanoma %>%
51
#'       coxphmulti(dependent_coxph, explanatory) %>%
52
#'       fit2df(estimate_suffix = " (Cox PH multivariable)")
53
#'     ) %>%
54
#'   ff_merge(
55
#'     melanoma %>%
56
#'       crrmulti(dependent_crr, explanatory) %>%
57
#'       fit2df(estimate_suffix = " (competing risks multivariable)")
58
#'     ) %>%
59
#'   select(-fit_id, -index) %>%
60
#'   dependent_label(melanoma, dependent_crr)
61

62
crruni <- function(.data, dependent, explanatory, ...){
63 1
  result = list()
64
  
65
  # Keep survival object grammar, split into terms
66 1
  dependent = dependent %>% 
67 1
    gsub("Surv\\(", "", .) %>% 
68 1
    gsub("\\)", "", .) %>% 
69 1
    strsplit(",") %>% 
70 1
    unlist() %>% 
71 1
    trimws()
72
  
73 1
  ftime = .data %>% 
74 1
    dplyr::pull(dependent[1])
75 1
  fstatus = .data %>% 
76 1
    dplyr::pull(dependent[2])
77

78 1
  for (i in 1:length(explanatory)){
79 1
    cov1 = model.matrix(as.formula(paste0("~", explanatory[i])), .data)[,-1, drop = FALSE] 
80 1
    result[[i]] = cmprsk::crr(ftime, fstatus, cov1, ...)
81
  }
82
  
83 1
  class(result) = "crrlist"
84 1
  return(result)
85
}

Read our documentation on viewing source code .

Loading