diff --git a/inst/shiny/server.R b/inst/shiny/server.R index 532070b..4fa010b 100644 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -646,7 +646,7 @@ server <- function(input, output, session) { # summarise_large_scale_characteristics ----- ## Tidy summarise_large_scale_characteristics ----- getTidyDataSummariseLargeScaleCharacteristics <- shiny::reactive({ -browser() + if (is.null(dataFiltered$summarise_large_scale_characteristics)) { validate("No large scale characteristics in results") } @@ -1047,9 +1047,12 @@ browser() # incidence ----- - incidenceFiltered <- shiny::reactive({ - - dataFiltered$incidence |> + filterIncidence <- shiny::reactive({ + if (is.null(dataFiltered$incidence)) { + validate("No incidence in results") + } + + result <- dataFiltered$incidence |> filter(cdm_name %in% input$incidence_grouping_cdm_name) |> filterGroup(outcome_cohort_name %in% @@ -1062,21 +1065,18 @@ browser() input$incidence_settings_denominator_days_prior_observation) |> filterAdditional(analysis_interval %in% input$incidence_settings_analysis_interval) + + if (nrow(result) == 0) { + validate("No results found for selected inputs") + } + return(result) }) + ## Table incidence ----- createTableIncidence <- 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, + filterIncidence(), groupColumn = c("cdm_name", "outcome_cohort_name"), hide = "denominator_cohort_name", settingsColumn = c("denominator_age_group", @@ -1104,90 +1104,54 @@ browser() gt::gtsave(data = obj, filename = file) } ) - ## Plot incidence_population ----- - createPlotIncidencePopulation <- shiny::reactive({ - - if(!is.null(input$incidence_population_plot_facet) && - isTRUE(input$incidence_population_plot_facet_free)){ - plotIncidencePopulation(x = input$incidence_population_plot_x, - y = input$incidence_population_plot_y, - result = incidenceFiltered(), - facet = NULL, - colour = input$incidence_population_plot_colour - - ) + - facet_wrap(facets = input$incidence_population_plot_facet, scales = "free") - } else { - plotIncidencePopulation(x = input$incidence_population_plot_x, - y = input$incidence_population_plot_y, - result = incidenceFiltered(), - facet = input$incidence_population_plot_facet, - colour = input$incidence_population_plot_colour - - ) - } - - - - }) - - output$incidence_population_plot <- renderUI({ - if(isTRUE(input$incidence_population_plot_interactive)){ - plot <- plotly::ggplotly(createPlotIncidencePopulation()) - } else { - plot <- renderPlot(createPlotIncidencePopulation()) - } - plot - }) - - output$incidence_population_plot_download <- shiny::downloadHandler( - filename = "incidence_population_plot.png", - content = function(file) { - obj <- createPlotIncidencePopulation() - ggplot2::ggsave( - filename = file, - plot = obj, - width = as.numeric(input$incidence_population_plot_download_width), - height = as.numeric(input$incidence_population_plot_download_height), - units = input$incidence_population_plot_download_units, - dpi = as.numeric(input$incidence_population_plot_download_dpi) - ) - } - ) - ## Plot incidence ----- createPlotIncidence <- 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") - } - - if(!is.null(input$incidence_plot_facet) && - isTRUE(input$incidence_plot_facet_free)){ - IncidencePrevalence::plotIncidence( - result, - x = input$incidence_plot_x, - ribbon = FALSE, - facet = input$incidence_plot_facet, - colour = input$incidence_plot_colour - ) + - facet_wrap(facets = input$incidence_plot_facet, scales = "free") - } else { - IncidencePrevalence::plotIncidence( + result <- filterIncidence() + + x <- input$incidence_plot_x + y <- input$incidence_plot_y + facet <- input$incidence_plot_facet + facet_free <- input$incidence_plot_facet_free + colour <- input$incidence_plot_colour + + # Plot incidence estimates + if(y == "incidence_estimates"){ + plot <- IncidencePrevalence::plotIncidence( result, - x = input$incidence_plot_x, + x = x, ribbon = FALSE, - facet = input$incidence_plot_facet, - colour = input$incidence_plot_colour + facet = facet, + colour = colour ) + + if(!is.null(facet) && isTRUE(facet_free)){ + plot <- plot + + facet_wrap(facets = facet, scales = "free") + } + }else{ + # Plot incidence population + if(!is.null(facet) && isTRUE(facet_free)){ + plot <- plotIncidencePopulation(x = x, + y = y, + result = result, + facet = NULL, + colour = colour + + ) + + facet_wrap(facets = facet, scales = "free") + } else { + plot <- plotIncidencePopulation(x = x, + y = y, + result = result, + facet = facet, + colour = colour + + ) + } } + return(plot) }) - + output$incidence_plot <- renderUI({ if(isTRUE(input$incidence_plot_interactive)){ plot <- plotly::ggplotly(createPlotIncidence()) @@ -1210,14 +1174,14 @@ browser() ) } ) - - - - + # prevalence ----- - prevalenceFiltered <- shiny::reactive({ - - dataFiltered$prevalence |> + filterPrevalence <- shiny::reactive({ + if (is.null(dataFiltered$prevalence)) { + validate("No prevalence in results") + } + + result <- dataFiltered$prevalence |> filter(cdm_name %in% input$prevalence_grouping_cdm_name) |> filterGroup(outcome_cohort_name %in% @@ -1230,18 +1194,16 @@ browser() input$prevalence_settings_denominator_days_prior_observation) |> filterAdditional(analysis_interval %in% input$prevalence_settings_analysis_interval) - }) - ## Table prevalence ---- - createTablePrevalence <- 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") } + + return(result) + }) + ## Table prevalence ---- + createTablePrevalence <- shiny::reactive({ + result <- filterPrevalence() IncidencePrevalence::tablePrevalence( result, @@ -1272,97 +1234,53 @@ browser() gt::gtsave(data = obj, filename = file) } ) - ## Plot population_prevalence ---- - createPlotPrevalencePopulation <- 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") - } - - if(!is.null(input$prevalence_population_plot_facet) && - isTRUE(input$prevalence_population_plot_facet_free)){ - IncidencePrevalence::plotPrevalencePopulation( - result = result, - x = input$prevalence_population_plot_x, - y = input$prevalence_population_plot_y, - facet = NULL, - colour = input$prevalence_population_plot_colour - ) + - facet_wrap(facets = input$prevalence_population_plot_facet, scales = "free") - } else { - IncidencePrevalence::plotPrevalencePopulation( - result = result, - x = input$prevalence_population_plot_x, - y = input$prevalence_population_plot_y, - facet = input$prevalence_population_plot_facet, - colour = input$prevalence_population_plot_colour - ) - } - - }) - output$prevalence_population_plot <- renderUI({ - if(isTRUE(input$prevalence_population_plot_interactive)){ - plot <- plotly::ggplotly(createPlotPrevalencePopulation()) - } else { - plot <- renderPlot(createPlotPrevalencePopulation()) - } - plot - }) - output$prevalence_population_plot_download <- shiny::downloadHandler( - filename = "prevalence_population_plot.png", - content = function(file) { - obj <- createPlotPrevalence() - ggplot2::ggsave( - filename = file, - plot = obj, - width = as.numeric(input$prevalence_population_plot_download_width), - height = as.numeric(input$prevalence_population_plot_download_height), - units = input$prevalence_population_plot_download_units, - dpi = as.numeric(input$prevalence_population_plot_download_dpi) - ) - } - ) - ## Plot prevalence ----- + ## Plot prevalence ---- createPlotPrevalence <- 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") - } - - if(!is.null(input$prevalence_plot_facet) && - isTRUE(input$prevalence_plot_facet_free)){ - IncidencePrevalence::plotPrevalence( - result, - x = input$prevalence_plot_x, - ribbon = FALSE, - facet = input$prevalence_plot_facet, - colour = input$prevalence_plot_colour - ) + - facet_wrap(facets = input$prevalence_plot_facet, scales = "free") - } else { - IncidencePrevalence::plotPrevalence( + result <- filterPrevalence() + + x <- input$prevalence_plot_x + y <- input$prevalence_plot_y + facet <- input$prevalence_plot_facet + facet_free <- input$prevalence_plot_facet_free + colour <- input$prevalence_plot_colour + + if(y == "prevalence_estimates"){ + plot <- IncidencePrevalence::plotPrevalence( result, - x = input$prevalence_plot_x, + x = x, ribbon = FALSE, - facet = input$prevalence_plot_facet, - colour = input$prevalence_plot_colour + facet = facet, + colour = colour ) + + if(!is.null(facet) && isTRUE(facet_free)){ + plot <- plot + + facet_wrap(facets = facet, scales = "free") + } + }else{ + if(!is.null(facet) && isTRUE(input$facet_free)){ + plot <- IncidencePrevalence::plotPrevalencePopulation( + result = result, + x = x, + y = y, + facet = NULL, + colour = colour) + + facet_wrap(facets = facet, scales = "free") + } else { + plot <- IncidencePrevalence::plotPrevalencePopulation( + result = result, + x = x, + y = y, + facet = facet, + colour = colour + ) + } } - - + + return(plot) + }) + output$prevalence_plot <- renderUI({ if(isTRUE(input$prevalence_plot_interactive)){ plot <- plotly::ggplotly(createPlotPrevalence()) diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R index d9c0077..1460af8 100644 --- a/inst/shiny/ui.R +++ b/inst/shiny/ui.R @@ -1301,88 +1301,6 @@ ui <- bslib::page_navbar( gt::gt_output("incidence_gt") |> withSpinner() ) ), - bslib::nav_panel( - title = "Plot incidence population", - bslib::card( - full_screen = TRUE, - bslib::card_header( - bslib::popover( - shiny::icon("download"), - shiny::numericInput( - inputId = "incidence_population_plot_download_width", - label = "Width", - value = 15 - ), - shiny::numericInput( - inputId = "incidence_population_plot_download_height", - label = "Height", - value = 10 - ), - shinyWidgets::pickerInput( - inputId = "incidence_population_plot_download_units", - label = "Units", - selected = "cm", - choices = c("px", "cm", "inch"), - multiple = FALSE - ), - shiny::numericInput( - inputId = "incidence_population_plot_download_dpi", - label = "dpi", - value = 300 - ), - shiny::downloadButton(outputId = "incidence_population_plot_download", label = "Download") - ), - class = "text-end" - ), - bslib::layout_sidebar( - sidebar = bslib::sidebar(width = 400, open = "closed", - materialSwitch(inputId = "incidence_population_plot_interactive", - value = TRUE, - label = "Interactive", - status = "primary"), - shinyWidgets::pickerInput( - inputId = "incidence_population_plot_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") - ), - shinyWidgets::pickerInput( - inputId = "incidence_population_plot_y", - label = "y", - selected = "denominator_count", - multiple = FALSE, - choices = c("denominator_count", "outcome_count", "person_days", "person_years"), - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "incidence_population_plot_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") - ), - shiny::checkboxInput( - inputId = "incidence_population_plot_facet_free", - label = "Free scales", - value = c(FALSE) - ), - shinyWidgets::pickerInput( - inputId = "incidence_population_plot_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" - ), - uiOutput("incidence_population_plot") - ) - ) - ), bslib::nav_panel( title = "Plot incidence", bslib::card( @@ -1417,14 +1335,22 @@ ui <- bslib::page_navbar( class = "text-end" ), bslib::layout_sidebar( - sidebar = bslib::sidebar(width = 400, open = "closed", + sidebar = bslib::sidebar(width = 400, open = "open", materialSwitch(inputId = "incidence_plot_interactive", value = TRUE, label = "Interactive", status = "primary"), + shinyWidgets::pickerInput( + inputId = "incidence_plot_y", + label = "Vertical axis", + selected = "incidence_estimates", + multiple = FALSE, + choices = c("incidence_estimates", "denominator_count", "outcome_count", "person_days", "person_years"), + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), shinyWidgets::pickerInput( inputId = "incidence_plot_x", - label = "x", + label = "Horizontal axis", 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"), @@ -1432,7 +1358,7 @@ ui <- bslib::page_navbar( ), shinyWidgets::pickerInput( inputId = "incidence_plot_facet", - label = "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"), @@ -1445,7 +1371,7 @@ ui <- bslib::page_navbar( ), shinyWidgets::pickerInput( inputId = "incidence_plot_colour", - label = "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"), @@ -1542,88 +1468,6 @@ ui <- bslib::page_navbar( gt::gt_output("prevalence_gt") |> withSpinner() ) ), - bslib::nav_panel( - title = "Plot prevalence population", - bslib::card( - full_screen = TRUE, - bslib::card_header( - bslib::popover( - shiny::icon("download"), - shiny::numericInput( - inputId = "prevalence_population_plot_download_width", - label = "Width", - value = 15 - ), - shiny::numericInput( - inputId = "prevalence_population_plot_download_height", - label = "Height", - value = 10 - ), - shinyWidgets::pickerInput( - inputId = "prevalence_population_plot_download_units", - label = "Units", - selected = "cm", - choices = c("px", "cm", "inch"), - multiple = FALSE - ), - shiny::numericInput( - inputId = "prevalence_population_plot_download_dpi", - label = "dpi", - value = 300 - ), - shiny::downloadButton(outputId = "prevalence_population_plot_download", label = "Download") - ), - class = "text-end" - ), - bslib::layout_sidebar( - sidebar = bslib::sidebar(width = 400, open = "closed", - materialSwitch(inputId = "prevalence_population_plot_interactive", - value = TRUE, - label = "Interactive", - status = "primary"), - shinyWidgets::pickerInput( - inputId = "prevalence_population_plot_x", - label = "x", - selected = "prevalence_start_date", - multiple = FALSE, - choices = c("cdm_name", "denominator_cohort_name", "prevalence_start_date", "prevalence_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 = "prevalence_population_plot_y", - label = "y", - selected = "denominator_count", - multiple = FALSE, - choices = c("denominator_count", "outcome_count"), - options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") - ), - shinyWidgets::pickerInput( - inputId = "prevalence_population_plot_facet", - label = "facet", - selected = NULL, - multiple = TRUE, - choices = c("cdm_name", "denominator_cohort_name", "prevalence_start_date", "prevalence_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 = "prevalence_population_plot_facet_free", - label = "Free scales", - value = c(FALSE) - ), - shinyWidgets::pickerInput( - inputId = "prevalence_population_plot_colour", - label = "colour", - selected = NULL, - multiple = TRUE, - choices = c("cdm_name", "denominator_cohort_name", "prevalence_start_date", "prevalence_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" - ), - uiOutput("prevalence_population_plot") - ) - ) - ), bslib::nav_panel( title = "Plot prevalence", bslib::card( @@ -1658,14 +1502,22 @@ ui <- bslib::page_navbar( class = "text-end" ), bslib::layout_sidebar( - sidebar = bslib::sidebar(width = 400, open = "closed", + sidebar = bslib::sidebar(width = 400, open = "opened", materialSwitch(inputId = "prevalence_plot_interactive", value = TRUE, label = "Interactive", status = "primary"), + shinyWidgets::pickerInput( + inputId = "prevalence_plot_y", + label = "Vertical axis", + selected = "prevalence_estimates", + multiple = FALSE, + choices = c("prevalence_estimates", "denominator_count", "outcome_count"), + options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3") + ), shinyWidgets::pickerInput( inputId = "prevalence_plot_x", - label = "x", + label = "Horizontal axis", selected = "prevalence_start_date", multiple = FALSE, choices = c("cdm_name", "denominator_cohort_name", "prevalence_start_date", "prevalence_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"), @@ -1673,7 +1525,7 @@ ui <- bslib::page_navbar( ), shinyWidgets::pickerInput( inputId = "prevalence_plot_facet", - label = "facet", + label = "Facet", selected = NULL, multiple = TRUE, choices = c("cdm_name", "denominator_cohort_name", "prevalence_start_date", "prevalence_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"), @@ -1686,7 +1538,7 @@ ui <- bslib::page_navbar( ), shinyWidgets::pickerInput( inputId = "prevalence_plot_colour", - label = "colour", + label = "Colour", selected = NULL, multiple = TRUE, choices = c("cdm_name", "denominator_cohort_name", "prevalence_start_date", "prevalence_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"),