Merge pull request #59 from monarch-initiative/bschilder1.5.1

v1.6 with contributions from bschilder

.Rbuildignore

@@ -1,3 +1,6 @@
+vignettes/visualisation\.Rmd
+visualisation\.Rmd
+
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^LICENSE\.md$

DESCRIPTION

@@ -24,7 +24,7 @@ Encoding: UTF-8
 LazyData: true
 Config/testthat/edition: 3
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 VignetteBuilder: knitr
 Imports:
     assertthat,
@@ -50,4 +50,5 @@ Imports:
     memoise
 Suggests: 
     testthat (>= 3.0.0),
-    rworkflows
+    rworkflows,
+    Matrix

NAMESPACE

@@ -1,8 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(ancestors,tbl_kgx)
 S3method(cypher_query,neo4j_engine)
 S3method(cypher_query_df,neo4j_engine)
 S3method(cytoscape,tbl_kgx)
+S3method(descendants,tbl_kgx)
 S3method(edges,tbl_kgx)
 S3method(example_graph,file_engine)
 S3method(example_graph,neo4j_engine)
@@ -20,21 +22,32 @@ S3method(summary,file_engine)
 S3method(summary,neo4j_engine)
 export("%in_list%")
 export("%~%")
+export(ancestors)
 export(cypher_query)
 export(cypher_query_df)
 export(cytoscape)
+export(descendants)
 export(edges)
 export(example_graph)
 export(expand)
+export(expand_n)
 export(explode)
 export(fetch_nodes)
 export(file_engine)
 export(file_engine_check)
 export(get_engine)
+export(graph_centrality)
+export(graph_semsim)
+export(graph_sparsity)
+export(kg_edge_weights)
 export(kg_join)
+export(layout_umap)
 export(load_kgx)
+export(merge_lists)
+export(monarch_edge_weight_encodings)
 export(monarch_engine)
 export(monarch_engine_check)
+export(monarch_palettes)
 export(monarch_search)
 export(monarch_semsim)
 export(neo4j_engine)
@@ -44,6 +57,7 @@ export(save_kgx)
 export(set_engine)
 export(summarize_neighborhood)
 export(tbl_kgx)
+export(theme_monarch)
 import(RCy3)
 import(dplyr)
 import(ggplot2)

NEWS.md

@@ -1,9 +1,27 @@
-# monarchr 1.5.1
+# monarchr 1.6.0
+
+## New features
+
+* New utility function:
+	- `graph_semsim`
+	- `graph_centrality`
+	- `graph_sparsity`
+
+* Updated plotting functions
+	-	Overhauled `plot.tbl_kgx`
+	- New function for getting consistent Monarch palettes: `monarch_palettes`.
+	- New function to apply monarch theme to existing `ggraph` plots: `theme_monarch`
+
+* `kg_edge_weights`: New function to compute quantitative edge weights from 
+discrete and continuous edge metadata.
+
+* `expand_n`: New function to expand a graph to a specified number of nodes.
 
 ## Bug fixes
 
 * Improved the URL try order for the Monarch Neo4j API.
 
+
 # monarchr 1.5.0
 
 ## New features

R/ancestors.R

@@ -0,0 +1,23 @@
+#' Expand ancestors transitively
+#'
+#' Expand a tbl_kgx graph to include all ancestors of nodes defined transitively
+#' by "biolink:subclass_of" relationships. This is a simple wrapper around
+#' expand(predicates = "biolink:subclass_of", direction = "out", transitive = TRUE)
+#'
+#'
+#' @param g A `tbl_kgx()` graph to expand.
+#' @param ... Other parameters (unused).
+#'
+#' @return A tbl_kgx graph.
+#' @export
+#' @examples
+#' engine <- file_engine(system.file("extdata", "eds_marfan_kg.tar.gz", package = "monarchr"))
+#' g <- engine |>
+#' 	 fetch_nodes(query_ids = "MONDO:0020066") |>
+#' 	 ancestors()
+#'
+#' @import tidygraph
+#' @import dplyr
+ancestors <- function(g, ...) {
+	UseMethod("ancestors")
+}

R/ancestors.tbl_kgx.R

@@ -0,0 +1,25 @@
+#' Expand ancestors transitively
+#'
+#' Expand a tbl_kgx graph to include all ancestors of nodes defined transitively
+#' by "biolink:subclass_of" relationships. This is a simple wrapper around
+#' expand(predicates = "biolink:subclass_of", direction = "out", transitive = TRUE)
+#'
+#'
+#' @param g A `tbl_kgx()` graph to expand.
+#' @param ... Other parameters (unused).
+#'
+#' @return A tbl_kgx graph.
+#' @export
+#' @examples
+#' engine <- file_engine(system.file("extdata", "eds_marfan_kg.tar.gz", package = "monarchr"))
+#' g <- engine |>
+#' 	 fetch_nodes(query_ids = "MONDO:0020066") |>
+#' 	 ancestors()
+#'
+#' @import tidygraph
+#' @import dplyr
+ancestors.tbl_kgx <- function(g, ...) {
+	return(g |> expand(predicates = "biolink:subclass_of",
+										 direction = "out",
+										 transitive = TRUE))
+}

R/descendants.R

@@ -0,0 +1,23 @@
+#' Expand descendants transitively
+#'
+#' Expand a tbl_kgx graph to include all descendants of nodes defined transitively
+#' by "biolink:subclass_of" relationships. This is a simple wrapper around
+#' expand(predicates = "biolink:subclass_of", direction = "in", transitive = TRUE)
+#'
+#'
+#' @param g A `tbl_kgx()` graph to expand.
+#' @param ... Other parameters (unused).
+#'
+#' @return A tbl_kgx graph.
+#' @export
+#' @examples
+#' engine <- file_engine(system.file("extdata", "eds_marfan_kg.tar.gz", package = "monarchr"))
+#' g <- engine |>
+#' 	 fetch_nodes(query_ids = "MONDO:0020066") |>
+#' 	 descendants()
+#'
+#' @import tidygraph
+#' @import dplyr
+descendants <- function(g, ...) {
+	UseMethod("descendants")
+}

R/descendants.tbl_kgx.R

@@ -0,0 +1,25 @@
+#' Expand descendants transitively
+#'
+#' Expand a tbl_kgx graph to include all descendants of nodes defined transitively
+#' by "biolink:subclass_of" relationships. This is a simple wrapper around
+#' expand(predicates = "biolink:subclass_of", direction = "in", transitive = TRUE)
+#'
+#'
+#' @param g A `tbl_kgx()` graph to expand.
+#' @param ... Other parameters (unused).
+#'
+#' @return A tbl_kgx graph.
+#' @export
+#' @examples
+#' engine <- file_engine(system.file("extdata", "eds_marfan_kg.tar.gz", package = "monarchr"))
+#' g <- engine |>
+#' 	 fetch_nodes(query_ids = "MONDO:0020066") |>
+#' 	 descendants()
+#'
+#' @import tidygraph
+#' @import dplyr
+descendants.tbl_kgx <- function(g, ...) {
+	return(g |> expand(predicates = "biolink:subclass_of",
+										 direction = "in",
+										 transitive = TRUE))
+}

R/expand_n.R

@@ -0,0 +1,79 @@
+#' Iteratively fetch additional knowledge graph edges connected to a query graph
+#'
+#' Given an initialized \link{tbl_kgx} graph, iteratively expand the graph
+#' \code{n} iterations using certain predicates/categories.
+#' Arguments can either be a single value or a list of values.
+#' If an argument is provided as a list, its length must be equal to the number
+#' of iterations (\code{n}).
+#' @param return_each If TRUE, return a list of graphs for each iteration.
+#' If FALSE, return the final graph with all expanded edges.
+#' @param n Number of expansion iterations to run.
+#' @inheritParams expand
+#' @param transitive NULL (not used in this function).
+#'
+#' @return A `tbl_kgx()` graph
+#' @export
+#' @examples
+#' ## Using example KGX file packaged with monarchr
+#' filename <- system.file("extdata", "eds_marfan_kg.tar.gz", package = "monarchr")
+#' g <- file_engine(filename) |>
+#'           fetch_nodes(query_ids = "MONDO:0007525") |>
+#'           expand(predicates = "biolink:has_phenotype",
+#'                  categories = "biolink:PhenotypicFeature")
+#' g_expanded <- g |>
+#'               expand_n(predicates = "biolink:subclass_of", n=3)
+#' @import tidygraph
+#' @import dplyr
+expand_n <- function(graph,
+										 return_each = FALSE,
+										 direction = "both",
+										 predicates = NULL,
+										 categories = NULL,
+										 transitive = NULL,
+										 drop_unused_query_nodes = FALSE,
+										 n=1,
+										 ...) {
+	## Check args
+	## Check args
+	check_len <- function(arg,n,i){
+		if(is.list(arg)){
+			if(length(arg) != n){
+				stop(paste("When provided a list, arguments must be equal to n."))
+			}
+			return(arg[[i]])
+		}else{
+			return(arg)
+		}
+	}
+	if(!is.null(transitive)) {
+		warning("Arguments to expand_n() are passed on to expand(), except for transitive which is set to NULL. Ignoring provided setting for transitive in expand_n().")
+	}
+
+	## Expand graph
+	message(paste(
+		"Initial graph size:",
+		nrow(nodes(graph)),"nodes ||",nrow(edges(graph)),"edges"
+	))
+	if(return_each) graph_list <- list(iteration0=graph)
+
+	for(i in 1:n){
+		message("Expanding graph: iteration ",i,"/",n)
+		graph <- expand(graph = graph,
+										direction = check_len(direction,n,i),
+										predicates = check_len(predicates,n,i),
+										categories = check_len(categories,n,i),
+										transitive = FALSE,
+										drop_unused_query_nodes = check_len(drop_unused_query_nodes,n,i),
+										...)
+		if(return_each) graph_list[[paste0("iteration",i)]] <- graph
+		message(paste(
+			"Graph size:",
+			nrow(nodes(graph)),"nodes ||",nrow(edges(graph)),"edges"
+		))
+	}
+	if(return_each){
+		return(graph_list)
+	} else {
+		return(graph)
+	}
+}

R/graph_centrality.R

@@ -0,0 +1,31 @@
+#' Add centrality
+#'
+#' First computes of each node in a graph.
+#' Then adds the centrality score as an node attribute.
+#' @param fun The centrality function to use.
+#'  Default is \link[igraph]{harmonic_centrality}.
+#' @param col Name of the new node attribute to store the centrality score.
+#' @param ... Additional arguments passed to the centrality function
+#'  (\code{sim_fun}).
+#' @inheritParams nodes
+#' @returns Graph object with centrality added as a new node attribute.
+#' @export
+#' @examples
+#' filename <- system.file("extdata", "eds_marfan_kg.tar.gz", package = "monarchr")
+#' g <- file_engine(filename) |>
+#'           fetch_nodes(query_ids = "MONDO:0007525") |>
+#'           expand(predicates = "biolink:has_phenotype",
+#'                  categories = "biolink:PhenotypicFeature")|>
+#'           expand(categories = "biolink:Gene")
+#' g <- graph_centrality(g)
+#' nodes(g)$centrality
+graph_centrality <- function(graph,
+														 fun=igraph::harmonic_centrality,
+														 col="centrality",
+														 ...){
+	message("Computing node centrality.")
+	graph <- graph|>
+		activate(nodes)|>
+		dplyr::mutate(!!col:=fun(graph, ...))
+	return(graph)
+}

R/graph_semsim.R

@@ -0,0 +1,46 @@
+#' Add semantic similarity
+#'
+#' First computes semantic similarity between all pairs of nodes in a graph.
+#' Then adds the continuous similarity score as an edge attribute.
+#' @param fun The similarity function to use.
+#'  Default is \link[igraph]{similarity}.
+#' @param col Name of the new edge attribute to store the similarity score.
+#' @param nm The node attribute to use as the matrix row/colnames.
+#' @param return_matrix Return the similarity matrix instead of the graph.
+#' @param sparse Return a sparse matrix instead of a dense matrix.
+#' @param ... Additional arguments passed to the similarity function
+#'  (\code{fun}).
+#' @inheritParams nodes
+#' @returns Graph object with similarity added as a new edge attribute.
+#' @export
+#' @examples
+#' filename <- system.file("extdata", "eds_marfan_kg.tar.gz", package = "monarchr")
+#' g <- file_engine(filename) |>
+#'           fetch_nodes(query_ids = "MONDO:0007525") |>
+#'           expand(predicates = "biolink:has_phenotype",
+#'                  categories = "biolink:PhenotypicFeature")|>
+#'           expand(categories = "biolink:Gene")
+#' g <- graph_semsim(g)
+#' edges(g)$similarity
+graph_semsim <- function(graph,
+												 fun=igraph::similarity,
+												 col="similarity",
+												 nm="id",
+												 sparse=TRUE,
+												 return_matrix=FALSE,
+												 ...){
+	from <- to <- NULL;
+	message("Computing pairwise node similarity.")
+	X <- fun(graph, ...)
+	if(sparse) {
+		requireNamespace("Matrix")
+		X <- Matrix::Matrix(X, sparse=TRUE)
+	}
+	rownames(X) <- colnames(X) <- nodes(graph)[[nm]]
+	if(return_matrix) return(X)
+
+	graph <- graph|>
+		activate(edges)|>
+		dplyr::mutate(!!col:=purrr::map2_dbl(from, to, ~ X[.y, .x]))
+	return(graph)
+}

R/graph_sparsity.R

@@ -0,0 +1,31 @@
+#' Compute sparsity
+#'
+#' Compute sparsity (proportion of zero values) in a matrix or graph.
+#' @param x An igraph object or a (sparse) matrix.
+#' @param fun Function to convert graph to matrix.
+#' @param ... Arguments passed to \code{fun}.
+#' @returns A numeric value representing the proportion of zero
+#'	values in the graph/matrix.
+#' @export
+#' @examples
+#' ## Using example KGX file packaged with monarchr
+#' filename <- system.file("extdata", "eds_marfan_kg.tar.gz", package = "monarchr")
+#' g <- file_engine(filename) |>
+#'           fetch_nodes(query_ids = "MONDO:0007525") |>
+#'           expand(predicates = "biolink:has_phenotype",
+#'                  categories = "biolink:PhenotypicFeature")
+#'
+#' graph_sparsity(g)
+graph_sparsity <- function(x,
+										 fun=igraph::as_adjacency_matrix,
+										 ...){
+	if(is(x,"igraph")){
+		x <- fun(x)
+	}
+	if(is(x,"Matrix")||is(x,"sparseMatrix")){
+		return(sum(x==0)/length(x))
+	}
+	else{
+		stop("x must be an igraph object or a (sparse) matrix.")
+	}
+}