From 66d7b6c80fd7497b4752b50acb04753b0e3a9340 Mon Sep 17 00:00:00 2001 From: xihang-chen Date: Sun, 24 Nov 2024 20:26:21 +0000 Subject: [PATCH 1/8] new cran release fix --- DESCRIPTION | 6 +++--- R/generateSequenceCohortSet.R | 2 +- tests/testthat/test-plotSequenceRatio.R | 4 ---- tests/testthat/test-plotTemporalSymmetry.R | 6 ------ tests/testthat/test-summariseSequenceRatios.R | 7 ------- tests/testthat/test-summariseTemporalSymmetry.R | 2 -- 6 files changed, 4 insertions(+), 23 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 77ab6a8..56b4184 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")), @@ -55,13 +55,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), + omopgenerics (>= 0.4.0), flextable, gt, DrugUtilisation (>= 0.7.0), 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/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..91a503a 100644 --- a/tests/testthat/test-summariseSequenceRatios.R +++ b/tests/testthat/test-summariseSequenceRatios.R @@ -953,12 +953,5 @@ 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) }) 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) From f8f1d6a499a6d04865fcfd087448288e0ca0db81 Mon Sep 17 00:00:00 2001 From: xihang-chen Date: Mon, 25 Nov 2024 10:47:10 +0000 Subject: [PATCH 2/8] to counter new release of visOmopResults --- R/plotTemporalSymmetry.R | 2 +- R/summariseTemporalSymmetry.R | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) 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/summariseTemporalSymmetry.R b/R/summariseTemporalSymmetry.R index 2e0a7f9..a90e04d 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) #' } #' @@ -45,8 +45,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 +89,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", From e49371e7957a595042a9959d28df9576fbdfa1ee Mon Sep 17 00:00:00 2001 From: xihang-chen Date: Mon, 25 Nov 2024 15:14:47 +0000 Subject: [PATCH 3/8] change tableSequenceRatio() function --- DESCRIPTION | 4 +- NAMESPACE | 1 - R/displayTables.R | 236 +++----------------- R/helpers.R | 15 ++ R/summariseTemporalSymmetry.R | 1 - man/summariseTemporalSymmetry.Rd | 2 +- man/tableSequenceRatios.Rd | 33 +-- man/tableSequenceRatiosOptions.Rd | 21 -- tests/testthat/test-displayTable.R | 142 ++++-------- vignettes/.build.timestamp | 0 vignettes/a04_Visualise_sequence_ratios.Rmd | 33 --- 11 files changed, 94 insertions(+), 394 deletions(-) delete mode 100644 man/tableSequenceRatiosOptions.Rd delete mode 100644 vignettes/.build.timestamp diff --git a/DESCRIPTION b/DESCRIPTION index 56b4184..43c0fe3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,6 +46,8 @@ Suggests: tidyselect, knitr, dbplyr (>= 2.5.0), + flextable, + gt, ggplot2, rmarkdown Imports: @@ -62,8 +64,6 @@ Imports: duckdb, here, omopgenerics (>= 0.4.0), - flextable, - gt, 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/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/summariseTemporalSymmetry.R b/R/summariseTemporalSymmetry.R index a90e04d..ea8c823 100644 --- a/R/summariseTemporalSymmetry.R +++ b/R/summariseTemporalSymmetry.R @@ -31,7 +31,6 @@ summariseTemporalSymmetry <- function(cohort, cohortId = NULL, timescale = "month", minCellCount = 5) { - # checks checkInputSummariseTemporalSymmetry(cohort = cohort, cohortId = cohortId, 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..13e3d7f 100644 --- a/man/tableSequenceRatios.Rd +++ b/man/tableSequenceRatios.Rd @@ -6,36 +6,28 @@ \usage{ tableSequenceRatios( result, + estimateName = character(), + header = character(), + groupColumn = character(), 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{estimateName}{A named list of estimate names to join. +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{header}{A vector specifying the elements to include in the header. +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{groupColumn}{Columns to use as group labels. +See visOmopResults package for more information on how to use this parameter.} -\item{studyPopulation}{whether to report the study population.} +\item{type}{The desired format of the output table.} -\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 +49,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/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. From 7b5987c4d9346075317b51ad071dd45c742c6c52 Mon Sep 17 00:00:00 2001 From: xihang-chen Date: Mon, 25 Nov 2024 15:20:49 +0000 Subject: [PATCH 4/8] Update tableSequenceRatios.Rd --- man/tableSequenceRatios.Rd | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/man/tableSequenceRatios.Rd b/man/tableSequenceRatios.Rd index 13e3d7f..da320a5 100644 --- a/man/tableSequenceRatios.Rd +++ b/man/tableSequenceRatios.Rd @@ -6,9 +6,8 @@ \usage{ tableSequenceRatios( result, - estimateName = character(), - header = character(), - groupColumn = character(), + header = "marker_cohort_name", + groupColumn = "cdm_name", type = "gt", hide = "variable_level" ) @@ -16,9 +15,6 @@ tableSequenceRatios( \arguments{ \item{result}{A sequence_symmetry object.} -\item{estimateName}{A named list of estimate names to join. -See visOmopResults package for more information on how to use this parameter.} - \item{header}{A vector specifying the elements to include in the header. See visOmopResults package for more information on how to use this parameter.} From 26b4db674de325d4afc3617f3ff60eaeb8712692 Mon Sep 17 00:00:00 2001 From: xihang-chen Date: Mon, 25 Nov 2024 15:54:36 +0000 Subject: [PATCH 5/8] update, removing .options() --- R/inputValidation.R | 15 --------------- inst/WORDLIST | 1 - 2 files changed, 16 deletions(-) diff --git a/R/inputValidation.R b/R/inputValidation.R index 117f230..f74f585 100644 --- a/R/inputValidation.R +++ b/R/inputValidation.R @@ -359,21 +359,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/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 From eafd70935dd9d83b127df77558fdfa4ab3e423f5 Mon Sep 17 00:00:00 2001 From: xihang-chen Date: Mon, 25 Nov 2024 16:06:42 +0000 Subject: [PATCH 6/8] Update inputValidation.R --- R/inputValidation.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/inputValidation.R b/R/inputValidation.R index f74f585..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) } From 431bd7658830b3a1eb9e29ba8c9dcf826177b749 Mon Sep 17 00:00:00 2001 From: xihang-chen Date: Mon, 25 Nov 2024 17:15:10 +0000 Subject: [PATCH 7/8] changing CI --- R/getConfidenceInterval.R | 12 ++++-------- R/summariseSequenceRatios.R | 2 +- 2 files changed, 5 insertions(+), 9 deletions(-) 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/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")) From 98b0462bd64db4a47822239ce729849942a62adb Mon Sep 17 00:00:00 2001 From: xihang-chen Date: Mon, 25 Nov 2024 17:31:20 +0000 Subject: [PATCH 8/8] Update test-summariseSequenceRatios.R --- tests/testthat/test-summariseSequenceRatios.R | 54 +++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/tests/testthat/test-summariseSequenceRatios.R b/tests/testthat/test-summariseSequenceRatios.R index 91a503a..9b6787f 100644 --- a/tests/testthat/test-summariseSequenceRatios.R +++ b/tests/testthat/test-summariseSequenceRatios.R @@ -955,3 +955,57 @@ test_that("min cell count",{ 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" + ) + ) +})