Adding Surv_CNSR() function

NAMESPACE

@@ -33,6 +33,7 @@ S3method(visr,survfit)
 S3method(visr,tidycuminc)
 export("%>%")
 export(Surv)
+export(Surv_CDISC)
 export(add_CI)
 export(add_CNSR)
 export(add_annotation)

R/Surv_CDISC.R

@@ -0,0 +1,56 @@
+#' Create a Survival Object from CDISC Data
+#'
+#' @description
+#' `r lifecycle::badge('experimental')`
+#'
+#' Create a survival object (e.g. `survival::Surv()`), which is usually used as
+#' the response variable in survival models.
+#' The function is designed to leverage the
+#' [CDISC ADaM ADTTE data model](https://www.cdisc.org/standards/foundational/adam/adam-basic-data-structure-bds-time-event-tte-analyses-v1-0)
+#' and more explicitly the conventions and controlled vocabulary of the data model.
+#'
+#' The `AVAL` and `CNSR` arguments are passed to
+#' `survival::Surv(time = AVAL, event = 1 - CNSR, type = 'right', origin = 0)`.
+#'
+#' @param AVAL The follow-up time. The follow-up time is assumed to originate from zero.
+#' When no argument is passed, the default value is a column/vector named `AVAL`
+#' @param CNSR The censoring indicator where `1=censored` and `0=death/event`.
+#' When no argument is passed, the default value is a column/vector named `CNSR`
+#'
+#' @return Object of class 'Surv'
+#' @seealso [`survival::Surv()`], [`estimate_KM()`]
+#' @export
+#'
+#' @examples
+#' survival::survfit(visR::Surv_CDISC() ~ SEX, data = adtte)
+#' adtte %>%
+#'  visR:: estimate_KM(formula = visR::Surv_CDISC() ~ SEX)
+#'
+#' # When using CDSIC data, you can specify arguments or rely on defaults
+#' with(adtte, visR::Surv_CDISC(AVAL, CNSR)) %>% head()
+#' with(adtte, visR::Surv_CDISC()) %>% head()
+
+Surv_CDISC <- function(AVAL, CNSR) {
+  # set default values if not passed by user -----------------------------------
+  if (missing(AVAL) && exists("AVAL", envir = rlang::caller_env()))
+    AVAL <- get("AVAL", envir = rlang::caller_env())
+  else if (missing(AVAL))
+    stop("Default 'AVAL' value not found. Specify argument in `Surv_CDISC(AVAL=)`.")
+  if (missing(CNSR) && exists("CNSR", envir = rlang::caller_env()))
+    CNSR <- get("CNSR", envir = rlang::caller_env())
+  else if (missing(CNSR))
+    stop("Default 'CNSR' value not found. Specify argument in `Surv_CDISC(CNSR=)`.")
+
+  # checking inputs ------------------------------------------------------------
+  if (!is.numeric(AVAL) || !is.numeric(CNSR))
+    stop("Expecting arguments 'AVAL' and 'CNSR' to be numeric.")
+
+  if (stats::na.omit(CNSR) %>% setdiff(c(0, 1)) %>% {!rlang::is_empty(.)})
+    stop("Expecting 'CNSR' argument to be binary with values `0/1`.")
+
+  if (any(AVAL < 0))
+    warning("Values of 'AVAL' are less than zero, which is likely a data error.")
+
+  # pass args to `survival::Surv()` --------------------------------------------
+  survival::Surv(time = AVAL, event = 1 - CNSR, type = "right", origin = 0)
+}

README.Rmd

@@ -24,8 +24,6 @@ riskmetric_score <- "visR" %>%
   riskmetric::pkg_score() %>%
   dplyr::pull("pkg_score") %>%
   round(2)
-
-
 ```
 
 # visR <img src='man/figures/logo.png' align="right" height="131.5" />

inst/WORDLIST

@@ -26,6 +26,7 @@ RGBA
 RRGGBB
 RRGGBBAA
 SDTM
+Surv
 Tarone
 UCL
 UX

_pkgdown.yml → pkgdown/_pkgdown.yml

@@ -47,6 +47,7 @@ reference:
       - get_pvalue
       - get_quantile
       - get_COX_HR
+      - Surv_CDISC
 
   - title: Data Summary
   - contents:

tests/testthat/test-Surv_CDISC.R

@@ -0,0 +1,71 @@
+#' @title Specifications test-Surv_CDISC.R
+#' @section Last updated by: Daniel Sjoberg
+#' @section Last update date:
+#'
+#' @section List of tested specifications
+#' T1. The function returns a `Surv` object.
+#' T1.1. No error when arguments are used as indicated in documentation.
+#' T2. Errors are triggered with bad argument inputs.
+#' T2.1. Errors are triggered with bad argument inputs.
+#' T3. Results match when not using Surv_CDISC.
+#' T3.1. Surv_CDISC() and Surv() results match
+
+# Requirement T1 ----------------------------------------------------------
+
+testthat::context("Surv_CDISC - T1. The function returns a `Surv` object.")
+
+testthat::test_that("T1.1. No error when arguments are used as indicated in documentation.", {
+  testthat::expect_error(survival::survfit(visR::Surv_CDISC() ~ 1, data = adtte), NA)
+  testthat::expect_error(survival::survfit(visR::Surv_CDISC() ~ SEX, data = adtte), NA)
+
+  testthat::expect_error(adtte %>% visR::estimate_KM(formula = Surv_CDISC() ~ 1), NA)
+  testthat::expect_error(adtte %>% visR::estimate_KM(formula = Surv_CDISC() ~ SEX), NA)
+
+  testthat::expect_error(survival::survfit(visR::Surv_CDISC(AVAL, CNSR) ~ 1, data = adtte), NA)
+  testthat::expect_error(survival::survfit(visR::Surv_CDISC(AVAL, CNSR) ~ SEX, data = adtte), NA)
+
+  testthat::expect_error(adtte %>% visR::estimate_KM(formula = visR::Surv_CDISC(AVAL, CNSR) ~ 1), NA)
+  testthat::expect_error(adtte %>% visR::estimate_KM(formula = visR::Surv_CDISC(AVAL, CNSR) ~ SEX), NA)
+
+  testthat::expect_error(with(adtte, visR::Surv_CDISC(AVAL, CNSR)), NA)
+
+  # WHEN THIS TEST FAILS, THAT IS OUR SIGNAL THAT {survival} HAS BEEN UPDATED ON CRAN!!
+  # AT THAT POINT WE SHOULD DO THE FOLLOWING
+  # 1. UPDATE THIS UNIT TEST TO ASSURE THERE IS _NO_ ERROR WITH coxph()
+  # 2. ADD A MIN VERSION REQUIREMENT FOR THE {survival} PACKAGE
+  #    THIS CAN BE DONE IN TWO WAYS:
+  #      1. in the DESCRIPTION file
+  #      2. using rlang::check_installed("survival", version = <add required version number>)
+  testthat::expect_error(survival::coxph(visR::Surv_CDISC() ~ SEX, data = adtte))
+})
+
+# Requirement T2 ----------------------------------------------------------
+
+testthat::context("Surv_CDISC - T2. Errors are triggered with bad argument inputs.")
+
+testthat::test_that("T2.1. Errors are triggered with bad argument inputs.", {
+  testthat::expect_error(survival::survfit(visR::Surv_CDISC() ~ 1, data = survival::lung))
+  testthat::expect_error(survival::survfit(visR::Surv_CDISC() ~ sex, data = survival::lung))
+  testthat::expect_error(survival::survfit(visR::Surv_CDISC() ~ 1, data = survival::lung %>% dplyr::rename(AVAL = time)))
+  testthat::expect_error(survival::survfit(visR::Surv_CDISC() ~ sex, data = survival::lung %>% dplyr::rename(AVAL = time)))
+
+  testthat::expect_error(survival::survfit(visR::Surv_CDISC(AVAL = time) ~ 1, data = survival::lung %>% dplyr::mutate(CNSR = as.character(status))))
+  testthat::expect_error(survival::survfit(visR::Surv_CDISC(AVAL = time) ~ 1, data = survival::lung %>% dplyr::mutate(CNSR = status)))
+  testthat::expect_warning(survival::survfit(visR::Surv_CDISC() ~ 1, data = adtte %>% dplyr::mutate(AVAL = AVAL - 10000)))
+})
+
+# Requirement T3 ----------------------------------------------------------
+
+testthat::context("Surv_CDISC - T3. Results match when not using Surv_CDISC.")
+
+testthat::test_that("T3.1. Surv_CDISC() and Surv() results match", {
+  testthat::expect_equal(
+    with(adtte, visR::Surv_CDISC()),
+    with(adtte, survival::Surv(AVAL, 1 - CNSR))
+  )
+
+  km1 <- adtte %>% visR::estimate_KM(formula = visR::Surv_CDISC(AVAL, CNSR) ~ 1)
+  km2 <- adtte %>% visR::estimate_KM()
+  km1$call <- km2$call <- NULL
+  testthat::expect_equal(km1, km2)
+})