diff --git a/ConceptSetDiagnostics/HelperFunctions.R b/ConceptSetDiagnostics/HelperFunctions.R new file mode 100644 index 00000000..c5af0db7 --- /dev/null +++ b/ConceptSetDiagnostics/HelperFunctions.R @@ -0,0 +1,149 @@ +camelCaseToTitleCase <- function(string) { + string <- gsub("([A-Z])", " \\1", string) + string <- gsub("([a-z])([0-9])", "\\1 \\2", string) + substr(string, 1, 1) <- toupper(substr(string, 1, 1)) + return(string) +} + +snakeCaseToCamelCase <- function(string) { + string <- tolower(string) + for (letter in letters) { + string <- + gsub(paste("_", letter, sep = ""), toupper(letter), string) + } + string <- gsub("_([0-9])", "\\1", string) + return(string) +} + +standardDataTable <- function(data, + selectionMode = "single", + selected = NULL, + searching = TRUE, + pageLength = 10) { + dataTableFilter = + list(position = 'top', + clear = TRUE, + plain = FALSE) + + dataTableOption = + list( + pageLength = pageLength, + lengthMenu = list(c(5, 10, 20,-1), c("5", "10", "20", "All")), + lengthChange = TRUE, + searching = searching, + ordering = TRUE, + scrollX = TRUE, + ordering = TRUE, + paging = TRUE, + info = TRUE, + searchHighlight = TRUE, + # search = list(regex = TRUE, caseInsensitive = FALSE), + stateSave = TRUE, + dom = 'lBfrtip', + # B for buttons + buttons = list( + 'copy', + list( + extend = 'collection', + buttons = c('csv', 'excel', 'pdf'), + text = 'Download' + ), + 'print', + 'colvis' + ), + colReorder = TRUE, + realtime = FALSE, + # for col reorder + # fixedColumns = list(leftColumns = 1), + # fixedHeader = TRUE, + # processing = TRUE, + autoWidth = TRUE + ) + listOfVariablesThatAreAlwaysFactors <- c( + 'domainId', + 'conceptClassId', + 'vocabularyId', + 'standardConcept', + 'conceptSetName', + 'conceptName', + 'conceptId', + 'standard', + 'invalidReason', + 'invalid', + 'conceptCode', + 'isExcluded', + 'excluded', + 'includeDescendants', + 'descendants', + 'includeMapped', + 'mapped' + ) + + convertVariableToFactor <- function(data, variables) { + for (i in (1:length(variables))) { + variable <- variables[i] + if (variable %in% colnames(data)) { + data[[variable]] <- as.factor(data[[variable]]) + } + } + return(data %>% dplyr::tibble()) + } + + data <- convertVariableToFactor(data = data, + variables = listOfVariablesThatAreAlwaysFactors) + + colNamesData <- camelCaseToTitleCase(colnames(data)) + + dataTable <- DT::datatable( + data = data, + class = "stripe compact order-column hover", + rownames = FALSE, + options = dataTableOption, + colnames = colNamesData, + filter = dataTableFilter, + # style = 'bootstrap4', + escape = FALSE, + selection = list( + mode = selectionMode, + target = "row", + selected = selected + ), + editable = FALSE, + # container = sketch, + extensions = c('Buttons', 'ColReorder', 'FixedColumns', 'FixedHeader'), + plugins = c('natural') #'ellipsis' + # escape = FALSE + ) + return(dataTable) +} + + +copyToClipboardButton <- + function(toCopyId, + label = "Copy to clipboard", + icon = shiny::icon("clipboard"), + ...) { + script <- sprintf( + " + text = document.getElementById('%s').textContent; + html = document.getElementById('%s').innerHTML; + function listener(e) { + e.clipboardData.setData('text/html', html); + e.clipboardData.setData('text/plain', text); + e.preventDefault(); + } + document.addEventListener('copy', listener); + document.execCommand('copy'); + document.removeEventListener('copy', listener); + return false;", + toCopyId, + toCopyId + ) + + tags$button(type = "button", + class = "btn btn-default action-button", + onclick = script, + icon, + label, + ...) + } diff --git a/ConceptSetDiagnostics/global.R b/ConceptSetDiagnostics/global.R new file mode 100644 index 00000000..7f51093a --- /dev/null +++ b/ConceptSetDiagnostics/global.R @@ -0,0 +1,29 @@ +library(magrittr) +library(purrr) + +source("HelperFunctions.R") + +# Used for Testing with old DB connection +connectionDetails <- + DatabaseConnector::createConnectionDetails( + dbms = "postgresql", + server = paste( + Sys.getenv("shinyDbServer"), + Sys.getenv("shinydbDatabase"), + sep = "/" + ), + user = Sys.getenv("shinyDbUser"), + password = Sys.getenv("shinyDbPassword"), + port = Sys.getenv("shinydbPort") + ) + +connection <- + DatabaseConnector::connect(connectionDetails = connectionDetails) + +defaultVocabularySchema <- "vocabulary" + +vocabularyVersion <- + ConceptSetDiagnostics::getVocabulary(connection = connection, + vocabulary = defaultVocabularySchema) %>% + dplyr::filter(.data$vocabularyId == 'None') %>% + dplyr::pull(.data$vocabularyVersion) diff --git a/ConceptSetDiagnostics/server.R b/ConceptSetDiagnostics/server.R new file mode 100644 index 00000000..ae88b910 --- /dev/null +++ b/ConceptSetDiagnostics/server.R @@ -0,0 +1,426 @@ +shiny::shinyServer(function(input, output, session) { + numberOfKeywords <- reactiveVal(value = 1) + col_names <- + shiny::reactive(x = paste0("col", seq_len(numberOfKeywords()))) + + observeEvent(eventExpr = input$addKeyword, + handlerExpr = { + numberOfKeywords(numberOfKeywords() + 1) + }) + + observeEvent(eventExpr = input$removeKeyword, + handlerExpr = { + if (numberOfKeywords() > 1) { + numberOfKeywords(numberOfKeywords() - 1) + } + }) + + output$col <- renderUI({ + purrr::map( + .x = col_names(), + .f = ~ shiny::textInput( + inputId = .x, + label = NULL, + value = isolate(expr = input[[.x]]) + ) + ) + }) + + conceptSetSearchResults <- reactiveVal(value = NULL) + conceptSetSearchResultsPassingtoConceptSetExpression <- + reactiveVal(value = NULL) + conceptSetResultsExpression <- reactiveVal(value = NULL) + observeEvent(eventExpr = input$search, + handlerExpr = { + shiny::withProgress(expr = { + shinyjs::runjs(paste0('$("#col input").css("background-color","white")')) + keywords <- purrr::map_chr(.x = col_names(), + .f = ~ input[[.x]] %||% "") + if (length(keywords) > 0) { + conceptSetExpressionAllTerms <- list() + searchResultConceptIdsAllTerms <- list() + for (i in 1:length(keywords)) { + vocabularyIdOfInterest <- input$vocabularyId + domainIdOfInterest <- input$domainId + + # step perform string search + searchResultConceptIds <- + ConceptSetDiagnostics::getStringSearchConcepts(connection = connection, + searchString = keywords[[i]]) + if (length(vocabularyIdOfInterest) > 0) { + searchResultConceptIds <- searchResultConceptIds %>% + dplyr::filter(.data$vocabularyId %in% vocabularyIdOfInterest) + } + if (length(domainIdOfInterest) > 0) { + searchResultConceptIds <- searchResultConceptIds %>% + dplyr::filter(.data$domainId %in% domainIdOfInterest) + } + + searchResultConceptIdsAllTerms[[i]] <- + searchResultConceptIds + } + + searchResultConceptIdsAllTerms <- + dplyr::bind_rows(searchResultConceptIdsAllTerms) %>% + dplyr::distinct() %>% + dplyr::arrange(dplyr::desc(.data$drc)) + conceptSetSearchResults(searchResultConceptIdsAllTerms) + conceptSetSearchResultsPassingtoConceptSetExpression(searchResultConceptIdsAllTerms) + conceptSetResultsExpression(NULL) + } + }, message = "Loading, Please Wait . .") + }) + + output$isSearchResultFound <- shiny::reactive({ + return(is.null(conceptSetSearchResultsPassingtoConceptSetExpression())) + }) + + outputOptions(output, 'isSearchResultFound', suspendWhenHidden = FALSE) + + output$searchResultConceptIds <- DT::renderDT({ + if (is.null(conceptSetSearchResults())) { + return(NULL) + } else { + standardDataTable(data = conceptSetSearchResults(), selectionMode = "single") %>% + DT::formatStyle('conceptName', + 'standardConcept', + color = DT::styleEqual(c('S', 'N', 'C'), c('blue', 'red', 'purple'))) + } + }) + + + output$numberOfRowSelectedInSearchResult <- shiny::reactive({ + return(length(input$searchResultConceptIds_rows_selected)) + }) + + outputOptions(output, + 'numberOfRowSelectedInSearchResult', + suspendWhenHidden = FALSE) + + observeEvent( + eventExpr = purrr::map_chr(.x = col_names(), + .f = ~ input[[.x]] %||% ""), + handlerExpr = { + shinyjs::runjs(paste0('$("#col input").css("background-color","white")')) + } + ) + + observeEvent(eventExpr = input$deleteSearchResult, + handlerExpr = { + if (!is.null(input$searchResultConceptIds_rows_selected)) { + conceptSetSearchResults(conceptSetSearchResults()[-as.integer(input$searchResultConceptIds_rows_selected), ]) + conceptSetSearchResultsPassingtoConceptSetExpression(conceptSetSearchResultsPassingtoConceptSetExpression()[-as.integer(input$searchResultConceptIds_rows_selected), ]) + shinyjs::runjs( + paste0( + ' setTimeout(function() {$("#col input").css("background-color","#D3D3D3")},500) ' + ) + ) + } + }) + + # observeEvent(eventExpr = input$searchResultConceptIds_rows_selected,handlerExpr = { + # idx <- input$searchResultConceptIds_rows_selected + # conceptName <- conceptSetSearchResults()[idx,]$conceptName + # shinyWidgets::updatePickerInput(session = session,inputId = "conceptId",choices = conceptName) + # ConceptSetDiagnostics::getConceptIdDetails(conceptIds = c(4028741),connection = connection) + # }) + + getConceptSetExpression <- shiny::reactive({ + shiny::withProgress(message = "Loading. . .", { + # develop a concept set expression based on string search + conceptSetExpressionDataFrame <- + ConceptSetDiagnostics::getConceptSetExpressionFromConceptSetExpressionDataFrame( + conceptSetExpressionDataFrame = conceptSetSearchResultsPassingtoConceptSetExpression(), + selectAllDescendants = TRUE + ) %>% + ConceptSetDiagnostics::getConceptSetSignatureExpression(connection = connection) %>% + ConceptSetDiagnostics::getConceptSetExpressionDataFrameFromConceptSetExpression( + updateVocabularyFields = TRUE, + recordCount = TRUE, + connection = connection + ) %>% + dplyr::arrange(dplyr::desc(.data$drc)) + }) + return(conceptSetExpressionDataFrame) + }) + + observeEvent(eventExpr = input$deleteConceptSetExpression, + handlerExpr = { + if (!is.null(input$conceptSetExpression_checkboxes_checked)) { + conceptSetResultsExpression(conceptSetResultsExpression()[-as.integer(input$conceptSetExpression_checkboxes_checked), ]) + conceptSetSearchResults(NULL) + shinyjs::runjs( + paste0( + ' setTimeout(function() {$("#col input").css("background-color","#D3D3D3")},500) ' + ) + ) + } + }) + + output$numberOfRowSelectedInConceptSetExpression <- + shiny::reactive({ + return(length(input$conceptSetExpression_checkboxes_checked)) + }) + + outputOptions(output, + 'numberOfRowSelectedInConceptSetExpression', + suspendWhenHidden = FALSE) + + observeEvent( + eventExpr = list( + input$descendants_checkboxes_checked, + input$mapped_checkboxes_checked, + input$excluded_checkboxes_checked + ), + handlerExpr = { + if (!is.null(input$descendants_checkboxes_checked) || + !is.null(input$mapped_checkboxes_checked) || + !is.null(input$excluded_checkboxes_checked)) { + conceptSetSearchResults(NULL) + shinyjs::runjs( + paste0( + ' setTimeout(function() {$("#col input").css("background-color","#D3D3D3")},500) ' + ) + ) + data <- conceptSetResultsExpression() + if (!is.null(input$descendants_checkboxes_checked)) { + for (i in min(as.integer(input$descendants_checkboxes_checked)):max(as.integer(input$descendants_checkboxes_checked))) { + if (i %in% as.integer(input$descendants_checkboxes_checked)) { + data$includeDescendants[i] <- TRUE + } else { + data$includeDescendants[i] <- FALSE + } + } + } + if (!is.null(input$mapped_checkboxes_checked)) { + for (i in min(as.integer(input$mapped_checkboxes_checked)):max(as.integer(input$mapped_checkboxes_checked))) { + if (i %in% as.integer(input$mapped_checkboxes_checked)) { + data$includeMapped[i] <- TRUE + } else { + data$includeMapped[i] <- FALSE + } + } + } + if (!is.null(input$excluded_checkboxes_checked)) { + for (i in min(as.integer(input$excluded_checkboxes_checked)):max(as.integer(input$excluded_checkboxes_checked))) { + if (i %in% as.integer(input$excluded_checkboxes_checked)) { + data$isExcluded[i] <- TRUE + } else { + data$isExcluded[i] <- FALSE + } + } + } + conceptSetResultsExpression(data) + + } + } + ) + + observeEvent(eventExpr = input$cohortDetails, + handlerExpr = { + if (input$cohortDetails == "conceptSetExpression" && + !is.null(conceptSetSearchResults())) { + conceptSetResultsExpression(getConceptSetExpression()) + } + }) + + output$conceptSetExpression <- DT::renderDT({ + data <- conceptSetResultsExpression() + if (is.null(data)) { + return(NULL) + } else { + data$checkedDescendants <- "" + data$checkedMapped <- "" + data$checkedExcluded <- "" + for (i in 1:nrow(data)) { + if (data[i, ]$includeDescendants) { + data[i,]$checkedDescendants <- 'checked=\"checked\"' + } + if (data[i, ]$includeMapped) { + data[i,]$checkedMapped <- 'checked=\"checked\"' + } + if (data[i, ]$isExcluded) { + data[i,]$checkedExcluded <- 'checked=\"checked\"' + } + } + data <- data %>% + dplyr::mutate( + # use glue to create checked field in javascript + select = glue::glue( + '
' + ), + selectDescendants = glue::glue( + '
' + ), + selectMapped = glue::glue( + '
' + ), + selectExcluded = glue::glue( + '
' + ) + ) %>% + dplyr::relocate(select) + standardDataTable( + data = data %>% + dplyr::select( + -.data$includeDescendants,-.data$includeMapped,-.data$isExcluded,-.data$checkedDescendants,-.data$checkedMapped,-.data$checkedExcluded + ), + selectionMode = "none" + ) + } + }) + + getResolved <- shiny::reactive({ + shiny::withProgress(message = "Loading. . .", { + data <- conceptSetResultsExpression() + data$includeDescendants <- FALSE + data$includeMapped <- FALSE + data$isExcluded <- FALSE + if (is.null(input$descendants_checkboxes_checked)) { + data$includeDescendants <- + conceptSetResultsExpression()$includeDescendants + } else { + data$includeDescendants[as.integer(input$descendants_checkboxes_checked)] <- + TRUE + } + if (is.null(input$mapped_checkboxes_checked)) { + data$includeMapped <- conceptSetResultsExpression()$includeMapped + } else { + data$includeMapped[as.integer(input$mapped_checkboxes_checked)] <- + TRUE + } + if (is.null(input$excluded_checkboxes_checked)) { + data$isExcluded <- conceptSetResultsExpression()$isExcluded + } else { + data$isExcluded[as.integer(input$excluded_checkboxes_checked)] <- + TRUE + } + # data <- data %>% + # dplyr::select( + # -.data$selectDescendants,-.data$selectMapped,-.data$selectExcluded,-.data$checkedDescendants,-.data$checkedMapped,-.data$checkedExcluded + # ) + + conceptSetExpression <- + ConceptSetDiagnostics::getConceptSetExpressionFromConceptSetExpressionDataFrame(conceptSetExpressionDataFrame = data) + result <- + ConceptSetDiagnostics::resolveConceptSetExpression(conceptSetExpression = conceptSetExpression, + connection = connection) + }) + return(result) + }) + + output$resolvedConceptSetExpression <- DT::renderDT({ + if (is.null(conceptSetResultsExpression())) { + return(NULL) + } else { + standardDataTable(data = getResolved()$resolvedConcepts) + } + }) + + output$mappedConceptSetExpression <- DT::renderDT({ + if (is.null(conceptSetResultsExpression())) { + return(NULL) + } else { + standardDataTable(data = getResolved()$mappedConcepts) + } + }) + + getRecommendation <- shiny::reactive({ + shiny::withProgress(message = "Loading. . .", { + conceptSetExpression <- + ConceptSetDiagnostics::getConceptSetExpressionFromConceptSetExpressionDataFrame(conceptSetExpressionDataFrame = conceptSetResultsExpression()) + data <- + ConceptSetDiagnostics::getRecommendationForConceptSetExpression(conceptSetExpression = conceptSetExpression, + connection = connection) + }) + return(data) + }) + + output$recommendedStandardConceptSetExpression <- DT::renderDT({ + if (is.null(conceptSetResultsExpression())) { + return(NULL) + } else { + standardDataTable(data = getRecommendation()$recommendedStandard) + } + }) + + output$recommendedSourceConceptSetExpression <- DT::renderDT({ + if (is.null(conceptSetResultsExpression())) { + return(NULL) + } else { + standardDataTable(data = getRecommendation()$recommendedSource) + } + }) + + output$conceptSetExpressionJSON <- shiny::renderText({ + if (is.null(conceptSetResultsExpression())) { + return(NULL) + } else { + data <- + ConceptSetDiagnostics::getConceptSetExpressionFromConceptSetExpressionDataFrame(conceptSetExpressionDataFrame = conceptSetResultsExpression()) %>% + RJSONIO::toJSON(digits = 23, pretty = TRUE) + } + }) + + selectedConceptId <- reactiveVal(NULL) + observeEvent(eventExpr = input$searchResultConceptIds_rows_selected, + handlerExpr = { + idx <- input$searchResultConceptIds_rows_selected + selectedConceptId(conceptSetSearchResults()$conceptId[idx]) + }) + + observeEvent(eventExpr = input$resolvedConceptSetExpression_rows_selected, + handlerExpr = { + idx <- input$resolvedConceptSetExpression_rows_selected + selectedConceptId(getResolved()$resolvedConcepts$conceptId[idx]) + }) + + observeEvent(eventExpr = input$mappedConceptSetExpression_rows_selected, + handlerExpr = { + idx <- input$mappedConceptSetExpression_rows_selected + selectedConceptId(getResolved()$mappedConcepts$conceptId[idx]) + }) + + output$conceptSynonym <- DT::renderDT({ + if (!is.null(selectedConceptId())) { + shiny::withProgress(message = "Loading. Please wait . . .", { + data <- + ConceptSetDiagnostics::getConceptSynonym(conceptIds = selectedConceptId(), connection = connection) + data <- data %>% + dplyr::rename("SynonymName" = "conceptSynonymName") %>% + dplyr::select(.data$SynonymName) + return(data) + }) + } + }) + + output$conceptRelationship <- DT::renderDT({ + if (!is.null(selectedConceptId())) { + shiny::withProgress(message = "Loading. Please wait . . .", { + data1 <- + ConceptSetDiagnostics::getConceptRelationship(conceptIds = selectedConceptId(), connection = connection) %>% + dplyr::arrange(.data$relationshipId) + + data2 <- + ConceptSetDiagnostics::getConceptIdDetails(conceptIds = data1$conceptId2, + connection = connection) + + data <- data1 %>% + dplyr::inner_join(data2, by = c("conceptId2" = "conceptId")) %>% + dplyr::select( + .data$relationshipId, + .data$conceptName, + .data$conceptId2, + .data$vocabularyId + ) %>% + dplyr::rename( + c("Relationship" = "relationshipId"), + c("Relates To" = "conceptName"), + c("ConceptID" = "conceptId2"), + c("Vocabulary" = "vocabularyId") + ) + return(data) + }) + } + }) +}) \ No newline at end of file diff --git a/ConceptSetDiagnostics/shiny.Rproj b/ConceptSetDiagnostics/shiny.Rproj new file mode 100644 index 00000000..8e3c2ebc --- /dev/null +++ b/ConceptSetDiagnostics/shiny.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/ConceptSetDiagnostics/ui.R b/ConceptSetDiagnostics/ui.R new file mode 100644 index 00000000..64a3e496 --- /dev/null +++ b/ConceptSetDiagnostics/ui.R @@ -0,0 +1,227 @@ + + +shinydashboard::dashboardPage( + sidebar = shinydashboard::dashboardSidebar(disable = TRUE), + header = shinydashboard::dashboardHeader(title = "Concept Set Diagnostric"), + body = shinydashboard::dashboardBody( + shinydashboard::box( + title = "Concept Set Diagnostic", + width = NULL, + status = "primary", + solidHeader = TRUE, + collapsible = TRUE, + shiny::h5("Enter Keyword(s) :"), + column(4, shiny::uiOutput(outputId = "col")), + shinyjs::useShinyjs(), + # tags$style("#col input {background-color:red !important}"), + column( + 2, + shiny::actionButton( + inputId = "addKeyword", + icon = icon("plus"), + label = "" + ), + shiny::actionButton( + inputId = "removeKeyword", + icon = icon("minus"), + label = "" + ) + ), + column( + 3, + shiny::selectInput( + inputId = "vocabularyId", + label = "Filter by Vocabulary", + choices = c('SNOMED', 'HCPCS', 'ICD10CM', 'ICD10', 'ICD9CM', 'ICD9', 'Read'), + selected = c('SNOMED', 'HCPCS', 'ICD10CM', 'ICD10', 'ICD9CM', 'ICD9', 'Read'), + multiple = TRUE + ) + ), + column( + 3, + shiny::selectInput( + inputId = "domainId", + label = "Filter by Domain", + choices = c('Condition', 'Observation'), + selected = c('Condition', 'Observation'), + multiple = TRUE + ) + ), + column(12, + shiny::actionButton(inputId = "search", label = "Search")) + ), + shiny::conditionalPanel( + condition = "!(output.isSearchResultFound)", + shinydashboard::box( + title = "Concept Set Result", + width = NULL, + status = "primary", + solidHeader = TRUE, + collapsible = TRUE, + shiny::tabsetPanel( + id = "cohortDetails", + type = "tab", + shiny::tabPanel( + title = "Search Result", + value = "searchResult", + shiny::conditionalPanel( + condition = "output.numberOfRowSelectedInSearchResult >= 1", + shiny::actionButton( + inputId = "deleteSearchResult", + label = "Delete", + style = "background-color:#c45;color:#fff" + ) + ), + DT::DTOutput(outputId = "searchResultConceptIds") + ), + shiny::tabPanel( + title = "Concept Set Expression", + value = "conceptSetExpression", + shiny::conditionalPanel( + condition = "output.numberOfRowSelectedInConceptSetExpression >= 1", + shiny::actionButton( + inputId = "deleteConceptSetExpression", + label = "Delete", + style = "background-color:#c45;color:#fff" + ) + ), + DT::DTOutput(outputId = "conceptSetExpression"), + tags$script( + HTML( + ' + $(document).on("click", ".selectConceptSetExpressionRow", function () { + var conceptSetExpressionRowCheckboxes = document.getElementsByName("selectConceptSetExpressionRow"); + var conceptSetExpressionRowCheckboxesChecked = []; + for (var i=0; i