add print method for s_survival and s_coxph classes and add tests

DESCRIPTION

@@ -19,6 +19,7 @@ Imports:
     DescTools,
     dplyr,
     emmeans,
+    formatters,
     lifecycle,
     lubridate,
     magrittr,

NAMESPACE

@@ -2,7 +2,9 @@
 
 S3method(print,or_ci)
 S3method(print,prop_ci)
+S3method(print,s_coxph)
 S3method(print,s_lsmeans)
+S3method(print,s_survival)
 export("%>%")
 export(Surv)
 export(derive_bor)
@@ -30,6 +32,7 @@ importFrom(dplyr,rowwise)
 importFrom(dplyr,select)
 importFrom(dplyr,summarise)
 importFrom(dplyr,ungroup)
+importFrom(formatters,format_value)
 importFrom(lifecycle,deprecated)
 importFrom(lubridate,days)
 importFrom(lubridate,ymd)
@@ -45,6 +48,7 @@ importFrom(stats,pbeta)
 importFrom(stats,quantile)
 importFrom(stats,rbinom)
 importFrom(stats,setNames)
+importFrom(survival,Surv)
 importFrom(survival,coxph)
 importFrom(survival,strata)
 importFrom(survminer,pairwise_survdiff)

R/package.R

@@ -15,8 +15,13 @@
 #' @importFrom survminer pairwise_survdiff
 #' @importFrom lubridate ymd days
 #' @importFrom utils combn
+#' @importFrom formatters format_value
 NULL
 
+#' @importFrom survival Surv
+#' @export
+survival::Surv
+
 utils::globalVariables(c(
   "ADT", "ADT.x", "ADT.y", "AVAL", "AVALC", "AVALC.x", "AVALC.y", "."
 ))

R/pkg-methods.R

@@ -74,3 +74,203 @@ print.or_ci <- function(x, ...) {
 
   invisible(x)
 }
+
+
+#' @describeIn s_get_survfit prints survival analysis summary from `survfit`.
+#' @exportS3Method
+#' @keywords internal
+print.s_survival <- function(x, ...) {
+  cat("Surv formula: ", x$params$formula, "\n", sep = "")
+  cat("Group by: ", paste(unique(x$surv$quantile$group), collapse = ", "), "\n", sep = "")
+  if (!is.null(x$params$strata)) {
+    cat("Stratified by: ", paste(x$params$strata, collapse = ", "), "\n", sep = "")
+  }
+  cat("Confidence interval type: ", x$params$conf_type, "\n", sep = "")
+
+  cat("\n---\n")
+  cat("Estimation of Survival Time:\n")
+  med <- x$surv$median %>%
+    rowwise() %>%
+    mutate(
+      `n(event)` = format_value(c(.data$n, .data$events), format = "xx (xx)"),
+      Median = format_value(c(.data$median, .data$lower, .data$upper),
+        format = "xx.xx (xx.xx - xx.xx)"
+      )
+    ) %>%
+    select("group", "n(event)", "Median")
+  quant <- x$surv$quantile %>%
+    rowwise() %>%
+    mutate(
+      surv = format_value(c(.data$time, .data$lower, .data$upper),
+        format = "xx.xx (xx.xx - xx.xx)"
+      )
+    ) %>%
+    tidyr::pivot_wider(
+      id_cols = "group",
+      names_from = "quantile",
+      names_glue = "Q{quantile}",
+      values_from = "surv"
+    )
+  rang <- x$surv$range %>%
+    rowwise() %>%
+    mutate(
+      `Range (event)` = format_value(c(.data$event_min, .data$event_max),
+        format = "(xx.x, xx.x)"
+      ),
+      `Range (censor)` = format_value(c(.data$censor_min, .data$censor_max),
+        format = "(xx.x, xx.x)"
+      ),
+      `Range` = format_value(c(.data$min, .data$max),
+        format = "(xx.x, xx.x)"
+      )
+    ) %>%
+    select("group", "Range (event)", "Range (censor)", "Range")
+  list(med, quant, rang) %>%
+    purrr::reduce(full_join, by = "group") %>%
+    tidyr::pivot_longer(cols = -1, values_to = "Value", names_to = "Stat") %>%
+    tidyr::pivot_wider(names_from = "group", values_from = "Value") %>%
+    tibble::column_to_rownames(var = "Stat") %>%
+    print()
+  cat("\n")
+
+
+  if (!is.null(x$surv$time_point)) {
+    cat("---\n")
+    cat(
+      "Survival Time at Specified Time Points (",
+      paste(unique(x$surv$time_point$time), collapse = ","), "):\n",
+      sep = ""
+    )
+    # print(x$surv$time_point)
+    x$surv$time_point %>%
+      rowwise() %>%
+      mutate(
+        `Number at risk` = as.character(.data$n.risk),
+        `Number of event` = as.character(.data$n.event),
+        `Number of consor` = as.character(.data$n.censor),
+        `Survival Rate` = format_value(c(.data$surv, .data$lower, .data$upper),
+          format = "xx.xx (xx.xx - xx.xx)"
+        )
+      ) %>%
+      select(
+        "time", "Number at risk", "Number of event",
+        "Number of consor", "Survival Rate", "group"
+      ) %>%
+      ungroup() %>%
+      dplyr::group_split(.data$time) %>%
+      purrr::walk(.f = function(dt) {
+        dt %>%
+          select(-1) %>%
+          tidyr::pivot_longer(cols = -c("group"), values_to = "Value", names_to = "Stat") %>%
+          tidyr::pivot_wider(names_from = "group", values_from = "Value") %>%
+          tibble::column_to_rownames(var = "Stat") %>%
+          print()
+        cat("\n")
+      })
+  }
+
+  if (!is.null(x$surv_diff$rate)) {
+    cat("---\n")
+    cat(
+      "Survival Difference at Specified Time Points (",
+      paste(unique(x$surv$time_point$time), collapse = ","), "):\n",
+      sep = ""
+    )
+    x$surv_diff$rate %>%
+      rowwise() %>%
+      mutate(
+        `Diff (Survival Rate)` = format_value(c(.data$surv.diff, .data$lower, .data$upper),
+          format = "xx.xx (xx.xx - xx.xx)"
+        ),
+        `p-value` = format_value(.data$pval, "x.xxxx | (<0.0001)")
+      ) %>%
+      select(
+        "time", "Diff (Survival Rate)", "p-value", "group"
+      ) %>%
+      ungroup() %>%
+      dplyr::group_split(.data$time) %>%
+      purrr::walk(.f = function(dt) {
+        dt %>%
+          select(-1) %>%
+          tidyr::pivot_longer(cols = -c("group"), values_to = "Value", names_to = "Stat") %>%
+          tidyr::pivot_wider(names_from = "group", values_from = "Value") %>%
+          tibble::column_to_rownames(var = "Stat") %>%
+          print()
+        cat("\n")
+      })
+  }
+
+  method <- if (x$params$rho == 0) {
+    "Log-Rank"
+  } else if (x$params$rho == 1) {
+    "Peto & Peto"
+  }
+  if (!is.null(x$surv_diff$test)) {
+    cat("---\n")
+    cat("Hypothesis Testing with ", method, ":\n", sep = "")
+    x$surv_diff$test %>%
+      tidyr::pivot_wider(names_from = "comparsion", values_from = "pval") %>%
+      tibble::column_to_rownames(var = "method") %>%
+      print()
+  }
+
+  invisible(x)
+}
+
+#' @describeIn s_get_coxph prints survival analysis summary from `coxph`.
+#' @exportS3Method
+#' @keywords internal
+print.s_coxph <- function(x, ...) {
+  cat("Surv formula: ", x$params$formula, "\n", sep = "")
+  cat("Group by: ", paste(x$params$group, collapse = ", "), "\n", sep = "")
+  if (!is.null(x$params$strata)) {
+    cat("Stratified by: ", paste(x$params$strata, collapse = ", "), "\n", sep = "")
+  }
+  cat("Tie method: ", x$params$ties, "\n", sep = "")
+  cat("P-value method for HR: ",
+    switch(x$params$pval_method,
+      all = paste(c("logtest", "sctest", "waldtest"), collapse = ", "),
+      log = "logtest",
+      sc = "sctest",
+      wald = "waldtest"
+    ),
+    "\n",
+    sep = ""
+  )
+
+  cat("\n---\n")
+  cat("Estimation of Hazard Ratio",
+    ifelse(!is.null(x$params$strata), " with Stratification", ""), ":\n",
+    sep = ""
+  )
+  hr <- x$hr %>%
+    rowwise() %>%
+    mutate(
+      `n(event)` = format_value(c(.data$n, .data$events), format = "xx (xx)"),
+      `Hazard Ratio` = format_value(c(.data$hr, .data$lower, .data$upper),
+        format = "xx.xx (xx.xx - xx.xx)"
+      )
+    ) %>%
+    select("comparsion", "n(event)", "Hazard Ratio")
+  pval <- x$pval %>%
+    rowwise() %>%
+    mutate(
+      pval = format_value(.data$pval, "x.xxxx | (<0.0001)")
+    ) %>%
+    select("comparsion", "method", "pval") %>%
+    tidyr::pivot_wider(
+      id_cols = "comparsion",
+      names_from = "method",
+      names_glue = "p-value ({method})",
+      values_from = "pval"
+    )
+
+  list(hr, pval) %>%
+    purrr::reduce(full_join, by = "comparsion") %>%
+    tidyr::pivot_longer(cols = -1, values_to = "Value", names_to = "Stat") %>%
+    tidyr::pivot_wider(names_from = "comparsion", values_from = "Value") %>%
+    tibble::column_to_rownames(var = "Stat") %>%
+    print()
+
+  invisible(x)
+}

R/summarize-survival.R

@@ -150,7 +150,8 @@ s_get_survfit <- function(data,
   # median survival time
   surv_tb <- if (is.null(km_fit$strata)) {
     broom::glance(km_fit) %>%
-      select(n = "nobs", "events", "median", lower = "conf.low", upper = "conf.high")
+      mutate(group = grps) %>%
+      select("group", n = "nobs", "events", "median", lower = "conf.low", upper = "conf.high")
   } else {
     tibble::as_tibble(summary(km_fit)$table) %>%
       mutate(group = grps) %>%
@@ -218,7 +219,8 @@ s_get_survfit <- function(data,
     survdiff <- h_pairwise_survdiff(
       formula = formula,
       strata = strata,
-      data = data
+      data = data,
+      rho = rho
     )
     tibble::tibble(
       comparsion = paste(bylist[, 1], bylist[, 2], sep = " vs. "),
@@ -320,6 +322,8 @@ s_get_survfit <- function(data,
 #'   )
 #' s_get_coxph(data = dat, formula = Surv(LENFOL, FSTAT) ~ AFB)
 #'
+#' s_get_coxph(data = dat, formula = Surv(LENFOL, FSTAT) ~ AFB, pval_method = "sc")
+#'
 #' # specify the stratified log-rank test
 #' s_get_coxph(
 #'   data = dat,
@@ -425,6 +429,7 @@ s_get_coxph <- function(data,
       pval = pval_tb,
       params = list(
         formula = format(formula),
+        group = paste(group_var, grps, sep = "="),
         ties = ties,
         conf_level = conf_level,
         strata = strata,

R/utils.R

@@ -13,20 +13,8 @@
 #' @return The result of calling `rhs(lhs)`.
 NULL
 
-#' Create a Survival Object
-#'
-#' A copy from [survival::Surv] in `survival` package.
-#'
-#' @inheritDotParams survival::Surv
-#'
-#' @return An object of class `Surv`.
-#' @export
-Surv <- function(...) {
-  survival::Surv(...)
-}
-
 #' @describeIn s_get_survfit a modified version of [survminer::pairwise_survdiff()]
-#' that can calculate the pairwise comparisons of survival curves regardless of
+#' that can calculates the pairwise comparisons of survival curves regardless of
 #' whether stratification is given.
 #'
 #' @export