Merge pull request #281 from OHDSI/new_cran_release

new cran release fix

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: CohortSymmetry
 Title: Sequence Symmetry Analysis Using the Observational Medical 
     Outcomes Partnership Common Data Model
-Version: 0.1.4
+Version: 0.1.5
 Authors@R: c(
     person("Xihang", "Chen", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0009-0001-8112-8959")),
@@ -46,6 +46,8 @@ Suggests:
     tidyselect,
     knitr,
     dbplyr (>= 2.5.0),
+    flextable,
+    gt,
     ggplot2,
     rmarkdown
 Imports: 
@@ -55,15 +57,13 @@ Imports:
     rlang,
     stringr,
     tibble,
-    visOmopResults (>= 0.3.0),
+    visOmopResults (>= 0.4.0),
     tidyr,
     omock (>= 0.3.1),    
     stats,
     duckdb,
     here,
-    omopgenerics (>= 0.2.1),
-    flextable,
-    gt,
+    omopgenerics (>= 0.4.0),
     DrugUtilisation (>= 0.7.0),
     CodelistGenerator (>= 3.1.0)
 Config/testthat/edition: 3

NAMESPACE

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

R/displayTables.R

@@ -5,19 +5,12 @@
 #' output.
 #'
 #' @param result A sequence_symmetry object.
-#' @param type Type of desired formatted table, possibilities: "gt",
-#' "flextable", "tibble".
-#' @param estimateNameFormat The columns that the user wishes to see for the
-#' formatted table, by default it would display both the counts and sequence ratios.
-#' @param style Named list that specifies how to style the different parts of a
-#'  gt table or flextable. See visOmopResults package for more information on
-#'  how to define a style. Alternatively, use "default" to get visOmopResults
-#'  style, or NULL for gt/flextable default styling.
-#' @param studyPopulation whether to report the study population.
-#' @param cdmName whether to report database names.
-#' @param .options named list with additional formatting options.
-#' tableSequenceRatiosOptions() shows allowed arguments and
-#' their default values.
+#' @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 sequence_symmetry object.
 #'
@@ -35,214 +28,37 @@
 #' CDMConnector::cdmDisconnect(cdm = cdm)
 #' }
 #'
-#'
 tableSequenceRatios <- function(result,
+                                header = "marker_cohort_name",
+                                groupColumn = "cdm_name",
                                 type = "gt",
-                                estimateNameFormat =
-                                  c("N (%)" = "<count> (<percentage> %)",
-                                    "SR (CI)" = "<point_estimate> (<lower_CI> - <upper_CI>)"),
-                                style = "default",
-                                studyPopulation = TRUE,
-                                cdmName = TRUE,
-                                .options = NULL) {
+                                hide = "variable_level") {
 
   rlang::check_installed("flextable")
   rlang::check_installed("gt")
 
-  # checks
-  crude <- T
-  adjusted <- T
-  indexName <- T
-  markerName <- T
-  checkSequenceSymmetry(result)
-  checksFormatSequenceSymmetry(type, crude, adjusted, studyPopulation, indexName,
-                               markerName, cdmName, .options)
-
-  # Fill .options argument
-  .options = defaultOptions(.options)
-
-  # get CI
-  ci <- result |>
-    omopgenerics::settings() |>
-    dplyr::pull("confidence_interval") |>
-    unique()
-
-  if (length(ci) > 1) {
-    cli::cli_abort("Provide results generated using the same confidence interval.")
-  }
+  # validate checks
+  result <- omopgenerics::validateResultArgument(result)
 
+ # check settings
   result <- result |>
-    visOmopResults::filterSettings(.data$result_type == "sequence_ratios")
-
-  # get study population
-  if (studyPopulation) {
-    total_participants <- result |>
-      dplyr::mutate(
-        estimate_value = as.numeric(.data$estimate_value)
-      ) |>
-      dplyr::filter(.data$variable_level == "first_pharmac") |>
-      dplyr::filter(.data$estimate_name == "count") |>
-      tidyr::pivot_wider(names_from = "variable_name",
-                         values_from = "estimate_value") |>
-      dplyr::mutate(estimate_value = as.character(.data$index + .data$marker),
-                    estimate_name = "Study population") |>
-      visOmopResults::splitGroup() |>
-      dplyr::select(!c("estimate_type", dplyr::starts_with("additional"),
-                       dplyr::starts_with("strata"), "index", "marker")) |>
-      dplyr::select(-"variable_level")
-  }
-
-  # columns to export
-  order_columns <- c("Database name", "Index", "Marker", "Study population",
-                     "Index first, N (%)", "Marker first, N (%)",
-                     paste0("CSR (", ci, "% CI)"),
-                     paste0("ASR (", ci, "% CI)"))
-  order_columns <- order_columns[c(cdmName, indexName, markerName,
-                                   studyPopulation, TRUE, TRUE, TRUE, TRUE)]
-
-  # correct names
-  if (!is.null(.options$groupColumn)) {
-    ind <- c("cdm_name", "index_cohort_name", "marker_cohort_name") %in% .options$groupColumn
-    if (any(ind)) {
-      .options$groupColumn <- c("Database name", "Index", "Marker")[ind]
-    }
-  }
-
-  # format table
-  format_result <- result |>
-    visOmopResults::formatEstimateValue(
-      decimals = .options$decimals,
-      decimalMark = .options$decimalMark,
-      bigMark = .options$bigMark
-    ) |>
-    visOmopResults::formatEstimateName(
-      estimateNameFormat = estimateNameFormat,
-      keepNotFormatted = .options$keepNotFormatted,
-      useFormatOrder = .options$useFormatOrder
-    ) |>
-    visOmopResults::splitGroup() |>
-    dplyr::select(!c("estimate_type", dplyr::starts_with("additional"),
-                     dplyr::starts_with("strata"))) |>
-    dplyr::mutate(
-      estimate_name = dplyr::case_when(
-        .data$variable_name == "crude" ~ paste0("CSR (", ci, "% CI)"),
-        .data$variable_name == "adjusted" ~ paste0("ASR (", ci, "% CI)"),
-        .default = .data$estimate_name
-      ),
-      estimate_name = dplyr::case_when(
-        .data$variable_name == "crude" ~ paste0("CSR (", ci, "% CI)"),
-        .data$variable_name == "adjusted" ~ paste0("ASR (", ci, "% CI)"),
-        .data$variable_name == "index" ~ "Index first, N (%)",
-        .data$variable_name == "marker" ~ "Marker first, N (%)"
-      )
-    ) |>
-    dplyr::select(-dplyr::all_of(c("variable_name", "variable_level"))) %>%
-    {if (studyPopulation) {
-      dplyr::union_all(., total_participants)
-    } else .} |>
-    dplyr::rename(
-      "Database name" = "cdm_name",
-      "Index" = "index_cohort_name",
-      "Marker" = "marker_cohort_name"
-    ) |>
-    dplyr::mutate(
-      Index = stringr::str_to_sentence(gsub("_", " ", .data$Index)),
-      Marker = stringr::str_to_sentence(gsub("_", " ", .data$Marker))
-    ) |>
-    # {if (!indexName) {
-    #   dplyr::select(., -"Index")
-    # } else .} |>
-    # {if (!markerName) {
-    #   dplyr::select(., -"Marker")
-    # } else .} |>
-    tidyr::pivot_wider(names_from = "estimate_name", values_from = "estimate_value") |>
-    dplyr::select(dplyr::all_of(order_columns))
-
-  # output type
-  if (type == "tibble") {
-    return(format_result)
-  }
-
-  if (type == "gt") {
-    return(
-      visOmopResults::gtTable(
-        format_result,
-        style = style,
-        na = .options$na,
-        title = .options$title,
-        subtitle = .options$subtitle,
-        caption = .options$caption,
-        groupColumn = .options$groupColumn,
-        groupAsColumn = .options$groupAsColumn,
-        groupOrder = .options$groupOrder,
-        colsToMergeRows = .options$colsToMergeRows
-      )
+    visOmopResults::filterSettings(
+      .data$result_type == "sequence_ratios"
     )
-  }
 
-  if (type == "flextable") {
-    return(
-      visOmopResults::fxTable(
-        format_result,
-        style = style,
-        na = .options$na,
-        title = .options$title,
-        subtitle = .options$subtitle,
-        caption = .options$caption,
-        groupColumn = .options$groupColumn,
-        groupAsColumn = .options$groupAsColumn,
-        groupOrder = .options$groupOrder,
-        colsToMergeRows = .options$colsToMergeRows
-      )
-    )
+  if (nrow(result) == 0) {
+    cli::cli_warn("`result` object does not contain any `result_type == 'sequence_ratios'` information.")
+    return(emptyResultTable(type))
   }
 
-}
-
-defaultOptions <- function(userOptions) {
-  defaultOpts <- list(
-    decimals = c(integer = 0, numeric = 2, percentage = 1, proportion = 3),
-    decimalMark = ".",
-    bigMark = ",",
-    keepNotFormatted = TRUE,
-    useFormatOrder = TRUE,
-    header = NULL,
-    includeHeaderName = FALSE,
-    includeHeaderKey = TRUE,
-    na = "-",
-    title = NULL,
-    subtitle = NULL,
-    caption = NULL,
-    groupColumn = NULL,
-    groupAsColumn = FALSE,
-    groupOrder = NULL,
-    colsToMergeRows = "all_columns"
+  # format table
+  tab <- visOmopResults::visOmopTable(
+    result = result,
+    estimateName = c("N (%)" = "<count> (<percentage>%)",
+                     "SR [CI 95%]" = "<point_estimate> [<lower_CI> - <upper_CI>]"),
+    header = header,
+    groupColumn = groupColumn,
+    type = type,
+    hide = hide
   )
-
-
-  for (opt in names(userOptions)) {
-    defaultOpts[[opt]] <- userOptions[[opt]]
-  }
-
-  return(defaultOpts)
-}
-
-#' A formatted visualization of sequence_ratios objects.
-#'
-#' @description
-#' It provides a list of allowed inputs for .option argument in
-#' tableSequenceRatios and their given default value.
-#'
-#'
-#' @return The default .options named list.
-#'
-#' @export
-#'
-#' @examples
-#' {
-#'  tableSequenceRatiosOptions()
-#' }
-#'
-tableSequenceRatiosOptions <- function() {
-  return(defaultOptions(NULL))
 }

R/generateSequenceCohortSet.R

@@ -293,7 +293,7 @@ generateSequenceCohortSet <- function(cdm,
     dplyr::distinct() |>
     dplyr::mutate(cohort_date_range = !!paste0("(",cohortDateRange[[1]], ",",
                                              cohortDateRange[[2]], ")"),
-                  days_prior_observation = !!daysPriorObservation,
+                  days_prior_observation = !!format(daysPriorObservation, nsmall = 0),
                   washout_window = !!format(washoutWindow, nsmall = 0),
                   index_marker_gap = !!format(indexMarkerGap, nsmall = 0),
                   combination_window = !!paste0("(",combinationWindow[[1]], ",",

R/getConfidenceInterval.R

@@ -19,15 +19,11 @@ getConfidenceInterval <- function(table, nsr, confidenceInterval = 95){
     counts$upper_asr_ci <- counts$upper_csr_ci/nsr
 
   } else if (counts$marker_first == 0){
-    counts$marker_first <-  0.5
-    counts$lower_csr_ci <- stats::qbeta(confidenceIntervalLevel, counts$index_first + 0.5, counts$marker_first + 0.5)
-    counts$upper_csr_ci <- stats::qbeta(1-confidenceIntervalLevel, counts$index_first + 0.5, counts$marker_first + 0.5)
+    counts$lower_csr_ci <- Inf
+    counts$upper_csr_ci <- Inf
 
-    counts$lower_csr_ci <- counts$lower_csr_ci/(1-counts$lower_csr_ci)
-    counts$upper_csr_ci <- counts$upper_csr_ci/(1-counts$upper_csr_ci)
-
-    counts$lower_asr_ci <- counts$lower_csr_ci/nsr
-    counts$upper_asr_ci <- counts$upper_csr_ci/nsr
+    counts$lower_asr_ci <- Inf
+    counts$upper_asr_ci <- Inf
 
   } else {
     counts$lower_csr_ci <- stats::qbeta(confidenceIntervalLevel, counts$index_first + 0.5, counts$marker_first + 0.5)

R/helpers.R

@@ -148,3 +148,18 @@ redundant_fun <- function() {
   gt::gt(data)
   CDMConnector::cdmDisconnect(cdm = cdm)
 }
+
+# empty output of visOmopTable()
+
+emptyResultTable <- function(type) {
+x <- dplyr::tibble(`Table has no data` = character())
+if (type == "gt") {
+  result <- gt::gt(x)
+} else if (type == "flextable") {
+  result <- flextable::flextable(x)
+} else {
+  result <- x
+}
+result
+}
+

R/inputValidation.R

@@ -137,8 +137,6 @@ checksFormatSequenceSymmetry <- function(type, crude, adjusted, studyPopulation,
   }
   ## Type
   checkType(type, errorMessage)
-  ## .options
-  checkOptions(.options, errorMessage)
   # Report errors
   checkmate::reportAssertions(collection = errorMessage)
 }
@@ -359,21 +357,6 @@ checkSingleBoolean <- function(splitGroup, errorMessage) {
                            add = errorMessage)
 }
 
-checkOptions <- function(.options, errorMessage) {
-  allowedNames <- names(tableSequenceRatiosOptions())
-  optionsNames <- names(.options)
-  checkmate::assertList(.options, null.ok = TRUE, any.missing = TRUE,
-                        types = c("numeric", "logical", "character", "list"),
-                        add = errorMessage)
-  names_id <- optionsNames %in% allowedNames
-  if(!all(names_id)) {
-    errorMessage$push(
-      paste0("The following elements are not supported arguments for .options: ",
-             paste0(optionsNames[!names_id], collapse = ", "))
-    )
-  }
-}
-
 checkXLim <- function(xlim, errorMessage) {
   checkmate::assert_integerish(xlim,
                                len = 2,

R/plotTemporalSymmetry.R

@@ -44,7 +44,7 @@ plotTemporalSymmetry <- function(result,
                                  scales = scales)
 
   plot_data <- result |>
-    visOmopResults::splitNameLevel() |>
+    visOmopResults::splitGroup() |>
     dplyr::select(.data$index_name, .data$marker_name, .data$variable_name, .data$variable_level, .data$estimate_name, .data$estimate_value, .data$additional_level, .data$additional_name) |>
     dplyr::group_by(.data$estimate_name) |>
     dplyr::mutate(row = dplyr::row_number()) |>