Merge pull request #113 from OHDSI/lsc_compare

fix lsc comparison
OHDSI · Nov 14, 2024 · 37bddf4 · 37bddf4
2 parents dca94c2 + 57dac5d
commit 37bddf4
Show file tree

Hide file tree

Showing 4 changed files with 42 additions and 7 deletions.
diff --git a/inst/shiny/global.R b/inst/shiny/global.R
@@ -27,20 +27,25 @@ if(file.exists(file.path(getwd(), "data", "appData.RData"))){
 }
 
 plotComparedLsc <- function(lsc, cohorts){
-  lsc <- lsc |>  tidy()
+   lsc <- lsc |>  tidy()
   plot_data <- lsc |>
     filter(cohort_name %in% c(cohorts
-    )) |>
+    )) |> 
     select(cohort_name,
            variable_name,
            variable_level,
+           concept_id,
+           table_name,
            percentage) |>
     pivot_wider(names_from = cohort_name,
-                       values_from = percentage)
-
+                values_from = percentage)
+  
   plot <- plot_data |>
-    ggplot(aes(text = paste("Label:", variable_name,
-                            "<br>Group:", variable_level))) +
+    ggplot(aes(text = paste("Concept:", variable_name,
+                            "<br>Concept ID:", concept_id,
+                            "<br>Time window:", variable_level,
+                            "<br>Table:", table_name, 
+                            "<br>Cohorts: "))) +
     geom_point(aes(x = !!sym(cohorts[1]),
                    y = !!sym(cohorts[2]))) +
     geom_abline(slope = 1, intercept = 0,

diff --git a/inst/shiny/scripts/preprocess.R b/inst/shiny/scripts/preprocess.R
@@ -71,6 +71,12 @@ choices$summarise_large_scale_characteristics_grouping_time_window <- unique(dat
   pull("variable_level"))
 selected$summarise_large_scale_characteristics_grouping_time_window <-choices$summarise_large_scale_characteristics_grouping_time_window
 
+choices$compare_large_scale_characteristics_grouping_time_window <- choices$summarise_large_scale_characteristics_grouping_time_window
+choices$compare_large_scale_characteristics_grouping_table <- choices$summarise_large_scale_characteristics_grouping_domain
+selected$compare_large_scale_characteristics_grouping_time_window <- selected$summarise_large_scale_characteristics_grouping_time_window
+selected$compare_large_scale_characteristics_grouping_table <- selected$summarise_large_scale_characteristics_grouping_domain
+
+
 orphanCodelist <- unique(dataFiltered$orphan_code_use |>
                            visOmopResults::splitAll() |> pull("codelist_name"))
 orphanCdm <- unique(dataFiltered$orphan_code_use |>

diff --git a/inst/shiny/server.R b/inst/shiny/server.R
@@ -831,7 +831,15 @@ server <- function(input, output, session) {
   )
   # compare lsc ----
   output$plotly_compare_lsc <- renderPlotly({
-    plotComparedLsc(lsc = dataFiltered$summarise_large_scale_characteristics,
+    lscFiltered <- dataFiltered$summarise_large_scale_characteristics |> 
+      filter(variable_level %in% input$compare_large_scale_characteristics_grouping_time_window) |>
+      filterSettings(table_name %in% input$compare_large_scale_characteristics_grouping_table)
+
+    if (nrow(lscFiltered) == 0) {
+      validate("No data to plot")
+    }
+
+    plotComparedLsc(lsc = lscFiltered,
                     cohorts = c(input$compare_large_scale_characteristics_grouping_cohort_1,
                                 input$compare_large_scale_characteristics_grouping_cohort_2))
   } )

diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R
@@ -574,6 +574,22 @@ ui <- bslib::page_navbar(
                                          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_table",
+                                         label = "Table",
+                                         choices = NULL,
+                                         selected = NULL,
+                                         multiple = TRUE,
+                                         options = list(`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3")
                                        )
                                      )
                                    )