Support for survival models?

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.24.0.7
+Version: 0.24.0.8
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

NAMESPACE

@@ -334,6 +334,7 @@ S3method(model_parameters,stanfit)
 S3method(model_parameters,stanmvreg)
 S3method(model_parameters,stanreg)
 S3method(model_parameters,summary_emm)
+S3method(model_parameters,survfit)
 S3method(model_parameters,svy2lme)
 S3method(model_parameters,svyglm)
 S3method(model_parameters,svytable)

NEWS.md

@@ -2,6 +2,8 @@
 
 ## Changes
 
+* `model_parameters()` now supports objects of class `survfit`.
+
 * `model_parameters()` now gives informative error messages for more model
   classes than before when the function fails to extract model parameters.
 

R/methods_survival.R

@@ -1,4 +1,53 @@
-# classes: .coxph, .aareg, .survreg, .riskRegression
+# classes: .coxph, .aareg, .survreg, .riskRegression, .survfit
+
+#################### .survfit ------
+
+#' @export
+model_parameters.survfit <- function(model,
+                                     keep = NULL,
+                                     drop = NULL,
+                                     verbose = TRUE,
+                                     ...) {
+  s <- summary(model)
+  # extract all elements with same length, which occur most in that list
+  # that is the data we need
+  uniqv <- unique(lengths(s))
+  tab <- tabulate(match(lengths(s), uniqv))
+  idx <- which.max(tab)
+  most_len <- uniqv[idx]
+
+  # convert list into data frame, only for elements of same length
+  params <- as.data.frame(s[lengths(s) == most_len])
+
+  # keep specific columns
+  keep_columns <- intersect(
+    c("time", "n.risk", "n.event", "surv", "std.err", "strata", "lower", "upper"),
+    colnames(params)
+  )
+  params <- params[keep_columns]
+
+  # rename
+  params <- datawizard::data_rename(
+    params,
+    select = c(
+      Time = "time", `N Risk` = "n.risk", `N Event` = "n.event", Survival = "surv",
+      SE = "std.err", Group = "strata", CI_low = "lower", CI_high = "upper"
+    )
+  )
+
+  # fix labels
+  params$Group <- gsub("x=", "", params$Group, fixed = TRUE)
+
+  # These are integers, need to be character to display without decimals
+  params$Time <- as.character(params$Time)
+  params[["N Risk"]] <- as.character(params[["N Risk"]])
+  params[["N Event"]] <- as.character(params[["N Event"]])
+
+  attr(params, "ci") <- s$conf.int
+  class(params) <- c("parameters_model", "see_parameters_model", class(params))
+
+  params
+}
 
 
 #################### .coxph ------
@@ -114,7 +163,7 @@
 
 #' @export
 standard_error.riskRegression <- function(model, ...) {
   junk <- utils::capture.output(cs <- stats::coef(model))
   .data_frame(
     Parameter = .remove_backticks_from_string(as.vector(cs[, 1])),
     SE = as.numeric(cs[, "StandardError"])
@@ -124,7 +173,7 @@
 
 #' @export
 p_value.riskRegression <- function(model, ...) {
   junk <- utils::capture.output(cs <- stats::coef(model))
   .data_frame(
     Parameter = .remove_backticks_from_string(as.vector(cs[, 1])),
     p = as.numeric(cs[, "Pvalue"])