feat(advanced-options): Set up advanced options panel for subnetwork search

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)

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

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, 
@@ -181,7 +184,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 +215,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 +225,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)
@@ -384,6 +395,11 @@ visualizeNetworkServer <- function(id, parent_session, dataComparison) {
     })
   })
 
+  observeEvent(input$toggle_adv, {
+    ns <- session$ns
+    toggle(id = "adv_panel", anim = TRUE)
+  })
+
   # Render search results
   output$proteinSearchResults <- renderUI({
     results <- proteinSearchResults()
@@ -475,7 +491,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(
@@ -547,6 +564,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 = "")
 

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)
   )
 }

tests/testthat/test_network_visualization.R

@@ -160,14 +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) {
-    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(
@@ -178,7 +174,29 @@ 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"
+  )
+
+  # 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")
@@ -189,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
 # =============================================================================
@@ -213,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)
 })