Skip to content

Commit

Permalink
Merge pull request #126 from OHDSI/colour_lsc
Browse files Browse the repository at this point in the history 
Colour by table_name in compared lsc
  • Loading branch information
@edward-burn
edward-burn authored Nov 15, 2024
2 parents 3a151e2 + dd56b21 commit 28bfcc3
Show file tree
Hide file tree
Showing 3 changed files with 83 additions and 39 deletions.
36 changes: 27 additions & 9 deletions inst/shiny/global.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,32 +27,50 @@ if(file.exists(file.path(getwd(), "data", "appData.RData"))){
source(file.path(getwd(),"scripts", "preprocess.R"))
}

plotComparedLsc <- function(lsc, cohorts){
plotComparedLsc <- function(lsc, cohorts, colour = NULL, facet = NULL){
lsc <- lsc |> tidy()
plot_data <- lsc |>
filter(cohort_name %in% c(cohorts
)) |>
select(cohort_name,
)) |>
select(database = cdm_name,
cohort_name,
variable_name,
variable_level,
time_window = variable_level,
concept_id,
table_name,
table = table_name,
percentage) |>
pivot_wider(names_from = cohort_name,
values_from = percentage)


# plot <- visOmopResults::scatterPlot(plot_data,
# x = cohorts[1],
# y = cohorts[2],
# colour = colour,
# facet = facet,
# line = FALSE,
# point = TRUE,
# ribbon = FALSE) +
# ggplot2::geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
# ggplot2::theme_bw()

plot <- plot_data |>
ggplot(aes(text = paste("Concept:", variable_name,
"<br>Concept ID:", concept_id,
"<br>Time window:", variable_level,
"<br>Table:", table_name,
"<br>Time window:", time_window,
"<br>Table:", table,
"<br>Cohorts: "))) +
geom_point(aes(x = !!sym(cohorts[1]),
y = !!sym(cohorts[2]))) +
y = !!sym(cohorts[2]),
colour = !!sym(colour))
) +
geom_abline(slope = 1, intercept = 0,
color = "red", linetype = "dashed") +
theme_bw()

if(!is.null(facet)){
plot <- plot +
ggplot2::facet_wrap(facet)
}
ggplotly(plot)

}
63 changes: 33 additions & 30 deletions inst/shiny/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -844,21 +844,21 @@ server <- function(input, output, session) {
gt::gtsave(data = obj, filename = file)
}
)

# prevalence -----
## tidy prevalence -----
getTidyDataPrevalence <- shiny::reactive({
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") {
Expand All @@ -869,7 +869,7 @@ server <- function(input, output, session) {
res <- res |>
visOmopResults::pivotEstimates(pivotEstimatesBy = vars)
}

res |>
dplyr::select(!dplyr::all_of(colsEliminate))
})
Expand All @@ -892,7 +892,7 @@ server <- function(input, output, session) {
createOutputprev1 <- shiny::reactive({
result <- dataFiltered$prevalence |>
filter(cdm_name %in% input$prevalence_grouping_cdm_name,
variable_level %in% input$prevalence_settings_outcome_cohort_name) |>
variable_level %in% input$prevalence_settings_outcome_cohort_name) |>
filterSettings(analysis_interval %in% input$prevalence_settings_analysis_interval,
denominator_age_group %in% input$prevalence_settings_denominator_age_group,
denominator_sex %in% input$prevalence_settings_denominator_sex)
Expand Down Expand Up @@ -923,16 +923,16 @@ server <- function(input, output, session) {
gt::gtsave(data = obj, filename = file)
}
)

## output prev2 -----
createOutputprev2 <- shiny::reactive({
result <- dataFiltered$prevalence |>
filter(cdm_name %in% input$prevalence_grouping_cdm_name,
variable_level %in% input$prevalence_settings_outcome_cohort_name) |>
variable_level %in% input$prevalence_settings_outcome_cohort_name) |>
filterSettings(analysis_interval %in% input$prevalence_settings_analysis_interval,
denominator_age_group %in% input$prevalence_settings_denominator_age_group,
denominator_sex %in% input$prevalence_settings_denominator_sex)

IncidencePrevalence::plotPrevalence(
result,
x = input$prevalence_ggplot2_prev2_x,
Expand All @@ -959,27 +959,27 @@ server <- function(input, output, session) {
)
}
)


# compare lsc ----

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)

})

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 |>
lsc <- lscFiltered |>
tidy() |>
filter(cohort_name %in%
c(target_cohort, comparator_cohort)
) |>
filter(cohort_name %in%
c(target_cohort, comparator_cohort)
) |>
select(cohort_name,
variable_name,
concept_id,
Expand All @@ -988,39 +988,42 @@ server <- function(input, output, session) {
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, ")")) |>
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,


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))
input$compare_large_scale_characteristics_grouping_cohort_2),
colour = c(input$compare_large_scale_characteristics_colour_1),
facet = c(input$compare_large_scale_characteristics_facet_1)
)
})

# orphan -----
Expand Down
23 changes: 23 additions & 0 deletions inst/shiny/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -679,6 +679,28 @@ ui <- bslib::page_navbar(
title = "Plot",
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()
)
)
Expand Down Expand Up @@ -797,6 +819,7 @@ ui <- bslib::page_navbar(
)
)
),
# Cohort overlap ----
bslib::nav_panel(
title = "Plot cohort overlap",
bslib::card(
Expand Down

0 comments on commit 28bfcc3

Please sign in to comment.