Skip to content

Commit

Permalink
Merge pull request #911 from OHDSI/TemporalCharReactiveFix
Browse files Browse the repository at this point in the history 
Shiny hotfix Temporal char reactive fix
  • Loading branch information
@azimov
azimov committed Sep 1, 2022
2 parents 5567b89 + 249412c commit befe0eb
Show file tree
Hide file tree
Showing 2 changed files with 4 additions and 265 deletions.
176 changes: 4 additions & 172 deletions inst/shiny/DiagnosticsExplorer/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2238,84 +2238,6 @@ shiny::shinyServer(function(input, output, session) {
})

# Cohort Characterization -------------------------------------------------
## ReactiveVal: characterizationAnalysisNameFilter ----
characterizationAnalysisNameFilter <- reactiveVal(NULL)
shiny::observeEvent(eventExpr = {
list(
input$characterizationAnalysisNameFilter_open,
input$tabs
)
}, handlerExpr = {
if (isFALSE(input$characterizationAnalysisNameFilter_open) ||
!is.null(input$tabs)) {
characterizationAnalysisNameFilter(input$characterizationAnalysisNameFilter)
}
})
#### characterizationAnalysisNameFilter ----
shiny::observe({
characterizationAnalysisOptionsUniverse <- NULL
charcterizationAnalysisOptionsSelected <- NULL

if (hasData(temporalAnalysisRef)) {
characterizationAnalysisOptionsUniverse <- analysisNameOptions
charcterizationAnalysisOptionsSelected <- temporalAnalysisRef %>%
dplyr::filter(.data$analysisId %in% analysisIdInCohortCharacterization) %>%
dplyr::pull(.data$analysisName) %>%
unique()
}

shinyWidgets::updatePickerInput(
session = session,
inputId = "characterizationAnalysisNameFilter",
choicesOpt = list(style = rep_len("color: black;", 999)),
choices = characterizationAnalysisOptionsUniverse,
selected = charcterizationAnalysisOptionsSelected
)
})

## ReactiveVal: characterizationDomainIdFilter ----
characterizationDomainIdFilter <- reactiveVal(NULL)
shiny::observeEvent(eventExpr = {
list(
input$characterizationDomainIdFilter_open,
input$tabs
)
}, handlerExpr = {
if (isFALSE(input$characterizationDomainIdFilter_open) ||
!is.null(input$tabs)) {
characterizationDomainIdFilter(input$characterizationDomainIdFilter)
}
})

### characterizationDomainNameFilter ----
shiny::observe({
characterizationDomainOptionsUniverse <- NULL
charcterizationDomainOptionsSelected <- NULL

if (hasData(temporalAnalysisRef)) {
characterizationDomainOptionsUniverse <- domainIdOptions
charcterizationDomainOptionsSelected <- temporalAnalysisRef %>%
dplyr::filter(.data$analysisId %in% analysisIdInCohortCharacterization) %>%
dplyr::pull(.data$domainId) %>%
unique()
}

shinyWidgets::updatePickerInput(
session = session,
inputId = "characterizationDomainIdFilter",
choicesOpt = list(style = rep_len("color: black;", 999)),
choices = characterizationDomainOptionsUniverse,
selected = charcterizationDomainOptionsSelected
)
shinyWidgets::updatePickerInput(
session = session,
inputId = "characterizationDomainIdFilter",
choicesOpt = list(style = rep_len("color: black;", 999)),
choices = characterizationDomainOptionsUniverse,
selected = charcterizationDomainOptionsSelected
)
})

shiny::observe({
subset <- getConceptSetNameForFilter()$name %>%
sort() %>%
Expand All @@ -2338,6 +2260,7 @@ shiny::shinyServer(function(input, output, session) {

data <-
characterizationOutputForCharacterizationMenu()

if (!hasData(data)) {
return(NULL)
}
Expand All @@ -2347,10 +2270,7 @@ shiny::shinyServer(function(input, output, session) {
}

data <- data %>%
dplyr::filter(.data$analysisId %in% analysisIdInCohortCharacterization) %>%
dplyr::filter(.data$timeId %in% c(characterizationTimeIdChoices$timeId %>% unique())) %>%
dplyr::filter(.data$cohortId %in% c(targetCohortId())) %>%
dplyr::filter(.data$databaseId %in% c(selectedDatabaseIds()))
dplyr::filter(.data$timeId %in% c(characterizationTimeIdChoices$timeId %>% unique()))

if (input$charType == "Raw") {
if (input$characterizationProportionOrContinuous == "Proportion") {
Expand All @@ -2370,12 +2290,6 @@ shiny::shinyServer(function(input, output, session) {
dplyr::filter(.data$isBinary == "N")
}

data <- data %>%
dplyr::filter(.data$analysisName %in% characterizationAnalysisNameFilter())

data <- data %>%
dplyr::filter(.data$domainId %in% characterizationDomainIdFilter())

if (hasData(selectedConceptSets())) {
if (hasData(getResolvedAndMappedConceptIdsForFilters())) {
data <- data %>%
Expand Down Expand Up @@ -2568,81 +2482,6 @@ shiny::shinyServer(function(input, output, session) {
}
})

# Temporal characterization ------------
## ReactiveVal: temporalCharacterizationAnalysisNameFilter ----
temporalCharacterizationAnalysisNameFilter <- reactiveVal(NULL)
shiny::observeEvent(eventExpr = {
list(
input$temporalCharacterizationAnalysisNameFilter_open,
input$tabs
)
}, handlerExpr = {
if (isFALSE(input$temporalCharacterizationAnalysisNameFilter_open) ||
!is.null(input$tabs)) {
temporalCharacterizationAnalysisNameFilter(input$temporalCharacterizationAnalysisNameFilter)
}
})
### temporalCharacterizationAnalysisNameFilter ----
shiny::observe({
temporalCharacterizationAnalysisOptionsUniverse <- NULL
temporalCharcterizationAnalysisOptionsSelected <- NULL

if (hasData(temporalAnalysisRef)) {
temporalCharacterizationAnalysisOptionsUniverse <-
analysisNameOptions
temporalCharcterizationAnalysisOptionsSelected <-
temporalAnalysisRef %>%
dplyr::filter(.data$analysisId %in% analysisIdInTemporalCharacterization) %>%
dplyr::pull(.data$analysisName) %>%
unique()
}

shinyWidgets::updatePickerInput(
session = session,
inputId = "temporalCharacterizationAnalysisNameFilter",
choicesOpt = list(style = rep_len("color: black;", 999)),
choices = temporalCharacterizationAnalysisOptionsUniverse,
selected = temporalCharcterizationAnalysisOptionsSelected
)
})

## ReactiveVal: temporalCharacterizationDomainIdFilter ----
temporalcharacterizationDomainIdFilter <- reactiveVal(NULL)
shiny::observeEvent(eventExpr = {
list(
input$temporalcharacterizationDomainIdFilter_open,
input$tabs
)
}, handlerExpr = {
if (isFALSE(input$temporalcharacterizationDomainIdFilter_open) ||
!is.null(input$tabs)) {
temporalcharacterizationDomainIdFilter(input$temporalcharacterizationDomainIdFilter)
}
})

### temporalcharacterizationDomainIdFilter ----
shiny::observe({
temporalCharacterizationDomainOptionsUniverse <- NULL
temporalCharcterizationDomainOptionsSelected <- NULL

if (hasData(temporalAnalysisRef)) {
temporalCharacterizationDomainOptionsUniverse <-
domainIdOptions
temporalCharcterizationDomainOptionsSelected <-
temporalAnalysisRef %>%
dplyr::filter(.data$analysisId %in% analysisIdInTemporalCharacterization) %>%
dplyr::pull(.data$domainId) %>%
unique()
}

shinyWidgets::updatePickerInput(
session = session,
inputId = "temporalcharacterizationDomainIdFilter",
choicesOpt = list(style = rep_len("color: black;", 999)),
choices = temporalCharacterizationDomainOptionsUniverse,
selected = temporalCharcterizationDomainOptionsSelected
)
})

## temporalCohortCharacterizationDataFiltered ------------
temporalCohortCharacterizationDataFiltered <- shiny::reactive({
Expand All @@ -2656,6 +2495,7 @@ shiny::shinyServer(function(input, output, session) {
}
data <-
characterizationOutputForCharacterizationMenu()

if (!hasData(data)) {
return(NULL)
}
Expand All @@ -2664,10 +2504,7 @@ shiny::shinyServer(function(input, output, session) {
return(NULL)
}
data <- data %>%
dplyr::filter(.data$analysisId %in% analysisIdInTemporalCharacterization) %>%
dplyr::filter(.data$timeId %in% selectedTemporalTimeIds()) %>%
dplyr::filter(.data$cohortId %in% c(targetCohortId())) %>%
dplyr::filter(.data$databaseId %in% c(input$database))
dplyr::filter(.data$timeId %in% selectedTemporalTimeIds())

if (input$temporalProportionOrContinuous == "Proportion") {
data <- data %>%
Expand All @@ -2677,10 +2514,6 @@ shiny::shinyServer(function(input, output, session) {
dplyr::filter(.data$isBinary == "N")
}

data <- data %>%
dplyr::filter(.data$analysisName %in% temporalCharacterizationAnalysisNameFilter()) %>%
dplyr::filter(.data$domainId %in% temporalcharacterizationDomainIdFilter())

if (hasData(selectedConceptSets())) {
if (hasData(getResolvedAndMappedConceptIdsForFilters())) {
data <- data %>%
Expand All @@ -2706,7 +2539,6 @@ shiny::shinyServer(function(input, output, session) {
message = "Post processing: Rendering table",
value = 0
)

temporalChoices <- temporalCharacterizationTimeIdChoices %>%
dplyr::filter(.data$timeId %in% c(data$timeId %>% unique())) %>%
dplyr::pull(.data$temporalChoices) %>%
Expand Down
93 changes: 0 additions & 93 deletions inst/shiny/DiagnosticsExplorer/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1051,46 +1051,6 @@ bodyTabItems <- shinydashboard::tabItems(
shiny::conditionalPanel(
condition = "input.charType == 'Raw'",
tags$table(tags$tr(
tags$td(
shinyWidgets::pickerInput(
inputId = "characterizationAnalysisNameFilter",
label = "Analysis name",
choices = c(""),
selected = c(""),
inline = TRUE,
multiple = TRUE,
width = 300,
choicesOpt = list(style = rep_len("color: black;", 999)),
options = shinyWidgets::pickerOptions(
actionsBox = TRUE,
liveSearch = TRUE,
size = 10,
liveSearchStyle = "contains",
liveSearchPlaceholder = "Type here to search",
virtualScroll = 50
)
)
),
tags$td(
shinyWidgets::pickerInput(
inputId = "characterizationDomainIdFilter",
label = "Domain name",
choices = c(""),
selected = c(""),
inline = TRUE,
multiple = TRUE,
width = 300,
choicesOpt = list(style = rep_len("color: black;", 999)),
options = shinyWidgets::pickerOptions(
actionsBox = TRUE,
liveSearch = TRUE,
size = 10,
liveSearchStyle = "contains",
liveSearchPlaceholder = "Type here to search",
virtualScroll = 50
)
)
),
tags$td(
shiny::radioButtons(
inputId = "characterizationProportionOrContinuous",
Expand Down Expand Up @@ -1148,42 +1108,8 @@ bodyTabItems <- shinydashboard::tabItems(
title = NULL,
tags$table(tags$tr(
tags$td(
shinyWidgets::pickerInput(
inputId = "temporalCharacterizationAnalysisNameFilter",
label = "Analysis name",
choices = c(""),
selected = c(""),
multiple = TRUE,
width = 200,
choicesOpt = list(style = rep_len("color: black;", 999)),
options = shinyWidgets::pickerOptions(
actionsBox = TRUE,
liveSearch = TRUE,
size = 10,
liveSearchStyle = "contains",
liveSearchPlaceholder = "Type here to search",
virtualScroll = 50
)
)
),
tags$td(
shinyWidgets::pickerInput(
inputId = "temporalcharacterizationDomainIdFilter",
label = "Domain name",
choices = c(""),
selected = c(""),
multiple = TRUE,
width = 200,
choicesOpt = list(style = rep_len("color: black;", 999)),
options = shinyWidgets::pickerOptions(
actionsBox = TRUE,
liveSearch = TRUE,
size = 10,
liveSearchStyle = "contains",
liveSearchPlaceholder = "Type here to search",
virtualScroll = 50
)
)
),
tags$td(
shiny::radioButtons(
Expand Down Expand Up @@ -1390,25 +1316,6 @@ bodyTabItems <- shinydashboard::tabItems(
)
)
),
tags$td(
shinyWidgets::pickerInput(
inputId = "temporalCompareDomainNameFilter",
label = "Domain name",
choices = c(""),
selected = c(""),
multiple = TRUE,
width = 200,
choicesOpt = list(style = rep_len("color: black;", 999)),
options = shinyWidgets::pickerOptions(
actionsBox = TRUE,
liveSearch = TRUE,
size = 10,
liveSearchStyle = "contains",
liveSearchPlaceholder = "Type here to search",
virtualScroll = 50
)
)
),
tags$td(
shiny::radioButtons(
inputId = "temporalCompareCharacterizationProportionOrContinuous",
Expand Down

0 comments on commit befe0eb

Please sign in to comment.