cleaning up and new lintr

schochastics · Dec 15, 2023 · f1d8f75 · f1d8f75
1 parent f669b66
commit f1d8f75
Show file tree

Hide file tree

Showing 23 changed files with 769 additions and 760 deletions.
diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION
@@ -0,0 +1,3 @@
+Version: 0.4.1
+Date: 2022-11-22 06:42:52 UTC
+SHA: 9196928bc4eda31af1e25c30dc6e71912b87cf58
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: edgebundle
 Title: Algorithms for Bundling Edges in Networks and Visualizing Flow and Metro Maps
-Version: 0.4.1
+Version: 0.4.2
 Authors@R: 
     person(given = "David",
            family = "Schoch",
@@ -19,7 +19,7 @@ Config/testthat/edition: 2
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
 LinkingTo: 
     Rcpp
 Imports: 

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,7 @@
+# edgebundle 0.4.2
+
+* clean up codebase
+
 # edgebundle 0.4.1
 
 * added package level docs

diff --git a/R/bundle_force.R b/R/bundle_force.R
@@ -20,39 +20,49 @@
 #' Holten, Danny, and Jarke J. Van Wijk. "Force-Directed Edge Bundling for Graph Visualization." Computer Graphics Forum (Blackwell Publishing Ltd) 28, no. 3 (2009): 983-990.
 #' @examples
 #' library(igraph)
-#' g  <- graph_from_edgelist(matrix(c(1,12,2,11,3,10,4,9,5,8,6,7),ncol = 2,byrow = TRUE),FALSE)
-#' xy <- cbind(c(rep(0,6),rep(1,6)),c(1:6,1:6))
-#' edge_bundle_force(g,xy)
+#' g <- graph_from_edgelist(
+#'     matrix(c(
+#'         1, 12, 2, 11, 3, 10,
+#'         4, 9, 5, 8, 6, 7
+#'     ), ncol = 2, byrow = TRUE), FALSE
+#' )
+#' xy <- cbind(c(rep(0, 6), rep(1, 6)), c(1:6, 1:6))
+#' edge_bundle_force(g, xy)
 #' @export
 
-edge_bundle_force <- function(object,xy, K=1,C=6,P=1,S=0.04,
-                              P_rate=2,I=50,I_rate=2/3,
+edge_bundle_force <- function(object, xy, K = 1, C = 6, P = 1, S = 0.04,
+                              P_rate = 2, I = 50, I_rate = 2 / 3,
                               compatibility_threshold = 0.6,
                               eps = 1e-8) {
-  #initialize matrix with coordinates
-  edges_xy <- convert_edges(object,xy)
-  m <- nrow(edges_xy)
+    # initialize matrix with coordinates
+    edges_xy <- convert_edges(object, xy)
+    m <- nrow(edges_xy)
 
-  #initialize edge subdivision list
-  elist <- unname(lapply(split(edges_xy, rep(1:nrow(edges_xy), ncol(edges_xy))),
-                         function(y) matrix(y,2,2,byrow = TRUE)))
+    # initialize edge subdivision list
+    elist <- unname(lapply(
+        split(edges_xy, rep(seq_len(nrow(edges_xy)), ncol(edges_xy))),
+        function(y) matrix(y, 2, 2, byrow = TRUE)
+    ))
 
-  #main force bundling routine
-  elist <- force_bundle_iter(edges_xy,elist,K,C,P,P_rate,
-                             S,I, I_rate,compatibility_threshold, eps)
+    # main force bundling routine
+    elist <- force_bundle_iter(
+        edges_xy, elist, K, C, P, P_rate,
+        S, I, I_rate, compatibility_threshold, eps
+    )
 
-  # assemble data frame
-  segments <- nrow(elist[[1]])
+    # assemble data frame
+    segments <- nrow(elist[[1]])
 
-  idx <- seq(0, 1, length.out = segments)
-  data_bundle <- as.data.frame(cbind(
-    do.call("rbind",elist),
-    rep(idx,m),
-    rep(1:m,each=segments)))
+    idx <- seq(0, 1, length.out = segments)
+    data_bundle <- as.data.frame(cbind(
+        do.call("rbind", elist),
+        rep(idx, m),
+        rep(1:m, each = segments)
+    ))
 
-  names(data_bundle) <- c("x","y","index","group")
+    names(data_bundle) <- c("x", "y", "index", "group")
 
-  data_bundle
+    data_bundle
 }
 
 #' @importFrom Rcpp sourceCpp

diff --git a/R/bundle_hammer.R b/R/bundle_hammer.R
@@ -14,40 +14,38 @@
 #' @seealso [edge_bundle_force],[edge_bundle_stub], [edge_bundle_path]
 #' @export
 
-edge_bundle_hammer <- function(object,xy,bw=0.05,decay=0.7){
-  if (!requireNamespace('reticulate', quietly = TRUE)) {
-    stop('The `reticulate` package is required for this functionality')
-  }
-  if(any(class(object)=="igraph")){
-    if (!requireNamespace('igraph', quietly = TRUE)) {
-      stop('The `igraph` package is required for this functionality')
+edge_bundle_hammer <- function(object, xy, bw = 0.05, decay = 0.7) {
+    if (!requireNamespace("reticulate", quietly = TRUE)) {
+        stop("The `reticulate` package is required for this functionality")
     }
-    nodes <- data.frame(name=paste0("node",0:(igraph::vcount(object)-1)),x=xy[,1],y=xy[,2])
-    el <- igraph::get.edgelist(object,names = FALSE)
-    el1 <- data.frame(source=el[,1]-1,target=el[,2]-1)
-
-  } else if(any(class(object)=="tbl_graph")){
-    if (!requireNamespace('tidygraph', quietly = TRUE)) {
-      stop('The `tidygraph` package is required for this functionality')
+    if (any(class(object) == "igraph")) {
+        if (!requireNamespace("igraph", quietly = TRUE)) {
+            stop("The `igraph` package is required for this functionality")
+        }
+        nodes <- data.frame(name = paste0("node", 0:(igraph::vcount(object) - 1)), x = xy[, 1], y = xy[, 2])
+        el <- igraph::get.edgelist(object, names = FALSE)
+        el1 <- data.frame(source = el[, 1] - 1, target = el[, 2] - 1)
+    } else if (any(class(object) == "tbl_graph")) {
+        if (!requireNamespace("tidygraph", quietly = TRUE)) {
+            stop("The `tidygraph` package is required for this functionality")
+        }
+        object <- tidygraph::as.igraph(object)
+        nodes <- data.frame(name = paste0("node", 0:(igraph::vcount(object) - 1)), x = xy[, 1], y = xy[, 2])
+        el <- igraph::get.edgelist(object, names = FALSE)
+        el1 <- data.frame(source = el[, 1] - 1, target = el[, 2] - 1)
+    } else if (any(class(object) == "network")) {
+        nodes <- data.frame(name = paste0("node", 0:(network::get.network.attribute(object, "n") - 1)), x = xy[, 1], y = xy[, 2])
+        el <- network::as.edgelist(object)
+        el1 <- data.frame(source = el[, 1] - 1, target = el[, 2] - 1)
+    } else {
+        stop("only `igraph`, `network` or `tbl_graph` objects supported.")
     }
-    object <- tidygraph::as.igraph(object)
-    nodes <- data.frame(name=paste0("node",0:(igraph::vcount(object)-1)),x=xy[,1],y=xy[,2])
-    el <- igraph::get.edgelist(object,names = FALSE)
-    el1 <- data.frame(source=el[,1]-1,target=el[,2]-1)
-
-  } else if(any(class(object)=="network")){
-    nodes <- data.frame(name=paste0("node",0:(network::get.network.attribute(object,"n")-1)),x=xy[,1],y=xy[,2])
-    el <- network::as.edgelist(object)
-    el1 <- data.frame(source=el[,1]-1,target=el[,2]-1)
-  } else{
-    stop("only `igraph`, `network` or `tbl_graph` objects supported.")
-  }
-  data_bundle <- shader_env$datashader_bundling$hammer_bundle(nodes,el1,initial_bandwidth = bw,decay = decay)
-  data_bundle$group <- is.na(data_bundle$y)+0
-  data_bundle$group <- cumsum(data_bundle$group)+1
-  data_bundle <- data_bundle[!is.na(data_bundle$y),]
-  data_bundle$index <- unlist(sapply(table(data_bundle$group),function(x) seq(0,1,length.out=x)))
-  data_bundle[,c("x","y","index","group")]
+    data_bundle <- shader_env$datashader_bundling$hammer_bundle(nodes, el1, initial_bandwidth = bw, decay = decay)
+    data_bundle$group <- is.na(data_bundle$y) + 0
+    data_bundle$group <- cumsum(data_bundle$group) + 1
+    data_bundle <- data_bundle[!is.na(data_bundle$y), ]
+    data_bundle$index <- unlist(sapply(table(data_bundle$group), function(x) seq(0, 1, length.out = x)))
+    data_bundle[, c("x", "y", "index", "group")]
 }
 
 #' @title install python dependencies for hammer bundling
@@ -60,17 +58,17 @@ edge_bundle_hammer <- function(object,xy,bw=0.05,decay=0.7){
 #' @export
 #'
 install_bundle_py <- function(method = "auto", conda = "auto") {
-  if (!requireNamespace('reticulate', quietly = TRUE)) {
-    stop('The `reticulate` package is required for this functionality')
-  }
-  reticulate::py_install("datashader", method = method, conda = conda, pip = TRUE)
-  reticulate::py_install("scikit-image", method = method, conda = conda, pip = TRUE)
+    if (!requireNamespace("reticulate", quietly = TRUE)) {
+        stop("The `reticulate` package is required for this functionality")
+    }
+    reticulate::py_install("datashader", method = method, conda = conda, pip = TRUE)
+    reticulate::py_install("scikit-image", method = method, conda = conda, pip = TRUE)
 }
 
 # Environment for globals
 shader_env <- new.env(parent = emptyenv())
 
 .onLoad <- function(libname, pkgname) {
-  reticulate::configure_environment(pkgname)
-  assign("datashader_bundling", reticulate::import("datashader.bundling", delay_load = TRUE), shader_env)
+    reticulate::configure_environment(pkgname)
+    assign("datashader_bundling", reticulate::import("datashader.bundling", delay_load = TRUE), shader_env)
 }
diff --git a/R/bundle_path.R b/R/bundle_path.R
@@ -14,93 +14,99 @@
 #' Wallinger, M., Archambault, D., Auber, D., Nollenburg, M., & Peltonen, J. (2021). Edge-Path Bundling: A Less Ambiguous Edge Bundling Approach. IEEE Transactions on Visualization and Computer Graphics.
 #' @examples
 #' library(igraph)
-#' g  <- graph_from_edgelist(matrix(c(1,2,1,6,1,4,2,3,3,4,4,5,5,6),ncol = 2,byrow = TRUE),FALSE)
-#' xy <- cbind(c(0,10,25,40,50,50),c(0,15,25,15,0,-10))
-#' edge_bundle_path(g,xy)
+#' g <- graph_from_edgelist(matrix(c(
+#'     1, 2, 1, 6,
+#'     1, 4, 2, 3, 3, 4, 4, 5, 5, 6
+#' ), ncol = 2, byrow = TRUE), FALSE)
+#' xy <- cbind(c(0, 10, 25, 40, 50, 50), c(0, 15, 25, 15, 0, -10))
+#' edge_bundle_path(g, xy)
 #' @export
 
-edge_bundle_path <- function(g,xy,max_distortion = 2,weight_fac = 2,segments = 20){
-  # preprocess
-  if(!igraph::is.igraph(g)){
-    stop("edge_bundle_path requires the input graph to be an ingraph object")
-  }
-  m <- igraph::ecount(g)
-  lock <- rep(FALSE,m)
-  skip <- rep(FALSE,m)
-
-  el <- igraph::get.edgelist(g,names = FALSE)
-  exy <- cbind(xy[el[,1],1],xy[el[,1],2],
-               xy[el[,2],1],xy[el[,2],2])
-  elen <- sqrt((exy[,1]-exy[,3])^2+(exy[,2]-exy[,4])^2)
-  weights <- elen^weight_fac
-  sortedEdges <- order(weights,decreasing = TRUE)
-  cpoints <- vector("list",m)
-  #iterate
-  for(e in sortedEdges){
-    s <- el[e,1]
-    t <- el[e,2]
-    cpoints[[e]] <- xy[c(s,t),]
-    if(lock[e]){
-      next()
-    }
-    skip[e] <- TRUE
-    g1 <- igraph::delete.edges(g,which(skip))
-    sp_verts <- suppressWarnings(igraph::shortest_paths(g1,s,t,weights = weights[!skip])$vpath[[1]])
-    if(length(sp_verts)<2){
-      skip[e] <- FALSE
-      next
+edge_bundle_path <- function(g, xy, max_distortion = 2, weight_fac = 2, segments = 20) {
+    # preprocess
+    if (!igraph::is.igraph(g)) {
+        stop("edge_bundle_path requires the input graph to be an ingraph object")
     }
-    sp_len <- path_length(sp_verts,xy)
-    if(sp_len >= max_distortion * elen[e]){
-      skip[e] <- FALSE
-      next
+    m <- igraph::ecount(g)
+    lock <- rep(FALSE, m)
+    skip <- rep(FALSE, m)
+
+    el <- igraph::get.edgelist(g, names = FALSE)
+    exy <- cbind(
+        xy[el[, 1], 1], xy[el[, 1], 2],
+        xy[el[, 2], 1], xy[el[, 2], 2]
+    )
+    elen <- sqrt((exy[, 1] - exy[, 3])^2 + (exy[, 2] - exy[, 4])^2)
+    weights <- elen^weight_fac
+    sortedEdges <- order(weights, decreasing = TRUE)
+    cpoints <- vector("list", m)
+    # iterate
+    for (e in sortedEdges) {
+        s <- el[e, 1]
+        t <- el[e, 2]
+        cpoints[[e]] <- xy[c(s, t), ]
+        if (lock[e]) {
+            next()
+        }
+        skip[e] <- TRUE
+        g1 <- igraph::delete.edges(g, which(skip))
+        sp_verts <- suppressWarnings(igraph::shortest_paths(g1, s, t, weights = weights[!skip])$vpath[[1]])
+        if (length(sp_verts) < 2) {
+            skip[e] <- FALSE
+            next
+        }
+        sp_len <- path_length(sp_verts, xy)
+        if (sp_len >= max_distortion * elen[e]) {
+            skip[e] <- FALSE
+            next
+        }
+        lock[igraph::get.edge.ids(g, rep(as.integer(sp_verts), each = 2)[-c(1, 2 * length(sp_verts))])] <- TRUE
+        cpoints[[e]] <- xy[sp_verts, ]
     }
-    lock[igraph::get.edge.ids(g,rep(as.integer(sp_verts),each=2)[-c(1,2*length(sp_verts))])] <- TRUE
-    cpoints[[e]] <- xy[sp_verts,]
-  }
-  cpoints_bezier <- lapply(cpoints,approximateBezier,n=segments)
+    cpoints_bezier <- lapply(cpoints, approximateBezier, n = segments)
 
-  idx <- seq(0, 1, length.out = segments)
-  data_bundle <- as.data.frame(cbind(
-    do.call("rbind",cpoints_bezier),
-    rep(idx,m),
-    rep(1:m,each=segments)))
+    idx <- seq(0, 1, length.out = segments)
+    data_bundle <- as.data.frame(cbind(
+        do.call("rbind", cpoints_bezier),
+        rep(idx, m),
+        rep(1:m, each = segments)
+    ))
 
-  names(data_bundle) <- c("x","y","index","group")
+    names(data_bundle) <- c("x", "y", "index", "group")
 
-  data_bundle
+    data_bundle
 }
 
-path_length <- function(verts,xy){
-  plen <- 0
-  for(i in 1:(length(verts)-1)){
-    plen <- plen + sqrt((xy[i,1]-xy[i+1,1])^2+(xy[i,2]-xy[i+1,2])^2)
-  }
-  plen
+path_length <- function(verts, xy) {
+    plen <- 0
+    for (i in 1:(length(verts) - 1)) {
+        plen <- plen + sqrt((xy[i, 1] - xy[i + 1, 1])^2 + (xy[i, 2] - xy[i + 1, 2])^2)
+    }
+    plen
 }
 
 approximateBezier <- function(points, n) {
-  pnrow <- nrow(points)-1
-  tseq <- seq(0,1,length.out=n)
-  if(pnrow==1){
-    bezier <- cbind(
-      tseq*points[1,1]+(1-tseq)*points[2,1],
-      tseq*points[1,2]+(1-tseq)*points[2,2]
-      )
-  }
-  binoms <- choose(pnrow,seq(0,pnrow))
-  bezier <- matrix(0,length(tseq),2)
-  b <- 1
-  for(t in tseq){
-    p <- c(0,0)
-    for(i in 0:pnrow){
-      tpi <- (1-t)^(pnrow-i)
-      coeff <- tpi*t^i
-      p[1] <- p[1] + binoms[i+1] * coeff * points[i+1,1]
-      p[2] <- p[2] + binoms[i+1] * coeff * points[i+1,2]
+    pnrow <- nrow(points) - 1
+    tseq <- seq(0, 1, length.out = n)
+    if (pnrow == 1) {
+        bezier <- cbind(
+            tseq * points[1, 1] + (1 - tseq) * points[2, 1],
+            tseq * points[1, 2] + (1 - tseq) * points[2, 2]
+        )
+    }
+    binoms <- choose(pnrow, seq(0, pnrow))
+    bezier <- matrix(0, length(tseq), 2)
+    b <- 1
+    for (t in tseq) {
+        p <- c(0, 0)
+        for (i in 0:pnrow) {
+            tpi <- (1 - t)^(pnrow - i)
+            coeff <- tpi * t^i
+            p[1] <- p[1] + binoms[i + 1] * coeff * points[i + 1, 1]
+            p[2] <- p[2] + binoms[i + 1] * coeff * points[i + 1, 2]
+        }
+        bezier[b, ] <- p
+        b <- b + 1
     }
-    bezier[b,] <- p
-    b <- b+1
-  }
-  bezier
+    bezier
 }