tests/testthat/test-apply_attrition.R

In visR: Clinical Graphs and Tables Adhering to Graphical Principles

#' @title Specifications test-apply_attrition.R
#' @section Last updated by: Tim Treis (tim.treis@@outlook.de)
#' @section Last update date: 2022-02-09T15:22:32
#'
#' @section List of tested specifications
#' T1. The function accepts a `data.frame` `tibble` or `data.table`
#' T1.1. No error when `data` is of class `data.frame`
#' T1.2. No error when `data` is of class `tibble`
#' T1.3. No error when `data` is of class `data.table`
#' T1.4. An error when `data` is of class `list`
#' T1.5 An error when `data` is NULL
#' T1.6 An error when `data` is NA
#' T1.7 An error when `data` does not exist in the global environment
#' T2. The function correctly handles arguments
#' T2.1 No error when `criteria_conditions` is a character vector
#' T2.2 An error when `criteria_conditions` is not a character vector
#' T2.3 An error when `criteria_conditions` is NULL
#' T2.4 An error when `data` is missing.
#' T2.5 An error when `criteria_conditions` is missing.
#' T3. The function filters correctly when provided a vector of single filters
#' T3.1 Correct filtering string column
#' T3.2 Correct filtering integer column
#' T3.3 Correct filtering factor column
#' T4. The function filters correctly when provided a vector of combined filters
#' T4.1 Correct filtering using a combined filter containing logical `and` (`&`)
#' T4.2 Correct filtering using a combined filter containing logical `or` (`|`)
#' T5. The returned object is of correct class
#' T5.1 The object is of class `data.frame`

# Requirement T1 ----------------------------------------------------------

testthat::context("apply_attrition - T1. The function accepts a `data.frame` `tibble` or `data.table`")

testthat::test_that("T1.1. No error when `data` is of class `data.frame`", {
  data <- adtte
  testthat::expect_error(
    visR::apply_attrition(data, c("TRTP == 'Placebo'", "AGE >= 75")), NA
  )
})


testthat::test_that("T1.2. No error when `data` is of class `tibble`", {
  data <- dplyr::as_tibble(adtte)
  testthat::expect_error(
    visR::apply_attrition(
      data,
      criteria_conditions = c("TRTP == 'Placebo'", "AGE >= 75")
    ), NA
  )
})

testthat::test_that("T1.3. No error when `data` is of class `data.table`", {
  if (nzchar(find.package("data.table"))) {
    data <- data.table::as.data.table(adtte)
    testthat::expect_error(
      visR::apply_attrition(
        data,
        criteria_conditions = c("TRTP == 'Placebo'", "AGE >= 75")
      ), NA
    )
  }
})

testthat::test_that("T1.4. An error when `data` is of class `list`", {
  data <- base::as.list(adtte)
  testthat::expect_error(
    visR::apply_attrition(
      data,
      criteria_conditions = c("TRTP == 'Placebo'", "AGE >= 75")
    )
  )
})

testthat::test_that("T1.5 An error when `data` is NULL", {
  testthat::expect_error(
    visR::apply_attrition(
      NULL,
      criteria_conditions = c("TRTP == 'Placebo'", "AGE >= 75")
    )
  )
})

testthat::test_that("T1.6 An error when `data` is NA", {
  testthat::expect_error(
    visR::apply_attrition(
      NA,
      criteria_conditions = c("TRTP == 'Placebo'", "AGE >= 75")
    )
  )
})

testthat::test_that("T1.7 An error when `data` does not exist in the global environment", {
  testthat::expect_error(
    visR::apply_attrition(
      blah,
      criteria_conditions = c("TRTP == 'Placebo'", "AGE >= 75")
    )
  )
})

# Requirement T2 ---------------------------------------------------------------

testthat::context("apply_attrition - T2. The function correctly handles arguments")

testthat::test_that("T2.1 No error when `criteria_conditions` is a character vector", {
  testthat::expect_error(
    visR::apply_attrition(
      adtte,
      criteria_conditions = c("TRTP == 'Placebo'", "AGE >= 75")
    ), NA
  )
})

testthat::test_that("T2.2 An error when `criteria_conditions` is not a character vector", {
  testthat::expect_error(
    visR::apply_attrition(
      adtte,
      criteria_conditions = 123
    )
  )
})

testthat::test_that("T2.3 An error when `criteria_conditions` is NULL", {
  testthat::expect_error(
    visR::apply_attrition(
      adtte,
      criteria_conditions = NULL
    )
  )
})

testthat::test_that("T2.4 An error when `data` is missing.", {
  testthat::expect_error(
    visR::apply_attrition(criteria_conditions = NULL)
  )
})

testthat::test_that("T2.5 An error when `criteria_conditions` is missing.", {
  testthat::expect_error(visR::apply_attrition(data = adtte))
})

# Requirement T3 ---------------------------------------------------------------

testthat::context("apply_attrition - T3. The function filters correctly when provided a vector of single filters")

testthat::test_that("T3.1 Correct filtering string column", {
  testthat::expect_equal(
    visR::apply_attrition(
      adtte,
      criteria_conditions = c("TRTP == 'Placebo'")
    ), adtte %>% dplyr::filter(TRTP == "Placebo")
  )
})

testthat::test_that("T3.2 Correct filtering integer column", {
  testthat::expect_equal(
    visR::apply_attrition(
      adtte,
      criteria_conditions = c("AGE >= 75")
    ), adtte %>% dplyr::filter(AGE >= 75)
  )
})

testthat::test_that("T3.3 Correct filtering factor column", {
  data <- adtte %>% dplyr::mutate(AGEGR1 = factor(AGEGR1))
  testthat::expect_equal(
    visR::apply_attrition(
      data,
      criteria_conditions = c("AGEGR1 == '< 65'")
    ), data %>% dplyr::filter(AGEGR1 == "< 65")
  )
})

# Requirement T4 ---------------------------------------------------------------

testthat::context("apply_attrition - T4. The function filters correctly when provided a vector of combined filters")

testthat::test_that("T4.1 Correct filtering using a combined filter containing logical `and` (`&`)", {
  testthat::expect_equal(
    visR::apply_attrition(
      adtte,
      criteria_conditions = c("AGEGR1 == '< 65' & SEX == 'M'")
    ), adtte %>%
      dplyr::filter(AGEGR1 == "< 65") %>%
      dplyr::filter(SEX == "M")
  )

  testthat::expect_equal(
    visR::apply_attrition(
      adtte,
      criteria_conditions = c(
        "AGEGR1 == '< 65' & SEX == 'M'",
        "TRTP == 'Placebo'"
      )
    ), adtte %>%
      dplyr::filter(AGEGR1 == "< 65") %>%
      dplyr::filter(SEX == "M") %>%
      dplyr::filter(TRTP == "Placebo")
  )
})

#
testthat::test_that("T4.2 Correct filtering using a combined filter containing logical `or` (`|`)", {
  testthat::expect_equal(
    visR::apply_attrition(
      adtte,
      criteria_conditions = c("AGEGR1 == '< 65' | SEX == 'M'")
    ), adtte %>%
      dplyr::filter(AGEGR1 == "< 65" | SEX == "M")
  )

  testthat::expect_equal(
    visR::apply_attrition(
      adtte,
      criteria_conditions = c(
        "AGEGR1 == '< 65' | SEX == 'M'",
        "TRTP == 'Placebo'"
      )
    ), adtte %>%
      dplyr::filter(AGEGR1 == "< 65" | SEX == "M") %>%
      dplyr::filter(TRTP == "Placebo")
  )

  testthat::expect_equal(
    visR::apply_attrition(
      adtte,
      criteria_conditions = c(
        "TRTP == 'Placebo'",
        "AGEGR1 == '< 65' | SEX == 'M'",
        "RACE != 'WHITE'"
      )
    ), adtte %>%
      dplyr::filter(AGEGR1 == "< 65" | SEX == "M") %>%
      dplyr::filter(TRTP == "Placebo") %>%
      dplyr::filter(RACE != "WHITE")
  )
})

# Requirement T5 ---------------------------------------------------------------

testthat::context("apply_attrition - T5. The returned object is of correct class")

testthat::test_that("T5.1 The object is of class `data.frame`", {
  outdf <- visR::apply_attrition(
    adtte,
    criteria_conditions = c("TRTP == 'Placebo'", "AGE >= 75")
  )

  testthat::expect_s3_class(outdf, "data.frame")
})

# END OF CODE -------------------------------------------------------------