feat: add fast plotting method

Only implemented for network_leiden()

NAMESPACE

@@ -171,6 +171,7 @@ importFrom(dplyr,mutate_if)
 importFrom(grDevices,rainbow)
 importFrom(htmltools,HTML)
 importFrom(igraph,graph_from_data_frame)
+importFrom(igraph,plot.igraph)
 importFrom(magrittr,"%>%")
 importFrom(markdown,markdownToHTML)
 importFrom(methods,is)

R/network_leiden.R

@@ -39,8 +39,13 @@
 #'   - 'data': return a vertex data file that matches vertices with communities and HR attributes.
 #'   - 'describe': return a list of data frames which describe each of the identified communities.
 #'   - 'network': return igraph object.
+#' @param size_threshold Numeric value representing the maximum number of edges before `network_leiden()`
+#' switches to use a more efficient, but less elegant plotting method (native igraph). Defaults to 5000.
+#' Set as `0` to co-erce to a fast plotting method every time, and `Inf` to always use the default plotting
+#' method.
 #'
 #' @import dplyr
+#' @importFrom igraph plot.igraph
 #'
 #' @export
 network_leiden <- function(data,
@@ -52,7 +57,8 @@ network_leiden <- function(data,
                            node_alpha = 0.8,
                            res = 0.5,
                            desc_hrvar = c("Organization", "LevelDesignation", "FunctionType"),
-                           return = "plot-leiden"){
+                           return = "plot-leiden",
+                           size_threshold = 5000){
 
   ## Set variables
   TO_hrvar <- paste0("TieOrigin_", hrvar)
@@ -115,67 +121,164 @@ network_leiden <- function(data,
   ## Return
   if(return == "plot-leiden"){
 
-    plot_output <-
-      g_layout +
-      ggraph::geom_edge_link(colour = "lightgrey", edge_width = 0.01, alpha = 0.15) +
-      ggraph::geom_node_point(aes(colour = cluster),
-                              alpha = node_alpha,
-                              pch = 16) +
-      theme_void() +
-      theme(legend.position = "bottom",
-            legend.background = element_rect(fill = bg_fill),
-            plot.background = element_rect(fill = bg_fill),
-            text = element_text(colour = font_col),
-            axis.line = element_blank()) +
-      labs(title = "Person to person collaboration with Community Detection",
-           subtitle = "Based on Leiden algorithm and Strong Tie Score",
-           y = "",
-           x = "")
+    if(igraph::ecount(g) > 5000){
 
-    # Default PDF output unless NULL supplied to path
-    if(is.null(path)){
+      message("Using fast plot method due to large network size...")
 
-      plot_output
+      ## Set colours
+      colour_tb <-
+        tibble(cluster = unique(igraph::V(g)$cluster)) %>%
+        mutate(colour = rainbow(nrow(.)))
+
+      ## Colour vector
+      colour_v <-
+        tibble(cluster = igraph::V(g)$cluster) %>%
+        left_join(colour_tb, by = "cluster") %>%
+        pull(colour)
+
+
+      igraph::V(g)$color <- grDevices::adjustcolor(colour_v, alpha.f = node_alpha)
+      igraph::V(g)$frame.color <- NA
+      igraph::E(g)$width <- 1
+
+      grDevices::pdf(paste0(path, tstamp(), ".pdf"))
+
+      par(bg = bg_fill)
+
+      plot(g,
+           layout = layout_with_mds,
+           vertex.label = NA,
+           vertex.size = 3,
+           edge.arrow.mode = "-",
+           edge.color = "#adadad")
+
+      legend(x = -1.5,
+             y = 0.5,
+             legend = colour_tb$cluster,
+             pch = 21,
+             text.col = font_col,
+             col = "#777777",
+             pt.bg= colour_tb$colour,
+             pt.cex = 2,
+             cex = .8,
+             bty = "n",
+             ncol = 1)
+
+      grDevices::dev.off()
 
     } else {
 
-     ggsave(paste0(path, tstamp(), ".pdf"),
-            plot = plot_output,
-            width = 16,
-            height = 9)
+      plot_output <-
+        g_layout +
+        ggraph::geom_edge_link(colour = "lightgrey", edge_width = 0.01, alpha = 0.15) +
+        ggraph::geom_node_point(aes(colour = cluster),
+                                alpha = node_alpha,
+                                pch = 16) +
+        theme_void() +
+        theme(legend.position = "bottom",
+              legend.background = element_rect(fill = bg_fill),
+              plot.background = element_rect(fill = bg_fill),
+              text = element_text(colour = font_col),
+              axis.line = element_blank()) +
+        labs(title = "Person to person collaboration with Community Detection",
+             subtitle = "Based on Leiden algorithm and Strong Tie Score",
+             y = "",
+             x = "")
 
+      # Default PDF output unless NULL supplied to path
+      if(is.null(path)){
+
+        plot_output
+
+      } else {
+
+        ggsave(paste0(path, tstamp(), ".pdf"),
+               plot = plot_output,
+               width = 16,
+               height = 9)
+
+      }
     }
 
   } else if(return == "plot-hrvar"){
 
-    plot_output <-
-      g_layout +
-      ggraph::geom_edge_link(colour = "lightgrey", edge_width = 0.01, alpha = 0.15) +
-      ggraph::geom_node_point(aes(colour = !!sym(hrvar)),
-                              alpha = node_alpha,
-                              pch = 16) +
-      theme_void() +
-      theme(legend.position = "bottom",
-            legend.background = element_rect(fill = bg_fill),
-            plot.background = element_rect(fill = bg_fill),
-            text = element_text(colour = font_col),
-            axis.line = element_blank()) +
-      labs(title = "Person to person collaboration",
-           subtitle = paste0("Showing ", hrvar),
-           y = "",
-           x = "")
+    if(igraph::ecount(g) > 5000){
 
-    # Default PDF output unless NULL supplied to path
-    if(is.null(path)){
+      message("Using fast plot method due to large network size...")
 
-      plot_output
+      ## Set colours
+      colour_tb <-
+        tibble(!!sym(hrvar) := unique(igraph::get.vertex.attribute(g, name = hrvar))) %>%
+        mutate(colour = rainbow(nrow(.)))
+
+      ## Colour vector
+      colour_v <-
+        tibble(!!sym(hrvar) := igraph::get.vertex.attribute(g, name = hrvar)) %>%
+        left_join(colour_tb, by = hrvar) %>%
+        pull(colour)
+
+
+      igraph::V(g)$color <- grDevices::adjustcolor(colour_v, alpha.f = node_alpha)
+      igraph::V(g)$frame.color <- NA
+      igraph::E(g)$width <- 1
+
+      grDevices::pdf(paste0(path, tstamp(), ".pdf"))
+
+      par(bg = bg_fill)
+
+      plot(g,
+           layout = layout_with_mds,
+           vertex.label = NA,
+           vertex.size = 3,
+           edge.arrow.mode = "-",
+           edge.color = "#adadad")
+
+      legend(x = -1.5,
+             y = 0.5,
+             legend = colour_tb[[hrvar]],
+             pch = 21,
+             text.col = font_col,
+             col = "#777777",
+             pt.bg = colour_tb$colour,
+             pt.cex = 2,
+             cex = .8,
+             bty = "n",
+             ncol = 1)
+
+      grDevices::dev.off()
 
     } else {
 
-      ggsave(paste0(path, tstamp(), ".pdf"),
-             plot = plot_output,
-             width = 16,
-             height = 9)
+      plot_output <-
+        g_layout +
+        ggraph::geom_edge_link(colour = "lightgrey", edge_width = 0.01, alpha = 0.15) +
+        ggraph::geom_node_point(aes(colour = !!sym(hrvar)),
+                                alpha = node_alpha,
+                                pch = 16) +
+        theme_void() +
+        theme(legend.position = "bottom",
+              legend.background = element_rect(fill = bg_fill),
+              plot.background = element_rect(fill = bg_fill),
+              text = element_text(colour = font_col),
+              axis.line = element_blank()) +
+        labs(title = "Person to person collaboration",
+             subtitle = paste0("Showing ", hrvar),
+             y = "",
+             x = "")
+
+      # Default PDF output unless NULL supplied to path
+      if(is.null(path)){
+
+        plot_output
+
+      } else {
+
+        ggsave(paste0(path, tstamp(), ".pdf"),
+               plot = plot_output,
+               width = 16,
+               height = 9)
+
+      }
 
     }
 

man/network_leiden.Rd

@@ -14,7 +14,8 @@ network_leiden(
   node_alpha = 0.8,
   res = 0.5,
   desc_hrvar = c("Organization", "LevelDesignation", "FunctionType"),
-  return = "plot-leiden"
+  return = "plot-leiden",
+  size_threshold = 5000
 )
 }
 \arguments{
@@ -56,6 +57,11 @@ Valid return options include:
 \item 'describe': return a list of data frames which describe each of the identified communities.
 \item 'network': return igraph object.
 }}
+
+\item{size_threshold}{Numeric value representing the maximum number of edges before \code{network_leiden()}
+switches to use a more efficient, but less elegant plotting method (native igraph). Defaults to 5000.
+Set as \code{0} to co-erce to a fast plotting method every time, and \code{Inf} to always use the default plotting
+method.}
 }
 \description{
 Take a P2P network query and implement the Leiden community detection method. To run