1#' @templateVar class cch
2#' @template title_desc_tidy
3#'
4#' @param x An `cch` object returned from [survival::cch()].
5#' @param conf.level confidence level for CI
6#' @template param_unused_dots
7#'
8#' @evalRd return_tidy(regression = TRUE)
9#'
10#' @examples
11#'
12#' if (requireNamespace("survival", quietly = TRUE)) {
13#'
14#' library(survival)
15#'
16#' # examples come from cch documentation
17#' subcoh <- nwtco$in.subcohort
18#' selccoh <- with(nwtco, rel == 1 | subcoh == 1)
19#' ccoh.data <- nwtco[selccoh, ]
20#' ccoh.data$subcohort <- subcoh[selccoh]
21#' ## central-lab histology
22#' ccoh.data$histol <- factor(ccoh.data$histol, labels = c("FH", "UH"))
23#' ## tumour stage
24#' ccoh.data$stage <- factor(ccoh.data$stage, labels = c("I", "II", "III", "IV"))
25#' ccoh.data$age <- ccoh.data$age / 12 # Age in years
26#'
27#' fit.ccP <- cch(Surv(edrel, rel) ~ stage + histol + age,
28#'   data = ccoh.data,
29#'   subcoh = ~subcohort, id = ~seqno, cohort.size = 4028
30#' )
31#'
32#' tidy(fit.ccP)
33#'
34#' # coefficient plot
35#' library(ggplot2)
36#' ggplot(tidy(fit.ccP), aes(x = estimate, y = term)) +
37#'   geom_point() +
38#'   geom_errorbarh(aes(xmin = conf.low, xmax = conf.high), height = 0) +
39#'   geom_vline(xintercept = 0)
40#'
41#' }
42#'
43#' @aliases cch_tidiers
44#' @export
45#' @seealso [tidy()], [survival::cch()]
46#' @family cch tidiers
47#' @family survival tidiers
48tidy.cch <- function(x, conf.level = .95, ...) {
49  s <- summary(x)
50  co <- stats::coefficients(s)
51
52  ret <- as_tidy_tibble(
53    co,
54    new_names = c("estimate", "std.error", "statistic", "p.value")
55  )
56
57  # add confidence interval
58  ci <- unrowname(stats::confint(x, level = conf.level))
59  colnames(ci) <- c("conf.low", "conf.high")
60  as_tibble(cbind(ret, ci))
61}
62
63
64#' @templateVar class cch
65#' @template title_desc_glance
66#'
67#' @inherit tidy.cch params examples
68#'
69#' @evalRd return_glance(
70#'   "score",
71#'   "rscore",
72#'   "p.value",
73#'   "iter",
74#'   n = "number of predictions",
75#'   nevent = "number of events"
76#' )
77#'
78#' @export
79#' @seealso [glance()], [survival::cch()]
80#' @family cch tidiers
81#' @family survival tidiers
82glance.cch <- function(x, ...) {
83  ret <- purrr::compact(unclass(x)[c(
84    "score", "rscore", "wald.test", "iter",
85    "n", "nevent"
86  )])
87  ret <- as_tibble(ret)
88  rename(ret, p.value = wald.test)
89}
90