Merge branch 'master' of github.com:saezlab/cosmosR

DESCRIPTION

@@ -50,6 +50,8 @@ Suggests:
     knitr,
     rmarkdown,
     piano,
-    ggplot2
+    ggplot2,
+    stringi,
+    reshape2
 biocViews: CellBiology, Pathways, Network, Proteomics, Metabolomics, Transcriptomics,
     GeneSignaling

NAMESPACE

@@ -2,21 +2,30 @@
 
 S3method(print,cosmos_data)
 export(compress_same_children)
+export(createLinearColors)
+export(decompress_moon_result)
 export(decompress_solution_network)
 export(decoupleRnival)
 export(default_CARNIVAL_options)
 export(display_node_neighboorhood)
 export(extract_nodes_for_ORA)
 export(filter_incohrent_TF_target)
 export(format_COSMOS_res)
+export(format_LR_ressource)
+export(get_moon_scoring_network)
 export(load_tf_regulon_dorothea)
+export(make_heatmap_color_palette)
 export(meta_network_cleanup)
+export(moon)
 export(prepare_metab_inputs)
 export(preprocess_COSMOS_metabolism_to_signaling)
 export(preprocess_COSMOS_signaling_to_metabolism)
 export(reduce_solution_network)
 export(run_COSMOS_metabolism_to_signaling)
 export(run_COSMOS_signaling_to_metabolism)
+export(translate_column_HMDB)
+export(translate_res)
+export(wide_ulm_res)
 import(decoupleR)
 import(dplyr)
 importFrom(dplyr,"%>%")

R/support_decoupleR.R

@@ -0,0 +1,102 @@
+#' Format Ligand-Receptor Resource
+#'
+#' This function formats a ligand-receptor resource by creating a gene set
+#' with source-target pairs, converting it to a long format, and adding
+#' default values for 'mor' and 'likelihood'.
+#'
+#' @param ligrec_ressource A data frame representing the ligand-receptor resource with columns for source and target gene symbols.
+#'
+#' @return A data frame containing the formatted ligand-receptor gene set with columns:
+#'   \item{gene}{The gene symbol from the ligand-receptor pairs.}
+#'   \item{set}{The set identifier combining source and target gene symbols.}
+#'   \item{mor}{Default value set to 1 for all entries.}
+#'   \item{likelihood}{Default value set to 1 for all entries.}
+#'
+#' @examples
+#' # Create a sample ligand-receptor resource
+#' ligrec_ressource <- data.frame(source_genesymbol = c("L1", "L2"),
+#'                                target_genesymbol = c("R1", "R2"))
+#'
+#' # Format the ligand-receptor resource
+#' formatted_geneset <- format_LR_ressource(ligrec_ressource)
+#'
+#' @export
+format_LR_ressource <- function(ligrec_ressource)
+{
+  ligrec_geneset <- ligrec_ressource[,c("source_genesymbol","target_genesymbol")]
+  ligrec_geneset$set <- paste(ligrec_geneset$source_genesymbol, ligrec_geneset$target_genesymbol, sep = "___")
+  ligrec_geneset <- reshape2::melt(ligrec_geneset, id.vars = "set")[,c(3,1)]
+  names(ligrec_geneset)[1] <- "gene"
+  ligrec_geneset$mor <- 1
+  ligrec_geneset$likelihood <- 1
+  ligrec_geneset <- distinct(ligrec_geneset)
+
+  return(ligrec_geneset)
+}
+
+#' Convert ULM Results to Wide Format
+#'
+#' This function converts the results from a ULM analysis to a wide format data frame.
+#' The input is a data frame with columns for source, condition, and score. The output 
+#' is a data frame where each row represents a source and each column represents a condition,
+#' with the corresponding scores as values.
+#'
+#' @param ulm_result A data frame representing the ULM results with columns: source, condition, and score.
+#'
+#' @return A data frame in wide format where each row is a source and each column is a condition.
+#'
+#' @examples
+#' # Create a sample ULM result
+#' ulm_result <- data.frame(source = c("A", "A", "B", "B"),
+#'                          condition = c("cond1", "cond2", "cond1", "cond2"),
+#'                          score = c(0.5, 0.8, 0.3, 0.7))
+#'
+#' # Convert to wide format
+#' wide_ulm_result <- wide_ulm_res(ulm_result)
+#'
+#' @export
+wide_ulm_res <- function(ulm_result)
+{
+  ulm_result_df <- reshape2::dcast(ulm_result, formula = source~condition, value.var = "score")
+  row.names(ulm_result_df) <- ulm_result_df$source
+  ulm_result_df <- ulm_result_df[,-1]
+
+  return(ulm_result_df)
+}
+
+#' Translate Column Using HMDB Mapper
+#'
+#' This function translates the values in a column using a provided Human Metabolome Database (HMDB) mapper vector.
+#' It modifies the input values by replacing certain prefixes and suffixes according to specific rules.
+#'
+#' @param my_column A vector of values to be translated.
+#' @param HMDB_mapper_vec A named vector where the names are the original identifiers and the values are the corresponding HMDB identifiers.
+#'
+#' @return A vector with the translated values.
+#'
+#' @examples
+#' # Create a sample column and HMDB mapper vector
+#' my_column <- c("Metab__1234_a", "Gene5678_b", "Metab__91011_c")
+#' HMDB_mapper_vec <- c("1234" = "HMDB00001", "5678" = "HMDB00002", "91011" = "HMDB00003")
+#'
+#' # Translate the column
+#' translated_column <- translate_column_HMDB(my_column, HMDB_mapper_vec)
+#'
+#' @export
+translate_column_HMDB <- function(my_column, HMDB_mapper_vec)
+{
+  return(sapply(my_column, function(x, HMDB_mapper_vec) {
+    x <- gsub("Metab__", "", x)
+    x <- gsub("^Gene", "Enzyme", x)
+    suffixe <- stringr::str_extract(x, "_[a-z]$")
+    x <- gsub("_[a-z]$", "", x)
+    if (x %in% names(HMDB_mapper_vec)) {
+      x <- HMDB_mapper_vec[x]
+      x <- paste("Metab__", x, sep = "")
+    }
+    if (!is.na(suffixe)) {
+      x <- paste(x, suffixe, sep = "")
+    }
+    return(x)
+  }, HMDB_mapper_vec = HMDB_mapper_vec))
+}

R/support_pheatmap.R

@@ -0,0 +1,81 @@
+#' Create Heatmap Color Palette
+#'
+#' This function generates a color palette suitable for heatmaps based on the values in a matrix. It uses the `createLinearColors` function to generate separate color gradients for positive and negative values.
+#'
+#' @param my_matrix A numeric matrix for which the heatmap color palette is to be generated.
+#'
+#' @return A character vector of colors representing the heatmap color palette based on the input matrix values.
+#'
+#' @examples
+#' # Create a sample matrix
+#' my_matrix <- matrix(c(-3, -1, 0, 1, 3), nrow = 1)
+#'
+#' # Generate heatmap color palette
+#' heatmap_palette <- make_heatmap_color_palette(my_matrix)
+#'
+#' @export
+make_heatmap_color_palette <- function(my_matrix)
+{
+  t <- as.vector(t(my_matrix))
+  palette1 <- createLinearColors(t[t < 0],withZero = F , maximum = abs(min(t,na.rm = T)) * 10)
+  palette2 <- createLinearColors(t[t > 0],withZero = F , maximum = abs(max(t,na.rm = T)) * 10)
+  palette <- c(palette1, palette2)
+}
+
+#' Create Linear Colors Based on Numeric Input
+#'
+#' This function generates a gradient of colors based on the provided numeric values. The colors can be adjusted to include zero and are configurable with a specified maximum and custom color palette.
+#'
+#' @param numbers A numeric vector for which the color gradient is to be generated.
+#' @param withZero A logical value indicating whether zero should be included in the color gradient. Default is TRUE.
+#' @param maximum An integer specifying the maximum number of colors to be generated in the gradient. Default is 100.
+#' @param my_colors A character vector of length three specifying the colors to be used in the gradient. Default is c("royalblue3", "white", "red").
+#'
+#' @return A character vector of colors representing the gradient based on the input numeric values.
+#'
+#' @examples
+#' # Generate colors for a set of numbers including zero
+#' numbers <- c(-50, -20, 0, 20, 50)
+#' colors <- createLinearColors(numbers, withZero = TRUE, maximum = 100)
+#'
+#' @export
+createLinearColors <- function(numbers, withZero = T, maximum = 100, my_colors = c("royalblue3","white","red"))
+{
+  if (min(numbers, na.rm = T) > 0)
+  {
+    if(withZero)
+    {
+      numbers <- c(0,numbers)
+    }
+    myPalette <- colorRampPalette(my_colors[c(2,3)])
+    myColors <- myPalette(maximum)
+  }
+  else
+  {
+    if (max(numbers, na.rm = T) < 0)
+    {
+      if(withZero)
+      {
+        numbers <- c(0,numbers)
+      }
+      myPalette <- colorRampPalette(my_colors[c(1,2)])
+      myColors <- myPalette(maximum)
+    }
+    else
+    {
+      myPalette_pos <- colorRampPalette(c("white","red"))
+      myPalette_neg <- colorRampPalette(c("royalblue3","white"))
+      npos <- length(numbers[numbers >= 0]) + 1
+      nneg <- length(numbers[numbers <= 0]) + 1
+
+      myColors_pos <- myPalette_pos(npos)
+      myColors_neg <- myPalette_neg(nneg)
+
+      #print(myColors_neg)
+      #print(myColors_pos)
+
+      myColors <- c(myColors_neg[-(nneg)], myColors_pos[-1])
+    }
+  }
+  return(myColors)
+}

README.md

@@ -40,31 +40,21 @@ If you don't have R 4.1, you can also clone the github repository on your machin
 
 But 4.1 is advised in any case.
 
-### Prerequisites
+## tutorial to use MOFA nad COSMOS
 
-COSMOS is dependent on CARNIVAL for exhibiting the signalling pathway optimisation.
-CARNIVAL requires the interactive version of IBM Cplex, Gurobi or CBC-COIN solver as the network optimiser. The IBM ILOG Cplex is freely available through Academic Initiative [here](https://www.ibm.com/products/ilog-cplex-optimization-studio). Gurobi license is also free for academics, request a license [here](https://www.gurobi.com/downloads/end-user-license-agreement-academic/). The [CBC](https://projects.coin-or.org/Cbc) solver is open source and freely available for any user, but has a significantly lower performance than CPLEX or Gurobi. Obtain CBC executable directly usable for cosmos [here](https://ampl.com/products/solvers/open-source/#cbc). Alternatively for small networks, users can rely on the freely available [lpSolve R-package](https://cran.r-project.org/web/packages/lpSolve/index.html), which is automatically installed with the package.
+[Here](https://github.com/saezlab/Factor_COSMOS) you can find an extensive tutorial showing how to use MOFA and COSMOS with the NCI60 dataset. This is an extensive tutorial, if you wish to get a quicker plug and play introduction to COSMOS, see below.
 
+## Tutorial (NCI60 playground)
 
-Small note to package dependencies:
-
- CARNIVAL is currently under active development. We try to ensure the compatibility of both packages, please install CARNIVAL from the our Github:
-```r
-# Install 
-remotes::install_github("saezlab/CARNIVAL")
-```
+We made a repository that contains pre-processed inputs and an example script to use cosmos with the NCI60 RNA+metabolomic datasets.
+You can find the repository [here](https://github.com/saezlab/COSMOS_basic).
 
 ## Tutorial (video)
 
 We recorded a video guide for cosmosR tutorial in the context of a course organised by EBI-EMBL. 
 You can access the recording at this link for a step by step introduction to cosmosR : 
 https://embl-ebi.cloud.panopto.eu/Panopto/Pages/Viewer.aspx?id=318f7091-b6bf-44ee-939f-adb10121fc1b
 
-## Tutorial (NCI60 playground)
-
-We made a repository that contains pre-processed inputs and an example script to use cosmos with the NCI60 RNA+metabolomic datasets.
-You can find the repository [here](https://github.com/saezlab/NCI60_cosmos).
-
 ## Access
 
 The meta PKN used with the biorXiv version of COSMOS is available [here](http://metapkn.omnipathdb.org/).