diff --git a/.gitignore b/.gitignore index a127bac..5d103d3 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ inst/doc .Rhistory inst/shiny/data/raw/*.csv inst/shiny/data/appData.RData +inst/shiny/*.RData diff --git a/DESCRIPTION b/DESCRIPTION index 3bb79a9..14bb175 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,7 +35,7 @@ Suggests: RPostgres, PatientProfiles (>= 1.2.2), ggplot2, - ggpubr, + ggpubr, stringr, shiny, DiagrammeR, @@ -46,7 +46,9 @@ Suggests: bslib, shinyWidgets, plotly, - tidyr + tidyr, + ggpol, + scales Config/testthat/edition: 3 RoxygenNote: 7.3.2 Imports: diff --git a/inst/shiny/global.R b/inst/shiny/global.R index 5789ca9..efebf7b 100644 --- a/inst/shiny/global.R +++ b/inst/shiny/global.R @@ -18,6 +18,7 @@ library(shinycssloaders) library(shinyWidgets) library(plotly) library(tidyr) +library(patchwork) # ensure minimum versions rlang::check_installed("omopgenerics", version = "0.4") @@ -43,8 +44,8 @@ plotComparedLsc <- function(lsc, cohorts, imputeMissings, colour = NULL, facet = plot_data <- lsc |> filter(group_level %in% c(cohorts )) |> - filter(estimate_name == "percentage") |> - omopgenerics::addSettings() |> + filter(estimate_name == "percentage") |> + omopgenerics::addSettings() |> select(database = cdm_name, cohort_name = group_level, variable_name, @@ -53,16 +54,16 @@ plotComparedLsc <- function(lsc, cohorts, imputeMissings, colour = NULL, facet = table = table_name, percentage = estimate_value) |> mutate(percentage = if_else(percentage == "-", - NA, percentage)) |> - mutate(percentage = as.numeric(percentage)) |> + NA, percentage)) |> + mutate(percentage = as.numeric(percentage)) |> pivot_wider(names_from = cohort_name, values_from = percentage) if(isTRUE(imputeMissings)){ - plot_data <- plot_data |> + plot_data <- plot_data |> mutate(across(c(cohorts[1], cohorts[2]), ~if_else(is.na(.x), 0, .x))) } - + plot <- plot_data |> ggplot(aes(text = paste("
Database:", database, "
Concept:", variable_name, @@ -85,3 +86,67 @@ plotComparedLsc <- function(lsc, cohorts, imputeMissings, colour = NULL, facet = ggplotly(plot) } + +plotAgeDistribution <- function(summarise_table, summarise_characteristics){ + + data <- summarise_table |> + filter(variable_name == "age") |> + pivot_wider(names_from = "estimate_name", values_from = "estimate_value") |> + mutate(density_x = as.numeric(density_x), + density_y = as.numeric(density_y)) |> + splitStrata() |> + mutate(density_y = if_else(sex == "Female", -density_y, density_y)) + + max_density <- max(data$density_y, na.rm = TRUE) + min_age <- (floor((data$density_x |> min())/5))*5 + max_age <- (ceiling((data$density_x |> max())/5))*5 + + iqr <- dataFiltered$summarise_characteristics |> + filter(variable_name == "Age", + strata_level %in% c("Female","Male"), + estimate_name %in% c("q25", "median", "q75")) |> + mutate(estimate_value = as.numeric(estimate_value)) |> + left_join( + data |> + select("cdm_name", "strata_level" = "sex", "estimate_value" = "density_x", "density_y") |> + arrange(strata_level, estimate_value, density_y) |> + mutate(estimate_value_round = round(estimate_value)) |> + mutate(estimate_value_diff = estimate_value - estimate_value_round) |> + group_by(strata_level, estimate_value_round) |> + filter(estimate_value_diff == min(estimate_value_diff)) |> + select("cdm_name", "estimate_value" = "estimate_value_round", "density_y", "strata_level"), + by = c("estimate_value", "strata_level", "cdm_name") + ) |> + rename("sex" = "strata_level") + + ggplot(data, aes(x = density_x, y = density_y, fill = sex)) + + geom_polygon() + + geom_segment(data = iqr[iqr$estimate_name == "median", ], + aes(x = estimate_value, y = 0, xend = estimate_value, yend = density_y), + linewidth = 1) + + geom_segment(data = iqr[iqr$estimate_name != "median", ], + aes(x = estimate_value, y = 0, xend = estimate_value, yend = density_y), + linetype = 2, + linewidth = 1) + + scale_y_continuous(labels = function(x) scales::label_percent()(abs(x)), + limits = c(-max_percentage*1.1, max_percentage*1.1)) + + theme_bw() + + theme( + axis.text.x = element_text(), + axis.title.x = ggplot2::element_blank(), + panel.grid.major.x = element_line(color = "grey90"), + panel.grid.major.y = element_line(color = "grey90"), + legend.box = "horizontal", + axis.title.y = ggplot2::element_blank(), + legend.position = "bottom", + legend.title = ggplot2::element_blank(), + panel.background = ggplot2::element_blank() + ) + + scale_x_continuous(labels = c(as.character(seq(min_age,max_age-5,5)), paste0(max_age,"+")), + breaks = c(seq(min_age,max_age-5,5), max_age)) + + scale_fill_manual(values = list("Male" = "#4682B4","Female" = "#003153")) + + facet_wrap(c("cdm_name", "group_level")) + + coord_flip(clip = "off") + + labs(subtitle = "The solid line represents the median, while the dotted lines indicate the interquartile range.") +} + diff --git a/inst/shiny/server.R b/inst/shiny/server.R index d459780..fbb74df 100644 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -19,7 +19,7 @@ server <- function(input, output, session) { selected = selected[[k]], server = TRUE ) - + shinyWidgets::updatePickerInput(session, inputId = names(choices)[k], choices = choices[[k]], @@ -33,7 +33,7 @@ server <- function(input, output, session) { if (is.null(dataFiltered$summarise_omop_snapshot)) { validate("No snapshot in results") } - + OmopSketch::tableOmopSnapshot( dataFiltered$summarise_omop_snapshot ) %>% @@ -55,28 +55,28 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - - + + # achilles_code_use ----- - + createOutputAchillesCodeUse <- shiny::reactive({ if (is.null(dataFiltered$achilles_code_use)) { validate("No achilles code use in results") } achillesFiltered <- dataFiltered$achilles_code_use |> filterData("achilles_code_use", input) - + if (nrow(achillesFiltered) == 0) { validate("No results found for selected inputs") } - + CodelistGenerator::tableAchillesCodeUse(achillesFiltered, header = input$achilles_code_use_header, groupColumn = input$achilles_code_use_groupColumn, hide = input$achilles_code_use_hide) - + }) - + output$achilles_code_use_gt <- gt::render_gt({ createOutputAchillesCodeUse() }) @@ -86,25 +86,25 @@ server <- function(input, output, session) { res <- dataFiltered$summarise_observation_period |> filterData("summarise_observation_period", input) |> tidyData() - + # columns to eliminate colsEliminate <- colnames(res) colsEliminate <- colsEliminate[!colsEliminate %in% c( input$summarise_observation_period_tidy_columns, "variable_name", "variable_level", "estimate_name", "estimate_type", "estimate_value" )] - + # pivot pivot <- input$summarise_observation_period_tidy_pivot if (pivot != "none") { vars <- switch(pivot, - "estimates" = "estimate_name", - "estimates and variables" = c("variable_name", "variable_level", "estimate_name") + "estimates" = "estimate_name", + "estimates and variables" = c("variable_name", "variable_level", "estimate_name") ) res <- res |> visOmopResults::pivotEstimates(pivotEstimatesBy = vars) } - + res |> dplyr::select(!dplyr::all_of(colsEliminate)) }) @@ -149,16 +149,16 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - + ## output 16 ----- createOutput16 <- shiny::reactive({ result <- dataFiltered$summarise_observation_period |> filterData("summarise_observation_period", input) - + if (nrow(result) == 0) { validate("No results found for selected inputs") } - + OmopSketch::plotObservationPeriod( result, variableName = input$summarise_observation_period_ggplot2_16_variableName, @@ -183,26 +183,26 @@ server <- function(input, output, session) { ) } ) - - + + # cohort_code_use ----- ## tidy cohort_code_use ----- getTidyDataCohortCodeUse <- shiny::reactive({ res <- dataFiltered$cohort_code_use |> tidyData() - - + + # pivot pivot <- input$cohort_code_use_tidy_pivot if (pivot != "none") { vars <- switch(pivot, - "estimates" = "estimate_name", - "estimates and variables" = c("variable_name", "variable_level", "estimate_name") + "estimates" = "estimate_name", + "estimates and variables" = c("variable_name", "variable_level", "estimate_name") ) res <- res |> visOmopResults::pivotEstimates(pivotEstimatesBy = vars) } - + res }) output$cohort_code_use_tidy <- DT::renderDT({ @@ -227,11 +227,11 @@ server <- function(input, output, session) { } result <- dataFiltered$cohort_code_use |> filterData("cohort_code_use", input) - + if (nrow(result) == 0) { validate("No results found for selected inputs") } - + CodelistGenerator::tableCohortCodeUse( result, header = input$cohort_code_use_gt_12_header, @@ -256,33 +256,33 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - - + + # summarise_cohort_attrition ----- ## tidy summarise_cohort_attrition ----- getTidyDataSummariseCohortAttrition <- shiny::reactive({ res <- dataFiltered$summarise_cohort_attrition |> filterData("summarise_cohort_attrition", input) |> tidyData() - + # columns to eliminate colsEliminate <- colnames(res) colsEliminate <- colsEliminate[!colsEliminate %in% c( input$summarise_cohort_attrition_tidy_columns, "variable_name", "variable_level", "estimate_name", "estimate_type", "estimate_value" )] - + # pivot pivot <- input$summarise_cohort_attrition_tidy_pivot if (pivot != "none") { vars <- switch(pivot, - "estimates" = "estimate_name", - "estimates and variables" = c("variable_name", "variable_level", "estimate_name") + "estimates" = "estimate_name", + "estimates and variables" = c("variable_name", "variable_level", "estimate_name") ) res <- res |> visOmopResults::pivotEstimates(pivotEstimatesBy = vars) } - + res |> dplyr::select(!dplyr::all_of(colsEliminate)) }) @@ -305,11 +305,11 @@ server <- function(input, output, session) { createOutput3 <- shiny::reactive({ result <- dataFiltered$summarise_cohort_attrition |> filterData("summarise_cohort_attrition", input) - + if (nrow(result) == 0) { validate("No results found for selected inputs") } - + CohortCharacteristics::tableCohortAttrition( result, header = input$summarise_cohort_attrition_gt_3_header, @@ -334,7 +334,7 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - + ## output 4 ----- createOutput4 <- shiny::reactive({ result <- dataFiltered$summarise_cohort_attrition |> @@ -359,33 +359,33 @@ server <- function(input, output, session) { ) } ) - - + + # summarise_cohort_overlap ----- ## tidy summarise_cohort_overlap ----- getTidyDataSummariseCohortOverlap <- shiny::reactive({ res <- dataFiltered$summarise_cohort_overlap |> filterData("summarise_cohort_overlap", input) |> tidyData() - + # columns to eliminate colsEliminate <- colnames(res) colsEliminate <- colsEliminate[!colsEliminate %in% c( input$summarise_cohort_overlap_tidy_columns, "variable_name", "variable_level", "estimate_name", "estimate_type", "estimate_value" )] - + # pivot pivot <- input$summarise_cohort_overlap_tidy_pivot if (pivot != "none") { vars <- switch(pivot, - "estimates" = "estimate_name", - "estimates and variables" = c("variable_name", "variable_level", "estimate_name") + "estimates" = "estimate_name", + "estimates and variables" = c("variable_name", "variable_level", "estimate_name") ) res <- res |> visOmopResults::pivotEstimates(pivotEstimatesBy = vars) } - + res |> dplyr::select(!dplyr::all_of(colsEliminate)) }) @@ -409,14 +409,14 @@ server <- function(input, output, session) { if (is.null(dataFiltered$summarise_cohort_overlap)) { validate("No cohort overlap in results") } - + result <- dataFiltered$summarise_cohort_overlap |> filterData("summarise_cohort_overlap", input) - + if (nrow(result) == 0) { validate("No results found for selected inputs") } - + CohortCharacteristics::tableCohortOverlap( result, uniqueCombinations = input$summarise_cohort_overlap_gt_1_uniqueCombinations, @@ -442,13 +442,13 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - + ## output 2 ----- createOutput2 <- shiny::reactive({ if (is.null(dataFiltered$summarise_cohort_overlap)) { validate("No cohort overlap in results") } - + result <- dataFiltered$summarise_cohort_overlap |> filterData("summarise_cohort_overlap", input) CohortCharacteristics::plotCohortOverlap( @@ -474,33 +474,33 @@ server <- function(input, output, session) { ) } ) - - + + # summarise_characteristics ----- ## tidy summarise_characteristics ----- getTidyDataSummariseCharacteristics <- shiny::reactive({ res <- dataFiltered$summarise_characteristics |> filterData("summarise_characteristics", input) |> tidyData() - + # columns to eliminate colsEliminate <- colnames(res) colsEliminate <- colsEliminate[!colsEliminate %in% c( input$summarise_characteristics_tidy_columns, "variable_name", "variable_level", "estimate_name", "estimate_type", "estimate_value" )] - + # pivot pivot <- input$summarise_characteristics_tidy_pivot if (pivot != "none") { vars <- switch(pivot, - "estimates" = "estimate_name", - "estimates and variables" = c("variable_name", "variable_level", "estimate_name") + "estimates" = "estimate_name", + "estimates and variables" = c("variable_name", "variable_level", "estimate_name") ) res <- res |> visOmopResults::pivotEstimates(pivotEstimatesBy = vars) } - + res |> dplyr::select(!dplyr::all_of(colsEliminate)) }) @@ -521,11 +521,11 @@ server <- function(input, output, session) { ## output summarise_characteristics ----- ## output 7 ----- createOutput7 <- shiny::reactive({ - + if (is.null(dataFiltered$summarise_characteristics)) { validate("No summarised characteristics in results") } - + if(isTRUE(input$summarise_characteristics_include_matched)){ selectedCohorts <- c( input$summarise_characteristics_grouping_cohort_name, @@ -536,11 +536,11 @@ server <- function(input, output, session) { } else { selectedCohorts <- input$summarise_characteristics_grouping_cohort_name } - + result <- dataFiltered$summarise_characteristics |> dplyr::filter(cdm_name %in% input$summarise_characteristics_grouping_cdm_name, group_level %in% selectedCohorts) - + if (nrow(result) == 0) { validate("No results found for selected inputs") } @@ -569,16 +569,16 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - + ## output 8 ----- createOutput8 <- shiny::reactive({ result <- dataFiltered$summarise_characteristics |> filterData("summarise_characteristics", input) - + if (nrow(result) == 0) { validate("No results found for selected inputs") } - + CohortCharacteristics::plotCharacteristics( result, plotType = input$summarise_characteristics_ggplot2_8_plotType, @@ -603,15 +603,16 @@ server <- function(input, output, session) { ) } ) - - + + # summarise_large_scale_characteristics ----- ## tidy summarise_large_scale_characteristics ----- getTidyDataSummariseLargeScaleCharacteristics <- shiny::reactive({ + if (is.null(dataFiltered$summarise_large_scale_characteristics)) { validate("No large scale characteristics in results") } - + lsc_data <- dataFiltered$summarise_large_scale_characteristics |> filter(!is.na(estimate_value)) |> filter(estimate_value != "-") |> @@ -620,11 +621,11 @@ server <- function(input, output, session) { dplyr::filter(cdm_name %in% input$summarise_large_scale_characteristics_grouping_cdm_name ) |> dplyr::filter(group_level %in% input$summarise_large_scale_characteristics_grouping_cohort_name) |> dplyr::filter(variable_level %in% input$summarise_large_scale_characteristics_grouping_time_window) - + if (nrow(lsc_data) == 0) { validate("No results found for selected inputs") } - + tidy(lsc_data) |> mutate(concept = paste0(variable_name, " (", concept_id, ")")) |> @@ -632,11 +633,11 @@ server <- function(input, output, session) { "concept", "count", "percentage") - + }) output$summarise_large_scale_characteristics_tidy <- DT::renderDT({ DT::datatable( - getTidyDataSummariseLargeScaleCharacteristics() |> + getTidyDataSummariseLargeScaleCharacteristics() |> dplyr::arrange(dplyr::desc(percentage)), options = list(scrollX = TRUE), rownames = FALSE @@ -652,28 +653,28 @@ server <- function(input, output, session) { ## output summarise_large_scale_characteristics ----- ## output 0 ----- createOutput0 <- shiny::reactive({ - + if (is.null(dataFiltered$summarise_large_scale_characteristics)) { validate("No large scale characteristics in results") } - + # if (input$top_n < 1) { # validate("Top n must be between 1 and 100") # } # if (input$top_n > 100) { # validate("Top n must be between 1 and 100") # } - - lsc_data <- dataFiltered$summarise_large_scale_characteristics |> - filter(!is.na(estimate_value)) |> - filter(estimate_value != "-") |> - visOmopResults::filterSettings(table_name %in% input$summarise_large_scale_characteristics_grouping_domain, - analysis %in% input$summarise_large_scale_characteristics_settings_analysis) |> + + lsc_data <- dataFiltered$summarise_large_scale_characteristics |> + filter(!is.na(estimate_value)) |> + filter(estimate_value != "-") |> + visOmopResults::filterSettings(table_name %in% input$summarise_large_scale_characteristics_grouping_domain, + analysis %in% input$summarise_large_scale_characteristics_settings_analysis) |> dplyr::filter(cdm_name %in% input$summarise_large_scale_characteristics_grouping_cdm_name ) |> dplyr::filter(group_level %in% input$summarise_large_scale_characteristics_grouping_cohort_name) |> - dplyr::filter(variable_level %in% input$summarise_large_scale_characteristics_grouping_time_window) - CohortCharacteristics::tableLargeScaleCharacteristics(lsc_data |> - arrange(desc(estimate_type), + dplyr::filter(variable_level %in% input$summarise_large_scale_characteristics_grouping_time_window) + CohortCharacteristics::tableLargeScaleCharacteristics(lsc_data |> + arrange(desc(estimate_type), desc(as.numeric(estimate_value))) # , # topConcepts = input$top_n @@ -681,7 +682,7 @@ server <- function(input, output, session) { # header = input$summarise_large_scale_characteristics_gt_0_header, # groupColumn = input$summarise_large_scale_characteristics_gt_0_group, # hide = input$summarise_large_scale_characteristics_gt_0_hide - ) %>% + ) %>% tab_header( title = "Large scale characteristics", subtitle = "Summary of all records from clinical tables within a time window" @@ -689,7 +690,7 @@ server <- function(input, output, session) { tab_options( heading.align = "left" ) - + }) output$summarise_large_scale_characteristics_gt_0 <- gt::render_gt({ createOutput0() @@ -701,33 +702,33 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - - + + # incidence ----- ## tidy incidence ----- getTidyDataIncidence <- shiny::reactive({ res <- dataFiltered$incidence |> filterData("incidence", input) |> tidyData() - + # columns to eliminate colsEliminate <- colnames(res) colsEliminate <- colsEliminate[!colsEliminate %in% c( input$incidence_tidy_columns, "variable_name", "variable_level", "estimate_name", "estimate_type", "estimate_value" )] - + # pivot pivot <- input$incidence_tidy_pivot if (pivot != "none") { vars <- switch(pivot, - "estimates" = "estimate_name", - "estimates and variables" = c("variable_name", "variable_level", "estimate_name") + "estimates" = "estimate_name", + "estimates and variables" = c("variable_name", "variable_level", "estimate_name") ) res <- res |> visOmopResults::pivotEstimates(pivotEstimatesBy = vars) } - + res |> dplyr::select(!dplyr::all_of(colsEliminate)) }) @@ -748,36 +749,36 @@ server <- function(input, output, session) { ## output incidence ----- incidenceFiltered <- shiny::reactive({ dataFiltered$incidence |> - filter(cdm_name %in% - input$incidence_grouping_cdm_name) |> - filterGroup(outcome_cohort_name %in% - input$incidence_grouping_outcome_cohort_name) |> + filter(cdm_name %in% + input$incidence_grouping_cdm_name) |> + filterGroup(outcome_cohort_name %in% + input$incidence_grouping_outcome_cohort_name) |> filterSettings(denominator_age_group %in% - input$incidence_settings_denominator_age_group, - denominator_sex %in% - input$incidence_settings_denominator_sex) |> + input$incidence_settings_denominator_age_group, + denominator_sex %in% + input$incidence_settings_denominator_sex) |> filterAdditional(analysis_interval %in% input$incidence_settings_analysis_interval) }) ## output 18 ----- createOutput18 <- shiny::reactive({ - + if (is.null(dataFiltered$incidence)) { validate("No incidence in results") } - + result <- incidenceFiltered() - + if (nrow(result) == 0) { validate("No results found for selected inputs") } - + IncidencePrevalence::tableIncidence( result, # header = input$incidence_gt_18_header, groupColumn = c("cdm_name", "outcome_cohort_name"), - hide = "denominator_cohort_name", + hide = "denominator_cohort_name", settingsColumns = c("denominator_age_group", "denominator_sex", "outcome_cohort_name") @@ -787,7 +788,7 @@ server <- function(input, output, session) { subtitle = "Incidence rates estimated for outcomes of interest" ) %>% tab_options( - heading.align = "left" + heading.align = "left" ) }) output$incidence_gt_18 <- gt::render_gt({ @@ -800,13 +801,13 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - + ## output 19 ----- createOutput19 <- shiny::reactive({ if (is.null(dataFiltered$incidence)) { validate("No incidence in results") } - + result <- incidenceFiltered() if (nrow(result) == 0) { @@ -819,7 +820,7 @@ server <- function(input, output, session) { ribbon = FALSE, facet = input$incidence_ggplot2_19_facet, colour = input$incidence_ggplot2_19_colour - ) |> + ) |> plotly::ggplotly() }) @@ -840,33 +841,33 @@ server <- function(input, output, session) { ) } ) - - + + # incidence_attrition ----- ## tidy incidence_attrition ----- getTidyDataIncidenceAttrition <- shiny::reactive({ res <- dataFiltered$incidence |> filterData("incidence_attrition", input) |> tidyData() - + # columns to eliminate colsEliminate <- colnames(res) colsEliminate <- colsEliminate[!colsEliminate %in% c( input$incidence_attrition_tidy_columns, "variable_name", "variable_level", "estimate_name", "estimate_type", "estimate_value" )] - + # pivot pivot <- input$incidence_attrition_tidy_pivot if (pivot != "none") { vars <- switch(pivot, - "estimates" = "estimate_name", - "estimates and variables" = c("variable_name", "variable_level", "estimate_name") + "estimates" = "estimate_name", + "estimates and variables" = c("variable_name", "variable_level", "estimate_name") ) res <- res |> visOmopResults::pivotEstimates(pivotEstimatesBy = vars) } - + res |> dplyr::select(!dplyr::all_of(colsEliminate)) }) @@ -887,18 +888,18 @@ server <- function(input, output, session) { ## output incidence_attrition ----- ## output 22 ----- createOutput22 <- shiny::reactive({ - + if (is.null(dataFiltered$incidence_attrition)) { validate("No incidence attrition in results") } - + result <- dataFiltered$incidence_attrition |> filterData("incidence_attrition", input) - + if (nrow(result) == 0) { validate("No results found for selected inputs") } - + IncidencePrevalence::tableIncidenceAttrition( result, header = input$incidence_attrition_gt_22_header, @@ -923,20 +924,20 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - + # prevalence ----- prevalenceFiltered <- shiny::reactive({ - dataFiltered$prevalence |> - filter(cdm_name %in% - input$prevalence_grouping_cdm_name) |> - filterGroup(outcome_cohort_name %in% - input$prevalence_grouping_outcome_cohort_name) |> + dataFiltered$prevalence |> + filter(cdm_name %in% + input$prevalence_grouping_cdm_name) |> + filterGroup(outcome_cohort_name %in% + input$prevalence_grouping_outcome_cohort_name) |> filterSettings(denominator_age_group %in% - input$prevalence_settings_denominator_age_group, - denominator_sex %in% - input$prevalence_settings_denominator_sex, + input$prevalence_settings_denominator_age_group, + denominator_sex %in% + input$prevalence_settings_denominator_sex, analysis_interval %in% - input$prevalence_settings_analysis_interval) + input$prevalence_settings_analysis_interval) }) ## tidy prevalence ----- @@ -944,14 +945,14 @@ server <- function(input, output, session) { res <- dataFiltered$prevalence |> filterData("prevalence", input) |> tidyData() - + # columns to eliminate colsEliminate <- colnames(res) colsEliminate <- colsEliminate[!colsEliminate %in% c( input$prevalence_tidy_columns, "variable_name", "variable_level", "estimate_name", "estimate_type", "estimate_value" )] - + # pivot pivot <- input$prevalence_tidy_pivot if (pivot != "none") { @@ -962,7 +963,7 @@ server <- function(input, output, session) { res <- res |> visOmopResults::pivotEstimates(pivotEstimatesBy = vars) } - + res |> dplyr::select(!dplyr::all_of(colsEliminate)) }) @@ -986,13 +987,13 @@ server <- function(input, output, session) { if (is.null(dataFiltered$prevalence)) { validate("No prevalence in results") } - + result <- prevalenceFiltered() - + if (nrow(result) == 0) { validate("No results found for selected inputs") } - + IncidencePrevalence::tablePrevalence( result, # header = input$prevalence_gt_prev1_header, @@ -1020,20 +1021,20 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - + ## output prev2 ----- createOutputprev2 <- shiny::reactive({ - + if (is.null(dataFiltered$prevalence)) { validate("No prevalence in results") } - + result <- prevalenceFiltered() - + if (nrow(result) == 0) { validate("No results found for selected inputs") } - + IncidencePrevalence::plotPrevalence( result, x = input$prevalence_ggplot2_prev2_x, @@ -1060,10 +1061,10 @@ server <- function(input, output, session) { ) } ) - - + + # compare lsc ---- - + outputLSC <- shiny::reactive({ if (is.null(dataFiltered$summarise_large_scale_characteristics)) { @@ -1073,12 +1074,12 @@ server <- function(input, output, session) { filter(variable_level %in% input$compare_large_scale_characteristics_grouping_time_window) |> filterSettings(table_name %in% input$compare_large_scale_characteristics_grouping_domain, analysis %in% input$compare_large_scale_characteristics_settings_analysis) - + }) - + output$gt_compare_lsc <- DT::renderDT({ lscFiltered <- outputLSC() - + if (nrow(lscFiltered) == 0) { validate("No results found for selected inputs") } @@ -1088,8 +1089,8 @@ server <- function(input, output, session) { lsc <- lscFiltered |> filter(group_level %in% c(target_cohort, comparator_cohort )) |> - filter(estimate_name == "percentage") |> - omopgenerics::addSettings() |> + filter(estimate_name == "percentage") |> + omopgenerics::addSettings() |> select(database = cdm_name, cohort_name = group_level, variable_name, @@ -1098,13 +1099,13 @@ server <- function(input, output, session) { table = table_name, percentage = estimate_value) |> mutate(percentage = if_else(percentage == "-", - NA, percentage)) |> - mutate(percentage = as.numeric(percentage)) |> + NA, percentage)) |> + mutate(percentage = as.numeric(percentage)) |> pivot_wider(names_from = cohort_name, values_from = percentage) - + if(isTRUE(input$compare_large_scale_characteristics_impute_missings)){ - lsc <- lsc |> + lsc <- lsc |> mutate(across(c(target_cohort, comparator_cohort), ~if_else(is.na(.x), 0, .x))) } @@ -1120,23 +1121,23 @@ server <- function(input, output, session) { target_cohort, comparator_cohort, "Standardised mean difference" = smd) - - + + round_cols <- c("Standardised mean difference", target_cohort, comparator_cohort) - + DT::datatable(lsc, rownames= FALSE) %>% formatRound(columns=c(round_cols), digits=2) - + }) - - + + output$plotly_compare_lsc <- renderPlotly({ if (nrow(outputLSC()) == 0) { validate("No data to plot") } - + plotComparedLsc(lsc = outputLSC(), cohorts = c(input$compare_large_scale_characteristics_grouping_cohort_1, input$compare_large_scale_characteristics_grouping_cohort_2), @@ -1145,21 +1146,21 @@ server <- function(input, output, session) { imputeMissings = input$compare_large_scale_characteristics_impute_missings ) }) - + # orphan ----- ## tidy orphan ----- getTidyDataSummariseCharacteristics <- shiny::reactive({ res <- dataFiltered$orphan |> filterData("orphan", input) |> tidyData() - + # columns to eliminate colsEliminate <- colnames(res) colsEliminate <- colsEliminate[!colsEliminate %in% c( input$orphan_tidy_columns, "variable_name", "variable_level", "estimate_name", "estimate_type", "estimate_value" )] - + # pivot pivot <- input$orphan_tidy_pivot if (pivot != "none") { @@ -1170,7 +1171,7 @@ server <- function(input, output, session) { res <- res |> visOmopResults::pivotEstimates(pivotEstimatesBy = vars) } - + res |> dplyr::select(!dplyr::all_of(colsEliminate)) }) @@ -1191,34 +1192,34 @@ server <- function(input, output, session) { ## output orphan ----- ## output 99 ----- createOutput99 <- shiny::reactive({ - + if (is.null(dataFiltered$prevalence)) { validate("No orphan codes in results") } - + if (is.null(dataFiltered$orphan_code_use)) { validate("No orphan codes in results") } - + result <- dataFiltered$orphan_code_use |> dplyr::filter(cdm_name %in% input$orphan_grouping_cdm_name, group_level %in% input$orphan_grouping_codelist_name) - tbl <- CodelistGenerator::tableOrphanCodes( + tbl <- CodelistGenerator::tableOrphanCodes( result, header = input$orphan_gt_99_header, groupColumn = input$orphan_gt_99_groupColumn, hide = input$orphan_gt_99_hide ) - - tbl %>% + + tbl %>% tab_header( title = "Summary of orphan codes", subtitle = "Orphan codes refer to concepts present in the database that are not in a codelist but are related to included codes." ) %>% - tab_options( - heading.align = "left" - ) - + tab_options( + heading.align = "left" + ) + }) output$orphan_gt_99 <- gt::render_gt({ createOutput99() @@ -1230,7 +1231,7 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - + ## unmapped codes ----- ## output orphan ----- ## output 99 ----- @@ -1238,7 +1239,7 @@ server <- function(input, output, session) { if (is.null(dataFiltered$unmapped_codes)) { validate("No unmapped codes in results") } - + CodelistGenerator::tableUnmappedCodes( dataFiltered$unmapped_codes |> dplyr::filter(cdm_name %in% input$unmapped_grouping_cdm_name, @@ -1265,7 +1266,42 @@ server <- function(input, output, session) { gt::gtsave(data = obj, filename = file) } ) - - - + + + + ## age distribution ---- + ## output table ---- + createAgePyramid <- shiny::reactive({ + + summarise_table <- dataFiltered$summarise_table |> + filter(cdm_name %in% input$summarise_characteristics_grouping_cdm_name, + group_level %in% input$summarise_characteristics_grouping_cohort_name) + + summarise_characteristics <- dataFiltered$summarise_characteristics |> + filter(cdm_name %in% input$summarise_characteristics_grouping_cdm_name, + group_level %in% input$summarise_characteristics_grouping_cohort_name) + + plotAgeDensity(summarise_table, summarise_characteristics) + + }) + + output$plot_age_pyramid <- shiny::renderPlot({ + createAgePyramid() + }) + + output$plot_age_pyramid_download <- shiny::downloadHandler( + filename = paste0("output_ggplot2_age_pyramid.", "png"), + content = function(file) { + obj <- createAgePyramid() + ggplot2::ggsave( + filename = file, + plot = obj, + width = as.numeric(input$plot_age_pyramid_download_width), + height = as.numeric(input$plot_age_pyramid_download_height), + units = input$plot_age_pyramid_download_units, + dpi = as.numeric(input$plot_age_pyramid_download_dpi) + ) + } + ) + } diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R index fad519b..19deef3 100644 --- a/inst/shiny/ui.R +++ b/inst/shiny/ui.R @@ -4,13 +4,13 @@ ui <- bslib::page_navbar( theme = bs_theme(bootswatch = "pulse"), # zephyr - + title = "PhenotypeR", bslib::nav_panel( title = "Background", icon = shiny::icon("disease"), shiny::includeMarkdown(path = "background.md") - + ), # Database diagnostics ----- bslib::nav_menu( @@ -20,50 +20,50 @@ ui <- bslib::page_navbar( bslib::nav_panel( title = "Snapshot", icon = shiny::icon("clipboard-list"), - bslib::card( - full_screen = TRUE, - bslib::card_header( - bslib::popover( - shiny::icon("download"), - shinyWidgets::pickerInput( - inputId = "summarise_omop_snapshot_gt_17_download_type", - label = "File type", - selected = "docx", - choices = c("docx", "png", "pdf", "html"), - multiple = FALSE - ), - shiny::downloadButton(outputId = "summarise_omop_snapshot_gt_17_download", label = "Download") - ), - class = "text-end" - ), - gt::gt_output("summarise_omop_snapshot_gt_17") |> withSpinner() - ) + bslib::card( + full_screen = TRUE, + bslib::card_header( + bslib::popover( + shiny::icon("download"), + shinyWidgets::pickerInput( + inputId = "summarise_omop_snapshot_gt_17_download_type", + label = "File type", + selected = "docx", + choices = c("docx", "png", "pdf", "html"), + multiple = FALSE + ), + shiny::downloadButton(outputId = "summarise_omop_snapshot_gt_17_download", label = "Download") + ), + class = "text-end" + ), + gt::gt_output("summarise_omop_snapshot_gt_17") |> withSpinner() + ) ), ## observation periods ----- bslib::nav_panel( title = "Observation periods", icon = shiny::icon("eye"), - bslib::nav_panel( - title = "Table observation period", - bslib::card( - full_screen = TRUE, - bslib::card_header( - bslib::popover( - shiny::icon("download"), - shinyWidgets::pickerInput( - inputId = "summarise_observation_period_gt_15_download_type", - label = "File type", - selected = "docx", - choices = c("docx", "png", "pdf", "html"), - multiple = FALSE - ), - shiny::downloadButton(outputId = "summarise_observation_period_gt_15_download", label = "Download") - ), - class = "text-end" + bslib::nav_panel( + title = "Table observation period", + bslib::card( + full_screen = TRUE, + bslib::card_header( + bslib::popover( + shiny::icon("download"), + shinyWidgets::pickerInput( + inputId = "summarise_observation_period_gt_15_download_type", + label = "File type", + selected = "docx", + choices = c("docx", "png", "pdf", "html"), + multiple = FALSE ), - gt::gt_output("summarise_observation_period_gt_15") |> withSpinner() - ) - ) + shiny::downloadButton(outputId = "summarise_observation_period_gt_15_download", label = "Download") + ), + class = "text-end" + ), + gt::gt_output("summarise_observation_period_gt_15") |> withSpinner() + ) + ) ) ), # Codelist diagnostics ----- @@ -147,7 +147,7 @@ ui <- bslib::page_navbar( ) ) ), - + ## unmapped concepts ----- # bslib::nav_panel( # title = "Unmapped concepts", @@ -225,7 +225,7 @@ ui <- bslib::page_navbar( # ) # ) # ), - + ## Orphan codes ----- bslib::nav_panel( title = "Orphan codes", @@ -297,20 +297,20 @@ ui <- bslib::page_navbar( ), gt::gt_output("orphan_gt_99") |> withSpinner() ) - - + + )) - + ), - + # Cohort diagnostics ----- - + bslib::nav_menu( title = "Cohort diagnostics", icon = shiny::icon("list"), - + ## Cohort code use ----- - + bslib::nav_panel( title = "Cohort code use", icon = shiny::icon("chart-column"), @@ -404,63 +404,40 @@ ui <- bslib::page_navbar( ) ), ## Cohort characteristics ----- - bslib::nav_panel( + bslib::nav_panel( title = "Cohort characteristics", icon = shiny::icon("users-gear"), bslib::layout_sidebar( sidebar = bslib::sidebar(width = 400, open = "closed", - bslib::accordion( - bslib::accordion_panel( - title = "Settings", - shinyWidgets::pickerInput( - inputId = "summarise_characteristics_grouping_cdm_name", - label = "Database", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "summarise_characteristics_grouping_cohort_name", - label = "Cohort name", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::prettyCheckbox( - inputId = "summarise_characteristics_include_matched", - label = "Show matched cohorts", - value = FALSE) - ), - bslib::accordion_panel( - title = "Table formatting", - sortable::bucket_list( - header = NULL, - sortable::add_rank_list( - text = "none", - labels = c("variable_name", "variable_level", "estimate_name"), - input_id = "summarise_characteristics_gt_7_none" - ), - sortable::add_rank_list( - text = "header", - labels = c("cdm_name", "cohort_name"), - input_id = "summarise_characteristics_gt_7_header" - ), - sortable::add_rank_list( - text = "groupColumn", - labels = NULL, - input_id = "summarise_characteristics_gt_7_groupColumn" - ), - sortable::add_rank_list( - text = "hide", - labels = character(), - input_id = "summarise_characteristics_gt_7_hide" - ) - ) - ) - ) + bslib::accordion( + bslib::accordion_panel( + title = "Settings", + shinyWidgets::pickerInput( + inputId = "summarise_characteristics_grouping_cdm_name", + label = "Database", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "summarise_characteristics_grouping_cohort_name", + label = "Cohort name", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::prettyCheckbox( + inputId = "summarise_characteristics_include_matched", + label = "Show matched cohorts", + value = FALSE) + ) + ) ), + bslib::navset_card_tab( + bslib::nav_panel( + title = "Table", bslib::card( full_screen = TRUE, bslib::card_header( @@ -477,62 +454,112 @@ ui <- bslib::page_navbar( ), class = "text-end" ), + bslib::layout_sidebar( + sidebar = bslib::sidebar(width = 400, open = "closed", + sortable::bucket_list( + header = NULL, + sortable::add_rank_list( + text = "none", + labels = c("variable_name", "variable_level", "estimate_name"), + input_id = "summarise_characteristics_gt_7_none" + ), + sortable::add_rank_list( + text = "header", + labels = c("cdm_name", "cohort_name"), + input_id = "summarise_characteristics_gt_7_header" + ), + sortable::add_rank_list( + text = "groupColumn", + labels = NULL, + input_id = "summarise_characteristics_gt_7_groupColumn" + ), + sortable::add_rank_list( + text = "hide", + labels = character(), + input_id = "summarise_characteristics_gt_7_hide" + ) + ), + position = "right" + ), gt::gt_output("summarise_characteristics_gt_7") |> withSpinner() + ) ) + ), + bslib::nav_panel( + title = "Age distribution", + bslib::card( + full_screen = TRUE, + bslib::card_header( + bslib::popover( + shiny::icon("download"), + shinyWidgets::pickerInput( + inputId = "plot_age_pyramid_download", + label = "File type", + selected = "png", + choices = c("docx", "png", "pdf", "html"), + multiple = FALSE + ), + shiny::downloadButton(outputId = "plot_age_pyramid_download", label = "Download") + ), + class = "text-end" + ), + shiny::plotOutput("plot_age_pyramid") + ) + ) + ) ) ), - ## Large scale characteristics ----- - + ## Large scale characteristics ----- bslib::nav_panel( title = "Large scale characteristics", icon = shiny::icon("arrow-up-right-dots"), bslib::layout_sidebar( sidebar = bslib::sidebar(width = 400, open = "closed", - bslib::accordion( - bslib::accordion_panel( - title = "Settings", - shinyWidgets::pickerInput( - inputId = "summarise_large_scale_characteristics_grouping_cdm_name", - label = "Database", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "summarise_large_scale_characteristics_grouping_cohort_name", - label = "Cohort name", - choices = NULL, - selected = NULL, - multiple = FALSE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "summarise_large_scale_characteristics_grouping_domain", - label = "Domain", - choices = NULL, - selected = NULL, - multiple = FALSE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "summarise_large_scale_characteristics_grouping_time_window", - label = "Time window", - choices = NULL, - selected = NULL, - multiple = FALSE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "summarise_large_scale_characteristics_settings_analysis", - label = "Concept type", - choices = NULL, - selected = NULL, - multiple = FALSE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ) - ) - ) + bslib::accordion( + bslib::accordion_panel( + title = "Settings", + shinyWidgets::pickerInput( + inputId = "summarise_large_scale_characteristics_grouping_cdm_name", + label = "Database", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "summarise_large_scale_characteristics_grouping_cohort_name", + label = "Cohort name", + choices = NULL, + selected = NULL, + multiple = FALSE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "summarise_large_scale_characteristics_grouping_domain", + label = "Domain", + choices = NULL, + selected = NULL, + multiple = FALSE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "summarise_large_scale_characteristics_grouping_time_window", + label = "Time window", + choices = NULL, + selected = NULL, + multiple = FALSE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "summarise_large_scale_characteristics_settings_analysis", + label = "Concept type", + choices = NULL, + selected = NULL, + multiple = FALSE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ) + ) + ) ), bslib::navset_card_tab( bslib::nav_panel( @@ -569,31 +596,31 @@ ui <- bslib::page_navbar( ), bslib::layout_sidebar( sidebar = bslib::sidebar(width = 400, open = "closed", - # numericInput("top_n", "Top n:", 10, min = 1, max = 100), - sortable::bucket_list( - header = NULL, - sortable::add_rank_list( - text = "none", - labels = c("concept_id", "variable_name", "variable_level", "estimate_name", "table_name", "type", "analysis"), - input_id = "summarise_large_scale_characteristics_gt_0_none" - ), - sortable::add_rank_list( - text = "header", - labels = "cdm_name", - input_id = "summarise_large_scale_characteristics_gt_0_header" - ), - sortable::add_rank_list( - text = "group", - labels = "cohort_name", - input_id = "summarise_large_scale_characteristics_gt_0_group" - ), - sortable::add_rank_list( - text = "hide", - labels = character(), - input_id = "summarise_large_scale_characteristics_gt_0_hide" - ) - ), - position = "right" + # numericInput("top_n", "Top n:", 10, min = 1, max = 100), + sortable::bucket_list( + header = NULL, + sortable::add_rank_list( + text = "none", + labels = c("concept_id", "variable_name", "variable_level", "estimate_name", "table_name", "type", "analysis"), + input_id = "summarise_large_scale_characteristics_gt_0_none" + ), + sortable::add_rank_list( + text = "header", + labels = "cdm_name", + input_id = "summarise_large_scale_characteristics_gt_0_header" + ), + sortable::add_rank_list( + text = "group", + labels = "cohort_name", + input_id = "summarise_large_scale_characteristics_gt_0_group" + ), + sortable::add_rank_list( + text = "hide", + labels = character(), + input_id = "summarise_large_scale_characteristics_gt_0_hide" + ) + ), + position = "right" ), gt::gt_output("summarise_large_scale_characteristics_gt_0") |> withSpinner() ) @@ -602,167 +629,168 @@ ui <- bslib::page_navbar( ) ) ), - ## Compare large scale characteristics ----- + ## Compare large scale characteristics ----- bslib::nav_panel( title = "Compare large scale characteristics", icon = shiny::icon("arrow-up-right-dots"), - bslib::layout_sidebar( - sidebar = bslib::sidebar(width = 400, open = "closed", - bslib::accordion( - bslib::accordion_panel( - title = "Settings", - shinyWidgets::pickerInput( - inputId = "compare_large_scale_characteristics_grouping_cdm_name", - label = "Database", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "compare_large_scale_characteristics_grouping_cohort_1", - label = "Cohort 1", - choices = NULL, - selected = NULL, - multiple = FALSE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "compare_large_scale_characteristics_grouping_cohort_2", - label = "Cohort 2", - choices = NULL, - selected = NULL, - multiple = FALSE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "compare_large_scale_characteristics_grouping_time_window", - label = "Time window", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "compare_large_scale_characteristics_grouping_domain", - label = "Domain", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "compare_large_scale_characteristics_settings_analysis", - label = "Concept type", - choices = NULL, - selected = NULL, - multiple = FALSE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::prettyCheckbox( - inputId = "compare_large_scale_characteristics_impute_missings", - label = "Impute missing values as 0", - value = FALSE) - ) + bslib::layout_sidebar( + sidebar = bslib::sidebar(width = 400, open = "closed", + bslib::accordion( + bslib::accordion_panel( + title = "Settings", + shinyWidgets::pickerInput( + inputId = "compare_large_scale_characteristics_grouping_cdm_name", + label = "Database", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "compare_large_scale_characteristics_grouping_cohort_1", + label = "Cohort 1", + choices = NULL, + selected = NULL, + multiple = FALSE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "compare_large_scale_characteristics_grouping_cohort_2", + label = "Cohort 2", + choices = NULL, + selected = NULL, + multiple = FALSE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "compare_large_scale_characteristics_grouping_time_window", + label = "Time window", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "compare_large_scale_characteristics_grouping_domain", + label = "Domain", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "compare_large_scale_characteristics_settings_analysis", + label = "Concept type", + choices = NULL, + selected = NULL, + multiple = FALSE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::prettyCheckbox( + inputId = "compare_large_scale_characteristics_impute_missings", + label = "Impute missing values as 0", + value = FALSE) ) + ) ), bslib::navset_card_tab( - + bslib::nav_panel( title = "Table", - bslib::card( - full_screen = TRUE, - DT::DTOutput("gt_compare_lsc") |> withSpinner() - ) + bslib::card( + full_screen = TRUE, + DT::DTOutput("gt_compare_lsc") |> withSpinner() + ) ), bslib::nav_panel( title = "Plot", - bslib::card( - full_screen = TRUE, - bslib::layout_sidebar( - sidebar = bslib::sidebar(width = 400, open = "closed", + bslib::card( + full_screen = TRUE, + bslib::layout_sidebar( + sidebar = bslib::sidebar(width = 400, open = "closed", + shinyWidgets::pickerInput( + inputId = "compare_large_scale_characteristics_colour_1", + label = "Colour", + selected = c("table"), + multiple = TRUE, + choices = c("table", "database", "time_window"), + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "compare_large_scale_characteristics_facet_1", + label = "Facet", + selected = c("database"), + multiple = TRUE, + choices = c("table", "database", "time_window"), + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + position = "right" + ), + position = "right" + ), + plotly::plotlyOutput("plotly_compare_lsc") |> withSpinner() + ) + ) + ) + ) + ), + ## Cohort overlap ----- + bslib::nav_panel( + title = "Cohort overlap", + icon = shiny::icon("circle-half-stroke"), + bslib::layout_sidebar( + sidebar = bslib::sidebar(width = 400, open = "closed", + bslib::accordion( + bslib::accordion_panel( + title = "Settings", shinyWidgets::pickerInput( - inputId = "compare_large_scale_characteristics_colour_1", - label = "Colour", - selected = c("table"), + inputId = "summarise_cohort_overlap_grouping_cdm_name", + label = "Database", + choices = NULL, + selected = NULL, multiple = TRUE, - choices = c("table", "database", "time_window"), options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") ), shinyWidgets::pickerInput( - inputId = "compare_large_scale_characteristics_facet_1", - label = "Facet", - selected = c("database"), + inputId = "summarise_cohort_overlap_grouping_cohort_name_reference", + label = "Cohort name reference", + choices = NULL, + selected = NULL, multiple = TRUE, - choices = c("table", "database", "time_window"), options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") ), - position = "right" - ), - position = "right" - ), - plotly::plotlyOutput("plotly_compare_lsc") |> withSpinner() - ) - ) - )) - ), - ## Cohort overlap ----- - bslib::nav_panel( - title = "Cohort overlap", - icon = shiny::icon("circle-half-stroke"), - bslib::layout_sidebar( - sidebar = bslib::sidebar(width = 400, open = "closed", - bslib::accordion( - bslib::accordion_panel( - title = "Settings", - shinyWidgets::pickerInput( - inputId = "summarise_cohort_overlap_grouping_cdm_name", - label = "Database", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "summarise_cohort_overlap_grouping_cohort_name_reference", - label = "Cohort name reference", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "summarise_cohort_overlap_grouping_cohort_name_comparator", - label = "Cohort name comparator", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ) - ), - bslib::accordion_panel( - title = "Variables", - shinyWidgets::pickerInput( - inputId = "summarise_cohort_overlap_variable_name", - label = "Variable name", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ) - ), - bslib::accordion_panel( - title = "Estimates", - shinyWidgets::pickerInput( - inputId = "summarise_cohort_overlap_estimate_name", - label = "Estimate name", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ) - ) - ) + shinyWidgets::pickerInput( + inputId = "summarise_cohort_overlap_grouping_cohort_name_comparator", + label = "Cohort name comparator", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ) + ), + bslib::accordion_panel( + title = "Variables", + shinyWidgets::pickerInput( + inputId = "summarise_cohort_overlap_variable_name", + label = "Variable name", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ) + ), + bslib::accordion_panel( + title = "Estimates", + shinyWidgets::pickerInput( + inputId = "summarise_cohort_overlap_estimate_name", + label = "Estimate name", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ) + ) + ) ), bslib::navset_card_tab( bslib::nav_panel( @@ -785,35 +813,35 @@ ui <- bslib::page_navbar( ), bslib::layout_sidebar( sidebar = bslib::sidebar(width = 400, open = "closed", - sortable::bucket_list( - header = NULL, - sortable::add_rank_list( - text = "none", - labels = c("cohort_name_reference", "cohort_name_comparator", "estimate_name"), - input_id = "summarise_cohort_overlap_gt_1_none" - ), - sortable::add_rank_list( - text = "header", - labels = "variable_name", - input_id = "summarise_cohort_overlap_gt_1_header" - ), - sortable::add_rank_list( - text = "groupColumn", - labels = "cdm_name", - input_id = "summarise_cohort_overlap_gt_1_groupColumn" - ), - sortable::add_rank_list( - text = "hide", - labels = "variable_level", - input_id = "summarise_cohort_overlap_gt_1_hide" - ) - ), - shiny::checkboxInput( - inputId = "summarise_cohort_overlap_gt_1_uniqueCombinations", - label = "uniqueCombinations", - value = c(TRUE) - ), - position = "right" + sortable::bucket_list( + header = NULL, + sortable::add_rank_list( + text = "none", + labels = c("cohort_name_reference", "cohort_name_comparator", "estimate_name"), + input_id = "summarise_cohort_overlap_gt_1_none" + ), + sortable::add_rank_list( + text = "header", + labels = "variable_name", + input_id = "summarise_cohort_overlap_gt_1_header" + ), + sortable::add_rank_list( + text = "groupColumn", + labels = "cdm_name", + input_id = "summarise_cohort_overlap_gt_1_groupColumn" + ), + sortable::add_rank_list( + text = "hide", + labels = "variable_level", + input_id = "summarise_cohort_overlap_gt_1_hide" + ) + ), + shiny::checkboxInput( + inputId = "summarise_cohort_overlap_gt_1_uniqueCombinations", + label = "uniqueCombinations", + value = c(TRUE) + ), + position = "right" ), gt::gt_output("summarise_cohort_overlap_gt_1") |> withSpinner() ) @@ -855,20 +883,20 @@ ui <- bslib::page_navbar( ), bslib::layout_sidebar( sidebar = bslib::sidebar(width = 400, open = "closed", - shinyWidgets::pickerInput( - inputId = "summarise_cohort_overlap_ggplot2_2_facet", - label = "facet", - selected = c("cdm_name", "cohort_name_reference"), - multiple = TRUE, - choices = c("cdm_name", "cohort_name_reference", "cohort_name_comparator", "variable_name", "variable_level", "estimate_name"), - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shiny::checkboxInput( - inputId = "summarise_cohort_overlap_ggplot2_2_uniqueCombinations", - label = "uniqueCombinations", - value = c(TRUE) - ), - position = "right" + shinyWidgets::pickerInput( + inputId = "summarise_cohort_overlap_ggplot2_2_facet", + label = "facet", + selected = c("cdm_name", "cohort_name_reference"), + multiple = TRUE, + choices = c("cdm_name", "cohort_name_reference", "cohort_name_comparator", "variable_name", "variable_level", "estimate_name"), + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shiny::checkboxInput( + inputId = "summarise_cohort_overlap_ggplot2_2_uniqueCombinations", + label = "uniqueCombinations", + value = c(TRUE) + ), + position = "right" ), plotly::plotlyOutput("summarise_cohort_overlap_ggplot2_2") ) @@ -878,7 +906,7 @@ ui <- bslib::page_navbar( ) ) ), - + # Population diagnostics ----- bslib::nav_menu( title = "Population diagnostics", @@ -889,51 +917,51 @@ ui <- bslib::page_navbar( icon = shiny::icon("chart-line"), bslib::layout_sidebar( sidebar = bslib::sidebar(width = 400, open = "closed", - bslib::accordion( - bslib::accordion_panel( - title = "Settings", - shinyWidgets::pickerInput( - inputId = "incidence_grouping_cdm_name", - label = "Database", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "incidence_grouping_outcome_cohort_name", - label = "Outcome cohort name", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "incidence_settings_analysis_interval", - label = "Time interval", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "incidence_settings_denominator_age_group", - label = "Denominator age group", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "incidence_settings_denominator_sex", - label = "Denominator sex", - choices = NULL, - selected = NULL, - multiple = TRUE, - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ) - ) - ) + bslib::accordion( + bslib::accordion_panel( + title = "Settings", + shinyWidgets::pickerInput( + inputId = "incidence_grouping_cdm_name", + label = "Database", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "incidence_grouping_outcome_cohort_name", + label = "Outcome cohort name", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "incidence_settings_analysis_interval", + label = "Time interval", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "incidence_settings_denominator_age_group", + label = "Denominator age group", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "incidence_settings_denominator_sex", + label = "Denominator sex", + choices = NULL, + selected = NULL, + multiple = TRUE, + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ) + ) + ) ), bslib::navset_card_tab( bslib::nav_panel( @@ -956,30 +984,30 @@ ui <- bslib::page_navbar( ), bslib::layout_sidebar( sidebar = bslib::sidebar(width = 400, open = "closed", - sortable::bucket_list( - header = NULL, - sortable::add_rank_list( - text = "none", - labels = c("cdm_name", "denominator_cohort_name", "incidence_start_date", "incidence_end_date", "analysis_outcome_washout", "analysis_repeated_events", "analysis_interval", "analysis_complete_database_intervals", "denominator_age_group", "denominator_sex", "denominator_days_prior_observation", "denominator_start_date", "denominator_end_date", "denominator_time_at_risk", "denominator_target_cohort_name", "outcome_cohort_name", "variable_name", "variable_level"), - input_id = "incidence_gt_18_none" - ), - sortable::add_rank_list( - text = "header", - labels = "estimate_name", - input_id = "incidence_gt_18_header" - ), - sortable::add_rank_list( - text = "groupColumn", - labels = character(), - input_id = "incidence_gt_18_groupColumn" - ), - sortable::add_rank_list( - text = "hide", - labels = character(), - input_id = "incidence_gt_18_hide" - ) - ), - position = "right" + sortable::bucket_list( + header = NULL, + sortable::add_rank_list( + text = "none", + labels = c("cdm_name", "denominator_cohort_name", "incidence_start_date", "incidence_end_date", "analysis_outcome_washout", "analysis_repeated_events", "analysis_interval", "analysis_complete_database_intervals", "denominator_age_group", "denominator_sex", "denominator_days_prior_observation", "denominator_start_date", "denominator_end_date", "denominator_time_at_risk", "denominator_target_cohort_name", "outcome_cohort_name", "variable_name", "variable_level"), + input_id = "incidence_gt_18_none" + ), + sortable::add_rank_list( + text = "header", + labels = "estimate_name", + input_id = "incidence_gt_18_header" + ), + sortable::add_rank_list( + text = "groupColumn", + labels = character(), + input_id = "incidence_gt_18_groupColumn" + ), + sortable::add_rank_list( + text = "hide", + labels = character(), + input_id = "incidence_gt_18_hide" + ) + ), + position = "right" ), gt::gt_output("incidence_gt_18") |> withSpinner() ) @@ -1020,36 +1048,36 @@ ui <- bslib::page_navbar( ), bslib::layout_sidebar( sidebar = bslib::sidebar(width = 400, open = "closed", - shinyWidgets::pickerInput( - inputId = "incidence_ggplot2_19_x", - label = "x", - selected = "incidence_start_date", - multiple = FALSE, - choices = c("cdm_name", "denominator_cohort_name", "incidence_start_date", "incidence_end_date", "analysis_outcome_washout", "analysis_repeated_events", "analysis_interval", "analysis_complete_database_intervals", "denominator_age_group", "denominator_sex", "denominator_days_prior_observation", "denominator_start_date", "denominator_end_date", "denominator_time_at_risk", "denominator_target_cohort_name", "outcome_cohort_name", "variable_name", "variable_level", "estimate_name"), - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shiny::checkboxInput( - inputId = "incidence_ggplot2_19_ribbon", - label = "ribbon", - value = c(FALSE) - ), - shinyWidgets::pickerInput( - inputId = "incidence_ggplot2_19_facet", - label = "facet", - selected = NULL, - multiple = TRUE, - choices = c("cdm_name", "denominator_cohort_name", "incidence_start_date", "incidence_end_date", "analysis_outcome_washout", "analysis_repeated_events", "analysis_interval", "analysis_complete_database_intervals", "denominator_age_group", "denominator_sex", "denominator_days_prior_observation", "denominator_start_date", "denominator_end_date", "denominator_time_at_risk", "denominator_target_cohort_name", "outcome_cohort_name", "variable_name", "variable_level", "estimate_name"), - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "incidence_ggplot2_19_colour", - label = "colour", - selected = NULL, - multiple = TRUE, - choices = c("cdm_name", "denominator_cohort_name", "incidence_start_date", "incidence_end_date", "analysis_outcome_washout", "analysis_repeated_events", "analysis_interval", "analysis_complete_database_intervals", "denominator_age_group", "denominator_sex", "denominator_days_prior_observation", "denominator_start_date", "denominator_end_date", "denominator_time_at_risk", "denominator_target_cohort_name", "outcome_cohort_name", "variable_name", "variable_level", "estimate_name"), - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - position = "right" + shinyWidgets::pickerInput( + inputId = "incidence_ggplot2_19_x", + label = "x", + selected = "incidence_start_date", + multiple = FALSE, + choices = c("cdm_name", "denominator_cohort_name", "incidence_start_date", "incidence_end_date", "analysis_outcome_washout", "analysis_repeated_events", "analysis_interval", "analysis_complete_database_intervals", "denominator_age_group", "denominator_sex", "denominator_days_prior_observation", "denominator_start_date", "denominator_end_date", "denominator_time_at_risk", "denominator_target_cohort_name", "outcome_cohort_name", "variable_name", "variable_level", "estimate_name"), + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shiny::checkboxInput( + inputId = "incidence_ggplot2_19_ribbon", + label = "ribbon", + value = c(FALSE) + ), + shinyWidgets::pickerInput( + inputId = "incidence_ggplot2_19_facet", + label = "facet", + selected = NULL, + multiple = TRUE, + choices = c("cdm_name", "denominator_cohort_name", "incidence_start_date", "incidence_end_date", "analysis_outcome_washout", "analysis_repeated_events", "analysis_interval", "analysis_complete_database_intervals", "denominator_age_group", "denominator_sex", "denominator_days_prior_observation", "denominator_start_date", "denominator_end_date", "denominator_time_at_risk", "denominator_target_cohort_name", "outcome_cohort_name", "variable_name", "variable_level", "estimate_name"), + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + shinyWidgets::pickerInput( + inputId = "incidence_ggplot2_19_colour", + label = "colour", + selected = NULL, + multiple = TRUE, + choices = c("cdm_name", "denominator_cohort_name", "incidence_start_date", "incidence_end_date", "analysis_outcome_washout", "analysis_repeated_events", "analysis_interval", "analysis_complete_database_intervals", "denominator_age_group", "denominator_sex", "denominator_days_prior_observation", "denominator_start_date", "denominator_end_date", "denominator_time_at_risk", "denominator_target_cohort_name", "outcome_cohort_name", "variable_name", "variable_level", "estimate_name"), + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), + position = "right" ), plotly::plotlyOutput("incidence_ggplot2_19") ) @@ -1275,7 +1303,7 @@ ui <- bslib::page_navbar( # ) # ) # ) - + ## Prevalence ----- bslib::nav_panel( title = "Prevalence", @@ -1668,8 +1696,8 @@ ui <- bslib::page_navbar( # ) # ) # ) - - + + ), # end ------ bslib::nav_spacer(),