├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── RWR.R ├── RandomWalkRestartMH_functions.R ├── combine_layers.R ├── enrichment_functions.R ├── get_graph_stats.R ├── get_grn.R ├── get_interaction_from_database.R ├── hmp_T2D.R ├── merge_layers_by_correlation.R ├── netOmics-package.R ├── plot.R ├── utils.R └── zzz.R ├── README.md ├── data-raw └── hmp_T2D_raw.R ├── data └── hmp_T2D.rda ├── inst └── CITATION ├── man ├── combine_layers.Rd ├── get_ORA.Rd ├── get_go_info.Rd ├── get_graph_stats.Rd ├── get_grn.Rd ├── get_interaction_from_ORA.Rd ├── get_interaction_from_correlation.Rd ├── get_interaction_from_database.Rd ├── hmp_T2D.Rd ├── netOmics.Rd ├── plot_rwr_subnetwork.Rd ├── random_walk_restart.Rd ├── rwr_find_closest_type.Rd ├── rwr_find_seeds_between_attributes.Rd └── summary_plot_rwr_attributes.Rd ├── tests ├── testthat.R └── testthat │ ├── Rplots.pdf │ ├── test-RWR.R │ ├── test-combine_layers.R │ ├── test-enrichment.R │ ├── test-get_graph_stats.R │ ├── test-get_grn.R │ ├── test-get_interaction_from_database.R │ ├── test-merge_layer_by_correlation.R │ ├── test-plot.R │ └── test-utils.R └── vignettes ├── img └── netomics_overview.png ├── mybib.bib ├── netOmics.R └── netOmics.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^codecov\.yml$ 5 | ^doc$ 6 | ^Meta$ 7 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rhistory 2 | .RData 3 | .Rproj.user 4 | R/backold.R 5 | doc 6 | Meta 7 | inst/doc 8 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: netOmics 2 | Title: Multi-Omics (time-course) network-based integration and interpretation 3 | Version: 1.11.1 4 | Authors@R: 5 | person(given = "Antoine", family = "Bodein", role = c("aut", "cre"), email = "antoine.bodein.1@ulaval.ca") 6 | Description: netOmics is a multi-omics networks builder and explorer. 7 | It uses a combination of network inference algorithms and and knowledge-based graphs to build multi-layered networks. 8 | The package can be combined with timeOmics to incorporate time-course expression data and build sub-networks from multi-omics kinetic clusters. 9 | Finally, from the generated multi-omics networks, propagation analyses allow the identification of missing biological functions (1), 10 | multi-omics mechanisms (2) and molecules between kinetic clusters (3). This helps to resolve complex regulatory mechanisms. 11 | License: GPL-3 12 | Encoding: UTF-8 13 | LazyData: false 14 | Roxygen: list(markdown = TRUE) 15 | RoxygenNote: 7.3.1 16 | VignetteBuilder: knitr 17 | Depends: R (>= 4.1) 18 | Imports: 19 | dplyr, 20 | ggplot2, 21 | igraph, 22 | magrittr, 23 | minet, 24 | purrr, 25 | tibble, 26 | tidyr, 27 | AnnotationDbi, 28 | GO.db, 29 | gprofiler2, 30 | methods, 31 | Matrix, 32 | stats 33 | Suggests: 34 | mixOmics, 35 | timeOmics, 36 | tidyverse, 37 | BiocStyle, 38 | testthat, 39 | covr, 40 | rmarkdown, 41 | knitr 42 | biocViews: GraphAndNetwork, Software, TimeCourse, WorkflowStep, SystemsBiology, NetworkInference, Network 43 | URL: https://github.com/abodein/netOmics 44 | BugReports: https://github.com/abodein/netOmics/issues 45 | PackageStatus: Deprecated 46 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(print,RWRM_Results) 4 | export(combine_layers) 5 | export(get_graph_stats) 6 | export(get_grn) 7 | export(get_interaction_from_ORA) 8 | export(get_interaction_from_correlation) 9 | export(get_interaction_from_database) 10 | export(plot_rwr_subnetwork) 11 | export(random_walk_restart) 12 | export(rwr_find_closest_type) 13 | export(rwr_find_seeds_between_attributes) 14 | export(summary_plot_rwr_attributes) 15 | import(GO.db) 16 | import(ggplot2) 17 | importFrom(AnnotationDbi,keytypes) 18 | importFrom(Matrix,Diagonal) 19 | importFrom(Matrix,bdiag) 20 | importFrom(Matrix,colSums) 21 | importFrom(Matrix,t) 22 | importFrom(dplyr,across) 23 | importFrom(dplyr,all_of) 24 | importFrom(dplyr,everything) 25 | importFrom(dplyr,filter) 26 | importFrom(dplyr,group_by) 27 | importFrom(dplyr,left_join) 28 | importFrom(dplyr,mutate) 29 | importFrom(dplyr,n) 30 | importFrom(dplyr,pull) 31 | importFrom(dplyr,select) 32 | importFrom(dplyr,summarise) 33 | importFrom(dplyr,top_n) 34 | importFrom(gprofiler2,gconvert) 35 | importFrom(gprofiler2,gost) 36 | importFrom(igraph,E) 37 | importFrom(igraph,V) 38 | importFrom(igraph,add_vertices) 39 | importFrom(igraph,adjacent_vertices) 40 | importFrom(igraph,as.undirected) 41 | importFrom(igraph,as_adjacency_matrix) 42 | importFrom(igraph,degree) 43 | importFrom(igraph,delete_vertex_attr) 44 | importFrom(igraph,delete_vertices) 45 | importFrom(igraph,ecount) 46 | importFrom(igraph,edge_density) 47 | importFrom(igraph,graph_from_adjacency_matrix) 48 | importFrom(igraph,graph_from_biadjacency_matrix) 49 | importFrom(igraph,graph_from_data_frame) 50 | importFrom(igraph,induced_subgraph) 51 | importFrom(igraph,is_weighted) 52 | importFrom(igraph,set_vertex_attr) 53 | importFrom(igraph,simplify) 54 | importFrom(igraph,union) 55 | importFrom(igraph,vcount) 56 | importFrom(igraph,vertex_attr) 57 | importFrom(magrittr,"%>%") 58 | importFrom(methods,is) 59 | importFrom(minet,aracne) 60 | importFrom(minet,build.mim) 61 | importFrom(purrr,imap_dfr) 62 | importFrom(purrr,is_empty) 63 | importFrom(purrr,map) 64 | importFrom(purrr,map2) 65 | importFrom(purrr,map_dfr) 66 | importFrom(purrr,reduce) 67 | importFrom(purrr,set_names) 68 | importFrom(stats,cor) 69 | importFrom(stats,na.omit) 70 | importFrom(tibble,rownames_to_column) 71 | importFrom(tidyr,pivot_longer) 72 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | Changes in version 0.99.1 (2021-07-15) 2 | + First Build 3 | 4 | Changes in version 1.9.4 (2024-04-12) 5 | + add RandomWalkRestartMH previously imported functions to avoid BioC depreciation 6 | -------------------------------------------------------------------------------- /R/RWR.R: -------------------------------------------------------------------------------- 1 | #' Random Walk with Restart 2 | #' 3 | #' This function performs a propagation analysis by random walk with restart 4 | #' in a multi-layered network from specific seeds. 5 | #' 6 | #' @param X an igraph or list.igraph object. 7 | #' @param seed a character vector. Only seeds present in X are considered. 8 | #' @param r a numeric value between 0 and 1. 9 | #' It sets the probability of restarting to a seed node after each step. 10 | #' 11 | #' @return 12 | #' Each element of X returns a list (class = 'rwr') 13 | #' containing the following elements: 14 | #' \item{rwr}{a \code{data.frame}, the RWR results for each valid seed.} 15 | #' \item{seed}{a character vector with the valid seeds} 16 | #' \item{graph}{\code{igraph} object from X} 17 | #' If X is a \code{list.igraph}, the returned object is a \code{list.rwr}. 18 | #' 19 | #' @seealso 20 | # \code{\link[RandomWalkRestartMH]{Random.Walk.Restart.Multiplex}}, 21 | #' \code{\link[netOmics]{rwr_find_seeds_between_attributes}}, 22 | #' \code{\link[netOmics]{rwr_find_closest_type}} 23 | #' 24 | #' @examples 25 | #' graph1 <- igraph::graph_from_data_frame( 26 | #' list(from = c('A', 'B', 'A', 'D', 'C', 'A', 'C'), 27 | #' to = c('B', 'C', 'D', 'E', 'D', 'F', 'G')), 28 | #' directed = FALSE) 29 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 30 | #' name = 'type', 31 | #' index = c('A','B','C'), 32 | #' value = '1') 33 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 34 | #' name = 'type', 35 | #' index = c('D','E'), 36 | #' value = '2') 37 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 38 | #' name = 'type', 39 | #' index = c('F', 'G'), 40 | #' value = '3') 41 | #' 42 | #' rwr_res <- random_walk_restart(X = graph1, 43 | #' seed = c('A', 'B', 'C', 'D', 'E')) 44 | #' 45 | # @importFrom RandomWalkRestartMH create.multiplex 46 | # @importFrom RandomWalkRestartMH compute.adjacency.matrix 47 | # @importFrom RandomWalkRestartMH normalize.multiplex.adjacency 48 | # @importFrom RandomWalkRestartMH Random.Walk.Restart.Multiplex 49 | #' @importFrom dplyr mutate left_join 50 | #' @importFrom purrr imap_dfr 51 | #' @importFrom magrittr %>% 52 | #' @export 53 | random_walk_restart <- function(X, seed = NULL, r = 0.7) { 54 | 55 | # check X is graph or list of graph 56 | X <- check_graph(X) 57 | 58 | # check seed 59 | seed <- check_vector_char(X = seed, var.name = "'seed' ") 60 | 61 | # check r 62 | r <- check_single_numeric_value(r, min = 0, max = 1, var.name = "'r' ") 63 | 64 | # delta 65 | delta <- 0.5 66 | 67 | res <- list() 68 | if (is(X, "list.igraph")) { 69 | # apply RWR on each graph 70 | for (i in seq_along(X)) { 71 | Xi <- X[[i]] 72 | Xi <- remove_unconnected_nodes(Xi) 73 | index_name_i <- ifelse( 74 | !is.null(names(X)[i]), 75 | names(X)[i], 76 | i 77 | ) 78 | 79 | ## possible implementation to benchmark: extract graph component 80 | ## and make couples with seeds and matching subgraph 81 | 82 | seed_xi <- intersect(seed, igraph::V(Xi)$name) 83 | # prevent the error: 'Some of the seeds are not nodes of the network 84 | 85 | # rwr layer names: to change if we include some day multiplex 86 | # network 87 | layers_name <- ifelse( 88 | !is.null(names(X)[i]), 89 | names(X)[i], 90 | "graph" 91 | ) 92 | 93 | # multiplex <- RandomWalkRestartMH::create.multiplex(L1 = 94 | # Xi,Layers_Name=layers_name) 95 | #multiplex <- RandomWalkRestartMH::create.multiplex( 96 | multiplex <- create.multiplex( 97 | LayersList = list(L1 = Xi), 98 | Layers_Name = layers_name 99 | ) 100 | # adj_matrix <- RandomWalkRestartMH::compute.adjacency.matrix( 101 | adj_matrix <- compute.adjacency.matrix( 102 | x = multiplex, 103 | delta = delta) 104 | adj_matrix_norm <- 105 | normalize.multiplex.adjacency( 106 | # RandomWalkRestartMH::normalize.multiplex.adjacency( 107 | x = adj_matrix) # time/RAM consuming 108 | 109 | res_tmp <- list() 110 | for (seed_xi_i in seed_xi) { 111 | # rwr_res <- RandomWalkRestartMH::Random.Walk.Restart.Multiplex( 112 | rwr_res <- Random.Walk.Restart.Multiplex( 113 | 114 | x = adj_matrix_norm, 115 | MultiplexObject = multiplex, 116 | Seeds = seed_xi_i, 117 | r = r 118 | ) 119 | res_tmp[[seed_xi_i]] <- rwr_res 120 | } 121 | if (!is_empty(seed_xi)) { 122 | res[[index_name_i]] <- list() 123 | res[[index_name_i]][["rwr"]] <- purrr::imap_dfr( 124 | res_tmp, ~{ 125 | .x$RWRM_Results %>% 126 | dplyr::mutate(SeedName = .y) 127 | } 128 | ) %>% 129 | dplyr::left_join( 130 | as.data.frame(vertex_attr(X[[i]])), 131 | by = c(NodeNames = "name") 132 | ) 133 | res[[index_name_i]][["graph"]] <- X[[i]] 134 | res[[index_name_i]][["seed"]] <- seed_xi 135 | class(res[[index_name_i]]) <- "rwr" 136 | } 137 | class(res) <- c("list.rwr") 138 | } 139 | } else { 140 | # X is a single graph 141 | Xi <- remove_unconnected_nodes(X) 142 | 143 | ## possible implementation to benchmark: extract graph component and 144 | ## make couples with seeds and matching subgraph 145 | 146 | seed_xi <- intersect(seed, igraph::V(Xi)$name) 147 | # prevent the error: Some of the seeds are not nodes of the network 148 | 149 | # rwr layer names: to change if we include some day multiplex network 150 | # layers_name <- ifelse(!is.null(names(X)[i]), names(X)[i], 'graph') 151 | layers_name <- c("graph") 152 | 153 | # multiplex <- RandomWalkRestartMH::create.multiplex(L1 = 154 | # Xi,Layers_Name=layers_name) 155 | multiplex <- create.multiplex( 156 | #RandomWalkRestartMH::create.multiplex( 157 | LayersList = list(L1 = Xi), 158 | Layers_Name = layers_name 159 | ) 160 | 161 | adj_matrix <- compute.adjacency.matrix( 162 | #RandomWalkRestartMH::compute.adjacency.matrix( 163 | x = multiplex, 164 | delta = delta) 165 | adj_matrix_norm <- normalize.multiplex.adjacency( 166 | #RandomWalkRestartMH::normalize.multiplex.adjacency( 167 | x = adj_matrix) # time/RAM consuming 168 | 169 | res_tmp <- list() 170 | for (seed_xi_i in seed_xi) { 171 | rwr_res <- Random.Walk.Restart.Multiplex( 172 | #rwr_res <- RandomWalkRestartMH::Random.Walk.Restart.Multiplex( 173 | x = adj_matrix_norm, 174 | MultiplexObject = multiplex, 175 | Seeds = seed_xi_i, 176 | r = r 177 | ) 178 | res_tmp[[seed_xi_i]] <- rwr_res 179 | } 180 | # all seeds for a graph X has been computed -> merge result (more 181 | # efficient than having seperate results + associated graph) 182 | if (!is_empty(seed_xi)) { 183 | res[["rwr"]] <- purrr::imap_dfr( 184 | res_tmp, ~{ 185 | .x$RWRM_Results %>% 186 | dplyr::mutate(SeedName = .y) 187 | } 188 | ) %>% 189 | dplyr::left_join( 190 | as.data.frame(vertex_attr(X)), 191 | by = c(NodeNames = "name") 192 | ) 193 | res[["graph"]] <- X 194 | res[["seed"]] <- seed_xi 195 | } 196 | 197 | class(res) <- c("rwr") 198 | } 199 | return(res) 200 | } 201 | 202 | #' @importFrom igraph delete_vertices simplify degree 203 | remove_unconnected_nodes <- function(X) { 204 | # remove unconnected nodes but does not simplify 205 | X.simplified <- igraph::simplify(X) 206 | isolated_nodes = which(igraph::degree(X.simplified) == 0) 207 | X = igraph::delete_vertices(X, isolated_nodes) 208 | return(X) 209 | } 210 | 211 | #' @importFrom dplyr filter pull top_n 212 | #' @importFrom igraph induced_subgraph set_vertex_attr V 213 | rwr_top_k_graph <- function(X, RWRM_Result_Object, Seed, k = 15) { 214 | Top_Results_Nodes <- RWRM_Result_Object %>% 215 | dplyr::filter(SeedName == Seed) %>% 216 | dplyr::top_n(n = k, wt = Score) %>% 217 | dplyr::pull(NodeNames) 218 | Query_Nodes <- intersect( 219 | c(Seed, Top_Results_Nodes), 220 | igraph::V(X)$name 221 | ) 222 | Target_Nodes <- intersect(Top_Results_Nodes, igraph::V(X)$name) 223 | 224 | if (!purrr::is_empty(Query_Nodes)) { 225 | top_k_graph <- igraph::induced_subgraph(graph = X, 226 | vids = Query_Nodes) 227 | top_k_graph <- igraph::set_vertex_attr(graph = top_k_graph, 228 | name = "rwr", 229 | index = Seed, 230 | value = "seed") 231 | top_k_graph <- igraph::set_vertex_attr(graph = top_k_graph, 232 | name = "rwr", 233 | index = Target_Nodes, 234 | value = "target") 235 | return(top_k_graph) 236 | } 237 | return(NULL) 238 | } 239 | 240 | 241 | 242 | 243 | #' RWR Find seeds between attributes 244 | #' 245 | #' From rwr results, this function returns a subgraph if any vertex shares 246 | #' different attributes value. 247 | #' In biological context, this might be useful to identify vertex shared between 248 | #' clusters or omics types. 249 | #' 250 | #' @param X a random walk result from \code{random_walk_restart} 251 | #' @param seed a character vector or NULL. If NULL, all the seeds from X 252 | #' are considered. 253 | #' @param attribute a character value or NULL. 254 | #' If NULL, the closest node is returned. 255 | #' @param k a integer, k closest nodes to consider in the search 256 | #' 257 | #' @return 258 | #' A list of igraph object for each seed. 259 | #' If X is a list, it returns a list of list of graph. 260 | #' 261 | #' @examples 262 | #' graph1 <- igraph::graph_from_data_frame( 263 | #' list(from = c("A", "B", "A", "D", "C", "A", "C"), 264 | #' to = c("B", "C", "D", "E", "D", "F", "G")), 265 | #' directed = FALSE) 266 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 267 | #' name = 'type', 268 | #' index = c("A","B","C"), 269 | #' value = "1") 270 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 271 | #' name = 'type', 272 | #' index = c("D","E"), 273 | #' value = "2") 274 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 275 | #' name = 'type', 276 | #' index = c("F", "G"), 277 | #' value = "3") 278 | #' 279 | #' rwr_res <- random_walk_restart(X = graph1, 280 | #' seed = c("A", "B", "C", "D", "E")) 281 | #' rwr_res_type <- rwr_find_seeds_between_attributes(X = rwr_res, 282 | #' attribute = "type", 283 | #' k = 3) 284 | #' 285 | #' @export 286 | rwr_find_seeds_between_attributes <- function(X, 287 | seed = NULL, 288 | k = 15, 289 | attribute = "type"){ 290 | # check X 291 | if(!(is(X, "rwr") | is(X, "list.rwr"))){ 292 | stop("X must be a random walk result") 293 | } 294 | 295 | # check k 296 | if(!is.null(k)){ 297 | k <- check_single_numeric_value(k, min = 0, 298 | max = 200, 299 | var.name = "'k' ") 300 | 301 | } else { 302 | k <- 15 303 | } 304 | 305 | # check seed # if seed is null, all seeds found in rwr are considered 306 | if(!is.null(seed)){ 307 | # don't check if all seeds are in vids -> NULL results anyway 308 | seed <- check_vector_char(X = seed, 309 | var.name = "'seed' ", 310 | default = NULL) 311 | } 312 | 313 | # check attribute 314 | attribute <- check_vector_char(X = attribute, var.name = "'attribute' ", 315 | default = "type", 316 | X.length = 1) 317 | 318 | if(is(X, "rwr")){ 319 | if(is.null(seed)){ # seed = all seeds 320 | seed <- X$seed # can be NULL 321 | } 322 | res <- .rwr_find_seeds_between_attribute(rwr = X, 323 | k = k, 324 | attribute = attribute, 325 | seed = seed) 326 | class(res) <- "rwr.attributes" 327 | } else { # X is list.res 328 | # should not be run on list.res because each item 329 | # contains a unique cluster 330 | res <- list() 331 | 332 | for(i in seq_along(X)){ 333 | index_name_i <- ifelse(!is.null(names(X)[i]), names(X)[i], i) 334 | 335 | if(is.null(seed)){ # seed = all seeds 336 | seed_i <- X[[index_name_i]]$seed # can be NULL 337 | } else { 338 | seed_i <- seed 339 | } 340 | 341 | res[[index_name_i]] <- .rwr_find_seeds_between_attribute( 342 | rwr = X[[index_name_i]], 343 | k = k, 344 | attribute = attribute, 345 | seed = seed_i) 346 | class(res[[index_name_i]]) <- "rwr.attributes" 347 | 348 | } 349 | class(res) <- "list.rwr.attributes" 350 | } 351 | return(res) 352 | } 353 | 354 | #' @importFrom igraph vertex_attr 355 | .rwr_find_seeds_between_attribute <- function(rwr, 356 | k, 357 | attribute, 358 | seed){ 359 | res <- list() 360 | for(seed_xi in seed){ 361 | # print(seed_xi) 362 | top_k_graph <- rwr_top_k_graph(X = rwr$graph, 363 | RWRM_Result_Object = rwr$rwr, 364 | Seed = seed_xi, k = k) 365 | 366 | # find different cluster 367 | if(!is.null(top_k_graph)){ 368 | if(nrow(table(igraph::vertex_attr(top_k_graph)[[attribute]])) >= 2){ 369 | # generic version 370 | res[[seed_xi]] <- top_k_graph 371 | } 372 | } 373 | } 374 | return(res) 375 | } 376 | 377 | 378 | 379 | #' RWR Find closest nodes 380 | #' 381 | #' From a rwr results, this function returns the closest nodes from a seed with 382 | #' a given attribute and value. 383 | #' In biological context, it might be useful to get the closest Gene Ontology 384 | #' annotation nodes from unannotated seeds. 385 | #' 386 | #' @param X a random walk result from \code{random_walk_restart} 387 | #' @param seed a character vector or NULL. If NULL, all the seeds 388 | #' from X are considered. 389 | #' @param attribute a character value or NULL. If NULL, 390 | #' the closest node is returned. 391 | #' @param value a character value or NULL. If NULL, the closest node for a given 392 | #' attribute is returned. 393 | #' @param top a numeric value, the top closest nodes to extract 394 | #' 395 | #' 396 | #' 397 | #' @return 398 | #' A list of \code{data.frame} for each seed containing the closest nodes per 399 | #' seed and their vertex attributes. 400 | #' If X is \code{list.rwr}, the returned value is a list of list. 401 | #' 402 | #' 403 | #' @examples 404 | #' graph1 <- igraph::graph_from_data_frame( 405 | #' list(from = c("A", "B", "A", "D", "C", "A", "C"), 406 | #' to = c("B", "C", "D", "E", "D", "F", "G")), 407 | #' directed = FALSE) 408 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 409 | #' name = 'type', 410 | #' index = c("A","B","C"), 411 | #' value = "1") 412 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 413 | #' name = 'type', 414 | #' index = c("D","E"), 415 | #' value = "2") 416 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 417 | #' name = 'type', 418 | #' index = c("F", "G"), 419 | #' value = "3") 420 | #' 421 | #' rwr_res <- random_walk_restart(X = graph1, 422 | #' seed = c("A", "B", "C", "D", "E")) 423 | #' rwr_find_closest_type(X=rwr_res, attribute = "type", 424 | #' seed = "A") 425 | 426 | 427 | #' @export 428 | rwr_find_closest_type <- function(X, 429 | seed = NULL, 430 | attribute = NULL, 431 | value = NULL, 432 | top = 1){ 433 | # check X 434 | if(!(is(X, "rwr") | is(X, "list.rwr"))){ 435 | stop("X must be a random walk result") 436 | } 437 | 438 | # check attribute or replace with default value 439 | attribute <- check_vector_char(X = attribute, 440 | X.length = 1, 441 | default = NULL, 442 | var.name = "'attribute' ") 443 | 444 | # check value or replace with default value 445 | value <- check_vector_char(X = value, 446 | X.length = 1, 447 | default = NULL, 448 | var.name = "'value' ") 449 | 450 | # check top 451 | top <- check_single_numeric_value(top, var.name = "'top' ") 452 | 453 | # check seed # if seed is null, all seeds found in rwr are considered 454 | if(!is.null(seed)){ 455 | # don't check if all seeds are in vids -> NULL results anyway 456 | seed <- check_vector_char(X = seed, 457 | var.name = "'seed' ", 458 | default = NULL) 459 | } 460 | 461 | if(is(X, "rwr")){ 462 | if(is.null(seed)){ # seed = all seeds 463 | seed <- X$seed # can be NULL 464 | } 465 | res <- .rwr_find_closest(rwr = X, user.attribute = attribute, 466 | seed = seed, 467 | user.value = value, 468 | top = top) 469 | class(res) <- "rwr.closest" 470 | } else { # X is list.res 471 | # should not be run on list.res because each item 472 | # contains a unique cluster 473 | res <- list() 474 | 475 | for(i in seq_along(X)){ 476 | index_name_i <- ifelse(!is.null(names(X)[i]), names(X)[i], i) 477 | 478 | if(is.null(seed)){ # seed = all seeds 479 | seed_i <- X[[index_name_i]]$seed # can be NULL 480 | } else { 481 | seed_i <- seed 482 | } 483 | 484 | res[[index_name_i]] <- .rwr_find_closest(rwr = X[[index_name_i]], 485 | user.attribute = attribute, 486 | seed = seed_i, 487 | user.value = value, 488 | top = top) 489 | class(res[[index_name_i]]) <- "rwr.closest" 490 | 491 | } 492 | class(res) <- "list.rwr.closest" 493 | } 494 | return(res) 495 | } 496 | 497 | #' @importFrom dplyr filter top_n left_join select everything across mutate 498 | #' @importFrom purrr map_dfr 499 | #' @importFrom tidyr pivot_longer 500 | .rwr_find_closest <- function(rwr, user.attribute, user.value, seed, top){ 501 | res <- list() 502 | for(seed_xi in seed){ 503 | rwr.res.filtered <- dplyr::filter(rwr$rwr, SeedName == seed_xi) 504 | # fix to use pivot_longer with different cast columns (integer/logical,) 505 | rwr.res.filtered <- rwr.res.filtered %>% t %>% t %>% as.data.frame() 506 | rwr.res.filtered <- tidyr::pivot_longer(rwr.res.filtered, 507 | names_to = "attribute", 508 | values_to = "value", 509 | -c(NodeNames, Score, SeedName), 510 | #values_ptypes = 511 | # list(value=character()) 512 | ) %>% 513 | dplyr::mutate(dplyr::across(dplyr::everything(), as.character)) 514 | 515 | if(!is.null(user.attribute)){ 516 | rwr.res.filtered <- dplyr::filter(rwr.res.filtered, 517 | attribute == user.attribute) 518 | } 519 | if(!is.null(user.value)){ 520 | rwr.res.filtered <- dplyr::filter(rwr.res.filtered, 521 | value == user.value) 522 | } 523 | rwr.res.filtered <- dplyr::top_n(x = rwr.res.filtered, 524 | n = top, 525 | wt = Score) %>% 526 | dplyr::select(c(NodeNames, SeedName)) %>% 527 | unique 528 | if(nrow(rwr.res.filtered) > 0){ 529 | res[[seed_xi]] <- dplyr::left_join( 530 | rwr.res.filtered, 531 | rwr$rwr, 532 | by = c("NodeNames" = "NodeNames", "SeedName" = "SeedName")) %>% 533 | dplyr::select(c(NodeNames, Score, SeedName), 534 | dplyr::everything()) 535 | } 536 | } 537 | #res <- purrr::map_dfr(res, ~.x) 538 | return(res) 539 | } 540 | 541 | 542 | 543 | -------------------------------------------------------------------------------- /R/RandomWalkRestartMH_functions.R: -------------------------------------------------------------------------------- 1 | # Credit to Valdeolivas et al. 2 | # All the functions below come from the package RandomWalkRestartMH. 3 | # Due to build errors in Bioconducteur, and to avoid depreciation of the netOmics package, all functions imported by the package have been repatriated here. 4 | 5 | # need ti keep: 6 | # - RandomWalkRestartMH::create.multiplex 7 | # - RandomWalkRestartMH::compute.adjacency.matrix 8 | # - RandomWalkRestartMH::normalize.multiplex.adjacency 9 | # - RandomWalkRestartMH::Random.Walk.Restart.Multiplex 10 | 11 | #' @importFrom igraph set_vertex_attr 12 | create.multiplex <- function(LayersList,...){ 13 | 14 | if (!class(LayersList) == "list"){ 15 | stop("The input object should be a list of graphs.") 16 | } 17 | 18 | 19 | Number_of_Layers <- length(LayersList) 20 | SeqLayers <- seq(Number_of_Layers) 21 | Layers_Name <- names(LayersList) 22 | 23 | # if (!all(sapply(SeqLayers, function(x) is.igraph(LayersList[[x]])))){ 24 | # stop("Not igraph objects") 25 | # } 26 | 27 | Layer_List <- lapply(SeqLayers, function (x) { 28 | if (is.null(V(LayersList[[x]])$name)){ 29 | LayersList[[x]] <- 30 | igraph::set_vertex_attr(LayersList[[x]],"name", 31 | value=seq(1,vcount(LayersList[[x]]),by=1)) 32 | } else { 33 | LayersList[[x]] 34 | } 35 | }) 36 | 37 | ## We simplify the layers 38 | Layer_List <- 39 | lapply(SeqLayers, function(x) simplify.layers(Layer_List[[x]])) 40 | 41 | ## We set the names of the layers. 42 | 43 | if (is.null(Layers_Name)){ 44 | names(Layer_List) <- paste0("Layer_", SeqLayers) 45 | } else { 46 | names(Layer_List) <- Layers_Name 47 | } 48 | 49 | ## We get a pool of nodes (Nodes in any of the layers.) 50 | Pool_of_Nodes <- 51 | sort(unique(unlist(lapply(SeqLayers, 52 | function(x) V(Layer_List[[x]])$name)))) 53 | 54 | Number_of_Nodes <- length(Pool_of_Nodes) 55 | 56 | Layer_List <- 57 | lapply(Layer_List, add.missing.nodes,Number_of_Layers,Pool_of_Nodes) 58 | 59 | # We set the attributes of the layer 60 | counter <- 0 61 | Layer_List <- lapply(Layer_List, function(x) { 62 | counter <<- counter + 1; 63 | igraph::set_edge_attr(x,"type",igraph::E(x), value = names(Layer_List)[counter]) 64 | }) 65 | 66 | 67 | MultiplexObject <- c(Layer_List,list(Pool_of_Nodes=Pool_of_Nodes, 68 | Number_of_Nodes_Multiplex=Number_of_Nodes, 69 | Number_of_Layers=Number_of_Layers)) 70 | 71 | class(MultiplexObject) <- "Multiplex" 72 | 73 | return(MultiplexObject) 74 | } 75 | 76 | 77 | 78 | # internal 79 | #' @importFrom igraph as.undirected is_weighted E simplify 80 | simplify.layers <- function(Input_Layer){ 81 | 82 | ## Undirected Graphs 83 | Layer <- igraph::as.undirected(Input_Layer, mode = c("collapse"), 84 | edge.attr.comb = igraph::igraph_opt("edge.attr.comb")) 85 | 86 | ## Unweighted or Weigthed Graphs 87 | if (igraph::is_weighted(Layer)){ 88 | b <- 1 89 | weigths_layer <- igraph::E(Layer)$weight 90 | if (min(weigths_layer) != max(weigths_layer)){ 91 | a <- min(weigths_layer)/max(weigths_layer) 92 | range01 <- (b-a)*(weigths_layer-min(weigths_layer))/ 93 | (max(weigths_layer)-min(weigths_layer)) + a 94 | igraph::E(Layer)$weight <- range01 95 | } else { 96 | igraph::E(Layer)$weight <- rep(1, length(weigths_layer)) 97 | } 98 | } else { 99 | igraph::E(Layer)$weight <- rep(1, ecount(Layer)) 100 | } 101 | 102 | ## Simple Graphs 103 | Layer <- 104 | igraph::simplify(Layer,remove.multiple = TRUE,remove.loops = TRUE, 105 | edge.attr.comb=mean) 106 | 107 | return(Layer) 108 | } 109 | 110 | #' @importFrom igraph add_vertices 111 | add.missing.nodes <- function (Layers,Nr_Layers,NodeNames) { 112 | 113 | igraph::add_vertices(Layers, 114 | length(NodeNames[which(!NodeNames %in% igraph::V(Layers)$name)]), 115 | name=NodeNames[which(!NodeNames %in% igraph::V(Layers)$name)]) 116 | } 117 | 118 | 119 | #' @importFrom Matrix Diagonal bdiag 120 | #' @importFrom igraph as_adjacency_matrix is_weighted 121 | 122 | compute.adjacency.matrix <- function(x,delta = 0.5) 123 | { 124 | if (!isMultiplex(x) & !isMultiplexHet(x)) { 125 | stop("Not a Multiplex or Multiplex Heterogeneous object") 126 | } 127 | if (delta > 1 || delta <= 0) { 128 | stop("Delta should be between 0 and 1") 129 | } 130 | 131 | N <- x$Number_of_Nodes_Multiplex 132 | L <- x$Number_of_Layers 133 | 134 | ## We impose delta=0 in the monoplex case. 135 | if (L==1){ 136 | delta = 0 137 | } 138 | 139 | Layers_Names <- names(x)[seq(L)] 140 | 141 | ## IDEM_MATRIX. 142 | Idem_Matrix <- Matrix::Diagonal(N, x = 1) 143 | 144 | counter <- 0 145 | Layers_List <- lapply(x[Layers_Names],function(x){ 146 | 147 | counter <<- counter + 1; 148 | if (igraph::is_weighted(x)){ 149 | Adjacency_Layer <- igraph::as_adjacency_matrix(x,sparse = TRUE, 150 | attr = "weight") 151 | } else { 152 | Adjacency_Layer <- igraph::as_adjacency_matrix(x,sparse = TRUE) 153 | } 154 | 155 | Adjacency_Layer <- Adjacency_Layer[order(rownames(Adjacency_Layer)), 156 | order(colnames(Adjacency_Layer))] 157 | colnames(Adjacency_Layer) <- 158 | paste0(colnames(Adjacency_Layer),"_",counter) 159 | rownames(Adjacency_Layer) <- 160 | paste0(rownames(Adjacency_Layer),"_",counter) 161 | Adjacency_Layer 162 | }) 163 | 164 | MyColNames <- unlist(lapply(Layers_List, function (x) unlist(colnames(x)))) 165 | MyRowNames <- unlist(lapply(Layers_List, function (x) unlist(rownames(x)))) 166 | names(MyColNames) <- c() 167 | names(MyRowNames) <- c() 168 | SupraAdjacencyMatrix <- (1-delta)*(Matrix::bdiag(unlist(Layers_List))) 169 | colnames(SupraAdjacencyMatrix) <-MyColNames 170 | rownames(SupraAdjacencyMatrix) <-MyRowNames 171 | 172 | offdiag <- (delta/(L-1))*Idem_Matrix 173 | 174 | i <- seq_len(L) 175 | Position_ini_row <- 1 + (i-1)*N 176 | Position_end_row <- N + (i-1)*N 177 | j <- seq_len(L) 178 | Position_ini_col <- 1 + (j-1)*N 179 | Position_end_col <- N + (j-1)*N 180 | 181 | for (i in seq_len(L)){ 182 | for (j in seq_len(L)){ 183 | if (j != i){ 184 | SupraAdjacencyMatrix[(Position_ini_row[i]:Position_end_row[i]), 185 | (Position_ini_col[j]:Position_end_col[j])] <- offdiag 186 | } 187 | } 188 | } 189 | 190 | SupraAdjacencyMatrix <- as(SupraAdjacencyMatrix, "dgCMatrix") 191 | return(SupraAdjacencyMatrix) 192 | } 193 | #' @importFrom Matrix t colSums 194 | normalize.multiplex.adjacency <- function(x) 195 | { 196 | if (!is(x,"dgCMatrix")){ 197 | stop("Not a dgCMatrix object of Matrix package") 198 | } 199 | 200 | Adj_Matrix_Norm <- Matrix::t(Matrix::t(x)/(Matrix::colSums(x, na.rm = FALSE, dims = 1, 201 | sparseResult = FALSE))) 202 | 203 | return(Adj_Matrix_Norm) 204 | } 205 | 206 | Random.Walk.Restart.Multiplex <- function(x, MultiplexObject, Seeds, 207 | r=0.7,tau,MeanType="Geometric", DispResults="TopScores",...){ 208 | 209 | 210 | L <- MultiplexObject$Number_of_Layers 211 | N <- MultiplexObject$Number_of_Nodes 212 | 213 | Seeds <- as.character(Seeds) 214 | if (length(Seeds) < 1 | length(Seeds) >= N){ 215 | stop("The length of the vector containing the seed nodes is not 216 | correct") 217 | } else { 218 | if (!all(Seeds %in% MultiplexObject$Pool_of_Nodes)){ 219 | stop("Some of the seeds are not nodes of the network") 220 | 221 | } 222 | } 223 | 224 | if (r >= 1 || r <= 0) { 225 | stop("Restart partameter should be between 0 and 1") 226 | } 227 | 228 | if(missing(tau)){ 229 | tau <- rep(1,L)/L 230 | } else { 231 | tau <- as.numeric(tau) 232 | if (sum(tau)/L != 1) { 233 | stop("The sum of the components of tau divided by the number of 234 | layers should be 1") 235 | } 236 | } 237 | 238 | if(!(MeanType %in% c("Geometric","Arithmetic","Sum"))){ 239 | stop("The type mean should be Geometric, Arithmetic or Sum") 240 | } 241 | 242 | if(!(DispResults %in% c("TopScores","Alphabetic"))){ 243 | stop("The way to display RWRM results should be TopScores or 244 | Alphabetic") 245 | } 246 | 247 | ## We define the threshold and the number maximum of iterations for 248 | ## the random walker. 249 | Threeshold <- 1e-10 250 | NetworkSize <- ncol(x) 251 | 252 | ## We initialize the variables to control the flux in the RW algo. 253 | residue <- 1 254 | iter <- 1 255 | 256 | ## We compute the scores for the different seeds. 257 | Seeds_Score <- get.seed.scoresMultiplex(Seeds,L,tau) 258 | 259 | ## We define the prox_vector(The vector we will move after the first RWR 260 | ## iteration. We start from The seed. We have to take in account 261 | ## that the walker with restart in some of the Seed nodes, depending on 262 | ## the score we gave in that file). 263 | prox_vector <- matrix(0,nrow = NetworkSize,ncol=1) 264 | 265 | prox_vector[which(colnames(x) %in% Seeds_Score[,1])] <- (Seeds_Score[,2]) 266 | 267 | prox_vector <- prox_vector/sum(prox_vector) 268 | restart_vector <- prox_vector 269 | 270 | while(residue >= Threeshold){ 271 | 272 | old_prox_vector <- prox_vector 273 | prox_vector <- (1-r)*(x %*% prox_vector) + r*restart_vector 274 | residue <- sqrt(sum((prox_vector-old_prox_vector)^2)) 275 | iter <- iter + 1; 276 | } 277 | 278 | NodeNames <- character(length = N) 279 | Score = numeric(length = N) 280 | 281 | rank_global <- data.frame(NodeNames = NodeNames, Score = Score) 282 | rank_global$NodeNames <- gsub("_1", "", row.names(prox_vector)[seq_len(N)]) 283 | 284 | if (MeanType=="Geometric"){ 285 | rank_global$Score <- geometric.mean(as.vector(prox_vector[,1]),L,N) 286 | } else { 287 | if (MeanType=="Arithmetic") { 288 | rank_global$Score <- regular.mean(as.vector(prox_vector[,1]),L,N) 289 | } else { 290 | rank_global$Score <- sumValues(as.vector(prox_vector[,1]),L,N) 291 | } 292 | } 293 | 294 | if (DispResults=="TopScores"){ 295 | ## We sort the nodes according to their score. 296 | Global_results <- 297 | rank_global[with(rank_global, order(-Score, NodeNames)), ] 298 | 299 | ### We remove the seed nodes from the Ranking and we write the results. 300 | Global_results <- 301 | Global_results[which(!Global_results$NodeNames %in% Seeds),] 302 | } else { 303 | Global_results <- rank_global 304 | } 305 | 306 | rownames(Global_results) <- c() 307 | 308 | RWRM_ranking <- list(RWRM_Results = Global_results,Seed_Nodes = Seeds) 309 | 310 | class(RWRM_ranking) <- "RWRM_Results" 311 | return(RWRM_ranking) 312 | } 313 | 314 | #' @method print RWRM_Results 315 | #' @export 316 | print.RWRM_Results <- function(x,...) 317 | { 318 | cat("Top 10 ranked Nodes:\n") 319 | print(head(x$RWRM_Results,10)) 320 | cat("\nSeed Nodes used:\n") 321 | print(x$Seed_Nodes) 322 | } 323 | 324 | get.seed.scoresMultiplex <- function(Seeds,Number_Layers,tau) { 325 | 326 | Nr_Seeds <- length(Seeds) 327 | 328 | Seeds_Seeds_Scores <- rep(tau/Nr_Seeds,Nr_Seeds) 329 | Seed_Seeds_Layer_Labeled <- 330 | paste0(rep(Seeds,Number_Layers),sep="_",rep(seq(Number_Layers), 331 | length.out = Nr_Seeds*Number_Layers,each=Nr_Seeds)) 332 | 333 | Seeds_Score <- data.frame(Seeds_ID = Seed_Seeds_Layer_Labeled, 334 | Score = Seeds_Seeds_Scores, stringsAsFactors = FALSE) 335 | 336 | return(Seeds_Score) 337 | } 338 | 339 | 340 | geometric.mean <- function(Scores, L, N) { 341 | 342 | FinalScore <- numeric(length = N) 343 | 344 | for (i in seq_len(N)){ 345 | FinalScore[i] <- prod(Scores[seq(from = i, to = N*L, by=N)])^(1/L) 346 | } 347 | 348 | return(FinalScore) 349 | } 350 | 351 | regular.mean <- function(Scores, L, N) { 352 | 353 | FinalScore <- numeric(length = N) 354 | 355 | for (i in seq_len(N)){ 356 | FinalScore[i] <- mean(Scores[seq(from = i, to = N*L, by=N)]) 357 | } 358 | 359 | return(FinalScore) 360 | } 361 | 362 | sumValues <- function(Scores, L, N) { 363 | 364 | FinalScore <- numeric(length = N) 365 | 366 | for (i in seq_len(N)){ 367 | FinalScore[i] <- sum(Scores[seq(from = i, to = N*L, by=N)]) 368 | } 369 | 370 | return(FinalScore) 371 | } 372 | 373 | isMultiplex <- function (x) 374 | { 375 | is(x, "Multiplex") 376 | } 377 | 378 | isMultiplexHet <- function (x) 379 | { 380 | is(x, "MultiplexHet") 381 | } 382 | -------------------------------------------------------------------------------- /R/combine_layers.R: -------------------------------------------------------------------------------- 1 | #' Combine layers 2 | #' 3 | #' Return a merged graph from two graph layers. 4 | #' 5 | #' @param graph1 an igraph object or list of igraph (\code{list.igraph}). 6 | #' @param graph2 an igraph object or list of igraph (\code{list.igraph}) with 7 | #' the same length as \code{graph1}. 8 | #' @param interaction.df (optional) a 2 colomns data.frame (from, to) 9 | #' describing the edges between vertices from both graphs. 10 | #' 11 | #' @details 12 | #' If \code{graph2} is a single graph, it will be merged to each element of 13 | #' \code{graph1} (\code{igraph} or \code{list.igraph}). 14 | #' 15 | #' If \code{graph2} is a list of graph (\code{list.igraph}), each element of 16 | #' \code{graph1} and each element of \code{graph2} are merged in pairs. 17 | #' 18 | #' Optionally, \code{interaction.df} should be provide if any vertex are shared 19 | #' between graphs. It can also be used to extend the first graph. 20 | #' 21 | #' In both scenarios, vertex attributes are kept. If a vertex attribute is 22 | #' missing from graph1 or graph2, NULL value is added. 23 | #' Otherwise, if there is an overlap between attribute values for the same 24 | #' vertex, attribute from graph2 is dropped. 25 | #' 26 | #' @return 27 | #' a merged graph with both vertex attributes from graph1 and graph2. 28 | #' 29 | #' @examples 30 | #' # with single graphs 31 | #' graph1 <- igraph::graph_from_data_frame(list(from = c('A', 'B'), 32 | #' to = c('B', 'C')), 33 | #' directed = FALSE) 34 | #' graph2 <- igraph::graph_from_data_frame(list(from = c(1), 35 | #' to = c(2)), 36 | #' directed = FALSE) 37 | #' res <- combine_layers(graph1 = graph1, 38 | #' graph2 = graph2) 39 | #' 40 | #' # with list of graphs 41 | #' graph1.list <- list(graph1, graph1) 42 | #' graph2.list <- list(graph2, graph2) 43 | #' class(graph1.list) <- class(graph2.list) <- 'list.igraph' 44 | #' 45 | #' res <- combine_layers(graph1 = graph1.list, 46 | #' graph2 = graph2) 47 | #' res <- combine_layers(graph1 = graph1.list, 48 | #' graph2 = graph2.list) 49 | #' 50 | #' # with interaction dataframe 51 | #' interaction.df1 <- as.data.frame(list(from = c('C', 'B'), to = c(1, 2))) 52 | #' res <- combine_layers(graph1 = graph1.list, 53 | #' graph2 = graph2, 54 | #' interaction.df = interaction.df1) 55 | #' 56 | #' 57 | #' @importFrom purrr is_empty map reduce map2 58 | #' @importFrom igraph induced_subgraph 59 | #' @importFrom igraph set_vertex_attr 60 | #' @importFrom igraph adjacent_vertices 61 | #' @importFrom igraph graph_from_data_frame 62 | #' @importFrom igraph vcount 63 | #' @importFrom igraph V 64 | #' @importFrom igraph as.undirected 65 | 66 | #' @export 67 | combine_layers <- function(graph1, 68 | graph2 = NULL, 69 | interaction.df = NULL) { 70 | 71 | # check graph1 72 | if (!is(graph1, "igraph") & !is(graph1, "list.igraph")) { 73 | stop("graph1 must be an igraph or list.igraph object") 74 | } 75 | if (is(graph1, "list.igraph")) { 76 | if (is.null(names(graph1))) { 77 | names(graph1) <- seq_along(graph1) 78 | } 79 | } 80 | 81 | if (!is(graph2, "igraph") & !is(graph2, "list.igraph") & !is.null(graph2)) { 82 | stop("graph2 must be an igraph or list.igraph object or NULL") 83 | } 84 | if (!is.null(interaction.df)) { 85 | interaction.df <- check_db(interaction.df) 86 | 87 | if (!is(interaction.df, "igraph")) { 88 | interaction.df <- interaction.df %>% 89 | dplyr::select(c("from", "to")) 90 | interaction.graph <- igraph::graph_from_data_frame(interaction.df, 91 | directed = FALSE) 92 | } else { 93 | interaction.graph <- igraph::as.undirected(interaction.df) 94 | } 95 | } 96 | 97 | # case1: graph2 = NULL, interaction.df = NULL 98 | if (is.null(graph2) & is.null(interaction.df)) { 99 | merged.res <- graph1 100 | } 101 | 102 | # case2: graph1 and graph2 are single graph (+ interaction.df) 103 | if (is(graph1, "igraph") & is(graph2, "igraph")) { 104 | merged.res <- merge_graphs(graph1, graph2) 105 | if (!is.null(interaction.df)) { 106 | # interaction.graph can be not found, df can be NULL 107 | interaction.graph.induced <- igraph::induced_subgraph( 108 | graph = interaction.graph, 109 | vids = intersect(igraph::V(interaction.graph)$name, 110 | igraph::V(merged.res)$name)) 111 | merged.res <- merge_graphs(merged.res, 112 | interaction.graph.induced) 113 | } 114 | 115 | # case3: graph1 is a list and graph2 is a single graph 116 | # (+ interaction.df) 117 | } else if (is(graph1, "list.igraph") & is(graph2, "igraph")) { 118 | merged.res <- purrr::map(graph1, ~{ 119 | merge_graphs(.x, graph2) 120 | }) 121 | names(merged.res) <- names(graph1) 122 | if (!is.null(interaction.df)) { 123 | # interaction.graph can be not found, df can be NULL 124 | # merged.res <- list() # already defined 125 | for (i in names(merged.res)) { 126 | interaction.graph.induced <- igraph::induced_subgraph( 127 | graph = interaction.graph, 128 | vids = intersect(igraph::V(interaction.graph)$name, 129 | igraph::V(merged.res[[i]])$name)) 130 | merged.res[[i]] <- merge_graphs(merged.res[[i]], 131 | interaction.graph.induced) 132 | } 133 | } 134 | 135 | # case4: graph1 and graph2 are list of graph (+ interaction.df) 136 | } else if (is(graph1, "list.igraph") & is(graph2, "list.igraph")) { 137 | if (length(graph1) != length(graph2)) { 138 | stop("graph1 and graph2 must have the same length") 139 | } 140 | if (!is.null(names(graph1)) & !is.null(names(graph2))) { 141 | # graph1 and graph2 have names same length 142 | # so reciprocal is TRUE they don't have the same names 143 | if (!all(names(graph1) %in% names(graph2))) { 144 | stop("graph1 and graph2 must have the same names") 145 | } else { 146 | merged.res <- purrr::map2(graph1, graph2[names(graph1)], ~{ 147 | merge_graphs(.x, .y) 148 | }) 149 | } 150 | } else { 151 | # no names, don't care about the order 152 | merged.res <- purrr::map2(graph1, graph2, ~{ 153 | merge_graphs(.x, .y) 154 | }) 155 | names(merged.res) <- names(graph1) 156 | } 157 | if (!is.null(interaction.df)) { 158 | # interaction.graph can be not found, df can be NULL 159 | for (i in names(merged.res)) { 160 | interaction.graph.induced <- igraph::induced_subgraph( 161 | graph = interaction.graph, 162 | vids = intersect(igraph::V(interaction.graph)$name, 163 | igraph::V(merged.res[[i]])$name)) 164 | merged.res[[i]] <- merge_graphs(merged.res[[i]], 165 | interaction.graph.induced) 166 | } 167 | } 168 | 169 | # case5: inverse of case3 -> error 170 | } else if (is(graph1, "igraph") & is(graph2, "list.igraph")) { 171 | stop("graph1 and graph2 must have the same length") 172 | 173 | # case6: graph1 and interaction.df 174 | } else if (is(graph1, "igraph") & 175 | is.null(graph2) & 176 | !is.null(interaction.df)) { 177 | interaction.df.sub <- interaction.df %>% 178 | dplyr::filter(.$from %in% igraph::V(graph1)$name | 179 | .$to %in% igraph::V(graph1)$name) 180 | interaction.graph <- igraph::graph_from_data_frame(interaction.df.sub, 181 | directed = FALSE) 182 | merged.res <- merge_graphs(graph1, interaction.graph) 183 | 184 | # case7: graph1 list and interaction.df 185 | } else if (is(graph1, "list.igraph") & 186 | is.null(graph2) & 187 | !is.null(interaction.df)) { 188 | merged.res <- list() 189 | for (i in names(graph1)) { 190 | interaction.df.sub <- interaction.df %>% 191 | dplyr::filter(.$from %in% igraph::V(graph1[[i]])$name | 192 | .$to %in% igraph::V(graph1[[i]])$name) 193 | interaction.graph <- igraph::graph_from_data_frame( 194 | interaction.df.sub, 195 | directed = FALSE) 196 | merged.res[[i]] <- merge_graphs(graph1[[i]], interaction.graph) 197 | } 198 | } 199 | 200 | if (is(merged.res, "list")) { 201 | class(merged.res) <- c("list.igraph", "list.merged.igraph") 202 | } 203 | return(merged.res) 204 | } 205 | 206 | 207 | #' @importFrom igraph vertex_attr 208 | #' @importFrom igraph union 209 | #' @importFrom igraph delete_vertex_attr 210 | #' @importFrom igraph set_vertex_attr 211 | #' @importFrom igraph vcount 212 | merge_graphs <- function(graph1, 213 | graph2) { 214 | # shared attr except 'name' 215 | shared_attr <- intersect(names(igraph::vertex_attr(graph1)), 216 | names(igraph::vertex_attr(graph2))) 217 | shared_attr <- shared_attr[!(shared_attr == "name")] 218 | 219 | merged_graphs <- igraph::union(graph1, graph2) 220 | # vertex_attr(merged_graphs) %>% as.data.frame() 221 | merged_attr <- igraph::vertex_attr(merged_graphs) 222 | for (sa in shared_attr) { 223 | merged_attr[[sa]] <- vector(length = igraph::vcount(merged_graphs)) 224 | for (i in seq_along(merged_attr[[sa]])) { 225 | # if !is.na _1, return _1 else return _2 226 | merged_attr[[sa]][i] <- 227 | ifelse(!is.na(merged_attr[[paste0(sa, "_1")]][i]), 228 | merged_attr[[paste0(sa, "_1")]][i], 229 | merged_attr[[paste0(sa, "_2")]][i]) 230 | } 231 | merged_graphs <- delete_vertex_attr(graph = merged_graphs, 232 | name = paste0(sa, "_1")) 233 | merged_graphs <- delete_vertex_attr(graph = merged_graphs, 234 | name = paste0(sa, "_2")) 235 | merged_graphs <- set_vertex_attr(graph = merged_graphs, 236 | name = sa, value = merged_attr[[sa]]) 237 | } 238 | class(merged_graphs) <- c("merged.igraph", "igraph") 239 | return(merged_graphs) 240 | } 241 | -------------------------------------------------------------------------------- /R/enrichment_functions.R: -------------------------------------------------------------------------------- 1 | #' Get interaction from ORA enrichment analysis 2 | #' 3 | #' Returns results of an ORA analysis as an interaction graph 4 | #' 5 | #' @param query a vector (or a list) of character with the ID to perform 6 | #' the ORA analysis 7 | #' @param sources (optional) a character in 8 | #' (GO, KEGG, REAC, TF, MIRNA, CORUM, HP, HPA, WP) 9 | #' @param organism (optional) a character (default = 'hsapiens') 10 | #' @param signif.value (optional) a logical, default = '' 11 | #' 12 | #' @return 13 | #' a graph object (or list of graph) containing the interaction between 14 | #' the query and the target terms. 15 | #' 16 | #' @seealso \code{\link[gprofiler2]{gost}} \code{\link[gprofiler2]{gconvert}} 17 | #' 18 | #' @examples 19 | #' query <- c('IL15', 'CDHR5', 'TGFA', 'C4B') 20 | #' get_interaction_from_ORA(query, 21 | #' sources = 'GO') 22 | #' 23 | #' query <- list('All' = c('IL15', 'CDHR5', 'TGFA', 'C4B'), 24 | #' 'c1' = c('IL15', 'CDHR5', 'TGFA')) 25 | #' get_interaction_from_ORA(query, 26 | #' sources = 'GO') 27 | #' 28 | #' @importFrom gprofiler2 gost gconvert 29 | #' @importFrom dplyr pull select filter 30 | #' @export 31 | get_interaction_from_ORA <- function(query, 32 | sources = "GO", 33 | organism = "hsapiens", 34 | signif.value = TRUE) { 35 | # validate query (char) 36 | if (is(query, "list")) { 37 | query <- lapply(query, 38 | function(x) 39 | check_vector_char(x, 40 | var.name = "'query '")) 41 | if (is.null(names(query))) { 42 | names(query) <- seq_along(query) 43 | } 44 | } else { 45 | query <- check_vector_char(query) 46 | } 47 | 48 | # check organism 49 | organism = check_vector_char( 50 | X = organism, 51 | X.length = 1, 52 | default = "hsapiens", 53 | var.name = "'organism' " 54 | ) 55 | 56 | # check source 57 | sources <- match.arg( 58 | arg = sources, 59 | choices = c("GO", "KEGG", "REAC", "TF", "MIRNA", "CORUM", "HP", 60 | "HPA", "WP"), 61 | several.ok = FALSE 62 | ) 63 | sources <- 64 | check_vector_char(sources, default = "GO") # default value 65 | 66 | # check signif 67 | signif.value <- return_true_false(signif.value, default = TRUE) 68 | 69 | if (is(query, "list")) { 70 | res.ora <- list() 71 | term_map <- list() 72 | res.graph <- list() 73 | for (i in names(query)) { 74 | res.ora[[i]] <- get_ORA(query = query[[i]], 75 | sources = sources, 76 | organism = organism) 77 | 78 | term_map_tmp <- gprofiler2::gconvert(query = query[[i]], 79 | organism = organism, 80 | target = sources) 81 | 82 | target_id <- ( 83 | res.ora[[i]] %>% 84 | dplyr::filter(significant == signif.value) %>% 85 | dplyr::pull(term_id) 86 | ) 87 | 88 | term_map[[i]] <- term_map_tmp %>% 89 | dplyr::filter(target %in% target_id) %>% 90 | dplyr::select(input, target) %>% 91 | unique %>% 92 | na.omit() 93 | 94 | res.graph[[i]] <- 95 | igraph::graph_from_data_frame(term_map[[i]], 96 | directed = FALSE) 97 | res.graph[[i]] <- set_vertex_attr( 98 | graph = res.graph[[i]], 99 | name = "mode", 100 | index = term_map[[i]]$input, 101 | value = "core" 102 | ) 103 | res.graph[[i]] <- set_vertex_attr( 104 | graph = res.graph[[i]], 105 | name = "mode", 106 | index = term_map[[i]]$target, 107 | value = "extended" 108 | ) 109 | class(res.graph) <- 110 | c("list.interaction.igraph", "list.igraph") 111 | } 112 | } else { 113 | # query is not a list 114 | res.ora <- get_ORA(query = query, 115 | sources = sources, 116 | organism = organism) 117 | 118 | term_map_tmp <- gprofiler2::gconvert(query = query, 119 | organism = organism, 120 | target = sources) 121 | 122 | target_id <- (res.ora %>% 123 | dplyr::filter(significant == signif.value) %>% 124 | dplyr::pull(term_id)) 125 | 126 | if (is.null(term_map_tmp)) { 127 | return(NULL) 128 | } 129 | term_map <- term_map_tmp %>% 130 | dplyr::filter(target %in% target_id) %>% 131 | dplyr::select(input, target) %>% 132 | unique %>% 133 | na.omit() 134 | 135 | res.graph <- 136 | igraph::graph_from_data_frame(term_map, directed = FALSE) 137 | res.graph <- set_vertex_attr( 138 | graph = res.graph, 139 | name = "mode", 140 | index = term_map$input, 141 | value = "core" 142 | ) 143 | res.graph <- set_vertex_attr( 144 | graph = res.graph, 145 | name = "mode", 146 | index = term_map$target, 147 | value = "extended" 148 | ) 149 | 150 | class(res.graph) <- c("interaction.igraph", "igraph") 151 | 152 | } 153 | return(res.graph) 154 | } 155 | 156 | 157 | #' ORA enrichment analysis 158 | #' 159 | #' Returns results of an ORA analysis 160 | #' 161 | #' @param query a vector of character, a lit of ID 162 | #' @param sources a character or list of character 163 | #' @param organism a character (default = 'hsapiens') 164 | #' 165 | #' @return 166 | #' a data.frame containing the enrichment result 167 | #' 168 | #' @seealso \code{\link[gprofiler2]{gost}} 169 | #' 170 | #' @importFrom gprofiler2 gost 171 | get_ORA <- function(query, 172 | sources = NULL, 173 | organism = "hsapiens") { 174 | if (is(query, "list")) { 175 | res <- list() 176 | for (i in names(query)) { 177 | ORA <- gprofiler2::gost( 178 | query = query[[i]], 179 | organism = organism, 180 | significant = FALSE, 181 | sources = sources, 182 | multi_query = FALSE 183 | ) 184 | ORA.res <- ORA$result 185 | if (!is.null(ORA.res)) { 186 | ORA.res <- ORA.res %>% 187 | mutate(cluster = i) %>% 188 | dplyr::select( 189 | "cluster", 190 | "term_id", 191 | "source", 192 | "term_name", 193 | "p_value", 194 | "significant", 195 | "term_size", 196 | "query_size", 197 | "intersection_size", 198 | "precision", 199 | "recall" 200 | ) 201 | res[[i]] <- ORA.res 202 | } 203 | } 204 | RES <- purrr::map_dfr(res, ~ .x) 205 | 206 | } else { 207 | ORA <- gprofiler2::gost( 208 | query = query, 209 | organism = organism, 210 | significant = FALSE, 211 | sources = sources, 212 | multi_query = FALSE 213 | ) 214 | ORA.res <- ORA$result 215 | if (!is.null(ORA.res)) { 216 | ORA.res <- ORA.res %>% 217 | mutate(cluster = "All") %>% 218 | dplyr::select( 219 | "cluster", 220 | "term_id", 221 | "source", 222 | "term_name", 223 | "p_value", 224 | "significant", 225 | "term_size", 226 | "query_size", 227 | "intersection_size", 228 | "precision", 229 | "recall" 230 | ) 231 | RES <- ORA.res 232 | } else { 233 | RES <- NULL 234 | } 235 | } 236 | return(RES) 237 | } 238 | 239 | #' Get GO info 240 | #' 241 | #' From a GO terms (GOID), return definition, ontology and term values 242 | #' from GO.db 243 | #' 244 | #' @param go a character, GO term 245 | #' 246 | #' @return 247 | #' a data.frame with the following columns: 'GOID', 'DEFINITION', 248 | #' 'ONTOLOGY', 'TERM' 249 | #' 250 | #' @import GO.db 251 | #' @importFrom AnnotationDbi keytypes 252 | get_go_info <- function(go) { 253 | res <- AnnotationDbi::select( 254 | x = GO.db, 255 | keys = go, 256 | keytype = "GOID", 257 | columns = keytypes(GO.db) 258 | ) 259 | return(res) 260 | } 261 | -------------------------------------------------------------------------------- /R/get_graph_stats.R: -------------------------------------------------------------------------------- 1 | #' Get graph statistics 2 | #' 3 | #' For a given igraph or list of igraph objects, this function summarize 4 | #' the number of vertices/edges and other vertex attributes. 5 | #' 6 | #' @param X an 'igraph' or 'list.igraph' object 7 | #' 8 | #' @return 9 | #' It returns a long data.frame with number of nodes/edges, 10 | #' and the count of the different attributes 11 | #' (if X is a list of graph, each row describes a graph) 12 | #' 13 | #' @examples 14 | #' graph1 <- igraph::graph_from_data_frame( 15 | #' list(from = c('A', 'B', 'A', 'D', 'C', 'A', 'C'), 16 | #' to = c('B', 'C', 'D', 'E', 'D', 'F', 'G')), 17 | #' directed = FALSE) 18 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 19 | #' name = 'type', 20 | #' index = c('A','B','C'), 21 | #' value = '1') 22 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 23 | #' name = 'type', 24 | #' index = c('D','E'), 25 | #' value = '2') 26 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 27 | #' name = 'type', 28 | #' index = c('F', 'G'), 29 | #' value = '-1') 30 | #' 31 | #' get_graph_stats(graph1) 32 | #' 33 | #' graph1.list <- list(graph1 = graph1, 34 | #' graph2 = graph1) 35 | #' get_graph_stats(graph1.list) 36 | #' 37 | #' @importFrom minet build.mim aracne 38 | #' @importFrom magrittr %>% 39 | #' @importFrom dplyr select all_of 40 | #' @importFrom purrr imap_dfr 41 | #' @importFrom igraph set_vertex_attr graph_from_adjacency_matrix 42 | #' @export 43 | get_graph_stats <- function(X) { 44 | 45 | X <- check_graph(X) 46 | 47 | if (is(X, "list") | 48 | is(X, "list.igraph")) { 49 | as.data.frame( 50 | lapply(X, function(x) .get_graph_stats_graph(x)), 51 | check.names = FALSE 52 | ) 53 | stats <- as.data.frame( 54 | purrr::imap_dfr(X, ~.get_graph_stats_graph(.x)), 55 | check.names = FALSE 56 | ) 57 | rownames(stats) <- names(X) 58 | 59 | } else { 60 | # X is not a list 61 | stats <- .get_graph_stats_graph(X) 62 | } 63 | class(stats) <- c("stats", "data.frame") 64 | return(stats) 65 | } 66 | 67 | 68 | #' @importFrom igraph degree ecount edge_density 69 | .get_graph_stats_graph <- function(X) { 70 | node.c <- sum(igraph::degree(X) != 0) 71 | node.i <- sum(igraph::degree(X) == 0) 72 | edge <- igraph::ecount(X) 73 | edge.density <- igraph::edge_density(graph = X) 74 | res <- list(node.c = node.c, 75 | node.i = node.i, 76 | edge = edge, 77 | edge.density = edge.density) 78 | 79 | if (any(names(vertex_attr(X)) !="name")) { 80 | item <- names(vertex_attr(X))[names(vertex_attr(X)) != "name"] 81 | vertex.attr.res <- as.data.frame( 82 | vertex_attr(X), 83 | check.names = FALSE 84 | ) %>% 85 | # tidyselect deprecation was: 86 | # dplyr::select(item) 87 | # Now: 88 | dplyr::select(dplyr::all_of(item)) 89 | for (i in item) { 90 | tmp <- as.list(table(vertex.attr.res[[i]])) 91 | for (j in names(tmp)) { 92 | name_item <- paste(i, j, sep = ":") 93 | res[[name_item]] <- tmp[[j]] 94 | } 95 | } 96 | } 97 | return(as.data.frame(res, check.names = FALSE)) 98 | } 99 | 100 | -------------------------------------------------------------------------------- /R/get_grn.R: -------------------------------------------------------------------------------- 1 | #' Gene Regulatory Network 2 | #' 3 | #' Get Gene Regulatory Network (GRN) from a data.frame. 4 | #' Optionally, if the gene are clustered, sub_network are build for 5 | #' each cluster. 6 | #' 7 | #' @param X a \code{data.frame}/\code{matrix} with gene expression 8 | #' (genes in columns, samples in rows). 9 | #' @param cluster (optional) clustering result from 10 | #' \code{\link[timeOmics]{getCluster}} 11 | #' @param method network building method, one of c('aracne') 12 | #' @param type character added to node metadata 13 | #' 14 | #' 15 | #' @details 16 | #' Methods of GRN reconstruction are as follows: 17 | #' 'aracne': use ARACNe algorithm on Mutual Information (MI) adjency matrix 18 | #' to remove low MI edges in triangles. 19 | #' 20 | #' @return 21 | #' An igraph object if no cluster informations are given. 22 | #' Otherwise, it returns a list of igraph object (\code{list.igraph}) with 23 | #' a subgraph for each cluster and a global graph with all the genes. 24 | #' 25 | #' @seealso 26 | #' \code{\link[minet]{build.mim}}, 27 | #' \code{\link[minet]{aracne}}, 28 | #' \code{\link[timeOmics]{getCluster}} 29 | #' 30 | #' @examples 31 | #' data(hmp_T2D) 32 | #' # grn only on gene 33 | #' cluster.mRNA <- timeOmics::getCluster(hmp_T2D$getCluster.res, 34 | #' user.block = 'RNA') 35 | #' X <- hmp_T2D$raw$RNA 36 | #' grn.res <- get_grn(X = hmp_T2D$raw$RNA, 37 | #' cluster = cluster.mRNA, 38 | #' method = 'aracne') 39 | #' 40 | #' 41 | #' @importFrom minet build.mim aracne 42 | #' @importFrom magrittr %>% 43 | #' @importFrom dplyr select 44 | #' @importFrom purrr map 45 | #' @importFrom igraph set_vertex_attr graph_from_adjacency_matrix as.undirected 46 | #' @export 47 | get_grn <- function(X, 48 | cluster = NULL, 49 | method = c("aracne"), 50 | type = "gene" 51 | ) { 52 | 53 | # check if X 54 | X <- validate_matrix_X(X, var.name = "'X' ") 55 | 56 | # check cluster 57 | cluster <- check_getCluster(cluster) 58 | 59 | # check method, for now only 1 60 | method <- match.arg(method) 61 | 62 | # check type 63 | type <- check_vector_char(type, X.length = 1, default = "gene") 64 | 65 | if (is.null(cluster)) { 66 | # no clusteing info -> perform grn on all molecules 67 | mim <- minet::build.mim(X) 68 | grn.adj <- minet::aracne(mim) 69 | grn.graph <- igraph::graph_from_adjacency_matrix(grn.adj) %>% 70 | igraph::as.undirected() 71 | 72 | # add type attribute 'type' <- 'Gene' 73 | grn.graph <- igraph::set_vertex_attr(graph = grn.graph, 74 | name = "type", 75 | value = type) 76 | grn.graph <- igraph::set_vertex_attr(graph = grn.graph, 77 | name = "mode", 78 | value = "core") 79 | grn.graph <- igraph::set_vertex_attr(graph = grn.graph, 80 | name = "cluster", 81 | value = "All") 82 | 83 | # res <- list() 84 | return(grn.graph) 85 | } else { 86 | # cluster != NULL we do have cluster info and data are clustered 1. grn 87 | # for all 88 | mim <- minet::build.mim(X) 89 | grn.adj <- minet::aracne(mim) 90 | grn.graph <- igraph::graph_from_adjacency_matrix(grn.adj) %>% 91 | igraph::as.undirected() 92 | 93 | grn.graph <- igraph::set_vertex_attr(graph = grn.graph, 94 | name = "type", 95 | value = type) 96 | grn.graph <- igraph::set_vertex_attr(graph = grn.graph, 97 | name = "mode", 98 | value = "core") 99 | 100 | res <- list() 101 | res[["All"]] <- grn.graph 102 | 103 | # 2. grn by all clusters 104 | mol_cluster <- cluster %>% 105 | split(.$cluster) %>% 106 | purrr::map(~.x$molecule) 107 | X.by.cluster <- purrr::map( 108 | mol_cluster, ~{ 109 | dplyr::select( 110 | as.data.frame(X, check.names = FALSE), 111 | .x 112 | ) 113 | } 114 | ) 115 | 116 | # names_mol_cluster <- check_name_list(mol_cluster) 117 | for (i in names(mol_cluster)) { 118 | mim.cluster <- minet::build.mim(X.by.cluster[[i]]) 119 | grn.adj.cluster <- minet::aracne(mim.cluster) 120 | grn.graph.cluster <- igraph::graph_from_adjacency_matrix( 121 | grn.adj.cluster) %>% 122 | igraph::as.undirected() 123 | grn.graph.cluster <- igraph::set_vertex_attr( 124 | graph = grn.graph.cluster, 125 | name = "type", 126 | value = type) 127 | grn.graph.cluster <- igraph::set_vertex_attr( 128 | graph = grn.graph.cluster, 129 | name = "mode", 130 | value = "core") 131 | grn.graph.cluster <- igraph::set_vertex_attr( 132 | graph = grn.graph.cluster, 133 | name = "cluster", 134 | value = i) 135 | 136 | res[[i]] <- grn.graph.cluster 137 | 138 | # also add cluster info to 'All' graph 139 | res[["All"]] <- igraph::set_vertex_attr( 140 | graph = res[["All"]], name = "cluster", 141 | value = i, 142 | index = igraph::V(grn.graph.cluster)$name 143 | ) 144 | 145 | } 146 | class(res) <- c("list.igraph") 147 | } 148 | return(res) 149 | } 150 | 151 | 152 | -------------------------------------------------------------------------------- /R/get_interaction_from_database.R: -------------------------------------------------------------------------------- 1 | #' Get interaction from database 2 | #' 3 | #' Returns an interaction graph from a vector of nodes (or a list of vectors) 4 | #' and an interaction database (data.frame or igraph) 5 | #' 6 | #' @param X vector of nodes or list of vectors 7 | #' @param db data.frame (with two columns: from, to) or igraph 8 | #' @param type character added to node metadata 9 | #' @param user.ego logical, if user.ego == TRUE looks for first degree neighbors 10 | #' in db and add 'mode' metadata ('core'/'extended') 11 | #' 12 | #' @return a subset graph of db from X list of nodes 13 | #' 14 | #' @examples 15 | #' X <- letters[1:4] 16 | #' db <- as.data.frame(list(from = sample(letters[1:10], replace = TRUE), 17 | #' to = sample(letters[1:10], replace = TRUE))) 18 | #' 19 | #' sub <- get_interaction_from_database(X, 20 | #' db) 21 | #' 22 | #' db.graph <- igraph::graph_from_data_frame(db, 23 | #' directed=FALSE) 24 | #' sub <- get_interaction_from_database(X, 25 | #' db) 26 | #' 27 | #' @importFrom purrr is_empty map reduce 28 | #' @importFrom igraph induced_subgraph set_vertex_attr adjacent_vertices 29 | #' @export 30 | get_interaction_from_database <- function(X, 31 | db = NULL, 32 | type = "db", 33 | user.ego = FALSE) { 34 | 35 | # check X 36 | if (is(X, "list")) { 37 | X <- lapply(X, function(x) check_vector_char(x)) 38 | if (is.null(names(X))) { 39 | names(X) <- seq_along(X) 40 | } 41 | } else { 42 | X <- check_vector_char(X) 43 | } 44 | 45 | # check db 46 | db <- check_db(db, var.name = "'db' ") 47 | 48 | # check type 49 | type <- check_vector_char(type, X.length = 1, default = "db") 50 | 51 | # check user.ego 52 | user.ego <- return_true_false(user.ego, default = FALSE) 53 | 54 | 55 | if (is.null(X)) { 56 | message("X is NULL, returning an empty graph") 57 | db.subgraph <- igraph::make_empty_graph(directed = FALSE) 58 | class(db.subgraph) <- c("interaction.igraph", "igraph") 59 | return(db.subgraph) 60 | } else if (is(X, "list")) { 61 | # filter db from X 62 | db.subgraph.list <- list() 63 | if (is(db, "igraph")) { 64 | ### 65 | db.subgraph.list <- lapply(X, function(i){ 66 | .interaction_from_igraph(X = i, 67 | db = db, 68 | ego = user.ego, 69 | type = type) 70 | }) 71 | 72 | } else { 73 | # db is a data.frame 74 | db.subgraph.list <- lapply(X, function(i){ 75 | .interaction_from_dataframe(X = i, 76 | db = db, 77 | ego = user.ego, 78 | type = type) 79 | }) 80 | } 81 | class(db.subgraph.list) <- "list.igraph" 82 | return(db.subgraph.list) 83 | } else { 84 | # X is a single vector 85 | if (is(db, "igraph")) { 86 | db.subgraph <- .interaction_from_igraph(X = X, 87 | db = db, 88 | ego = user.ego, 89 | type = type) 90 | } else { 91 | # db is a data.frame 92 | db.subgraph <- .interaction_from_dataframe(X = X, 93 | db = db, 94 | ego = user.ego, 95 | type = type) 96 | } 97 | return(db.subgraph) 98 | } 99 | } 100 | 101 | .interaction_from_igraph <- function(X, 102 | db, 103 | ego, 104 | type) { 105 | node.names <- intersect(X, igraph::V(db)$name) 106 | if (purrr::is_empty(node.names)) { 107 | message("no shared elements between X and db, return empty graph") 108 | db.subgraph <- igraph::make_empty_graph(directed = FALSE) 109 | } else if (isTRUE(ego)) { 110 | ego.neighbors <- igraph::adjacent_vertices(graph = db, 111 | v = node.names, 112 | mode = "all") 113 | ego.neighbors <- unique( 114 | purrr::reduce( 115 | purrr::map(ego.neighbors, ~names(.x)), 116 | union 117 | ) 118 | ) 119 | ego.neighbors <- setdiff(ego.neighbors, node.names) 120 | 121 | db.subgraph <- igraph::induced_subgraph(graph = db, 122 | vids = c(node.names, 123 | ego.neighbors)) 124 | db.subgraph <- igraph::set_vertex_attr(graph = db.subgraph, 125 | name = "mode", 126 | index = node.names, 127 | value = "core") 128 | db.subgraph <- igraph::set_vertex_attr(graph = db.subgraph, 129 | name = "mode", 130 | index = ego.neighbors, 131 | value = "extended") 132 | } else { 133 | # ego = FALSE 134 | db.subgraph <- igraph::induced_subgraph(graph = db, 135 | vids = c(node.names)) 136 | db.subgraph <- igraph::set_vertex_attr(graph = db.subgraph, 137 | name = "mode", 138 | index = node.names, 139 | value = "core") 140 | } 141 | # return graph 142 | db.subgraph <- igraph::set_vertex_attr(graph = db.subgraph, 143 | name = "type", 144 | value = type) 145 | class(db.subgraph) <- c("interaction.igraph", "igraph") 146 | return(db.subgraph) 147 | } 148 | 149 | .interaction_from_dataframe <- function(X, 150 | db, 151 | ego, 152 | type) { 153 | db <- as.data.frame(db) %>% 154 | dplyr::select(c("from", "to")) # checked colnames 155 | db.all.nodes <- unique(c(db$from, db$to)) 156 | node.names <- intersect(X, db.all.nodes) 157 | if (purrr::is_empty(node.names)) { 158 | message("no shared elements between X and db, return empty graph") 159 | db.subgraph <- igraph::make_empty_graph(directed = FALSE) 160 | } else if (isTRUE(ego)) { 161 | ego.db <- db %>% 162 | dplyr::filter(.$from %in% node.names | .$to %in% node.names) 163 | # ego.neighbors <- setdiff(db.all.nodes, node.names) 164 | ego.neighbors <- setdiff( 165 | unique(c(ego.db$from, ego.db$to)), 166 | node.names 167 | ) 168 | 169 | db.subgraph <- igraph::graph_from_data_frame(ego.db, directed = FALSE) 170 | db.subgraph <- igraph::set_vertex_attr(graph = db.subgraph, 171 | name = "mode", 172 | index = node.names, 173 | value = "core") 174 | db.subgraph <- igraph::set_vertex_attr(graph = db.subgraph, 175 | name = "mode", 176 | index = ego.neighbors, 177 | value = "extended") 178 | } else { 179 | # ego = FALSE 180 | ego.db <- db %>% 181 | dplyr::filter(.$from %in% node.names & .$to %in% node.names) 182 | 183 | db.subgraph <- igraph::graph_from_data_frame(ego.db, directed = FALSE) 184 | db.subgraph <- igraph::set_vertex_attr(graph = db.subgraph, 185 | name = "mode", 186 | value = "core") 187 | } 188 | 189 | # return graph 190 | db.subgraph <- igraph::set_vertex_attr(graph = db.subgraph, 191 | name = "type", 192 | value = type) 193 | class(db.subgraph) <- c("interaction.igraph", "igraph") 194 | return(db.subgraph) 195 | } 196 | -------------------------------------------------------------------------------- /R/hmp_T2D.R: -------------------------------------------------------------------------------- 1 | #' hmp_T2D 2 | #' 3 | #' This dataset contained a list of data.frames. 4 | #' Raw data is a subset of the data available at: 5 | #' https://github.com/aametwally/ipop_seasonal 6 | #' The package will be illustrated on longitudinal MO dataset to study the 7 | #' seasonality of MO expression in patients with diabetes 8 | #' (see `netOmics` vignette). 9 | #' In this subset we focused on a single individual with 7 timepoints. 10 | #' Briefly 6 different omics were sampled (RNA, proteins, cytokines, 11 | #' gut microbiome, metabolites and clinical variables). 12 | #' 13 | #' 14 | #' @format a list of data.frame 15 | #' \describe{ 16 | #' \item{raw}{data.frame, raw data} 17 | #' \item{modelled}{data.frame, modelled data} 18 | #' \item{getCluster.res}{data.frame, clustering results from timeOmics} 19 | #' \item{getCluster.sparse.res}{data.frame, sparse clustering results from timeOmics} 20 | #' \item{interaction.biogrid}{data.frame, interactions from BioGRID database} 21 | #' \item{interaction.TF}{data.frame, TFome interactions from TTrust and TF2DNA} 22 | #' \item{medlineranker.res.df}{data.frame, medlineRanker enrichment results} 23 | #' \item{graph.gut}{list of igraph, gut graph obtained with SparCC} 24 | #' } 25 | #' 26 | "hmp_T2D" -------------------------------------------------------------------------------- /R/merge_layers_by_correlation.R: -------------------------------------------------------------------------------- 1 | #' Interaction_from_correlation 2 | #' 3 | #' Compute correlation between two dataframe X and Y (or list of data.frame). 4 | #' An incidence graph is returned. A link between two features is produced 5 | #' if their correlation (absolute value) is above the threshold. 6 | #' 7 | #' @param X a data.frame or list of data.frame (with a similar number of row). 8 | #' @param Y a data.frame or list of data.frame (with a similar number of row). 9 | #' @param threshold a threshold to cut the correlation matrix above which a link 10 | #' is created between a feature from X and a feature from Y. 11 | #' 12 | #' @return an 'igraph' object 13 | 14 | 15 | 16 | #' @examples 17 | #' X <- matrix(rexp(200, rate=.1), ncol=20) 18 | #' Y <- matrix(rexp(200, rate=.1), ncol=20) 19 | #' get_interaction_from_correlation(X,Y) 20 | #' 21 | #' X <- list(matrix(rexp(200, rate=.1), ncol=20), 22 | #' matrix(rexp(200, rate=.1), ncol=20)) 23 | #' Y <- matrix(rexp(200, rate=.1), ncol=20) 24 | #' get_interaction_from_correlation(X,Y) 25 | #' 26 | #' @importFrom igraph graph_from_biadjacency_matrix simplify 27 | #' @importFrom stats cor 28 | 29 | #' @export 30 | get_interaction_from_correlation <- function(X, 31 | Y, 32 | threshold = 0.5) { 33 | 34 | # check X 35 | if (is(X, "list")) { 36 | X <- validate_list_matrix_X(X) 37 | if (length(unique(unlist(lapply(X, nrow)))) > 1) { 38 | stop("'X' must have the same number of rows") 39 | } 40 | X <- do.call(X, what = "cbind") 41 | } else { 42 | X <- validate_matrix_X(X) 43 | } 44 | 45 | # check Y 46 | if (is(Y, "list")) { 47 | # X and Y can have a different length 48 | Y <- validate_list_matrix_X(Y, var.name = "'Y' ") 49 | if (length(unique(unlist(lapply(Y, nrow)))) > 1) { 50 | stop("'Y' must have the same number of rows") 51 | } 52 | Y <- do.call(Y, what = "cbind") 53 | } else { 54 | Y <- validate_matrix_X(Y, var.name = "'Y' ") 55 | } 56 | 57 | # check threshold 58 | threshold <- check_single_numeric_value(threshold, 59 | min = 0, 60 | max = 1, 61 | var.name = "'threshold' ") 62 | 63 | # corr between X and Y 64 | res.corr <- cor(x = X, y = Y, method = "spearman") 65 | corr.graph <- abs(res.corr) >= 66 | threshold 67 | 68 | # graph 69 | res.graph <- igraph::graph_from_biadjacency_matrix(corr.graph, 70 | directed = FALSE) 71 | res.graph <- igraph::simplify(res.graph) 72 | 73 | return(res.graph) 74 | } 75 | 76 | 77 | 78 | -------------------------------------------------------------------------------- /R/netOmics-package.R: -------------------------------------------------------------------------------- 1 | #' netOmics: network-based multi-omics integration and interpretation 2 | #' 3 | #' netOmics is a multi-omics networks builder and explorer. 4 | #' It uses a combination of network inference algorithms and and knowledge-based 5 | #' graphs to build multi-layered networks. 6 | #' 7 | #' The package can be combined with 8 | #' `timeOmics` to incorporate time-course expression data and build 9 | #' sub-networks from multi-omics kinetic clusters. 10 | #' 11 | #' Finally, from the generated multi-omics networks, propagation analyses allow 12 | #' the identification of missing biological functions (1), 13 | #' multi-omics mechanisms (2) and molecules between kinetic clusters (3). 14 | #' This helps to resolve complex regulatory mechanisms. 15 | #' Here are the main functions. 16 | #' 17 | #' @section Network building: 18 | 19 | #' \describe{ 20 | #' \item{`get_grn`}{Based on expression matrix, this function build a gene 21 | #' gene regulatory network. Additionally, if clustering information is given, 22 | #' it builds cluster specific graph.} 23 | #' \item{`get_interaction_from_database`}{From a database (graph or data.frame 24 | #' with interactions between 2 molecules), this function build the induced 25 | #' graph based on a list of molecules . Alternatively, the function can 26 | #' build a graph with the first degree neighbors.} 27 | #' \item{`get_interaction_from_correlation`}{Compute correlation between two 28 | #' dataframe X and Y (or list of data.frame). 29 | #' An incidence graph is returned. A link between two features is produced 30 | #' if their correlation (absolute value) is above the threshold.} 31 | #' \item{`combine_layers`}{Combine 2 (or list of) graphs based on given 32 | #' intersections.} 33 | #' } 34 | #' 35 | #' @section Network exploration: 36 | #' \describe{ 37 | #' \item{`random_walk_restart`}{This function performs a propagation analysis 38 | #' by random walk with restart 39 | #' in a multi-layered network from specific seeds.} 40 | #' \item{`rwr_find_seeds_between_attributes`}{From rwr results, this function 41 | #' returns a subgraph if any vertex shares 42 | #' different attributes value. 43 | #' In biological context, this might be useful to identify vertex shared between 44 | #' clusters or omics types.} 45 | #' \item{`rwr_find_closest_type`}{From a rwr results, this function returns 46 | #' the closest nodes from a seed with 47 | #' a given attribute and value. 48 | #' In biological context, it might be useful to get the closest Gene Ontology 49 | #' annotation nodes from unannotated seeds.} 50 | #' } 51 | #' 52 | #' @section Visualisation: 53 | #' \describe{ 54 | #' \item{`summary_plot_rwr_attributes`}{#' Based on the results of 55 | #' \code{\link[netOmics]{rwr_find_seeds_between_attributes}} which identify the 56 | #' closest k neighbors from a seed, this function returns a barplot of the node 57 | #' types (layers) reached for each seed.} 58 | #' \item{`plot_rwr_subnetwork`}{Display the subgraph from a RWR results. 59 | #' This function colors adds a specific 60 | #' color to each node based on their 'type' attribute. 61 | #' It also adds a legend including the number of vertices/edges and the number 62 | #' of nodes of specific type. 63 | #' Additionally, the function can display any igraph object.} 64 | #' } 65 | #' 66 | #' 67 | #' @docType package 68 | #' @name netOmics 69 | #' 70 | NULL 71 | #> NULL -------------------------------------------------------------------------------- /R/plot.R: -------------------------------------------------------------------------------- 1 | #' Summary Plot RWR attributes 2 | #' 3 | #' Based on the results of 4 | #' \code{\link[netOmics]{rwr_find_seeds_between_attributes}} which identify the 5 | #' closest k neighbors from a seed, this function returns a barplot of the node 6 | #' types (layers) reached for each seed. 7 | #' 8 | #' @param X a 'rwr.attributes' or 'list.rwr.attributes' object 9 | #' from rwr_find_seeds_between_attributes() 10 | #' @param color (optional) a named character vector or list, 11 | #' list of color to apply to each type 12 | #' @param seed.id (optional) a character vector, to filter the results and 13 | #' filter on specific seeds IDs 14 | #' @param seed.type (optional) a character vector, to filter the results and 15 | #' filter on specific seeds types 16 | #' @param plot logical, if TRUE then the plot is produced 17 | #' 18 | #' @return 19 | #' a 'ggplot' object 20 | #' 21 | #' @seealso \code{\link[netOmics]{random_walk_restart}}, 22 | #' \code{\link[netOmics]{rwr_find_seeds_between_attributes}} 23 | #' 24 | #' @examples 25 | #' graph1 <- igraph::graph_from_data_frame( 26 | #' list(from = c("A", "B", "A", "D", "C", "A", "C"), 27 | #' to = c("B", "C", "D", "E", "D", "F", "G")), 28 | #' directed = FALSE) 29 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 30 | #' name = 'type', 31 | #' index = c("A","B","C"), 32 | #' value = "1") 33 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 34 | #' name = 'type', 35 | #' index = c("D","E"), 36 | #' value = "2") 37 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 38 | #' name = 'type', 39 | #' index = c("F", "G"), 40 | #' value = "3") 41 | #' 42 | #' rwr_res <- random_walk_restart(X = graph1, 43 | #' seed = c("A", "B", "C", "D", "E")) 44 | #' rwr_res_type <- rwr_find_seeds_between_attributes(X = rwr_res, 45 | #' attribute = "type", 46 | #' k = 3) 47 | #' summary_plot_rwr_attributes(rwr_res_type) 48 | #' 49 | #' 50 | #' @importFrom tibble rownames_to_column 51 | #' @import ggplot2 52 | #' @importFrom purrr imap_dfr set_names 53 | #' @importFrom igraph vertex_attr 54 | #' @importFrom dplyr filter mutate left_join group_by select summarise n 55 | #' @export 56 | summary_plot_rwr_attributes <- function(X, 57 | color = NULL, 58 | seed.id = NULL, 59 | seed.type = NULL, 60 | plot = TRUE){ 61 | stopifnot(is(X, "rwr.attributes") | is(X, "list.rwr.attributes")) 62 | 63 | # check seed.id 64 | seed.id <- check_vector_char(X = seed.id, 65 | default = NULL, 66 | var.name = "'seed.id' ") 67 | 68 | # check seed.type 69 | seed.type <- check_vector_char(X = seed.type, 70 | default = NULL, 71 | var.name = "'seed.type' ") 72 | 73 | # check color 74 | if(!is.null(color)){ 75 | color <- check_named_vector(X = color, var.name = "'color' ") 76 | } 77 | # check plot 78 | plot <- return_true_false(x = plot, default = TRUE) 79 | 80 | 81 | if(is(X, "rwr.attributes")){ 82 | # seed type 83 | seed_types <- purrr::imap_dfr(X, ~{vertex_attr(.x) %>% 84 | as.data.frame() %>% dplyr::filter(rwr == "seed") %>% 85 | dplyr::select(name, type) %>% 86 | purrr::set_names(c("name", "seed.type"))}) 87 | # count layer 88 | va.all <- purrr::imap_dfr(X, ~{igraph::vertex_attr(.x) %>% 89 | as.data.frame() %>% 90 | dplyr::mutate(seed = .y) %>% 91 | dplyr::group_by(seed, type) %>% 92 | dplyr::summarise(N = dplyr::n(), .groups = "keep")}) %>% 93 | dplyr::left_join(seed_types, by = c("seed"="name")) 94 | } else { #X is list.rwr.attributes 95 | seed_types <- lapply(names(X), function(Y){ 96 | purrr::imap_dfr(X[[Y]], ~{igraph::vertex_attr(.x) %>% 97 | as.data.frame() %>% dplyr::filter(rwr == "seed") %>% 98 | dplyr::select(name, type) %>% 99 | purrr::set_names(c("name", "seed.type"))}) %>% 100 | dplyr::mutate(sub = Y)}) %>% do.call(what = "rbind") 101 | 102 | va.all <- lapply(names(X), function(Y){ 103 | purrr::imap_dfr(X[[Y]], ~{vertex_attr(.x) %>% as.data.frame() %>% 104 | dplyr::mutate(seed = .y) %>% 105 | dplyr::group_by(seed, type) %>% 106 | dplyr::summarise(N = dplyr::n(), .groups = "keep")}) %>% 107 | dplyr::mutate(sub = Y) 108 | }) %>% do.call(what = "rbind") %>% 109 | dplyr::left_join(seed_types, by = c("seed"="name", "sub" = "sub")) 110 | } 111 | 112 | # filter seed.id 113 | if(!is.null(seed.id)){ 114 | va.all <- va.all %>% dplyr::filter(seed %in% seed.id) 115 | } 116 | 117 | # filter seed.type 118 | if(!is.null(seed.type)){ 119 | user.seed.type <- seed.type 120 | va.all <- dplyr::filter(va.all, seed.type %in% user.seed.type) 121 | } 122 | 123 | if(!nrow(va.all)){ 124 | return(NULL) 125 | } 126 | 127 | # user color 128 | if(!is.null(color)){ 129 | user.color <- as.list(color) %>% # named list/vector 130 | as.data.frame(check.names = FALSE) %>% 131 | t %>% 132 | as.data.frame(check.names = FALSE) %>% 133 | tibble::rownames_to_column("type") %>% 134 | purrr::set_names(c("type", "color")) 135 | 136 | } else { # color is NULL -> defined color 137 | color.tmp <- va.all$type %>% unique %>% sort() 138 | user.color <- mixOmics::color.mixo(seq(color.tmp)) %>% 139 | purrr::set_names(color.tmp) %>% 140 | as.data.frame(check.names = FALSE) %>% 141 | tibble::rownames_to_column("type") %>% 142 | purrr::set_names(c("type", "color")) 143 | } 144 | 145 | # barplot 146 | # ----------- 147 | gg.tmp <- ggplot2::ggplot(va.all, aes(x = seed, y = N, fill = type)) + 148 | geom_bar(stat = "identity") + 149 | #scale_fill_identity(guide = "legend", labels = user.color$type) 150 | scale_fill_manual(values = user.color$color) + 151 | ylab("Node Types") + 152 | xlab("Seeds") + 153 | labs(fill = "Types") + 154 | theme_bw() + 155 | theme(axis.text.x = element_text(angle = 90, hjust=1)) 156 | 157 | if(is(X, "list.rwr.attributes")){ 158 | gg.tmp <- gg.tmp + facet_grid(.~sub, scales = "free_x") 159 | } 160 | if(plot == TRUE){ 161 | print(gg.tmp) 162 | } 163 | return(invisible(gg.tmp)) 164 | } 165 | 166 | #' Plot RWR subnetwork 167 | #' 168 | #' Display the subgraph from a RWR results. This function colors adds a specific 169 | #' color to each node based on their 'type' attribute. 170 | #' It also adds a legend including the number of vertices/edges and the number 171 | #' of nodes of specific type. 172 | #' Additionally, the function can display any igraph object. 173 | #' 174 | #' @param X an igraph object 175 | #' @param color (optional) a named character vector or list, list of color 176 | #' to apply to each type 177 | #' @param plot logical, if TRUE then the plot is produced 178 | #' @param legend (optional) logical, if TRUE then the legend is displayed 179 | #' with number of veretices/edges and the number of nodes of specific type. 180 | #' @param ... Arguments to be passed to the plot method 181 | #' 182 | #' @return 183 | #' X is returned with additional vertex attributes 184 | #' 185 | #' @examples 186 | #' graph1 <- igraph::graph_from_data_frame( 187 | #' list(from = c("A", "B", "A", "D", "C", "A", "C"), 188 | #' to = c("B", "C", "D", "E", "D", "F", "G")), 189 | #' directed = FALSE) 190 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 191 | #' name = 'type', 192 | #' index = c("A","B","C"), 193 | #' value = "1") 194 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 195 | #' name = 'type', 196 | #' index = c("D","E"), 197 | #' value = "2") 198 | #' graph1 <- igraph::set_vertex_attr(graph = graph1, 199 | #' name = 'type', 200 | #' index = c("F", "G"), 201 | #' value = "3") 202 | #' 203 | #' rwr_res <- random_walk_restart(X = graph1, 204 | #' seed = c("A")) 205 | #' rwr_res_type <- rwr_find_seeds_between_attributes(X = rwr_res, 206 | #' attribute = "type") 207 | #' 208 | #' plot_rwr_subnetwork(rwr_res_type$A) 209 | #' 210 | #' 211 | #' @import ggplot2 212 | #' @export 213 | plot_rwr_subnetwork <- function(X, 214 | color = NULL, 215 | plot = TRUE, 216 | legend = TRUE, 217 | ...){ 218 | # check X 219 | stopifnot(is(X, "igraph")) 220 | 221 | # check color 222 | if(!is.null(color)){ 223 | color <- check_named_vector(X = color, 224 | var.name = "'color' ") 225 | } 226 | 227 | # check plot 228 | plot <- return_true_false(x = plot, default = TRUE) 229 | legend <- return_true_false(x = legend, default = TRUE) 230 | 231 | 232 | va <- igraph::vertex_attr(X) %>% 233 | as.data.frame() 234 | 235 | # user color 236 | if(!is.null(color)){ 237 | user.color <- as.list(color) %>% # named list/vector 238 | as.data.frame(check.names = FALSE) %>% 239 | t %>% 240 | as.data.frame(check.names = FALSE) %>% 241 | tibble::rownames_to_column("type") %>% 242 | purrr::set_names(c("type", "color")) 243 | 244 | } else { # color is NULL -> defined color 245 | color.tmp <- va$type %>% unique %>% sort() 246 | user.color <- mixOmics::color.mixo(seq(color.tmp)) %>% 247 | purrr::set_names(color.tmp) %>% 248 | as.data.frame(check.names = FALSE) %>% 249 | tibble::rownames_to_column("type") %>% 250 | purrr::set_names(c("type", "color")) 251 | } 252 | 253 | 254 | va <- va %>% dplyr::left_join(user.color, by = c("type" = "type")) 255 | #mutate(color = ifelse(rwr == "seed", 'red', color)) %>% 256 | if('rwr' %in% names(va)){ 257 | va <- va %>% 258 | mutate(shape = ifelse(rwr == "seed", 'rectangle', "circle")) %>% 259 | mutate(frame.color = ifelse(rwr == "seed", 'red', "black")) 260 | } 261 | 262 | igraph::vertex_attr(X) <- va 263 | 264 | # graph stats 265 | legend.graph.stats <- list( 266 | leg = c(paste0("V: ",c(igraph::vcount(X))), 267 | paste0("E: ",c(igraph::ecount(X)))), 268 | pch = c(1, NA), lty = c(NA, 1)) 269 | 270 | ## type 271 | legend.graph.type <- va %>% group_by(type) %>% summarise(N = dplyr::n()) %>% 272 | mutate(leg = paste0(type, ": ", N)) %>% 273 | mutate(pch = c(19)) %>% 274 | left_join(user.color, by = c('type')) 275 | 276 | if(plot == TRUE){ 277 | # plot(X, ...) 278 | plot(X) 279 | 280 | if(legend == TRUE){ 281 | # legend.graph.stats 282 | legend("topleft", 283 | legend = legend.graph.stats$leg, 284 | pch = legend.graph.stats$pch, 285 | lty = legend.graph.stats$lty) 286 | 287 | # legend.graph.type 288 | legend("bottomleft", 289 | legend = legend.graph.type$leg, 290 | pch = legend.graph.type$pch, 291 | col = legend.graph.type$color) 292 | 293 | if('rwr' %in% names(va)){ 294 | title(main = va %>% filter(rwr == "seed") %>% pull(name)) 295 | } 296 | } 297 | } 298 | return(X) 299 | } 300 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # from timeOmics 2 | check_matrix <- function(X){ 3 | # add rownames and colnames if absent, cast into matrix 4 | if(!(is.matrix(X) || is.data.frame(X))) return(FALSE) 5 | 6 | if(is.data.frame(X)){ 7 | X <- as.matrix(X) 8 | } 9 | if(is.null(rownames(X))){ 10 | rownames(X) <- seq_len(nrow(X)) 11 | } 12 | if(is.null(colnames(X))){ 13 | colnames(X) <- paste0("V", seq_len(ncol(X))) 14 | } 15 | return(X) 16 | } 17 | 18 | validate_matrix_X <- function(X, var.name = "'X' "){ 19 | # X should be a numeric matrix 20 | X <- check_matrix(X) 21 | if(!is.numeric(X)){ 22 | stop(var.name,"must be a numeric matrix/data.frame") 23 | } 24 | # if(any(!X)) stop("X must be a numeric matrix/data.frame") 25 | return(X) 26 | } 27 | 28 | validate_list_matrix_X <- function(X, var.name = "'X' "){ 29 | if(!is.list(X)){ 30 | stop(var.name, "must be a list of matrix/data.frame") 31 | } 32 | X <- lapply(X, validate_matrix_X) 33 | return(X) 34 | } 35 | 36 | # is_almostInteger <- function (X) 37 | # { 38 | # if (!is.numeric(X) & !is.vector(X)) 39 | # return(FALSE) 40 | # if (length(X) != 1) 41 | # return(FALSE) 42 | # if (!is.finite(X)) 43 | # return(FALSE) 44 | # X.round <- round(X) 45 | # if (X == X.round) 46 | # return(TRUE) 47 | # return(FALSE) 48 | # } 49 | 50 | #' @importFrom methods is 51 | check_getCluster <- function(X){ 52 | if(!(is(X, "cluster.df") || is.null(X))){ 53 | stop("cluster must be NULL or a result from getCluster()") 54 | } 55 | #stopifnot(is(X, "cluster.df") || is.null(X)) 56 | return(X) 57 | } 58 | 59 | check_graph <- function(X){ 60 | stopifnot(is(X, "igraph") || 61 | is(X, "grn") || 62 | is.list(X) || 63 | is(X, "list.igraph")) 64 | 65 | if(is(X, "list")){ 66 | stopifnot(all(as.logical(lapply(X, 67 | function(x) {is(x, "igraph") || 68 | is(x, "list.igraph")})))) 69 | class(X) <- c("list.igraph", class(X)) 70 | } 71 | return(X) 72 | } 73 | 74 | check_db <- function(X, var.name = "'db' "){ 75 | # ADD list of db 76 | # x is a dataframe with 2 columns (from, to) or igraph 77 | if(!(is(X, "igraph") || is(X, "data.frame"))){ 78 | stop(var.name, "must be an igraph or data.frame object") 79 | } 80 | if(is(X, "data.frame") & !(all(c("from", "to") %in% colnames(X)))){ 81 | stop(var.name, "must contains the columns 'from' and 'to'") 82 | } 83 | return(X) 84 | } 85 | 86 | #' @importFrom purrr is_empty 87 | #' @importFrom stats na.omit 88 | check_vector_char <- function(X, 89 | X.length = NULL, 90 | default = NULL, 91 | var.name = "'X' "){ 92 | if(is.null(X)){ 93 | return(default) 94 | } 95 | 96 | # remove NA 97 | X <- na.omit(X) 98 | if(is_empty(X)){ 99 | return(default) 100 | } else if(!is.character(X)){ 101 | stop(var.name, "must be a charactor vector") 102 | } else if(!is.null(X.length)){ 103 | if(length(X) != X.length){ 104 | stop("invalid length") 105 | } else { # good length 106 | return(X) 107 | } 108 | } else{ 109 | return(X) 110 | } 111 | # return(default) 112 | } 113 | 114 | return_true_false <- function(x, default){ 115 | if(is.logical(x)){ 116 | if(is.finite(x)){ 117 | return(x) 118 | } else { #NA 119 | return(default) 120 | } 121 | } else { 122 | return(default) 123 | } 124 | } 125 | 126 | 127 | check_single_numeric_value <- function(x, 128 | min = NULL, 129 | max = NULL, 130 | var.name = "'r' "){ 131 | if(!is.numeric(x) & !is.matrix(x) & length(x) == 1){ 132 | stop(var.name, "must be a numeric value") 133 | } 134 | if(!is.null(min) & !is.null(max)){ 135 | if(x < min | x > max){ 136 | # internal, no need to check min and max order 137 | stop(var.name, "must be a numeric value between ", min, " and ", max) 138 | } 139 | } 140 | return(x) 141 | } 142 | 143 | check_named_vector <- function(X, var.name = "'X' "){ 144 | if(!(is(X, 'list') | is(X, "atomic"))){ 145 | stop(var.name, "must be a named verctor or list") 146 | } 147 | if(is.null(names(X))){ 148 | stop(var.name, "must be a named verctor or list") 149 | } 150 | return(X) 151 | } 152 | 153 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | .onAttach <- function(libname, pkgname) { 2 | msg <- sprintf( 3 | "Package '%s' is deprecated and will be removed from Bioconductor 4 | version %s", pkgname, "3.21") 5 | .Deprecated(msg=paste(strwrap(msg, exdent=2), collapse="\n")) 6 | } 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | [![Build Status](https://travis-ci.com/abodein/netOmics.svg?branch=master)] 3 | (https://travis-ci.com/abodein/netOmics) 4 | 5 | [![License: GPL v3](https://img.shields.io/badge/License-GPLv3-blue.svg)] 6 | (https://www.gnu.org/licenses/gpl-3.0) 7 | 8 | # netOmics 9 | 10 | With netOmics, we go beyond integration by introducing an interpretation tool. 11 | netOmics is a package for the creation and exploration of multi-omics networks. 12 | 13 | Depending on the provided dataset, it allows to create inference networks from 14 | expression data but also interaction networks from knowledge databases. 15 | After merging the sub-networks to obtain a global multi-omics network, 16 | we propose network exploration methods using propoagation techniques to perform 17 | functional prediction or identification of molecular mechanisms. 18 | 19 | Furthermore, the package has been developed for longitudinal multi-omics data 20 | and can be used in conjunction with our previously published package timeOmics. 21 | 22 | for more examples, please visite 23 | https://github.com/abodein/netOmics-case-studies 24 | 25 | ## Installation 26 | 27 | ### Latest `BioConductor` Release 28 | 29 | To install this package, start R (version "4.1") and enter: 30 | 31 | ```r 32 | if (!requireNamespace("BiocManager", quietly = TRUE)) 33 | install.packages("BiocManager") 34 | 35 | BiocManager::install("netOmics") 36 | ``` 37 | 38 | 39 | ### Latest `GitHub` Version 40 | 41 | Install the devtools package in R, then load it and install the latest stable 42 | version of `netOmics` from `GitHub` 43 | 44 | ```r 45 | ## install devtools if not installed 46 | if (!requireNamespace("devtools", quietly = TRUE)) 47 | install.packages("devtools") 48 | ## install netOmics 49 | devtools::install_github("abodein/netOmics") 50 | ``` 51 | 52 | ## Citing 53 | 54 | *"Bodein, A., Scott-Boyer, M. P., Perin, O., Le Cao, K. A., & Droit, A. (2020). 55 | Interpretation of network-based integration from multi-omics longitudinal data. 56 | bioRxiv."* 57 | 58 | ## Maintainer 59 | Antoine Bodein () 60 | 61 | ## Bugs/Feature requests 62 | 63 | If you have any bugs or feature requests, 64 | [let us know](https://github.com/abodein/netOmics/issues). 65 | Thanks! 66 | 67 | -------------------------------------------------------------------------------- /data-raw/hmp_T2D_raw.R: -------------------------------------------------------------------------------- 1 | 2 | library(tidyverse) 3 | library(timeOmics) 4 | library(lubridate) 5 | library(lmms) 6 | 7 | rm(list=ls()) 8 | 9 | # RData from: 10 | # Sailani, M. R., Metwally, A. A., Zhou, W., Rose, S. M. S. F., Ahadi, S., Contrepois, K., ... & Snyder, M. P. (2020). 11 | # Deep longitudinal multiomics profiling reveals two biological seasonal patterns in California. Nature communications, 11(1), 1-12. 12 | load("/home/antoine/Documents/timeomics_analysis/HMP_seasoning/Multi_Omics_Seasonal.RData") 13 | 14 | # 0. DATA CLEANING 15 | 16 | Gut_annotation_colData <- Gut_annotation_colData %>% 17 | mutate(YMD = lubridate::dmy(IRIS)) %>% 18 | mutate(Date = IRIS) %>% 19 | mutate(Time = yday(YMD)) %>% 20 | mutate(omics = "Gut") %>% dplyr::select(-Date, -BMI, -IRIS) 21 | 22 | list_lab <- list("RNA" = RNA_annotation_colData, 23 | "Metabo" = Metabolomics_annotation_colData, 24 | #"Gut" =Gut_annotation_colData, 25 | "Clinical" = Clinical_labs_annotation_colData) 26 | 27 | list_lab_df <- imap_dfr(list_lab, ~{.x %>% 28 | mutate("omics" = .y) %>% 29 | mutate(YMD = lubridate::ymd(as.Date(Date))) %>% 30 | dplyr::select(-Date) 31 | }) 32 | 33 | IRIS_BMI <- list_lab_df[c(1:3)] %>% unique() 34 | IRIS_only <- IRIS_BMI %>% dplyr::select(-BMI) %>% unique %>% filter(!is.na(IRIS), !is.na(SubjectID)) %>% 35 | unique 36 | IRIS_1 <- IRIS_only %>% group_by(SubjectID) %>% 37 | dplyr::summarise(N = n()) %>% 38 | filter(N == 1) %>% pull(SubjectID) %>% as.character() 39 | IRIS_only <- IRIS_only %>% filter(SubjectID %in% IRIS_1) 40 | 41 | # 1. DATA PREPARATION 42 | # GUT 43 | ########################### 44 | GUT_sample <- Gut_annotation_colData %>% 45 | mutate(Year = ifelse(year(YMD) < 2000, year(YMD) +2000, year(YMD))) %>% 46 | left_join(IRIS_only) %>% 47 | mutate(SampleID = paste0(SubjectID, "_", Time, "_", Year, "_", IRIS, "_", rownames(.))) 48 | 49 | GUT <- gut_df_Data 50 | rownames(GUT) <- GUT_sample$SampleID 51 | 52 | # CLINICAL 53 | ########################### 54 | CLINICAL_sample <- Clinical_labs_annotation_colData %>% 55 | mutate(Year = ifelse(year(Date) < 2000, year(Date) +2000, year(Date))) %>% 56 | left_join(IRIS_only) %>% 57 | mutate(SampleID = paste0(SubjectID, "_", Time, "_", Year, "_", IRIS, "_", rownames(.))) 58 | 59 | CLINICAL <- clinical_labs_Data 60 | rownames(CLINICAL) <- CLINICAL_sample$SampleID 61 | index.na <- CLINICAL %>% lapply(function(x) is.na(x) %>% sum) %>% unlist 62 | CLINICAL <- CLINICAL[index.na<=11] %>% na.omit 63 | 64 | # RNA 65 | ########################### 66 | RNA_sample <- RNA_annotation_colData %>% 67 | mutate(Year = ifelse(year(Date) < 2000, year(Date) +2000, year(Date))) %>% 68 | left_join(IRIS_only) %>% 69 | mutate(SampleID = paste0(SubjectID, "_", Time, "_", Year, "_", IRIS, "_", rownames(.))) 70 | 71 | index.NA <- (!is.na(RNA_annotation_colData$Time) & !is.na(RNA_annotation_colData$Time)) 72 | RNA_sample <- RNA_sample[index.NA,] 73 | RNA <- RNA_df_Data[index.NA,] 74 | rownames(RNA) <- RNA_sample$SampleID 75 | 76 | # NOSE 77 | ########################### 78 | Nasal_sample <- Nasal_annotation_colData %>% 79 | mutate(Year = ifelse(year(Date) < 2000, year(Date) +2000, year(Date))) %>% 80 | left_join(IRIS_only) %>% 81 | mutate(SampleID = paste0(SubjectID, "_", Time, "_", Year, "_", IRIS, "_", rownames(.))) 82 | 83 | NASAL <- Nasal_df_Data 84 | rownames(NASAL) <- Nasal_sample$SampleID 85 | 86 | # PROTEIN 87 | ########################### 88 | PROT_sample <- Proteomics_annotation_colData %>% 89 | mutate(Year = ifelse(year(Date) < 2000, year(Date) +2000, year(Date))) %>% 90 | left_join(IRIS_only) %>% 91 | mutate(SampleID = paste0(SubjectID, "_", Time, "_", Year, "_", IRIS, "_", rownames(.))) 92 | 93 | PROT <- Proteomics_df_Data 94 | rownames(PROT) <- PROT_sample$SampleID 95 | 96 | # METABOLITE 97 | ########################### 98 | METAB_sample <- Metabolomics_annotation_colData %>% 99 | mutate(Year = ifelse(year(Date) < 2000, year(Date) +2000, year(Date))) %>% 100 | left_join(IRIS_only) %>% 101 | mutate(SampleID = paste0(SubjectID, "_", Time, "_", Year, "_", IRIS, "_", rownames(.))) 102 | 103 | METAB <- Metabolomics_df_Data 104 | rownames(METAB) <- METAB_sample$SampleID 105 | 106 | # CYTOKINE 107 | ########################### 108 | CYTO_sample <- Cytokines_annotation_colData %>% 109 | mutate(Year = ifelse(year(Date) < 2000, year(Date) +2000, year(Date))) %>% 110 | left_join(IRIS_only) %>% 111 | mutate(SampleID = paste0(SubjectID, "_", Time, "_", Year, "_", IRIS, "_", rownames(.))) 112 | 113 | CYTO <- Cytokines_df_Data 114 | rownames(CYTO) <- CYTO_sample$SampleID 115 | 116 | ############################ 117 | 118 | # DATA: only RNA/CLINICAL/GUT/METAB 119 | # split by IR/IS 120 | DATA <- list("RNA.IR" = RNA[str_split(rownames(RNA),"_") %>% map_chr(~.x[[4]]) == "IR",], 121 | "GUT.IR" = GUT[str_split(rownames(GUT),"_") %>% map_chr(~.x[[4]]) == "IR",], 122 | 123 | "CLINICAL.IR" = CLINICAL[str_split(rownames(CLINICAL),"_") %>% map_chr(~.x[[4]]) == "IR",], 124 | "RNA.IS" = RNA[str_split(rownames(RNA),"_") %>% map_chr(~.x[[4]]) == "IS",], 125 | 126 | "GUT.IS" = GUT[str_split(rownames(GUT),"_") %>% map_chr(~.x[[4]]) == "IS",], 127 | "CLINICAL.IS" = CLINICAL[str_split(rownames(CLINICAL),"_") %>% map_chr(~.x[[4]]) == "IS",], 128 | 129 | "METAB.IR" = METAB[str_split(rownames(METAB),"_") %>% map_chr(~.x[[4]]) == "IR",], 130 | "METAB.IS" = METAB[str_split(rownames(METAB),"_") %>% map_chr(~.x[[4]]) == "IS",], 131 | 132 | "PROT.IS" = PROT[str_split(rownames(PROT),"_") %>% map_chr(~.x[[4]]) == "IS",], 133 | "PROT.IR" = PROT[str_split(rownames(PROT),"_") %>% map_chr(~.x[[4]]) == "IR",], 134 | 135 | "CYTO.IS" = CYTO[str_split(rownames(CYTO),"_") %>% map_chr(~.x[[4]]) == "IS",], 136 | "CYTO.IR" = CYTO[str_split(rownames(CYTO),"_") %>% map_chr(~.x[[4]]) == "IR",] 137 | ) 138 | 139 | COMBINED <- list("RNA" = RNA, CLINICAL = CLINICAL, GUT = GUT, METAB = METAB, PROT = PROT, CYTO = CYTO) 140 | save(DATA, COMBINED, file = "/home/antoine/Documents/timeomics_analysis/HMP_seasoning/netomics/RAW_DATA.RDA") 141 | ############################################################ 142 | 143 | stat_raw_data <- lapply(list(RNA=RNA, GUT=GUT, METAB=METAB, CLINICAL=CLINICAL, PROT = PROT, CYTO = CYTO), dim) %>% 144 | as.data.frame() %>% t %>% as.data.frame() %>% 145 | setNames(c("sample", "feature")) 146 | lapply(list(RNA=RNA, GUT=GUT, METAB=METAB, CLINICAL=CLINICAL, PROT = PROT, CYTO = CYTO), function(x){ 147 | rownames(x) %>% str_remove("_.*") %>% unique %>% length()}) %>% 148 | as.data.frame() %>% t %>% as.data.frame() %>% setNames("uniqueID") %>% 149 | rownames_to_column("omic") %>% 150 | left_join(stat_raw_data %>% rownames_to_column("omic")) %>% column_to_rownames("omic") %>% t %>% 151 | as.data.frame() %>% knitr::kable() 152 | 153 | # 2. DATA FILTERING 154 | 155 | # 1. coef. of var 156 | cv.data <- lapply(DATA, function(X){ 157 | unlist(lapply(as.data.frame(X), 158 | function(x) abs(sd(x, na.rm = TRUE)/mean(x, na.rm= TRUE)))) 159 | }) 160 | 161 | fc.data <- list("RNA.IR"= 1.5, "RNA.IS"=1.5, 162 | "CLINICAL.IR"=0, "CLINICAL.IS"=0, 163 | "GUT.IR"=1.5, "GUT.IS"=1.5, 164 | "METAB.IR"=1.5 , "METAB.IS"=1.5, 165 | "PROT.IR"=1.5 , "PROT.IS"=1.5, 166 | "CYTO.IR" = 1.5, "CYTO.IS"=1.5) 167 | 168 | par(mfrow = c(6,2)) 169 | #for(i in c("RNA.IR","CLINICAL.IR", "GUT.IR", "METAB.IR", "RNA.IS","CLINICAL.IS", "GUT.IS", "METAB.IS", "PROT.IR", "PROT.IS", "CYTO.IR", "CYTO.IS")){ 170 | for(i in c("RNA.IR","RNA.IS", "CLINICAL.IR", "CLINICAL.IS", "GUT.IR","GUT.IS", "METAB.IS", "METAB.IR", "PROT.IR", "PROT.IS", "CYTO.IR", "CYTO.IS")){ 171 | 172 | hist(cv.data[[i]], breaks = 20, main =i) 173 | abline(v = fc.data[[i]], col = "red") 174 | legend("topright", legend = paste0("FC = ",fc.data[[i]]), col = "red", lty = 1) 175 | } 176 | par(mfrow = c(1,1)) 177 | 178 | 179 | # 2. Remove low cv features 180 | remove.low.cv <- function(X, cutoff = 0.5){ 181 | # var.coef 182 | cv <- unlist(lapply(as.data.frame(X), 183 | function(x) abs(sd(x, na.rm = TRUE)/mean(x, na.rm= TRUE)))) 184 | return(X[,cv > cutoff]) 185 | } 186 | 187 | DATA.filtered <- list("RNA.IR" = remove.low.cv(DATA$RNA.IR, 1.5), 188 | "RNA.IS" = remove.low.cv(DATA$RNA.IS, 1.5), 189 | "GUT.IR" = remove.low.cv(DATA$GUT.IR, 1.5), 190 | "GUT.IS" = remove.low.cv(DATA$GUT.IS, 1.5), 191 | # "CLINICAL.IR" = remove.low.cv(DATA$CLINICAL.IR, 0), 192 | # "CLINICAL.IS" = remove.low.cv(DATA$CLINICAL.IS, 0), 193 | "CLINICAL.IR" = DATA$CLINICAL.IR, 194 | "CLINICAL.IS" = DATA$CLINICAL.IS, 195 | 196 | "METAB.IR" = remove.low.cv(DATA$METAB.IR, 1.5), 197 | "METAB.IS" = remove.low.cv(DATA$METAB.IS, 1.5), 198 | "PROT.IS" = remove.low.cv(DATA$PROT.IS, 1.5), 199 | "PROT.IR" = remove.low.cv(DATA$PROT.IR, 1.5), 200 | "CYTO.IS" = remove.low.cv(DATA$CYTO.IS, 1), 201 | "CYTO.IR" = remove.low.cv(DATA$CYTO.IR, 1)) 202 | lapply(DATA.filtered, dim) 203 | 204 | # 3. scale filtered value (log, scale, CLR) 205 | 206 | # scale for OTU 207 | norm_OTU <- function(DF, AR = F){ 208 | DF <- DF + 0.0001 209 | 210 | data.TSS.clr = mixOmics::logratio.transfo(DF, logratio = 'CLR') 211 | 212 | # reconstrcuct dataframe 213 | data.good <- as.data.frame(matrix(ncol = ncol(data.TSS.clr), 214 | nrow = nrow( data.TSS.clr))) 215 | rownames(data.good) <- rownames(data.TSS.clr) 216 | colnames(data.good) <- colnames(data.TSS.clr) 217 | for( i in c(1:nrow(data.TSS.clr))){ 218 | for( j in c(1:ncol(data.TSS.clr))){ 219 | data.good[i,j] <- data.TSS.clr[i,j] 220 | } 221 | } 222 | return(data.good) 223 | } 224 | 225 | 226 | DATA.filtered.scale <- list( 227 | "RNA.IR" = log(DATA.filtered$RNA.IR + 1) %>% scale, 228 | "RNA.IS" = log(DATA.filtered$RNA.IS + 1) %>% scale, 229 | 230 | "CLINICAL.IR" = log(DATA.filtered$CLINICAL.IR +1)%>% scale, 231 | "CLINICAL.IS" = log(DATA.filtered$CLINICAL.IS +1)%>% scale, 232 | 233 | "GUT.IR" = norm_OTU(DATA.filtered$GUT.IR), 234 | "GUT.IS" = norm_OTU(DATA.filtered$GUT.IS), 235 | 236 | "METAB.IR" = log(DATA.filtered$METAB.IR +1)%>% scale, 237 | "METAB.IS" = log(DATA.filtered$METAB.IS +1)%>% scale, 238 | 239 | # "PROT.IR" = log(DATA.filtered$PROT.IR +1)%>% scale, 240 | # "PROT.IS" = log(DATA.filtered$PROT.IS +1)%>% scale 241 | 242 | "PROT.IR" = DATA.filtered$PROT.IR, # already scale 243 | "PROT.IS" = DATA.filtered$PROT.IS, 244 | 245 | "CYTO.IR" = log(DATA.filtered$CYTO.IR +1), 246 | "CYTO.IS" = log(DATA.filtered$CYTO.IS +1) 247 | 248 | ) 249 | 250 | lapply(DATA.filtered, dim) %>% 251 | as.data.frame() %>% t %>% as.data.frame() %>% 252 | setNames(c("sample", "feature")) %>% 253 | rownames_to_column("OMIC") %>% 254 | mutate(IRIS = str_extract(OMIC,"..$"), OMIC = str_remove(OMIC, "...$")) %>% 255 | gather(meta, value, -c(OMIC, IRIS)) %>% 256 | spread(OMIC, value) %>% arrange(IRIS) %>% 257 | dplyr::select(IRIS, meta, RNA, GUT, METAB, CLINICAL, PROT, CYTO) 258 | 259 | save(DATA.filtered.scale, DATA.filtered, file = "/home/antoine/Documents/timeomics_analysis/HMP_seasoning/netomics/DATA_FILTERED.RDA") 260 | ############################################################ 261 | 262 | fc.data.combined <- list("RNA"= 1.5, 263 | "CLINICAL"=0.2, 264 | "GUT"=1.5, 265 | "METAB"=1.5, 266 | "PROT" = 1.5, 267 | "CYTO" = 1) 268 | cv.data.combined <- lapply(COMBINED, function(X){ 269 | unlist(lapply(as.data.frame(X), 270 | function(x) abs(sd(x, na.rm = TRUE)/mean(x, na.rm= TRUE)))) 271 | }) 272 | fc.color <- list("RNA"= color.mixo(4), 273 | "CLINICAL"=color.mixo(1), 274 | "GUT"=color.mixo(2), 275 | "METAB"=color.mixo(3), 276 | "PROT"=color.mixo(5), 277 | "CYTO" = color.mixo(6)) 278 | 279 | par(mfrow = c(3,2)) 280 | for(i in c("RNA","CLINICAL", "GUT", "METAB", "PROT", "CYTO")){ 281 | hist(cv.data.combined[[i]], breaks = 20, main =i, xlab = paste0("Var. Coef. (", i, ")"), 282 | col = fc.color[[i]]) 283 | abline(v = fc.data.combined[[i]], col = "red") 284 | legend("topright", legend = paste0("CV = ",fc.data.combined[[i]]), col = "red", lty = 1) 285 | } 286 | par(mfrow = c(1,1)) 287 | 288 | # 3. MODELLING 289 | 290 | lmms.func <- function(X, mode = "p-spline"){ 291 | time <- rownames(X) %>% str_split("_") %>% map_chr(~.x[[2]]) %>% as.numeric() 292 | lmms.output <- lmms::lmmSpline(data = X, time = time, 293 | sampleID = rownames(X), deri = FALSE, 294 | basis = mode, numCores = 4, 295 | keepModels = TRUE) 296 | return(lmms.output) 297 | } 298 | 299 | # only one ID/Year 300 | ID_u <- "ZLZNCLZ" 301 | Year_u <- 2015 302 | 303 | # ID_u <- "ZOZOW1T" 304 | # Year_u <- 2015 305 | 306 | 307 | tmp <- imap_dfr(DATA.filtered.scale, ~{ 308 | .x %>% as.data.frame() %>% rownames_to_column("sample") %>% 309 | gather(feature, value, -sample) %>% 310 | mutate(ID = str_split(sample, "_") %>% map_chr(~.x[[1]])) %>% 311 | mutate(year = str_split(sample, "_") %>% map_chr(~.x[[3]])) %>% 312 | mutate(OMIC = str_remove(.y, "...$")) %>% 313 | mutate(IRIS = str_extract(.y, "..$")) 314 | }) 315 | tmp %>% dplyr::select(-feature, -value) %>% unique() %>% na.omit %>% 316 | group_by(ID, year, OMIC, IRIS) %>% summarise(N = n()) %>% spread(OMIC, N) %>% 317 | na.omit() %>% split(.$year) 318 | tmp %>% dplyr::select(-feature, -value) %>% unique() %>% na.omit %>% 319 | group_by(ID, year, OMIC, IRIS) %>% summarise(N = n()) %>% spread(OMIC, N) %>% 320 | filter(ID == ID_u) %>% dplyr::select(-IRIS) %>% na.omit 321 | 322 | # just a filter to get only the selected ID/Year 323 | DATA.GOOD <- imap_dfr(DATA.filtered.scale, ~{ 324 | .x %>% as.data.frame() %>% rownames_to_column("sample") %>% 325 | gather(feature, value, -sample) %>% 326 | mutate(ID = str_split(sample, "_") %>% map_chr(~.x[[1]])) %>% 327 | mutate(year = str_split(sample, "_") %>% map_chr(~.x[[3]])) %>% 328 | mutate(OMIC = str_remove(.y, "...$")) %>% 329 | dplyr::filter(ID == ID_u) %>% 330 | dplyr::filter(year == Year_u) 331 | }) %>% split(.$OMIC) %>% 332 | purrr::map(~{ 333 | .x %>% 334 | dplyr::select(sample, feature, value) %>% 335 | spread(feature, value) %>% 336 | column_to_rownames("sample") 337 | }) 338 | 339 | 340 | # only 1 year 341 | MODELLED <- lapply(DATA.GOOD, function(x) lmms.func(x)) 342 | 343 | MODELLED %>% lapply(function(x)x@predSpline %>% dim) %>% 344 | as.data.frame() %>% t %>% as.data.frame() %>% 345 | setNames(c("sample", "feature")) %>% t %>%as.data.frame() %>% 346 | dplyr::select(RNA, GUT, METAB, CLINICAL, PROT) 347 | 348 | MODELLED %>% imap_dfr(~.x@modelsUsed %>% table %>% as.data.frame %>% 349 | column_to_rownames(".") %>% t %>% as.data.frame %>% 350 | mutate(omic = .y)) %>% remove_rownames() %>% 351 | column_to_rownames('omic') %>% t %>% 352 | as.data.frame() %>% dplyr::select(RNA, GUT, METAB, CLINICAL, PROT) 353 | 354 | # 4. STRAIGHT LINE FILTERING 355 | 356 | filterlmms.func <- function(modelled.data, lmms.output){ 357 | time = modelled.data %>% rownames() %>% str_split("_") %>% map_chr(~.x[[2]]) %>% as.numeric() 358 | #time = rownames(modelled.data) %>% as.numeric() 359 | filter.res <- lmms.filter.lines(data = modelled.data, 360 | lmms.obj = lmms.output, time = time, 361 | homoskedasticity.cutoff=0.05)$filtered 362 | } 363 | 364 | FILTER <- lapply(names(DATA.GOOD), function(x) filterlmms.func(modelled.data = DATA.GOOD[[x]], lmms.output = MODELLED[[x]])) 365 | names(FILTER) <- names(MODELLED) 366 | 367 | FILTER %>% lapply(dim) %>% 368 | as.data.frame() %>% t %>% as.data.frame() %>% 369 | setNames(c("sample", "feature")) %>% 370 | t %>%as.data.frame() %>% 371 | dplyr::select(RNA, GUT, METAB, CLINICAL) 372 | 373 | FINAL.FILTER <- FILTER[c("CLINICAL", "GUT", "METAB", "RNA", "PROT")] 374 | rownames(FINAL.FILTER[["GUT"]]) <- rownames(FINAL.FILTER[["RNA"]]) # change 86 par 85 375 | 376 | DATA.LMMS <- lapply(MODELLED, function(x)x@predSpline %>% t %>% as.data.frame) 377 | rownames(DATA.LMMS[["GUT"]]) <- rownames(DATA.LMMS[["RNA"]]) # change 86 par 85 378 | 379 | save(FINAL.FILTER, MODELLED, DATA.GOOD, DATA.LMMS, file = "/home/antoine/Documents/timeomics_analysis/HMP_seasoning/netomics/LMMS.RDA") 380 | 381 | lapply(DATA.LMMS, dim) 382 | # 5. MULTI-OMICS CLUSTERING 383 | 384 | block.res <- block.pls(DATA.LMMS, indY = 1, ncomp = 5) 385 | getNcomp.res <- getNcomp(block.res, X = DATA.LMMS, indY = 1) 386 | 387 | # block.res <- block.pls(FINAL.FILTER, indY = 1, ncomp = 3) 388 | # getNcomp.res <- getNcomp(block.res, X = FINAL.FILTER, indY = 1) 389 | 390 | plot(getNcomp.res) 391 | 392 | # ncomp = 2 393 | block.res <- block.pls(DATA.LMMS, indY = 1, ncomp = 1, scale =FALSE) 394 | 395 | # block.res <- block.pls(FINAL.FILTER, indY = 1, ncomp = 1, scale =FALSE) 396 | 397 | plotLong(object = block.res, title = "Block-PLS Clusters, scale = TRUE", legend = TRUE) 398 | 399 | getCluster(block.res) %>% group_by(block, cluster) %>% summarise(N = n()) %>% 400 | spread(block, N) %>% 401 | dplyr::select(cluster, RNA, GUT, METAB, CLINICAL) 402 | 403 | save(block.res, file = "/home/antoine/Documents/timeomics_analysis/HMP_seasoning/netomics/timeomics_res_block.rda") 404 | 405 | 406 | # elagage 407 | test.list.keepX <- list( 408 | "CLINICAL" = seq(2,8,by=1), 409 | "GUT" = seq(2,10,by=1), 410 | "METAB" = seq(2,9,by=1), 411 | "RNA" = seq(10,50,by=2) 412 | ) 413 | 414 | tune.block.res <- tuneCluster.block.spls(X= FINAL.FILTER, indY = 1, 415 | test.list.keepX=test.list.keepX, 416 | scale=FALSE, 417 | mode = "canonical", ncomp = 1) 418 | tune.block.res$choice.keepX 419 | final.block <- block.spls(FINAL.FILTER, indY = 1, ncomp = 1, scale =FALSE, 420 | keepX = tune.block.res$choice.keepX) 421 | plotLong(final.block, legend = TRUE) 422 | 423 | getCluster(final.block) %>% group_by(block, cluster) %>% summarise(N = n()) %>% 424 | spread(block, N) %>% 425 | dplyr::select(cluster, RNA, GUT, METAB, CLINICAL) 426 | 427 | library("openxlsx") 428 | cluster_comp <- getCluster(final.block) %>% dplyr::select(molecule, block, cluster, comp, contribution) %>% 429 | mutate(cluster = ifelse(cluster == -1, "Cluster 1", "Cluster 2")) %>% 430 | split(.$cluster) 431 | write.xlsx(cluster_comp, file = "cluster_composition.xlsx") 432 | 433 | 434 | # final data for netOmics package // shrink 435 | # DATA.GOOD -> ! individual, 7 timepoints but no modelisation 436 | # DATA RAW -> filter based on DATA.GOOD molecules (for OTU -> sparcc needs RAW) 437 | # DATA$RNA.IS %>% rownames() %>% str_remove("_.*") %>% str_detect("ZLZNCLZ") %>% any() 438 | # [1] TRUE 439 | 440 | hmp_T2D <- list() 441 | hmp_T2D$raw <- list() 442 | hmp_T2D$data <- list() 443 | for(i in names(DATA.GOOD)){ 444 | # hmp_diabetes$raw[[i]] <- DATA[[paste0(i, ".IS")]][str_detect(rownames(DATA[[paste0(i, ".IS")]]), "ZLZNCLZ"), colnames(DATA.GOOD[[i]])] 445 | hmp_T2D$raw[[i]] <- DATA[[paste0(i, ".IS")]][rownames(DATA.GOOD[[i]]), colnames(DATA.GOOD[[i]])] 446 | rownames(hmp_T2D$raw[[i]]) <- rownames(DATA.GOOD$RNA) 447 | hmp_T2D$raw[[i]] <- hmp_T2D$raw[[i]] %>% rownames_to_column("Rownames") %>% 448 | mutate(Rownames = Rownames %>% str_split("_") %>% map_chr(~.x[[2]]) %>% as.numeric()) %>% 449 | arrange(Rownames) %>% column_to_rownames(var = "Rownames") 450 | 451 | #data 452 | hmp_T2D$data[[i]] <- DATA.GOOD[[i]] 453 | rownames(hmp_T2D$data[[i]]) <- rownames(hmp_T2D$raw[[i]]) 454 | } 455 | 456 | hmp_T2D$data <- DATA.GOOD 457 | lmms.func <- function(X){ 458 | # time <- rownames(X) %>% str_split("_") %>% map_chr(~.x[[2]]) %>% as.numeric() 459 | time <- rownames(X) %>% as.numeric() 460 | lmms.output <- lmms::lmmSpline(data = X, time = time, 461 | sampleID = rownames(X), deri = FALSE, 462 | basis = "p-spline", numCores = 4, 463 | keepModels = TRUE) 464 | return(lmms.output) 465 | } 466 | 467 | MODELLED <- lapply(hmp_T2D$data, function(x) lmms.func(x)) 468 | 469 | MODELLED %>% imap_dfr(~.x@modelsUsed %>% table %>% as.data.frame %>% 470 | column_to_rownames(".") %>% t %>% as.data.frame %>% 471 | mutate(omic = .y)) %>% remove_rownames() %>% 472 | column_to_rownames('omic') %>% t %>% 473 | as.data.frame() 474 | 475 | data.MODELLED <- lapply(MODELLED, function(x) x@predSpline %>% t) 476 | rownames(data.MODELLED$GUT) <- rownames(data.MODELLED$RNA) 477 | 478 | 479 | # .$timeOmics 480 | # block.res.no.model <- block.pls(hmp_T2D$data, indY = 1, ncomp = 5, scale =FALSE) 481 | # getNcomp.res <- getNcomp(block.res.no.model, X = hmp_T2D$data, indY = 1) 482 | # plot(getNcomp.res) 483 | block.res.no.model <- block.pls(hmp_T2D$data, indY = 1, ncomp = 1, scale =TRUE) 484 | hmp_T2D$getCluster.res <- getCluster(block.res.no.model) 485 | 486 | block.res.w.model <- block.pls(data.MODELLED, indY = 1, ncomp = 5, scale =TRUE) 487 | getNcomp.res <- getNcomp(block.res.w.model, X = data.MODELLED, indY = 1) 488 | block.res.w.model <- block.pls(data.MODELLED, indY = 1, ncomp = 1, scale =TRUE) 489 | 490 | hmp_T2D$getCluster.res <- getCluster(block.res.w.model) 491 | 492 | # .$sparse 493 | test.list.keepX <- list( 494 | "CLINICAL" = seq(2,39,by=2), 495 | "CYTO" = seq(2,10,b=2), 496 | "GUT" = seq(2,50,by=2), 497 | "METAB" = seq(2,50,by=2), 498 | "PROT" = seq(2,30,b=2), 499 | "RNA" = seq(10,100,by=3)) 500 | 501 | # tune.block.res <- tuneCluster.block.spls(X= hmp_T2D$data, indY = 1, 502 | # test.list.keepX=test.list.keepX, 503 | # scale=FALSE, 504 | # mode = "canonical", ncomp = 1) 505 | # too long 506 | 507 | list.keepX <- list( 508 | "CLINICAL" = 4, 509 | "CYTO" = 3, 510 | "GUT" = 10, 511 | "METAB" = 3, 512 | "PROT" = 2, 513 | "RNA" = 34) 514 | 515 | sparse.block.res.w.model <- block.spls(data.MODELLED, indY = 1, ncomp = 1, scale =TRUE, keepX = list.keepX) 516 | plotLong(sparse.block.res.w.model, scale = TRUE, legend = TRUE) 517 | 518 | 519 | hmp_T2D$getCluster.sparse.res <- getCluster(sparse.block.res.w.model) 520 | timeOmics::getSilhouette(sparse.block.res.w.model) 521 | timeOmics::getSilhouette(block.res.w.model) 522 | 523 | ## Biogrid ## DATABASES 524 | biogrid <- read_tsv("/home/antoine/Documents/TO2/netOmics-case-studies/HeLa_Cell_Cycling/data/BIOGRID-ALL-3.5.187.tab3.txt") 525 | biogrid.filtered <- biogrid %>% dplyr::select("Official Symbol Interactor A", "Official Symbol Interactor B") %>% unique %>% 526 | set_names(c("from", "to")) 527 | 528 | biogrid.filtered.tmp <- biogrid.filtered %>% filter(from %in% cluster.info$molecule | to %in% cluster.info$molecule) 529 | 530 | hmp_T2D$interaction.biogrid <- biogrid.filtered.tmp 531 | 532 | TFome <- readRDS( "~/Documents/TO2/TFome.Rds") 533 | tf.1 <- TFome %>% filter(TF %in% hmp_T2D$getCluster.res$molecule | Target %in% hmp_T2D$getCluster.res$molecule) %>% 534 | unlist() %>% unique 535 | hmp_T2D$interaction.TF <- TFome %>% filter(TF %in% tf.1 | Target %in% tf.1) 536 | 537 | hmp_T2D$interaction.TF <- TFome.igraph 538 | 539 | hmp_T2D$interaction.TF <- TF.interact 540 | usethis::use_data(hmp_T2D, overwrite = TRUE) 541 | 542 | 543 | medlineranker.res <- read_tsv("/home/antoine/Documents/timeomics_analysis/HMP_seasoning/netomics/res_medlineranker_all.csv") 544 | tmp <- dplyr::select(medlineranker.res, c("Disease", 'Gene symbols')) %>% set_names(c("Disease", "symbol")) 545 | # separate_rows(tmp, Disease, symbol, sep = "|", convert = TRUE) 546 | 547 | library(splitstackshape) 548 | tmp[c(1,2),] %>% separate_rows(Disease, symbol) 549 | tmp[c(2,3),] %>% 550 | rownames_to_column("id") %>% 551 | cSplit(., sep = "|", splitCols = 2:ncol(.), direction = "long", makeEqual = T) %>% 552 | as_tibble() %>% 553 | group_by(id) %>% 554 | fill(2:ncol(.)) %>% 555 | unique() %>% 556 | ungroup(id) %>% 557 | select(-id) 558 | 559 | medlineranker.res.df <- tmp %>% rownames_to_column("id") %>% 560 | cSplit(., sep = "|", splitCols = 3:ncol(.), direction = "long", makeEqual = T) %>% 561 | as_tibble() %>% group_by(id) %>% fill(2:ncol(.)) %>% unique() %>% ungroup(id) %>% select(-id) 562 | 563 | medlineranker.res.df <- left_join(medlineranker.res.df, medlineranker.res) %>% mutate(symbol = as.character(symbol)) 564 | hmp_T2D$medlineranker.res.df <- medlineranker.res.df 565 | usethis::use_data(hmp_T2D, overwrite = TRUE) -------------------------------------------------------------------------------- /data/hmp_T2D.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/abodein/netOmics/c2b1e80dda2685d8309229307fc54273493f64d0/data/hmp_T2D.rda -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite netOmics in publications, please use:") 2 | 3 | citEntry(entry="article", 4 | title={"Interpretation of network-based integration from multi-omics longitudinal data"}, 5 | author={"Bodein, Antoine and Scott-Boyer, Marie-Pier and Perin, Olivier and Le Cao, Kim-Anh and Droit, Arnaud"}, 6 | journal={"bioRxiv"}, 7 | year={"2020"}, 8 | publisher={"Cold Spring Harbor Laboratory"}, 9 | textVersion={"Bodein, A., Scott-Boyer, M. P., Perin, O., Le Cao, K. A., & Droit, A. (2020). Interpretation of network-based integration from multi-omics longitudinal data. bioRxiv."} 10 | ) 11 | -------------------------------------------------------------------------------- /man/combine_layers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/combine_layers.R 3 | \name{combine_layers} 4 | \alias{combine_layers} 5 | \title{Combine layers} 6 | \usage{ 7 | combine_layers(graph1, graph2 = NULL, interaction.df = NULL) 8 | } 9 | \arguments{ 10 | \item{graph1}{an igraph object or list of igraph (\code{list.igraph}).} 11 | 12 | \item{graph2}{an igraph object or list of igraph (\code{list.igraph}) with 13 | the same length as \code{graph1}.} 14 | 15 | \item{interaction.df}{(optional) a 2 colomns data.frame (from, to) 16 | describing the edges between vertices from both graphs.} 17 | } 18 | \value{ 19 | a merged graph with both vertex attributes from graph1 and graph2. 20 | } 21 | \description{ 22 | Return a merged graph from two graph layers. 23 | } 24 | \details{ 25 | If \code{graph2} is a single graph, it will be merged to each element of 26 | \code{graph1} (\code{igraph} or \code{list.igraph}). 27 | 28 | If \code{graph2} is a list of graph (\code{list.igraph}), each element of 29 | \code{graph1} and each element of \code{graph2} are merged in pairs. 30 | 31 | Optionally, \code{interaction.df} should be provide if any vertex are shared 32 | between graphs. It can also be used to extend the first graph. 33 | 34 | In both scenarios, vertex attributes are kept. If a vertex attribute is 35 | missing from graph1 or graph2, NULL value is added. 36 | Otherwise, if there is an overlap between attribute values for the same 37 | vertex, attribute from graph2 is dropped. 38 | } 39 | \examples{ 40 | # with single graphs 41 | graph1 <- igraph::graph_from_data_frame(list(from = c('A', 'B'), 42 | to = c('B', 'C')), 43 | directed = FALSE) 44 | graph2 <- igraph::graph_from_data_frame(list(from = c(1), 45 | to = c(2)), 46 | directed = FALSE) 47 | res <- combine_layers(graph1 = graph1, 48 | graph2 = graph2) 49 | 50 | # with list of graphs 51 | graph1.list <- list(graph1, graph1) 52 | graph2.list <- list(graph2, graph2) 53 | class(graph1.list) <- class(graph2.list) <- 'list.igraph' 54 | 55 | res <- combine_layers(graph1 = graph1.list, 56 | graph2 = graph2) 57 | res <- combine_layers(graph1 = graph1.list, 58 | graph2 = graph2.list) 59 | 60 | # with interaction dataframe 61 | interaction.df1 <- as.data.frame(list(from = c('C', 'B'), to = c(1, 2))) 62 | res <- combine_layers(graph1 = graph1.list, 63 | graph2 = graph2, 64 | interaction.df = interaction.df1) 65 | 66 | 67 | } 68 | -------------------------------------------------------------------------------- /man/get_ORA.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/enrichment_functions.R 3 | \name{get_ORA} 4 | \alias{get_ORA} 5 | \title{ORA enrichment analysis} 6 | \usage{ 7 | get_ORA(query, sources = NULL, organism = "hsapiens") 8 | } 9 | \arguments{ 10 | \item{query}{a vector of character, a lit of ID} 11 | 12 | \item{sources}{a character or list of character} 13 | 14 | \item{organism}{a character (default = 'hsapiens')} 15 | } 16 | \value{ 17 | a data.frame containing the enrichment result 18 | } 19 | \description{ 20 | Returns results of an ORA analysis 21 | } 22 | \seealso{ 23 | \code{\link[gprofiler2]{gost}} 24 | } 25 | -------------------------------------------------------------------------------- /man/get_go_info.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/enrichment_functions.R 3 | \name{get_go_info} 4 | \alias{get_go_info} 5 | \title{Get GO info} 6 | \usage{ 7 | get_go_info(go) 8 | } 9 | \arguments{ 10 | \item{go}{a character, GO term} 11 | } 12 | \value{ 13 | a data.frame with the following columns: 'GOID', 'DEFINITION', 14 | 'ONTOLOGY', 'TERM' 15 | } 16 | \description{ 17 | From a GO terms (GOID), return definition, ontology and term values 18 | from GO.db 19 | } 20 | -------------------------------------------------------------------------------- /man/get_graph_stats.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_graph_stats.R 3 | \name{get_graph_stats} 4 | \alias{get_graph_stats} 5 | \title{Get graph statistics} 6 | \usage{ 7 | get_graph_stats(X) 8 | } 9 | \arguments{ 10 | \item{X}{an 'igraph' or 'list.igraph' object} 11 | } 12 | \value{ 13 | It returns a long data.frame with number of nodes/edges, 14 | and the count of the different attributes 15 | (if X is a list of graph, each row describes a graph) 16 | } 17 | \description{ 18 | For a given igraph or list of igraph objects, this function summarize 19 | the number of vertices/edges and other vertex attributes. 20 | } 21 | \examples{ 22 | graph1 <- igraph::graph_from_data_frame( 23 | list(from = c('A', 'B', 'A', 'D', 'C', 'A', 'C'), 24 | to = c('B', 'C', 'D', 'E', 'D', 'F', 'G')), 25 | directed = FALSE) 26 | graph1 <- igraph::set_vertex_attr(graph = graph1, 27 | name = 'type', 28 | index = c('A','B','C'), 29 | value = '1') 30 | graph1 <- igraph::set_vertex_attr(graph = graph1, 31 | name = 'type', 32 | index = c('D','E'), 33 | value = '2') 34 | graph1 <- igraph::set_vertex_attr(graph = graph1, 35 | name = 'type', 36 | index = c('F', 'G'), 37 | value = '-1') 38 | 39 | get_graph_stats(graph1) 40 | 41 | graph1.list <- list(graph1 = graph1, 42 | graph2 = graph1) 43 | get_graph_stats(graph1.list) 44 | 45 | } 46 | -------------------------------------------------------------------------------- /man/get_grn.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_grn.R 3 | \name{get_grn} 4 | \alias{get_grn} 5 | \title{Gene Regulatory Network} 6 | \usage{ 7 | get_grn(X, cluster = NULL, method = c("aracne"), type = "gene") 8 | } 9 | \arguments{ 10 | \item{X}{a \code{data.frame}/\code{matrix} with gene expression 11 | (genes in columns, samples in rows).} 12 | 13 | \item{cluster}{(optional) clustering result from 14 | \code{\link[timeOmics]{getCluster}}} 15 | 16 | \item{method}{network building method, one of c('aracne')} 17 | 18 | \item{type}{character added to node metadata} 19 | } 20 | \value{ 21 | An igraph object if no cluster informations are given. 22 | Otherwise, it returns a list of igraph object (\code{list.igraph}) with 23 | a subgraph for each cluster and a global graph with all the genes. 24 | } 25 | \description{ 26 | Get Gene Regulatory Network (GRN) from a data.frame. 27 | Optionally, if the gene are clustered, sub_network are build for 28 | each cluster. 29 | } 30 | \details{ 31 | Methods of GRN reconstruction are as follows: 32 | 'aracne': use ARACNe algorithm on Mutual Information (MI) adjency matrix 33 | to remove low MI edges in triangles. 34 | } 35 | \examples{ 36 | data(hmp_T2D) 37 | # grn only on gene 38 | cluster.mRNA <- timeOmics::getCluster(hmp_T2D$getCluster.res, 39 | user.block = 'RNA') 40 | X <- hmp_T2D$raw$RNA 41 | grn.res <- get_grn(X = hmp_T2D$raw$RNA, 42 | cluster = cluster.mRNA, 43 | method = 'aracne') 44 | 45 | 46 | } 47 | \seealso{ 48 | \code{\link[minet]{build.mim}}, 49 | \code{\link[minet]{aracne}}, 50 | \code{\link[timeOmics]{getCluster}} 51 | } 52 | -------------------------------------------------------------------------------- /man/get_interaction_from_ORA.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/enrichment_functions.R 3 | \name{get_interaction_from_ORA} 4 | \alias{get_interaction_from_ORA} 5 | \title{Get interaction from ORA enrichment analysis} 6 | \usage{ 7 | get_interaction_from_ORA( 8 | query, 9 | sources = "GO", 10 | organism = "hsapiens", 11 | signif.value = TRUE 12 | ) 13 | } 14 | \arguments{ 15 | \item{query}{a vector (or a list) of character with the ID to perform 16 | the ORA analysis} 17 | 18 | \item{sources}{(optional) a character in 19 | (GO, KEGG, REAC, TF, MIRNA, CORUM, HP, HPA, WP)} 20 | 21 | \item{organism}{(optional) a character (default = 'hsapiens')} 22 | 23 | \item{signif.value}{(optional) a logical, default = ''} 24 | } 25 | \value{ 26 | a graph object (or list of graph) containing the interaction between 27 | the query and the target terms. 28 | } 29 | \description{ 30 | Returns results of an ORA analysis as an interaction graph 31 | } 32 | \examples{ 33 | query <- c('IL15', 'CDHR5', 'TGFA', 'C4B') 34 | get_interaction_from_ORA(query, 35 | sources = 'GO') 36 | 37 | query <- list('All' = c('IL15', 'CDHR5', 'TGFA', 'C4B'), 38 | 'c1' = c('IL15', 'CDHR5', 'TGFA')) 39 | get_interaction_from_ORA(query, 40 | sources = 'GO') 41 | 42 | } 43 | \seealso{ 44 | \code{\link[gprofiler2]{gost}} \code{\link[gprofiler2]{gconvert}} 45 | } 46 | -------------------------------------------------------------------------------- /man/get_interaction_from_correlation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/merge_layers_by_correlation.R 3 | \name{get_interaction_from_correlation} 4 | \alias{get_interaction_from_correlation} 5 | \title{Interaction_from_correlation} 6 | \usage{ 7 | get_interaction_from_correlation(X, Y, threshold = 0.5) 8 | } 9 | \arguments{ 10 | \item{X}{a data.frame or list of data.frame (with a similar number of row).} 11 | 12 | \item{Y}{a data.frame or list of data.frame (with a similar number of row).} 13 | 14 | \item{threshold}{a threshold to cut the correlation matrix above which a link 15 | is created between a feature from X and a feature from Y.} 16 | } 17 | \value{ 18 | an 'igraph' object 19 | } 20 | \description{ 21 | Compute correlation between two dataframe X and Y (or list of data.frame). 22 | An incidence graph is returned. A link between two features is produced 23 | if their correlation (absolute value) is above the threshold. 24 | } 25 | \examples{ 26 | X <- matrix(rexp(200, rate=.1), ncol=20) 27 | Y <- matrix(rexp(200, rate=.1), ncol=20) 28 | get_interaction_from_correlation(X,Y) 29 | 30 | X <- list(matrix(rexp(200, rate=.1), ncol=20), 31 | matrix(rexp(200, rate=.1), ncol=20)) 32 | Y <- matrix(rexp(200, rate=.1), ncol=20) 33 | get_interaction_from_correlation(X,Y) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/get_interaction_from_database.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_interaction_from_database.R 3 | \name{get_interaction_from_database} 4 | \alias{get_interaction_from_database} 5 | \title{Get interaction from database} 6 | \usage{ 7 | get_interaction_from_database(X, db = NULL, type = "db", user.ego = FALSE) 8 | } 9 | \arguments{ 10 | \item{X}{vector of nodes or list of vectors} 11 | 12 | \item{db}{data.frame (with two columns: from, to) or igraph} 13 | 14 | \item{type}{character added to node metadata} 15 | 16 | \item{user.ego}{logical, if user.ego == TRUE looks for first degree neighbors 17 | in db and add 'mode' metadata ('core'/'extended')} 18 | } 19 | \value{ 20 | a subset graph of db from X list of nodes 21 | } 22 | \description{ 23 | Returns an interaction graph from a vector of nodes (or a list of vectors) 24 | and an interaction database (data.frame or igraph) 25 | } 26 | \examples{ 27 | X <- letters[1:4] 28 | db <- as.data.frame(list(from = sample(letters[1:10], replace = TRUE), 29 | to = sample(letters[1:10], replace = TRUE))) 30 | 31 | sub <- get_interaction_from_database(X, 32 | db) 33 | 34 | db.graph <- igraph::graph_from_data_frame(db, 35 | directed=FALSE) 36 | sub <- get_interaction_from_database(X, 37 | db) 38 | 39 | } 40 | -------------------------------------------------------------------------------- /man/hmp_T2D.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/hmp_T2D.R 3 | \docType{data} 4 | \name{hmp_T2D} 5 | \alias{hmp_T2D} 6 | \title{hmp_T2D} 7 | \format{ 8 | a list of data.frame 9 | \describe{ 10 | \item{raw}{data.frame, raw data} 11 | \item{modelled}{data.frame, modelled data} 12 | \item{getCluster.res}{data.frame, clustering results from timeOmics} 13 | \item{getCluster.sparse.res}{data.frame, sparse clustering results from timeOmics} 14 | \item{interaction.biogrid}{data.frame, interactions from BioGRID database} 15 | \item{interaction.TF}{data.frame, TFome interactions from TTrust and TF2DNA} 16 | \item{medlineranker.res.df}{data.frame, medlineRanker enrichment results} 17 | \item{graph.gut}{list of igraph, gut graph obtained with SparCC} 18 | } 19 | } 20 | \usage{ 21 | hmp_T2D 22 | } 23 | \description{ 24 | This dataset contained a list of data.frames. 25 | Raw data is a subset of the data available at: 26 | https://github.com/aametwally/ipop_seasonal 27 | The package will be illustrated on longitudinal MO dataset to study the 28 | seasonality of MO expression in patients with diabetes 29 | (see \code{netOmics} vignette). 30 | In this subset we focused on a single individual with 7 timepoints. 31 | Briefly 6 different omics were sampled (RNA, proteins, cytokines, 32 | gut microbiome, metabolites and clinical variables). 33 | } 34 | \keyword{datasets} 35 | -------------------------------------------------------------------------------- /man/netOmics.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/netOmics-package.R 3 | \docType{package} 4 | \name{netOmics} 5 | \alias{netOmics-package} 6 | \alias{netOmics} 7 | \title{netOmics: network-based multi-omics integration and interpretation} 8 | \description{ 9 | netOmics is a multi-omics networks builder and explorer. 10 | It uses a combination of network inference algorithms and and knowledge-based 11 | graphs to build multi-layered networks. 12 | 13 | The package can be combined with 14 | \code{timeOmics} to incorporate time-course expression data and build 15 | sub-networks from multi-omics kinetic clusters. 16 | 17 | Finally, from the generated multi-omics networks, propagation analyses allow 18 | the identification of missing biological functions (1), 19 | multi-omics mechanisms (2) and molecules between kinetic clusters (3). 20 | This helps to resolve complex regulatory mechanisms. 21 | Here are the main functions. 22 | } 23 | \section{Network building}{ 24 | 25 | \describe{ 26 | \item{\code{get_grn}}{Based on expression matrix, this function build a gene 27 | gene regulatory network. Additionally, if clustering information is given, 28 | it builds cluster specific graph.} 29 | \item{\code{get_interaction_from_database}}{From a database (graph or data.frame 30 | with interactions between 2 molecules), this function build the induced 31 | graph based on a list of molecules . Alternatively, the function can 32 | build a graph with the first degree neighbors.} 33 | \item{\code{get_interaction_from_correlation}}{Compute correlation between two 34 | dataframe X and Y (or list of data.frame). 35 | An incidence graph is returned. A link between two features is produced 36 | if their correlation (absolute value) is above the threshold.} 37 | \item{\code{combine_layers}}{Combine 2 (or list of) graphs based on given 38 | intersections.} 39 | } 40 | } 41 | 42 | \section{Network exploration}{ 43 | 44 | \describe{ 45 | \item{\code{random_walk_restart}}{This function performs a propagation analysis 46 | by random walk with restart 47 | in a multi-layered network from specific seeds.} 48 | \item{\code{rwr_find_seeds_between_attributes}}{From rwr results, this function 49 | returns a subgraph if any vertex shares 50 | different attributes value. 51 | In biological context, this might be useful to identify vertex shared between 52 | clusters or omics types.} 53 | \item{\code{rwr_find_closest_type}}{From a rwr results, this function returns 54 | the closest nodes from a seed with 55 | a given attribute and value. 56 | In biological context, it might be useful to get the closest Gene Ontology 57 | annotation nodes from unannotated seeds.} 58 | } 59 | } 60 | 61 | \section{Visualisation}{ 62 | 63 | \describe{ 64 | \item{\code{summary_plot_rwr_attributes}}{#' Based on the results of 65 | \code{\link[netOmics]{rwr_find_seeds_between_attributes}} which identify the 66 | closest k neighbors from a seed, this function returns a barplot of the node 67 | types (layers) reached for each seed.} 68 | \item{\code{plot_rwr_subnetwork}}{Display the subgraph from a RWR results. 69 | This function colors adds a specific 70 | color to each node based on their 'type' attribute. 71 | It also adds a legend including the number of vertices/edges and the number 72 | of nodes of specific type. 73 | Additionally, the function can display any igraph object.} 74 | } 75 | } 76 | 77 | \seealso{ 78 | Useful links: 79 | \itemize{ 80 | \item \url{https://github.com/abodein/netOmics} 81 | \item Report bugs at \url{https://github.com/abodein/netOmics/issues} 82 | } 83 | 84 | } 85 | \author{ 86 | \strong{Maintainer}: Antoine Bodein \email{antoine.bodein.1@ulaval.ca} 87 | 88 | } 89 | -------------------------------------------------------------------------------- /man/plot_rwr_subnetwork.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.R 3 | \name{plot_rwr_subnetwork} 4 | \alias{plot_rwr_subnetwork} 5 | \title{Plot RWR subnetwork} 6 | \usage{ 7 | plot_rwr_subnetwork(X, color = NULL, plot = TRUE, legend = TRUE, ...) 8 | } 9 | \arguments{ 10 | \item{X}{an igraph object} 11 | 12 | \item{color}{(optional) a named character vector or list, list of color 13 | to apply to each type} 14 | 15 | \item{plot}{logical, if TRUE then the plot is produced} 16 | 17 | \item{legend}{(optional) logical, if TRUE then the legend is displayed 18 | with number of veretices/edges and the number of nodes of specific type.} 19 | 20 | \item{...}{Arguments to be passed to the plot method} 21 | } 22 | \value{ 23 | X is returned with additional vertex attributes 24 | } 25 | \description{ 26 | Display the subgraph from a RWR results. This function colors adds a specific 27 | color to each node based on their 'type' attribute. 28 | It also adds a legend including the number of vertices/edges and the number 29 | of nodes of specific type. 30 | Additionally, the function can display any igraph object. 31 | } 32 | \examples{ 33 | graph1 <- igraph::graph_from_data_frame( 34 | list(from = c("A", "B", "A", "D", "C", "A", "C"), 35 | to = c("B", "C", "D", "E", "D", "F", "G")), 36 | directed = FALSE) 37 | graph1 <- igraph::set_vertex_attr(graph = graph1, 38 | name = 'type', 39 | index = c("A","B","C"), 40 | value = "1") 41 | graph1 <- igraph::set_vertex_attr(graph = graph1, 42 | name = 'type', 43 | index = c("D","E"), 44 | value = "2") 45 | graph1 <- igraph::set_vertex_attr(graph = graph1, 46 | name = 'type', 47 | index = c("F", "G"), 48 | value = "3") 49 | 50 | rwr_res <- random_walk_restart(X = graph1, 51 | seed = c("A")) 52 | rwr_res_type <- rwr_find_seeds_between_attributes(X = rwr_res, 53 | attribute = "type") 54 | 55 | plot_rwr_subnetwork(rwr_res_type$A) 56 | 57 | 58 | } 59 | -------------------------------------------------------------------------------- /man/random_walk_restart.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RWR.R 3 | \name{random_walk_restart} 4 | \alias{random_walk_restart} 5 | \title{Random Walk with Restart} 6 | \usage{ 7 | random_walk_restart(X, seed = NULL, r = 0.7) 8 | } 9 | \arguments{ 10 | \item{X}{an igraph or list.igraph object.} 11 | 12 | \item{seed}{a character vector. Only seeds present in X are considered.} 13 | 14 | \item{r}{a numeric value between 0 and 1. 15 | It sets the probability of restarting to a seed node after each step.} 16 | } 17 | \value{ 18 | Each element of X returns a list (class = 'rwr') 19 | containing the following elements: 20 | \item{rwr}{a \code{data.frame}, the RWR results for each valid seed.} 21 | \item{seed}{a character vector with the valid seeds} 22 | \item{graph}{\code{igraph} object from X} 23 | If X is a \code{list.igraph}, the returned object is a \code{list.rwr}. 24 | } 25 | \description{ 26 | This function performs a propagation analysis by random walk with restart 27 | in a multi-layered network from specific seeds. 28 | } 29 | \examples{ 30 | graph1 <- igraph::graph_from_data_frame( 31 | list(from = c('A', 'B', 'A', 'D', 'C', 'A', 'C'), 32 | to = c('B', 'C', 'D', 'E', 'D', 'F', 'G')), 33 | directed = FALSE) 34 | graph1 <- igraph::set_vertex_attr(graph = graph1, 35 | name = 'type', 36 | index = c('A','B','C'), 37 | value = '1') 38 | graph1 <- igraph::set_vertex_attr(graph = graph1, 39 | name = 'type', 40 | index = c('D','E'), 41 | value = '2') 42 | graph1 <- igraph::set_vertex_attr(graph = graph1, 43 | name = 'type', 44 | index = c('F', 'G'), 45 | value = '3') 46 | 47 | rwr_res <- random_walk_restart(X = graph1, 48 | seed = c('A', 'B', 'C', 'D', 'E')) 49 | 50 | } 51 | \seealso{ 52 | \code{\link[netOmics]{rwr_find_seeds_between_attributes}}, 53 | \code{\link[netOmics]{rwr_find_closest_type}} 54 | } 55 | -------------------------------------------------------------------------------- /man/rwr_find_closest_type.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RWR.R 3 | \name{rwr_find_closest_type} 4 | \alias{rwr_find_closest_type} 5 | \title{RWR Find closest nodes} 6 | \usage{ 7 | rwr_find_closest_type(X, seed = NULL, attribute = NULL, value = NULL, top = 1) 8 | } 9 | \arguments{ 10 | \item{X}{a random walk result from \code{random_walk_restart}} 11 | 12 | \item{seed}{a character vector or NULL. If NULL, all the seeds 13 | from X are considered.} 14 | 15 | \item{attribute}{a character value or NULL. If NULL, 16 | the closest node is returned.} 17 | 18 | \item{value}{a character value or NULL. If NULL, the closest node for a given 19 | attribute is returned.} 20 | 21 | \item{top}{a numeric value, the top closest nodes to extract} 22 | } 23 | \value{ 24 | A list of \code{data.frame} for each seed containing the closest nodes per 25 | seed and their vertex attributes. 26 | If X is \code{list.rwr}, the returned value is a list of list. 27 | } 28 | \description{ 29 | From a rwr results, this function returns the closest nodes from a seed with 30 | a given attribute and value. 31 | In biological context, it might be useful to get the closest Gene Ontology 32 | annotation nodes from unannotated seeds. 33 | } 34 | \examples{ 35 | graph1 <- igraph::graph_from_data_frame( 36 | list(from = c("A", "B", "A", "D", "C", "A", "C"), 37 | to = c("B", "C", "D", "E", "D", "F", "G")), 38 | directed = FALSE) 39 | graph1 <- igraph::set_vertex_attr(graph = graph1, 40 | name = 'type', 41 | index = c("A","B","C"), 42 | value = "1") 43 | graph1 <- igraph::set_vertex_attr(graph = graph1, 44 | name = 'type', 45 | index = c("D","E"), 46 | value = "2") 47 | graph1 <- igraph::set_vertex_attr(graph = graph1, 48 | name = 'type', 49 | index = c("F", "G"), 50 | value = "3") 51 | 52 | rwr_res <- random_walk_restart(X = graph1, 53 | seed = c("A", "B", "C", "D", "E")) 54 | rwr_find_closest_type(X=rwr_res, attribute = "type", 55 | seed = "A") 56 | } 57 | -------------------------------------------------------------------------------- /man/rwr_find_seeds_between_attributes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RWR.R 3 | \name{rwr_find_seeds_between_attributes} 4 | \alias{rwr_find_seeds_between_attributes} 5 | \title{RWR Find seeds between attributes} 6 | \usage{ 7 | rwr_find_seeds_between_attributes(X, seed = NULL, k = 15, attribute = "type") 8 | } 9 | \arguments{ 10 | \item{X}{a random walk result from \code{random_walk_restart}} 11 | 12 | \item{seed}{a character vector or NULL. If NULL, all the seeds from X 13 | are considered.} 14 | 15 | \item{k}{a integer, k closest nodes to consider in the search} 16 | 17 | \item{attribute}{a character value or NULL. 18 | If NULL, the closest node is returned.} 19 | } 20 | \value{ 21 | A list of igraph object for each seed. 22 | If X is a list, it returns a list of list of graph. 23 | } 24 | \description{ 25 | From rwr results, this function returns a subgraph if any vertex shares 26 | different attributes value. 27 | In biological context, this might be useful to identify vertex shared between 28 | clusters or omics types. 29 | } 30 | \examples{ 31 | graph1 <- igraph::graph_from_data_frame( 32 | list(from = c("A", "B", "A", "D", "C", "A", "C"), 33 | to = c("B", "C", "D", "E", "D", "F", "G")), 34 | directed = FALSE) 35 | graph1 <- igraph::set_vertex_attr(graph = graph1, 36 | name = 'type', 37 | index = c("A","B","C"), 38 | value = "1") 39 | graph1 <- igraph::set_vertex_attr(graph = graph1, 40 | name = 'type', 41 | index = c("D","E"), 42 | value = "2") 43 | graph1 <- igraph::set_vertex_attr(graph = graph1, 44 | name = 'type', 45 | index = c("F", "G"), 46 | value = "3") 47 | 48 | rwr_res <- random_walk_restart(X = graph1, 49 | seed = c("A", "B", "C", "D", "E")) 50 | rwr_res_type <- rwr_find_seeds_between_attributes(X = rwr_res, 51 | attribute = "type", 52 | k = 3) 53 | 54 | } 55 | -------------------------------------------------------------------------------- /man/summary_plot_rwr_attributes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.R 3 | \name{summary_plot_rwr_attributes} 4 | \alias{summary_plot_rwr_attributes} 5 | \title{Summary Plot RWR attributes} 6 | \usage{ 7 | summary_plot_rwr_attributes( 8 | X, 9 | color = NULL, 10 | seed.id = NULL, 11 | seed.type = NULL, 12 | plot = TRUE 13 | ) 14 | } 15 | \arguments{ 16 | \item{X}{a 'rwr.attributes' or 'list.rwr.attributes' object 17 | from rwr_find_seeds_between_attributes()} 18 | 19 | \item{color}{(optional) a named character vector or list, 20 | list of color to apply to each type} 21 | 22 | \item{seed.id}{(optional) a character vector, to filter the results and 23 | filter on specific seeds IDs} 24 | 25 | \item{seed.type}{(optional) a character vector, to filter the results and 26 | filter on specific seeds types} 27 | 28 | \item{plot}{logical, if TRUE then the plot is produced} 29 | } 30 | \value{ 31 | a 'ggplot' object 32 | } 33 | \description{ 34 | Based on the results of 35 | \code{\link[netOmics]{rwr_find_seeds_between_attributes}} which identify the 36 | closest k neighbors from a seed, this function returns a barplot of the node 37 | types (layers) reached for each seed. 38 | } 39 | \examples{ 40 | graph1 <- igraph::graph_from_data_frame( 41 | list(from = c("A", "B", "A", "D", "C", "A", "C"), 42 | to = c("B", "C", "D", "E", "D", "F", "G")), 43 | directed = FALSE) 44 | graph1 <- igraph::set_vertex_attr(graph = graph1, 45 | name = 'type', 46 | index = c("A","B","C"), 47 | value = "1") 48 | graph1 <- igraph::set_vertex_attr(graph = graph1, 49 | name = 'type', 50 | index = c("D","E"), 51 | value = "2") 52 | graph1 <- igraph::set_vertex_attr(graph = graph1, 53 | name = 'type', 54 | index = c("F", "G"), 55 | value = "3") 56 | 57 | rwr_res <- random_walk_restart(X = graph1, 58 | seed = c("A", "B", "C", "D", "E")) 59 | rwr_res_type <- rwr_find_seeds_between_attributes(X = rwr_res, 60 | attribute = "type", 61 | k = 3) 62 | summary_plot_rwr_attributes(rwr_res_type) 63 | 64 | 65 | } 66 | \seealso{ 67 | \code{\link[netOmics]{random_walk_restart}}, 68 | \code{\link[netOmics]{rwr_find_seeds_between_attributes}} 69 | } 70 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(netOmics) 3 | 4 | test_check("netOmics") 5 | -------------------------------------------------------------------------------- /tests/testthat/Rplots.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/abodein/netOmics/c2b1e80dda2685d8309229307fc54273493f64d0/tests/testthat/Rplots.pdf -------------------------------------------------------------------------------- /tests/testthat/test-RWR.R: -------------------------------------------------------------------------------- 1 | context("RWR") 2 | 3 | graph1 <- igraph::graph_from_data_frame(list(from = c("A", "B", "A", "D", "C", "A", "C"), 4 | to = c("B", "C", "D", "E", "D", "F", "G")), directed = FALSE) 5 | graph1 <- set_vertex_attr(graph = graph1, name = 'type', index = c("A","B","C"),value = "1") 6 | graph1 <- set_vertex_attr(graph = graph1, name = 'type', index = c("D","E"),value = "2") 7 | graph1 <- set_vertex_attr(graph = graph1, name = 'type', index = c("F", "G"),value = "3") 8 | 9 | rwr_res <- random_walk_restart(X = graph1, seed = c("A", "B", "C", "D", "E")) 10 | rwr_res_type <- rwr_find_seeds_between_attributes(X = rwr_res, attribute = "type", k = 3) 11 | 12 | graph1.list <- list("X" = graph1, "Y"= graph1) 13 | 14 | rwr_res.list <- random_walk_restart(X = graph1.list, seed = c("A", "B", "C", "D", "E")) 15 | rwr_res_type.list <- rwr_find_seeds_between_attributes(X = rwr_res.list, attribute = "type", k = 3) 16 | 17 | test_that("random_walk_with_restart fails with invalid input", { 18 | # X 19 | expect_error(random_walk_restart(X=NULL)) 20 | expect_error(random_walk_restart(X=data.frame())) 21 | expect_error(random_walk_restart(X=list(3))) 22 | 23 | # seed 24 | expect_error(random_walk_restart(X=graph1, seed = 3)) 25 | 26 | # r 27 | expect_error(random_walk_restart(X=graph1, r = -2), "'r' must be a numeric value between 0 and 1", fixed = TRUE) 28 | expect_error(random_walk_restart(X=graph1, r = matrix(2)), "'r' must be a numeric value", fixed = TRUE) 29 | 30 | }) 31 | 32 | test_that("random_walk_with_restart works", { 33 | 34 | # X 35 | expect_is(random_walk_restart(graph1.list), "list.rwr") 36 | expect_is(random_walk_restart(graph1), "rwr") 37 | 38 | # seed 39 | expect_is(random_walk_restart(graph1, seed = 'A'), "rwr") 40 | expect_is(random_walk_restart(graph1.list, seed = "A"), "list.rwr") 41 | expect_is(random_walk_restart(graph1, seed = NULL), "rwr") 42 | 43 | # r 44 | expect_is(random_walk_restart(graph1, seed = NULL, r = 0.4), "rwr") 45 | 46 | }) 47 | 48 | 49 | 50 | test_that("rwr_find_seeds_between_attributes fails with invalid input", { 51 | # X 52 | expect_error(rwr_find_seeds_between_attributes(X=NULL)) 53 | expect_error(rwr_find_seeds_between_attributes(X=matrix())) 54 | 55 | # k 56 | expect_error(rwr_find_seeds_between_attributes(X=rwr_res, k = -5), "'k' must be a numeric value between 0 and 200", fixed = TRUE) 57 | expect_error(rwr_find_seeds_between_attributes(X=rwr_res, k = list(3)),"'k' must be a numeric value", fixed = TRUE) 58 | 59 | # seed / attribute 60 | expect_error(rwr_find_seeds_between_attributes(X=rwr_res, seed = matrix(3)), "'seed' must be a charactor vector", fixed = TRUE) 61 | expect_error(rwr_find_seeds_between_attributes(X=rwr_res, attribute = matrix(3)), "'attribute' must be a charactor vector", fixed = TRUE) 62 | expect_error(rwr_find_seeds_between_attributes(X=rwr_res, attribute = c("4", "5")), "invalid length", fixed = TRUE) 63 | }) 64 | 65 | 66 | test_that("rwr_find_seeds_between_attributes works", { 67 | # X 68 | expect_is(rwr_find_seeds_between_attributes(X=rwr_res), "rwr.attributes") 69 | expect_is(rwr_find_seeds_between_attributes(X=rwr_res.list), "list.rwr.attributes") 70 | 71 | # seed 72 | expect_is(rwr_find_seeds_between_attributes(X=rwr_res, seed = logical(0)), "rwr.attributes") 73 | expect_is(rwr_find_seeds_between_attributes(X=rwr_res, attribute = logical(0)), "rwr.attributes") 74 | expect_is(rwr_find_seeds_between_attributes(X=rwr_res, seed = "Z"), "rwr.attributes") 75 | 76 | expect_is(rwr_find_seeds_between_attributes(X=rwr_res.list, seed = "Z"), "list.rwr.attributes") 77 | 78 | 79 | # k 80 | expect_is(rwr_find_seeds_between_attributes(X=rwr_res, k = 1) , "rwr.attributes") 81 | expect_is(rwr_find_seeds_between_attributes(X=rwr_res, k = NULL), "rwr.attributes") 82 | 83 | }) 84 | 85 | 86 | test_that("rwr_find_closest_type fails with invalid input", { 87 | # X 88 | expect_error(rwr_find_closest_type(X=NULL)) 89 | expect_error(rwr_find_closest_type(X=matrix())) 90 | 91 | # seed / attribute 92 | expect_error(rwr_find_closest_type(X=rwr_res, seed = matrix(3)), "'seed' must be a charactor vector", fixed = TRUE) 93 | expect_error(rwr_find_closest_type(X=rwr_res, attribute = matrix(3)), "'attribute' must be a charactor vector", fixed = TRUE) 94 | expect_error(rwr_find_closest_type(X=rwr_res, attribute = c("4", "5")), "invalid length", fixed = TRUE) 95 | 96 | # value 97 | expect_error(rwr_find_closest_type(X=rwr_res, attribute = NULL, seed = NULL, value = c("a", "b")), "invalid length", fixed = TRUE) 98 | expect_error(rwr_find_closest_type(X=rwr_res, attribute = NULL, seed = NULL, value = matrix(1,2)), "'value' must be a charactor vector", fixed = TRUE) 99 | 100 | }) 101 | 102 | 103 | test_that("rwr_find_closest_type works", { 104 | # X 105 | expect_is(rwr_find_closest_type(X=rwr_res), "rwr.closest") 106 | expect_is(rwr_find_closest_type(X=rwr_res.list), "list.rwr.closest") 107 | 108 | # seeds / attributes 109 | expect_is(rwr_find_closest_type(X=rwr_res, seed = logical(0)), "rwr.closest") 110 | expect_is(rwr_find_closest_type(X=rwr_res, attribute = logical(0)), "rwr.closest") 111 | expect_is(rwr_find_closest_type(X=rwr_res, attribute = NULL, seed = NULL), "rwr.closest") 112 | expect_is(rwr_find_closest_type(X=rwr_res, attribute = "NULL", seed = NULL), "rwr.closest") 113 | 114 | #value 115 | expect_is(rwr_find_closest_type(X=rwr_res, attribute = "NULL", seed = NULL, value = NULL), "rwr.closest") 116 | expect_is(rwr_find_closest_type(X=rwr_res, attribute = NULL, seed = NULL, value = "test"), "rwr.closest") 117 | expect_is(rwr_find_closest_type(X=rwr_res, value = "test"), "rwr.closest") 118 | 119 | expect_is(rwr_find_closest_type(X=rwr_res, seed = "Z"), "rwr.closest") 120 | expect_is(rwr_find_closest_type(X=rwr_res.list, seed = "Z"), "list.rwr.closest") 121 | 122 | }) 123 | 124 | # test_that("top_k_graph returns NULL", { 125 | # rwr_top_k_graph 126 | # rwr_top_k_graph(X = rwr_res$graph, RWRM_Result_Object = rwr_res$rwr, Seed = "A", k = 1) 127 | # }) 128 | -------------------------------------------------------------------------------- /tests/testthat/test-combine_layers.R: -------------------------------------------------------------------------------- 1 | context("combine_layers") 2 | 3 | graph1 <- igraph::graph_from_data_frame( 4 | list(from = c("A", "B"), to = c("B", "C")), directed = FALSE) 5 | graph2 <- igraph::graph_from_data_frame( 6 | list(from = c(1), to = c(2)), directed = FALSE) 7 | graph3 <- igraph::make_empty_graph(directed = FALSE) 8 | graph1.1 <- set_vertex_attr(graph1, name = "type", value = 'ty') 9 | 10 | interaction.df1 <- as.data.frame(list(from = c("C", "B"), to = c(1, 2))) 11 | interaction.df2 <- as.data.frame(list(from = c("D", "D"), to = c(3, 4))) 12 | interaction.df1.graph <- igraph::graph_from_data_frame(as.data.frame( 13 | list(from = c("C", "B"), to = c(1, 2))), directed = FALSE) 14 | 15 | 16 | graph1.list <- list(graph1, graph1) 17 | graph2.list <- list(graph2, graph2) 18 | graph3.list <- list(graph1, graph1, graph1) 19 | class(graph1.list) <- class(graph2.list) <- class(graph3.list) <- "list.igraph" 20 | 21 | graph1.list.named <- list(graph1 = graph1, graph2 = graph1) 22 | graph2.list.named <- list(graph1 = graph2, graph2 = graph2) 23 | graph3.list.named <- list(graph2 = graph2, graph1 = graph2) 24 | graph4.list.named <- list(graph3 = graph2, graph2 = graph2) 25 | class(graph1.list.named) <- class(graph2.list.named) <- 26 | class(graph3.list.named) <- class(graph4.list.named) <- "list.igraph" 27 | 28 | 29 | test_that("get_grn fails on invalid input", { 30 | expect_error(combine_layers(graph1 = ""), "graph1 must be an igraph or list.igraph object", fixed = TRUE) 31 | expect_error(combine_layers(graph1, graph2 = ""), "graph2 must be an igraph or list.igraph object or NULL", fixed = TRUE) 32 | expect_error(combine_layers(graph1, graph2, interaction.df = "")) 33 | expect_error(combine_layers(graph1, graph2 = graph2.list), "graph1 and graph2 must have the same length", fixed = TRUE) 34 | expect_error(combine_layers(graph1.list, graph2 = graph3.list), "graph1 and graph2 must have the same length", fixed = TRUE) 35 | 36 | expect_error(combine_layers(graph1.list, graph2 = graph3.list), "graph1 and graph2 must have the same length", fixed = TRUE) 37 | expect_error(combine_layers(graph1.list.named, graph2 = graph4.list.named), "graph1 and graph2 must have the same names", fixed = TRUE) 38 | 39 | }) 40 | 41 | 42 | test_that("combine_layers works", { 43 | # graph1 44 | expect_is(combine_layers(graph1 = graph1), "igraph") 45 | 46 | # graph1 and graph2 47 | expect_is(combine_layers(graph1 = graph1, graph2 = graph2), "merged.igraph") 48 | expect_is(combine_layers(graph1 = graph1.1, graph2 = graph1.1), "merged.igraph") 49 | 50 | 51 | # graph1 and interaction.df 52 | expect_is(combine_layers(graph1 = graph1, interaction.df = interaction.df1), "merged.igraph") 53 | #expect_warning(combine_layers(graph1 = graph1, interaction.df = interaction.df2), "Some, but not all graphs are named, not using vertex names", fixed = TRUE) 54 | expect_is(combine_layers(graph1 = graph1, interaction.df = interaction.df2), "merged.igraph") 55 | 56 | 57 | expect_is(combine_layers(graph1 = graph1, graph2 = graph2, interaction.df = interaction.df1), "merged.igraph") 58 | expect_is(combine_layers(graph1 = graph1, graph2 = graph2, interaction.df = interaction.df2), "merged.igraph") 59 | expect_is(combine_layers(graph1 = graph1.list, graph2 = graph2, interaction.df = interaction.df1.graph), "list.merged.igraph") 60 | 61 | 62 | expect_is(combine_layers(graph1 = graph1.list, graph2 = graph2), "list.merged.igraph") 63 | expect_is(combine_layers(graph1 = graph1.list, graph2 = graph2, interaction.df = interaction.df1), "list.merged.igraph") 64 | expect_is(combine_layers(graph1 = graph1.list, graph2 = NULL, interaction.df = interaction.df1), "list.merged.igraph") 65 | 66 | 67 | expect_is(combine_layers(graph1 = graph1.list, graph2 = graph2.list), "list.merged.igraph") 68 | expect_is(combine_layers(graph1 = graph1.list, graph2 = graph2.list, interaction.df = interaction.df1), "list.merged.igraph") 69 | 70 | #named list 71 | expect_is(combine_layers(graph1.list.named, graph2 = graph2.list.named), "list.merged.igraph") 72 | expect_is(combine_layers(graph1.list.named, graph2 = graph3.list.named), "list.merged.igraph") 73 | 74 | # with empty graph 75 | expect_warning(combine_layers(graph1, graph2 = graph3), "Some, but not all graphs are named, not using vertex names", fixed = TRUE) 76 | 77 | 78 | }) 79 | -------------------------------------------------------------------------------- /tests/testthat/test-enrichment.R: -------------------------------------------------------------------------------- 1 | context("ORA") 2 | 3 | test_that("get_interaction_from_ORA fails on invalid imput", { 4 | query <- c("IL15", "CDHR5", "TGFA", 'C4B') 5 | expect_error(get_interaction_from_ORA(query, sources = "qowiudjh")) 6 | expect_error(get_interaction_from_ORA(query, sources = c("GO", "KEGG"))) 7 | }) 8 | 9 | test_that("get_interaction_from_ORA works ", { 10 | query <- c("IL15", "CDHR5", "TGFA", 'C4B') 11 | expect_is(get_interaction_from_ORA(query, sources = "GO"), "igraph") 12 | expect_is(get_interaction_from_ORA(query, sources = c("KEGG")), "NULL") 13 | 14 | 15 | query <- list("All" = c("IL15", "CDHR5", "TGFA", 'C4B'), 16 | "c1" = c("IL15", "CDHR5", "TGFA")) 17 | expect_is(get_interaction_from_ORA(query, sources = "GO"), "list.igraph") 18 | query <- list(c("IL15", "CDHR5", "TGFA", 'C4B'), c("IL15", "CDHR5", "TGFA")) 19 | expect_is(get_interaction_from_ORA(query, sources = "GO"), "list.igraph") 20 | 21 | }) 22 | 23 | test_that("get_ORA works", { 24 | query <- list("All" = c("IL15", "CDHR5", "TGFA", 'C4B'), 25 | "c1" = c("IL15", "CDHR5", "TGFA")) 26 | expect_is(get_ORA(query), "data.frame") 27 | query <- c("IL15") 28 | expect_is(get_ORA(query), "data.frame") 29 | }) 30 | 31 | # test_that("get_go_info works", { 32 | # expect_is(get_go_info("GO:0044216"), "data.frame") 33 | # }) 34 | -------------------------------------------------------------------------------- /tests/testthat/test-get_graph_stats.R: -------------------------------------------------------------------------------- 1 | context("get_graph_stats") 2 | 3 | graph1 <- igraph::graph_from_data_frame(list(from = c("A", "B", "A", "D", "C", "A", "C"), 4 | to = c("B", "C", "D", "E", "D", "F", "G")), directed = FALSE) 5 | graph1 <- set_vertex_attr(graph = graph1, name = 'type', index = c("A","B","C"),value = "1") 6 | graph1 <- set_vertex_attr(graph = graph1, name = 'type', index = c("D","E"),value = "2") 7 | graph1 <- set_vertex_attr(graph = graph1, name = 'type', index = c("F", "G"),value = "3") 8 | 9 | 10 | graph1.list <- list("X" = graph1, "Y"= graph1) 11 | 12 | test_that("get_graph_stats fails on invalid input", { 13 | expect_error(get_graph_stats(X = "")) 14 | }) 15 | 16 | test_that("get_graph_stats works", { 17 | expect_is(get_graph_stats(X = graph1), "data.frame") 18 | expect_is(get_graph_stats(X = graph1.list), "data.frame") 19 | }) -------------------------------------------------------------------------------- /tests/testthat/test-get_grn.R: -------------------------------------------------------------------------------- 1 | context("get_grn") 2 | 3 | #' data(HeLa) 4 | #' #' # grn only on gene 5 | #' cluster.mRNA <- HeLa$getCluster %>% dplyr::filter(block == "mRNA") 6 | #' X <- HeLa$raw$mRNA 7 | #' #grn.res <- get_grn(X = HeLa$raw$mRNA, cluster = cluster.mRNA, method = "aracne") 8 | #' 9 | data("hmp_T2D") 10 | cluster.mRNA <- hmp_T2D$getCluster.res %>% dplyr::filter(block == "RNA") 11 | X <- hmp_T2D$raw$RNA 12 | 13 | test_that("get_grn fails on invalid input - X", { 14 | # X 15 | expect_error(get_grn(X = ""), "'X' must be a numeric matrix/data.frame", fixed = TRUE) 16 | expect_error(get_grn(X = 1), "'X' must be a numeric matrix/data.frame", fixed = TRUE) 17 | expect_error(get_grn(X = NA), "'X' must be a numeric matrix/data.frame", fixed = TRUE) 18 | expect_error(get_grn(X = list()), "'X' must be a numeric matrix/data.frame", fixed = TRUE) 19 | 20 | }) 21 | 22 | 23 | test_that("get_grn fails on invalid input - X", { 24 | expect_error(get_grn(X = X, cluster = ""), "cluster must be NULL or a result from getCluster()", fixed = TRUE) 25 | }) 26 | 27 | test_that("get_grn fails on invalid input - method", { 28 | expect_error(get_grn(X = X, cluster = NULL, method = "")) 29 | }) 30 | 31 | test_that("get_grn works", { 32 | # expect_is(get_grn(X = X, cluster = cluster.mRNA, method = "aracne"), "list.igraph") 33 | expect_warning(get_grn(X = X, cluster = cluster.mRNA, method = "aracne")) 34 | 35 | # expect_is(get_grn(X = X, method = "aracne"), "igraph") 36 | expect_warning(get_grn(X = X, method = "aracne")) 37 | 38 | }) 39 | -------------------------------------------------------------------------------- /tests/testthat/test-get_interaction_from_database.R: -------------------------------------------------------------------------------- 1 | context("get_interaction_from_database") 2 | 3 | db.data.frame <- as.data.frame(list(from = c("A", "B", "E", "A"), 4 | to = c("B", "C", "F", "C"))) 5 | db.graph <- igraph::graph_from_data_frame(db.data.frame, directed = FALSE) 6 | 7 | X <- c("A", "F") 8 | X.list <- list(X) 9 | names(X.list) <- "2" 10 | 11 | #get_interaction_from_database(X, db = NULL, type = "db", user.ego = FALSE) 12 | 13 | test_that("get_interaction_from_database fails on invalid input", { 14 | # if X fails, X recieve a default value 15 | # same for type and user.ego 16 | expect_error(get_interaction_from_database(X = NULL), "'db' must be an igraph or data.frame object") 17 | expect_error(get_interaction_from_database(X = NULL, db = ""), "'db' must be an igraph or data.frame object") 18 | expect_error(get_interaction_from_database(X = NULL, db = data.frame("a" = c(1,2,3), 'b'= c(2,3,4))), "'db' must contains the columns 'from' and 'to'") 19 | 20 | }) 21 | 22 | test_that("get_interaction_from_database works", { 23 | expect_message(get_interaction_from_database(X = NULL, db = db.data.frame), "X is NULL, returning an empty graph") 24 | expect_is(get_interaction_from_database(X = X, db = db.data.frame, type = "db", user.ego = FALSE), "interaction.igraph") 25 | expect_is(get_interaction_from_database(X = X, db = db.graph, type = "db", user.ego = FALSE), "interaction.igraph") 26 | 27 | expect_is(get_interaction_from_database(X = X.list, db = db.graph, type = "db", user.ego = FALSE), "list.igraph") 28 | expect_is(get_interaction_from_database(X = X.list, db = db.data.frame, type = "db", user.ego = FALSE), "list.igraph") 29 | 30 | expect_message(get_interaction_from_database(X = list("A" = "Z"), db = db.graph, type = "db", user.ego = FALSE), "no shared elements between X and db, return empty graph", fixed = TRUE) 31 | expect_is(get_interaction_from_database(X = X.list, db= db.graph, type = "db", user.ego = TRUE), "list.igraph") 32 | 33 | expect_message(get_interaction_from_database(X = list("A" = "Z"), db = db.data.frame, type = "db", user.ego = FALSE), "no shared elements between X and db, return empty graph", fixed = TRUE) 34 | expect_is(get_interaction_from_database(X = X.list, db = db.data.frame, type = "db", user.ego = TRUE), "list.igraph") 35 | 36 | expect_message(get_interaction_from_database(X = list("Z"), db = db.data.frame, type = "db", user.ego = FALSE), "no shared elements between X and db, return empty graph", fixed = TRUE) 37 | 38 | }) 39 | -------------------------------------------------------------------------------- /tests/testthat/test-merge_layer_by_correlation.R: -------------------------------------------------------------------------------- 1 | context('merge_layer_by_correlation') 2 | 3 | 4 | test_that("get_interaction_from_correlation fails on invalind input", { 5 | X <- matrix(rexp(200, rate=.1), ncol=20) 6 | Y <- matrix(rexp(200, rate=.1), ncol=20) 7 | expect_error(get_interaction_from_correlation(X = "",Y), "'X' must be a numeric matrix/data.frame", fixed = TRUE) 8 | 9 | X <- list(matrix(rexp(200, rate=.1), ncol=20), matrix(rexp(200, rate=.1), ncol=2)) 10 | expect_error(get_interaction_from_correlation(X = X,Y),"'X' must have the same number of rows", fixed = TRUE) 11 | 12 | X <- matrix(rexp(200, rate=.1), ncol=20) 13 | Y <- list(matrix(rexp(200, rate=.1), ncol=20), matrix(rexp(200, rate=.1), ncol=2)) 14 | expect_error(get_interaction_from_correlation(X = X,Y),"'Y' must have the same number of rows", fixed = TRUE) 15 | expect_error(get_interaction_from_correlation(X = X,Y = ""),"'Y' must be a numeric matrix/data.frame", fixed = TRUE) 16 | 17 | 18 | }) 19 | 20 | test_that("get_interaction_from_correlation works", { 21 | X <- matrix(rexp(200, rate=.1), ncol=20) 22 | Y <- matrix(rexp(200, rate=.1), ncol=20) 23 | expect_is(get_interaction_from_correlation(X,Y), "igraph") 24 | 25 | X <- list(matrix(rexp(200, rate=.1), ncol=20), matrix(rexp(200, rate=.1), ncol=20)) 26 | Y <- matrix(rexp(200, rate=.1), ncol=20) 27 | expect_is(get_interaction_from_correlation(X,Y), "igraph") 28 | 29 | X <- list(matrix(rexp(200, rate=.1), ncol=20), matrix(rexp(200, rate=.1), ncol=20)) 30 | Y <- list(matrix(rexp(200, rate=.1), ncol=20), matrix(rexp(200, rate=.1), ncol=20)) 31 | expect_is(get_interaction_from_correlation(X,Y), "igraph") 32 | }) -------------------------------------------------------------------------------- /tests/testthat/test-plot.R: -------------------------------------------------------------------------------- 1 | context("plot") 2 | 3 | graph1 <- igraph::graph_from_data_frame(list(from = c("A", "B", "A", "D", "C", "A", "C"), 4 | to = c("B", "C", "D", "E", "D", "F", "G")), directed = FALSE) 5 | graph1 <- set_vertex_attr(graph = graph1, name = 'type', index = c("A","B","C"),value = "1") 6 | graph1 <- set_vertex_attr(graph = graph1, name = 'type', index = c("D","E"),value = "2") 7 | graph1 <- set_vertex_attr(graph = graph1, name = 'type', index = c("F", "G"),value = "3") 8 | 9 | rwr_res <- random_walk_restart(X = graph1, seed = c("A", "B", "C", "D", "E")) 10 | rwr_res_type <- rwr_find_seeds_between_attributes(X = rwr_res, attribute = "type", k = 3) 11 | 12 | graph1.list <- list("X" = graph1, "Y"= graph1) 13 | 14 | rwr_res.list <- random_walk_restart(X = graph1.list, seed = c("A", "B", "C", "D", "E")) 15 | rwr_res_type.list <- rwr_find_seeds_between_attributes(X = rwr_res.list, attribute = "type", k = 3) 16 | 17 | summary_plot_rwr_attributes(rwr_res_type) 18 | 19 | test_that("summary_plot_rwr_attributes fails on invalid input", { 20 | #X 21 | expect_error(summary_plot_rwr_attributes(X = c())) 22 | expect_error(summary_plot_rwr_attributes(X = NULL)) 23 | # color must be a named vector/list 24 | expect_error(summary_plot_rwr_attributes(X = rwr_res_type, color = 3), "'color' must be a named verctor or list", fixed = TRUE) 25 | expect_error(summary_plot_rwr_attributes(X = rwr_res_type, color = data.frame()), "'color' must be a named verctor or list", fixed = TRUE) 26 | 27 | # seed.id 28 | expect_error(summary_plot_rwr_attributes(X = rwr_res_type, seed.id = c(1)), "'seed.id' must be a charactor vector", fixed = TRUE) 29 | # seed.type 30 | expect_error(summary_plot_rwr_attributes(X = rwr_res_type, seed.type = c(1)), "'seed.type' must be a charactor vector", fixed = TRUE) 31 | 32 | # plot TRUE/FALSE -> default 33 | }) 34 | 35 | test_that("summary_plot_rwr_attributes works", { 36 | expect_is(summary_plot_rwr_attributes(rwr_res_type), "ggplot") 37 | 38 | expect_is(summary_plot_rwr_attributes(rwr_res_type,color = list("1" = "red", "2"="blue", "3"="pink")),"ggplot") 39 | expect_is(summary_plot_rwr_attributes(rwr_res_type, seed.id = c("A","B")), "ggplot") 40 | expect_is(summary_plot_rwr_attributes(rwr_res_type, seed.type = c("1")), "ggplot") 41 | 42 | expect_is(summary_plot_rwr_attributes(rwr_res_type, seed.type = c("1"), plot = NA), "ggplot") 43 | expect_is(summary_plot_rwr_attributes(rwr_res_type, seed.type = c("1"), plot = FALSE), "ggplot") 44 | 45 | expect_is(summary_plot_rwr_attributes(rwr_res_type.list), "ggplot") 46 | 47 | expect_null(summary_plot_rwr_attributes(rwr_res_type, seed.type = c("f"), plot = FALSE)) 48 | 49 | }) 50 | 51 | test_that("plot_rwr_subnetwork fails on invalid input", { 52 | # X 53 | expect_error(plot_rwr_subnetwork(c())) 54 | 55 | # color 56 | expect_error(plot_rwr_subnetwork(X = rwr_res_type$A, color = 3), "'color' must be a named verctor or list", fixed = TRUE) 57 | expect_error(plot_rwr_subnetwork(X = rwr_res_type$A, color = data.frame()), "'color' must be a named verctor or list", fixed = TRUE) 58 | 59 | # plot, legend -> TRUE/FALSE 60 | # ... 61 | }) 62 | 63 | test_that("plot_rwr_subnetwork works", { 64 | # X 65 | expect_is(plot_rwr_subnetwork(X = rwr_res_type$A), "igraph") 66 | 67 | #color 68 | expect_is(plot_rwr_subnetwork(X = rwr_res_type$A, color = list("1" = "red", "2"="blue", "3"="green")), "igraph") 69 | expect_is(plot_rwr_subnetwork(X = rwr_res_type$A, color = list("1" = "red", "4"="blue", "3"="green")), "igraph") 70 | 71 | #plot 72 | expect_is(plot_rwr_subnetwork(X = rwr_res_type$A, plot = FALSE), "igraph") 73 | expect_is(plot_rwr_subnetwork(X = rwr_res_type$A, plot = NA), "igraph") 74 | 75 | expect_is(plot_rwr_subnetwork(X = rwr_res_type$A, legend = FALSE), "igraph") 76 | expect_is(plot_rwr_subnetwork(X = rwr_res_type$A, legend = NA), "igraph") 77 | expect_is(plot_rwr_subnetwork(X = rwr_res_type$A, legend = NULL), "igraph") 78 | 79 | }) 80 | 81 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | context("utils") 2 | 3 | # # from timeOmics 4 | # check_matrix <- function(X){ 5 | # # add rownames and colnames if absent, cast into matrix 6 | # if(!(is.matrix(X) || is.data.frame(X))) return(FALSE) 7 | # 8 | # if(is.data.frame(X)){ 9 | # X <- as.matrix(X) 10 | # } 11 | # if(is.null(rownames(X))){ 12 | # rownames(X) <- 1:nrow(X) 13 | # } 14 | # if(is.null(colnames(X))){ 15 | # colnames(X) <- paste0("V", 1:ncol(X)) 16 | # } 17 | # return(X) 18 | # } 19 | 20 | test_that("check_matrix", { 21 | expect_false(check_matrix(c(1,2,3))) 22 | X = data.frame("a" = c(1,2,3), 'b'= c(2,3,4)) 23 | expect_is(check_matrix(X), 'matrix') 24 | X = matrix(c(1,2,3,2,3,4), nrow = 2) 25 | expect_is(check_matrix(X), 'matrix') 26 | rownames(X) <- NULL 27 | expect_is(check_matrix(X), 'matrix') 28 | colnames(X) <- NULL 29 | expect_is(check_matrix(X), 'matrix') 30 | }) 31 | 32 | # validate_matrix_X <- function(X){ 33 | # # X should be a numeric matrix 34 | # X <- check_matrix(X) 35 | # if(!is.numeric(X)){ 36 | # stop("'X' must be a numeric matrix/data.frame") 37 | # } 38 | # # if(any(!X)) stop("'X' must be a numeric matrix/data.frame") 39 | # return(X) 40 | # } 41 | 42 | test_that("validate_matrix_X", { 43 | X = data.frame("a" = c("A","B", "C"), 'b'= c(NA)) 44 | expect_error(validate_matrix_X(X), "'X' must be a numeric matrix/data.frame", fixed = TRUE) 45 | }) 46 | 47 | # validate_list_matrix_X <- function(X){ 48 | # if(!is.list(X)){ 49 | # stop("'X' must be a list of matrix/data.frame") 50 | # } 51 | # X <- lapply(X, validate_matrix_X) 52 | # return(X) 53 | # } 54 | 55 | test_that("validate_list_matrix_X", { 56 | expect_error(validate_list_matrix_X(X = 2), "'X' must be a list of matrix/data.frame", fixed=TRUE) 57 | X <- list(data.frame("a" = c(1,2,3), 'b'= c(2,3,4)), data.frame("a" = c(1,2,3), 'b'= c(2,3,4))) 58 | expect_is(validate_list_matrix_X(X), "list") 59 | }) 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | -------------------------------------------------------------------------------- /vignettes/img/netomics_overview.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/abodein/netOmics/c2b1e80dda2685d8309229307fc54273493f64d0/vignettes/img/netomics_overview.png -------------------------------------------------------------------------------- /vignettes/mybib.bib: -------------------------------------------------------------------------------- 1 | @article{friedman2012inferring, 2 | title={Inferring correlation networks from genomic survey data}, 3 | author={Friedman, Jonathan and Alm, Eric J}, 4 | year={2012}, 5 | publisher={Public Library of Science San Francisco, USA} 6 | } 7 | 8 | @article{bodein2020interpretation, 9 | title={Interpretation of network-based integration from multi-omics longitudinal data}, 10 | author={Bodein, Antoine and Scott-Boyer, Marie-Pier and Perin, Olivier and Le Cao, Kim-Anh and Droit, Arnaud}, 11 | journal={bioRxiv}, 12 | year={2020}, 13 | publisher={Cold Spring Harbor Laboratory} 14 | } 15 | 16 | @article{sailani2020deep, 17 | title={Deep longitudinal multiomics profiling reveals two biological seasonal patterns in California}, 18 | author={Sailani, M Reza and Metwally, Ahmed A and Zhou, Wenyu and Rose, Sophia Miryam Sch{\"u}ssler-Fiorenza and Ahadi, Sara and Contrepois, Kevin and Mishra, Tejaswini and Zhang, Martin Jinye and Kidzi{\'n}ski, {\L}ukasz and Chu, Theodore J and others}, 19 | journal={Nature communications}, 20 | volume={11}, 21 | number={1}, 22 | pages={1--12}, 23 | year={2020}, 24 | publisher={Nature Publishing Group} 25 | } 26 | 27 | -------------------------------------------------------------------------------- /vignettes/netOmics.R: -------------------------------------------------------------------------------- 1 | ## ----echo=FALSE--------------------------------------------------------------- 2 | knitr::opts_chunk$set(fig.align = "center") 3 | 4 | 5 | ## ----eval=FALSE--------------------------------------------------------------- 6 | ## # install the package via BioConductor 7 | ## if (!requireNamespace("BiocManager", quietly = TRUE)) 8 | ## install.packages("BiocManager") 9 | ## 10 | ## BiocManager::install("netOmics") 11 | 12 | 13 | ## ----eval=FALSE--------------------------------------------------------------- 14 | ## # install the package via github 15 | ## library(devtools) 16 | ## install_github("abodein/netOmics") 17 | 18 | 19 | ## ----eval=TRUE, message=FALSE------------------------------------------------- 20 | # load the package 21 | library(netOmics) 22 | 23 | 24 | ## ----eval=TRUE, message=FALSE------------------------------------------------- 25 | # usefull packages to build this vignette 26 | library(timeOmics) 27 | library(tidyverse) 28 | library(igraph) 29 | 30 | 31 | ## ----load_data---------------------------------------------------------------- 32 | # load data 33 | data("hmp_T2D") 34 | 35 | 36 | ## ----timeOmics_1, eval=FALSE-------------------------------------------------- 37 | ## # not evaluated in this vignette 38 | ## 39 | ## #1 filter fold-change 40 | ## remove.low.cv <- function(X, cutoff = 0.5){ 41 | ## # var.coef 42 | ## cv <- unlist(lapply(as.data.frame(X), 43 | ## function(x) abs(sd(x, na.rm = TRUE)/mean(x, na.rm= TRUE)))) 44 | ## return(X[,cv > cutoff]) 45 | ## } 46 | ## fc.threshold <- list("RNA"= 1.5, "CLINICAL"=0.2, "GUT"=1.5, "METAB"=1.5, 47 | ## "PROT" = 1.5, "CYTO" = 1) 48 | ## 49 | ## # --> hmp_T2D$raw 50 | ## data.filter <- imap(raw, ~{remove.low.cv(.x, cutoff = fc.threshold[[.y]])}) 51 | ## 52 | ## #2 scale 53 | ## data <- lapply(data.filter, function(x) log(x+1)) 54 | ## # --> hmp_T2D$data 55 | ## 56 | ## 57 | ## #3 modelling 58 | ## lmms.func <- function(X){ 59 | ## time <- rownames(X) %>% str_split("_") %>% 60 | ## map_chr(~.x[[2]]) %>% as.numeric() 61 | ## lmms.output <- lmms::lmmSpline(data = X, time = time, 62 | ## sampleID = rownames(X), deri = FALSE, 63 | ## basis = "p-spline", numCores = 4, 64 | ## keepModels = TRUE) 65 | ## return(lmms.output) 66 | ## } 67 | ## data.modelled <- lapply(data, function(x) lmms.func(x)) 68 | ## 69 | ## # 4 clustering 70 | ## block.res <- block.pls(data.modelled, indY = 1, ncomp = 1) 71 | ## getCluster.res <- getCluster(block.res) 72 | ## # --> hmp_T2D$getCluster.res 73 | ## 74 | ## 75 | ## # 5 signature 76 | ## list.keepX <- list("CLINICAL" = 4, "CYTO" = 3, "GUT" = 10, "METAB" = 3, 77 | ## "PROT" = 2,"RNA" = 34) 78 | ## sparse.block.res <- block.spls(data.modelled, indY = 1, ncomp = 1, scale =TRUE, 79 | ## keepX =list.keepX) 80 | ## getCluster.sparse.res <- getCluster(sparse.block.res) 81 | ## # --> hmp_T2D$getCluster.sparse.res 82 | 83 | 84 | ## ----timeOmics_2-------------------------------------------------------------- 85 | # clustering results 86 | cluster.info <- hmp_T2D$getCluster.res 87 | 88 | 89 | ## ----graph.rna, warning=FALSE------------------------------------------------- 90 | cluster.info.RNA <- timeOmics::getCluster(cluster.info, user.block = "RNA") 91 | graph.rna <- get_grn(X = hmp_T2D$data$RNA, cluster = cluster.info.RNA) 92 | 93 | # to get info about the network 94 | get_graph_stats(graph.rna) 95 | 96 | 97 | ## ----PROT_graph, warning=FALSE------------------------------------------------ 98 | # Utility function to get the molecules by cluster 99 | get_list_mol_cluster <- function(cluster.info, user.block){ 100 | require(timeOmics) 101 | tmp <- timeOmics::getCluster(cluster.info, user.block) 102 | res <- tmp %>% split(.$cluster) %>% 103 | lapply(function(x) x$molecule) 104 | res[["All"]] <- tmp$molecule 105 | return(res) 106 | } 107 | 108 | cluster.info.prot <- get_list_mol_cluster(cluster.info, user.block = 'PROT') 109 | graph.prot <- get_interaction_from_database(X = cluster.info.prot, 110 | db = hmp_T2D$interaction.biogrid, 111 | type = "PROT", user.ego = TRUE) 112 | # get_graph_stats(graph.prot) 113 | 114 | 115 | ## ----GUT_graph, eval = FALSE-------------------------------------------------- 116 | ## # not evaluated in this vignette 117 | ## library(SpiecEasi) 118 | ## 119 | ## get_sparcc_graph <- function(X, threshold = 0.3){ 120 | ## res.sparcc <- sparcc(data = X) 121 | ## sparcc.graph <- abs(res.sparcc$Cor) >= threshold 122 | ## colnames(sparcc.graph) <- colnames(X) 123 | ## rownames(sparcc.graph) <- colnames(X) 124 | ## res.graph <- graph_from_adjacency_matrix(sparcc.graph, 125 | ## mode = "undirected") %>% simplify 126 | ## return(res.graph) 127 | ## } 128 | ## 129 | ## gut_list <- get_list_mol_cluster(cluster.info, user.block = 'GUT') 130 | ## 131 | ## graph.gut <- list() 132 | ## graph.gut[["All"]] <- get_sparcc_graph(hmp_T2D$raw$GUT, threshold = 0.3) 133 | ## graph.gut[["1"]] <- get_sparcc_graph(hmp_T2D$raw$GUT %>% 134 | ## dplyr::select(gut_list[["1"]]), 135 | ## threshold = 0.3) 136 | ## graph.gut[["-1"]] <- get_sparcc_graph(hmp_T2D$raw$GUT %>% 137 | ## dplyr::select(gut_list[["-1"]]), 138 | ## threshold = 0.3) 139 | ## class(graph.gut) <- "list.igraph" 140 | 141 | 142 | ## ----GUT---------------------------------------------------------------------- 143 | graph.gut <- hmp_T2D$graph.gut 144 | # get_graph_stats(graph.gut) 145 | 146 | 147 | ## ----CYTO_graph, warning=FALSE------------------------------------------------ 148 | # CYTO -> from database (biogrid) 149 | cyto_list = get_list_mol_cluster(cluster.info = cluster.info, 150 | user.block = "CYTO") 151 | graph.cyto <- get_interaction_from_database(X = cyto_list, 152 | db = hmp_T2D$interaction.biogrid, 153 | type = "CYTO", user.ego = TRUE) 154 | # get_graph_stats(graph.cyto) 155 | 156 | # METAB -> inference 157 | cluster.info.metab <- timeOmics::getCluster(X = cluster.info, 158 | user.block = "METAB") 159 | graph.metab <- get_grn(X = hmp_T2D$data$METAB, 160 | cluster = cluster.info.metab) 161 | # get_graph_stats(graph.metab) 162 | 163 | # CLINICAL -> inference 164 | cluster.info.clinical <- timeOmics::getCluster(X = cluster.info, 165 | user.block = 'CLINICAL') 166 | graph.clinical <- get_grn(X = hmp_T2D$data$CLINICAL, 167 | cluster = cluster.info.clinical) 168 | # get_graph_stats(graph.clinical) 169 | 170 | 171 | ## ----merged_0----------------------------------------------------------------- 172 | full.graph <- combine_layers(graph1 = graph.rna, graph2 = graph.prot) 173 | full.graph <- combine_layers(graph1 = full.graph, graph2 = graph.cyto) 174 | 175 | full.graph <- combine_layers(graph1 = full.graph, 176 | graph2 = hmp_T2D$interaction.TF) 177 | # get_graph_stats(full.graph) 178 | 179 | 180 | ## ----merged_1_gut, warning=FALSE---------------------------------------------- 181 | all_data <- reduce(hmp_T2D$data, cbind) 182 | 183 | # omic = gut 184 | gut_list <- get_list_mol_cluster(cluster.info, user.block = "GUT") 185 | omic_data <- lapply(gut_list, function(x)dplyr::select(hmp_T2D$data$GUT, x)) 186 | 187 | # other data = "RNA", "PROT", "CYTO" 188 | other_data_list <- get_list_mol_cluster(cluster.info, 189 | user.block = c("RNA", "PROT", "CYTO")) 190 | other_data <- lapply(other_data_list, function(x)dplyr::select(all_data, x)) 191 | 192 | # get interaction between gut data and other data 193 | interaction_df_gut <- get_interaction_from_correlation(X = omic_data, 194 | Y = other_data, 195 | threshold = 0.99) 196 | 197 | # and merge with full graph 198 | full.graph <- combine_layers(graph1 = full.graph, 199 | graph2 = graph.gut, 200 | interaction.df = interaction_df_gut$All) 201 | 202 | 203 | ## ----merged_2_clinical, warning=FALSE----------------------------------------- 204 | # omic = Clinical 205 | clinical_list <- get_list_mol_cluster(cluster.info, user.block = "CLINICAL") 206 | omic_data <- lapply(clinical_list, 207 | function(x)dplyr::select(hmp_T2D$data$CLINICAL, x)) 208 | 209 | # other data = "RNA", "PROT", "CYTO", "GUT" 210 | other_data_list <- get_list_mol_cluster(cluster.info, 211 | user.block = c("RNA", "PROT", 212 | "CYTO", "GUT")) 213 | other_data <- lapply(other_data_list, function(x)dplyr::select(all_data, x)) 214 | 215 | 216 | # get interaction between gut data and other data 217 | interaction_df_clinical <- get_interaction_from_correlation(X = omic_data 218 | , Y = other_data, 219 | threshold = 0.99) 220 | 221 | # and merge with full graph 222 | full.graph <- combine_layers(graph1 = full.graph, 223 | graph2 = graph.clinical, 224 | interaction.df = interaction_df_clinical$All) 225 | 226 | 227 | ## ----merged_3_metab, warning=FALSE-------------------------------------------- 228 | # omic = Metab 229 | metab_list <- get_list_mol_cluster(cluster.info, user.block = "METAB") 230 | omic_data <- lapply(metab_list, function(x)dplyr::select(hmp_T2D$data$METAB, x)) 231 | 232 | # other data = "RNA", "PROT", "CYTO", "GUT", "CLINICAL" 233 | other_data_list <- get_list_mol_cluster(cluster.info, 234 | user.block = c("RNA", "PROT", "CYTO", 235 | "GUT", "CLINICAL")) 236 | other_data <- lapply(other_data_list, function(x)dplyr::select(all_data, x)) 237 | 238 | # get interaction between gut data and other data 239 | interaction_df_metab <- get_interaction_from_correlation(X = omic_data, 240 | Y = other_data, 241 | threshold = 0.99) 242 | 243 | # and merge with full graph 244 | full.graph <- combine_layers(graph1 = full.graph, 245 | graph2 = graph.metab, 246 | interaction.df = interaction_df_metab$All) 247 | 248 | 249 | ## ----------------------------------------------------------------------------- 250 | # ORA by cluster/All 251 | mol_ora <- get_list_mol_cluster(cluster.info, 252 | user.block = c("RNA", "PROT", "CYTO")) 253 | 254 | # get ORA interaction graph by cluster 255 | graph.go <- get_interaction_from_ORA(query = mol_ora, 256 | sources = "GO", 257 | organism = "hsapiens", 258 | signif.value = TRUE) 259 | 260 | # merge 261 | full.graph <- combine_layers(graph1 = full.graph, graph2 = graph.go) 262 | 263 | 264 | ## ----------------------------------------------------------------------------- 265 | # medlineRanker -> database 266 | medlineranker.res.df <- hmp_T2D$medlineranker.res.df %>% 267 | dplyr::select(Disease, symbol) %>% 268 | set_names(c("from", "to")) 269 | 270 | mol_list <- get_list_mol_cluster(cluster.info = cluster.info, 271 | user.block = c("RNA", "PROT", "CYTO")) 272 | graph.medlineranker <- get_interaction_from_database(X = mol_list, 273 | db = medlineranker.res.df, 274 | type = "Disease", 275 | user.ego = TRUE) 276 | # get_graph_stats(graph.medlineranker) 277 | 278 | # merging 279 | full.graph <- combine_layers(graph1 = full.graph, graph2 = graph.medlineranker) 280 | 281 | 282 | ## ----------------------------------------------------------------------------- 283 | # graph cleaning 284 | graph_cleaning <- function(X, cluster.info){ 285 | # no reusability 286 | X <- igraph::simplify(X) 287 | va <- vertex_attr(X) 288 | viewed_mol <- c() 289 | for(omic in unique(cluster.info$block)){ 290 | mol <- intersect(cluster.info %>% dplyr::filter(.$block == omic) %>% 291 | pull(molecule), V(X)$name) 292 | viewed_mol <- c(viewed_mol, mol) 293 | X <- set_vertex_attr(graph = X, 294 | name = "type", 295 | index = mol, 296 | value = omic) 297 | X <- set_vertex_attr(graph = X, 298 | name = "mode", 299 | index = mol, 300 | value = "core") 301 | } 302 | # add medline ranker and go 303 | mol <- intersect(map(graph.go, ~ as_data_frame(.x)$to) %>% 304 | unlist %>% unique(), V(X)$name) # only GO terms 305 | viewed_mol <- c(viewed_mol, mol) 306 | X <- set_vertex_attr(graph = X, name = "type", index = mol, value = "GO") 307 | X <- set_vertex_attr(graph = X, name = "mode", 308 | index = mol, value = "extended") 309 | 310 | mol <- intersect(as.character(medlineranker.res.df$from), V(X)$name) 311 | viewed_mol <- c(viewed_mol, mol) 312 | X <- set_vertex_attr(graph = X, name = "type", 313 | index = mol, value = "Disease") 314 | X <- set_vertex_attr(graph = X, name = "mode", 315 | index = mol, value = "extended") 316 | 317 | other_mol <- setdiff(V(X), viewed_mol) 318 | if(!is_empty(other_mol)){ 319 | X <- set_vertex_attr(graph = X, name = "mode", 320 | index = other_mol, value = "extended") 321 | } 322 | X <- set_vertex_attr(graph = X, name = "mode", 323 | index = intersect(cluster.info$molecule, V(X)$name), 324 | value = "core") 325 | 326 | # signature 327 | mol <- intersect(V(X)$name, hmp_T2D$getCluster.sparse.res$molecule) 328 | X <- set_vertex_attr(graph = X, name = "sparse", index = mol, value = TRUE) 329 | mol <- setdiff(V(X)$name, hmp_T2D$getCluster.sparse.res$molecule) 330 | X <- set_vertex_attr(graph = X, name = "sparse", index = mol, value = FALSE) 331 | 332 | return(X) 333 | } 334 | 335 | 336 | ## ----------------------------------------------------------------------------- 337 | FULL <- lapply(full.graph, function(x) graph_cleaning(x, cluster.info)) 338 | get_graph_stats(FULL) 339 | 340 | 341 | ## ----eval = FALSE------------------------------------------------------------- 342 | ## # degree analysis 343 | ## d <- degree(FULL$All) 344 | ## hist(d) 345 | ## d[max(d)] 346 | ## 347 | ## # modularity # Warnings: can take several minutes 348 | ## res.mod <- walktrap.community(FULL$All) 349 | ## # ... 350 | ## 351 | ## # modularity 352 | ## sp <- shortest.paths(FULL$All) 353 | 354 | 355 | ## ----------------------------------------------------------------------------- 356 | # seeds = all vertices -> takes 5 minutes to run on regular computer 357 | # seeds <- V(FULL$All)$name 358 | # rwr_res <- random_walk_restart(FULL, seeds) 359 | 360 | # seed = some GO terms 361 | seeds <- head(V(FULL$All)$name[V(FULL$All)$type == "GO"]) 362 | rwr_res <- random_walk_restart(FULL, seeds) 363 | 364 | 365 | ## ----------------------------------------------------------------------------- 366 | rwr_type_k15 <- rwr_find_seeds_between_attributes(X = rwr_res, 367 | attribute = "type", k = 15) 368 | 369 | # a summary plot function 370 | summary_plot_rwr_attributes(rwr_type_k15) 371 | summary_plot_rwr_attributes(rwr_type_k15$All) 372 | 373 | 374 | ## ----------------------------------------------------------------------------- 375 | rwr_type_k15 <- rwr_find_seeds_between_attributes(X = rwr_res$All, 376 | attribute = "cluster", k = 15) 377 | summary_plot_rwr_attributes(rwr_type_k15) 378 | 379 | 380 | ## ----------------------------------------------------------------------------- 381 | sub_res <- rwr_type_k15$`GO:0005737` 382 | sub <- plot_rwr_subnetwork(sub_res, legend = TRUE, plot = TRUE) 383 | 384 | 385 | ## ----------------------------------------------------------------------------- 386 | rwr_res <- random_walk_restart(FULL$All, seed = "ZNF263") 387 | 388 | # closest GO term 389 | rwr_find_closest_type(rwr_res, seed = "ZNF263", attribute = "type", 390 | value = "GO", top = 5) 391 | 392 | # closest Disease 393 | rwr_find_closest_type(rwr_res, seed = "ZNF263", attribute = "type", 394 | value = "Disease", top = 5) 395 | 396 | # closest nodes with an attribute "cluster" and the value "-1" 397 | rwr_find_closest_type(rwr_res, seed = "ZNF263", attribute = "cluster", 398 | value = "-1", top = 5) 399 | 400 | 401 | ## ----eval = FALSE------------------------------------------------------------- 402 | ## seeds <- V(FULL$All)$name[V(FULL$All)$type %in% c("GO", "Disease")] 403 | 404 | 405 | ## ----------------------------------------------------------------------------- 406 | sessionInfo() 407 | 408 | -------------------------------------------------------------------------------- /vignettes/netOmics.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "netOmics" 3 | author: 4 | - name: "Antoine Bodein" 5 | affiliation: "CHU de Québec Research Center, Université Laval, Molecular Medicine department, Québec, QC, Canada" 6 | email: "antoine.bodein.1@ulaval.ca" 7 | - name: "Marie-Pier Scott-Boyer" 8 | affiliation: "CHU de Québec Research Center, Université Laval, Molecular Medicine department, Québec, QC, Canada" 9 | - name: "Olivier Perin" 10 | affiliation: "Digital Sciences Department, L’Oréal Advanced Research, Aulnay-sous-bois, France" 11 | - name: "Kim-Anh Lê Cao" 12 | affiliation: "Melbourne Integrative Genomics, School of Mathematics and Statistics, University of Melbourne, Melbourne, VIC, Australia" 13 | - name: "Arnaud Droit" 14 | affiliation: "CHU de Québec Research Center, Université Laval, Molecular Medicine department, Québec, QC, Canada" 15 | package: netOmics 16 | output: 17 | BiocStyle::html_document 18 | 19 | vignette: > 20 | %\VignetteIndexEntry{netOmics} 21 | %\VignetteEngine{knitr::rmarkdown} 22 | %\VignetteEncoding{UTF-8} 23 | 24 | bibliography: ["mybib.bib"] 25 | biblio-style: apalike 26 | link-citations: true 27 | --- 28 | 29 | ```{r, echo=FALSE} 30 | knitr::opts_chunk$set(fig.align = "center") 31 | ``` 32 | 33 | 34 | The emergence of multi-omics data enabled the development of 35 | integration methods. 36 | 37 | With netOmics, we go beyond integration by introducing an interpretation tool. 38 | netOmics is a package for the creation and exploration of multi-omics networks. 39 | 40 | Depending on the provided dataset, it allows to create inference networks from 41 | expression data but also interaction networks from knowledge databases. 42 | After merging the sub-networks to obtain a global multi-omics network, 43 | we propose network exploration methods using propoagation techniques to perform 44 | functional prediction or identification of molecular mechanisms. 45 | 46 | Furthermore, the package has been developed for longitudinal multi-omics data 47 | and can be used in conjunction with our previously published package timeOmics. 48 | 49 | ![Overview](./img/netomics_overview.png) 50 | 51 | For more informnation about the method, please check [@bodein2020interpretation] 52 | 53 | In this vignette, we introduced a case study which depict the main steps to 54 | create and explore multi-omics networks from multi-omics time-course data. 55 | 56 | # Requirements 57 | 58 | ```{r,eval=FALSE} 59 | # install the package via BioConductor 60 | if (!requireNamespace("BiocManager", quietly = TRUE)) 61 | install.packages("BiocManager") 62 | 63 | BiocManager::install("netOmics") 64 | ``` 65 | 66 | ```{r,eval=FALSE} 67 | # install the package via github 68 | library(devtools) 69 | install_github("abodein/netOmics") 70 | ``` 71 | 72 | 73 | ```{r, eval=TRUE, message=FALSE} 74 | # load the package 75 | library(netOmics) 76 | ``` 77 | 78 | 79 | ```{r, eval=TRUE, message=FALSE} 80 | # usefull packages to build this vignette 81 | library(timeOmics) 82 | library(tidyverse) 83 | library(igraph) 84 | ``` 85 | 86 | # Case Study: Human Microbiome Project T2D 87 | 88 | The package will be illustrated on longitudinal MO dataset to study 89 | the seasonality of MO expression in patients with diabetes [@sailani2020deep]. 90 | 91 | The data used in this vignette is a subset of the data available at: 92 | https://github.com/aametwally/ipop_seasonal 93 | 94 | We focused on a single individual with 7 timepoints. 95 | 6 different omics were sampled 96 | (RNA, proteins, cytokines, gut microbiome, metabolites and clinical variables). 97 | 98 | ```{r load_data} 99 | # load data 100 | data("hmp_T2D") 101 | ``` 102 | 103 | 104 | # (optional: *timeOmics* analysis) 105 | 106 | The first step of the analysis is the preprocessing and longitudinal clustering. 107 | This step is carried out with timeOmics and should be reserved for longitudinal 108 | data. 109 | 110 | It ensures that the time profiles are classified into groups of similar profiles 111 | so each MO molecule is labbeled with its cluster. 112 | 113 | In addition, timeOmics can identify a multi-omics signature of the clusters. 114 | These molecules can be, for example, the starting points of the propogation 115 | analysis. 116 | 117 | For more informations about *timeOmics*, please 118 | check http://www.bioconductor.org/packages/release/bioc/html/timeOmics.html 119 | 120 | As illustrated in the R chunk below the timeOmics step includes: 121 | 122 | * omic-specific preprocessing and longitudinal fold-change filtering 123 | * modelling of expression profiles 124 | * clustering of MO expression profiles 125 | * signature identification by cluster 126 | 127 | ```{r timeOmics_1, eval=FALSE} 128 | # not evaluated in this vignette 129 | 130 | #1 filter fold-change 131 | remove.low.cv <- function(X, cutoff = 0.5){ 132 | # var.coef 133 | cv <- unlist(lapply(as.data.frame(X), 134 | function(x) abs(sd(x, na.rm = TRUE)/mean(x, na.rm= TRUE)))) 135 | return(X[,cv > cutoff]) 136 | } 137 | fc.threshold <- list("RNA"= 1.5, "CLINICAL"=0.2, "GUT"=1.5, "METAB"=1.5, 138 | "PROT" = 1.5, "CYTO" = 1) 139 | 140 | # --> hmp_T2D$raw 141 | data.filter <- imap(raw, ~{remove.low.cv(.x, cutoff = fc.threshold[[.y]])}) 142 | 143 | #2 scale 144 | data <- lapply(data.filter, function(x) log(x+1)) 145 | # --> hmp_T2D$data 146 | 147 | 148 | #3 modelling 149 | lmms.func <- function(X){ 150 | time <- rownames(X) %>% str_split("_") %>% 151 | map_chr(~.x[[2]]) %>% as.numeric() 152 | lmms.output <- lmms::lmmSpline(data = X, time = time, 153 | sampleID = rownames(X), deri = FALSE, 154 | basis = "p-spline", numCores = 4, 155 | keepModels = TRUE) 156 | return(lmms.output) 157 | } 158 | data.modelled <- lapply(data, function(x) lmms.func(x)) 159 | 160 | # 4 clustering 161 | block.res <- block.pls(data.modelled, indY = 1, ncomp = 1) 162 | getCluster.res <- getCluster(block.res) 163 | # --> hmp_T2D$getCluster.res 164 | 165 | 166 | # 5 signature 167 | list.keepX <- list("CLINICAL" = 4, "CYTO" = 3, "GUT" = 10, "METAB" = 3, 168 | "PROT" = 2,"RNA" = 34) 169 | sparse.block.res <- block.spls(data.modelled, indY = 1, ncomp = 1, scale =TRUE, 170 | keepX =list.keepX) 171 | getCluster.sparse.res <- getCluster(sparse.block.res) 172 | # --> hmp_T2D$getCluster.sparse.res 173 | ``` 174 | 175 | timeOmics resulted in 2 clusters, labelled `1` and `-1` 176 | 177 | ```{r timeOmics_2} 178 | # clustering results 179 | cluster.info <- hmp_T2D$getCluster.res 180 | ``` 181 | 182 | # Network building 183 | 184 | Each layer of the network is built sequentially and then assembled 185 | in a second section. 186 | 187 | All the functions in the package can be used on one element or a list of 188 | elements. 189 | In the longitudinal context of the data, kinetic cluster sub-networks are built 190 | plus a global network 191 | (`1`, `-1` and `All`). 192 | 193 | ## Inference Network 194 | 195 | Multi-omics network building starts with a first layer of gene. 196 | Currently, the ARACNe algorithm handles the inference but we will include more 197 | algorithms in the future. 198 | 199 | The function `get_grn` return a Gene Regulatory Network from gene expression 200 | data. 201 | Optionally, the user can provide a timeOmics clustering result (`?getCluster`) 202 | to get cluster specific sub-networks. In this case study, this will 203 | automatically build the networks (`1`, `-1` and `All`), as indicated previously. 204 | 205 | The `get_graph_stats` function provides basic graph statistics such as the 206 | number of vertices and edges. 207 | If the vertices have different attributes, it also includes a summary of these. 208 | 209 | ```{r graph.rna, warning=FALSE} 210 | cluster.info.RNA <- timeOmics::getCluster(cluster.info, user.block = "RNA") 211 | graph.rna <- get_grn(X = hmp_T2D$data$RNA, cluster = cluster.info.RNA) 212 | 213 | # to get info about the network 214 | get_graph_stats(graph.rna) 215 | ``` 216 | 217 | ## Interaction from databases 218 | 219 | As for the genes, the second layer is a protein layer (Protein-Protein 220 | Interaction). 221 | This time, no inference is performed. Instead, known interactions are extracted 222 | from a database of interaction (BIOGRID). 223 | 224 | The function `get_interaction_from_database` will fetch the interactions from a 225 | database provided as a `data.frame` (with columns `from` and `to`) or a graph 226 | (`igraph` object). 227 | In addition to the interactions between the indicated molecules, the first 228 | degree neighbors can also be collected (option `user.ego = TRUE`) 229 | 230 | 231 | ```{r PROT_graph, warning=FALSE} 232 | # Utility function to get the molecules by cluster 233 | get_list_mol_cluster <- function(cluster.info, user.block){ 234 | require(timeOmics) 235 | tmp <- timeOmics::getCluster(cluster.info, user.block) 236 | res <- tmp %>% split(.$cluster) %>% 237 | lapply(function(x) x$molecule) 238 | res[["All"]] <- tmp$molecule 239 | return(res) 240 | } 241 | 242 | cluster.info.prot <- get_list_mol_cluster(cluster.info, user.block = 'PROT') 243 | graph.prot <- get_interaction_from_database(X = cluster.info.prot, 244 | db = hmp_T2D$interaction.biogrid, 245 | type = "PROT", user.ego = TRUE) 246 | # get_graph_stats(graph.prot) 247 | ``` 248 | 249 | In this example, only a subset of the Biogrid database is used 250 | (matching elements). 251 | 252 | ## Other inference methods 253 | 254 | Another way to compute networks from expression data is to use other inference 255 | methods. 256 | In the following chunk, we intend to illustrate the use of the SparCC algorithm 257 | [@friedman2012inferring] on the gut data and how it can be integrate into the 258 | pipeline. 259 | (sparcc is not included in this package) 260 | 261 | 262 | ```{r GUT_graph, eval = FALSE} 263 | # not evaluated in this vignette 264 | library(SpiecEasi) 265 | 266 | get_sparcc_graph <- function(X, threshold = 0.3){ 267 | res.sparcc <- sparcc(data = X) 268 | sparcc.graph <- abs(res.sparcc$Cor) >= threshold 269 | colnames(sparcc.graph) <- colnames(X) 270 | rownames(sparcc.graph) <- colnames(X) 271 | res.graph <- graph_from_adjacency_matrix(sparcc.graph, 272 | mode = "undirected") %>% simplify 273 | return(res.graph) 274 | } 275 | 276 | gut_list <- get_list_mol_cluster(cluster.info, user.block = 'GUT') 277 | 278 | graph.gut <- list() 279 | graph.gut[["All"]] <- get_sparcc_graph(hmp_T2D$raw$GUT, threshold = 0.3) 280 | graph.gut[["1"]] <- get_sparcc_graph(hmp_T2D$raw$GUT %>% 281 | dplyr::select(gut_list[["1"]]), 282 | threshold = 0.3) 283 | graph.gut[["-1"]] <- get_sparcc_graph(hmp_T2D$raw$GUT %>% 284 | dplyr::select(gut_list[["-1"]]), 285 | threshold = 0.3) 286 | class(graph.gut) <- "list.igraph" 287 | ``` 288 | 289 | ```{r GUT} 290 | graph.gut <- hmp_T2D$graph.gut 291 | # get_graph_stats(graph.gut) 292 | ``` 293 | 294 | ## Other examples 295 | 296 | For this case study, we complete this first step of network building with the 297 | missing layers. 298 | 299 | ```{r CYTO_graph, warning=FALSE} 300 | # CYTO -> from database (biogrid) 301 | cyto_list = get_list_mol_cluster(cluster.info = cluster.info, 302 | user.block = "CYTO") 303 | graph.cyto <- get_interaction_from_database(X = cyto_list, 304 | db = hmp_T2D$interaction.biogrid, 305 | type = "CYTO", user.ego = TRUE) 306 | # get_graph_stats(graph.cyto) 307 | 308 | # METAB -> inference 309 | cluster.info.metab <- timeOmics::getCluster(X = cluster.info, 310 | user.block = "METAB") 311 | graph.metab <- get_grn(X = hmp_T2D$data$METAB, 312 | cluster = cluster.info.metab) 313 | # get_graph_stats(graph.metab) 314 | 315 | # CLINICAL -> inference 316 | cluster.info.clinical <- timeOmics::getCluster(X = cluster.info, 317 | user.block = 'CLINICAL') 318 | graph.clinical <- get_grn(X = hmp_T2D$data$CLINICAL, 319 | cluster = cluster.info.clinical) 320 | # get_graph_stats(graph.clinical) 321 | ``` 322 | 323 | # Layer merging 324 | 325 | We included 2 types of layer merging: 326 | 327 | * *merging with interactions* uses the shared elements between 2 graphs to build 328 | a larger network. 329 | * *merging with correlations* uses the spearman correlation from expression 330 | profiles between 2 layers when any interaction is known. 331 | 332 | 333 | ## Merging with interactions 334 | 335 | The function `combine_layers` enables the fusion of different network layers. 336 | It combines the network (or list of network) in `graph1` with the network 337 | (or list of network) in `graph2`, based on the shared vertices between 338 | the networks. 339 | 340 | Additionally, the user can provide an interaction table `interaction.df` 341 | (in the form of a data.frame or igraph object). 342 | 343 | In the following chunk, we sequentially merge RNA, PROT and CYTO layers and uses 344 | the TFome information (TF protein -> Target Gene) to connect these layers. 345 | 346 | ```{r, merged_0} 347 | full.graph <- combine_layers(graph1 = graph.rna, graph2 = graph.prot) 348 | full.graph <- combine_layers(graph1 = full.graph, graph2 = graph.cyto) 349 | 350 | full.graph <- combine_layers(graph1 = full.graph, 351 | graph2 = hmp_T2D$interaction.TF) 352 | # get_graph_stats(full.graph) 353 | ``` 354 | 355 | ## Merging with correlations 356 | 357 | To connect omics layers for which no interaction information is available, 358 | we propose to use a threshold on the correlation between the expression profiles 359 | of two or more omics data. 360 | 361 | The strategy is as follows: we isolate the omics from the data and calculate 362 | the correlations between this omics and the other data. 363 | 364 | ```{r merged_1_gut, warning=FALSE} 365 | all_data <- reduce(hmp_T2D$data, cbind) 366 | 367 | # omic = gut 368 | gut_list <- get_list_mol_cluster(cluster.info, user.block = "GUT") 369 | omic_data <- lapply(gut_list, function(x)dplyr::select(hmp_T2D$data$GUT, x)) 370 | 371 | # other data = "RNA", "PROT", "CYTO" 372 | other_data_list <- get_list_mol_cluster(cluster.info, 373 | user.block = c("RNA", "PROT", "CYTO")) 374 | other_data <- lapply(other_data_list, function(x)dplyr::select(all_data, x)) 375 | 376 | # get interaction between gut data and other data 377 | interaction_df_gut <- get_interaction_from_correlation(X = omic_data, 378 | Y = other_data, 379 | threshold = 0.99) 380 | 381 | # and merge with full graph 382 | full.graph <- combine_layers(graph1 = full.graph, 383 | graph2 = hmp_T2D$graph.gut, 384 | interaction.df = interaction_df_gut$All) 385 | ``` 386 | 387 | 388 | ```{r, merged_2_clinical, warning=FALSE} 389 | # omic = Clinical 390 | clinical_list <- get_list_mol_cluster(cluster.info, user.block = "CLINICAL") 391 | omic_data <- lapply(clinical_list, 392 | function(x)dplyr::select(hmp_T2D$data$CLINICAL, x)) 393 | 394 | # other data = "RNA", "PROT", "CYTO", "GUT" 395 | other_data_list <- get_list_mol_cluster(cluster.info, 396 | user.block = c("RNA", "PROT", 397 | "CYTO", "GUT")) 398 | other_data <- lapply(other_data_list, function(x)dplyr::select(all_data, x)) 399 | 400 | 401 | # get interaction between gut data and other data 402 | interaction_df_clinical <- get_interaction_from_correlation(X = omic_data 403 | , Y = other_data, 404 | threshold = 0.99) 405 | 406 | # and merge with full graph 407 | full.graph <- combine_layers(graph1 = full.graph, 408 | graph2 = hmp_T2D$graph.clinical, 409 | interaction.df = interaction_df_clinical$All) 410 | ``` 411 | 412 | 413 | ```{r, merged_3_metab, warning=FALSE} 414 | # omic = Metab 415 | metab_list <- get_list_mol_cluster(cluster.info, user.block = "METAB") 416 | omic_data <- lapply(metab_list, function(x)dplyr::select(hmp_T2D$data$METAB, x)) 417 | 418 | # other data = "RNA", "PROT", "CYTO", "GUT", "CLINICAL" 419 | other_data_list <- get_list_mol_cluster(cluster.info, 420 | user.block = c("RNA", "PROT", "CYTO", 421 | "GUT", "CLINICAL")) 422 | other_data <- lapply(other_data_list, function(x)dplyr::select(all_data, x)) 423 | 424 | # get interaction between gut data and other data 425 | interaction_df_metab <- get_interaction_from_correlation(X = omic_data, 426 | Y = other_data, 427 | threshold = 0.99) 428 | 429 | # and merge with full graph 430 | full.graph <- combine_layers(graph1 = full.graph, 431 | graph2 = graph.metab, 432 | interaction.df = interaction_df_metab$All) 433 | ``` 434 | 435 | # Addition of supplemental layers 436 | 437 | For the interpretation of the MO integration results, the use of additional 438 | information layers or molecules can be useful to enrich the network. 439 | 440 | ## Over Representation Analysis 441 | 442 | ORA is a common step to include knowledge. 443 | The function `get_interaction_from_ORA` perform the ORA analysis from the 444 | desired molecules and return an interaction graph with the enriched terms and 445 | the corresponding molecules. 446 | 447 | Then, the interaction graph with the new vertices can be linked to the network 448 | as illustrated in the previous step. 449 | 450 | Here, ORA was performed with RNA, PROT, and CYTO against the Gene Ontology. 451 | 452 | ```{r} 453 | # ORA by cluster/All 454 | mol_ora <- get_list_mol_cluster(cluster.info, 455 | user.block = c("RNA", "PROT", "CYTO")) 456 | 457 | # get ORA interaction graph by cluster 458 | graph.go <- get_interaction_from_ORA(query = mol_ora, 459 | sources = "GO", 460 | organism = "hsapiens", 461 | signif.value = TRUE) 462 | 463 | # merge 464 | full.graph <- combine_layers(graph1 = full.graph, graph2 = graph.go) 465 | ``` 466 | 467 | ## External knowledge 468 | 469 | Additionally, knowledge from external sources can be included in the network. 470 | 471 | In the following chunk, we performed disease-related gene enrichment analysis 472 | from *medlineRanker* (http://cbdm-01.zdv.uni-mainz.de/~jfontain/cms/?page_id=4). 473 | We converted the results into a data.frame (with the columns `from` and `to`) 474 | and this acted as an interaction database. 475 | 476 | ```{r} 477 | # medlineRanker -> database 478 | medlineranker.res.df <- hmp_T2D$medlineranker.res.df %>% 479 | dplyr::select(Disease, symbol) %>% 480 | set_names(c("from", "to")) 481 | 482 | mol_list <- get_list_mol_cluster(cluster.info = cluster.info, 483 | user.block = c("RNA", "PROT", "CYTO")) 484 | graph.medlineranker <- get_interaction_from_database(X = mol_list, 485 | db = medlineranker.res.df, 486 | type = "Disease", 487 | user.ego = TRUE) 488 | # get_graph_stats(graph.medlineranker) 489 | 490 | # merging 491 | full.graph <- combine_layers(graph1 = full.graph, graph2 = graph.medlineranker) 492 | ``` 493 | 494 | We complete the MO network preparation with attribute cleaning and addition of 495 | several attributes such as: 496 | 497 | * mode = "core" if the vertex was originally present in the data; "extended" 498 | otherwise 499 | * sparse = TRUE if the vertex was present in kinetic cluster signature; FALSE 500 | otherwise 501 | * type = type of omics ("RNA","PROT","CLINICAL","CYTO","GUT","METAB","GO", 502 | "Disease") 503 | * cluster = '1', '-1' or 'NA' (for vertices not originally present in the 504 | original data) 505 | 506 | ```{r} 507 | # graph cleaning 508 | graph_cleaning <- function(X, cluster.info){ 509 | # no reusability 510 | X <- igraph::simplify(X) 511 | va <- vertex_attr(X) 512 | viewed_mol <- c() 513 | for(omic in unique(cluster.info$block)){ 514 | mol <- intersect(cluster.info %>% dplyr::filter(.$block == omic) %>% 515 | pull(molecule), V(X)$name) 516 | viewed_mol <- c(viewed_mol, mol) 517 | X <- set_vertex_attr(graph = X, 518 | name = "type", 519 | index = mol, 520 | value = omic) 521 | X <- set_vertex_attr(graph = X, 522 | name = "mode", 523 | index = mol, 524 | value = "core") 525 | } 526 | # add medline ranker and go 527 | mol <- intersect(map(graph.go, ~ as_data_frame(.x)$to) %>% 528 | unlist %>% unique(), V(X)$name) # only GO terms 529 | viewed_mol <- c(viewed_mol, mol) 530 | X <- set_vertex_attr(graph = X, name = "type", index = mol, value = "GO") 531 | X <- set_vertex_attr(graph = X, name = "mode", 532 | index = mol, value = "extended") 533 | 534 | mol <- intersect(as.character(medlineranker.res.df$from), V(X)$name) 535 | viewed_mol <- c(viewed_mol, mol) 536 | X <- set_vertex_attr(graph = X, name = "type", 537 | index = mol, value = "Disease") 538 | X <- set_vertex_attr(graph = X, name = "mode", 539 | index = mol, value = "extended") 540 | 541 | other_mol <- setdiff(V(X), viewed_mol) 542 | if(!is_empty(other_mol)){ 543 | X <- set_vertex_attr(graph = X, name = "mode", 544 | index = other_mol, value = "extended") 545 | } 546 | X <- set_vertex_attr(graph = X, name = "mode", 547 | index = intersect(cluster.info$molecule, V(X)$name), 548 | value = "core") 549 | 550 | # signature 551 | mol <- intersect(V(X)$name, hmp_T2D$getCluster.sparse.res$molecule) 552 | X <- set_vertex_attr(graph = X, name = "sparse", index = mol, value = TRUE) 553 | mol <- setdiff(V(X)$name, hmp_T2D$getCluster.sparse.res$molecule) 554 | X <- set_vertex_attr(graph = X, name = "sparse", index = mol, value = FALSE) 555 | 556 | return(X) 557 | } 558 | ``` 559 | 560 | 561 | ```{r} 562 | FULL <- lapply(full.graph, function(x) graph_cleaning(x, cluster.info)) 563 | get_graph_stats(FULL) 564 | ``` 565 | 566 | # Network exploration 567 | 568 | ## Basics network exploration 569 | 570 | We can use basic graph statistics to explore the network such as degree 571 | distribution, modularity, and short path. 572 | 573 | ```{r, eval = FALSE} 574 | # degree analysis 575 | d <- degree(FULL$All) 576 | hist(d) 577 | d[max(d)] 578 | 579 | # modularity # Warnings: can take several minutes 580 | res.mod <- walktrap.community(FULL$All) 581 | # ... 582 | 583 | # modularity 584 | sp <- shortest.paths(FULL$All) 585 | ``` 586 | 587 | ## Random walk with restart 588 | 589 | RWR is a powerful tool to explore the MO networks which simulates a particle 590 | that randomly walk on the network. 591 | From a starting point (`seed`) it ranks the other vertices based on their 592 | proximity with the seed and the network structure. 593 | 594 | We use RWR for function prediction and molecular mechanism identification. 595 | 596 | In the example below, the seeds were the GO terms vertices. 597 | 598 | ```{r} 599 | # seeds = all vertices -> takes 5 minutes to run on regular computer 600 | # seeds <- V(FULL$All)$name 601 | # rwr_res <- random_walk_restart(FULL, seeds) 602 | 603 | # seed = some GO terms 604 | seeds <- head(V(FULL$All)$name[V(FULL$All)$type == "GO"]) 605 | rwr_res <- random_walk_restart(FULL, seeds) 606 | ``` 607 | 608 | ### Find vertices with specific attributes 609 | 610 | After the RWR analysis, we implemented several functions to extract valuable 611 | information. 612 | 613 | To identify MO molecular functions, the seed can be a GO term and we are 614 | interested to identify vertices with different omics type within the 615 | closest nodes. 616 | 617 | The function `rwr_find_seeds_between_attributes` can identify which seeds were 618 | able to reach vertices with different attributes (ex: `type`) within the 619 | closest `k` (ex: `15`) vertices. 620 | 621 | The function `summary_plot_rwr_attributes` displays the number of different 622 | values for a seed attribute as a bar graph. 623 | 624 | ```{r} 625 | rwr_type_k15 <- rwr_find_seeds_between_attributes(X = rwr_res, 626 | attribute = "type", k = 15) 627 | 628 | # a summary plot function 629 | summary_plot_rwr_attributes(rwr_type_k15) 630 | summary_plot_rwr_attributes(rwr_type_k15$All) 631 | ``` 632 | 633 | Alternatively, we can be interested to find functions or molecules which 634 | link different kinetic cluster (to find regulatory mechanisms). 635 | 636 | ```{r} 637 | rwr_type_k15 <- rwr_find_seeds_between_attributes(X = rwr_res$All, 638 | attribute = "cluster", k = 15) 639 | summary_plot_rwr_attributes(rwr_type_k15) 640 | ``` 641 | 642 | A RWR subnetworks can also be displayed with `plot_rwr_subnetwork` 643 | from a specific seed. 644 | ```{r} 645 | sub_res <- rwr_type_k15$`GO:0005737` 646 | sub <- plot_rwr_subnetwork(sub_res, legend = TRUE, plot = TRUE) 647 | ``` 648 | 649 | ### Function prediction 650 | 651 | Finally, RWR can also be used for function prediction. 652 | From an annotated genes, the predicted function can be the closest vertex of the 653 | type "GO". 654 | 655 | We generalized this principle to identify, from a seed of interest, the closest 656 | node (or `top` closest nodes) with specific attributes and value. 657 | 658 | In the example below, the gene "ZNF263" is linked to the 5 closest nodes of 659 | type = 'GO' and type = 'Disease'. 660 | 661 | ```{r} 662 | rwr_res <- random_walk_restart(FULL$All, seed = "ZNF263") 663 | 664 | # closest GO term 665 | rwr_find_closest_type(rwr_res, seed = "ZNF263", attribute = "type", 666 | value = "GO", top = 5) 667 | 668 | # closest Disease 669 | rwr_find_closest_type(rwr_res, seed = "ZNF263", attribute = "type", 670 | value = "Disease", top = 5) 671 | 672 | # closest nodes with an attribute "cluster" and the value "-1" 673 | rwr_find_closest_type(rwr_res, seed = "ZNF263", attribute = "cluster", 674 | value = "-1", top = 5) 675 | ``` 676 | 677 | 678 | ```{r, eval = FALSE} 679 | seeds <- V(FULL$All)$name[V(FULL$All)$type %in% c("GO", "Disease")] 680 | ``` 681 | 682 | ```{r} 683 | sessionInfo() 684 | ``` 685 | 686 | # References --------------------------------------------------------------------------------