Merge pull request #74 from schochastics/refactoring-r_fct

refactor R code (#73)

.gitignore

@@ -3,4 +3,5 @@ inst/doc
 .Rhistory
 .RData
 docs
-CRAN-SUBMISSION
+CRAN-SUBMISSION
+revdep/

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: graphlayouts
 Title: Additional Layout Algorithms for Network Visualizations
-Version: 1.0.2
+Version: 1.0.2.9000
 Authors@R: person("David", "Schoch", email = "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2952-4812"))
 Description: Several new layout algorithms to visualize networks are provided which are not part of 'igraph'. 

NEWS.md

@@ -1,3 +1,9 @@
+# graphlayouts 1.0.2.9000
+
+* `layout_with_constrained_stress()` and `layout_with_constrained_stress3D()`
+  work for disconnected graphs
+* internal code refactoring
+
 # graphlayouts 1.0.2
 
 * fixed bug with weighted disconnected graphs (#71) h/t @gi0na 

R/layout_backbone.R

@@ -25,136 +25,134 @@
 #'
 
 layout_as_backbone <- function(g, keep = 0.2, backbone = TRUE) {
-  if (!igraph::is.igraph(g)) {
-    stop("g is not an igraph object")
-  }
-
-  if (igraph::ecount(g) == 0) {
-    stop("graph is empty")
-  }
-
-  if (!requireNamespace("oaqc", quietly = TRUE)) {
-    stop("oaqc is needed for this function to work. Please install it.", call. = FALSE)
-  }
-  if (igraph::any_multiple(g)) {
-    stop("backbone layout does not work with multiple edges.")
-  }
-  if (igraph::is_directed(g)) {
-    stop("backbone layout does not work with directed edges.")
-  }
-  if (any(igraph::is.loop(g))) {
-    stop("backbone layout does not work with loops.")
-  }
-
-  if (any(igraph::components(g)$no > 1)) {
-    warning("input graph is disconnected. The algorithm works best on connected graphs and may lead to misleading results for graphs with disconnected components. Run the algorithm on each component separately and delete isolated nodes to mitigate this issue.")
-  }
-
-  # weighting ----
-  orbs <- oaqc::oaqc(igraph::get.edgelist(g, names = FALSE) - 1, non_ind_freq = T)
-  e11 <- orbs$e_orbits_non_ind[, 11]
-
-  qu <- rep(0, igraph::vcount(g))
-  el <- igraph::get.edgelist(g, names = FALSE)
-  el <- cbind(el, e11)
-  for (e in seq_len(nrow(el))) {
-    qu[el[e, 1]] <- qu[el[e, 1]] + el[e, 3]
-    qu[el[e, 2]] <- qu[el[e, 2]] + el[e, 3]
-  }
-  w <- apply(el, 1, function(x) x[3] / sqrt(qu[x[1]] * qu[x[2]]))
-
-  w[is.na(w)] <- 0
-  w[is.infinite(w)] <- 0
-  igraph::E(g)$weight <- w
-
-  # reweighting -----
-  w <- max_prexif_jaccard(g)
-  igraph::E(g)$weight <- w
-
-  # umst ----
-  g_umst <- umst(g)
-
-  # filtering ----
-  igraph::E(g)$bone <- w >= sort(w, decreasing = TRUE)[ceiling(igraph::ecount(g) * keep)]
-  g_bone <- igraph::graph_from_edgelist(el[igraph::E(g)$bone, 1:2], directed = F)
-  g_lay <- igraph::simplify(igraph::graph.union(g_umst, g_bone))
-  # if there is an issue with isolates (see #44)
-  if (igraph::vcount(g_lay) != igraph::vcount(g)) {
-    n_iso <- igraph::vcount(g) - igraph::vcount(g_lay)
-    g_lay <- igraph::add_vertices(g_lay, n_iso)
-  }
-  if (backbone) {
-    bb <- backbone_edges(g, g_lay)
-  } else {
-    bb <- NULL
-  }
-  xy <- layout_with_stress(g_lay)
-  list(xy = xy, backbone = bb)
+    ensure_igraph(g)
+
+    if (igraph::ecount(g) == 0) {
+        stop("graph is empty")
+    }
+
+    if (!requireNamespace("oaqc", quietly = TRUE)) {
+        stop("oaqc is needed for this function to work. Please install it.", call. = FALSE)
+    }
+    if (igraph::any_multiple(g)) {
+        stop("backbone layout does not work with multiple edges.")
+    }
+    if (igraph::is_directed(g)) {
+        stop("backbone layout does not work with directed edges.")
+    }
+    if (any(igraph::is.loop(g))) {
+        stop("backbone layout does not work with loops.")
+    }
+
+    if (any(igraph::components(g)$no > 1)) {
+        warning("input graph is disconnected. The algorithm works best on connected graphs and may lead to misleading results for graphs with disconnected components. Run the algorithm on each component separately and delete isolated nodes to mitigate this issue.")
+    }
+
+    # weighting ----
+    orbs <- oaqc::oaqc(igraph::get.edgelist(g, names = FALSE) - 1, non_ind_freq = T)
+    e11 <- orbs$e_orbits_non_ind[, 11]
+
+    qu <- rep(0, igraph::vcount(g))
+    el <- igraph::get.edgelist(g, names = FALSE)
+    el <- cbind(el, e11)
+    for (e in seq_len(nrow(el))) {
+        qu[el[e, 1]] <- qu[el[e, 1]] + el[e, 3]
+        qu[el[e, 2]] <- qu[el[e, 2]] + el[e, 3]
+    }
+    w <- apply(el, 1, function(x) x[3] / sqrt(qu[x[1]] * qu[x[2]]))
+
+    w[is.na(w)] <- 0
+    w[is.infinite(w)] <- 0
+    igraph::E(g)$weight <- w
+
+    # reweighting -----
+    w <- max_prexif_jaccard(g)
+    igraph::E(g)$weight <- w
+
+    # umst ----
+    g_umst <- umst(g)
+
+    # filtering ----
+    igraph::E(g)$bone <- w >= sort(w, decreasing = TRUE)[ceiling(igraph::ecount(g) * keep)]
+    g_bone <- igraph::graph_from_edgelist(el[igraph::E(g)$bone, 1:2], directed = F)
+    g_lay <- igraph::simplify(igraph::graph.union(g_umst, g_bone))
+    # if there is an issue with isolates (see #44)
+    if (igraph::vcount(g_lay) != igraph::vcount(g)) {
+        n_iso <- igraph::vcount(g) - igraph::vcount(g_lay)
+        g_lay <- igraph::add_vertices(g_lay, n_iso)
+    }
+    if (backbone) {
+        bb <- backbone_edges(g, g_lay)
+    } else {
+        bb <- NULL
+    }
+    xy <- layout_with_stress(g_lay)
+    list(xy = xy, backbone = bb)
 }
 
 #-------------------------------------------------------------------------------
 # helper functions
 #-------------------------------------------------------------------------------
 
 umst <- function(g) {
-  el <- igraph::get.edgelist(g, names = FALSE)
-  el <- cbind(el, igraph::E(g)$weight)
-  el <- el[order(el[, 3], decreasing = TRUE), ]
-  el <- cbind(el, rank(-el[, 3]))
-  vfind <- 1:igraph::vcount(g)
-  el_un <- matrix(0, 0, 2)
-  for (i in unique(el[, 4])) {
-    el_tmp <- matrix(0, 0, 2)
-    Bi <- which(el[, 4] == i)
-    for (e in Bi) {
-      u <- el[e, 1]
-      v <- el[e, 2]
-      if (vfind[u] != vfind[v]) {
-        el_tmp <- rbind(el_tmp, c(u, v))
-      }
+    el <- igraph::get.edgelist(g, names = FALSE)
+    el <- cbind(el, igraph::E(g)$weight)
+    el <- el[order(el[, 3], decreasing = TRUE), ]
+    el <- cbind(el, rank(-el[, 3]))
+    vfind <- 1:igraph::vcount(g)
+    el_un <- matrix(0, 0, 2)
+    for (i in unique(el[, 4])) {
+        el_tmp <- matrix(0, 0, 2)
+        Bi <- which(el[, 4] == i)
+        for (e in Bi) {
+            u <- el[e, 1]
+            v <- el[e, 2]
+            if (vfind[u] != vfind[v]) {
+                el_tmp <- rbind(el_tmp, c(u, v))
+            }
+        }
+        if (nrow(el_tmp) == 0) {
+            next()
+        }
+        for (eb in seq_len(nrow(el_tmp))) {
+            u <- el_tmp[eb, 1]
+            v <- el_tmp[eb, 2]
+            partu <- vfind[u]
+            partv <- vfind[v]
+            vfind[v] <- partu
+            if (any(vfind == partv)) {
+                vfind[vfind == partv] <- partu
+            }
+        }
+        el_un <- rbind(el_un, el_tmp)
     }
-    if (nrow(el_tmp) == 0) {
-      next()
-    }
-    for (eb in seq_len(nrow(el_tmp))) {
-      u <- el_tmp[eb, 1]
-      v <- el_tmp[eb, 2]
-      partu <- vfind[u]
-      partv <- vfind[v]
-      vfind[v] <- partu
-      if (any(vfind == partv)) {
-        vfind[vfind == partv] <- partu
-      }
-    }
-    el_un <- rbind(el_un, el_tmp)
-  }
-  return(igraph::simplify(igraph::graph_from_edgelist(el_un, directed = FALSE)))
+    return(igraph::simplify(igraph::graph_from_edgelist(el_un, directed = FALSE)))
 }
 
 
 backbone_edges <- function(g, g_lay) {
-  tmp <- rbind(igraph::get.edgelist(g_lay), igraph::get.edgelist(g, names = FALSE))
-  which(duplicated(tmp)) - igraph::ecount(g_lay)
+    tmp <- rbind(igraph::get.edgelist(g_lay), igraph::get.edgelist(g, names = FALSE))
+    which(duplicated(tmp)) - igraph::ecount(g_lay)
 }
 
 max_prexif_jaccard <- function(g) {
-  if ("name" %in% igraph::vertex_attr_names(g)) {
-    g <- igraph::delete_vertex_attr(g, "name")
-  }
-  el_tbl <- igraph::as_data_frame(g, "edges")
-
-  N_ranks <- lapply(1:igraph::vcount(g), get_rank, el_tbl = el_tbl)
-  el <- igraph::get.edgelist(g, names = FALSE)
-  new_w <- reweighting(el - 1, N_ranks)
-  new_w
+    if ("name" %in% igraph::vertex_attr_names(g)) {
+        g <- igraph::delete_vertex_attr(g, "name")
+    }
+    el_tbl <- igraph::as_data_frame(g, "edges")
+
+    N_ranks <- lapply(1:igraph::vcount(g), get_rank, el_tbl = el_tbl)
+    el <- igraph::get.edgelist(g, names = FALSE)
+    new_w <- reweighting(el - 1, N_ranks)
+    new_w
 }
 
 get_rank <- function(el_tbl, u) {
-  Nu_idx <- el_tbl[["from"]] == u | el_tbl[["to"]] == u
-  omega <- el_tbl[Nu_idx, "weight"]
-  Nu <- setdiff(c(el_tbl[Nu_idx, "from"], el_tbl[Nu_idx, "to"]), u)
-  r <- rank(-omega)
-  r <- match(r, sort(unique(r))) - 1
-  Nru <- cbind(Nu - 1, r)
-  Nru[order(Nru[, 2]), , drop = FALSE]
+    Nu_idx <- el_tbl[["from"]] == u | el_tbl[["to"]] == u
+    omega <- el_tbl[Nu_idx, "weight"]
+    Nu <- setdiff(c(el_tbl[Nu_idx, "from"], el_tbl[Nu_idx, "to"]), u)
+    r <- rank(-omega)
+    r <- match(r, sort(unique(r))) - 1
+    Nru <- cbind(Nu - 1, r)
+    Nru[order(Nru[, 2]), , drop = FALSE]
 }