From aed514373b3818b0c97845fba1783f1357e364ef Mon Sep 17 00:00:00 2001 From: Gowtham Rao Date: Wed, 24 Feb 2021 08:58:22 -0500 Subject: [PATCH] Updated siny app for mskai and phenotype library 2 --- MskaiCohortDiagnostics/R/DataPulls.R | 30 +- MskaiCohortDiagnostics/R/HelperFunctions.R | 46 +- MskaiCohortDiagnostics/R/Results.R | 4 +- MskaiCohortDiagnostics/R/Tables.R | 7 + MskaiCohortDiagnostics/global.R | 25 +- .../resultsDataModelSpecification.csv | 1 + MskaiCohortDiagnostics/server.R | 718 +++++++++++++++--- .../sql/RecommendationSource.sql | 8 +- .../sql/RecommendationStandard.sql | 8 +- .../sql/SearchVocabularyForConcepts.sql | 2 +- MskaiCohortDiagnostics/ui.R | 292 +------ PhenotypeLibrary2/R/HelperFunctions.R | 25 +- PhenotypeLibrary2/global.R | 26 +- PhenotypeLibrary2/server.R | 27 +- PhenotypeLibrary2/ui.R | 2 +- 15 files changed, 793 insertions(+), 428 deletions(-) diff --git a/MskaiCohortDiagnostics/R/DataPulls.R b/MskaiCohortDiagnostics/R/DataPulls.R index 0244ef63..ca9d91d0 100644 --- a/MskaiCohortDiagnostics/R/DataPulls.R +++ b/MskaiCohortDiagnostics/R/DataPulls.R @@ -13,7 +13,7 @@ loadRecommenderStandardFromDatabase <- renderTranslateQuerySql( connection = dataSource$connection, sql = sql, - results_database_schema = 'concept_prevalence', + # results_database_schema = dataSource$resultsDatabaseSchema, vocabulary_database_schema = dataSource$vocabularyDatabaseSchema, source_list = conceptList, snakeCaseToCamelCase = TRUE @@ -40,7 +40,7 @@ loadRecommenderSourceFromDatabase <- renderTranslateQuerySql( connection = dataSource$connection, sql = sql, - results_database_schema = 'concept_prevalence', + # results_database_schema = dataSource$resultsDatabaseSchema, vocabulary_database_schema = dataSource$vocabularyDatabaseSchema, source_list = conceptList, snakeCaseToCamelCase = TRUE @@ -246,8 +246,8 @@ resolveConceptSetExpressionUsingDatabase <- function(dataSource = .GlobalEnv, # get all conceptIds (as dataframe) that are excluded in concept set expression with descendants excludedConceptIdsWithDescendants <- descendantConcepts %>% dplyr::filter(.data$ancestorConceptId %in% (conceptSetExpressionTable %>% - dplyr::filter(.data$isExcluded == TRUE && - .data$includeDescendants == TRUE) %>% + dplyr::filter(.data$isExcluded == TRUE) %>% + dplyr::filter(.data$includeDescendants == TRUE) %>% dplyr::pull(.data$conceptId))) # conceptIds in conceptSetExpression table @@ -403,4 +403,26 @@ getDetailsForConceptIds <- function(dataSource = dataSource, ) %>% dplyr::arrange(1) return(data) +} + + +getConceptPrevalenceCountsForConceptIds <- function(dataSource = .GlobalEnv, + conceptIdsList) { + + sql <- "select * + from concept_prevalence.cp_master + where concept_id in (@concept_list);" + if (length(conceptIdsList) > 0) { + data <- + renderTranslateQuerySql( + connection = dataSource$connection, + concept_list = conceptIdsList, + sql = sql, + snakeCaseToCamelCase = TRUE + ) %>% + dplyr::arrange(1) + return(data) + } else { + return(dplyr::tibble()) + } } \ No newline at end of file diff --git a/MskaiCohortDiagnostics/R/HelperFunctions.R b/MskaiCohortDiagnostics/R/HelperFunctions.R index 9d042cfc..f5db108a 100644 --- a/MskaiCohortDiagnostics/R/HelperFunctions.R +++ b/MskaiCohortDiagnostics/R/HelperFunctions.R @@ -8,7 +8,8 @@ cohortReference <- function(outputId) { standardDataTable <- function(data, selectionMode = "single", selected = c(1), - searching = TRUE) { + searching = TRUE, + pageLength = 10) { dataTableFilter = list(position = 'top', @@ -17,7 +18,7 @@ standardDataTable <- function(data, dataTableOption = list( - pageLength = 10, + pageLength = pageLength, lengthMenu = list(c(5, 10, 20, -1), c("5", "10", "20", "All")), lengthChange = TRUE, searching = searching, @@ -66,7 +67,18 @@ standardDataTable <- function(data, 'temporalChoices', 'covariateName', 'conceptId', - 'databaseId' + 'databaseId', + 'standard', + 'invalidReason', + 'invalid', + 'conceptCode', + 'isExcluded', + 'excluded', + 'includeDescendants', + 'descendants', + 'includeMapped', + 'mapped', + 'conceptInSet' ) convertVariableToFactor <- function(data, variables) { @@ -114,7 +126,7 @@ standardDataTable <- function(data, colNames <- colnames(data) listRounds <- c(colNames[stringr::str_detect(string = tolower(colNames), - pattern = 'entries|subjects|count|min|max|p10|p25|median|p75|p90|max|before|onvisitstart|after|duringvisit')] + pattern = 'entries|subjects|count|min|max|p10|p25|median|p75|p90|max|before|onvisitstart|after|duringvisit|dbc|drc|rc')] , colNames[stringr::str_detect(string = colNames, pattern = paste0(database$databaseId, collapse = "|"))]) listDecimal <- @@ -270,3 +282,29 @@ convertMdToHtml <- function(markdown) { # } # return(cohort) # } + + +pivotIndexBreakDownData <- function(data, variable, phenotypeLibraryMode = TRUE) { + pivotByPhenotypeCohort <- c('phenotypeId', 'phenotypeName', 'cohortId', 'cohortName', 'conceptId', 'conceptName') + pivotByCohort <- c('cohortId', 'cohortName', 'conceptId', 'conceptName') + if (phenotypeLibraryMode) { + if (nrow(data) > 0) { + data <- data %>% + dplyr::select(dplyr::all_of(pivotByPhenotypeCohort), 'databaseId', dplyr::all_of(variable)) %>% + tidyr::pivot_wider(id_cols = pivotByPhenotypeCohort, + values_from = dplyr::all_of(variable), + names_from = 'databaseId', + values_fill = 0) + } else {dplyr::tibble('no data')} + } else { + if (nrow(data) > 0) { + data <- data %>% + dplyr::select(dplyr::all_of(pivotByCohort), 'databaseId', dplyr::all_of(variable)) %>% + tidyr::pivot_wider(id_cols = pivotByCohort, + values_from = dplyr::all_of(variable), + names_from = 'databaseId', + values_fill = 0) + } else {dplyr::tibble('no data')} + } + return(data) +} \ No newline at end of file diff --git a/MskaiCohortDiagnostics/R/Results.R b/MskaiCohortDiagnostics/R/Results.R index 41ccbdbd..f33ee74a 100644 --- a/MskaiCohortDiagnostics/R/Results.R +++ b/MskaiCohortDiagnostics/R/Results.R @@ -216,15 +216,13 @@ getIndexEventBreakdown <- function(dataSource = .GlobalEnv, dplyr::left_join(y = cohortCounts, by = c("cohortId" = "cohortId", "databaseId" = "databaseId")) %>% - dplyr::mutate(percent = .data$conceptCount/.data$cohortEntries) %>% dplyr::relocate( .data$databaseId, .data$cohortId, .data$conceptId, .data$conceptName, .data$conceptCount - ) %>% - dplyr::select(-.data$cohortEntries) + ) return(data) } diff --git a/MskaiCohortDiagnostics/R/Tables.R b/MskaiCohortDiagnostics/R/Tables.R index b1c36688..e2c91958 100644 --- a/MskaiCohortDiagnostics/R/Tables.R +++ b/MskaiCohortDiagnostics/R/Tables.R @@ -2,6 +2,13 @@ library(magrittr) prepareTable1 <- function(covariates, pathToCsv = "Table1Specs.csv") { + if ('conceptName' %in% colnames(covariates)) { + covariates <- covariates %>% + dplyr::mutate(covariateName = conceptName) + } + # remove negative values that are created because of minCellCount + covariates <- covariates %>% + dplyr::filter(.data$mean > 0) space <- " " specifications <- readr::read_csv( file = pathToCsv, diff --git a/MskaiCohortDiagnostics/global.R b/MskaiCohortDiagnostics/global.R index 236d45c6..1c11b251 100644 --- a/MskaiCohortDiagnostics/global.R +++ b/MskaiCohortDiagnostics/global.R @@ -309,7 +309,21 @@ if (isValidConnection && databaseMode && !foundPremergedFile) { ) } } - + for (table in c("recommender_set")) { + if (table %in% resultsTablesOnServer && + !exists(x = snakeCaseToCamelCase(string = table)) && + !isEmpty( + connection = connectionPool, + tableName = table, + resultsDatabaseSchema = 'concept_prevalence' + )) { + assign( + x = snakeCaseToCamelCase(table), + value = dplyr::tibble(), + envir = .GlobalEnv + ) + } + } dataSource <- createDatabaseDataSource( connection = connectionPool, @@ -385,13 +399,11 @@ if (exists("cohort")) { } cohortMetaData <- dplyr::bind_rows(cohortMetaData) %>% readr::type_convert(col_types = readr::cols()) - if ('referent_concept_id' %in% colnames(cohortMetaData)) { + if ('referentConceptId' %in% colnames(cohortMetaData)) { referentConceptIds <- c(referentConceptIds, - cohortMetaData$referent_concept_id) %>% unique() + cohortMetaData$referentConceptId) %>% unique() } - colnames(cohortMetaData) <- - snakeCaseToCamelCase(colnames(cohortMetaData)) } } else { stop("Cohort table not found in data source") @@ -586,5 +598,4 @@ if (exists(x = "phenotypeDescription")) { appTitle <- phenotypeLibraryModeDefaultTitle } else { appTitle <- cohortDiagnosticModeDefaultTitle -} - +} \ No newline at end of file diff --git a/MskaiCohortDiagnostics/resultsDataModelSpecification.csv b/MskaiCohortDiagnostics/resultsDataModelSpecification.csv index 0cbff3c5..677f81fe 100644 --- a/MskaiCohortDiagnostics/resultsDataModelSpecification.csv +++ b/MskaiCohortDiagnostics/resultsDataModelSpecification.csv @@ -99,6 +99,7 @@ inclusion_rule_stats,cohort_id,bigint,Yes,Yes,No,Yes inclusion_rule_stats,database_id,varchar,Yes,Yes,No,Yes index_event_breakdown,concept_id,int,Yes,Yes,No,Yes index_event_breakdown,concept_count,float,Yes,No,No,Yes +index_event_breakdown,subject_count,float,Yes,No,No,Yes index_event_breakdown,cohort_id,bigint,Yes,Yes,No,Yes index_event_breakdown,database_id,varchar,Yes,Yes,No,Yes orphan_concept,cohort_id,bigint,Yes,Yes,No,Yes diff --git a/MskaiCohortDiagnostics/server.R b/MskaiCohortDiagnostics/server.R index d6a3faee..660eb53c 100644 --- a/MskaiCohortDiagnostics/server.R +++ b/MskaiCohortDiagnostics/server.R @@ -16,6 +16,7 @@ shiny::shinyServer(function(input, output, session) { ) showAllMenuItem <- reactiveVal(FALSE) + rvCharacterizationPrettyTableGenerated <- shiny::reactiveVal(value = FALSE) output$isHeaderbarVisible <- shiny::reactive(x = { return(showAllMenuItem()) @@ -102,6 +103,265 @@ shiny::shinyServer(function(input, output, session) { shinydashboard::sidebarMenu(menuList) }) + searchTableRowIsSelected <- shiny::reactive(x = { + length <- length(input$cohortSearchTableResults_rows_selected) + + if (length == 2) { + return(6) + } else { + return(12) + } + }) + + output$dynamicUIGenerationCohortDetailsOne <- shiny::renderUI( + shiny::column( + searchTableRowIsSelected(), + shiny::conditionalPanel( + "output.cohortSearchResultsCountOfSelected > 0&input.compareCohorts=='No Comparision'", + shiny::tabsetPanel( + id = "cohortDetails", + type = "tab", + shiny::tabPanel(title = "Description", + value = "descriptionFirst", + copyToClipboardButton(toCopyId = "cohortDetailsTextFirst", + style = "margin-top: 5px; margin-bottom: 5px;"), + shiny::htmlOutput("cohortDetailsTextFirst")), + shiny::tabPanel( + value = "cohortDefinitionFirst", + title = "Cohort definition", + copyToClipboardButton(toCopyId = "cohortDefinitionDetailsFirst", + style = "margin-top: 5px; margin-bottom: 5px;"), + shiny::htmlOutput(outputId = "cohortDefinitionDetailsFirst") + ), + shiny::tabPanel( + value = "cohortDefinitionConceptsetFirst", + title = "Concept Sets", + DT::DTOutput(outputId = "cohortDefinitionConceptSetsTableFirst"), + shiny::conditionalPanel( + condition = "output.cohortConceptSetsSelectedFirstRowIsSelected == true", + shiny::tabsetPanel( + id = "conceptsetExpressionTabFirst", + shiny::tabPanel( + value = "conceptsetExpressionFirst", + title = "Expression", + DT::DTOutput(outputId = "cohortConceptsetExpressionDataTableFirst") + ), + shiny::tabPanel( + value = "conceptsetExpressionJsonFirst", + title = "Json", + copyToClipboardButton(toCopyId = "cohortConceptsetExpressionJsonFirst", + style = "margin-top: 5px; margin-bottom: 5px;"), + shiny::verbatimTextOutput(outputId = "cohortConceptsetExpressionJsonFirst"), + tags$head( + tags$style( + "#cohortConceptsetExpressionJsonFirst { max-height:400px};" + ) + ) + ), + shiny::tabPanel( + value = "conceptsetExpressionResoledFirst", + title = "Resolved", + shiny::tabsetPanel( + id = "resolvedConceptsetExpressionFirst", + shiny::tabPanel( + value = "resolvedConceptsetExpressionTabPanelFirst", + title = "Resolved", + DT::DTOutput(outputId = "resolvedConceptSetExpressionDtStandardFirst") + ), + shiny::tabPanel( + value = "mappedConceptsetExpressionTabPanelFirst", + title = "Mapped standard to non standard", + DT::DTOutput(outputId = "resolvedConceptSetExpressionDtMappedFirst") + )), + ), + shiny::tabPanel( + value = "conceptsetExpressionOptimizedFirst", + title = "Optimized", + shiny::tabsetPanel( + id = "optimizedConceptsetExpressionFirst", + shiny::tabPanel( + value = "retainedConceptsetExpressionFirst", + title = "Retained", + DT::DTOutput(outputId = "optimizedConceptSetExpressionDtRetainedFirst") + ), + shiny::tabPanel( + value = "removedConceptsetExpressionFirst", + title = "Removed", + DT::DTOutput(outputId = "optimizedConceptSetExpressionDtRemovedFirst") + )), + ), + shiny::tabPanel( + value = "conceptsetExpressionRecommendedFirst", + title = "Recommended", + shiny::tabsetPanel( + id = "recommendedConceptsetExpressionFirst", + shiny::tabPanel( + value = "standartRecommendedConceptSetExpressionFirst", + title = "Standard", + DT::DTOutput(outputId = "recommendedConceptSetExpressionDtStandardFirst") + ), + shiny::tabPanel( + value = "nonStandartRecommendedConceptSetExpressionFirst", + title = "Non Standard", + DT::DTOutput(outputId = "recommendedConceptSetExpressionDtSourceFirst") + )), + ) + ) + ) + ), + shiny::tabPanel( + value = "cohortDefinitionJsonFirst", + title = "JSON", + copyToClipboardButton(toCopyId = "cohortDefinitionJsonFirst", + style = "margin-top: 5px; margin-bottom: 5px;"), + shiny::verbatimTextOutput(outputId = "cohortDefinitionJsonFirst"), + tags$head( + tags$style( + "#cohortDefinitionJsonFirst { max-height:400px};" + ) + ) + ), + shiny::tabPanel( + value = "cohortDefinitionSqlFirst", + title = "SQL", + copyToClipboardButton(toCopyId = "cohortDefinitionSqlFirst", + style = "margin-top: 5px; margin-bottom: 5px;"), + shiny::verbatimTextOutput(outputId = "cohortDefinitionSqlFirst"), + tags$head( + tags$style( + "#cohortDefinitionSqlFirst { max-height:400px};" + ) + ) + ) + ) + ) + ) + ) + output$dynamicUIGenerationCohortDetailsTwo <- shiny::renderUI( + shiny::column( + searchTableRowIsSelected(), + shiny::conditionalPanel( + "output.cohortSearchResultsCountOfSelected == 2&input.compareCohorts=='No Comparision'", + shiny::tabsetPanel( + id = "cohortDetailsSecond", + type = "tab", + shiny::tabPanel(title = "Description", + value = "descriptionSecond", + copyToClipboardButton(toCopyId = "cohortDetailsTextSecond", + style = "margin-top: 5px; margin-bottom: 5px;"), + shiny::htmlOutput(outputId = "cohortDetailsTextSecond")), + shiny::tabPanel( + value = "cohortDefinitionSecond", + title = "Cohort definition", + copyToClipboardButton(toCopyId = "cohortDefinitionDetailsSecond", + style = "margin-top: 5px; margin-bottom: 5px;"), + shiny::htmlOutput(outputId = "cohortDefinitionDetailsSecond") + ), + shiny::tabPanel( + value = "cohortDefinitionConceptsetSecond", + title = "Concept Sets", + DT::DTOutput(outputId = "cohortDefinitionConceptSetsTableSecond"), + shiny::conditionalPanel( + condition = "output.cohortConceptSetsSelectedSecondRowIsSelected == true", + shiny::tabsetPanel( + id = "conceptsetExpressionTabSecond", + shiny::tabPanel( + value = "conceptsetExpressionSecond", + title = "Expression", + DT::DTOutput(outputId = "cohortConceptsetExpressionDataTableSecond") + ), + shiny::tabPanel( + value = "conceptetExpressionJsonSecond", + title = "Json", + copyToClipboardButton(toCopyId = "cohortConceptsetExpressionJsonSecond", + style = "margin-top: 5px; margin-bottom: 5px;"), + shiny::verbatimTextOutput(outputId = "cohortConceptsetExpressionJsonSecond"), + tags$head( + tags$style( + "#cohortConceptsetExpressionJsonSecond { max-height:400px};" + ) + ) + ), + shiny::tabPanel( + value = "conceptsetExpressionResolvedSecond", + title = "Resolved", + shiny::tabsetPanel( + id = "resolvedConceptsetExpressionSecond", + shiny::tabPanel( + value = "resolvedConceptsetExpressionTabPanelSecond", + title = "Standard", + DT::DTOutput(outputId = "resolvedConceptSetExpressionDtStandardSecond") + ), + shiny::tabPanel( + value = "mappedConceptsetExpressionTabPanelFirst", + title = "Mapped", + DT::DTOutput(outputId = "resolvedConceptSetExpressionDtMappedSecond") + )), + ), + shiny::tabPanel( + value = "conceptsetExpressionOptimizedSecond", + title = "Optimized", + shiny::tabsetPanel( + id = "optimizedConceptsetExpressionSecond", + shiny::tabPanel( + value = "retainedConceptsetExpressionSecond", + title = "Retained", + DT::DTOutput(outputId = "optimizedConceptSetExpressionDtRetainedSecond") + ), + shiny::tabPanel( + value = "removedConceptsetExpressionSecond", + title = "Removed", + DT::DTOutput(outputId = "optimizedConceptSetExpressionDtRemovedSecond") + )), + ), + shiny::tabPanel( + value = "conceptsetExpressionRecommendedSecond", + title = "Recommended", + shiny::tabsetPanel( + id = "recommendedConceptsetExpressionSecond", + shiny::tabPanel( + value = "standardRecommendedConceptsetExpressionSecond", + title = "Standard", + DT::DTOutput(outputId = "recommendedConceptSetExpressionDtStandardSecond") + ), + shiny::tabPanel( + value = "nonStandardRecommendedConceptsetExpressionSecond", + title = "Non Standard", + DT::DTOutput(outputId = "recommendedConceptSetExpressionDtSourceSecond") + )), + ) + ) + ) + ), + shiny::tabPanel( + value = "cohortDefinitionJsonSecond", + title = "JSON", + copyToClipboardButton(toCopyId = "cohortDefinitionJsonSecond", + style = "margin-top: 5px; margin-bottom: 5px;"), + shiny::verbatimTextOutput("cohortDefinitionJsonSecond"), + tags$head( + tags$style( + "#cohortDefinitionJsonSecond { max-height:400px};" + ) + ) + ), + shiny::tabPanel( + value = "cohortDefinitionSqlSecond", + title = "SQL", + copyToClipboardButton(toCopyId = "cohortDefinitionSqlSecond", + style = "margin-top: 5px; margin-bottom: 5px;"), + shiny::verbatimTextOutput("cohortDefinitionSqlSecond"), + tags$head( + tags$style( + "#cohortDefinitionSqlSecond { max-height:400px};" + ) + ) + ) + ) + ) + ) + ) + ############### search tab ###################################### rvCohortSearch <- shiny::reactiveValues() # Cohort search results @@ -122,12 +382,17 @@ shiny::shinyServer(function(input, output, session) { searchString, searchField, points) { - data <- searchTable %>% - dplyr::filter(stringr::str_detect(string = tolower(.data[[searchField]]), - pattern = tolower(searchString))) %>% - dplyr::select(.data$cohortId) %>% - dplyr::mutate(points = points) - return(data) + if (searchField %in% colnames(searchTable)) { + data <- searchTable %>% + dplyr::filter(stringr::str_detect( + string = tolower(.data[[searchField]]), + pattern = tolower(searchString) + )) %>% + dplyr::select(.data$cohortId) %>% + dplyr::mutate(points = points) %>% + dplyr::mutate(wordSearched = word) + return(data) + } } searchResultByWords <- list() @@ -138,8 +403,7 @@ shiny::shinyServer(function(input, output, session) { searchResult[[j]] <- searchInField(searchTable = cohort, searchField = searchFieldWeight[j,]$searchFields, searchString = word, - points = searchFieldWeight[j,]$searchPoints) %>% - dplyr::mutate(wordSearched = word) + points = searchFieldWeight[j,]$searchPoints) } searchResultByWords[[i]] <- dplyr::bind_rows(searchResult) } @@ -453,28 +717,48 @@ shiny::shinyServer(function(input, output, session) { # synchronize the selection of tabset panels when comparing two cohorts shiny::observe({ - if (input$cohortDetails == "descriptionFirst") { - shiny::updateTabsetPanel(session, inputId = "cohortDetailsSecond", selected = "descriptionSecond") - } else if (input$cohortDetails == "cohortDefinitionFirst") { - shiny::updateTabsetPanel(session, inputId = "cohortDetailsSecond", selected = "cohortDefinitionSecond") - } else if (input$cohortDetails == "cohortDefinitionConceptsetFirst") { - shiny::updateTabsetPanel(session, inputId = "cohortDetailsSecond", selected = "cohortDefinitionConceptsetSecond") - } else if (input$cohortDetails == "cohortDefinitionJsonFirst") { - shiny::updateTabsetPanel(session, inputId = "cohortDetailsSecond", selected = "cohortDefinitionJsonSecond") - } else if (input$cohortDetails == "cohortDefinitionSqlFirst") { - shiny::updateTabsetPanel(session, inputId = "cohortDetailsSecond", selected = "cohortDefinitionSqlSecond") - } - - if (input$conceptsetExpressionTabFirst == "conceptsetExpressionFirst") { - shiny::updateTabsetPanel(session, inputId = "conceptsetExpressionTabSecond", selected = "conceptsetExpressionSecond") - } else if (input$conceptsetExpressionTabFirst == "conceptsetExpressionJsonFirst") { - shiny::updateTabsetPanel(session, inputId = "conceptsetExpressionTabSecond", selected = "conceptetExpressionJsonSecond") - } else if (input$conceptsetExpressionTabFirst == "conceptsetExpressionResoledFirst") { - shiny::updateTabsetPanel(session, inputId = "conceptsetExpressionTabSecond", selected = "conceptsetExpressionResolvedSecond") - } else if (input$conceptsetExpressionTabFirst == "conceptsetExpressionOptimizedFirst") { - shiny::updateTabsetPanel(session, inputId = "conceptsetExpressionTabSecond", selected = "conceptsetExpressionOptimizedSecond") - } else if (input$conceptsetExpressionTabFirst == "conceptsetExpressionRecommendedFirst") { - shiny::updateTabsetPanel(session, inputId = "conceptsetExpressionTabSecond", selected = "conceptsetExpressionRecommendedSecond") + if (searchTableRowIsSelected() == 6) { + if (input$cohortDetails == "descriptionFirst") { + shiny::updateTabsetPanel(session, inputId = "cohortDetailsSecond", selected = "descriptionSecond") + } else if (input$cohortDetails == "cohortDefinitionFirst") { + shiny::updateTabsetPanel(session, inputId = "cohortDetailsSecond", selected = "cohortDefinitionSecond") + } else if (input$cohortDetails == "cohortDefinitionConceptsetFirst") { + shiny::updateTabsetPanel(session, inputId = "cohortDetailsSecond", selected = "cohortDefinitionConceptsetSecond") + } else if (input$cohortDetails == "cohortDefinitionJsonFirst") { + shiny::updateTabsetPanel(session, inputId = "cohortDetailsSecond", selected = "cohortDefinitionJsonSecond") + } else if (input$cohortDetails == "cohortDefinitionSqlFirst") { + shiny::updateTabsetPanel(session, inputId = "cohortDetailsSecond", selected = "cohortDefinitionSqlSecond") + } + + if (input$conceptsetExpressionTabFirst == "conceptsetExpressionFirst") { + shiny::updateTabsetPanel(session, inputId = "conceptsetExpressionTabSecond", selected = "conceptsetExpressionSecond") + } else if (input$conceptsetExpressionTabFirst == "conceptsetExpressionJsonFirst") { + shiny::updateTabsetPanel(session, inputId = "conceptsetExpressionTabSecond", selected = "conceptetExpressionJsonSecond") + } else if (input$conceptsetExpressionTabFirst == "conceptsetExpressionResoledFirst") { + shiny::updateTabsetPanel(session, inputId = "conceptsetExpressionTabSecond", selected = "conceptsetExpressionResolvedSecond") + } else if (input$conceptsetExpressionTabFirst == "conceptsetExpressionOptimizedFirst") { + shiny::updateTabsetPanel(session, inputId = "conceptsetExpressionTabSecond", selected = "conceptsetExpressionOptimizedSecond") + } else if (input$conceptsetExpressionTabFirst == "conceptsetExpressionRecommendedFirst") { + shiny::updateTabsetPanel(session, inputId = "conceptsetExpressionTabSecond", selected = "conceptsetExpressionRecommendedSecond") + } + + if (input$resolvedConceptsetExpressionFirst == "resolvedConceptsetExpressionTabPanelFirst") { + shiny::updateTabsetPanel(session, inputId = "resolvedConceptsetExpressionSecond", selected = "resolvedConceptsetExpressionTabPanelSecond") + } else if (input$resolvedConceptsetExpressionFirst == "mappedConceptsetExpressionTabPanelFirst") { + shiny::updateTabsetPanel(session, inputId = "resolvedConceptsetExpressionSecond", selected = "mappedConceptsetExpressionTabPanelFirst") + } + + if (input$optimizedConceptsetExpressionFirst == "retainedConceptsetExpressionFirst") { + shiny::updateTabsetPanel(session, inputId = "optimizedConceptsetExpressionSecond", selected = "retainedConceptsetExpressionSecond") + } else if (input$optimizedConceptsetExpressionFirst == "removedConceptsetExpressionFirst") { + shiny::updateTabsetPanel(session, inputId = "optimizedConceptsetExpressionSecond", selected = "removedConceptsetExpressionSecond") + } + + if (input$recommendedConceptsetExpressionFirst == "standartRecommendedConceptSetExpressionFirst") { + shiny::updateTabsetPanel(session, inputId = "recommendedConceptsetExpressionSecond", selected = "standardRecommendedConceptsetExpressionSecond") + } else if (input$recommendedConceptsetExpressionFirst == "nonStandartRecommendedConceptSetExpressionFirst") { + shiny::updateTabsetPanel(session, inputId = "recommendedConceptsetExpressionSecond", selected = "nonStandardRecommendedConceptsetExpressionSecond") + } } }) @@ -515,6 +799,24 @@ shiny::shinyServer(function(input, output, session) { data <- cohortConceptSets()[[1]]$conceptSetExpressionDetails data <- data %>% dplyr::filter(.data$id == cohortConceptSetsSelectedFirst()$id) + data <- data %>% + dplyr::select(.data$conceptId, .data$conceptName, + .data$isExcluded, .data$includeDescendants, + .data$includeMapped, + .data$standardConcept, .data$invalidReason, + .data$conceptCode, .data$domainId, + .data$vocabularyId, .data$conceptClassId) %>% + dplyr::rename(invalid = .data$invalidReason, + code = .data$conceptCode, + id = .data$conceptId, + name = .data$conceptName, + standard = .data$standardConcept, + exclude = .data$isExcluded, + descendants = .data$includeDescendants, + mapped = .data$includeMapped) %>% + dplyr::mutate(exclude = as.integer(.data$exclude), + descendants = as.integer(.data$descendants), + mapped = as.integer(.data$mapped)) dataTable <- standardDataTable(data = data, selectionMode = "single") return(dataTable) } else { @@ -555,6 +857,24 @@ shiny::shinyServer(function(input, output, session) { data <- cohortConceptSets()[[2]]$conceptSetExpressionDetails data <- data %>% dplyr::filter(.data$id == cohortConceptSetsSelectedSecond()$id) + data <- data %>% + dplyr::select(.data$conceptId, .data$conceptName, + .data$isExcluded, .data$includeDescendants, + .data$includeMapped, + .data$standardConcept, .data$invalidReason, + .data$conceptCode, .data$domainId, + .data$vocabularyId, .data$conceptClassId) %>% + dplyr::rename(invalid = .data$invalidReason, + code = .data$conceptCode, + id = .data$conceptId, + name = .data$conceptName, + standard = .data$standardConcept, + exclude = .data$isExcluded, + descendants = .data$includeDescendants, + mapped = .data$includeMapped) %>% + dplyr::mutate(exclude = as.integer(.data$exclude), + descendants = as.integer(.data$descendants), + mapped = as.integer(.data$mapped)) dataTable <- standardDataTable(data = data, selectionMode = "single") return(dataTable) } else {NULL} @@ -571,6 +891,22 @@ shiny::shinyServer(function(input, output, session) { expression <- cohortConceptSetsSelectedFirst()$expression data <- resolveConceptSetExpressionUsingDatabase(dataSource = dataSource, conceptSetExpression = expression) + resolvedConceptIds <- data$resolved$conceptId %>% unique() + resolvedConceptIdCounts <- getConceptPrevalenceCountsForConceptIds(dataSource = dataSource, + conceptIdsList = resolvedConceptIds) + data$resolvedConcepts <- data$resolvedConcepts %>% + dplyr::left_join(y = resolvedConceptIdCounts, by = "conceptId") %>% + dplyr::arrange(dplyr::desc(.data$drc)) %>% + dplyr::distinct() + + mappedConceptIds <- data$mappedConcepts$conceptId %>% unique() + mappedConceptIdsConceptIdCounts <- getConceptPrevalenceCountsForConceptIds(dataSource = dataSource, + conceptIdsList = mappedConceptIds) + data$mappedConcepts <- data$mappedConcepts %>% + dplyr::left_join(y = mappedConceptIdsConceptIdCounts, by = "conceptId") %>% + dplyr::arrange(dplyr::desc(.data$drc)) %>% + dplyr::distinct() + return(data) } else { return(NULL) @@ -593,7 +929,7 @@ shiny::shinyServer(function(input, output, session) { dataTable <- standardDataTable(data = data) return(dataTable) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) @@ -604,9 +940,20 @@ shiny::shinyServer(function(input, output, session) { data <- resolveConceptSetExpressionUsingDatabase(dataSource = dataSource, conceptSetExpression = expression) + resolvedConceptIds <- data$resolved$conceptId %>% unique() + resolvedConceptIdCounts <- getConceptPrevalenceCountsForConceptIds(dataSource = dataSource, + conceptIdsList = resolvedConceptIds) + data$resolvedConcepts <- data$resolvedConcepts %>% + dplyr::left_join(y = resolvedConceptIdCounts, by = "conceptId") %>% + dplyr::arrange(dplyr::desc(.data$drc)) + + mappedConceptIds <- data$mappedConcepts$conceptId %>% unique() + mappedConceptIdsConceptIdCounts <- getConceptPrevalenceCountsForConceptIds(dataSource = dataSource, + conceptIdsList = mappedConceptIds) + data$mappedConcepts <- data$mappedConcepts %>% + dplyr::left_join(y = mappedConceptIdsConceptIdCounts, by = "conceptId") %>% + dplyr::arrange(dplyr::desc(.data$drc)) return(data) - } else { - return(NULL) } }) output$resolvedConceptSetExpressionDtStandardSecond <- @@ -619,7 +966,7 @@ shiny::shinyServer(function(input, output, session) { return(dataTable) } } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) output$resolvedConceptSetExpressionDtMappedSecond <- @@ -629,7 +976,7 @@ shiny::shinyServer(function(input, output, session) { dataTable <- standardDataTable(data = data) return(dataTable) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) @@ -642,9 +989,18 @@ shiny::shinyServer(function(input, output, session) { expression <- cohortConceptSetsSelectedFirst()$expression data <- getOptimizationRecommendationForConceptSetExpression(dataSource = dataSource, conceptSetExpression = expression) + data <- data %>% + dplyr::filter(.data$conceptId != 0) + optimizedConceptIds <- data$conceptId %>% unique() + optimizedConceptIdCounts <- getConceptPrevalenceCountsForConceptIds(dataSource = dataSource, + conceptIdsList = optimizedConceptIds) + data <- data %>% + dplyr::left_join(y = optimizedConceptIdCounts, by = "conceptId") %>% + dplyr::arrange(.data$ddbc) %>% + dplyr::distinct() return(data) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) output$optimizedConceptSetExpressionDtRetainedFirst <- @@ -659,7 +1015,7 @@ shiny::shinyServer(function(input, output, session) { dataTable <- standardDataTable(data = data) return(dataTable) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) output$optimizedConceptSetExpressionDtRemovedFirst <- @@ -674,7 +1030,7 @@ shiny::shinyServer(function(input, output, session) { dataTable <- standardDataTable(data = data) return(dataTable) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) @@ -684,9 +1040,16 @@ shiny::shinyServer(function(input, output, session) { expression <- cohortConceptSetsSelectedSecond()$expression data <- getOptimizationRecommendationForConceptSetExpression(dataSource = dataSource, conceptSetExpression = expression) + data <- data %>% + dplyr::filter(.data$conceptId != 0) + optimizedConceptIds <- data$conceptId %>% unique() + optimizedConceptIdCounts <- getConceptPrevalenceCountsForConceptIds(dataSource = dataSource, + conceptIdsList = optimizedConceptIds) + data <- data %>% + dplyr::left_join(y = optimizedConceptIdCounts, by = "conceptId") %>% + dplyr::arrange(.data$ddbc) %>% + dplyr::distinct() return(data) - } else { - return(NULL) } }) output$optimizedConceptSetExpressionDtRetainedSecond <- @@ -701,7 +1064,7 @@ shiny::shinyServer(function(input, output, session) { dataTable <- standardDataTable(data = data) return(dataTable) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) output$optimizedConceptSetExpressionDtRemovedSecond <- @@ -716,7 +1079,7 @@ shiny::shinyServer(function(input, output, session) { dataTable <- standardDataTable(data = data) return(dataTable) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) @@ -733,10 +1096,14 @@ shiny::shinyServer(function(input, output, session) { if (length(conceptIds) > 0) { data <- loadRecommenderStandardFromDatabase(dataSource = dataSource, conceptList = conceptIds) + data <- data %>% + dplyr::filter(.data$conceptId != 0) %>% + dplyr::distinct() } } return(data) }) + recommendedConceptSetExpressionSourceReactiveFirst <- shiny::reactive(x = { data <- NULL @@ -746,7 +1113,8 @@ shiny::shinyServer(function(input, output, session) { conceptIds <- c(resolvedConcepts$conceptId, mappedConcepts$conceptId) %>% unique() if (length(conceptIds) > 0) { data <- loadRecommenderSourceFromDatabase(dataSource = dataSource, - conceptList = conceptIds) + conceptList = conceptIds) %>% + dplyr::distinct() } } return(data) @@ -754,12 +1122,24 @@ shiny::shinyServer(function(input, output, session) { output$recommendedConceptSetExpressionDtStandardFirst <- DT::renderDT(expr = { data <- recommendedConceptSetExpressionStandardReactiveFirst() + data <- data %>% + dplyr::rename(id = .data$conceptId, + name = .data$conceptName, + standard = .data$standardConcept, + rc = .data$recordCount, + dbc = .data$databaseCount, + drc = .data$descendantRecordCount, + ddbc = .data$descendantDatabaseCount) %>% + dplyr::select(.data$conceptInSet, .data$id, .data$name, + .data$rc, .data$drc, .data$dbc, .data$ddbc, + .data$vocabularyId, .data$domainId, .data$standard) %>% + dplyr::arrange(dplyr::desc(.data$drc)) if (!is.null(data) && nrow(data) > 0) { dataTable <- standardDataTable(data = data) return(dataTable) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) output$recommendedConceptSetExpressionDtSourceFirst <- @@ -770,7 +1150,7 @@ shiny::shinyServer(function(input, output, session) { dataTable <- standardDataTable(data = data) return(dataTable) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) recommendedConceptSetExpressionStandardReactiveSecond <- @@ -782,7 +1162,8 @@ shiny::shinyServer(function(input, output, session) { conceptIds <- c(resolvedConcepts$conceptId, mappedConcepts$conceptId) %>% unique() if (length(conceptIds) > 0) { data <- loadRecommenderStandardFromDatabase(dataSource = dataSource, - conceptList = conceptIds) + conceptList = conceptIds) %>% + dplyr::distinct() } } return(data) @@ -796,7 +1177,8 @@ shiny::shinyServer(function(input, output, session) { conceptIds <- c(resolvedConcepts$conceptId, mappedConcepts$conceptId) %>% unique() if (length(conceptIds) > 0) { data <- loadRecommenderSourceFromDatabase(dataSource = dataSource, - conceptList = conceptIds) + conceptList = conceptIds) %>% + dplyr::distinct() } } return(data) @@ -806,10 +1188,22 @@ shiny::shinyServer(function(input, output, session) { data <- recommendedConceptSetExpressionStandardReactiveSecond() if (!is.null(data) && nrow(data) > 0) { + data <- data %>% + dplyr::rename(id = .data$conceptId, + name = .data$conceptName, + standard = .data$standardConcept, + rc = .data$recordCount, + dbc = .data$databaseCount, + drc = .data$descendantRecordCount, + ddbc = .data$descendantDatabaseCount) %>% + dplyr::select(.data$conceptInSet, .data$id, .data$name, + .data$rc, .data$drc, .data$dbc, .data$ddbc, + .data$vocabularyId, .data$domainId, .data$standard) %>% + dplyr::arrange(dplyr::desc(.data$drc)) dataTable <- standardDataTable(data = data) return(dataTable) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) output$recommendedConceptSetExpressionDtSourceSecond <- @@ -820,7 +1214,7 @@ shiny::shinyServer(function(input, output, session) { dataTable <- standardDataTable(data = data) return(dataTable) } else { - return(NULL) + return(dplyr::tibble("No recommendation")) } }) @@ -1352,6 +1746,7 @@ shiny::shinyServer(function(input, output, session) { choices = temporalCharacterizationDomainFilter() %>% sort(), selected = temporalCharacterizationDomainFilter() ) + rvCharacterizationPrettyTableGenerated(FALSE) } ) showAllMenuItem(TRUE) @@ -1658,7 +2053,7 @@ shiny::shinyServer(function(input, output, session) { names_from = .data$databaseId) } else { data <- data %>% - dplyr::select(-.data$cohortSubjects) %>% + dplyr::select(-.data$cohortEntries) %>% tidyr::pivot_wider(id_cols = c(.data$cohortId, .data$cohortName), values_from = .data$cohortSubjects, names_from = .data$databaseId) @@ -2079,7 +2474,11 @@ shiny::shinyServer(function(input, output, session) { ) data <- inclusionRuleTablePreFetch() %>% dplyr::inner_join(y = filter, - by = c("cohortId", "databaseId")) + by = c("cohortId", "databaseId")) %>% + dplyr::mutate(meetPercent = .data$meetSubjects/.data$totalSubjects, + gainPercent = .data$gainSubjects/.data$totalSubjects, + remainPercent = .data$remainSubjects/.data$totalSubjects) %>% + dplyr::arrange(dplyr::desc(.data$remainPercent)) } else { data <- dplyr::tibble() } @@ -2134,8 +2533,50 @@ shiny::shinyServer(function(input, output, session) { { isPhenotypeLibraryMode <- exists("phenotypeDescription") && nrow(phenotypeDescription) > 0 data <- - addMetaDataInformationToResults(data = indexEventBreakDownDataFiltered(), isPhenotypeLibraryMode = isPhenotypeLibraryMode) %>% - dplyr::arrange(dplyr::desc(.data$percent)) + addMetaDataInformationToResults(data = indexEventBreakDownDataFiltered(), + isPhenotypeLibraryMode = isPhenotypeLibraryMode) + if ('conceptCount' %in% colnames(data)) { + data <- data %>% + dplyr::mutate(percentEntries = round(x = (.data$conceptCount/.data$cohortEntries)*100, digits = 2)) %>% + dplyr::arrange(dplyr::desc(.data$percentEntries)) + } + if ('subjectCount' %in% colnames(data)) { + data <- data %>% + dplyr::mutate(percentSubjects = round(x = (.data$subjectCount/.data$cohortEntries)*100, digits = 2)) + } else { + data <- data %>% + dplyr::mutate(percentSubjects = NA) + } + + if (input$pivotIndexEventBreakDown == 'None') { + data <- data %>% + dplyr::mutate(percentEntries = percentEntries/100, + percentSubjects = percentSubjects/100) + } else if (input$pivotIndexEventBreakDown == 'Concept count') { + if ('phenotypeId' %in% colnames(data)) { + data <- pivotIndexBreakDownData(data = data, variable = 'conceptCount', phenotypeLibraryMode = TRUE) + } else { + data <- pivotIndexBreakDownData(data = data, variable = 'conceptCount', phenotypeLibraryMode = FALSE) + } + } else if (input$pivotIndexEventBreakDown == 'Subject count') { + if ('phenotypeId' %in% colnames(data)) { + data <- pivotIndexBreakDownData(data = data, variable = 'subjectCount', phenotypeLibraryMode = TRUE) + } else { + data <- pivotIndexBreakDownData(data = data, variable = 'subjectCount', phenotypeLibraryMode = FALSE) + } + } else if (input$pivotIndexEventBreakDown == 'Percent entries') { + if ('phenotypeId' %in% colnames(data)) { + data <- pivotIndexBreakDownData(data = data, variable = 'percentEntries', phenotypeLibraryMode = TRUE) + } else { + data <- pivotIndexBreakDownData(data = data, variable = 'percentEntries', phenotypeLibraryMode = FALSE) + } + } else if (input$pivotIndexEventBreakDown == 'Percent persons') { + if ('phenotypeId' %in% colnames(data)) { + data <- pivotIndexBreakDownData(data = data, variable = 'percentSubjects', phenotypeLibraryMode = TRUE) + } else { + data <- pivotIndexBreakDownData(data = data, variable = 'percentSubjects', phenotypeLibraryMode = FALSE) + } + } dataTable <- standardDataTable(data) return(dataTable) }) @@ -2253,34 +2694,14 @@ shiny::shinyServer(function(input, output, session) { .data$isBinary), by = "analysisId" ) + data <- data %>% + tidyr::replace_na(list(domainId = 'Other', analysisName = 'Other')) return(data) }) - characterizationAnalysisNameFilter <- shiny::reactive(x = { - if (nrow(characterizationDataFilterOptions()) > 0) { - characterizationAnalysisNameFilter <- - characterizationDataFilterOptions()$analysisName %>% unique() - return(characterizationAnalysisNameFilter) - } else { - return(NULL) - } - }) - characterizationDomainFilter <- shiny::reactive(x = { - if (nrow(characterizationDataFilterOptions()) > 0) { - characterizationDomainFilter <- - characterizationDataFilterOptions()$domainId %>% unique() - return(characterizationDomainFilter) - } else { - return(NULL) - } - }) characterizationDataFiltered <- shiny::reactive(x = { dataFilterOptions <- - characterizationDataFilterOptions() %>% - dplyr::filter( - analysisName %in% input$characterizationAnalysisNameFilter, - domainId %in% input$characterizationDomainFilter - ) + characterizationDataFilterOptions() filter <- combinationToFilterPreFetchDataBasedOnUserChoiceCohortIdDatabaseId() %>% dplyr::filter( .data$cohortId %in% selectedCohortIds(), .data$databaseId %in% selectedDatabaseIds() @@ -2304,11 +2725,60 @@ shiny::shinyServer(function(input, output, session) { return(data) }) - characterizationTablePretty <- shiny::reactive(x = { - data <- characterizationDataFiltered() + characterizationAnalysisNameFilter <- shiny::reactive(x = { + if (nrow(characterizationDataFilterOptions()) > 0) { + characterizationAnalysisNameFilter <- + characterizationDataFilterOptions() %>% + dplyr::select(.data$analysisName) %>% + tidyr::replace_na(list(analysisName = 'Other')) %>% + unique() %>% + dplyr::pull() + return(characterizationAnalysisNameFilter) + } else { + return(NULL) + } + }) + + characterizationDomainFilter <- shiny::reactive(x = { + if (nrow(characterizationDataFilterOptions()) > 0) { + characterizationDomainFilter <- + characterizationDataFilterOptions() %>% + dplyr::select(.data$domainId) %>% + tidyr::replace_na(list(domainId = 'Other')) %>% + unique() %>% + dplyr::pull() + return(characterizationDomainFilter) + } else { + return(NULL) + } + }) + + characterizationTableRaw <- shiny::reactive(x = { + data <- characterizationDataFiltered() %>% + dplyr::filter(.data$domainId %in% input$characterizationDomainFilter) %>% + dplyr::filter(.data$analysisName %in% input$characterizationAnalysisNameFilter) if (nrow(data) > 0) { isPhenotypeLibraryMode <- exists("phenotypeDescription") && nrow(phenotypeDescription) > 0 data <- addMetaDataInformationToResults(data = data, isPhenotypeLibraryMode = isPhenotypeLibraryMode) + } + return(data) + }) + + output$characterizationTableRaw <- + DT::renderDT(expr = { + shiny::withProgress(message = 'Rendering characterization data table.', value = 0, { + data <- characterizationTableRaw() + if (nrow(data) > 0) { + table <- standardDataTable(data = characterizationTableRaw()) + } + return(table) + }) + }, server = TRUE) + + + characterizationTablePretty <- shiny::reactive(x = { + data <- characterizationDataFiltered() + if (nrow(data) > 0) { analysisIds <- prettyAnalysisIds table <- data %>% prepareTable1() %>% @@ -2355,41 +2825,67 @@ shiny::shinyServer(function(input, output, session) { dplyr::arrange(.data$databaseId, .data$cohortId, .data$sortOrder) %>% dplyr::select(-.data$position, -.data$header) %>% dplyr::relocate(.data$sortOrder, .after = dplyr::last_col()) + + rvCharacterizationPrettyTableGenerated(TRUE) + } else { data <- dplyr::tibble() } return(data) }) - output$characterizationTablePrettyDt <- + + output$characterizationTablePrettyDt <- DT::renderDT(expr = { shiny::withProgress(message = 'Rendering characterization data table.', value = 0, { - data <- characterizationTablePretty() + data <- characterizationTablePretty() if (nrow(data) > 0) { isPhenotypeLibraryMode <- exists("phenotypeDescription") && nrow(phenotypeDescription) > 0 data <- addMetaDataInformationToResults(data = data, isPhenotypeLibraryMode = isPhenotypeLibraryMode) - table <- standardDataTable(data = data) + + if (rvCharacterizationPrettyTableGenerated()) { + # data <- data %>% ## WHY IS IT NOT WORKING? + # dplyr::filter(.data$databaseId %in% input$characterizationTablePrettyDtDropDownDatabase) %>% + # dplyr::filter(.data$cohortId %in% input$characterizationTablePrettyDtDropDownCohort) + } + table <- standardDataTable(data = data, pageLength = -1) return(table) } }) }, server = TRUE) - output$characterizationTableRaw <- - DT::renderDT(expr = { - shiny::withProgress(message = 'Rendering characterization data table.', value = 0, { - data <- characterizationDataFiltered() - if (nrow(data) > 0) { - isPhenotypeLibraryMode <- exists("phenotypeDescription") && nrow(phenotypeDescription) > 0 - data <- addMetaDataInformationToResults(data = data, isPhenotypeLibraryMode = isPhenotypeLibraryMode) - } - table <- standardDataTable(data = data) - return(table) - }) - }, server = TRUE) + characterizationPrettyDatabaseFilter <- shiny::reactive(x = { + if (nrow(characterizationTablePretty()) > 0) { + characterizationPrettyDatabaseFilter <- + characterizationTablePretty()$databaseId %>% + unique() %>% + sort() + return(characterizationPrettyDatabaseFilter) + } else { + return(NULL) + } + }) + + characterizationPrettyCohortFilter <- shiny::reactive(x = { + if (nrow(characterizationTablePretty()) > 0) { + characterizationPrettyCohortFilter <- + cohort %>% dplyr::inner_join(characterizationTablePretty() %>% + dplyr::select(.data$cohortId), + by = "cohortId") %>% + dplyr::pull(.data$cohortName) %>% + unique() %>% + sort() + return(characterizationPrettyCohortFilter) + } else { + return(NULL) + } + }) shiny::observeEvent(eventExpr = { - (!is.null(input$tabs) && input$tabs == "cohortCharacterization") + (!is.null(input$tabs) && + input$tabs == "cohortCharacterization" && + isTRUE(rvCharacterizationPrettyTableGenerated())) }, handlerExpr = { shinyWidgets::updatePickerInput( @@ -2404,6 +2900,14 @@ shiny::shinyServer(function(input, output, session) { choices = characterizationDomainFilter() %>% sort(), selected = characterizationDomainFilter() ) + }) + + + + shiny::observeEvent(eventExpr = { + (!is.null(input$tabs) && input$tabs == "cohortCharacterization") + }, + handlerExpr = { shinyWidgets::updatePickerInput( session = session, inputId = "characterizationTablePrettyDtDropDownDatabase", @@ -2414,32 +2918,10 @@ shiny::shinyServer(function(input, output, session) { session = session, inputId = "characterizationTablePrettyDtDropDownCohort", choices = characterizationPrettyCohortFilter(), - selected = characterizationPrettyDatabaseFilter()[1] + selected = characterizationPrettyCohortFilter()[1] ) }) - - characterizationPrettyDatabaseFilter <- shiny::reactive(x = { - if (nrow(characterizationTablePretty()) > 0) { - characterizationPrettyDatabaseFilter <- - characterizationTablePretty()$databaseId %>% - unique() %>% - sort() - return(characterizationPrettyDatabaseFilter) - } else { - return(NULL) - } - }) - characterizationPrettyCohortFilter <- shiny::reactive(x = { - if (nrow(characterizationTablePretty()) > 0) { - characterizationPrettyCohortFilter <- - characterizationTablePretty()$cohortName %>% - unique() %>% - sort() - return(characterizationPrettyCohortFilter) - } else { - return(NULL) - } - }) + # output$characterizationTable <- diff --git a/MskaiCohortDiagnostics/sql/RecommendationSource.sql b/MskaiCohortDiagnostics/sql/RecommendationSource.sql index a948490d..f3ab93c1 100644 --- a/MskaiCohortDiagnostics/sql/RecommendationSource.sql +++ b/MskaiCohortDiagnostics/sql/RecommendationSource.sql @@ -7,13 +7,13 @@ select distinct c2.concept_id, c2.concept_name, c2.domain_id, c2.vocabulary_id, cp2.drc as descendant_record_count, cp2.ddbc as descendant_database_count, c.concept_id as source_concept_id, c.concept_name as source_concept_name, c.vocabulary_id as source_vocabulary_id, c.concept_code as source_concept_code, cp.rc as source_record_count, cp.dbc as source_database_count from list l -join @results_database_schema.recommender_set r on l.concept_id = r.source_id +join concept_prevalence.recommender_set r on l.concept_id = r.source_id join @vocabulary_database_schema.concept c on c.concept_id = r.concept_id and c.standard_concept is null -join @results_database_schema.cp_master cp on cp.concept_id = c.concept_id +join concept_prevalence.cp_master cp on cp.concept_id = c.concept_id join @vocabulary_database_schema.concept_relationship cr on cr.concept_id_1 = c.concept_id and cr.relationship_id in ('Maps to','Maps to value') join @vocabulary_database_schema.concept c2 on c2.concept_id = cr.concept_id_2 and c2.standard_concept = 'S' -join @results_database_schema.cp_master cp2 on cp2.concept_id = c2.concept_id -left join @results_database_schema.recommended_blacklist rb on c2.concept_id = rb.concept_id +join concept_prevalence.cp_master cp2 on cp2.concept_id = c2.concept_id +left join concept_prevalence.recommended_blacklist rb on c2.concept_id = rb.concept_id where rb.concept_id is null and not exists (select 1 from list l2 join @vocabulary_database_schema.concept_relationship cr1 on l2.concept_id = cr1.concept_id_2 and cr1.relationship_id = 'Maps to' diff --git a/MskaiCohortDiagnostics/sql/RecommendationStandard.sql b/MskaiCohortDiagnostics/sql/RecommendationStandard.sql index 695b6886..4710fa56 100644 --- a/MskaiCohortDiagnostics/sql/RecommendationStandard.sql +++ b/MskaiCohortDiagnostics/sql/RecommendationStandard.sql @@ -11,12 +11,12 @@ recommendations as ( --find not included concepts found by orphan check via standards select rc1.concept_id, 'Not included - recommended via standard' as concept_in_set from list i - join @results_database_schema.recommender_set rc1 on i.concept_id = rc1.source_id + join concept_prevalence.recommender_set rc1 on i.concept_id = rc1.source_id join @vocabulary_database_schema.concept c1 on rc1.concept_id = c1.concept_id and c1.standard_concept = 'S' union select cr1.concept_id_2, 'Not included - recommended via source' as concept_in_set from list i - join @results_database_schema.recommender_set rc1 on i.concept_id = rc1.source_id + join concept_prevalence.recommender_set rc1 on i.concept_id = rc1.source_id join @vocabulary_database_schema.concept c1 on rc1.concept_id = c1.concept_id and c1.standard_concept is null join @vocabulary_database_schema.concept_relationship cr1 on c1.concept_id = cr1.concept_id_1 and cr1.relationship_id in ('Maps to', 'Maps to value') -- excluding those sources that already have one standard counterpart in our input list @@ -41,8 +41,8 @@ select c.concept_id, c.concept_name, c.vocabulary_id, c.domain_id, c.standard_c coalesce(cp.dbc,0) as database_count, coalesce(cp.drc,0) as descendant_record_count, coalesce(cp.ddbc,0) as descendant_database_count from recommendations r join @vocabulary_database_schema.concept c on c.concept_id = r.concept_id -left join @results_database_schema.cp_master cp on r.concept_id = cp.concept_id -left join @results_database_schema.recommended_blacklist rb on r.concept_id = rb.concept_id +left join concept_prevalence.cp_master cp on r.concept_id = cp.concept_id +left join concept_prevalence.recommended_blacklist rb on r.concept_id = rb.concept_id where (rb.concept_id is null and not exists (select 1 from list l join @vocabulary_database_schema.concept_relationship cr1 on l.concept_id = cr1.concept_id_2 and cr1.relationship_id = 'Maps to' diff --git a/MskaiCohortDiagnostics/sql/SearchVocabularyForConcepts.sql b/MskaiCohortDiagnostics/sql/SearchVocabularyForConcepts.sql index 7c345e22..c9374d9e 100644 --- a/MskaiCohortDiagnostics/sql/SearchVocabularyForConcepts.sql +++ b/MskaiCohortDiagnostics/sql/SearchVocabularyForConcepts.sql @@ -26,5 +26,5 @@ SELECT c.CONCEPT_ID, ISNULL(universe.DDBC, 0) DDBC FROM @vocabulary_database_schema.concept c INNER JOIN matched_concepts ON c.concept_id = matched_concepts.concept_id -LEFT JOIN @results_database_schema.universe ON c.concept_id = universe.concept_id +LEFT JOIN concept_prevalence.universe ON c.concept_id = universe.concept_id ORDER BY ISNULL(universe.DRC, 0) DESC; \ No newline at end of file diff --git a/MskaiCohortDiagnostics/ui.R b/MskaiCohortDiagnostics/ui.R index 1ca3b482..b19e2298 100644 --- a/MskaiCohortDiagnostics/ui.R +++ b/MskaiCohortDiagnostics/ui.R @@ -169,232 +169,8 @@ bodyTabItems <- shinydashboard::tabItems( inline = TRUE ) ), - column( - 6, - conditionalPanel( - "output.cohortSearchResultsCountOfSelected > 0&input.compareCohorts=='No Comparision'", - shiny::tabsetPanel( - id = "cohortDetails", - type = "tab", - shiny::tabPanel(title = "Description", - value = "descriptionFirst", - copyToClipboardButton(toCopyId = "cohortDetailsTextFirst", - style = "margin-top: 5px; margin-bottom: 5px;"), - shiny::htmlOutput("cohortDetailsTextFirst")), - shiny::tabPanel( - value = "cohortDefinitionFirst", - title = "Cohort definition", - copyToClipboardButton(toCopyId = "cohortDefinitionDetailsFirst", - style = "margin-top: 5px; margin-bottom: 5px;"), - shiny::htmlOutput(outputId = "cohortDefinitionDetailsFirst") - ), - shiny::tabPanel( - value = "cohortDefinitionConceptsetFirst", - title = "Concept Sets", - DT::DTOutput(outputId = "cohortDefinitionConceptSetsTableFirst"), - shiny::conditionalPanel( - condition = "output.cohortConceptSetsSelectedFirstRowIsSelected == true", - shiny::tabsetPanel( - id = "conceptsetExpressionTabFirst", - shiny::tabPanel( - value = "conceptsetExpressionFirst", - title = "Expression", - DT::DTOutput(outputId = "cohortConceptsetExpressionDataTableFirst") - ), - shiny::tabPanel( - value = "conceptsetExpressionJsonFirst", - title = "Json", - copyToClipboardButton(toCopyId = "cohortConceptsetExpressionJsonFirst", - style = "margin-top: 5px; margin-bottom: 5px;"), - shiny::verbatimTextOutput(outputId = "cohortConceptsetExpressionJsonFirst"), - tags$head( - tags$style( - "#cohortConceptsetExpressionJsonFirst { max-height:400px};" - ) - ) - ), - shiny::tabPanel( - value = "conceptsetExpressionResoledFirst", - title = "Resolved", - shiny::tabsetPanel( - shiny::tabPanel( - title = "Standard", - DT::DTOutput(outputId = "resolvedConceptSetExpressionDtStandardFirst") - ), - shiny::tabPanel( - title = "Mapped", - DT::DTOutput(outputId = "resolvedConceptSetExpressionDtMappedFirst") - )), - ), - shiny::tabPanel( - value = "conceptsetExpressionOptimizedFirst", - title = "Optimized", - shiny::tabsetPanel( - shiny::tabPanel( - title = "Retained", - DT::DTOutput(outputId = "optimizedConceptSetExpressionDtRetainedFirst") - ), - shiny::tabPanel( - title = "Removed", - DT::DTOutput(outputId = "optimizedConceptSetExpressionDtRemovedFirst") - )), - ), - shiny::tabPanel( - value = "conceptsetExpressionRecommendedFirst", - title = "Recommended", - shiny::tabsetPanel( - shiny::tabPanel( - title = "Standard", - DT::DTOutput(outputId = "recommendedConceptSetExpressionDtStandardFirst") - ), - shiny::tabPanel( - title = "Non Standard", - DT::DTOutput(outputId = "recommendedConceptSetExpressionDtSourceFirst") - )), - ) - ) - ) - ), - shiny::tabPanel( - value = "cohortDefinitionJsonFirst", - title = "JSON", - copyToClipboardButton(toCopyId = "cohortDefinitionJsonFirst", - style = "margin-top: 5px; margin-bottom: 5px;"), - shiny::verbatimTextOutput(outputId = "cohortDefinitionJsonFirst"), - tags$head( - tags$style( - "#cohortDefinitionJsonFirst { max-height:400px};" - ) - ) - ), - shiny::tabPanel( - value = "cohortDefinitionSqlFirst", - title = "SQL", - copyToClipboardButton(toCopyId = "cohortDefinitionSqlFirst", - style = "margin-top: 5px; margin-bottom: 5px;"), - shiny::verbatimTextOutput(outputId = "cohortDefinitionSqlFirst"), - tags$head( - tags$style( - "#cohortDefinitionSqlFirst { max-height:400px};" - ) - ) - ) - ) - ) - ), - column( - 6, - conditionalPanel( - "output.cohortSearchResultsCountOfSelected == 2&input.compareCohorts=='No Comparision'", - shiny::tabsetPanel( - id = "cohortDetailsSecond", - type = "tab", - shiny::tabPanel(title = "Description", - value = "descriptionSecond", - copyToClipboardButton(toCopyId = "cohortDetailsTextSecond", - style = "margin-top: 5px; margin-bottom: 5px;"), - shiny::htmlOutput(outputId = "cohortDetailsTextSecond")), - shiny::tabPanel( - value = "cohortDefinitionSecond", - title = "Cohort definition", - copyToClipboardButton(toCopyId = "cohortDefinitionDetailsSecond", - style = "margin-top: 5px; margin-bottom: 5px;"), - shiny::htmlOutput(outputId = "cohortDefinitionDetailsSecond") - ), - shiny::tabPanel( - value = "cohortDefinitionConceptsetSecond", - title = "Concept Sets", - DT::DTOutput(outputId = "cohortDefinitionConceptSetsTableSecond"), - shiny::conditionalPanel( - condition = "output.cohortConceptSetsSelectedSecondRowIsSelected == true", - shiny::tabsetPanel( - id = "conceptsetExpressionTabSecond", - shiny::tabPanel( - value = "conceptsetExpressionSecond", - title = "Expression", - DT::DTOutput(outputId = "cohortConceptsetExpressionDataTableSecond") - ), - shiny::tabPanel( - value = "conceptetExpressionJsonSecond", - title = "Json", - copyToClipboardButton(toCopyId = "cohortConceptsetExpressionJsonSecond", - style = "margin-top: 5px; margin-bottom: 5px;"), - shiny::verbatimTextOutput(outputId = "cohortConceptsetExpressionJsonSecond"), - tags$head( - tags$style( - "#cohortConceptsetExpressionJsonSecond { max-height:400px};" - ) - ) - ), - shiny::tabPanel( - value = "conceptsetExpressionResolvedSecond", - title = "Resolved", - shiny::tabsetPanel( - shiny::tabPanel( - title = "Standard", - DT::DTOutput(outputId = "resolvedConceptSetExpressionDtStandardSecond") - ), - shiny::tabPanel( - title = "Mapped", - DT::DTOutput(outputId = "resolvedConceptSetExpressionDtMappedSecond") - )), - ), - shiny::tabPanel( - value = "conceptsetExpressionOptimizedSecond", - title = "Optimized", - shiny::tabsetPanel( - shiny::tabPanel( - title = "Retained", - DT::DTOutput(outputId = "optimizedConceptSetExpressionDtRetainedSecond") - ), - shiny::tabPanel( - title = "Removed", - DT::DTOutput(outputId = "optimizedConceptSetExpressionDtRemovedSecond") - )), - ), - shiny::tabPanel( - value = "conceptsetExpressionRecommendedSecond", - title = "Recommended", - shiny::tabsetPanel( - shiny::tabPanel( - title = "Standard", - DT::DTOutput(outputId = "recommendedConceptSetExpressionDtStandardSecond") - ), - shiny::tabPanel( - title = "Non Standard", - DT::DTOutput(outputId = "recommendedConceptSetExpressionDtSourceSecond") - )), - ) - ) - ) - ), - shiny::tabPanel( - value = "cohortDefinitionJsonSecond", - title = "JSON", - copyToClipboardButton(toCopyId = "cohortDefinitionJsonSecond", - style = "margin-top: 5px; margin-bottom: 5px;"), - shiny::verbatimTextOutput("cohortDefinitionJsonSecond"), - tags$head( - tags$style( - "#cohortDefinitionJsonSecond { max-height:400px};" - ) - ) - ), - shiny::tabPanel( - value = "cohortDefinitionSqlSecond", - title = "SQL", - copyToClipboardButton(toCopyId = "cohortDefinitionSqlSecond", - style = "margin-top: 5px; margin-bottom: 5px;"), - shiny::verbatimTextOutput("cohortDefinitionSqlSecond"), - tags$head( - tags$style( - "#cohortDefinitionSqlSecond { max-height:400px};" - ) - ) - ) - ) - ) - ), + shiny::uiOutput(outputId = "dynamicUIGenerationCohortDetailsOne"), + shiny::uiOutput(outputId = "dynamicUIGenerationCohortDetailsTwo"), column( 12, conditionalPanel( @@ -605,6 +381,18 @@ bodyTabItems <- shinydashboard::tabItems( ), shinydashboard::tabItem( tabName = "indexEventBreakdown", + shiny::radioButtons( + inputId = "pivotIndexEventBreakDown", + label = "Pivot data over data sources with value from", + selected = "Percent entries", + inline = TRUE, + choices = c( + "None", + "Concept count", + "Subject count", + "Percent entries", + "Percent persons" + )), shinydashboard::box( title = "Data", width = NULL, @@ -639,30 +427,6 @@ bodyTabItems <- shinydashboard::tabItems( ), shinydashboard::tabItem( tabName = "cohortCharacterization", - shinydashboard::box( - title = NULL, - width = NULL, - status = "primary", - collapsible = FALSE, - shiny::column(width = 6, - shinyWidgets::pickerInput( - inputId = "characterizationAnalysisNameFilter", - label = "Analysis Choices", - choices = NULL, - multiple = TRUE, - inline = FALSE, - options = shinyWidgetsPickerOptions - )), - shiny::column(width = 6, - shinyWidgets::pickerInput( - inputId = "characterizationDomainFilter", - label = "Domain Choices", - choices = NULL, - multiple = TRUE, - inline = FALSE, - options = shinyWidgetsPickerOptions - )) - ), shinydashboard::box( title = "Data (Pretty)", width = NULL, @@ -672,7 +436,7 @@ bodyTabItems <- shinydashboard::tabItems( shiny::column(width = 4, shinyWidgets::pickerInput( inputId = "characterizationTablePrettyDtDropDownDatabase", - label = "Database", + label = "Database (not working)", choices = NULL, multiple = FALSE, inline = FALSE, @@ -681,7 +445,7 @@ bodyTabItems <- shinydashboard::tabItems( shiny::column(width = 4, shinyWidgets::pickerInput( inputId = "characterizationTablePrettyDtDropDownCohort", - label = "Cohort", + label = "Cohort (not working)", choices = NULL, multiple = FALSE, inline = FALSE, @@ -696,6 +460,30 @@ bodyTabItems <- shinydashboard::tabItems( status = "primary", collapsible = TRUE, collapsed = TRUE, + shinydashboard::box( + title = NULL, + width = NULL, + status = "primary", + collapsible = FALSE, + shiny::column(width = 6, + shinyWidgets::pickerInput( + inputId = "characterizationAnalysisNameFilter", + label = "Analysis Choices", + choices = NULL, + multiple = TRUE, + inline = FALSE, + options = shinyWidgetsPickerOptions + )), + shiny::column(width = 6, + shinyWidgets::pickerInput( + inputId = "characterizationDomainFilter", + label = "Domain Choices", + choices = NULL, + multiple = TRUE, + inline = FALSE, + options = shinyWidgetsPickerOptions + )) + ), DT::DTOutput("characterizationTableRaw") ) ), diff --git a/PhenotypeLibrary2/R/HelperFunctions.R b/PhenotypeLibrary2/R/HelperFunctions.R index b559c575..f5db108a 100644 --- a/PhenotypeLibrary2/R/HelperFunctions.R +++ b/PhenotypeLibrary2/R/HelperFunctions.R @@ -8,7 +8,8 @@ cohortReference <- function(outputId) { standardDataTable <- function(data, selectionMode = "single", selected = c(1), - searching = TRUE) { + searching = TRUE, + pageLength = 10) { dataTableFilter = list(position = 'top', @@ -17,7 +18,7 @@ standardDataTable <- function(data, dataTableOption = list( - pageLength = 10, + pageLength = pageLength, lengthMenu = list(c(5, 10, 20, -1), c("5", "10", "20", "All")), lengthChange = TRUE, searching = searching, @@ -287,19 +288,23 @@ pivotIndexBreakDownData <- function(data, variable, phenotypeLibraryMode = TRUE) pivotByPhenotypeCohort <- c('phenotypeId', 'phenotypeName', 'cohortId', 'cohortName', 'conceptId', 'conceptName') pivotByCohort <- c('cohortId', 'cohortName', 'conceptId', 'conceptName') if (phenotypeLibraryMode) { - data <- data %>% - dplyr::select(pivotByPhenotypeCohort, 'databaseId', variable) %>% - tidyr::pivot_wider(id_cols = pivotByPhenotypeCohort, - values_from = variable, - names_from = 'databaseId', - values_fill = 0) + if (nrow(data) > 0) { + data <- data %>% + dplyr::select(dplyr::all_of(pivotByPhenotypeCohort), 'databaseId', dplyr::all_of(variable)) %>% + tidyr::pivot_wider(id_cols = pivotByPhenotypeCohort, + values_from = dplyr::all_of(variable), + names_from = 'databaseId', + values_fill = 0) + } else {dplyr::tibble('no data')} } else { + if (nrow(data) > 0) { data <- data %>% - dplyr::select(pivotByCohort, 'databaseId', variable) %>% + dplyr::select(dplyr::all_of(pivotByCohort), 'databaseId', dplyr::all_of(variable)) %>% tidyr::pivot_wider(id_cols = pivotByCohort, - values_from = variable, + values_from = dplyr::all_of(variable), names_from = 'databaseId', values_fill = 0) + } else {dplyr::tibble('no data')} } return(data) } \ No newline at end of file diff --git a/PhenotypeLibrary2/global.R b/PhenotypeLibrary2/global.R index 2c1b0c34..2d649e24 100644 --- a/PhenotypeLibrary2/global.R +++ b/PhenotypeLibrary2/global.R @@ -6,19 +6,19 @@ library(magrittr) # reactlog::reactlog_enable() appVersion <- "Running Cohort Diagnostics 2.1.0" -# userName <- Sys.getenv("phoebedbUser") -# password <- Sys.getenv("phoebedbPw") -# databaseServer <- Sys.getenv("phoebedbServer") -# databaseName <- Sys.getenv("phoebedb") -# resultsSchema <- Sys.getenv("phoebedbTargetSchema") -# vocabularySchema <- Sys.getenv("phoebedbVocabSchema") - -userName <- Sys.getenv("charybdisdbUser") -password <- Sys.getenv("charybdisdbPw") -databaseServer <- Sys.getenv("shinydbServer") -databaseName <- Sys.getenv("shinydbDatabase") -resultsSchema <- 'aesi3' -vocabularySchema <- 'vocabulary' +userName <- Sys.getenv("phoebedbUser") +password <- Sys.getenv("phoebedbPw") +databaseServer <- Sys.getenv("phoebedbServer") +databaseName <- Sys.getenv("phoebedb") +resultsSchema <- Sys.getenv("phoebedbTargetSchema") +vocabularySchema <- Sys.getenv("phoebedbVocabSchema") + +# userName <- Sys.getenv("charybdisdbUser") +# password <- Sys.getenv("charybdisdbPw") +# databaseServer <- Sys.getenv("shinydbServer") +# databaseName <- Sys.getenv("shinydbDatabase") +# resultsSchema <- 'mskai' +# vocabularySchema <- 'vocabulary' source("R/DisplayFunctions.R") diff --git a/PhenotypeLibrary2/server.R b/PhenotypeLibrary2/server.R index 8e1c94e8..660eb53c 100644 --- a/PhenotypeLibrary2/server.R +++ b/PhenotypeLibrary2/server.R @@ -2053,7 +2053,7 @@ shiny::shinyServer(function(input, output, session) { names_from = .data$databaseId) } else { data <- data %>% - dplyr::select(-.data$cohortSubjects) %>% + dplyr::select(-.data$cohortEntries) %>% tidyr::pivot_wider(id_cols = c(.data$cohortId, .data$cohortName), values_from = .data$cohortSubjects, names_from = .data$databaseId) @@ -2474,7 +2474,11 @@ shiny::shinyServer(function(input, output, session) { ) data <- inclusionRuleTablePreFetch() %>% dplyr::inner_join(y = filter, - by = c("cohortId", "databaseId")) + by = c("cohortId", "databaseId")) %>% + dplyr::mutate(meetPercent = .data$meetSubjects/.data$totalSubjects, + gainPercent = .data$gainSubjects/.data$totalSubjects, + remainPercent = .data$remainSubjects/.data$totalSubjects) %>% + dplyr::arrange(dplyr::desc(.data$remainPercent)) } else { data <- dplyr::tibble() } @@ -2530,9 +2534,19 @@ shiny::shinyServer(function(input, output, session) { isPhenotypeLibraryMode <- exists("phenotypeDescription") && nrow(phenotypeDescription) > 0 data <- addMetaDataInformationToResults(data = indexEventBreakDownDataFiltered(), - isPhenotypeLibraryMode = isPhenotypeLibraryMode) %>% - dplyr::mutate(percentEntries = round(x = (.data$conceptCount/.data$cohortEntries)*100, digits = 2), - percentSubjects = round(x = (.data$subjectCount/.data$cohortSubjects)*100, digits = 2)) + isPhenotypeLibraryMode = isPhenotypeLibraryMode) + if ('conceptCount' %in% colnames(data)) { + data <- data %>% + dplyr::mutate(percentEntries = round(x = (.data$conceptCount/.data$cohortEntries)*100, digits = 2)) %>% + dplyr::arrange(dplyr::desc(.data$percentEntries)) + } + if ('subjectCount' %in% colnames(data)) { + data <- data %>% + dplyr::mutate(percentSubjects = round(x = (.data$subjectCount/.data$cohortEntries)*100, digits = 2)) + } else { + data <- data %>% + dplyr::mutate(percentSubjects = NA) + } if (input$pivotIndexEventBreakDown == 'None') { data <- data %>% @@ -2563,7 +2577,6 @@ shiny::shinyServer(function(input, output, session) { data <- pivotIndexBreakDownData(data = data, variable = 'percentSubjects', phenotypeLibraryMode = FALSE) } } - dataTable <- standardDataTable(data) return(dataTable) }) @@ -2835,7 +2848,7 @@ shiny::shinyServer(function(input, output, session) { # dplyr::filter(.data$databaseId %in% input$characterizationTablePrettyDtDropDownDatabase) %>% # dplyr::filter(.data$cohortId %in% input$characterizationTablePrettyDtDropDownCohort) } - table <- standardDataTable(data = data) + table <- standardDataTable(data = data, pageLength = -1) return(table) } }) diff --git a/PhenotypeLibrary2/ui.R b/PhenotypeLibrary2/ui.R index 0ffeea60..b19e2298 100644 --- a/PhenotypeLibrary2/ui.R +++ b/PhenotypeLibrary2/ui.R @@ -384,7 +384,7 @@ bodyTabItems <- shinydashboard::tabItems( shiny::radioButtons( inputId = "pivotIndexEventBreakDown", label = "Pivot data over data sources with value from", - selected = "Subject count", + selected = "Percent entries", inline = TRUE, choices = c( "None",