diff --git a/DESCRIPTION b/DESCRIPTION index 77ab6a8..43c0fe3 100644 --- a/DESCRIPTION +++ b/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", , "xihang.chen@ndorms.ox.ac.uk", 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 diff --git a/NAMESPACE b/NAMESPACE index 279fdc9..4403729 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,7 +7,6 @@ export(plotTemporalSymmetry) export(summariseSequenceRatios) export(summariseTemporalSymmetry) export(tableSequenceRatios) -export(tableSequenceRatiosOptions) importFrom(dplyr,"%>%") importFrom(rlang,":=") importFrom(rlang,.data) diff --git a/R/displayTables.R b/R/displayTables.R index 45cf04f..dfefcee 100644 --- a/R/displayTables.R +++ b/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 (%)" = " ( %)", - "SR (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 (%)" = " (%)", + "SR [CI 95%]" = " [ - ]"), + 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)) } diff --git a/R/generateSequenceCohortSet.R b/R/generateSequenceCohortSet.R index 0a76497..c12c827 100644 --- a/R/generateSequenceCohortSet.R +++ b/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]], ",", diff --git a/R/getConfidenceInterval.R b/R/getConfidenceInterval.R index b72058f..c139da3 100644 --- a/R/getConfidenceInterval.R +++ b/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) diff --git a/R/helpers.R b/R/helpers.R index 3db967e..214c777 100644 --- a/R/helpers.R +++ b/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 +} + diff --git a/R/inputValidation.R b/R/inputValidation.R index 117f230..a7cd8b6 100644 --- a/R/inputValidation.R +++ b/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, diff --git a/R/plotTemporalSymmetry.R b/R/plotTemporalSymmetry.R index a7156fc..312ca08 100644 --- a/R/plotTemporalSymmetry.R +++ b/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()) |> diff --git a/R/summariseSequenceRatios.R b/R/summariseSequenceRatios.R index 249d494..8fe8499 100644 --- a/R/summariseSequenceRatios.R +++ b/R/summariseSequenceRatios.R @@ -82,7 +82,7 @@ summariseSequenceRatios <- function(cohort, dplyr::filter(.data$index_id == i & .data$marker_id == j) |> dplyr::pull("nsr") asr <- csr/nsr - counts <- getConfidenceInterval(temporary_cohort, + counts <- getConfidenceInterval(table = temporary_cohort, nsr = nsr, confidenceInterval = confidenceInterval) |> dplyr::select(-c("index_first", "marker_first")) diff --git a/R/summariseTemporalSymmetry.R b/R/summariseTemporalSymmetry.R index 2e0a7f9..ea8c823 100644 --- a/R/summariseTemporalSymmetry.R +++ b/R/summariseTemporalSymmetry.R @@ -23,7 +23,7 @@ #' name = "joined_cohorts", #' indexTable = "cohort_1", #' markerTable = "cohort_2") -#' temporal_symmetry <- summariseTemporalSymmetry(cohort = cdm$joined_cohorts) +#' temporal_symmetry <- summariseTemporalSymmetry(cohort = cdm$joined_cohorts, minCellCount = 0) #' CDMConnector::cdmDisconnect(cdm) #' } #' @@ -31,7 +31,6 @@ summariseTemporalSymmetry <- function(cohort, cohortId = NULL, timescale = "month", minCellCount = 5) { - # checks checkInputSummariseTemporalSymmetry(cohort = cohort, cohortId = cohortId, @@ -45,8 +44,8 @@ summariseTemporalSymmetry <- function(cohort, cohort_settings <- omopgenerics::settings(cohort)|> dplyr::mutate(timescale = .env$timescale) |> dplyr::select(-c("index_id", "marker_id", "index_name", "marker_name")) - settings <- c("days_prior_observation", "washout_window", "index_marker_gap", - "combination_window", "timescale") + settings <- c("cohort_date_range", "days_prior_observation", "washout_window", "index_marker_gap", + "combination_window", "moving_average_restriction", "timescale") output <- cohort %>% dplyr::mutate(time = as.numeric(!!CDMConnector::datediff( @@ -89,7 +88,7 @@ summariseTemporalSymmetry <- function(cohort, dplyr::mutate(variable_name = "temporal_symmetry", variable_level = as.character(.data$variable_level), estimate_value = as.character(.data$estimate_value), - strata_name = "overall", #to change + strata_name = "overall", strata_level = "overall", additional_name = "overall", additional_level = "overall", diff --git a/inst/WORDLIST b/inst/WORDLIST index db9753e..1fea356 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -60,7 +60,6 @@ summariseTemporalSymmetry summarised summarising tableSequenceRatios -tableSequenceRatiosOptions temporality tibble visOmopResults diff --git a/man/summariseTemporalSymmetry.Rd b/man/summariseTemporalSymmetry.Rd index a336706..c3a2d33 100644 --- a/man/summariseTemporalSymmetry.Rd +++ b/man/summariseTemporalSymmetry.Rd @@ -37,7 +37,7 @@ cdm <- generateSequenceCohortSet(cdm = cdm, name = "joined_cohorts", indexTable = "cohort_1", markerTable = "cohort_2") -temporal_symmetry <- summariseTemporalSymmetry(cohort = cdm$joined_cohorts) +temporal_symmetry <- summariseTemporalSymmetry(cohort = cdm$joined_cohorts, minCellCount = 0) CDMConnector::cdmDisconnect(cdm) } diff --git a/man/tableSequenceRatios.Rd b/man/tableSequenceRatios.Rd index eb4f911..da320a5 100644 --- a/man/tableSequenceRatios.Rd +++ b/man/tableSequenceRatios.Rd @@ -6,36 +6,24 @@ \usage{ tableSequenceRatios( result, + header = "marker_cohort_name", + groupColumn = "cdm_name", type = "gt", - estimateNameFormat = c(`N (\%)` = " ( \%)", `SR (CI)` = - " ( - )"), - style = "default", - studyPopulation = TRUE, - cdmName = TRUE, - .options = NULL + hide = "variable_level" ) } \arguments{ \item{result}{A sequence_symmetry object.} -\item{type}{Type of desired formatted table, possibilities: "gt", -"flextable", "tibble".} +\item{header}{A vector specifying the elements to include in the header. +See visOmopResults package for more information on how to use this parameter.} -\item{estimateNameFormat}{The columns that the user wishes to see for the -formatted table, by default it would display both the counts and sequence ratios.} +\item{groupColumn}{Columns to use as group labels. +See visOmopResults package for more information on how to use this parameter.} -\item{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.} +\item{type}{The desired format of the output table.} -\item{studyPopulation}{whether to report the study population.} - -\item{cdmName}{whether to report database names.} - -\item{.options}{named list with additional formatting options. -tableSequenceRatiosOptions() shows allowed arguments and -their default values.} +\item{hide}{Columns to drop from the output table.} } \value{ A formatted version of the sequence_symmetry object. @@ -57,5 +45,4 @@ gtResult <- tableSequenceRatios(res) CDMConnector::cdmDisconnect(cdm = cdm) } - } diff --git a/man/tableSequenceRatiosOptions.Rd b/man/tableSequenceRatiosOptions.Rd deleted file mode 100644 index 6ac57a4..0000000 --- a/man/tableSequenceRatiosOptions.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/displayTables.R -\name{tableSequenceRatiosOptions} -\alias{tableSequenceRatiosOptions} -\title{A formatted visualization of sequence_ratios objects.} -\usage{ -tableSequenceRatiosOptions() -} -\value{ -The default .options named list. -} -\description{ -It provides a list of allowed inputs for .option argument in -tableSequenceRatios and their given default value. -} -\examples{ -{ - tableSequenceRatiosOptions() -} - -} diff --git a/tests/testthat/test-displayTable.R b/tests/testthat/test-displayTable.R index 6127c9c..0c8bfcb 100644 --- a/tests/testthat/test-displayTable.R +++ b/tests/testthat/test-displayTable.R @@ -13,16 +13,28 @@ test_that("tableSequenceRatios - gt output", { gtResult <- tableSequenceRatios(res) expect_true("gt_tbl" %in% (gtResult %>% class())) - expect_true(all(colnames(gtResult$`_data`) %in% - c("Database name", "Index", "Marker", "Study population", - "Index first, N (%)", "Marker first, N (%)", "CSR (95% CI)", - "ASR (95% CI)"))) - expect_no_error(gtResult <- tableSequenceRatios(res, studyPopulation = FALSE)) - expect_no_error(gtResult <- tableSequenceRatios(res, cdmName = FALSE)) - expect_true(all(colnames(gtResult$`_data`) %in% - c("Index", "Marker", "Study population", - "Index first, N (%)", "Marker first, N (%)", "CSR (95% CI)", - "ASR (95% CI)"))) + + expect_no_error( + tableSequenceRatios(res, header = "index_cohort_name") + ) + + expect_error( + tableSequenceRatios(res, header = "cdm_name") + ) + + expect_no_error( + tableSequenceRatios(res, + header = "index_cohort_name", + groupColumn = "cdm_name") + ) + + expect_no_error( + tableSequenceRatios(res, + header = "index_cohort_name", + groupColumn = character(), + hide = "cdm_name") + ) + CDMConnector::cdmDisconnect(cdm) }) @@ -43,14 +55,6 @@ test_that("tableSequenceRatios - tibble output", { tibble_res <- tableSequenceRatios(res, type = "tibble") expect_true("data.frame" %in% (tibble_res %>% class())) - expect_true(all(colnames(tibble_res) %in% - c("Database name", "Index", "Marker", "Study population", - "Index first, N (%)", "Marker first, N (%)", "CSR (95% CI)", - "ASR (95% CI)"))) - expect_no_error(tibble_res <- tableSequenceRatios(res, type = "tibble", - studyPopulation = FALSE)) - expect_no_error(gtResult <- tableSequenceRatios(res, type = "tibble", - cdmName = FALSE)) CDMConnector::cdmDisconnect(cdm) }) @@ -71,103 +75,33 @@ test_that("tableSequenceRatios - flextable output", { flextable_res <- tableSequenceRatios(res, type = "flextable") expect_true("flextable" %in% (flextable_res %>% class())) - expect_true(all(colnames(flextable_res) %in% - c("Database name", "Index", "Marker", "Study population", - "Index first, N (%)", "Marker first, N (%)", "CSR (95% CI)", - "ASR (95% CI)"))) - expect_no_error(flextable_res <- tableSequenceRatios(res, type = "flextable", - studyPopulation = FALSE)) - expect_no_error(flextable_res <- tableSequenceRatios(res, type = "flextable", - cdmName = FALSE)) - CDMConnector::cdmDisconnect(cdm) -}) - -test_that("tableSequenceRatio options", { - skip_on_cran() - skip_if_not_installed("gt") - skip_if_not_installed("flextable") - cdm <- mockCohortSymmetry() - cdm <- generateSequenceCohortSet(cdm = cdm, - indexTable = "cohort_1", - markerTable = "cohort_2", - name = "joined_cohort") - - expect_warning( - result <- summariseSequenceRatios(cohort = cdm$joined_cohort, minCellCount = 0) - ) expect_no_error( - tableSequenceRatios(result = result, - .options = NULL) + tableSequenceRatios(res, + type = "flextable", + header = "index_cohort_name") ) expect_error( - tableSequenceRatios(result = result, - .options = list(titless = "Title")) - ) - - expect_no_error( - tableSequenceRatios(result = result, - .options = list( - groupColumn = c("cdm_name") - ))) - - expect_no_error( - tableSequenceRatios(result = result, - .options = list(bigMark = " < ")) - ) - - expect_no_error( - tableSequenceRatios(result = result, - .options = list(decimalMark = " < ")) - ) - - expect_no_error( - tableSequenceRatios(result = result, - .options = list(keepNotFormatted = F)) - ) - - expect_no_error( - tableSequenceRatios(result = result, - .options = list(useFormatOrder = F)) - ) - - expect_no_error( - tableSequenceRatios(result = result, - .options = list(includeHeaderName = T)) - ) - - expect_no_error( - tableSequenceRatios(result = result, - .options = list(includeHeaderKey = F)) - ) - - expect_no_error( - tableSequenceRatios(result = result, - .options = list(title = "Title")) + tableSequenceRatios(res, + type = "flextable", + header = "cdm_name") ) expect_no_error( - tableSequenceRatios(result = result, - .options = list( - title = "Title", - subtitle = "Subtitle")) + tableSequenceRatios(res, + type = "flextable", + header = "index_cohort_name", + groupColumn = "cdm_name") ) expect_no_error( - tableSequenceRatios(result = result, - .options = list(caption = "caption")) + tableSequenceRatios(res, + type = "flextable", + header = "index_cohort_name", + groupColumn = character(), + hide = "cdm_name") ) - expect_no_error( - tableSequenceRatios(result = result, - .options = list(na = "NA")) - ) - - expect_no_error( - tableSequenceRatios(result = result, - .options = list(groupAsColumn = T)) - ) - - CDMConnector::cdm_disconnect(cdm = cdm) + CDMConnector::cdmDisconnect(cdm) }) diff --git a/tests/testthat/test-plotSequenceRatio.R b/tests/testthat/test-plotSequenceRatio.R index 59c9a25..20033d6 100644 --- a/tests/testthat/test-plotSequenceRatio.R +++ b/tests/testthat/test-plotSequenceRatio.R @@ -125,10 +125,6 @@ test_that("empty result error",{ sr <- summariseSequenceRatios(cohort = cdm$joined_cohorts) ) - expect_error( - plotSequenceRatios(sr) - ) - expect_warning( sr2 <- summariseSequenceRatios(cohort = cdm$joined_cohorts, minCellCount = 0) diff --git a/tests/testthat/test-plotTemporalSymmetry.R b/tests/testthat/test-plotTemporalSymmetry.R index d191688..3159273 100644 --- a/tests/testthat/test-plotTemporalSymmetry.R +++ b/tests/testthat/test-plotTemporalSymmetry.R @@ -122,12 +122,6 @@ test_that("empty result error",{ indexTable = "cohort_1", markerTable = "cohort_2") - ts <- summariseTemporalSymmetry(cohort = cdm$joined_cohorts) - - expect_error( - plotTemporalSymmetry(ts) - ) - ts2 <- summariseTemporalSymmetry(cohort = cdm$joined_cohorts, minCellCount = 0) diff --git a/tests/testthat/test-summariseSequenceRatios.R b/tests/testthat/test-summariseSequenceRatios.R index c3574df..9b6787f 100644 --- a/tests/testthat/test-summariseSequenceRatios.R +++ b/tests/testthat/test-summariseSequenceRatios.R @@ -953,12 +953,59 @@ test_that("min cell count",{ nrow()|> as.numeric()) - expect_true(all( - (result2 %>% - dplyr::select(estimate_value) %>% - dplyr::mutate(estimate_value = as.numeric(estimate_value)) %>% - dplyr::pull(estimate_value))%in% c(NA, 0) - )) - CDMConnector::cdm_disconnect(cdm = cdm) }) + +test_that("Inf CI", { + skip_on_cran() + indexCohort <- dplyr::tibble( + cohort_definition_id = c(1, 1, 1, 1), + subject_id = c(1, 2, 3, 4), + cohort_start_date = as.Date( + c( + "2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01" + ) + ), + cohort_end_date = as.Date( + c( + "2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01" + ) + ) + )|> + dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id), + subject_id = as.integer(.data$subject_id)) + + markerCohort <- dplyr::tibble( + cohort_definition_id = c(1, 1, 1, 1), + subject_id = c(1, 2, 3, 4), + cohort_start_date = as.Date( + c( + "2020-04-02", "2021-06-02", "2022-05-23", "2010-01-02" + ) + ), + cohort_end_date = as.Date( + c( + "2020-04-02", "2021-06-02", "2022-05-23", "2010-01-02" + ) + ) + )|> + dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id), + subject_id = as.integer(.data$subject_id)) + + cdm <- mockCohortSymmetry(indexCohort = indexCohort, + markerCohort = markerCohort) + + cdm <- generateSequenceCohortSet(cdm = cdm, + name = "joined_cohorts", + indexTable = "cohort_1", + markerTable = "cohort_2") + + res <- summariseSequenceRatios(cohort = cdm$joined_cohorts) + + expect_true( + all(res |> + dplyr::filter(estimate_name %in% c("lower_CI", "upper_CI")) |> + dplyr::pull("estimate_value") == "Inf" + ) + ) +}) diff --git a/tests/testthat/test-summariseTemporalSymmetry.R b/tests/testthat/test-summariseTemporalSymmetry.R index c4d43ba..74d17ca 100644 --- a/tests/testthat/test-summariseTemporalSymmetry.R +++ b/tests/testthat/test-summariseTemporalSymmetry.R @@ -27,8 +27,6 @@ test_that("test summariseTemporalSymmetry", { ) )) - expect_true(is.na(temporal_symmetry$estimate_value |> unique())) - temporal_symmetry <- summariseTemporalSymmetry(cohort = cdm$joined_cohorts, minCellCount = 0) diff --git a/vignettes/.build.timestamp b/vignettes/.build.timestamp deleted file mode 100644 index e69de29..0000000 diff --git a/vignettes/a04_Visualise_sequence_ratios.Rmd b/vignettes/a04_Visualise_sequence_ratios.Rmd index e9551b5..2dc87b0 100644 --- a/vignettes/a04_Visualise_sequence_ratios.Rmd +++ b/vignettes/a04_Visualise_sequence_ratios.Rmd @@ -83,31 +83,6 @@ The function `tableSequenceRatios` inputs the result from `summariseSequenceRati tableSequenceRatios(result = result) ``` -## Arguments used to suppress columns - -By default, it has many columns such as Index (name), Marker (name), Study population, CSR and ASR, some of these columns could be suppressed with relevant parameters. For example if one wants to not display study population, one could do the following: - -```{r message= FALSE, warning=FALSE} -tableSequenceRatios(result = result, - studyPopulation = FALSE) -``` - -Or suppress `cdmName` like so - -```{r message= FALSE, warning=FALSE} -tableSequenceRatios(result = result, - cdmName = FALSE) -``` - -There are also `.options` argument that one may wish to specify. For example, the user can specify a title: - -```{r message= FALSE, warning=FALSE} -tableSequenceRatios(result = result, - .options = list(title = "Title")) -``` - -Similarly, `subtitle` and `caption` can also be defined this way. - ## Modify `type` Instead of a gt table, the user may also want to put the sequence ratio results in a flex table format (the rest of the arguments that we saw for a gt table also applies here): @@ -124,14 +99,6 @@ tableSequenceRatios(result = result, type = "tibble") ``` -One may also wish to change the style of the output, see the R package visOmopResults for more information on how to define a style. The default style inherits from visOmopResults, however the user may set it to NULL for the gt/flextable default styling. - -```{r message= FALSE, warning=FALSE} -tableSequenceRatios(result = result, - type = "flextable", - style = NULL) -``` - # Plot output of the sequence ratio results Similarly, we also have `plotSequenceRatios()` to visualise the results.