From ad65a688df001af848343d575d8be3891259722b Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Thu, 5 Mar 2026 18:46:08 -0500 Subject: [PATCH 1/3] add linting step in dry run --- .github/workflows/dry-run-build.yml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/.github/workflows/dry-run-build.yml b/.github/workflows/dry-run-build.yml index a5c529a..6824e2b 100644 --- a/.github/workflows/dry-run-build.yml +++ b/.github/workflows/dry-run-build.yml @@ -8,6 +8,22 @@ jobs: steps: - name: Checkout repository uses: actions/checkout@v4 + - name: Setup R for linting + uses: r-lib/actions/setup-r@v2 + - name: Check style + run: | + Rscript -e " + install.packages('styler') + files <- styler::style_pkg( + transformers = styler::tidyverse_style(indent_by = 4), + dry = 'on' + ) + if (any(files\$changed)) { + message('The following files need styling. Please run:') + message(' styler::style_pkg(transformers = styler::tidyverse_style(indent_by = 4))') + quit(status = 1) + } + " - name: Setup R and Bioconductor uses: grimbough/bioc-actions/setup-bioc@v1 with: From 7c519baa68f9caa66bfc9acf999ba77b1710ab38 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Thu, 5 Mar 2026 18:53:15 -0500 Subject: [PATCH 2/3] fix linting script --- .github/scripts/check_style.R | 10 ++++++++++ .github/workflows/dry-run-build.yml | 15 +++------------ 2 files changed, 13 insertions(+), 12 deletions(-) create mode 100644 .github/scripts/check_style.R diff --git a/.github/scripts/check_style.R b/.github/scripts/check_style.R new file mode 100644 index 0000000..54d57f3 --- /dev/null +++ b/.github/scripts/check_style.R @@ -0,0 +1,10 @@ +files <- styler::style_pkg( + transformers = styler::tidyverse_style(indent_by = 4), + dry = "on" +) + +if (any(files$changed)) { + message("The following files need styling. Please run:") + message(" styler::style_pkg(transformers = styler::tidyverse_style(indent_by = 4))") + quit(status = 1) +} \ No newline at end of file diff --git a/.github/workflows/dry-run-build.yml b/.github/workflows/dry-run-build.yml index 6824e2b..85e7542 100644 --- a/.github/workflows/dry-run-build.yml +++ b/.github/workflows/dry-run-build.yml @@ -12,18 +12,9 @@ jobs: uses: r-lib/actions/setup-r@v2 - name: Check style run: | - Rscript -e " - install.packages('styler') - files <- styler::style_pkg( - transformers = styler::tidyverse_style(indent_by = 4), - dry = 'on' - ) - if (any(files\$changed)) { - message('The following files need styling. Please run:') - message(' styler::style_pkg(transformers = styler::tidyverse_style(indent_by = 4))') - quit(status = 1) - } - " + Rscript -e "install.packages('styler')" + Rscript -e "install.packages('roxygen2')" + Rscript .github/scripts/check_style.R - name: Setup R and Bioconductor uses: grimbough/bioc-actions/setup-bioc@v1 with: From 9622117488b480e7e29e8cba861d93dccdcb3e5a Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Thu, 5 Mar 2026 18:59:45 -0500 Subject: [PATCH 3/3] style files --- R/annotateProteinInfoFromIndra.R | 227 +++++++------- R/cytoscapeNetwork.R | 77 +++-- R/exportNetworkToHTML.R | 40 +-- R/getSubnetworkFromIndra.R | 38 +-- R/utils_annotateProteinInfoFromIndra.R | 249 ++++++++-------- R/utils_cytoscapeNetwork.R | 277 ++++++++++-------- R/utils_getSubnetworkFromIndra.R | 154 +++++----- .../test-annotateProteinInfoFromIndra.R | 22 +- tests/testthat/test-exportNetworkToHTML.R | 127 ++++---- tests/testthat/test-getSubnetworkFromIndra.R | 4 +- ...est-utils_annotateProteinInfoFromIndra.R.R | 1 - tests/testthat/test-utils_cytoscapeNetwork.R | 145 +++++---- .../test-utils_getSubnetworkFromIndra.R | 143 +++++---- vignettes/Cytoscape-Visualization.Rmd | 66 ++--- vignettes/MSstatsBioNet.Rmd | 10 +- vignettes/PTM-Analysis.Rmd | 4 +- 16 files changed, 838 insertions(+), 746 deletions(-) diff --git a/R/annotateProteinInfoFromIndra.R b/R/annotateProteinInfoFromIndra.R index b85497e..e22e943 100644 --- a/R/annotateProteinInfoFromIndra.R +++ b/R/annotateProteinInfoFromIndra.R @@ -2,11 +2,11 @@ #' #' This function annotates a data frame with protein information from Indra. #' -#' @param df output of \code{\link[MSstats]{groupComparison}} function's -#' comparisonResult table, which contains a list of proteins and their -#' corresponding p-values, logFCs, along with additional HGNC ID and HGNC +#' @param df output of \code{\link[MSstats]{groupComparison}} function's +#' comparisonResult table, which contains a list of proteins and their +#' corresponding p-values, logFCs, along with additional HGNC ID and HGNC #' name columns -#' @param proteinIdType A character string specifying the type of protein ID. +#' @param proteinIdType A character string specifying the type of protein ID. #' It can be either "Uniprot", "Uniprot_Mnemonic", or "Hgnc_Name". #' @return A data frame with the following columns: #' \describe{ @@ -24,14 +24,14 @@ #' head(annotated_df) #' @export annotateProteinInfoFromIndra <- function(df, proteinIdType) { - .validateAnnotateProteinInfoFromIndraInput(df) - df <- .populateUniprotIdsInDataFrame(df, proteinIdType) - df <- .populateHgncIdsInDataFrame(df, proteinIdType) - df <- .populateHgncNamesInDataFrame(df) - df <- .populateTranscriptionFactorInfoInDataFrame(df) - df <- .populateKinaseInfoInDataFrame(df) - df <- .populatePhophataseInfoInDataFrame(df) - return(df) + .validateAnnotateProteinInfoFromIndraInput(df) + df <- .populateUniprotIdsInDataFrame(df, proteinIdType) + df <- .populateHgncIdsInDataFrame(df, proteinIdType) + df <- .populateHgncNamesInDataFrame(df) + df <- .populateTranscriptionFactorInfoInDataFrame(df) + df <- .populateKinaseInfoInDataFrame(df) + df <- .populatePhophataseInfoInDataFrame(df) + return(df) } #' Validate Annotate Protein Info Input @@ -41,9 +41,9 @@ annotateProteinInfoFromIndra <- function(df, proteinIdType) { #' @param df A data frame containing protein information. #' @return None. Throws an error if validation fails. .validateAnnotateProteinInfoFromIndraInput <- function(df) { - if (!"Protein" %in% colnames(df)) { - stop("Input dataframe must contain 'Protein' column.") - } + if (!"Protein" %in% colnames(df)) { + stop("Input dataframe must contain 'Protein' column.") + } } #' Populate Uniprot IDs in Data Frame @@ -51,40 +51,41 @@ annotateProteinInfoFromIndra <- function(df, proteinIdType) { #' This function populates the Uniprot IDs in the data frame based on the protein ID type. #' #' @param df A data frame containing protein information. -#' @param proteinIdType A character string specifying the type of protein ID. +#' @param proteinIdType A character string specifying the type of protein ID. #' It can be either "Uniprot" or "Uniprot_Mnemonic". #' @return A data frame with populated Uniprot IDs. .populateUniprotIdsInDataFrame <- function(df, proteinIdType) { - if ("GlobalProtein" %in% colnames(df)) { - protein_ids = unique(as.character(df$GlobalProtein)) - } else { - df$Protein = as.character(df$Protein) - df$GlobalProtein = ifelse(grepl("_[A-Z][0-9]", df$Protein), - gsub("_[A-Z][0-9].*", "", df$Protein, perl = TRUE), - df$Protein) - protein_ids = unique(df$GlobalProtein) - } - df$UniprotId <- NA - if (proteinIdType == "Uniprot") { - df$UniprotId <- as.character(df$GlobalProtein) - } - - if (proteinIdType == "Uniprot_Mnemonic") { - mnemonicProteins <- protein_ids - if (length(mnemonicProteins) > 0) { - uniprotMapping <- .callGetUniprotIdsFromUniprotMnemonicIdsApi(as.list(mnemonicProteins)) - for (mnemonicId in names(uniprotMapping)) { - if (!is.null(uniprotMapping[[mnemonicId]])) { - df$UniprotId[df$GlobalProtein == mnemonicId] <- uniprotMapping[[mnemonicId]] - } - } + if ("GlobalProtein" %in% colnames(df)) { + protein_ids <- unique(as.character(df$GlobalProtein)) + } else { + df$Protein <- as.character(df$Protein) + df$GlobalProtein <- ifelse(grepl("_[A-Z][0-9]", df$Protein), + gsub("_[A-Z][0-9].*", "", df$Protein, perl = TRUE), + df$Protein + ) + protein_ids <- unique(df$GlobalProtein) + } + df$UniprotId <- NA + if (proteinIdType == "Uniprot") { + df$UniprotId <- as.character(df$GlobalProtein) + } + + if (proteinIdType == "Uniprot_Mnemonic") { + mnemonicProteins <- protein_ids + if (length(mnemonicProteins) > 0) { + uniprotMapping <- .callGetUniprotIdsFromUniprotMnemonicIdsApi(as.list(mnemonicProteins)) + for (mnemonicId in names(uniprotMapping)) { + if (!is.null(uniprotMapping[[mnemonicId]])) { + df$UniprotId[df$GlobalProtein == mnemonicId] <- uniprotMapping[[mnemonicId]] } + } } - - if (proteinIdType == "Hgnc_Name") { - df$UniprotId <- NA - } - return(df) + } + + if (proteinIdType == "Hgnc_Name") { + df$UniprotId <- NA + } + return(df) } #' Populate HGNC IDs in Data Frame @@ -92,35 +93,35 @@ annotateProteinInfoFromIndra <- function(df, proteinIdType) { #' This function populates the HGNC IDs in the data frame based on the Uniprot IDs. #' #' @param df A data frame containing protein information. -#' @param proteinIdType A character string specifying the type of protein ID. +#' @param proteinIdType A character string specifying the type of protein ID. #' It can be either "Uniprot", "Uniprot_Mnemonic", or "Hgnc_Name". #' @return A data frame with populated HGNC IDs. .populateHgncIdsInDataFrame <- function(df, proteinIdType) { - df$HgncId <- NA - if (proteinIdType == "Uniprot" || proteinIdType == "Uniprot_Mnemonic") { - validMask <- !is.na(df$UniprotId) - validUniprots <- unique(df$UniprotId[validMask]) - if (length(validUniprots) > 0) { - hgncMapping <- .callGetHgncIdsFromUniprotIdsApi(as.list(validUniprots)) - for (uniprotId in names(hgncMapping)) { - if (!is.null(hgncMapping[[uniprotId]])) { - df$HgncId[df$UniprotId == uniprotId] <- hgncMapping[[uniprotId]] - } + df$HgncId <- NA + if (proteinIdType == "Uniprot" || proteinIdType == "Uniprot_Mnemonic") { + validMask <- !is.na(df$UniprotId) + validUniprots <- unique(df$UniprotId[validMask]) + if (length(validUniprots) > 0) { + hgncMapping <- .callGetHgncIdsFromUniprotIdsApi(as.list(validUniprots)) + for (uniprotId in names(hgncMapping)) { + if (!is.null(hgncMapping[[uniprotId]])) { + df$HgncId[df$UniprotId == uniprotId] <- hgncMapping[[uniprotId]] } } - } else { - hgncNames <- unique(df$GlobalProtein) - if (length(hgncNames) > 0) { - hgncMapping <- .callGetHgncIdsFromGildaApi(as.list(hgncNames)) - for (hgncName in names(hgncMapping)) { - if (!is.null(hgncMapping[[hgncName]])) { - df$HgncId[df$GlobalProtein == hgncName] <- hgncMapping[[hgncName]] - } + } + } else { + hgncNames <- unique(df$GlobalProtein) + if (length(hgncNames) > 0) { + hgncMapping <- .callGetHgncIdsFromGildaApi(as.list(hgncNames)) + for (hgncName in names(hgncMapping)) { + if (!is.null(hgncMapping[[hgncName]])) { + df$HgncId[df$GlobalProtein == hgncName] <- hgncMapping[[hgncName]] } } } - - return(df) + } + + return(df) } #' Populate HGNC Names in Data Frame @@ -130,18 +131,18 @@ annotateProteinInfoFromIndra <- function(df, proteinIdType) { #' @param df A data frame containing protein information. #' @return A data frame with populated HGNC names. .populateHgncNamesInDataFrame <- function(df) { - df$HgncName <- NA - validHgncMask <- !is.na(df$HgncId) - validHgncs <- unique(df$HgncId[validHgncMask]) - if (length(validHgncs) > 0) { - nameMapping <- .callGetHgncNamesFromHgncIdsApi(as.list(validHgncs)) - for (hgncId in names(nameMapping)) { - if (!is.null(nameMapping[[hgncId]])) { - df$HgncName[df$HgncId == hgncId] <- nameMapping[[hgncId]] - } - } + df$HgncName <- NA + validHgncMask <- !is.na(df$HgncId) + validHgncs <- unique(df$HgncId[validHgncMask]) + if (length(validHgncs) > 0) { + nameMapping <- .callGetHgncNamesFromHgncIdsApi(as.list(validHgncs)) + for (hgncId in names(nameMapping)) { + if (!is.null(nameMapping[[hgncId]])) { + df$HgncName[df$HgncId == hgncId] <- nameMapping[[hgncId]] + } } - return(df) + } + return(df) } #' Populate Transcription Factor Info in Data Frame @@ -151,19 +152,19 @@ annotateProteinInfoFromIndra <- function(df, proteinIdType) { #' @param df A data frame containing protein information. #' @return A data frame with populated transcription factor information. .populateTranscriptionFactorInfoInDataFrame <- function(df) { - df$IsTranscriptionFactor <- NA - validNameMask <- !is.na(df$HgncName) - validNames <- unique(df$HgncName[validNameMask]) - if (length(validNames) > 0) { - validNamesList <- as.list(validNames) - charMapping <- .callIsTranscriptionFactorApi(validNamesList) - for (hgncName in names(charMapping)) { - if (!is.null(charMapping[[hgncName]])) { - df$IsTranscriptionFactor[df$HgncName == hgncName] <- charMapping[[hgncName]] - } - } + df$IsTranscriptionFactor <- NA + validNameMask <- !is.na(df$HgncName) + validNames <- unique(df$HgncName[validNameMask]) + if (length(validNames) > 0) { + validNamesList <- as.list(validNames) + charMapping <- .callIsTranscriptionFactorApi(validNamesList) + for (hgncName in names(charMapping)) { + if (!is.null(charMapping[[hgncName]])) { + df$IsTranscriptionFactor[df$HgncName == hgncName] <- charMapping[[hgncName]] + } } - return(df) + } + return(df) } #' Populate Kinase Info in Data Frame @@ -173,19 +174,19 @@ annotateProteinInfoFromIndra <- function(df, proteinIdType) { #' @param df A data frame containing protein information. #' @return A data frame with populated kinase information. .populateKinaseInfoInDataFrame <- function(df) { - df$IsKinase <- NA - validNameMask <- !is.na(df$HgncName) - validNames <- unique(df$HgncName[validNameMask]) - if (length(validNames) > 0) { - validNamesList <- as.list(validNames) - charMapping <- .callIsKinaseApi(validNamesList) - for (hgncName in names(charMapping)) { - if (!is.null(charMapping[[hgncName]])) { - df$IsKinase[df$HgncName == hgncName] <- charMapping[[hgncName]] - } - } + df$IsKinase <- NA + validNameMask <- !is.na(df$HgncName) + validNames <- unique(df$HgncName[validNameMask]) + if (length(validNames) > 0) { + validNamesList <- as.list(validNames) + charMapping <- .callIsKinaseApi(validNamesList) + for (hgncName in names(charMapping)) { + if (!is.null(charMapping[[hgncName]])) { + df$IsKinase[df$HgncName == hgncName] <- charMapping[[hgncName]] + } } - return(df) + } + return(df) } #' Populate Phosphatase Info in Data Frame @@ -195,17 +196,17 @@ annotateProteinInfoFromIndra <- function(df, proteinIdType) { #' @param df A data frame containing protein information. #' @return A data frame with populated phosphatase information. .populatePhophataseInfoInDataFrame <- function(df) { - df$IsPhosphatase <- NA - validNameMask <- !is.na(df$HgncName) - validNames <- unique(df$HgncName[validNameMask]) - if (length(validNames) > 0) { - validNamesList <- as.list(validNames) - charMapping <- .callIsPhosphataseApi(validNamesList) - for (hgncName in names(charMapping)) { - if (!is.null(charMapping[[hgncName]])) { - df$IsPhosphatase[df$HgncName == hgncName] <- charMapping[[hgncName]] - } - } + df$IsPhosphatase <- NA + validNameMask <- !is.na(df$HgncName) + validNames <- unique(df$HgncName[validNameMask]) + if (length(validNames) > 0) { + validNamesList <- as.list(validNames) + charMapping <- .callIsPhosphataseApi(validNamesList) + for (hgncName in names(charMapping)) { + if (!is.null(charMapping[[hgncName]])) { + df$IsPhosphatase[df$HgncName == hgncName] <- charMapping[[hgncName]] + } } - return(df) -} \ No newline at end of file + } + return(df) +} diff --git a/R/cytoscapeNetwork.R b/R/cytoscapeNetwork.R index cfdf293..af4f647 100644 --- a/R/cytoscapeNetwork.R +++ b/R/cytoscapeNetwork.R @@ -28,15 +28,15 @@ #' @examples #' \dontrun{ #' nodes <- data.frame( -#' id = c("TP53", "MDM2", "CDKN1A"), -#' logFC = c(1.5, -0.8, 2.1), -#' stringsAsFactors = FALSE +#' id = c("TP53", "MDM2", "CDKN1A"), +#' logFC = c(1.5, -0.8, 2.1), +#' stringsAsFactors = FALSE #' ) #' edges <- data.frame( -#' source = c("TP53", "MDM2"), -#' target = c("MDM2", "TP53"), -#' interaction = c("Activation", "Inhibition"), -#' stringsAsFactors = FALSE +#' source = c("TP53", "MDM2"), +#' target = c("MDM2", "TP53"), +#' interaction = c("Activation", "Inhibition"), +#' stringsAsFactors = FALSE #' ) #' cytoscapeNetwork(nodes, edges) #' } @@ -45,14 +45,13 @@ #' @importFrom grDevices colorRamp rgb #' @export cytoscapeNetwork <- function(nodes, - edges = data.frame(), + edges = data.frame(), displayLabelType = "id", - nodeFontSize = 12, + nodeFontSize = 12, layoutOptions = NULL, - width = NULL, - height = NULL, - elementId = NULL) { - + width = NULL, + height = NULL, + elementId = NULL) { # Validate inputs if (!is.data.frame(nodes) || !("id" %in% names(nodes))) { stop("`nodes` must be a data frame with at least an `id` column.") @@ -64,7 +63,7 @@ cytoscapeNetwork <- function(nodes, if (nrow(edges) > 0 && !all(required_edge_cols %in% names(edges))) { stop("`edges` must contain columns: source, target, interaction.") } - + # Build layout config default_layout <- list( name = "dagre", @@ -81,17 +80,17 @@ cytoscapeNetwork <- function(nodes, if (!is.null(layoutOptions)) { for (nm in names(layoutOptions)) layout[[nm]] <- layoutOptions[[nm]] } - + # Build element list elements <- .buildElements(nodes, edges, displayLabelType) - + # Package everything for the JS side x <- list( elements = elements, layout = layout, node_font_size = nodeFontSize ) - + htmlwidgets::createWidget( name = "cytoscapeNetwork", x = x, @@ -115,28 +114,28 @@ cytoscapeNetwork <- function(nodes, #' @examples #' \dontrun{ #' library(shiny) -#' +#' #' ui <- fluidPage( -#' cytoscapeNetworkOutput("cytoNetwork") +#' cytoscapeNetworkOutput("cytoNetwork") #' ) -#' +#' #' server <- function(input, output, session) { -#' output$cytoNetwork <- renderCytoscapeNetwork({ -#' nodes <- data.frame( -#' id = c("TP53", "MDM2", "CDKN1A"), -#' logFC = c(1.5, -0.8, 2.1), -#' stringsAsFactors = FALSE -#' ) -#' edges <- data.frame( -#' source = c("TP53", "MDM2"), -#' target = c("MDM2", "TP53"), -#' interaction = c("Activation", "Inhibition"), -#' stringsAsFactors = FALSE -#' ) -#' cytoscapeNetwork(nodes, edges) -#' }) +#' output$cytoNetwork <- renderCytoscapeNetwork({ +#' nodes <- data.frame( +#' id = c("TP53", "MDM2", "CDKN1A"), +#' logFC = c(1.5, -0.8, 2.1), +#' stringsAsFactors = FALSE +#' ) +#' edges <- data.frame( +#' source = c("TP53", "MDM2"), +#' target = c("MDM2", "TP53"), +#' interaction = c("Activation", "Inhibition"), +#' stringsAsFactors = FALSE +#' ) +#' cytoscapeNetwork(nodes, edges) +#' }) #' } -#' +#' #' shinyApp(ui, server) #' } #' @@ -144,7 +143,7 @@ cytoscapeNetwork <- function(nodes, #' @inheritParams htmlwidgets::shinyWidgetOutput #' @export cytoscapeNetworkOutput <- function(outputId, - width = "100%", + width = "100%", height = "500px") { htmlwidgets::shinyWidgetOutput( outputId = outputId, @@ -162,9 +161,9 @@ cytoscapeNetworkOutput <- function(outputId, renderCytoscapeNetwork <- function(expr, env = parent.frame(), quoted = FALSE) { if (!quoted) expr <- substitute(expr) htmlwidgets::shinyRenderWidget( - expr = expr, + expr = expr, outputFunction = cytoscapeNetworkOutput, - env = env, - quoted = TRUE + env = env, + quoted = TRUE ) } diff --git a/R/exportNetworkToHTML.R b/R/exportNetworkToHTML.R index c333cc4..ab2a11e 100644 --- a/R/exportNetworkToHTML.R +++ b/R/exportNetworkToHTML.R @@ -1,56 +1,56 @@ #' Export network data with Cytoscape visualization -#' +#' #' Convenience function that takes nodes and edges data directly and creates #' both the configuration and HTML export in one step. -#' +#' #' @inheritParams cytoscapeNetwork #' @param filename Output HTML filename #' @param ... Additional arguments passed to exportCytoscapeToHTML() #' @export #' @return Invisibly returns the file path of the created HTML file -exportNetworkToHTML <- function(nodes, edges, +exportNetworkToHTML <- function(nodes, edges, filename = "network_visualization.html", displayLabelType = "id", nodeFontSize = 12, ...) { - - widget <- cytoscapeNetwork(nodes, edges, - displayLabelType = displayLabelType, - nodeFontSize = nodeFontSize) - + widget <- cytoscapeNetwork(nodes, edges, + displayLabelType = displayLabelType, + nodeFontSize = nodeFontSize + ) + htmlwidgets::saveWidget( widget, file = filename, selfcontained = TRUE ) - + invisible(filename) } #' Preview network in browser -#' +#' #' Creates a temporary HTML file and opens it in the default web browser #' @export #' @importFrom utils browseURL #' @inheritParams exportNetworkToHTML -previewNetworkInBrowser <- function(nodes, edges, +previewNetworkInBrowser <- function(nodes, edges, displayLabelType = "id", nodeFontSize = 12) { - # Create temporary filename temp_file <- tempfile(fileext = ".html") - + # Export to temp file - exportNetworkToHTML(nodes, edges, - filename = temp_file, - displayLabelType = displayLabelType, - nodeFontSize = nodeFontSize) - + exportNetworkToHTML(nodes, edges, + filename = temp_file, + displayLabelType = displayLabelType, + nodeFontSize = nodeFontSize + ) + # Open in browser if (interactive()) { browseURL(temp_file) cat("Network opened in browser. Temporary file:", temp_file, "\n") } - + invisible(temp_file) -} \ No newline at end of file +} diff --git a/R/getSubnetworkFromIndra.R b/R/getSubnetworkFromIndra.R index 8eea0a9..5cc22bd 100644 --- a/R/getSubnetworkFromIndra.R +++ b/R/getSubnetworkFromIndra.R @@ -3,13 +3,13 @@ #' Using differential abundance results from MSstats, this function retrieves #' a subnetwork of protein interactions from INDRA database. #' -#' @param input output of \code{\link[MSstats]{groupComparison}} function's -#' comparisionResult table, which contains a list of proteins and their -#' corresponding p-values, logFCs, along with additional HGNC ID and HGNC +#' @param input output of \code{\link[MSstats]{groupComparison}} function's +#' comparisionResult table, which contains a list of proteins and their +#' corresponding p-values, logFCs, along with additional HGNC ID and HGNC #' name columns -#' @param protein_level_data output of the \code{\link[MSstats]{dataProcess}} -#' function's ProteinLevelData table, which contains a list of proteins and -#' their corresponding abundances. Used for annotating correlation information +#' @param protein_level_data output of the \code{\link[MSstats]{dataProcess}} +#' function's ProteinLevelData table, which contains a list of proteins and +#' their corresponding abundances. Used for annotating correlation information #' and applying correlation cutoffs. #' @param pvalueCutoff p-value cutoff for filtering. Default is NULL, i.e. no #' filtering @@ -19,24 +19,24 @@ #' @param evidence_count_cutoff number of evidence to filter on for each #' paper. E.g. A paper may have 5 sentences describing the same interaction vs 1 #' sentence. Default is 1. -#' @param correlation_cutoff if protein_level_abundance is not NULL, apply a +#' @param correlation_cutoff if protein_level_abundance is not NULL, apply a #' cutoff for edges with correlation less than a specified cutoff. Default is #' 0.3 #' @param sources_filter filtering only on specific sources. Default is no filter, i.e. NULL. #' Otherwise, should be a list, e.g. c('reach', 'medscan'). -#' @param logfc_cutoff absolute log fold change cutoff for filtering proteins. -#' Only proteins with |logFC| greater than this value will be retained. Default +#' @param logfc_cutoff absolute log fold change cutoff for filtering proteins. +#' Only proteins with |logFC| greater than this value will be retained. Default #' is NULL, i.e. no logFC filtering. #' @param force_include_other character vector of identifiers to include in the #' network, regardless if those ids are in the input data. Should be formatted #' as "namespace:identifier", e.g. "HGNC:1234" or "CHEBI:4911". #' @param filter_by_curation logical, whether to filter out statements that #' have been curated as incorrect in INDRA. Default is FALSE. -#' @param filter_by_ptm_site logical, whether to filter edges based on whether the -#' site information from INDRA matches with the PTM site in the input. Default is FALSE. +#' @param filter_by_ptm_site logical, whether to filter edges based on whether the +#' site information from INDRA matches with the PTM site in the input. Default is FALSE. #' Only applicable for differential PTM abundance results. -#' @param include_infinite_fc logical, whether to include proteins with -#' infinite log fold change (i.e. proteins that are only detected in one condition). +#' @param include_infinite_fc logical, whether to include proteins with +#' infinite log fold change (i.e. proteins that are only detected in one condition). #' Default is FALSE. #' @param direction Character string specifying the direction of regulation to #' include. One of \code{"both"} (default), \code{"up"} (upregulated only), @@ -55,21 +55,21 @@ #' head(subnetwork$nodes) #' head(subnetwork$edges) #' -getSubnetworkFromIndra <- function(input, +getSubnetworkFromIndra <- function(input, protein_level_data = NULL, - pvalueCutoff = NULL, + pvalueCutoff = NULL, statement_types = NULL, paper_count_cutoff = 1, evidence_count_cutoff = 1, correlation_cutoff = 0.3, sources_filter = NULL, logfc_cutoff = NULL, - force_include_other = NULL, + force_include_other = NULL, filter_by_curation = FALSE, filter_by_ptm_site = FALSE, include_infinite_fc = FALSE, direction = c("both", "up", "down")) { - direction = match.arg(direction) + direction <- match.arg(direction) input <- .filterGetSubnetworkFromIndraInput(input, pvalueCutoff, logfc_cutoff, force_include_other, include_infinite_fc, direction) .validateGetSubnetworkFromIndraInput(input, protein_level_data, sources_filter, force_include_other) res <- .callIndraCogexApi(input$HgncId, force_include_other) @@ -77,8 +77,8 @@ getSubnetworkFromIndra <- function(input, edges <- .constructEdgesDataFrame(res, input, protein_level_data) edges <- .filterEdgesDataFrame(edges, paper_count_cutoff, correlation_cutoff) nodes <- .constructNodesDataFrame(input, edges) - subnetwork = .filterByPtmSite(nodes, edges, filter_by_ptm_site) - subnetwork = .filterByCuration(subnetwork$nodes, subnetwork$edges, evidence_count_cutoff, filter_by_curation) + subnetwork <- .filterByPtmSite(nodes, edges, filter_by_ptm_site) + subnetwork <- .filterByCuration(subnetwork$nodes, subnetwork$edges, evidence_count_cutoff, filter_by_curation) warning( "NOTICE: This function includes third-party software components that are licensed under the BSD 2-Clause License. Please ensure to diff --git a/R/utils_annotateProteinInfoFromIndra.R b/R/utils_annotateProteinInfoFromIndra.R index 4fcba0d..e50d3d1 100644 --- a/R/utils_annotateProteinInfoFromIndra.R +++ b/R/utils_annotateProteinInfoFromIndra.R @@ -1,4 +1,4 @@ -INDRA_API_URL = "https://discovery.indra.bio" +INDRA_API_URL <- "https://discovery.indra.bio" #' Call API to get UniProt IDs from UniProt mnemonic IDs #' @param uniprotMnemonicIds list of UniProt mnemonic ids @@ -8,7 +8,6 @@ INDRA_API_URL = "https://discovery.indra.bio" #' @keywords internal #' @noRd .callGetUniprotIdsFromUniprotMnemonicIdsApi <- function(uniprotMnemonicIds) { - if (!is.list(uniprotMnemonicIds)) { stop("Input must be a list.") } @@ -16,41 +15,47 @@ INDRA_API_URL = "https://discovery.indra.bio" if (length(uniprotMnemonicIds) == 0) { stop("Input list must not be empty.") } - - tryCatch({ - # Attempt to convert all elements to character if not already character - uniprotMnemonicIds <- lapply(uniprotMnemonicIds, function(x) { - if (!is.character(x)) { - as.character(x) - } else { - x + + tryCatch( + { + # Attempt to convert all elements to character if not already character + uniprotMnemonicIds <- lapply(uniprotMnemonicIds, function(x) { + if (!is.character(x)) { + as.character(x) + } else { + x + } + }) + + # Check if conversion was successful + if (any(!sapply(uniprotMnemonicIds, is.character))) { + stop("All elements in the list must be character strings representing UniProt mnemonic IDs.") } - }) - - # Check if conversion was successful - if (any(!sapply(uniprotMnemonicIds, is.character))) { - stop("All elements in the list must be character strings representing UniProt mnemonic IDs.") + }, + error = function(e) { + stop("An error occurred converting uniprot mnemonic IDs to character strings: ", e$message) } - }, error = function(e) { - stop("An error occurred converting uniprot mnemonic IDs to character strings: ", e$message) - }) + ) apiUrl <- file.path(INDRA_API_URL, "api/get_uniprot_ids_from_uniprot_mnemonic_ids") requestBody <- list(uniprot_mnemonic_ids = uniprotMnemonicIds) requestBody <- jsonlite::toJSON(requestBody, auto_unbox = TRUE) - res <- tryCatch({ - response <- POST( - apiUrl, - body = requestBody, - add_headers("Content-Type" = "application/json"), - encode = "raw" - ) - content(response) - }, error = function(e) { - message("Error in API call: ", e) - NULL - }) + res <- tryCatch( + { + response <- POST( + apiUrl, + body = requestBody, + add_headers("Content-Type" = "application/json"), + encode = "raw" + ) + content(response) + }, + error = function(e) { + message("Error in API call: ", e) + NULL + } + ) return(res) } @@ -62,7 +67,6 @@ INDRA_API_URL = "https://discovery.indra.bio" #' @keywords internal #' @noRd .callGetHgncIdsFromUniprotIdsApi <- function(uniprotIds) { - if (!is.list(uniprotIds)) { stop("Input must be a list.") } @@ -79,18 +83,21 @@ INDRA_API_URL = "https://discovery.indra.bio" requestBody <- list(uniprot_ids = uniprotIds) requestBody <- jsonlite::toJSON(requestBody, auto_unbox = TRUE) - res <- tryCatch({ - response <- POST( - apiUrl, - body = requestBody, - add_headers("Content-Type" = "application/json"), - encode = "raw" - ) - content(response) - }, error = function(e) { - message("Error in API call: ", e) - NULL - }) + res <- tryCatch( + { + response <- POST( + apiUrl, + body = requestBody, + add_headers("Content-Type" = "application/json"), + encode = "raw" + ) + content(response) + }, + error = function(e) { + message("Error in API call: ", e) + NULL + } + ) return(res) } @@ -102,7 +109,6 @@ INDRA_API_URL = "https://discovery.indra.bio" #' @keywords internal #' @noRd .callGetHgncNamesFromHgncIdsApi <- function(hgncIds) { - if (!is.list(hgncIds)) { stop("Input must be a list.") } @@ -119,18 +125,21 @@ INDRA_API_URL = "https://discovery.indra.bio" requestBody <- list(hgnc_ids = hgncIds) requestBody <- jsonlite::toJSON(requestBody, auto_unbox = TRUE) - res <- tryCatch({ - response <- POST( - apiUrl, - body = requestBody, - add_headers("Content-Type" = "application/json"), - encode = "raw" - ) - content(response) - }, error = function(e) { - message("Error in API call: ", e) - NULL - }) + res <- tryCatch( + { + response <- POST( + apiUrl, + body = requestBody, + add_headers("Content-Type" = "application/json"), + encode = "raw" + ) + content(response) + }, + error = function(e) { + message("Error in API call: ", e) + NULL + } + ) return(res) } @@ -142,7 +151,6 @@ INDRA_API_URL = "https://discovery.indra.bio" #' @keywords internal #' @noRd .callIsKinaseApi <- function(genes) { - if (!is.list(genes)) { stop("Input must be a list.") } @@ -159,18 +167,21 @@ INDRA_API_URL = "https://discovery.indra.bio" requestBody <- list(genes = genes) requestBody <- jsonlite::toJSON(requestBody, auto_unbox = TRUE) - res <- tryCatch({ - response <- POST( - apiUrl, - body = requestBody, - add_headers("Content-Type" = "application/json"), - encode = "raw" - ) - content(response) - }, error = function(e) { - message("Error in API call: ", e) - NULL - }) + res <- tryCatch( + { + response <- POST( + apiUrl, + body = requestBody, + add_headers("Content-Type" = "application/json"), + encode = "raw" + ) + content(response) + }, + error = function(e) { + message("Error in API call: ", e) + NULL + } + ) return(res) } @@ -182,7 +193,6 @@ INDRA_API_URL = "https://discovery.indra.bio" #' @keywords internal #' @noRd .callIsPhosphataseApi <- function(genes) { - if (!is.list(genes)) { stop("Input must be a list.") } @@ -199,18 +209,21 @@ INDRA_API_URL = "https://discovery.indra.bio" requestBody <- list(genes = genes) requestBody <- jsonlite::toJSON(requestBody, auto_unbox = TRUE) - res <- tryCatch({ - response <- POST( - apiUrl, - body = requestBody, - add_headers("Content-Type" = "application/json"), - encode = "raw" - ) - content(response) - }, error = function(e) { - message("Error in API call: ", e) - NULL - }) + res <- tryCatch( + { + response <- POST( + apiUrl, + body = requestBody, + add_headers("Content-Type" = "application/json"), + encode = "raw" + ) + content(response) + }, + error = function(e) { + message("Error in API call: ", e) + NULL + } + ) return(res) } @@ -222,7 +235,6 @@ INDRA_API_URL = "https://discovery.indra.bio" #' @keywords internal #' @noRd .callIsTranscriptionFactorApi <- function(genes) { - if (!is.list(genes)) { stop("Input must be a list.") } @@ -239,18 +251,21 @@ INDRA_API_URL = "https://discovery.indra.bio" requestBody <- list(genes = genes) requestBody <- jsonlite::toJSON(requestBody, auto_unbox = TRUE) - res <- tryCatch({ - response <- POST( - apiUrl, - body = requestBody, - add_headers("Content-Type" = "application/json"), - encode = "raw" - ) - content(response) - }, error = function(e) { - message("Error in API call: ", e) - NULL - }) + res <- tryCatch( + { + response <- POST( + apiUrl, + body = requestBody, + add_headers("Content-Type" = "application/json"), + encode = "raw" + ) + content(response) + }, + error = function(e) { + message("Error in API call: ", e) + NULL + } + ) return(res) } @@ -262,21 +277,20 @@ INDRA_API_URL = "https://discovery.indra.bio" #' @keywords internal #' @noRd .callGetHgncIdsFromGildaApi <- function(hgncNames) { - if (!is.list(hgncNames)) { stop("Input must be a list.") } - + if (any(!sapply(hgncNames, is.character))) { stop("All elements in the list must be character strings representing hgnc names.") } - + if (length(hgncNames) == 0) { stop("Input list must not be empty.") } - + apiUrl <- file.path("https://grounding.indra.bio/", "ground_multi") - + requestBody <- lapply(hgncNames, function(hgnc_name) { list( text = hgnc_name, @@ -284,25 +298,28 @@ INDRA_API_URL = "https://discovery.indra.bio" ) }) requestBody <- jsonlite::toJSON(requestBody, auto_unbox = TRUE) - res <- tryCatch({ - response <- POST( - apiUrl, - body = requestBody, - add_headers("Content-Type" = "application/json"), - encode = "raw" - ) - content(response) - }, error = function(e) { - message("Error in API call: ", e) - NULL - }) - + res <- tryCatch( + { + response <- POST( + apiUrl, + body = requestBody, + add_headers("Content-Type" = "application/json"), + encode = "raw" + ) + content(response) + }, + error = function(e) { + message("Error in API call: ", e) + NULL + } + ) + if (is.null(res)) { return(NULL) } - + hgnc_mapping <- character(0) - + for (item in res) { # Find the term where db == "HGNC" hgnc_term <- NULL @@ -312,7 +329,7 @@ INDRA_API_URL = "https://discovery.indra.bio" break } } - + # Only add to mapping if HGNC term was found if (!is.null(hgnc_term)) { hgnc_mapping[hgnc_term$text] <- hgnc_term$id diff --git a/R/utils_cytoscapeNetwork.R b/R/utils_cytoscapeNetwork.R index a7e2726..769499f 100644 --- a/R/utils_cytoscapeNetwork.R +++ b/R/utils_cytoscapeNetwork.R @@ -4,41 +4,44 @@ #' @noRd .mapLogFCToColor <- function(logFC_values) { colors <- c("#ADD8E6", "#ADD8E6", "#D3D3D3", "#FFA590", "#FFA590") - + if (all(is.na(logFC_values)) || length(unique(logFC_values[!is.na(logFC_values)])) <= 1) { return(rep("#D3D3D3", length(logFC_values))) } - + is_pos_inf <- is.infinite(logFC_values) & logFC_values > 0 is_neg_inf <- is.infinite(logFC_values) & logFC_values < 0 - - finite_values <- logFC_values[is.finite(logFC_values)] - default_max <- 2 - max_logFC <- max(c(abs(finite_values), default_max), na.rm = TRUE) - min_logFC <- -max_logFC - - logFC_values[is_pos_inf] <- max_logFC - logFC_values[is_neg_inf] <- min_logFC - - color_map <- grDevices::colorRamp(colors) - normalized <- (logFC_values - min_logFC) / (max_logFC - min_logFC) + + finite_values <- logFC_values[is.finite(logFC_values)] + default_max <- 2 + max_logFC <- max(c(abs(finite_values), default_max), na.rm = TRUE) + min_logFC <- -max_logFC + + logFC_values[is_pos_inf] <- max_logFC + logFC_values[is_neg_inf] <- min_logFC + + color_map <- grDevices::colorRamp(colors) + normalized <- (logFC_values - min_logFC) / (max_logFC - min_logFC) normalized[is.na(normalized)] <- 0.5 - rgb_colors <- color_map(normalized) + rgb_colors <- color_map(normalized) grDevices::rgb(rgb_colors[, 1], rgb_colors[, 2], rgb_colors[, 3], - maxColorValue = 255) + maxColorValue = 255 + ) } #' Safely escape a string for embedding in a JS single-quoted literal #' @keywords internal #' @noRd .escJS <- function(x) { - if (is.null(x)) return("") + if (is.null(x)) { + return("") + } x <- as.character(x) x <- gsub("\\\\", "\\\\\\\\", x) - x <- gsub("'", "\\\\'", x) - x <- gsub("\r", "\\\\r", x) - x <- gsub("\n", "\\\\n", x) + x <- gsub("'", "\\\\'", x) + x <- gsub("\r", "\\\\r", x) + x <- gsub("\n", "\\\\n", x) x } @@ -56,14 +59,16 @@ consolidate = "undirected" ), regulatory = list( - types = c("Inhibition", "Activation", "IncreaseAmount", "DecreaseAmount"), - colors = list(Inhibition = "#FF4444", - Activation = "#44AA44", - IncreaseAmount = "#4488FF", - DecreaseAmount = "#FF8844"), - style = "solid", - arrow = "triangle", - width = 3, + types = c("Inhibition", "Activation", "IncreaseAmount", "DecreaseAmount"), + colors = list( + Inhibition = "#FF4444", + Activation = "#44AA44", + IncreaseAmount = "#4488FF", + DecreaseAmount = "#FF8844" + ), + style = "solid", + arrow = "triangle", + width = 3, consolidate = "bidirectional" ), phosphorylation = list( @@ -107,21 +112,21 @@ #' @noRd .edgeStyle <- function(interaction, category, edge_type) { props <- .relProps() - p <- if (category %in% names(props)) props[[category]] else props$other - + p <- if (category %in% names(props)) props[[category]] else props$other + color <- if (category == "regulatory" && !is.null(p$colors)) { base <- sub(" \\(bidirectional\\)", "", interaction) if (base %in% names(p$colors)) p$colors[[base]] else "#666666" } else { p$color } - + arrow <- switch(edge_type, - undirected = "none", - bidirectional = "triangle", - p$arrow + undirected = "none", + bidirectional = "triangle", + p$arrow ) - + list(color = color, style = p$style, arrow = arrow, width = p$width) } @@ -130,16 +135,18 @@ #' @importFrom stats setNames #' @noRd .ptmOverlap <- function(edges, nodes) { - if (nrow(edges) == 0 || is.null(nodes)) return(setNames(character(0), character(0))) - + if (nrow(edges) == 0 || is.null(nodes)) { + return(setNames(character(0), character(0))) + } + edges$edge_key <- paste(edges$source, edges$target, edges$interaction, sep = "-") - unique_keys <- unique(edges$edge_key) - result <- setNames(character(length(unique_keys)), unique_keys) - + unique_keys <- unique(edges$edge_key) + result <- setNames(character(length(unique_keys)), unique_keys) + for (key in unique_keys) { sub_edges <- edges[edges$edge_key == key, ] all_sites <- c() - + for (i in seq_len(nrow(sub_edges))) { e <- sub_edges[i, ] if (!is.na(e$target) && "site" %in% names(e) && !is.na(e$site)) { @@ -148,21 +155,21 @@ edge_sites <- trimws(unlist(strsplit(as.character(e$site), "[,;|]"))) for (j in seq_len(nrow(tnodes))) { if (!is.na(tnodes$Site[j])) { - node_sites <- trimws(unlist(strsplit(as.character(tnodes$Site[j]), "_"))) - overlap <- intersect(edge_sites, node_sites) - overlap <- overlap[overlap != "" & !is.na(overlap)] - all_sites <- c(all_sites, overlap) + node_sites <- trimws(unlist(strsplit(as.character(tnodes$Site[j]), "_"))) + overlap <- intersect(edge_sites, node_sites) + overlap <- overlap[overlap != "" & !is.na(overlap)] + all_sites <- c(all_sites, overlap) } } } } } - + u <- unique(all_sites[all_sites != "" & !is.na(all_sites)]) result[key] <- if (length(u) == 0) { "" } else if (length(u) == 1) { - paste0("Overlapping PTM site: ", u) + paste0("Overlapping PTM site: ", u) } else { paste0("Overlapping PTM sites: ", paste(u, collapse = ", ")) } @@ -174,36 +181,43 @@ #' @keywords internal #' @noRd .consolidateEdges <- function(edges, nodes = NULL) { - if (nrow(edges) == 0) return(edges) - - ptm_map <- .ptmOverlap(edges, nodes) - props <- .relProps() + if (nrow(edges) == 0) { + return(edges) + } + + ptm_map <- .ptmOverlap(edges, nodes) + props <- .relProps() consolidated <- list() - processed <- c() - + processed <- c() + for (i in seq_len(nrow(edges))) { - e <- edges[i, ] + e <- edges[i, ] pair_key <- paste(sort(c(e$source, e$target)), e$interaction, collapse = "-") if (pair_key %in% processed) next - - cat <- .classify(e$interaction) - rev_edges <- edges[edges$source == e$target & - edges$target == e$source & - edges$interaction == e$interaction, ] - con_type <- props[[cat]]$consolidate - edge_key <- paste(e$source, e$target, e$interaction, sep = "-") - ptm_txt <- if (edge_key %in% names(ptm_map)) ptm_map[[edge_key]] else "" - + + cat <- .classify(e$interaction) + rev_edges <- edges[edges$source == e$target & + edges$target == e$source & + edges$interaction == e$interaction, ] + con_type <- props[[cat]]$consolidate + edge_key <- paste(e$source, e$target, e$interaction, sep = "-") + ptm_txt <- if (edge_key %in% names(ptm_map)) ptm_map[[edge_key]] else "" + if (nrow(rev_edges) > 0 && con_type %in% c("undirected", "bidirectional")) { - new_interaction <- if (con_type == "undirected") e$interaction else + new_interaction <- if (con_type == "undirected") { + e$interaction + } else { paste(e$interaction, "(bidirectional)") - new_edge <- data.frame(source = e$source, - target = e$target, - interaction = new_interaction, - edge_type = if (con_type == "undirected") "undirected" else "bidirectional", - category = cat, - ptm_overlap = ptm_txt, - stringsAsFactors = FALSE) + } + new_edge <- data.frame( + source = e$source, + target = e$target, + interaction = new_interaction, + edge_type = if (con_type == "undirected") "undirected" else "bidirectional", + category = cat, + ptm_overlap = ptm_txt, + stringsAsFactors = FALSE + ) for (col in setdiff(names(e), c("source", "target", "interaction"))) { new_edge[[col]] <- e[[col]] } @@ -211,17 +225,17 @@ consolidated[[key]] <- new_edge processed <- c(processed, pair_key) } else { - de <- e - de$edge_type <- "directed" - de$category <- cat + de <- e + de$edge_type <- "directed" + de$category <- cat de$ptm_overlap <- ptm_txt - key <- paste(e$source, e$target, e$interaction, sep = "-") + key <- paste(e$source, e$target, e$interaction, sep = "-") consolidated[[key]] <- de } } - + if (length(consolidated) > 0) { - result <- do.call(rbind, consolidated) + result <- do.call(rbind, consolidated) rownames(result) <- NULL result } else { @@ -241,62 +255,73 @@ } else { rep("#D3D3D3", nrow(nodes)) } - + label_col <- if (display_label_type == "hgncName" && - "hgncName" %in% names(nodes)) "hgncName" else "id" - + "hgncName" %in% names(nodes)) { + "hgncName" + } else { + "id" + } + has_ptm_sites <- if ("Site" %in% names(nodes)) { unique(nodes$id[!is.na(nodes$Site) & trimws(nodes$Site) != ""]) } else { character(0) } - - elements <- list() - emitted_prots <- character(0) - emitted_cpds <- character(0) - emitted_ptm_n <- character(0) - emitted_ptm_e <- character(0) - + + elements <- list() + emitted_prots <- character(0) + emitted_cpds <- character(0) + emitted_ptm_n <- character(0) + emitted_ptm_e <- character(0) + for (i in seq_len(nrow(nodes))) { - row <- nodes[i, , drop = FALSE] - color <- node_colors[i] - has_site <- "Site" %in% names(nodes) && + row <- nodes[i, , drop = FALSE] + color <- node_colors[i] + has_site <- "Site" %in% names(nodes) && !is.na(row$Site) && trimws(row$Site) != "" - + display_label <- if (label_col == "hgncName" && - !is.na(row$hgncName) && row$hgncName != "") - row$hgncName else row$id - + !is.na(row$hgncName) && row$hgncName != "") { + row$hgncName + } else { + row$id + } + needs_compound <- row$id %in% has_ptm_sites - compound_id <- paste0(row$id, "__compound__") - + compound_id <- paste0(row$id, "__compound__") + # Compound container if (needs_compound && !(compound_id %in% emitted_cpds)) { elements <- c(elements, list( - list(data = list(id = compound_id, - node_type = "compound")) + list(data = list( + id = compound_id, + node_type = "compound" + )) )) emitted_cpds <- c(emitted_cpds, compound_id) } - + # Protein node if (!(row$id %in% emitted_prots)) { - nd <- list(id = row$id, - label = display_label, - color = color, - node_type = "protein", - width = max(60, min(nchar(display_label) * 8 + 20, 150)), - height = max(40, min(nchar(display_label) * 2 + 30, 60))) + nd <- list( + id = row$id, + label = display_label, + color = color, + node_type = "protein", + width = max(60, min(nchar(display_label) * 8 + 20, 150)), + height = max(40, min(nchar(display_label) * 2 + 30, 60)) + ) if (needs_compound) nd$parent <- compound_id elements <- c(elements, list(list(data = nd))) emitted_prots <- c(emitted_prots, row$id) } - + # PTM child nodes + attachment edges if (has_site) { sites <- unique(trimws(unlist(strsplit(as.character(row$Site), "[_,;|]")))) sites <- sites[sites != ""] - + for (site in sites) { ptm_nid <- paste0(row$id, "__ptm__", site) if (!(ptm_nid %in% emitted_ptm_n)) { @@ -310,7 +335,7 @@ )))) emitted_ptm_n <- c(emitted_ptm_n, ptm_nid) } - + ptm_eid <- paste0(row$id, "__ptm_edge__", site) if (!(ptm_eid %in% emitted_ptm_e)) { elements <- c(elements, list(list(data = list( @@ -331,36 +356,38 @@ } } } - + # ── edges ───────────────────────────────────────────────────────────── if (!is.null(edges) && nrow(edges) > 0) { con <- .consolidateEdges(edges, nodes) - + for (i in seq_len(nrow(con))) { - row <- con[i, ] - sty <- .edgeStyle(row$interaction, row$category, row$edge_type) - eid <- paste(row$source, row$target, row$interaction, sep = "-") + row <- con[i, ] + sty <- .edgeStyle(row$interaction, row$category, row$edge_type) + eid <- paste(row$source, row$target, row$interaction, sep = "-") elink <- if ("evidenceLink" %in% names(row)) { ev <- row$evidenceLink if (is.na(ev) || ev == "NA") "" else as.character(ev) - } else "" - + } else { + "" + } + elements <- c(elements, list(list(data = list( - id = eid, - source = row$source, - target = row$target, + id = eid, + source = row$source, + target = row$target, interaction = row$interaction, - edge_type = row$edge_type, - category = row$category, + edge_type = row$edge_type, + category = row$category, evidenceLink = elink, - color = sty$color, - line_style = sty$style, + color = sty$color, + line_style = sty$style, arrow_shape = sty$arrow, - width = sty$width, - tooltip = if (!is.null(row$ptm_overlap)) row$ptm_overlap else "" + width = sty$width, + tooltip = if (!is.null(row$ptm_overlap)) row$ptm_overlap else "" )))) } } - + elements -} \ No newline at end of file +} diff --git a/R/utils_getSubnetworkFromIndra.R b/R/utils_getSubnetworkFromIndra.R index 228ff02..50cabad 100644 --- a/R/utils_getSubnetworkFromIndra.R +++ b/R/utils_getSubnetworkFromIndra.R @@ -10,7 +10,7 @@ if (!"HgncId" %in% colnames(input)) { stop("Invalid Input Error: Input must contain a column named 'HgncId'.") } - num_proteins = length(unique(input$HgncId)) + + num_proteins <- length(unique(input$HgncId)) + ifelse(!is.null(force_include_other), length(force_include_other), 0) if (num_proteins >= 400) { stop("Invalid Input Error: INDRA query must contain less than 400 proteins. Consider lowering your p-value cutoff") @@ -19,7 +19,7 @@ stop("Invalid Input Error: Input must contain at least one protein after filtering.") } if (!is.null(protein_level_data)) { - if(!all(c("Protein", "LogIntensities", "originalRUN") %in% colnames(protein_level_data))) { + if (!all(c("Protein", "LogIntensities", "originalRUN") %in% colnames(protein_level_data))) { stop("protein_level_data must contain 'Protein', 'LogIntensities', and 'originalRUN' columns.") } } @@ -42,7 +42,7 @@ indraCogexUrl <- "https://discovery.indra.bio/api/indra_subnetwork_relations" - hgncIds = unique(hgncIds) + hgncIds <- unique(hgncIds) groundings <- lapply(hgncIds, function(x) list("HGNC", x)) if (!is.null(force_include_other)) { groundings <- c(groundings, lapply(force_include_other, function(x) { @@ -72,26 +72,31 @@ stmt_hash_char <- as.character(stmt_hash) url <- paste0("https://db.indra.bio/curation/list/", stmt_hash_char) - tryCatch({ - response <- GET(url) - if (status_code(response) == 200) { - curations <- fromJSON(content(response, "text", encoding = "UTF-8")) - if (length(curations) == 0) { + tryCatch( + { + response <- GET(url) + if (status_code(response) == 200) { + curations <- fromJSON(content(response, "text", encoding = "UTF-8")) + if (length(curations) == 0) { + return(0) + } + incorrect_curations <- curations[curations$tag != "correct", ] + unique_incorrect <- length(unique(incorrect_curations$source_hash)) + + return(unique_incorrect) + } else { + warning(paste( + "API request failed for hash", stmt_hash_char, + "with status code", status_code(response) + )) return(0) } - incorrect_curations <- curations[curations$tag != "correct", ] - unique_incorrect <- length(unique(incorrect_curations$source_hash)) - - return(unique_incorrect) - } else { - warning(paste("API request failed for hash", stmt_hash_char, - "with status code", status_code(response))) + }, + error = function(e) { + warning(paste("Error processing hash", stmt_hash_char, ":", e$message)) return(0) } - }, error = function(e) { - warning(paste("Error processing hash", stmt_hash_char, ":", e$message)) - return(0) - }) + ) } #' Call INDRA Cogex API and return response @@ -103,25 +108,28 @@ #' @importFrom jsonlite fromJSON #' @keywords internal #' @noRd -.filterIndraResponse <- function(res, statement_types, evidence_count_cutoff, +.filterIndraResponse <- function(res, statement_types, evidence_count_cutoff, sources_filter = NULL) { if (!is.null(statement_types)) { - res = Filter( - function(statement) statement$data$stmt_type %in% statement_types, - res) + res <- Filter( + function(statement) statement$data$stmt_type %in% statement_types, + res + ) } if (!is.null(sources_filter)) { - res = Filter( + res <- Filter( function(statement) { parsed <- tryCatch(fromJSON(statement$data$source_counts), error = function(e) NULL) - if (is.null(parsed)) return(FALSE) + if (is.null(parsed)) { + return(FALSE) + } return(any(names(parsed) %in% sources_filter)) - }, + }, res ) } - res = Filter( - function(statement) statement$data$evidence_count >= evidence_count_cutoff, + res <- Filter( + function(statement) statement$data$evidence_count >= evidence_count_cutoff, res ) return(res) @@ -132,23 +140,23 @@ #' @param pvalueCutoff p-value cutoff #' @param logfc_cutoff logFC cutoff #' @param force_include_other list of identifiers to exempt from filtering -#' @param include_infinite_fc logical, whether to include proteins with -#' infinite log fold change (i.e. proteins that are only detected in one condition). -#' Default is FALSE. +#' @param include_infinite_fc logical, whether to include proteins with +#' infinite log fold change (i.e. proteins that are only detected in one condition). +#' Default is FALSE. #' @param direction Character string specifying the direction of regulation to #' include. One of \code{"both"} (default), \code{"up"} (upregulated only), #' or \code{"down"} (downregulated only). #' @return filtered groupComparison result #' @keywords internal #' @noRd -.filterGetSubnetworkFromIndraInput <- function(input, - pvalueCutoff, - logfc_cutoff, - force_include_other, - include_infinite_fc, +.filterGetSubnetworkFromIndraInput <- function(input, + pvalueCutoff, + logfc_cutoff, + force_include_other, + include_infinite_fc, direction) { input$Protein <- as.character(input$Protein) - + # Extract exempt proteins before any filtering exempt_proteins <- NULL if (!is.null(force_include_other)) { @@ -162,13 +170,13 @@ exempt_proteins <- data.frame() } } - + infinite_fc_proteins <- NULL if (include_infinite_fc) { infinite_fc_proteins <- input[is.infinite(input$log2FC), ] } - input <- input[!is.na(input$adj.pvalue),] + input <- input[!is.na(input$adj.pvalue), ] if (!is.null(pvalueCutoff)) { input <- input[input$adj.pvalue < pvalueCutoff, ] } @@ -178,34 +186,35 @@ } input <- input[!is.na(input$log2FC) & abs(input$log2FC) > logfc_cutoff, ] } - + if (!is.null(infinite_fc_proteins) && nrow(infinite_fc_proteins) > 0) { combined_input <- rbind(infinite_fc_proteins, input) input <- combined_input[!duplicated(combined_input$Protein), ] } - + if (direction == "up") { input <- input[!is.na(input$log2FC) & input$log2FC > 0, ] } else if (direction == "down") { input <- input[!is.na(input$log2FC) & input$log2FC < 0, ] } - + # Combine filtered data with exempt proteins and remove duplicates if (!is.null(exempt_proteins) && nrow(exempt_proteins) > 0) { combined_input <- rbind(exempt_proteins, input) # Remove duplicates based on Protein column, keeping first occurrence input <- combined_input[!duplicated(combined_input$Protein), ] } - + # Handle PTMs in Protein column - input$Site = ifelse(grepl("_[A-Z][0-9]", input$Protein), - gsub("^_", "", - gsub("^[^_]*_|_(?![A-Z][0-9])[^_]*", "", input$Protein, perl = TRUE) - ), - NA_character_ - ) + input$Site <- ifelse(grepl("_[A-Z][0-9]", input$Protein), + gsub( + "^_", "", + gsub("^[^_]*_|_(?![A-Z][0-9])[^_]*", "", input$Protein, perl = TRUE) + ), + NA_character_ + ) if ("GlobalProtein" %in% colnames(input)) { - input$Protein = input$GlobalProtein + input$Protein <- input$GlobalProtein } return(input) } @@ -223,7 +232,7 @@ edge$target_id, "@", edge$target_ns, "&format=html", sep = "" ) - + # Convert back to uniprot IDs matched_rows_source <- input[which(input$HgncId == edge$source_id), ] uniprot_ids_source <- unique(matched_rows_source$Protein) @@ -232,15 +241,15 @@ } else { edge$source_uniprot_id <- uniprot_ids_source } - + matched_rows_target <- input[which(input$HgncId == edge$target_id), ] - uniprot_ids_target = unique(matched_rows_target$Protein) + uniprot_ids_target <- unique(matched_rows_target$Protein) if (length(uniprot_ids_target) != 1) { edge$target_uniprot_id <- edge$target_name } else { edge$target_uniprot_id <- uniprot_ids_target } - + return(edge) } @@ -260,12 +269,12 @@ key <- paste(edge$source_id, edge$target_id, edge$data$stmt_type, sep = "_") json_object <- fromJSON(edge$data$stmt_json) if (!is.null(json_object$residue) && !is.null(json_object$position)) { - edge$site = paste0(json_object$residue, json_object$position) + edge$site <- paste0(json_object$residue, json_object$position) key <- paste(key, edge$site, sep = "_") } else { - edge$site = NA_character_ + edge$site <- NA_character_ } - if (!key %in% keys(edgeToMetadataMapping) || + if (!key %in% keys(edgeToMetadataMapping) || edge$data$evidence_count > edgeToMetadataMapping[[key]]$data$evidence_count) { edge <- .addAdditionalMetadataToIndraEdge(edge, input) edge$data$paper_count <- 1 # TODO: fix paper count @@ -321,8 +330,9 @@ # add correlation - maybe create a separate function if (!is.null(protein_level_data)) { protein_level_data <- protein_level_data[ - protein_level_data$Protein %in% edges$source | - protein_level_data$Protein %in% edges$target, ] + protein_level_data$Protein %in% edges$source | + protein_level_data$Protein %in% edges$target, + ] correlations <- .getCorrelationMatrixFromProteinLevelData(protein_level_data) edges$correlation <- apply(edges, 1, function(edge) { if (edge["source"] %in% rownames(correlations) && edge["target"] %in% colnames(correlations)) { @@ -342,10 +352,10 @@ #' @keywords internal #' @noRd .constructNodesDataFrame <- function(input, edges) { - nodes = input[, c("Protein", "HgncName", "Site", "log2FC", "adj.pvalue")] - colnames(nodes) = c("id", "hgncName", "Site", "logFC", "adj.pvalue") - - nodes = nodes[nodes$id %in% c(edges$source, edges$target), ] + nodes <- input[, c("Protein", "HgncName", "Site", "log2FC", "adj.pvalue")] + colnames(nodes) <- c("id", "hgncName", "Site", "logFC", "adj.pvalue") + + nodes <- nodes[nodes$id %in% c(edges$source, edges$target), ] extra_force_include_other <- setdiff(unique(c(edges$source, edges$target)), nodes$id) if (length(extra_force_include_other) > 0) { extra_nodes <- data.frame( @@ -358,20 +368,20 @@ ) nodes <- rbind(nodes, extra_nodes) } - nodes$hgncName = ifelse(is.na(nodes$hgncName), nodes$id, nodes$hgncName) - + nodes$hgncName <- ifelse(is.na(nodes$hgncName), nodes$id, nodes$hgncName) + return(nodes) } #' Filter Edges Data Frame #' @param edges response from INDRA #' @param paper_count_cutoff cutoff for number of papers -#' @param correlation_cutoff if protein_level_abundance is not NULL, apply a +#' @param correlation_cutoff if protein_level_abundance is not NULL, apply a #' cutoff for edges with correlation less than a specified cutoff. #' @return filtered edges data frame #' @keywords internal #' @noRd -.filterEdgesDataFrame <- function(edges, +.filterEdgesDataFrame <- function(edges, paper_count_cutoff, correlation_cutoff) { edges <- edges[which(edges$paperCount >= paper_count_cutoff), ] @@ -384,7 +394,7 @@ return(edges) } -.filterByCuration = function(nodes, edges, evidence_count_cutoff, filter_by_curation) { +.filterByCuration <- function(nodes, edges, evidence_count_cutoff, filter_by_curation) { if (filter_by_curation) { incorrect_counts <- numeric(nrow(edges)) for (i in seq_len(nrow(edges))) { @@ -398,12 +408,12 @@ return(list(nodes = nodes, edges = edges)) } -.filterByPtmSite = function(nodes, edges, filter_by_ptm_site) { +.filterByPtmSite <- function(nodes, edges, filter_by_ptm_site) { if (filter_by_ptm_site && nrow(nodes[!is.na(nodes$Site), ]) > 0) { ptm_overlap <- .ptmOverlap(edges, nodes) keep <- ptm_overlap[paste(edges$source, edges$target, edges$interaction, sep = "-")] edges <- edges[!is.na(keep) & keep != "", ] - edges <- edges[!is.na(edges$site),] + edges <- edges[!is.na(edges$site), ] nodes <- nodes[nodes$id %in% c(edges$source, edges$target), ] } return(list(nodes = nodes, edges = edges)) @@ -417,8 +427,8 @@ #' @keywords internal #' @noRd .getCorrelationMatrixFromProteinLevelData <- function(protein_level_data) { - Protein = LogIntensities = NULL - wide_data <- pivot_wider(protein_level_data[,c("Protein", "LogIntensities", "originalRUN")], names_from = Protein, values_from = LogIntensities) + Protein <- LogIntensities <- NULL + wide_data <- pivot_wider(protein_level_data[, c("Protein", "LogIntensities", "originalRUN")], names_from = Protein, values_from = LogIntensities) wide_data <- wide_data[, -which(names(wide_data) == "originalRUN")] if (any(colSums(!is.na(wide_data)) == 0)) { warning("protein_level_data contains proteins with all missing values, unable to calculate correlations for those proteins.") diff --git a/tests/testthat/test-annotateProteinInfoFromIndra.R b/tests/testthat/test-annotateProteinInfoFromIndra.R index c4d201c..99875e0 100644 --- a/tests/testthat/test-annotateProteinInfoFromIndra.R +++ b/tests/testthat/test-annotateProteinInfoFromIndra.R @@ -1,7 +1,7 @@ test_that("annotateProteinInfoFromIndra works correctly with Uniprot_Mnemonic", { df <- data.frame(Protein = c("CLH1_HUMAN")) annotated_df <- annotateProteinInfoFromIndra(df, "Uniprot_Mnemonic") - + expect_true("Protein" %in% colnames(annotated_df)) expect_true("UniprotId" %in% colnames(annotated_df)) expect_true("HgncId" %in% colnames(annotated_df)) @@ -16,7 +16,7 @@ test_that("annotateProteinInfoFromIndra works correctly with Uniprot_Mnemonic", expect_false(is.na(annotated_df$IsTranscriptionFactor)) expect_false(is.na(annotated_df$IsKinase)) expect_false(is.na(annotated_df$IsPhosphatase)) - + expect_equal(annotated_df$Protein, "CLH1_HUMAN") expect_equal(annotated_df$UniprotId, "Q00610") expect_equal(annotated_df$HgncId, "2092") @@ -24,7 +24,6 @@ test_that("annotateProteinInfoFromIndra works correctly with Uniprot_Mnemonic", expect_equal(annotated_df$IsTranscriptionFactor, FALSE) expect_equal(annotated_df$IsKinase, FALSE) expect_equal(annotated_df$IsPhosphatase, FALSE) - }) test_that("annotateProteinInfoFromIndra throws error for missing Protein column", { @@ -35,7 +34,7 @@ test_that("annotateProteinInfoFromIndra throws error for missing Protein column" test_that("annotateProteinInfoFromIndra works correctly with Uniprot", { df <- data.frame(Protein = c("Q00610")) annotated_df <- annotateProteinInfoFromIndra(df, "Uniprot") - + expect_true("Protein" %in% colnames(annotated_df)) expect_true("UniprotId" %in% colnames(annotated_df)) expect_true("HgncId" %in% colnames(annotated_df)) @@ -50,7 +49,7 @@ test_that("annotateProteinInfoFromIndra works correctly with Uniprot", { expect_false(is.na(annotated_df$IsTranscriptionFactor)) expect_false(is.na(annotated_df$IsKinase)) expect_false(is.na(annotated_df$IsPhosphatase)) - + expect_equal(annotated_df$Protein, "Q00610") expect_equal(annotated_df$UniprotId, "Q00610") expect_equal(annotated_df$HgncId, "2092") @@ -63,7 +62,7 @@ test_that("annotateProteinInfoFromIndra works correctly with Uniprot", { test_that("annotateProteinInfoFromIndra returns NA for unknown protein id", { df <- data.frame(Protein = c("ABC")) annotated_df <- annotateProteinInfoFromIndra(df, "Uniprot_Mnemonic") - + expect_true("Protein" %in% colnames(annotated_df)) expect_true("UniprotId" %in% colnames(annotated_df)) expect_true("HgncId" %in% colnames(annotated_df)) @@ -78,14 +77,14 @@ test_that("annotateProteinInfoFromIndra returns NA for unknown protein id", { expect_true(is.na(annotated_df$IsTranscriptionFactor)) expect_true(is.na(annotated_df$IsKinase)) expect_true(is.na(annotated_df$IsPhosphatase)) - + expect_equal(annotated_df$Protein, "ABC") }) test_that("annotateProteinInfoFromIndra works correctly with HGNC name", { df <- data.frame(Protein = c("EGFR")) annotated_df <- annotateProteinInfoFromIndra(df, "Hgnc_Name") - + expect_true("Protein" %in% colnames(annotated_df)) expect_true("UniprotId" %in% colnames(annotated_df)) expect_true("HgncId" %in% colnames(annotated_df)) @@ -93,19 +92,18 @@ test_that("annotateProteinInfoFromIndra works correctly with HGNC name", { expect_true("IsTranscriptionFactor" %in% colnames(annotated_df)) expect_true("IsKinase" %in% colnames(annotated_df)) expect_true("IsPhosphatase" %in% colnames(annotated_df)) - + expect_true(is.na(annotated_df$UniprotId)) expect_false(is.na(annotated_df$HgncId)) expect_false(is.na(annotated_df$HgncName)) expect_false(is.na(annotated_df$IsTranscriptionFactor)) expect_false(is.na(annotated_df$IsKinase)) expect_false(is.na(annotated_df$IsPhosphatase)) - + expect_equal(annotated_df$Protein, "EGFR") expect_equal(annotated_df$HgncId, "3236") expect_equal(annotated_df$HgncName, "EGFR") expect_type(annotated_df$IsTranscriptionFactor, "logical") expect_type(annotated_df$IsKinase, "logical") expect_type(annotated_df$IsPhosphatase, "logical") - -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-exportNetworkToHTML.R b/tests/testthat/test-exportNetworkToHTML.R index 3a49a29..8afe8dd 100644 --- a/tests/testthat/test-exportNetworkToHTML.R +++ b/tests/testthat/test-exportNetworkToHTML.R @@ -2,7 +2,7 @@ library(mockery) make_nodes <- function() { data.frame( - id = c("P53_HUMAN", "MDM2_HUMAN"), + id = c("P53_HUMAN", "MDM2_HUMAN"), logFC = c(1.5, -1.0), stringsAsFactors = FALSE ) @@ -10,8 +10,8 @@ make_nodes <- function() { make_edges <- function() { data.frame( - source = "P53_HUMAN", - target = "MDM2_HUMAN", + source = "P53_HUMAN", + target = "MDM2_HUMAN", interaction = "Activation", stringsAsFactors = FALSE ) @@ -19,12 +19,12 @@ make_edges <- function() { test_that("exportNetworkToHTML calls saveWidget with the correct filename", { tmp <- tempfile(fileext = ".html") - + save_widget_mock <- mock() stub(exportNetworkToHTML, "htmlwidgets::saveWidget", save_widget_mock) - + exportNetworkToHTML(make_nodes(), make_edges(), filename = tmp) - + expect_called(save_widget_mock, 1) call_args <- mock_args(save_widget_mock)[[1]] expect_equal(call_args$file, tmp) @@ -33,9 +33,9 @@ test_that("exportNetworkToHTML calls saveWidget with the correct filename", { test_that("exportNetworkToHTML calls saveWidget with selfcontained = TRUE", { save_widget_mock <- mock() stub(exportNetworkToHTML, "htmlwidgets::saveWidget", save_widget_mock) - + exportNetworkToHTML(make_nodes(), make_edges(), filename = tempfile(fileext = ".html")) - + call_args <- mock_args(save_widget_mock)[[1]] expect_true(call_args$selfcontained) }) @@ -43,9 +43,9 @@ test_that("exportNetworkToHTML calls saveWidget with selfcontained = TRUE", { test_that("exportNetworkToHTML passes a cytoscapeNetwork widget to saveWidget", { save_widget_mock <- mock() stub(exportNetworkToHTML, "htmlwidgets::saveWidget", save_widget_mock) - + exportNetworkToHTML(make_nodes(), make_edges(), filename = tempfile(fileext = ".html")) - + widget_arg <- mock_args(save_widget_mock)[[1]][[1]] expect_s3_class(widget_arg, "htmlwidget") expect_s3_class(widget_arg, "cytoscapeNetwork") @@ -54,11 +54,12 @@ test_that("exportNetworkToHTML passes a cytoscapeNetwork widget to saveWidget", test_that("exportNetworkToHTML passes nodeFontSize through to the widget", { save_widget_mock <- mock() stub(exportNetworkToHTML, "htmlwidgets::saveWidget", save_widget_mock) - + exportNetworkToHTML(make_nodes(), make_edges(), - filename = tempfile(fileext = ".html"), - nodeFontSize = 18) - + filename = tempfile(fileext = ".html"), + nodeFontSize = 18 + ) + widget_arg <- mock_args(save_widget_mock)[[1]][[1]] expect_equal(widget_arg$x$node_font_size, 18) }) @@ -66,18 +67,23 @@ test_that("exportNetworkToHTML passes nodeFontSize through to the widget", { test_that("exportNetworkToHTML passes displayLabelType through to the widget", { save_widget_mock <- mock() stub(exportNetworkToHTML, "htmlwidgets::saveWidget", save_widget_mock) - + nodes_hgnc <- make_nodes() nodes_hgnc$hgncName <- c("TP53", "MDM2") - + exportNetworkToHTML(nodes_hgnc, make_edges(), - filename = tempfile(fileext = ".html"), - displayLabelType = "hgncName") - - widget_arg <- mock_args(save_widget_mock)[[1]][[1]] - protein_nodes <- Filter(function(el) !is.null(el$data$node_type) && - el$data$node_type == "protein", - widget_arg$x$elements) + filename = tempfile(fileext = ".html"), + displayLabelType = "hgncName" + ) + + widget_arg <- mock_args(save_widget_mock)[[1]][[1]] + protein_nodes <- Filter( + function(el) { + !is.null(el$data$node_type) && + el$data$node_type == "protein" + }, + widget_arg$x$elements + ) labels <- sapply(protein_nodes, function(el) el$data$label) expect_length(labels, 2) expect_setequal(labels, c("TP53", "MDM2")) @@ -90,75 +96,78 @@ test_that("exportNetworkToHTML passes displayLabelType through to the widget", { test_that("previewNetworkInBrowser calls exportNetworkToHTML with a .html temp path", { export_mock <- mock(invisible(NULL)) stub(previewNetworkInBrowser, "exportNetworkToHTML", export_mock) - stub(previewNetworkInBrowser, "interactive", mock(FALSE)) - + stub(previewNetworkInBrowser, "interactive", mock(FALSE)) + previewNetworkInBrowser(make_nodes(), make_edges()) - + expect_called(export_mock, 1) call_args <- mock_args(export_mock)[[1]] expect_true(grepl("\\.html$", call_args$filename)) }) test_that("previewNetworkInBrowser calls browseURL when interactive() is TRUE", { - browse_mock <- mock(invisible(NULL)) - export_mock <- mock(invisible(NULL)) + browse_mock <- mock(invisible(NULL)) + export_mock <- mock(invisible(NULL)) mock_interactive <- mock(TRUE) - + stub(previewNetworkInBrowser, "exportNetworkToHTML", export_mock) - stub(previewNetworkInBrowser, "browseURL", browse_mock) - stub(previewNetworkInBrowser, "interactive", mock_interactive) - + stub(previewNetworkInBrowser, "browseURL", browse_mock) + stub(previewNetworkInBrowser, "interactive", mock_interactive) + previewNetworkInBrowser(make_nodes(), make_edges()) - + expect_called(browse_mock, 1) }) test_that("previewNetworkInBrowser passes the temp filename to browseURL", { captured_filename <- NULL browse_mock <- mock(invisible(NULL)) - - stub(previewNetworkInBrowser, "exportNetworkToHTML", - function(nodes, edges, filename, ...) { - captured_filename <<- filename - invisible(filename) - }) + + stub( + previewNetworkInBrowser, "exportNetworkToHTML", + function(nodes, edges, filename, ...) { + captured_filename <<- filename + invisible(filename) + } + ) stub(previewNetworkInBrowser, "browseURL", browse_mock) - stub(previewNetworkInBrowser, "interactive", mock(TRUE)) - + stub(previewNetworkInBrowser, "interactive", mock(TRUE)) + result <- previewNetworkInBrowser(make_nodes(), make_edges()) - + browse_arg <- mock_args(browse_mock)[[1]][[1]] expect_equal(browse_arg, captured_filename) - expect_equal(result, captured_filename) + expect_equal(result, captured_filename) }) test_that("previewNetworkInBrowser does NOT call browseURL when non-interactive", { browse_mock <- mock(invisible(NULL)) export_mock <- mock(invisible(NULL)) - - + + stub(previewNetworkInBrowser, "exportNetworkToHTML", export_mock) - stub(previewNetworkInBrowser, "utils::browseURL", browse_mock) - stub(previewNetworkInBrowser, "interactive", mock(FALSE)) - + stub(previewNetworkInBrowser, "utils::browseURL", browse_mock) + stub(previewNetworkInBrowser, "interactive", mock(FALSE)) + previewNetworkInBrowser(make_nodes(), make_edges()) - + expect_called(browse_mock, 0) }) test_that("previewNetworkInBrowser passes nodeFontSize and displayLabelType through", { export_mock <- mock(invisible(NULL)) stub(previewNetworkInBrowser, "exportNetworkToHTML", export_mock) - stub(previewNetworkInBrowser, "interactive", mock(FALSE)) - - nodes_hgnc <- make_nodes() - nodes_hgnc$hgncName <- c("TP53", "MDM2") - + stub(previewNetworkInBrowser, "interactive", mock(FALSE)) + + nodes_hgnc <- make_nodes() + nodes_hgnc$hgncName <- c("TP53", "MDM2") + previewNetworkInBrowser(nodes_hgnc, make_edges(), - displayLabelType = "hgncName", - nodeFontSize = 16) - + displayLabelType = "hgncName", + nodeFontSize = 16 + ) + call_args <- mock_args(export_mock)[[1]] expect_equal(call_args$displayLabelType, "hgncName") - expect_equal(call_args$nodeFontSize, 16) -}) \ No newline at end of file + expect_equal(call_args$nodeFontSize, 16) +}) diff --git a/tests/testthat/test-getSubnetworkFromIndra.R b/tests/testthat/test-getSubnetworkFromIndra.R index ddeca35..aea5cef 100644 --- a/tests/testthat/test-getSubnetworkFromIndra.R +++ b/tests/testthat/test-getSubnetworkFromIndra.R @@ -2,7 +2,7 @@ test_that("getSubnetworkFromIndra works correctly", { input <- data.table::fread( system.file("extdata/groupComparisonModel.csv", package = "MSstatsBioNet") ) - local_mocked_bindings(.callIndraCogexApi = function(x,y) { + local_mocked_bindings(.callIndraCogexApi = function(x, y) { return(readRDS(system.file("extdata/indraResponse.rds", package = "MSstatsBioNet"))) }) suppressWarnings(subnetwork <- getSubnetworkFromIndra(input, statement_types = c("Activation", "Phosphorylation"))) @@ -14,7 +14,7 @@ test_that("getSubnetworkFromIndra with different statement type works correctly" input <- data.table::fread( system.file("extdata/groupComparisonModel.csv", package = "MSstatsBioNet") ) - local_mocked_bindings(.callIndraCogexApi = function(x,y) { + local_mocked_bindings(.callIndraCogexApi = function(x, y) { return(readRDS(system.file("extdata/indraResponse.rds", package = "MSstatsBioNet"))) }) suppressWarnings( diff --git a/tests/testthat/test-utils_annotateProteinInfoFromIndra.R.R b/tests/testthat/test-utils_annotateProteinInfoFromIndra.R.R index 53f0fe9..cd6d238 100644 --- a/tests/testthat/test-utils_annotateProteinInfoFromIndra.R.R +++ b/tests/testthat/test-utils_annotateProteinInfoFromIndra.R.R @@ -84,4 +84,3 @@ test_that(".callGetHgncIdsFromGildaApi works correctly", { expected_value <- c("EGFR" = "3236", "CHEK1" = "1925") expect_equal(result, expected_value) }) - diff --git a/tests/testthat/test-utils_cytoscapeNetwork.R b/tests/testthat/test-utils_cytoscapeNetwork.R index b36eecb..f8ef4d1 100644 --- a/tests/testthat/test-utils_cytoscapeNetwork.R +++ b/tests/testthat/test-utils_cytoscapeNetwork.R @@ -4,9 +4,9 @@ create_mock_nodes <- function() { data.frame( - id = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN", "BRCA1_HUMAN"), - logFC = c(2.5, -1.8, 1.2, -2.1), - pvalue = c(0.001, 0.02, 0.03, 0.005), + id = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN", "BRCA1_HUMAN"), + logFC = c(2.5, -1.8, 1.2, -2.1), + pvalue = c(0.001, 0.02, 0.03, 0.005), hgncName = c("TP53", "MDM2", "ATM", "BRCA1"), stringsAsFactors = FALSE ) @@ -14,18 +14,18 @@ create_mock_nodes <- function() { create_mock_nodes_ptm <- function() { data.frame( - id = c("P53_HUMAN", "MDM2_HUMAN"), - logFC = c(2.5, -1.8), + id = c("P53_HUMAN", "MDM2_HUMAN"), + logFC = c(2.5, -1.8), hgncName = c("TP53", "MDM2"), - Site = c(NA, "S15_S20"), + Site = c(NA, "S15_S20"), stringsAsFactors = FALSE ) } create_mock_edges <- function() { data.frame( - source = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN", "P53_HUMAN", "BRCA1_HUMAN"), - target = c("MDM2_HUMAN", "P53_HUMAN", "P53_HUMAN", "BRCA1_HUMAN", "P53_HUMAN"), + source = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN", "P53_HUMAN", "BRCA1_HUMAN"), + target = c("MDM2_HUMAN", "P53_HUMAN", "P53_HUMAN", "BRCA1_HUMAN", "P53_HUMAN"), interaction = c("Inhibition", "Inhibition", "Phosphorylation", "Complex", "Complex"), evidenceLink = c("link1", "link2", "link3", "link4", "link5"), stringsAsFactors = FALSE @@ -34,10 +34,10 @@ create_mock_edges <- function() { create_mock_edges_ptm <- function() { data.frame( - source = c("P53_HUMAN"), - target = c("MDM2_HUMAN"), + source = c("P53_HUMAN"), + target = c("MDM2_HUMAN"), interaction = c("Phosphorylation"), - site = c("S15"), + site = c("S15"), stringsAsFactors = FALSE ) } @@ -81,14 +81,14 @@ test_that(".mapLogFCToColor handles Inf and -Inf values", { test_that(".relProps returns correct structure", { props <- MSstatsBioNet:::.relProps() - + expect_type(props, "list") expect_true(all(c("complex", "regulatory", "phosphorylation", "other") %in% names(props))) - + expect_equal(props$complex$consolidate, "undirected") expect_equal(props$regulatory$consolidate, "bidirectional") expect_equal(props$phosphorylation$consolidate, "directed") - + expect_true("Inhibition" %in% names(props$regulatory$colors)) expect_true("Activation" %in% names(props$regulatory$colors)) }) @@ -98,11 +98,11 @@ test_that(".relProps returns correct structure", { # ============================================================================= test_that(".classify maps interaction types to correct categories", { - expect_equal(MSstatsBioNet:::.classify("Inhibition"), "regulatory") - expect_equal(MSstatsBioNet:::.classify("Activation"), "regulatory") + expect_equal(MSstatsBioNet:::.classify("Inhibition"), "regulatory") + expect_equal(MSstatsBioNet:::.classify("Activation"), "regulatory") expect_equal(MSstatsBioNet:::.classify("Phosphorylation"), "phosphorylation") - expect_equal(MSstatsBioNet:::.classify("Complex"), "complex") - expect_equal(MSstatsBioNet:::.classify("Unknown"), "other") + expect_equal(MSstatsBioNet:::.classify("Complex"), "complex") + expect_equal(MSstatsBioNet:::.classify("Unknown"), "other") }) # ============================================================================= @@ -113,7 +113,7 @@ test_that(".edgeStyle returns correct colour for regulatory interactions", { style <- MSstatsBioNet:::.edgeStyle("Inhibition", "regulatory", "directed") expect_type(style, "list") expect_equal(style$color, "#FF4444") - + style_act <- MSstatsBioNet:::.edgeStyle("Activation", "regulatory", "directed") expect_equal(style_act$color, "#44AA44") }) @@ -141,10 +141,10 @@ test_that(".edgeStyle falls back to grey for unknown category", { test_that(".consolidateEdges consolidates bidirectional inhibition into one edge", { edges <- create_mock_edges() result <- MSstatsBioNet:::.consolidateEdges(edges) - + expect_s3_class(result, "data.frame") expect_true(all(c("edge_type", "category", "ptm_overlap") %in% names(result))) - + # Two Inhibition edges in opposite directions → one bidirectional edge inhibition <- result[grepl("Inhibition", result$interaction), ] expect_equal(nrow(inhibition), 1) @@ -154,7 +154,7 @@ test_that(".consolidateEdges consolidates bidirectional inhibition into one edge test_that(".consolidateEdges marks phosphorylation as directed", { edges <- create_mock_edges() result <- MSstatsBioNet:::.consolidateEdges(edges) - + phospho <- result[result$interaction == "Phosphorylation", ] expect_equal(nrow(phospho), 1) expect_equal(phospho$edge_type, "directed") @@ -164,15 +164,17 @@ test_that(".consolidateEdges marks phosphorylation as directed", { test_that(".consolidateEdges marks complex as undirected", { edges <- create_mock_edges() result <- MSstatsBioNet:::.consolidateEdges(edges) - + complex <- result[result$interaction == "Complex", ] expect_equal(nrow(complex), 1) expect_equal(complex$edge_type, "undirected") }) test_that(".consolidateEdges handles empty input", { - empty <- data.frame(source = character(0), target = character(0), - interaction = character(0), stringsAsFactors = FALSE) + empty <- data.frame( + source = character(0), target = character(0), + interaction = character(0), stringsAsFactors = FALSE + ) result <- MSstatsBioNet:::.consolidateEdges(empty) expect_equal(nrow(result), 0) }) @@ -184,7 +186,7 @@ test_that(".consolidateEdges handles empty input", { test_that(".ptmOverlap detects overlapping PTM sites", { nodes <- create_mock_nodes_ptm() edges <- create_mock_edges_ptm() - + result <- MSstatsBioNet:::.ptmOverlap(edges, nodes) expect_type(result, "character") expect_length(result, 1) @@ -193,17 +195,21 @@ test_that(".ptmOverlap detects overlapping PTM sites", { test_that(".ptmOverlap returns empty string when no overlap", { nodes <- create_mock_nodes_ptm() - edges <- data.frame(source = "P53_HUMAN", target = "MDM2_HUMAN", - interaction = "Phosphorylation", site = "T999", - stringsAsFactors = FALSE) + edges <- data.frame( + source = "P53_HUMAN", target = "MDM2_HUMAN", + interaction = "Phosphorylation", site = "T999", + stringsAsFactors = FALSE + ) result <- MSstatsBioNet:::.ptmOverlap(edges, nodes) expect_equal(result[[1]], "") }) test_that(".ptmOverlap handles empty edges gracefully", { - nodes <- create_mock_nodes_ptm() - empty <- data.frame(source = character(0), target = character(0), - interaction = character(0), stringsAsFactors = FALSE) + nodes <- create_mock_nodes_ptm() + empty <- data.frame( + source = character(0), target = character(0), + interaction = character(0), stringsAsFactors = FALSE + ) result <- MSstatsBioNet:::.ptmOverlap(empty, nodes) expect_length(result, 0) }) @@ -213,40 +219,42 @@ test_that(".ptmOverlap handles empty edges gracefully", { # ============================================================================= test_that(".buildElements returns a list of elements", { - nodes <- create_mock_nodes() - edges <- create_mock_edges() + nodes <- create_mock_nodes() + edges <- create_mock_edges() result <- MSstatsBioNet:::.buildElements(nodes, edges) - + expect_type(result, "list") - expect_gt(length(result), nrow(nodes)) # nodes + edges + expect_gt(length(result), nrow(nodes)) # nodes + edges }) test_that(".buildElements assigns correct node_type to proteins", { - nodes <- create_mock_nodes() + nodes <- create_mock_nodes() result <- MSstatsBioNet:::.buildElements(nodes, data.frame()) - + node_types <- sapply(result, function(el) el$data$node_type) expect_true(all(node_types == "protein")) }) test_that(".buildElements creates PTM child nodes and attachment edges", { - nodes <- create_mock_nodes_ptm() + nodes <- create_mock_nodes_ptm() result <- MSstatsBioNet:::.buildElements(nodes, data.frame()) - + node_types <- sapply(result, function(el) el$data$node_type) expect_true("ptm" %in% node_types) expect_true("compound" %in% node_types) - + edge_types <- sapply(result, function(el) el$data$edge_type) expect_true("ptm_attachment" %in% edge_types) }) test_that(".buildElements uses hgncName label when requested", { - nodes <- create_mock_nodes() + nodes <- create_mock_nodes() result <- MSstatsBioNet:::.buildElements(nodes, data.frame(), "hgncName") - - protein_nodes <- Filter(function(el) !is.null(el$data$node_type) && - el$data$node_type == "protein", result) + + protein_nodes <- Filter(function(el) { + !is.null(el$data$node_type) && + el$data$node_type == "protein" + }, result) labels <- sapply(protein_nodes, function(el) el$data$label) expect_true(all(labels %in% c("TP53", "MDM2", "ATM", "BRCA1"))) }) @@ -255,32 +263,38 @@ test_that(".buildElements falls back to id when hgncName is NA", { nodes <- create_mock_nodes() nodes$hgncName <- NA result <- MSstatsBioNet:::.buildElements(nodes, data.frame(), "hgncName") - - protein_nodes <- Filter(function(el) !is.null(el$data$node_type) && - el$data$node_type == "protein", result) + + protein_nodes <- Filter(function(el) { + !is.null(el$data$node_type) && + el$data$node_type == "protein" + }, result) labels <- sapply(protein_nodes, function(el) el$data$label) expect_true(all(labels %in% nodes$id)) }) test_that(".buildElements computes width and height from label length", { - nodes <- create_mock_nodes() + nodes <- create_mock_nodes() result <- MSstatsBioNet:::.buildElements(nodes, data.frame()) - - protein_nodes <- Filter(function(el) !is.null(el$data$node_type) && - el$data$node_type == "protein", result) - widths <- sapply(protein_nodes, function(el) el$data$width) + + protein_nodes <- Filter(function(el) { + !is.null(el$data$node_type) && + el$data$node_type == "protein" + }, result) + widths <- sapply(protein_nodes, function(el) el$data$width) heights <- sapply(protein_nodes, function(el) el$data$height) - - expect_true(all(widths >= 60 & widths <= 150)) - expect_true(all(heights >= 40 & heights <= 60)) + + expect_true(all(widths >= 60 & widths <= 150)) + expect_true(all(heights >= 40 & heights <= 60)) }) test_that(".buildElements uses grey when logFC column is absent", { nodes <- create_mock_nodes()[, !names(create_mock_nodes()) %in% "logFC"] result <- MSstatsBioNet:::.buildElements(nodes, data.frame()) - - protein_nodes <- Filter(function(el) !is.null(el$data$node_type) && - el$data$node_type == "protein", result) + + protein_nodes <- Filter(function(el) { + !is.null(el$data$node_type) && + el$data$node_type == "protein" + }, result) colors <- sapply(protein_nodes, function(el) el$data$color) expect_true(all(colors == "#D3D3D3")) }) @@ -298,13 +312,14 @@ test_that("cytoscapeNetwork() returns an htmlwidget", { test_that("cytoscapeNetwork() x list contains elements and layout", { w <- cytoscapeNetwork(create_mock_nodes(), create_mock_edges()) expect_true("elements" %in% names(w$x)) - expect_true("layout" %in% names(w$x)) + expect_true("layout" %in% names(w$x)) expect_gt(length(w$x$elements), 0) }) test_that("cytoscapeNetwork() passes custom layout options through", { w <- cytoscapeNetwork(create_mock_nodes(), create_mock_edges(), - layoutOptions = list(rankDir = "LR", rankSep = 120)) + layoutOptions = list(rankDir = "LR", rankSep = 120) + ) expect_equal(w$x$layout$rankDir, "LR") expect_equal(w$x$layout$rankSep, 120) }) @@ -315,8 +330,10 @@ test_that("cytoscapeNetwork() passes nodeFontSize through", { }) test_that("cytoscapeNetwork() accepts empty edges", { - empty_edges <- data.frame(source = character(0), target = character(0), - interaction = character(0), stringsAsFactors = FALSE) + empty_edges <- data.frame( + source = character(0), target = character(0), + interaction = character(0), stringsAsFactors = FALSE + ) expect_no_error(cytoscapeNetwork(create_mock_nodes(), empty_edges)) }) @@ -327,4 +344,4 @@ test_that("cytoscapeNetwork() errors when nodes has no id column", { test_that("cytoscapeNetwork() errors when nodes is not a data frame", { expect_error(cytoscapeNetwork(list(id = "A")), "id column|data frame") -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-utils_getSubnetworkFromIndra.R b/tests/testthat/test-utils_getSubnetworkFromIndra.R index afd76db..f6e904a 100644 --- a/tests/testthat/test-utils_getSubnetworkFromIndra.R +++ b/tests/testthat/test-utils_getSubnetworkFromIndra.R @@ -1,123 +1,129 @@ -describe(".filterByPtmSite", { +describe(".filterByPtmSite", { make_nodes <- function() { data.frame( - id = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN"), - logFC = c(1.5, -1.0, 0.5), - Site = c("S15_S20", "T68", NA), + id = c("P53_HUMAN", "MDM2_HUMAN", "ATM_HUMAN"), + logFC = c(1.5, -1.0, 0.5), + Site = c("S15_S20", "T68", NA), stringsAsFactors = FALSE ) } - + make_edges <- function() { data.frame( - source = c("ATM_HUMAN", "ATM_HUMAN", "P53_HUMAN", "P53_HUMAN"), - target = c("P53_HUMAN", "MDM2_HUMAN", "MDM2_HUMAN", "ATM_HUMAN"), + source = c("ATM_HUMAN", "ATM_HUMAN", "P53_HUMAN", "P53_HUMAN"), + target = c("P53_HUMAN", "MDM2_HUMAN", "MDM2_HUMAN", "ATM_HUMAN"), interaction = c("Phosphorylation", "Phosphorylation", "Activation", "Activation"), - site = c("S15", "T999", NA, "S15"), + site = c("S15", "T999", NA, "S15"), stringsAsFactors = FALSE ) } - + test_that(".filterByPtmSite returns input unchanged when filter_by_ptm_site = FALSE", { - nodes <- make_nodes() - edges <- make_edges() + nodes <- make_nodes() + edges <- make_edges() result <- MSstatsBioNet:::.filterByPtmSite(nodes, edges, filter_by_ptm_site = FALSE) - + expect_equal(nrow(result$nodes), nrow(nodes)) expect_equal(nrow(result$edges), nrow(edges)) expect_equal(result$nodes, nodes) expect_equal(result$edges, edges) }) - + test_that(".filterByPtmSite returns input unchanged when no nodes have Site data", { - nodes <- make_nodes() - nodes$Site <- NA # wipe all sites - edges <- make_edges() - + nodes <- make_nodes() + nodes$Site <- NA # wipe all sites + edges <- make_edges() + result <- MSstatsBioNet:::.filterByPtmSite(nodes, edges, filter_by_ptm_site = TRUE) - + expect_equal(nrow(result$nodes), nrow(nodes)) expect_equal(nrow(result$edges), nrow(edges)) }) - + test_that(".filterByPtmSite keeps only edges with PTM site overlap on target node", { result <- MSstatsBioNet:::.filterByPtmSite(make_nodes(), make_edges(), - filter_by_ptm_site = TRUE) + filter_by_ptm_site = TRUE + ) # Only ATM→P53 with site=S15 should survive expect_equal(nrow(result$edges), 1) - expect_equal(result$edges$source, "ATM_HUMAN") - expect_equal(result$edges$target, "P53_HUMAN") - expect_equal(result$edges$site, "S15") + expect_equal(result$edges$source, "ATM_HUMAN") + expect_equal(result$edges$target, "P53_HUMAN") + expect_equal(result$edges$site, "S15") }) - + test_that(".filterByPtmSite drops edges where edge site does not overlap node Site", { result <- MSstatsBioNet:::.filterByPtmSite(make_nodes(), make_edges(), - filter_by_ptm_site = TRUE) + filter_by_ptm_site = TRUE + ) # ATM→MDM2 with site=T999 should be gone (T999 not in MDM2's T68) dropped <- result$edges[result$edges$source == "ATM_HUMAN" & - result$edges$target == "MDM2_HUMAN", ] + result$edges$target == "MDM2_HUMAN", ] expect_equal(nrow(dropped), 0) }) - + test_that(".filterByPtmSite drops edges with NA edge site even if node has Site data", { result <- MSstatsBioNet:::.filterByPtmSite(make_nodes(), make_edges(), - filter_by_ptm_site = TRUE) + filter_by_ptm_site = TRUE + ) # P53→MDM2 has site=NA so must be dropped dropped <- result$edges[result$edges$source == "P53_HUMAN" & - result$edges$target == "MDM2_HUMAN", ] + result$edges$target == "MDM2_HUMAN", ] expect_equal(nrow(dropped), 0) }) - + test_that(".filterByPtmSite drops edges where target node has no Site data", { result <- MSstatsBioNet:::.filterByPtmSite(make_nodes(), make_edges(), - filter_by_ptm_site = TRUE) + filter_by_ptm_site = TRUE + ) # P53→ATM: ATM node Site is NA so no overlap possible dropped <- result$edges[result$edges$source == "P53_HUMAN" & - result$edges$target == "ATM_HUMAN", ] + result$edges$target == "ATM_HUMAN", ] expect_equal(nrow(dropped), 0) }) - + test_that(".filterByPtmSite prunes nodes to only those in surviving edges", { result <- MSstatsBioNet:::.filterByPtmSite(make_nodes(), make_edges(), - filter_by_ptm_site = TRUE) + filter_by_ptm_site = TRUE + ) # Only ATM_HUMAN (source) and P53_HUMAN (target) should remain expect_setequal(result$nodes$id, c("ATM_HUMAN", "P53_HUMAN")) expect_false("MDM2_HUMAN" %in% result$nodes$id) }) - + test_that(".filterByPtmSite preserves all node columns after pruning", { result <- MSstatsBioNet:::.filterByPtmSite(make_nodes(), make_edges(), - filter_by_ptm_site = TRUE) + filter_by_ptm_site = TRUE + ) expect_true(all(c("id", "logFC", "Site") %in% names(result$nodes))) }) - + test_that(".filterByPtmSite keeps edge when site matches any of multiple node sites", { nodes <- data.frame( - id = c("A", "B"), + id = c("A", "B"), Site = c("S15_S20_T68", NA), stringsAsFactors = FALSE ) edges <- data.frame( - source = "A", - target = "B", + source = "A", + target = "B", interaction = "Phosphorylation", - site = "S20", # matches second site in A's Site string + site = "S20", # matches second site in A's Site string stringsAsFactors = FALSE ) # Note: filter checks target node — B has no Site, so this should drop. # Swap so A is the target to test multi-site matching. edges2 <- data.frame( - source = "B", - target = "A", + source = "B", + target = "A", interaction = "Phosphorylation", - site = "S20", + site = "S20", stringsAsFactors = FALSE ) result <- MSstatsBioNet:::.filterByPtmSite(nodes, edges2, filter_by_ptm_site = TRUE) expect_equal(nrow(result$edges), 1) expect_equal(result$edges$site, "S20") }) - + test_that(".filterByPtmSite handles empty edges gracefully", { nodes <- make_nodes() empty_edges <- data.frame( @@ -126,12 +132,13 @@ describe(".filterByPtmSite", { stringsAsFactors = FALSE ) result <- MSstatsBioNet:::.filterByPtmSite(nodes, empty_edges, - filter_by_ptm_site = TRUE) + filter_by_ptm_site = TRUE + ) expect_equal(nrow(result$edges), 0) # All nodes pruned since no edges reference them expect_equal(nrow(result$nodes), 0) }) - + test_that(".filterByPtmSite handles empty nodes gracefully", { empty_nodes <- data.frame( id = character(0), Site = character(0), @@ -140,13 +147,15 @@ describe(".filterByPtmSite", { edges <- make_edges() # No nodes have Site data so passthrough expected result <- MSstatsBioNet:::.filterByPtmSite(empty_nodes, edges, - filter_by_ptm_site = TRUE) + filter_by_ptm_site = TRUE + ) expect_equal(nrow(result$edges), nrow(edges)) }) - + test_that(".filterByPtmSite always returns a list with nodes and edges", { result <- MSstatsBioNet:::.filterByPtmSite(make_nodes(), make_edges(), - filter_by_ptm_site = TRUE) + filter_by_ptm_site = TRUE + ) expect_type(result, "list") expect_true(all(c("nodes", "edges") %in% names(result))) expect_s3_class(result$nodes, "data.frame") @@ -157,57 +166,63 @@ describe(".filterByPtmSite", { describe(".filterGetSubnetworkFromIndraInput", { .make_test_input <- function() { data.frame( - Protein = c("A", "B", "C", "D"), - log2FC = c(3, -3, 0.5, Inf), + Protein = c("A", "B", "C", "D"), + log2FC = c(3, -3, 0.5, Inf), adj.pvalue = c(0.01, 0.01, 0.5, 0.01), stringsAsFactors = FALSE ) } - + test_that(".filterGetSubnetworkFromIndraInput filters by pvalueCutoff", { result <- MSstatsBioNet:::.filterGetSubnetworkFromIndraInput( - .make_test_input(), pvalueCutoff = 0.05, logfc_cutoff = NULL, + .make_test_input(), + pvalueCutoff = 0.05, logfc_cutoff = NULL, force_include_other = NULL, include_infinite_fc = FALSE, direction = "both" ) expect_true(all(result$adj.pvalue < 0.05)) }) - + test_that(".filterGetSubnetworkFromIndraInput filters by logfc_cutoff", { result <- MSstatsBioNet:::.filterGetSubnetworkFromIndraInput( - .make_test_input(), pvalueCutoff = NULL, logfc_cutoff = 1, + .make_test_input(), + pvalueCutoff = NULL, logfc_cutoff = 1, force_include_other = NULL, include_infinite_fc = FALSE, direction = "both" ) expect_true(all(abs(result$log2FC) > 1)) }) - + test_that(".filterGetSubnetworkFromIndraInput respects force_include_other", { input <- cbind(.make_test_input(), HgncId = c("1", "2", "3", "4")) result <- MSstatsBioNet:::.filterGetSubnetworkFromIndraInput( - input, pvalueCutoff = 0.001, logfc_cutoff = 10, + input, + pvalueCutoff = 0.001, logfc_cutoff = 10, force_include_other = c("HGNC:1"), include_infinite_fc = FALSE, direction = "both" ) expect_true("A" %in% result$Protein) }) - + test_that(".filterGetSubnetworkFromIndraInput includes infinite FC when requested", { result <- MSstatsBioNet:::.filterGetSubnetworkFromIndraInput( - .make_test_input(), pvalueCutoff = NULL, logfc_cutoff = 5, + .make_test_input(), + pvalueCutoff = NULL, logfc_cutoff = 5, force_include_other = NULL, include_infinite_fc = TRUE, direction = "both" ) expect_true("D" %in% result$Protein) }) - + test_that(".filterGetSubnetworkFromIndraInput filters by direction up", { result <- MSstatsBioNet:::.filterGetSubnetworkFromIndraInput( - .make_test_input(), pvalueCutoff = NULL, logfc_cutoff = NULL, + .make_test_input(), + pvalueCutoff = NULL, logfc_cutoff = NULL, force_include_other = NULL, include_infinite_fc = FALSE, direction = "up" ) expect_true(all(result$log2FC > 0)) }) - + test_that(".filterGetSubnetworkFromIndraInput filters by direction down", { result <- MSstatsBioNet:::.filterGetSubnetworkFromIndraInput( - .make_test_input(), pvalueCutoff = NULL, logfc_cutoff = NULL, + .make_test_input(), + pvalueCutoff = NULL, logfc_cutoff = NULL, force_include_other = NULL, include_infinite_fc = FALSE, direction = "down" ) expect_true(all(result$log2FC < 0)) diff --git a/vignettes/Cytoscape-Visualization.Rmd b/vignettes/Cytoscape-Visualization.Rmd index 2f0e128..f17a5a3 100644 --- a/vignettes/Cytoscape-Visualization.Rmd +++ b/vignettes/Cytoscape-Visualization.Rmd @@ -13,13 +13,13 @@ vignette: > library(MSstatsBioNet) nodes_min <- data.frame( - id = c("TP53", "MDM2", "CDKN1A"), + id = c("TP53", "MDM2", "CDKN1A"), stringsAsFactors = FALSE ) edges_min <- data.frame( - source = c("TP53", "MDM2"), - target = c("MDM2", "TP53"), + source = c("TP53", "MDM2"), + target = c("MDM2", "TP53"), interaction = c("Activation", "Inhibition"), stringsAsFactors = FALSE ) @@ -31,14 +31,14 @@ cytoscapeNetwork(nodes_min, edges_min) # Nodes coloured on a blue (down) → grey (neutral) → red (up) scale. nodes_fc <- data.frame( - id = c("TP53", "MDM2", "CDKN1A", "BCL2", "BAX"), - logFC = c( 1.5, -0.8, 2.1, -1.9, 0.3), + id = c("TP53", "MDM2", "CDKN1A", "BCL2", "BAX"), + logFC = c(1.5, -0.8, 2.1, -1.9, 0.3), stringsAsFactors = FALSE ) edges_fc <- data.frame( - source = c("TP53", "TP53", "MDM2", "BCL2"), - target = c("MDM2", "CDKN1A", "TP53", "BAX"), + source = c("TP53", "TP53", "MDM2", "BCL2"), + target = c("MDM2", "CDKN1A", "TP53", "BAX"), interaction = c("Activation", "IncreaseAmount", "Inhibition", "Complex"), stringsAsFactors = FALSE ) @@ -52,17 +52,17 @@ cytoscapeNetwork(nodes_fc, edges_fc) # information when an edge target shares a PTM site with node data. nodes_ptm <- data.frame( - id = c("EGFR", "SRC", "AKT1"), - logFC = c( 1.2, 0.5, -0.3), - Site = c("Y1068_Y1173", "Y416", NA), + id = c("EGFR", "SRC", "AKT1"), + logFC = c(1.2, 0.5, -0.3), + Site = c("Y1068_Y1173", "Y416", NA), stringsAsFactors = FALSE ) edges_ptm <- data.frame( - source = c("EGFR", "SRC"), - target = c("SRC", "AKT1"), + source = c("EGFR", "SRC"), + target = c("SRC", "AKT1"), interaction = c("Phosphorylation", "Activation"), - site = c("Y416", NA), # edge targets a specific site + site = c("Y416", NA), # edge targets a specific site stringsAsFactors = FALSE ) @@ -72,15 +72,15 @@ cytoscapeNetwork(nodes_ptm, edges_ptm, nodeFontSize = 14) # ── Example 4 · HGNC labels + left-to-right layout ───────────────────────── nodes_hgnc <- data.frame( - id = c("ENSG001", "ENSG002", "ENSG003"), - hgncName = c("TP53", "MDM2", "CDKN1A"), - logFC = c( 1.0, -0.5, 2.0), + id = c("ENSG001", "ENSG002", "ENSG003"), + hgncName = c("TP53", "MDM2", "CDKN1A"), + logFC = c(1.0, -0.5, 2.0), stringsAsFactors = FALSE ) edges_hgnc <- data.frame( - source = c("ENSG001", "ENSG001"), - target = c("ENSG002", "ENSG003"), + source = c("ENSG001", "ENSG001"), + target = c("ENSG002", "ENSG003"), interaction = c("Activation", "IncreaseAmount"), stringsAsFactors = FALSE ) @@ -88,7 +88,7 @@ edges_hgnc <- data.frame( cytoscapeNetwork( nodes_hgnc, edges_hgnc, displayLabelType = "hgncName", - layoutOptions = list(rankDir = "LR", rankSep = 120) + layoutOptions = list(rankDir = "LR", rankSep = 120) ) @@ -96,10 +96,10 @@ cytoscapeNetwork( # Click an edge to open the evidence URL in a new tab. edges_ev <- data.frame( - source = c("TP53", "MDM2"), - target = c("MDM2", "TP53"), - interaction = c("Activation", "Inhibition"), - evidenceLink = c( + source = c("TP53", "MDM2"), + target = c("MDM2", "TP53"), + interaction = c("Activation", "Inhibition"), + evidenceLink = c( "https://www.ncbi.nlm.nih.gov/pubmed/10490031", "https://www.ncbi.nlm.nih.gov/pubmed/16474400" ), @@ -118,12 +118,13 @@ if (requireNamespace("shiny", quietly = TRUE)) { sidebarPanel( sliderInput("font_size", "Node font size", min = 8, max = 24, value = 12), selectInput("layout_dir", "Layout direction", - choices = c("Top-Bottom" = "TB", "Left-Right" = "LR"), - selected = "TB") + choices = c("Top-Bottom" = "TB", "Left-Right" = "LR"), + selected = "TB" + ) ), mainPanel( cytoscapeNetworkOutput("network", height = "600px"), - style = "height: 650px;" + style = "height: 650px;" ) ) ) @@ -141,18 +142,17 @@ if (requireNamespace("shiny", quietly = TRUE)) { } - # ── Example 7 · Save to a standalone HTML file ────────────────────────────── widget <- cytoscapeNetwork(nodes_ptm, edges_ptm) if (requireNamespace("rmarkdown", quietly = TRUE) && rmarkdown::pandoc_available()) { - htmlwidgets::saveWidget( - widget, - file = tempfile("network-", fileext = ".html"), - selfcontained = FALSE - ) + htmlwidgets::saveWidget( + widget, + file = tempfile("network-", fileext = ".html"), + selfcontained = FALSE + ) } # browseURL("network.html") # open in browser -``` \ No newline at end of file +``` diff --git a/vignettes/MSstatsBioNet.Rmd b/vignettes/MSstatsBioNet.Rmd index d3fd498..96c16fc 100644 --- a/vignettes/MSstatsBioNet.Rmd +++ b/vignettes/MSstatsBioNet.Rmd @@ -42,7 +42,7 @@ networks. The package is designed to be used in conjunction with the We will be taking a subset of the dataset found in this [paper](https://pmc.ncbi.nlm.nih.gov/articles/PMC7331093/). ```{r} -input = data.table::fread(system.file( +input <- data.table::fread(system.file( "extdata/msstats.csv", package = "MSstatsBioNet" )) @@ -52,7 +52,7 @@ input = data.table::fread(system.file( ```{r} library(MSstatsConvert) -msstats_imported = FragPipetoMSstatsFormat(input, use_log_file = FALSE) +msstats_imported <- FragPipetoMSstatsFormat(input, use_log_file = FALSE) head(msstats_imported) ``` @@ -95,7 +95,7 @@ can also extract other information, such as hgnc gene name and protein function. ```{r} library(MSstatsBioNet) -annotated_df = annotateProteinInfoFromIndra(model$ComparisonResult, "Uniprot") +annotated_df <- annotateProteinInfoFromIndra(model$ComparisonResult, "Uniprot") head(annotated_df) ``` @@ -107,8 +107,8 @@ analysis results. ```{r} subnetwork <- getSubnetworkFromIndra( - annotated_df, - pvalueCutoff = 0.05, + annotated_df, + pvalueCutoff = 0.05, statement_types = c("Complex", "IncreaseAmount", "DecreaseAmount", "Inhibition", "Activation", "Phosphorylation") ) head(subnetwork$nodes) diff --git a/vignettes/PTM-Analysis.Rmd b/vignettes/PTM-Analysis.Rmd index 10d43ca..232b134 100644 --- a/vignettes/PTM-Analysis.Rmd +++ b/vignettes/PTM-Analysis.Rmd @@ -33,7 +33,7 @@ BiocManager::install("MSstatsBioNet") We will be taking a subset of the dataset found in this [paper](https://www.biorxiv.org/content/10.1101/2024.10.21.619348v1). The table is the output of the MSstatsPTM function `groupComparisonPTM` (filtered down to the columns that are actually needed) ```{r} -input = data.table::fread(system.file( +input <- data.table::fread(system.file( "extdata/garrido-2024.csv", package = "MSstatsBioNet" )) @@ -48,7 +48,7 @@ In the below example, we convert uniprot IDs to their corresponding Hgnc IDs. We ```{r} library(MSstatsBioNet) -annotated_df = annotateProteinInfoFromIndra(input, "Uniprot") +annotated_df <- annotateProteinInfoFromIndra(input, "Uniprot") head(annotated_df) ```