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", NA_character_, "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", NA_character_, "-", "-", "1", "-", "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", NA_character_, "-", "-", "1", "-", "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", "-", "-", "-", "-", "1", "-", "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", "-", "-", "-", "-", "1", "-", "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("-", "-", "-", "-", "-", "-", "-", "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("-", "-", "-", "-", "-", "-", "-", "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("-", 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, "-", "-", "-")) 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(all(xs$estimate_value[xs$estimate_name == "count_missing"] == "-")) expect_true(all(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)) }) test_that("multiple result ids", { res <- dplyr::tibble( result_id = 1L, cdm_name = "mock", group_name = "overall", group_level = "overall", strata_name = "overall", strata_level = "overall", variable_name = "number records", variable_level = NA_character_, estimate_name = "count", estimate_type = "integer", estimate_value = "5", additional_name = "overall", additional_level = "overall" ) |> newSummarisedResult(settings = dplyr::tibble( result_id = 1L, result_type = "test", package_name = "omopgenerics", package_version = "1.0.0" )) res0 <- res |> suppress() res1 <- res expect_warning(res <- suppress(bind(res1, res0))) })