tests/testthat/test-tableMeasurementSummary.R

test_that("check that it works ", {
  cdm <- testMockCdm()
  cdm <- copyCdm(cdm)

  # Summarise measurement use ----
  result <- summariseMeasurementUse(cdm = cdm,
                                    codes = list("test_codelist" = c(3001467L, 45875977L)))
  # Table types
  expect_no_error(x <- tableMeasurementSummary(result,
                                               type = "gt",
                                               header = c(visOmopResults::strataColumns(result)),
                                               groupColumn = c("codelist_name"),
                                               hide = c("variable_name", "variable_level"),
                                               .options = list()))
  expect_true("gt_tbl" %in% class(x))
  expect_true(all(c("Codelist name", "CDM name", "Estimate name", "Estimate value") %in% colnames(x$`_data`)))

  expect_no_error(x <- tableMeasurementSummary(result, type = "flextable"))
  expect_true("flextable" %in% class(x))

  expect_no_error(x <- tableMeasurementSummary(result, type = "tibble"))
  expect_true(all(class(x) %in% c("tbl_df", "tbl", "data.frame")))

  expect_error(tableMeasurementSummary(result, type = "hola"))

  # Different package versions
  x <- result |>
    omopgenerics::newSummarisedResult(
      "settings" = omopgenerics::settings(result) |>
        dplyr::mutate("package_version" = "0.0.0")
    )
  expect_message(tableMeasurementSummary(x))

  # Empty output message
  expect_warning(x <- tableMeasurementSummary(
    result = omopgenerics::emptySummarisedResult(), type = "gt"
  ))

  # Summarise cohort measurement use ----
  result <- summariseCohortMeasurementUse(cohort = cdm$my_cohort, bySex = TRUE,
                                          codes = list("test_codelist" = c(3001467L, 45875977L)))
  expect_no_error(x <- tableMeasurementSummary(result,
                                               type = "gt",
                                               header = c(visOmopResults::strataColumns(result)),
                                               groupColumn = c("codelist_name"),
                                               settingsColumn = "timing",
                                               hide = c("variable_level"),
                                               .options = list()))

  expect_true(all(
    c('Codelist name', 'CDM name', 'Variable name', 'Estimate name', 'Timing',
      '[header_name]Sex\n[header_level]overall', '[header_name]Sex\n[header_level]Male') %in%
      colnames(x$`_data`)))

  dropCreatedTables(cdm = cdm)
})

Try the MeasurementDiagnostics package in your browser

Any scripts or data that you put into this service are public.

MeasurementDiagnostics documentation built on Dec. 17, 2025, 5:10 p.m.