From dbc7b5bb7e4c9334c048e3dc1aa75091d38fc5fb Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Thu, 5 Mar 2026 15:23:37 -0500 Subject: [PATCH 1/6] feat(advanced-options): Set up advanced options panel for subnetwork search --- NAMESPACE | 2 + R/MSstatsShiny.R | 4 +- R/module-visualize-network-server.R | 4 ++ R/module-visualize-network-ui.R | 74 ++++++++++++++++++++++++----- 4 files changed, 70 insertions(+), 14 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index b214184..2eca31e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,6 +86,7 @@ importFrom(shiny,HTML) importFrom(shiny,NS) importFrom(shiny,a) importFrom(shiny,actionButton) +importFrom(shiny,actionLink) importFrom(shiny,br) importFrom(shiny,checkboxInput) importFrom(shiny,column) @@ -185,6 +186,7 @@ importFrom(shinyjs,onclick) importFrom(shinyjs,refresh) importFrom(shinyjs,runjs) importFrom(shinyjs,show) +importFrom(shinyjs,toggle) importFrom(shinyjs,toggleClass) importFrom(shinyjs,toggleState) importFrom(shinyjs,useShinyjs) diff --git a/R/MSstatsShiny.R b/R/MSstatsShiny.R index ce2215b..da63ebc 100644 --- a/R/MSstatsShiny.R +++ b/R/MSstatsShiny.R @@ -23,9 +23,9 @@ #' \item \code{\link{tmt_model}} : Modeling for TMT experiments. #' } #' -#' @importFrom shiny reactiveValues isolate renderText observeEvent fluidPage HTML headerPanel div img mainPanel sidebarPanel sidebarLayout tagList h1 h2 h3 h4 h5 h6 a br hr p radioButtons icon conditionalPanel fileInput checkboxInput actionButton column uiOutput numericInput tags textOutput tabsetPanel tabPanel wellPanel fluidRow selectInput downloadButton fluidPage renderUI selectizeInput observe req reactive sliderInput validate need eventReactive downloadHandler plotOutput tableOutput renderPlot renderTable updateTabsetPanel textInput updateSelectInput insertUI verbatimTextOutput renderPrint nearPoints titlePanel reactiveFileReader hideTab showTab navbarPage navbarMenu shinyUI downloadLink shinyApp +#' @importFrom shiny reactiveValues isolate renderText observeEvent fluidPage HTML headerPanel div img mainPanel sidebarPanel sidebarLayout tagList h1 h2 h3 h4 h5 h6 a br hr p radioButtons icon conditionalPanel fileInput checkboxInput actionButton column uiOutput numericInput tags textOutput tabsetPanel tabPanel wellPanel fluidRow selectInput downloadButton fluidPage renderUI selectizeInput observe req reactive sliderInput validate need eventReactive downloadHandler plotOutput tableOutput renderPlot renderTable updateTabsetPanel textInput updateSelectInput insertUI verbatimTextOutput renderPrint nearPoints titlePanel reactiveFileReader hideTab showTab navbarPage navbarMenu shinyUI downloadLink shinyApp actionLink #' @importFrom shinyBS tipify bsTooltip -#' @importFrom shinyjs disabled hidden useShinyjs runjs enable disable toggleState onclick hide show js toggleClass refresh extendShinyjs +#' @importFrom shinyjs disabled hidden useShinyjs runjs enable disable toggleState onclick hide show js toggleClass refresh extendShinyjs toggle #' @importFrom shinybusy use_busy_spinner remove_modal_spinner show_modal_spinner #' @importFrom DT dataTableOutput renderDataTable #' @importFrom data.table copy fread diff --git a/R/module-visualize-network-server.R b/R/module-visualize-network-server.R index 51d820b..8ebffc2 100644 --- a/R/module-visualize-network-server.R +++ b/R/module-visualize-network-server.R @@ -384,6 +384,10 @@ visualizeNetworkServer <- function(id, parent_session, dataComparison) { }) }) + observeEvent(input$toggle_adv, { + toggle(id = "adv_panel", anim = TRUE) + }) + # Render search results output$proteinSearchResults <- renderUI({ results <- proteinSearchResults() diff --git a/R/module-visualize-network-ui.R b/R/module-visualize-network-ui.R index d70cc46..c6fa787 100644 --- a/R/module-visualize-network-ui.R +++ b/R/module-visualize-network-ui.R @@ -253,18 +253,68 @@ createFilterDropdowns <- function(ns) { ) } -createCurationFilterCheckbox <- function(ns) { +createAdvancedOptionsCollapsible <- function(ns) { div( - tags$label( - "Filter Out Incorrect Statements:", - class = "icon-wrapper", - icon("question-circle", lib = "font-awesome"), - div("When checked, excludes protein regulatory relationships that have been manually curated as incorrect in the INDRA database.", - class = "icon-tooltip") - ), - checkboxInput(ns("filterByCuration"), - label = "Filter out statements curated as incorrect", - value = FALSE) + style = "margin-bottom: 15px;", + tagList( + useShinyjs(), + actionLink( + ns("toggle_adv"), + label = tagList(icon("sliders"), " Advanced Options"), + style = "font-size: 0.85rem; color: #888; text-decoration: none;" + ), + hidden( + div( + id = ns("adv_panel"), + style = "margin-top: 8px; padding: 12px; border: 1px solid #ddd; + border-radius: 4px; background-color: #f9f9f9;", + checkboxInput(ns("filterByCuration"), + label = tags$span( + "Filter out statements curated as incorrect", + class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div("When checked, excludes protein regulatory relationships that have been manually curated as incorrect in the INDRA database.", + class = "icon-tooltip") + ), + value = FALSE), + checkboxInput(ns("filter_by_ptm_site"), + label = tags$span( + "Filter by PTM site", + class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div("Filter relationships based on whether the PTM site information from INDRA matches with the PTM site in the input. Only applicable for differential PTM abundance results.", + class = "icon-tooltip") + ), + value = FALSE), + checkboxInput(ns("include_infinite_fc"), + label = tags$span( + "Include infinite fold change", + class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div("Enable to include proteins/PTMs with infinite log fold change (i.e. proteins that are only detected in one condition).", + class = "icon-tooltip") + ), + value = FALSE), + selectInput(ns("direction"), + label = tags$span( + "Direction of regulation", + class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div("Specify the direction of regulation of differentially abundant proteins/PTMs to include in the network. + 'Upregulated only' only includes up-regulated proteins/PTMs (positive log fold change), + while 'Downregulated only' only includes down-regulated proteins/PTMs (negative log fold change).", + class = "icon-tooltip") + ), + choices = c( + "Both (up & down)" = "both", + "Upregulated only" = "up", + "Downregulated only" = "down" + ), + selected = "both", + width = "100%") + ) + ) + ) ) } @@ -300,7 +350,7 @@ createDataUploadBox <- function(ns) { createDisplayLabelRadioButtons(ns), createParameterSliders(ns), createFilterDropdowns(ns), - createCurationFilterCheckbox(ns), + createAdvancedOptionsCollapsible(ns), createDisplayNetworkButton(ns) ) } From a514f143c1ca121da825d33c1834673fdb425e4d Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Thu, 5 Mar 2026 15:40:07 -0500 Subject: [PATCH 2/6] advanced options integrated on the backend --- R/module-visualize-network-server.R | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/R/module-visualize-network-server.R b/R/module-visualize-network-server.R index 8ebffc2..a459ea9 100644 --- a/R/module-visualize-network-server.R +++ b/R/module-visualize-network-server.R @@ -181,7 +181,10 @@ getInputParameters <- function(input, selectedProteins) { sources = sources, selectedLabel = req(input$selectedLabel), selectedProteins = selectedProteins, - filterByCuration = filterByCuration + filterByCuration = filterByCuration, + filter_by_ptm_site = input$filter_by_ptm_site, + include_infinite_fc = input$include_infinite_fc, + direction = input$direction ) } @@ -209,7 +212,8 @@ annotateProteinData <- function(df, proteinIdType) { } extractSubnetwork <- function(annotated_df, pValue, evidence, statementTypes, - sources, absLogFC, selectedProteins, filterByCuration) { + sources, absLogFC, selectedProteins, filterByCuration, + filter_by_ptm_site, include_infinite_fc, direction) { tryCatch({ getSubnetworkFromIndra(annotated_df, pvalueCutoff = pValue, @@ -218,7 +222,11 @@ extractSubnetwork <- function(annotated_df, pValue, evidence, statementTypes, sources_filter = sources, logfc_cutoff = absLogFC, force_include_other = selectedProteins, - filter_by_curation = filterByCuration) + filter_by_curation = filterByCuration, + filter_by_ptm_site = filter_by_ptm_site, + include_infinite_fc = include_infinite_fc, + direction = direction + ) }, error = function(e) { showNotification(paste("Error in subnetwork extraction:", e$message), type = "error") print(e$message) @@ -479,7 +487,8 @@ visualizeNetworkServer <- function(id, parent_session, dataComparison) { subnetwork <- extractSubnetwork(annotated_df, params$pValue, params$evidence, params$statementTypes, params$sources, params$absLogFC, params$selectedProteins, - params$filterByCuration) + params$filterByCuration, params$filter_by_ptm_site, + params$include_infinite_fc, params$direction) if (is.null(subnetwork)) return(NULL) return(list( @@ -551,6 +560,9 @@ visualizeNetworkServer <- function(id, parent_session, dataComparison) { } codes <- paste(codes, ",\n filter_by_curation = ", params$filterByCuration, "\n", sep = "") + codes <- paste(codes, ",\n filter_by_ptm_site = ", params$filter_by_ptm_site, "\n", sep = "") + codes <- paste(codes, ",\n include_infinite_fc = ", params$include_infinite_fc, "\n", sep = "") + codes <- paste(codes, ",\n direction = ", params$direction, "\n", sep = "") codes <- paste(codes, ")\n\n", sep = "") From 4122b7cf97c61f34e3ac48c7f64f9e61a8142a34 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Thu, 5 Mar 2026 17:46:50 -0500 Subject: [PATCH 3/6] address coderabbit comments and adjust unit tests --- R/module-visualize-network-server.R | 5 +++-- tests/testthat/test_network_visualization.R | 8 ++++++-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/module-visualize-network-server.R b/R/module-visualize-network-server.R index a459ea9..22e8c80 100644 --- a/R/module-visualize-network-server.R +++ b/R/module-visualize-network-server.R @@ -393,7 +393,8 @@ visualizeNetworkServer <- function(id, parent_session, dataComparison) { }) observeEvent(input$toggle_adv, { - toggle(id = "adv_panel", anim = TRUE) + ns <- session$ns + toggle(id = ns("adv_panel"), anim = TRUE) }) # Render search results @@ -562,7 +563,7 @@ visualizeNetworkServer <- function(id, parent_session, dataComparison) { codes <- paste(codes, ",\n filter_by_curation = ", params$filterByCuration, "\n", sep = "") codes <- paste(codes, ",\n filter_by_ptm_site = ", params$filter_by_ptm_site, "\n", sep = "") codes <- paste(codes, ",\n include_infinite_fc = ", params$include_infinite_fc, "\n", sep = "") - codes <- paste(codes, ",\n direction = ", params$direction, "\n", sep = "") + codes <- paste(codes, ",\n direction = \"", params$direction, "\"\n", sep = "") codes <- paste(codes, ")\n\n", sep = "") diff --git a/tests/testthat/test_network_visualization.R b/tests/testthat/test_network_visualization.R index d47664c..e4efd68 100644 --- a/tests/testthat/test_network_visualization.R +++ b/tests/testthat/test_network_visualization.R @@ -163,7 +163,8 @@ test_that("extractSubnetwork works with mocked MSstatsBioNet function", { # Create a mock function that returns the expected subnetwork mock_extract_func <- function(df, pvalueCutoff, evidence_count_cutoff, statement_types, sources_filter, - logfc_cutoff, force_include_other, filter_by_curation) { + logfc_cutoff, force_include_other, filter_by_curation, + filter_by_ptm_site, include_infinite_fc, direction) { return(expected_subnetwork) } @@ -178,7 +179,10 @@ test_that("extractSubnetwork works with mocked MSstatsBioNet function", { sources = NULL, absLogFC = 0.5, selectedProteins = NULL, - filterByCuration = FALSE + filterByCuration = FALSE, + filter_by_ptm_site = FALSE, + include_infinite_fc = FALSE, + direction = "both" ) expect_type(result, "list") From 4fc5f1ff06e160aa25d2f2e63ceb4b5392148f7d Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Thu, 5 Mar 2026 17:49:57 -0500 Subject: [PATCH 4/6] adjusted unit tests to be more robust --- tests/testthat/test_network_visualization.R | 31 +++++++++++++++------ 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test_network_visualization.R b/tests/testthat/test_network_visualization.R index e4efd68..5ce77c3 100644 --- a/tests/testthat/test_network_visualization.R +++ b/tests/testthat/test_network_visualization.R @@ -160,15 +160,10 @@ test_that("extractSubnetwork works with mocked MSstatsBioNet function", { annotated_df <- create_mock_annotated_data() expected_subnetwork <- create_mock_subnetwork() - # Create a mock function that returns the expected subnetwork - mock_extract_func <- function(df, pvalueCutoff, evidence_count_cutoff, - statement_types, sources_filter, - logfc_cutoff, force_include_other, filter_by_curation, - filter_by_ptm_site, include_infinite_fc, direction) { - return(expected_subnetwork) - } + # Use mockery::mock() so we can inspect call args + mock_extract_func <- mock(expected_subnetwork) - # Use mockery to stub the function call + # Stub getSubnetworkFromIndra inside extractSubnetwork stub(extractSubnetwork, "getSubnetworkFromIndra", mock_extract_func) result <- extractSubnetwork( @@ -185,6 +180,25 @@ test_that("extractSubnetwork works with mocked MSstatsBioNet function", { direction = "both" ) + # Verify getSubnetworkFromIndra was called exactly once + expect_called(mock_extract_func, 1) + + # Verify it was called with the exact parameters extractSubnetwork passes through + expect_args( + mock_extract_func, 1, + annotated_df, + pvalueCutoff = 0.05, + evidence_count_cutoff = 5, + statement_types = NULL, + sources_filter = NULL, + logfc_cutoff = 0.5, + force_include_other = NULL, + filter_by_curation = FALSE, + filter_by_ptm_site = FALSE, + include_infinite_fc = FALSE, + direction = "both" + ) + expect_type(result, "list") expect_true("nodes" %in% names(result)) expect_true("edges" %in% names(result)) @@ -193,7 +207,6 @@ test_that("extractSubnetwork works with mocked MSstatsBioNet function", { expect_equal(nrow(result$nodes), 4) expect_equal(nrow(result$edges), 4) }) - # ============================================================================= # TESTS FOR ERROR HANDLING # ============================================================================= From 7ebf7f7289ce4e482a1b82262b29a65ca4d0273e Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Thu, 5 Mar 2026 17:54:52 -0500 Subject: [PATCH 5/6] fix unit test coderabbit --- tests/testthat/test_network_visualization.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test_network_visualization.R b/tests/testthat/test_network_visualization.R index 5ce77c3..0b01faf 100644 --- a/tests/testthat/test_network_visualization.R +++ b/tests/testthat/test_network_visualization.R @@ -230,7 +230,7 @@ test_that("Functions handle errors gracefully", { # Test extractSubnetwork with error stub(extractSubnetwork, "getSubnetworkFromIndra", mock_error_func) stub(extractSubnetwork, "showNotification", mock_show_notification) - result2 <- extractSubnetwork(create_mock_annotated_data(), 0.05, 5, NULL, NULL, 0.5, NULL, FALSE) + result2 <- extractSubnetwork(create_mock_annotated_data(), 0.05, 5, NULL, NULL, 0.5, NULL, FALSE, FALSE, FALSE, "both") expect_null(result2) }) From f0cc677804d96ce602a6d520efb9ad61f62afbf6 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Thu, 5 Mar 2026 18:23:10 -0500 Subject: [PATCH 6/6] fix node display of Inf, fix advanced options collapsible --- R/module-visualize-network-server.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/module-visualize-network-server.R b/R/module-visualize-network-server.R index 22e8c80..fe5af80 100644 --- a/R/module-visualize-network-server.R +++ b/R/module-visualize-network-server.R @@ -1,4 +1,7 @@ renderDataTables <- function(output, nodes_table, edges_table) { + nodes_table <- as.data.frame(lapply(nodes_table, function(x) { + if (is.numeric(x) && any(is.infinite(x))) as.character(x) else x + })) output$nodesTable <- renderDT({ datatable(nodes_table, options = list(pageLength = 10, @@ -394,7 +397,7 @@ visualizeNetworkServer <- function(id, parent_session, dataComparison) { observeEvent(input$toggle_adv, { ns <- session$ns - toggle(id = ns("adv_panel"), anim = TRUE) + toggle(id = "adv_panel", anim = TRUE) }) # Render search results