From a4f78d707ddcda7f0594b5113f15e3158beb9739 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Tue, 7 Jan 2025 16:12:25 +0100
Subject: [PATCH] Support for survival models? (#1060)

Fixes #651
---
 DESCRIPTION          |  2 +-
 NAMESPACE            |  1 +
 NEWS.md              |  2 ++
 R/methods_survival.R | 51 +++++++++++++++++++++++++++++++++++++++++++-
 4 files changed, 54 insertions(+), 2 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 3b3cddc19..df2bc29a9 100644
--- a/DESCRIPTION
+++ b/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",
diff --git a/NAMESPACE b/NAMESPACE
index 5282042a9..eff06f921 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/NEWS.md b/NEWS.md
index ffe502d2c..1ba240f5a 100644
--- a/NEWS.md
+++ b/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.
 
diff --git a/R/methods_survival.R b/R/methods_survival.R
index b375dbd5d..b1928cfa1 100644
--- a/R/methods_survival.R
+++ b/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 ------