Enhancement for #145 (#201)

feat: added `plot.graph` parameter to network to allow user control over whether to plot the network or just return the output. Either way, the returned object is the same

R/network.R

@@ -136,6 +136,9 @@
 #' @param layout.fun a function. It specifies how the vertices will be placed
 #' on the graph. See help(layout) in the igraph package. Defaults to
 #' layout.fruchterman.reingold.
+#' @param plot.graph logical. If \code{TRUE} (default), plotting window will be 
+#' filled with network. If \code{FALSE}, then no graph will be plotted, though 
+#' the return value of the function is the exact same.
 #' @return \code{network} return a list containing the following components:
 #' \item{M}{the correlation matrix used by \code{network}.} \item{gR}{a
 #' \code{graph} object to save the graph for cytoscape use (requires to load
@@ -195,7 +198,8 @@ network <- function(mat,
                     interactive = FALSE,
                     layout.fun = NULL,
                     save = NULL,
-                    name.save = NULL
+                    name.save = NULL,
+                    plot.graph = TRUE
 
 )
 {
@@ -269,6 +273,10 @@ network <- function(mat,
 
     }
 
+    if (!plot.graph & interactive) {
+        stop("plot.graph cannot be FALSE if interactive = TRUE", call.=FALSE)
+    }
+
     class.object = class(mat)
     object.pls=c("mixo_pls","mixo_spls","mixo_mlspls")
     object.rcc="rcc"
@@ -973,50 +981,53 @@ network <- function(mat,
     #-----------------------------------#
     # construction of the initial graph #
     #-----------------------------------#
-    nn = vcount(gR)
-    V(gR)$label.cex = min(2.5 * cex.node.name/log(nn), 1)
-    E(gR)$label.cex = min(2.25 * cex.edge.label/log(nn), 1)
-    cex0 = 2 * V(gR)$label.cex
-
-    def.par = par(no.readonly = TRUE)
-    dev.new()
-    par(pty = "s", mar = c(0, 0, 0, 0),mfrow=c(1,1))
-    plot(1:100, 1:100, type = "n", axes = FALSE, xlab = "", ylab = "")
-    cha = V(gR)$label
-    cha = paste("", cha, "")
-    xh = strwidth(cha, cex = cex0) * 1.5
-    yh = strheight(cha, cex = cex0) * 3
-
-    V(gR)$size = xh
-    V(gR)$size2 = yh
-
-    dev.off()
-
-    if (is.null(layout.fun))
-    {
-        l = layout.fruchterman.reingold(gR, weights = (1 - abs(E(gR)$weight)))
-    } else {
-        l = layout.fun(gR)
-    }
 
-    if (isTRUE(!interactive))
-    {
-        if (isTRUE(show.color.key))
+    if (plot.graph) {
+        nn = vcount(gR)
+        V(gR)$label.cex = min(2.5 * cex.node.name/log(nn), 1)
+        E(gR)$label.cex = min(2.25 * cex.edge.label/log(nn), 1)
+        cex0 = 2 * V(gR)$label.cex
+
+        def.par = par(no.readonly = TRUE)
+        dev.new()
+        par(pty = "s", mar = c(0, 0, 0, 0),mfrow=c(1,1))
+        plot(1:100, 1:100, type = "n", axes = FALSE, xlab = "", ylab = "")
+        cha = V(gR)$label
+        cha = paste("", cha, "")
+        xh = strwidth(cha, cex = cex0) * 1.5
+        yh = strheight(cha, cex = cex0) * 3
+
+        V(gR)$size = xh
+        V(gR)$size2 = yh
+
+        dev.off()
+
+        if (is.null(layout.fun))
         {
-            layout(lmat, widths = lwid, heights = lhei, respect = FALSE)
-            par(mar = c(5, 4, 2, 1), cex = 0.75)
-            image(z.mat, col = col, xaxt = "n", yaxt = "n")
-            box()
-            par(usr = c(0, 1, 0, 1))
-            axis(1, at = xv, labels = lv, cex.axis = keysize.label)
-            title("Color key", font.main = 1, cex.main = keysize.label)
-            par(def.par)
-            par(new = TRUE)
+            l = layout.fruchterman.reingold(gR, weights = (1 - abs(E(gR)$weight)))
+        } else {
+            l = layout.fun(gR)
         }
 
-        par(pty = "s", mar = c(0, 0, 0, 0),mfrow=c(1,1))
-        plot(gR, layout = l)
-        par(def.par)
+        if (isTRUE(!interactive))
+        {
+            if (isTRUE(show.color.key))
+            {
+                layout(lmat, widths = lwid, heights = lhei, respect = FALSE)
+                par(mar = c(5, 4, 2, 1), cex = 0.75)
+                image(z.mat, col = col, xaxt = "n", yaxt = "n")
+                box()
+                par(usr = c(0, 1, 0, 1))
+                axis(1, at = xv, labels = lv, cex.axis = keysize.label)
+                title("Color key", font.main = 1, cex.main = keysize.label)
+                par(def.par)
+                par(new = TRUE)
+            }
+
+            par(pty = "s", mar = c(0, 0, 0, 0),mfrow=c(1,1))
+            plot(gR, layout = l)
+            par(def.par)
+        }
     }
 
     #-----------------------#

tests/testthat/test-network.R

@@ -39,3 +39,17 @@ test_that("network works for spls", {
 })
 
 unlink(list.files(pattern = "*.pdf"))
+
+
+test_that("network plot.graph parameter does not affect numerical output", {
+  data("nutrimouse")
+  X <- nutrimouse$gene
+  Y <- nutrimouse$lipid
+
+  pls.obj <- pls(X, Y)
+
+  network.obj.F <- network(pls.obj, plot.graph = F)
+  network.obj.T <- network(pls.obj, plot.graph = T)
+
+  expect_equal(network.obj.F$M, network.obj.T$M)
+})