Merge pull request #116 from OHDSI/table_matched_lsc

table for matched lsc
OHDSI · Nov 15, 2024 · deb4a49 · deb4a49
2 parents 1816cca + f86d566
commit deb4a49
Show file tree

Hide file tree

Showing 4 changed files with 96 additions and 27 deletions.
diff --git a/R/matchedDiagnostics.R b/R/matchedDiagnostics.R
@@ -80,8 +80,14 @@ matchedDiagnostics <- function(cohort,
   cdm[[matchedCohortTable]] <- CohortConstructor::matchCohorts(cdm[[matchedCohortTable]],
                                      name = matchedCohortTable)
 
+  cdm[[matchedCohortTable]]  <- cdm[[matchedCohortTable]] |>
+    PatientProfiles::addAge(ageGroup = list(c(0, 17), c(18, 64), c(65, 150))) |>
+    PatientProfiles::addSex() |>
+    CDMConnector::compute(name = matchedCohortTable, temporary = FALSE)
+
   results[["cohort_summary"]] <- cdm[[matchedCohortTable]] |>
     CohortCharacteristics::summariseCharacteristics(
+      strata = list("age_group", "sex"),
       tableIntersectCount = list(
         "Number visits prior year" = list(
           tableName = "visit_occurrence",
@@ -90,7 +96,6 @@ matchedDiagnostics <- function(cohort,
       )
     )
 
-
   cli::cli_bullets(c("*" = "{.strong Running large scale characterisation}"))
   results[["lsc"]] <- CohortCharacteristics::summariseLargeScaleCharacteristics(
     cohort = cdm[[matchedCohortTable]],

diff --git a/inst/shiny/scripts/preprocess.R b/inst/shiny/scripts/preprocess.R
@@ -15,7 +15,11 @@ library(sortable)
 library(visOmopResults)
 library(shinycssloaders)
 
-data <- omopgenerics::importSummarisedResult(file.path(getwd(),"data", "raw")) |>
+data <- omopgenerics::importSummarisedResult(file.path(getwd(),"data", "raw")) 
+if(nrow(data) == 0){
+  cli::cli_abort("No data found in data/raw")
+}
+data <- data |>
   correctSettings()
 
 # cohort_name_ref <- readr::read_csv(here::here("cohort_name_ref.csv"),
@@ -42,20 +46,20 @@ for(i in seq_along(settingsUsed)){
   dataFiltered[[workingSetting]] <- visOmopResults::filterSettings(data, result_type ==
                                                                      workingSetting)
 }
-#
-# codeUseCohorts <- unique(dataFiltered$cohort_code_use |>
-#                            visOmopResults::splitAll() |> pull("cohort_name"))
-# codeUseCodelist <- unique(dataFiltered$cohort_code_use |>
-#                             visOmopResults::splitAll() |> pull("codelist_name"))
-#
+
+codeUseCohorts <- unique(dataFiltered$cohort_code_use |>
+                           visOmopResults::splitAll() |> pull("cohort_name"))
+codeUseCodelist <- unique(dataFiltered$cohort_code_use |>
+                            visOmopResults::splitAll() |> pull("codelist_name"))
+
 selected <- choices
-#
+
 selected$summarise_characteristics_grouping_cohort_name <- selected$summarise_characteristics_grouping_cohort_name[1]
 selected$summarise_large_scale_characteristics_grouping_cohort_name <- selected$summarise_large_scale_characteristics_grouping_cohort_name[1]
-#
-# choices$cohort_code_use_grouping_cohort_name <- codeUseCohorts
-# selected$cohort_code_use_grouping_cohort_name <- codeUseCohorts[1]
-#
+
+choices$cohort_code_use_grouping_cohort_name <- codeUseCohorts
+selected$cohort_code_use_grouping_cohort_name <- codeUseCohorts[1]
+
 choices$compare_large_scale_characteristics_grouping_cdm_name <- choices$summarise_large_scale_characteristics_grouping_cdm_name
 choices$compare_large_scale_characteristics_grouping_cohort_1 <- choices$summarise_large_scale_characteristics_grouping_cohort_name
 choices$compare_large_scale_characteristics_grouping_cohort_2 <- choices$summarise_large_scale_characteristics_grouping_cohort_name
@@ -98,12 +102,12 @@ selected$orphan_grouping_cohort_name <- orphanCodelist[1]
 # selected$unmapped_grouping_codelist_name <- unmappedCodelist[1]
 #
 #
-# selected$incidence_settings_outcome_cohort_name <- selected$incidence_settings_outcome_cohort_name[1]
-#
-# selected$incidence_settings_analysis_interval <- selected$incidence_settings_analysis_interval[1]
-# selected$incidence_settings_denominator_age_group <- selected$incidence_settings_denominator_age_group[1]
-# selected$incidence_settings_denominator_sex <- selected$incidence_settings_denominator_sex[1]
-# selected$incidence_grouping_incidence_start_date
+selected$incidence_settings_outcome_cohort_name <- selected$incidence_settings_outcome_cohort_name[1]
+
+selected$incidence_settings_analysis_interval <- selected$incidence_settings_analysis_interval[1]
+selected$incidence_settings_denominator_age_group <- selected$incidence_settings_denominator_age_group[1]
+selected$incidence_settings_denominator_sex <- selected$incidence_settings_denominator_sex[1]
+selected$incidence_grouping_incidence_start_date
 #
 # min_incidence_start <- min(as.Date(selected$incidence_grouping_incidence_start_date))
 # max_incidence_end <- max(as.Date(selected$incidence_grouping_incidence_end_date))

diff --git a/inst/shiny/server.R b/inst/shiny/server.R
@@ -845,19 +845,66 @@ server <- function(input, output, session) {
     }
   )
   # compare lsc ----
-  output$plotly_compare_lsc <- renderPlotly({
-    lscFiltered <- dataFiltered$summarise_large_scale_characteristics |>
+
+  outputLSC <- shiny::reactive({
+    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) {
+
+  })
+
+  output$gt_compare_lsc <- DT::renderDT({
+
+    lscFiltered <- outputLSC()
+    target_cohort <- input$compare_large_scale_characteristics_grouping_cohort_1
+    comparator_cohort <- input$compare_large_scale_characteristics_grouping_cohort_2
+    lsc <- lscFiltered |>  
+      tidy() |>
+      filter(cohort_name %in% 
+               c(target_cohort, comparator_cohort) 
+             ) |> 
+      select(cohort_name,
+             variable_name,
+             concept_id,
+             variable_level,
+             table_name,
+             percentage) |>
+      pivot_wider(names_from = cohort_name,
+                  values_from = percentage)
+
+    lsc <-lsc |>
+      mutate(across(c(target_cohort, comparator_cohort), ~ as.numeric(.x)/100)) |>
+      mutate(smd = (!!sym(target_cohort) - !!sym(comparator_cohort))/sqrt((!!sym(target_cohort)*(1-!!sym(target_cohort)) + !!sym(comparator_cohort)*(1-!!sym(comparator_cohort)))/2)) |>
+      arrange(desc(smd))  |>
+      mutate(across(c(target_cohort, comparator_cohort), ~ as.numeric(.x)*100)) |> 
+      mutate(concept = paste0(variable_name, " (",concept_id, ")")) |> 
+      select("Concept name (concept ID)" = concept,
+             "Table" = table_name,
+             "Time window" = variable_level,
+             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 = lscFiltered,
+    plotComparedLsc(lsc = outputLSC(),
                     cohorts = c(input$compare_large_scale_characteristics_grouping_cohort_1,
                                 input$compare_large_scale_characteristics_grouping_cohort_2))
-  } )
+  })
 
   # orphan -----
   ## tidy orphan -----

diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R
@@ -562,7 +562,7 @@ ui <- bslib::page_navbar(
             )
           ),
           bslib::nav_panel(
-            title = "Formatted",
+            title = "Top concepts",
             bslib::card(
               full_screen = TRUE,
               bslib::card_header(
@@ -666,11 +666,24 @@ ui <- bslib::page_navbar(
                                      )
                                    )
         ),
+        bslib::navset_card_tab(
+
+          bslib::nav_panel(
+            title = "Table",
+          bslib::card(
+            full_screen = TRUE,
+            DT::DTOutput("gt_compare_lsc") |> withSpinner()
+          )
+          ),
+          bslib::nav_panel(
+            title = "Plot",
         bslib::card(
           full_screen = TRUE,
           plotly::plotlyOutput("plotly_compare_lsc") |> withSpinner()
           )
-      )),
+          )
+      ))
+      ),
   ## Cohort overlap -----
     bslib::nav_panel(
       title = "Cohort overlap",