tests/testthat/test-methodSuppress.R

In omopgenerics: Methods and Classes for the OMOP Common Data Model

test_that("test supress methods", {
  x <- dplyr::tibble(
    "result_id" = as.integer(1),
    "cdm_name" = "mock",
    "group_name" = "overall",
    "group_level" = "overall",
    "strata_name" = c(rep("overall", 6), rep("sex", 3)),
    "strata_level" = c(rep("overall", 6), "male", "female", "female"),
    "variable_name" = c("number records", "age_group", "age_group", "age_group", "age_group", "my_variable", "number records", "age_group", "age_group"),
    "variable_level" = c(NA, "<50", "<50", ">=50", ">=50", NA, NA, "<50", "<50"),
    "estimate_name" = c("count", "count", "percentage", "count", "percentage", "random", "count", "count", "percentage"),
    "estimate_type" = c("integer", "integer", "percentage", "integer", "percentage", "numeric", "integer", "integer", "percentage"),
    "estimate_value" = c("10", "5", "50", "3", "30", "1", "3", "12", "6"),
    "additional_name" = "overall",
    "additional_level" = "overall"
  )

  obj <- newSummarisedResult(
    x,
    settings = dplyr::tibble(
      "result_id" = as.integer(1),
      "result_type" = "summarised_characteristics",
      "package_name" = "omopgenerics",
      "package_version" = as.character(utils::packageVersion("omopgenerics"))))

  settingsTest <- function(minCellCount) {
    dplyr::tibble(
      "result_id" = as.integer(1),
      "result_type" = "summarised_characteristics",
      "package_name" = "omopgenerics",
      "package_version" = as.character(utils::packageVersion("omopgenerics")),
      "min_cell_count" = as.integer(minCellCount))
  }

  objOut <- newSummarisedResult(x, settings = settingsTest(2))
  result <- suppress(obj, minCellCount = 2)
  expect_identical(result, objOut)

  objOut <- newSummarisedResult(x, settings = settingsTest(3))
  result <- suppress(obj, minCellCount = 3)
  expect_identical(result, objOut)

  objOut <- newSummarisedResult(x, settings = settingsTest(4))
  result <- suppress(obj, minCellCount = 4)
  expect_identical(
    result$estimate_value,
    c("10", "5", "50", NA, NA, "1", NA, "12", "6")
  )
  expect_identical(
    result |> dplyr::select(-"estimate_value"),
    objOut |> dplyr::select(-"estimate_value")
  )

  objOut <- newSummarisedResult(x, settings = settingsTest(5))
  result <- suppress(obj, minCellCount = 5)
  expect_identical(
    result$estimate_value,
    c("10", "5", "50", NA, NA, "1", NA, "12", "6")
  )
  expect_identical(
    result |> dplyr::select(-"estimate_value"),
    objOut |> dplyr::select(-"estimate_value")
  )

  objOut <- newSummarisedResult(x, settings = settingsTest(6))
  result <- suppress(obj, minCellCount = 6)
  expect_identical(
    result$estimate_value,
    c("10", NA, NA, NA, NA, "1", NA, "12", "6")
  )
  expect_identical(
    result |> dplyr::select(-"estimate_value"),
    objOut |> dplyr::select(-"estimate_value")
  )

  objOut <- newSummarisedResult(x, settings = settingsTest(10))
  result <- suppress(obj, minCellCount = 10)
  expect_identical(
    result$estimate_value,
    c("10", NA, NA, NA, NA, "1", NA, "12", "6")
  )
  expect_identical(
    result |> dplyr::select(-"estimate_value"),
    objOut |> dplyr::select(-"estimate_value")
  )

  objOut <- newSummarisedResult(x, settings = settingsTest(11))
  result <- suppress(obj, minCellCount = 11)
  expect_identical(
    result$estimate_value,
    c(NA, NA, NA, NA, NA, NA, NA, "12", "6")
  )
  expect_identical(
    result |> dplyr::select(-"estimate_value"),
    objOut |> dplyr::select(-"estimate_value")
  )

  objOut <- newSummarisedResult(x, settings = settingsTest(12))
  result <- suppress(obj, minCellCount = 12)
  expect_identical(
    result$estimate_value,
    c(NA, NA, NA, NA, NA, NA, NA, "12", "6")
  )
  expect_identical(
    result |> dplyr::select(-"estimate_value"),
    objOut |> dplyr::select(-"estimate_value")
  )

  objOut <- newSummarisedResult(x, settings = settingsTest(13))
  result <- suppress(obj, minCellCount = 13)
  expect_identical(result$estimate_value, rep(NA_character_, 9))
  expect_identical(
    result |> dplyr::select(-"estimate_value"),
    objOut |> dplyr::select(-"estimate_value")
  )

  # test already suppress input
  expect_warning(result1 <- suppress(result, minCellCount = 10))
  expect_identical(result, result1)

  # contains count
  x <- dplyr::tibble(
    "result_id" = as.integer(1),
    "cdm_name" = "mock",
    "group_name" = "overall",
    "group_level" = "overall",
    "strata_name" ="overall",
    "strata_level" = "overall",
    "variable_name" = c("concept id name 1", "concept id name 1", "concept id name 2", "concept id name 2"),
    "variable_level" = NA_character_,
    "estimate_name" = c("record_count", "person_count", "record_count", "person_count"),
    "estimate_type" = c("integer", "integer", "integer", "integer"),
    "estimate_value" = c("6", "3", "4", "4"),
    "additional_name" = "overall",
    "additional_level" = "overall"
  )

  obj <- newSummarisedResult(
    x,
    settings = dplyr::tibble(
      "result_id" = as.integer(1),
      "result_type" = "summarised_characteristics",
      "package_name" = "omopgenerics",
      "package_version" = as.character(utils::packageVersion("omopgenerics"))))

  result <- suppress(obj)
  expect_identical(result$estimate_value, c(6, NA_character_, NA_character_, NA_character_))

  x <- dplyr::tibble(
    "result_id" = 1L,
    "cdm_name" = "unknown",
    "group_name" = "overall",
    "group_level" = "overall",
    "strata_name" = "overall",
    "strata_level" = "overall",
    "variable_name" = c("number records", "a", "a"),
    "variable_level" = NA_character_,
    "estimate_name" = c("count", "count_missing", "median"),
    "estimate_type" = c("integer", "integer", "numeric"),
    "estimate_value" = c("7", "1", "5"),
    "additional_name" = c("overall"),
    "additional_level" = c("overall")
  ) |>
    newSummarisedResult()

  expect_no_error(xs <- suppress(x))
  expect_true(is.na(xs$estimate_value[xs$estimate_name == "count_missing"]))
  expect_true(all(!is.na(xs$estimate_value[xs$estimate_name != "count_missing"])))

  # Test keep individual counts
  x <- dplyr::tibble(
    "result_id" = 1L,
    "cdm_name" = "unknown",
    "group_name" = "overall",
    "group_level" = "overall",
    "strata_name" = "overall",
    "strata_level" = "overall",
    "variable_name" = c("outcome", "outcome", "outcome", "outcome", "outcome", "outcome"),
    "variable_level" = c("outcome1", "outcome1", "outcome1", "outcome2", "outcome2", "outcome2"),
    "estimate_name" = c("denominator_count", "outcome_count", "prevalence", "denominator_count", "outcome_count", "prevalence"),
    "estimate_type" = c("integer", "integer", "numeric", "integer", "integer", "numeric"),
    "estimate_value" = c("7", "1", "5", "4", "0", "1"),
    "additional_name" = c("overall"),
    "additional_level" = c("overall")
  ) |>
    newSummarisedResult()
  result <- suppress(x)
  expect_true(
    all(result$estimate_name[is.na(result$estimate_value)] == c("outcome_count", "prevalence", "denominator_count", "prevalence"))
  )

  # Test keep individual counts
  x <- dplyr::tibble(
    "result_id" = 1L,
    "cdm_name" = "unknown",
    "group_name" = "overall",
    "group_level" = "overall",
    "strata_name" = "overall",
    "strata_level" = "overall",
    "variable_name" = c("outcome", "outcome", "outcome", "outcome", "outcome", "outcome"),
    "variable_level" = c("outcome1", "outcome1", "outcome1", "outcome1", "outcome1", "outcome1"),
    "estimate_name" = c("denominator_count", "outcome_count", "prevalence", "denominator_count", "outcome_count", "prevalence"),
    "estimate_type" = c("integer", "integer", "numeric", "integer", "integer", "numeric"),
    "estimate_value" = c("7", "1", "5", "4", "0", "1"),
    "additional_name" = "time",
    "additional_level" = c("1", "1", "1", "2", "2", "2"),
  ) |>
    newSummarisedResult()
  result <- suppress(x)
  expect_true(
    all(result$estimate_name[is.na(result$estimate_value)] == c("outcome_count", "prevalence", "denominator_count", "prevalence"))
  )

  # Test duplicate
  x <- dplyr::tibble(
    "result_id" = 1L,
    "cdm_name" = "unknown",
    "group_name" = "overall",
    "group_level" = "overall",
    "strata_name" = "overall",
    "strata_level" = "overall",
    "variable_name" = c("outcome", "outcome", "outcome"),
    "variable_level" = c("outcome1", "outcome1", "outcome1"),
    "estimate_name" = c("denominator_count", "outcome_count", "prevalence"),
    "estimate_type" = c("integer", "integer", "numeric"),
    "estimate_value" = c("4", "1", "5"),
    "additional_name" = "time",
    "additional_level" = c("1", "1", "1"),
  ) |>
    newSummarisedResult()
  result <- suppress(x)
  expect_true(nrow(x) == nrow(result))
})