add custom assertion to DRY (#23)

R/aalen_johansen.R

@@ -35,12 +35,9 @@
 aalen_johansen <- function(data,
                            ce,
                            tau) {
-  assert_data_frame(data, any.missing = FALSE, min.rows = 1, min.cols = 2)
+  assert_ae_data(data)
   assert_subset(ce, c(2, 3))
   assert_true(tau > 0)
-  assert_numeric(data$time_to_event, lower = 0, finite = TRUE)
-  assert_integerish(data$type_of_event, any.missing = FALSE)
-  assert_subset(data$type_of_event, c(0, 1, 2, 3))
   assert_number(tau, finite = TRUE)
 
   data$type_of_event_accounted <- ifelse(

R/assert.R

@@ -0,0 +1,16 @@
+#' Assertion of Adverse Event Data
+#'
+#' Custom assertion to check adverse event data sets.
+#'
+#' @param data `data.frame` to be checked for `time_to_event` and `type_of_event` columns.
+#'
+#' @return None.
+#'
+#' @keywords internal
+assert_ae_data <- function(data) {
+  assert_data_frame(data, any.missing = FALSE, min.rows = 1, min.cols = 2)
+  assert_numeric(data$time_to_event, lower = 0, finite = TRUE)
+  assert_integerish(data$type_of_event, any.missing = FALSE)
+  assert_subset(data$type_of_event, c(0, 1, 2, 3))
+  invisible()
+}

R/inc_prop.R

@@ -29,10 +29,7 @@
 #'
 inc_prop <- function(data,
                      tau) {
-  assert_data_frame(data, any.missing = FALSE, min.rows = 1, min.cols = 2)
-  assert_numeric(data$time_to_event, lower = 0, finite = TRUE)
-  assert_integerish(data$type_of_event, any.missing = FALSE)
-  assert_subset(data$type_of_event, c(0, 1, 2, 3))
+  assert_ae_data(data)
   assert_number(tau, finite = TRUE)
   assert_true(tau > 0)
 

R/one_minus_kaplan_meier.R

@@ -29,10 +29,7 @@
 #' one_minus_kaplan_meier(dat, tau = 4)
 one_minus_kaplan_meier <- function(data,
                                    tau) {
-  assert_data_frame(data, any.missing = FALSE, min.rows = 1, min.cols = 2)
-  assert_numeric(data$time_to_event, lower = 0, finite = TRUE)
-  assert_integerish(data$type_of_event, any.missing = FALSE)
-  assert_subset(data$type_of_event, c(0, 1, 2, 3))
+  assert_ae_data(data)
   assert_number(tau, finite = TRUE)
   assert_true(tau > 0)
 

R/prop_trans_inc_dens.R

@@ -22,10 +22,7 @@
 #' prop_trans_inc_dens(dat, tau = 4)
 prop_trans_inc_dens <- function(data,
                                 tau) {
-  assert_data_frame(data, any.missing = FALSE, min.rows = 1, min.cols = 2)
-  assert_numeric(data$time_to_event, lower = 0, finite = TRUE)
-  assert_integerish(data$type_of_event, any.missing = FALSE)
-  assert_subset(data$type_of_event, c(0, 1, 2, 3))
+  assert_ae_data(data)
   assert_number(tau, finite = TRUE)
   assert_true(tau > 0)
 

R/prop_trans_inc_dens_ce.R

@@ -33,13 +33,10 @@
 prop_trans_inc_dens_ce <- function(data,
                                    ce,
                                    tau) {
-  assert_data_frame(data, any.missing = FALSE, min.rows = 1, min.cols = 2)
-  assert_numeric(data$time_to_event, lower = 0, finite = TRUE)
-  assert_integerish(data$type_of_event, any.missing = FALSE)
-  assert_subset(data$type_of_event, c(0, 1, 2, 3))
+  assert_ae_data(data)
+  assert_subset(ce, c(2, 3))
   assert_number(tau, finite = TRUE)
   assert_true(tau > 0)
-  assert_subset(ce, c(2, 3))
 
   data$type_of_event_accounted <- ifelse(ce == 2 & data$type_of_event == 3, 0,
     ifelse(ce == 3 & data$type_of_event == 3, 2, data$type_of_event)

tests/testthat/test-assert.R

@@ -0,0 +1,42 @@
+# assert_ae_data ----
+
+test_that("assert_ae_data passes as expected", {
+  data <- data.frame(
+    time_to_event = c(12.0, 1.2, 0.3),
+    type_of_event = c(1L, 2L, 0L)
+  )
+  result <- expect_silent(assert_ae_data(data))
+  expected <- NULL
+  expect_identical(result, expected)
+})
+
+test_that("assert_ae_data fails as expected", {
+  expect_error(
+    assert_ae_data(
+      data.frame(bla = 0, bli = 1)
+    ),
+    "'data$time_to_event' failed",
+    fixed = TRUE
+  )
+  expect_error(
+    assert_ae_data(
+      data.frame(time_to_event = -1.3, bli = 1)
+    ),
+    "Element 1 is not >= 0",
+    fixed = TRUE
+  )
+  expect_error(
+    assert_ae_data(
+      data.frame(time_to_event = 0, bli = 1)
+    ),
+    "'data$type_of_event' failed",
+    fixed = TRUE
+  )
+  expect_error(
+    assert_ae_data(
+      data.frame(time_to_event = 0, type_of_event = 4L)
+    ),
+    "Must be a subset of {'0','1','2','3'}",
+    fixed = TRUE
+  )
+})