adding tableTemporalSymmetry and tests

NAMESPACE

@@ -7,6 +7,7 @@ export(plotTemporalSymmetry)
 export(summariseSequenceRatios)
 export(summariseTemporalSymmetry)
 export(tableSequenceRatios)
+export(tableTemporalSymmetry)
 importFrom(dplyr,"%>%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)

R/summariseTemporalSymmetry.R

@@ -102,9 +102,10 @@ summariseTemporalSymmetry <- function(cohort,
   setting <- output_sum |>
     dplyr::distinct(dplyr::across(dplyr::all_of(c(settings, "cdm_name")))) |>
     dplyr::mutate(result_id = as.integer(dplyr::row_number()),
-                  result_type = "sequence_ratios",
+                  result_type = "temporal_symmetry",
                   package_name = "CohortSymmetry",
-                  package_version = as.character(utils::packageVersion("CohortSymmetry")))
+                  package_version = as.character(utils::packageVersion("CohortSymmetry")),
+                  timescale = .env$timescale)
 
   output_sum <- output_sum |>
     dplyr::left_join(setting, by = c("cdm_name", "days_prior_observation", "washout_window",

R/tableTemporalSymmetry.R

@@ -0,0 +1,79 @@
+#' A formatted visualization of temporal_symmetry objects.
+#'
+#' @description
+#' It provides a formatted table with the contents of the summariseTemporalSymmetry
+#' output.
+#'
+#' @param result A temporal_symmetry object.
+#' @param header A vector specifying the elements to include in the header.
+#' See visOmopResults package for more information on how to use this parameter.
+#' @param groupColumn Columns to use as group labels.
+#' See visOmopResults package for more information on how to use this parameter.
+#' @param type The desired format of the output table.
+#' @param hide Columns to drop from the output table.
+#'
+#' @return A formatted version of the temporal_symmetry object.
+#'
+#' @export
+#' @examples
+#' \donttest{
+#' library(CohortSymmetry)
+#' cdm <- mockCohortSymmetry()
+#' cdm <- generateSequenceCohortSet(cdm = cdm,
+#'                                  indexTable = "cohort_1",
+#'                                  markerTable = "cohort_2",
+#'                                  name = "joined_cohort")
+#' res <- summariseTemporalSymmetry(cohort = cdm$joined_cohort, minCellCount = 0)
+#' gtResult <- tableTemporalSymmetry(result = res)
+#' CDMConnector::cdmDisconnect(cdm = cdm)
+#' }
+#'
+tableTemporalSymmetry <- function(result,
+                                header = "variable_level",
+                                groupColumn = c("cdm_name", "index_name"),
+                                type = "gt",
+                                hide = "variable_name") {
+
+  rlang::check_installed("flextable")
+  rlang::check_installed("gt")
+
+  # validate checks
+  result <- omopgenerics::validateResultArgument(result)
+
+  # check settings
+  result <- result |>
+    visOmopResults::filterSettings(
+      .data$result_type == "temporal_symmetry"
+    )
+
+  if (nrow(result) == 0) {
+    cli::cli_warn("`result` object does not contain any `result_type == 'temporal_symmetry'` information.")
+    return(emptyResultTable(type))
+  }
+
+  setting <- omopgenerics::settings(result)
+
+  result_visualised <- result |>
+    omopgenerics::addSettings() |>
+    dplyr::mutate(estimate_name = paste0(.data$timescale, "ly_count"),
+                  variable_level = as.integer(.data$variable_level)) |>
+    dplyr::group_by(.data$group_level) |>
+    dplyr::arrange(.data$variable_level) |>
+    dplyr::ungroup() |>
+    dplyr::mutate(variable_level = as.character(.data$variable_level))
+
+  result <- result_visualised |>
+    dplyr::select(dplyr::all_of(omopgenerics::resultColumns())) |>
+    omopgenerics::newSummarisedResult(
+      settings = setting
+    )
+
+  # format table
+  tab <- visOmopResults::visOmopTable(
+    result = result,
+    header = header,
+    groupColumn = groupColumn,
+    type = type,
+    hide = hide
+  )
+}

tests/testthat/test-displayTable.R → tests/testthat/test-tableSequenceRatios.R

@@ -18,6 +18,10 @@ test_that("tableSequenceRatios - gt output", {
     tableSequenceRatios(res, header = "index_cohort_name")
   )
 
+  expect_warning(
+    tableTemporalSymmetry(res)
+  )
+
   expect_error(
     tableSequenceRatios(res, header = "cdm_name")
   )
@@ -52,6 +56,10 @@ test_that("tableSequenceRatios - tibble output", {
 
   res <- summariseSequenceRatios(cohort = cdm$joined_cohort, minCellCount = 0)
 
+  expect_warning(
+    tableTemporalSymmetry(res, type = "tibble")
+  )
+
   tibble_res <- tableSequenceRatios(res, type = "tibble")
 
   expect_true("data.frame" %in% (tibble_res %>% class()))
@@ -72,6 +80,10 @@ test_that("tableSequenceRatios - flextable output", {
 
   res <- summariseSequenceRatios(cohort = cdm$joined_cohort, minCellCount = 0)
 
+  expect_warning(
+    tableTemporalSymmetry(res, type = "flextable")
+  )
+
   flextable_res <- tableSequenceRatios(res, type = "flextable")
 
   expect_true("flextable" %in% (flextable_res %>% class()))

tests/testthat/test-tableTemporalSymmetry.R

@@ -0,0 +1,119 @@
+test_that("tableTemporalSymmetry - gt output", {
+  skip_if_not_installed("gt")
+  skip_if_not_installed("flextable")
+  cdm <- mockCohortSymmetry()
+  cdm <- generateSequenceCohortSet(cdm = cdm,
+                                   indexTable = "cohort_1",
+                                   indexId = 1,
+                                   markerTable = "cohort_2",
+                                   markerId = 3,
+                                   name = "joined_cohort")
+
+  res <- summariseTemporalSymmetry(cohort = cdm$joined_cohort, minCellCount = 0)
+
+  gtResult <- tableTemporalSymmetry(res)
+  expect_true("gt_tbl" %in% (gtResult %>% class()))
+
+  expect_no_error(
+    tableTemporalSymmetry(res, header = "index_cohort_name")
+  )
+
+  expect_warning(
+    tableSequenceRatios(res)
+  )
+
+  expect_error(
+    tableTemporalSymmetry(res, header = "cdm_name")
+  )
+
+  expect_no_error(
+    tableTemporalSymmetry(res,
+                        header = "index_cohort_name",
+                        groupColumn = "cdm_name")
+  )
+
+  expect_no_error(
+    tableTemporalSymmetry(res,
+                        header = "index_cohort_name",
+                        groupColumn = character(),
+                        hide = "cdm_name")
+  )
+
+  CDMConnector::cdmDisconnect(cdm)
+})
+
+test_that("tableTemporalSymmetry - tibble output", {
+  skip_on_cran()
+  skip_if_not_installed("gt")
+  skip_if_not_installed("flextable")
+  cdm <- mockCohortSymmetry()
+  cdm <- generateSequenceCohortSet(cdm = cdm,
+                                   indexTable = "cohort_1",
+                                   indexId = 1,
+                                   markerTable = "cohort_2",
+                                   markerId = 3,
+                                   name = "joined_cohort")
+
+  res <- summariseTemporalSymmetry(cohort = cdm$joined_cohort, minCellCount = 0)
+
+  tibble_res <- tableTemporalSymmetry(res, type = "tibble")
+
+  expect_warning(
+    tableSequenceRatios(res, type = "tibble")
+  )
+
+  expect_true("data.frame" %in% (tibble_res %>% class()))
+  CDMConnector::cdmDisconnect(cdm)
+})
+
+test_that("tableTemporalSymmetry - flextable output", {
+  skip_on_cran()
+  skip_if_not_installed("gt")
+  skip_if_not_installed("flextable")
+  cdm <- mockCohortSymmetry()
+  cdm <- generateSequenceCohortSet(cdm = cdm,
+                                   indexTable = "cohort_1",
+                                   indexId = 1,
+                                   markerTable = "cohort_2",
+                                   markerId = 3,
+                                   name = "joined_cohort")
+
+  res <- summariseTemporalSymmetry(cohort = cdm$joined_cohort, minCellCount = 0)
+
+  flextable_res <- tableTemporalSymmetry(res, type = "flextable")
+
+  expect_warning(
+    tableSequenceRatios(res, type = "flextable")
+  )
+
+  expect_true("flextable" %in% (flextable_res %>% class()))
+
+  expect_no_error(
+    tableTemporalSymmetry(res,
+                          type = "flextable",
+                          header = "index_cohort_name")
+  )
+
+  expect_error(
+    tableTemporalSymmetry(res,
+                          type = "flextable",
+                          header = "cdm_name")
+  )
+
+  expect_no_error(
+    tableTemporalSymmetry(res,
+                          type = "flextable",
+                          header = "index_cohort_name",
+                          groupColumn = "cdm_name")
+  )
+
+  expect_no_error(
+    tableTemporalSymmetry(res,
+                          type = "flextable",
+                          header = "index_cohort_name",
+                          groupColumn = character(),
+                          hide = "cdm_name")
+  )
+
+  CDMConnector::cdmDisconnect(cdm)
+})