Merge pull request #10 from danforthcenter/replot

Replot

NAMESPACE

@@ -14,6 +14,7 @@ export(net.plot)
 export(netClust)
 export(netThresh)
 export(netcomi2scb)
+export(nodeFilter)
 export(pcadf)
 export(pullNode)
 export(qc)

R/disparityFilter.R

@@ -6,6 +6,8 @@
 #' (ordered for \code{net$edges}) or a column name from \code{net$edges}.
 #' @param alpha the significance level to filter edges for. Defaults to 0.05 for no serious reason.
 #' @param cores Number of cores to run in parallel, defaults to 1 if "mc.cores" option is unset.
+#' @param replot Logical, should nodes be rearranged to represent the network better visually?
+#' Defaults to TRUE.
 #' @importFrom stats quantile
 #' @return A modified version of net with filtered edges (and nodes if any were now isolated).
 #'
@@ -29,7 +31,8 @@
 #' @export
 #'
 
-dispFilter <- function(net, weights = NULL, alpha = 0.05, cores = getOption("mc.cores", 1)) {
+dispFilter <- function(net, weights = NULL, alpha = 0.05, cores = getOption("mc.cores", 1),
+                       replot = TRUE) {
   # these could be arguments, but I don't see a reason to change them ever
   node_metric <- "degree"
   node_metric_minimum <- 1
@@ -72,7 +75,7 @@ dispFilter <- function(net, weights = NULL, alpha = 0.05, cores = getOption("mc.
   edges$inverted_p <- ifelse(is.na(edges$inverted_p), 0, edges$inverted_p)
   net$edges <- edges
   # call edgeFilter
-  net <- edgeFilter(net, filter = 1 - alpha, edge = "inverted_p")
+  net <- edgeFilter(net, filter = 1 - alpha, edge = "inverted_p", replot = replot)
   net$edges <- net$edges[, -which(colnames(net$edges) %in% c("disp_filt_weight", "inverted_p"))]
   return(net)
 }

R/edgeFilter.R

@@ -8,6 +8,8 @@
 #' will show equal size edges between all connected nodes.
 #' @param direction Direction of filtering, "g" (the default) for greater than filter value, "l" for
 #' less than filter value/quantile.
+#' @param replot Logical, should nodes be rearranged to represent the network better visually?
+#' Defaults to TRUE.
 #' @importFrom stats quantile
 #' @return A modified version of net with filtered edges (and nodes if any were now isolated).
 #'
@@ -33,7 +35,7 @@
 #' @export
 #'
 
-edgeFilter <- function(net, filter, edge = "spearman_similarity", direction = "g") {
+edgeFilter <- function(net, filter, edge = "spearman_similarity", direction = "g", replot = TRUE) {
   original_nodes <- net[["nodes"]]
   original_edges <- net[["edges"]]
   if (is.character(filter)) {
@@ -61,5 +63,31 @@ edgeFilter <- function(net, filter, edge = "spearman_similarity", direction = "g
   removed_nodes <- setdiff(original_nodes$asv, nodes$asv)
   net[["graph"]] <- igraph::delete_edges(net[["graph"]], removed_edge_names)
   net[["graph"]] <- igraph::delete_vertices(net[["graph"]], removed_nodes)
+  if (replot) {
+    net <- .replotNodes(net_data = net)
+  }
   return(net)
 }
+
+#' @keywords internal
+#' @noRd
+
+.replotNodes <- function(net_data) {
+  g <- net_data$graph
+  nd <- as.data.frame(igraph::layout.auto(g))
+  node_id_name <- colnames(net_data$nodes)[1]
+  nd[[node_id_name]] <- igraph::as_ids(igraph::V(g))
+  nodes <- net_data$nodes
+  nodes <- nodes[sort(nodes[[node_id_name]], index.return = TRUE)$ix, ]
+  nd <- nd[sort(nd[[node_id_name]], index.return = TRUE)$ix, ]
+  nodes$V1 <- nd$V1
+  nodes$V2 <- nd$V2
+  eg <- net_data$edges
+  eg$from.x <- nd$V1[match(eg$from, nd[[node_id_name]])]
+  eg$from.y <- nd$V2[match(eg$from, nd[[node_id_name]])]
+  eg$to.x <- nd$V1[match(eg$to, nd[[node_id_name]])]
+  eg$to.y <- nd$V2[match(eg$to, nd[[node_id_name]])]
+  net_data$edges <- eg
+  net_data$nodes <- nodes
+  return(net_data)
+}

R/nodeFilter.R

@@ -0,0 +1,97 @@
+#' Function to filter nodes from networks generated by \code{asvNet}.
+#'
+#' @param net Object returned from \link{asvNet}.
+#' @param trait A node trait to filter data using. This should be a column name in net$nodes.
+#' @param filter Value to filter nodes by. How this is used depends on the type argument. For
+#' numeric traits this can be a number or a character (0.9 or "0.9") with the character option
+#' corresponding to quantiles (in this example the 90th percentile). For character traits this
+#' should be a character vector and nodes with values of trait in that vector will be kept.
+#' @param type type of comparison to make out of "ge", "le", and "in". Defaults to NULL in which case
+#' "in" is used for character traits and "ge" is used for numeric traits. Note "ge" and "le" are
+#' greater than or equal to and less than or equal to, respectively.
+#' @param replot Logical, should nodes be rearranged to represent the network better visually?
+#' Defaults to TRUE.
+#' @importFrom stats quantile
+#' @return A modified version of net with filtered nodes (and edges to those nodes).
+#'
+#' @examples
+#'
+#' taxa <- c(
+#'   "Bacteria", "Proteobacteria", "Betaproteobacteria", "Burkholderiales",
+#'   "Burkholderiaceae", "Paraburkholderia", NA
+#' )
+#' taxa <- matrix(rep(taxa, 10), nrow = 10, byrow = TRUE)
+#' colnames(taxa) <- c("Kingdom", "Phylum", "Class", "Order", "Family", "Genus", "Species")
+#' rownames(taxa) <- paste0("ASV", 1:10)
+#' # taxonomy data if used should have ASV names explicitly as a column
+#' taxa_df <- as.data.frame(taxa)
+#' taxa_df$asv <- rownames(taxa_df)
+#'
+#' sp_dist <- asvDist(asv, method = "spearman", clr_transform = TRUE, edgeFilter = 0.5)
+#' net_data <- asvNet(sp_dist, taxa_df, edge = "spearman_similarity")
+#'
+#' dim(net_data$nodes)
+#' net_data2 <- nodeFilter(net_data, trait = "strength", filter = 7, type = NULL, replot = TRUE)
+#' dim(net_data2$nodes)
+#'
+#' @export
+
+nodeFilter <- function(net, trait = NULL, filter = NULL, type = NULL, replot = TRUE) {
+  original_nodes <- net[["nodes"]]
+  original_edges <- net[["edges"]]
+  type <- .nodeFilterType(net, trait, type) # format type
+  filter_for <- .nodeFilterCutoffs(net, trait, type, filter) # format filter
+  # logical comparisons based on type
+  if (type == "in") {
+    nodes <- original_nodes[original_nodes[[trait]] %in% filter_for, ]
+    removed_nodes <- original_nodes[!original_nodes[[trait]] %in% filter_for, ]
+  } else if (type == "ge") {
+    nodes <- original_nodes[original_nodes[[trait]] >= filter_for, ]
+    removed_nodes <- original_nodes[original_nodes[[trait]] < filter_for, ]
+  } else if (type == "le") {
+    nodes <- original_nodes[original_nodes[[trait]] <= filter_for, ]
+    removed_nodes <- original_nodes[original_nodes[[trait]] > filter_for, ]
+  }
+  keep_nodes <- nodes[[1]]
+  # get list of new edges only connecting nodes that were kept
+  edges <- original_edges[original_edges$to %in% keep_nodes & original_edges$from %in% keep_nodes, ]
+  # get list of edges to remove in to|from syntax
+  removed_edges <- original_edges[!original_edges$to %in% keep_nodes |
+                                    !original_edges$from %in% keep_nodes, ]
+  removed_edge_names <- paste(removed_edges$from, removed_edges$to, sep = "|")
+  # overwrite components of net
+  net[["edges"]] <- edges
+  net[["nodes"]] <- nodes
+  net[["graph"]] <- igraph::delete_edges(net[["graph"]], removed_edge_names)
+  net[["graph"]] <- igraph::delete_vertices(net[["graph"]], removed_nodes[[1]])
+  if (replot) {
+    net <- .replotNodes(net_data = net)
+  }
+  return(net)
+}
+
+#' @keywords internal
+#' @noRd
+
+.nodeFilterCutoffs <- function(net, trait, type, filter) {
+  cutoff <- filter
+  if (filter %in% c("le", "ge") && is.character(filter)) {
+    cutoff <- stats::quantile(net$nodes[[trait]], probs = as.numeric(filter))
+  }
+  return(cutoff)
+}
+
+#' @keywords internal
+#' @noRd
+
+.nodeFilterType <- function(net, trait, type) {
+  if (is.null(type)) {
+    trait_values <- net$nodes[[trait]]
+    if (is.numeric(trait_values)) {
+      type <- "ge"
+    } else {
+      type <- "in"
+    }
+  }
+  return(type)
+}