From b990b8c509f0eecd501f3f5a3b05c53e505e078c Mon Sep 17 00:00:00 2001 From: Daniel Sabanes Bove Date: Mon, 12 Feb 2024 15:36:47 +0100 Subject: [PATCH] add custom assertion to DRY (#23) --- R/aalen_johansen.R | 5 +---- R/assert.R | 16 ++++++++++++++ R/inc_prop.R | 5 +---- R/one_minus_kaplan_meier.R | 5 +---- R/prop_trans_inc_dens.R | 5 +---- R/prop_trans_inc_dens_ce.R | 7 ++---- man/assert_ae_data.Rd | 18 ++++++++++++++++ tests/testthat/test-assert.R | 42 ++++++++++++++++++++++++++++++++++++ 8 files changed, 82 insertions(+), 21 deletions(-) create mode 100644 R/assert.R create mode 100644 man/assert_ae_data.Rd create mode 100644 tests/testthat/test-assert.R diff --git a/R/aalen_johansen.R b/R/aalen_johansen.R index 998ccd6..363e8c3 100644 --- a/R/aalen_johansen.R +++ b/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( diff --git a/R/assert.R b/R/assert.R new file mode 100644 index 0000000..33311aa --- /dev/null +++ b/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() +} diff --git a/R/inc_prop.R b/R/inc_prop.R index 7f451e2..87a5dda 100644 --- a/R/inc_prop.R +++ b/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) diff --git a/R/one_minus_kaplan_meier.R b/R/one_minus_kaplan_meier.R index 3d773d9..b42b7ff 100644 --- a/R/one_minus_kaplan_meier.R +++ b/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) diff --git a/R/prop_trans_inc_dens.R b/R/prop_trans_inc_dens.R index 4355fc4..22e5a25 100644 --- a/R/prop_trans_inc_dens.R +++ b/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) diff --git a/R/prop_trans_inc_dens_ce.R b/R/prop_trans_inc_dens_ce.R index 1885e64..9af49fb 100644 --- a/R/prop_trans_inc_dens_ce.R +++ b/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) diff --git a/man/assert_ae_data.Rd b/man/assert_ae_data.Rd new file mode 100644 index 0000000..60dae0c --- /dev/null +++ b/man/assert_ae_data.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assert.R +\name{assert_ae_data} +\alias{assert_ae_data} +\title{Assertion of Adverse Event Data} +\usage{ +assert_ae_data(data) +} +\arguments{ +\item{data}{\code{data.frame} to be checked for \code{time_to_event} and \code{type_of_event} columns.} +} +\value{ +None. +} +\description{ +Custom assertion to check adverse event data sets. +} +\keyword{internal} diff --git a/tests/testthat/test-assert.R b/tests/testthat/test-assert.R new file mode 100644 index 0000000..a96da96 --- /dev/null +++ b/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 + ) +})