Merge pull request #15 from drostlab/rework

Rework

.gitignore

@@ -0,0 +1,7 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata
+.Rbuildignore
+inst/dev_test/
+*.Rproj

DESCRIPTION

@@ -1,17 +1,31 @@
 Package: edgynode
 Type: Package
-Title: Analytics of Gene Regulatory Networks
-Version: 0.1.0
+Title: Comparison of Gene Regulatory Networks
+Version: 1.0.0
 Authors@R: c(person("Hajk-Georg", "Drost", , "[email protected]", c("cre", "aut", "ctb")),
+            person("Ilias", "Moutsopoulos", , "[email protected]", c("aut", "ctb")),
             person("lmshk", "", , "", c("aut", "ctb")),
-            person("Sergio", "Vasquez", , "[email protected]", c("aut", "ctb"))
+            person("Sergio", "Vasquez", , "[email protected]", c("aut", "ctb")),
+            person("Irina", "Mohorianu", , "[email protected]", c("ctb"))
             )
 Maintainer: Hajk-Georg Drost <[email protected]>
-Description: Imports correlation matrices of gene regulatory networks inferred with different gene regulatory network inference tools such as GENIE3, GRNBoost2, LEAP, PIDC and provides data transformation and network analytics functions to statistically assess, compare and visualize imported networks.
+Description: Imports correlation matrices of gene regulatory networks inferred 
+        with different gene regulatory network inference tools. Provides data 
+        transformation and network analytics functions to statistically assess, 
+        compare and visualize networks.
 License: GPL-3
-Depends: R (>= 3.1.1)
-Imports: fs, readr, igraph, e1071, philentropy, dplyr, tidyr, ggplot2, scales, stringr, tibble, ggsci
+Depends: R (>= 4.1.0)
+Imports: fs, e1071, philentropy, ggplot2, poorman, igraph, backbone
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
-Suggests: testthat, knitr, rmarkdown
+RoxygenNote: 7.2.3
+Suggests: 
+    testthat (>= 3.0.0),
+    knitr,
+    rmarkdown,
+    ggsci,
+    tibble,
+    dplyr,
+    tidyr,
+    stringr
+Config/testthat/edition: 3

NAMESPACE

@@ -1,27 +1,31 @@
 # Generated by roxygen2: do not edit by hand
 
-export(adj_to_edge)
-export(genie)
-export(grisli)
-export(jaccard)
-export(leap)
+export(assert_adjacency)
+export(convert_adj_to_edges)
+export(convert_adj_to_igraph)
+export(convert_adj_to_matrix)
+export(convert_edges_to_adj)
+export(import_genie3)
+export(is_adjacency)
+export(is_binary)
+export(is_standard)
+export(is_symmetric)
+export(make_adjacency)
+export(make_binary)
+export(make_standard)
+export(make_symmetric)
+export(metric_dist_delta_con)
+export(metric_summary_distance)
 export(network_benchmark_noise_filtering)
-export(network_benchmark_noise_filtering_kruskal_test)
-export(network_compare)
+export(network_benchmark_noise_filtering_test)
 export(network_dist_pairwise_genes)
+export(network_filter_edges)
 export(network_make_binary)
-export(network_make_symmetric)
 export(network_rescale)
-export(network_statistics_component_distribution)
-export(network_statistics_degree_distribution)
-export(network_statistics_degree_distribution_naive)
-export(network_statistics_powerlaws)
-export(pidc)
-export(plot_network_benchmark_noise_filtering)
-export(plot_network_degree_distribution_naive)
-export(plot_network_degree_distribution_naive_comparison)
-export(plot_network_dendrogram)
-export(plot_network_weight_distribution)
-export(plot_network_weight_distribution_boxplot)
-export(plot_network_weight_distribution_violin)
 export(ppcor)
+export(summary_centrality_alpha)
+export(summary_centrality_harmonic)
+export(summary_centrality_kleinberg)
+export(summary_centrality_subgraph)
+export(summary_delta_con_similarity)
+export(summary_node_degree)

R/add_names_to_matrix.R

@@ -0,0 +1,11 @@
+add_names_to_matrix <- function(x){
+  if(is.null(rownames(x)) & is.null(colnames(x))){
+    rownames(x) <- paste0("N", seq_len(nrow(x)))
+    colnames(x) <- paste0("N", seq_len(ncol(x)))
+  }else if(is.null(rownames(x))){
+    rownames(x) <- colnames(x)
+  }else if(is.null(colnames(x))){
+    colnames(x) <- rownames(x)
+  }
+  x
+}

R/assert_adjacency.R

@@ -0,0 +1,41 @@
+#' @title Check whether a matrix fulfills the \pkg{edgynode} adjacency
+#' matrix convention
+#' @description Imports a matrix and tests whether it is an adjacency in
+#' \pkg{edgynode} format.
+#' @param x a \code{\link{matrix}} object.
+#' @return An informative error if the test fails, NULL otherwise
+#' @examples
+#' # test with an already clean adjacency matrix
+#' edgynode::assert_adjacency(edgynode::adjacency_clean_test_3)
+#'
+#' # look at raw matrix
+#' edgynode::adjacency_matrix_test_3
+#' # convert raw matrix into a edgynode adjacency matrix
+#' clean_matrix <- edgynode::make_adjacency(edgynode::adjacency_matrix_test_3)
+#' # test converted matrix
+#' edgynode::assert_adjacency(clean_matrix)
+#' @author Ilias Moutsopoulos and Hajk-Georg Drost
+#' @seealso \code{\link{make_adjacency}}, \code{\link{is_adjacency}}
+#' @export
+assert_adjacency <- function(x){
+  x_name <- deparse(substitute(x))
+  full_error_message <- function(str){
+    paste0(
+      x_name,
+      " is not an adjacency (",
+      str,
+      ").\n",
+      "  You can convert an input matrix using edgynode::make_adjacency()."
+      )
+  }
+  if(!inherits(x, "adjacency")) stop(full_error_message("not of class 'adjacency'"))
+  if(!is.matrix(x)) stop(full_error_message("not a matrix"))
+  if(nrow(x) != ncol(x)) stop(full_error_message("different # of rows and columns"))
+  if(is.null(rownames(x))) stop(full_error_message("no row names"))
+  if(is.null(colnames(x))) stop(full_error_message("no column names"))
+  if(!all(rownames(x) == colnames(x))) stop(full_error_message("row/column names don't match"))
+  if(!is.numeric(x)) stop(full_error_message("non-numeric values"))
+  if(is.null(attr(x, "known_symmetric"))) stop(full_error_message("missing known_symmetric attribute"))
+  if(is.null(attr(x, "known_binary"))) stop(full_error_message("missing known_binary attribute"))
+  invisible(NULL)
+}

R/assert_known_binary.R

@@ -0,0 +1,7 @@
+assert_known_binary <- function(adj){
+  assert_known_standard(adj)
+  if(!attr(adj, "known_binary")){
+    stop(deparse(substitute(adj)), " must be known to be binary")
+  }
+  invisible(NULL)
+}

R/assert_known_standard.R

@@ -0,0 +1,5 @@
+assert_known_standard <- function(adj){
+  assert_adjacency(adj)
+  if(!is_standard(adj)) stop(deparse(substitute(adj)), " must be in the standard format")
+  invisible(NULL)
+}

R/assert_known_symmetric.R

@@ -0,0 +1,7 @@
+assert_known_symmetric <- function(adj){
+  assert_known_standard(adj)
+  if(!attr(adj, "known_symmetric")){
+    stop(deparse(substitute(adj)), " must be known to be symmetric")
+  }
+  invisible(NULL)
+}

R/assert_same_names.R

@@ -0,0 +1,15 @@
+assert_same_names <- function(x1, x2){
+  if(is.matrix(x1) & is.matrix(x2)){
+    check <- identical(rownames(x1), rownames(x2)) & identical(colnames(x1), colnames(x2))
+  }else if(is.vector(x1) & is.vector(x2)){
+    check <- identical(names(x1), names(x2))
+  }else{
+    stop(deparse(substitute(x1)), " and ", deparse(substitute(x2)),
+         "must both be vectors or both be matrices")
+  }
+  if(!check){
+    stop(deparse(substitute(x1)), " and ", deparse(substitute(x2)),
+         " must have identical names")
+  }
+  invisible(NULL)
+}

R/collect_summary_vectors_to_df.R

@@ -0,0 +1,26 @@
+collect_summary_vectors_to_df <- function(x){
+  vec_to_df <- function(vec, id = "stat"){
+    if(is.null(names(vec))) stop("input vector(s) must be named")
+    df <- data.frame(
+      id = id,
+      name = factor(names(vec), levels = names(vec)),
+      xnum = seq_along(vec),
+      value = vec
+    )
+  }
+  if(!is.list(x)){
+    df <- vec_to_df(x)
+  }else{
+    if(is.null(names(x))) names(x) <- seq_along(x)
+    df <- data.frame()
+    vec_names <- names(x[[1]])
+    for(i in seq_along(x)){
+      vec <- x[[i]]
+      if(!identical(names(vec), vec_names)){
+        stop("all input vectors must have the same names")
+      }
+      df <- rbind(df, vec_to_df(vec, names(x)[i]))
+    }
+  }
+  df
+}

R/compare_adj_list.R

@@ -0,0 +1,12 @@
+compare_adj_list <- function(adj_list, metric = metric_summary_distance()){
+  metric_name <- deparse(substitute(metric))
+  df <- as.data.frame(t(combn(names(adj_list), 2))) |>
+    poorman::rename(adj1 = V1, adj2 = V2) |>
+    poorman::mutate(metric = factor(metric_name))
+  df[["distance"]] <- sapply(seq_len(nrow(df)), function(i){
+    adj1 <- adj_list[[df$adj1[i]]]
+    adj2 <- adj_list[[df$adj2[i]]]
+    metric(adj1, adj2)
+  })
+  df
+}

R/compare_node_degree_difference.R

@@ -0,0 +1,4 @@
+compare_node_degree_difference <- function(vec1, vec2){
+  assert_same_names(vec1, vec2)
+  vec1 - vec2
+}

R/convert_adj_to_edges.R

@@ -0,0 +1,16 @@
+#' @title Convert an adjacency matrix to an edge list
+#' @description This function takes an adjacency matrix and
+#' transforms it into an edge list
+#' @param adj the adjacency matrix
+#' @author Ilias Moutsopoulos
+#' @export
+
+convert_adj_to_edges <- function(adj){
+  add_names_to_matrix(adj)
+  data.frame(
+    from = rep(rownames(adj), times = ncol(adj)),
+    to = rep(colnames(adj), each = nrow(adj)),
+    value = as.vector(adj)
+  ) |>
+    poorman::filter(value != 0)
+}

R/convert_adj_to_igraph.R

@@ -0,0 +1,19 @@
+#' @title Convert an adjacency matrix to igraph object
+#' @description This function takes an adjacency matrix and
+#' transforms it into an igraph object
+#' @param adj the adjacency matrix
+#' @author Ilias Moutsopoulos and Sergio Vasquez
+#' @export
+
+convert_adj_to_igraph <- function(adj){
+  assert_known_standard(adj)
+  if(attr(adj, "known_binary")){
+    weighted <- NULL
+  }else{
+    weighted <- TRUE
+  }
+  igraph::graph_from_adjacency_matrix(
+    adjmatrix = adj,
+    weighted = weighted
+  )
+}

R/convert_adj_to_matrix.R

@@ -0,0 +1,14 @@
+#' @title Convert an adjacency matrix to plain matrix
+#' @description This function takes an adjacency matrix and
+#' transforms it into a plain matrix
+#' @param adj the adjacency matrix
+#' @author Ilias Moutsopoulos and Sergio Vasquez
+#' @export
+
+convert_adj_to_matrix <- function(adj){
+  assert_adjacency(adj)
+  x <- adj[]
+  attr(x, "known_symmetric") <- NULL
+  attr(x, "known_binary") <- NULL
+  x
+}

R/convert_edges_to_adj.R

@@ -0,0 +1,26 @@
+#' @title Convert an edge list to an adjacency matrix
+#' @description This function takes an edge list and
+#' transforms it into an adjacency matrix
+#' @param edges the edge list data frame, with 2 or 3 columns
+#' (from, to, value)
+#' @author Ilias Moutsopoulos
+#' @export
+
+convert_edges_to_adj <- function(edges){
+  edges <- edges_to_edges(edges)
+  rows <- unique(edges$from)
+  cols <- unique(edges$to)
+  adj <- matrix(
+    data = 0,
+    nrow = length(rows),
+    ncol = length(cols),
+    dimnames = list(rows, cols)
+  )
+  # use apply and parallelise this
+  for(k in seq_len(nrow(edges))){
+    i <- match(edges$from[k], rows)
+    j <- match(edges$to[k], cols)
+    adj[i, j] <- edges$value[k]
+  }
+  adj
+}

R/convert_edges_to_edges.R

@@ -0,0 +1,5 @@
+convert_edges_to_edges <- function(edges){
+  if(ncol(edges) == 2) edges[, 3] <- 1
+  colnames(edges)[1:3] <- c("from", "to", "value")
+  edges |> as.data.frame() |> dplyr::select(1:3)
+}

R/distance_hamming.R

@@ -0,0 +1,3 @@
+distance_hamming <- function(x, y){
+  sum(x != y)
+}

R/import_genie3.R

@@ -0,0 +1,16 @@
+#' @title Output Parser for GENIE3
+#' @description This function parses the standard output generated by the BEELINE tool GENIE3.
+#' @param filename a file path to the GENIE3 output file generated by BEELINE.
+#' @author Ilias Moutsopoulos
+#' @examples
+#' # path to GENIE3 output file
+#' genie3_output <- system.file('beeline_examples/GENIE3/outFile.csv', package = 'edgynode')
+#' # import GENIE3 specific output
+#' genie3_parsed <- import_genie3(genie3_output)
+#' # look at output
+#' head(genie3_parsed)
+#' @export
+
+import_genie3 <- function(filename) {
+  as.matrix(read.csv(filename, row.names = 1, check.names = FALSE))
+}

R/infer_binarisation_threshold.R

@@ -0,0 +1,12 @@
+infer_binarisation_threshold <- function(adj, prob = 0.95, split_by_margin = NULL){
+  # this function will be extended to other methods in the future
+  assert_known_standard(adj)
+  if(is.null(split_by_margin)){
+    threshold <- stats::quantile(as.vector(adj), probs = prob, names = FALSE)
+  }else{
+    threshold <- apply(X = adj, MARGIN = split_by_margin, FUN = function(x){
+      stats::quantile(x, probs = prob, names = FALSE)
+    })
+  }
+  threshold
+}