chore: lengths()

R/attributes.R

@@ -962,7 +962,7 @@ edge.attributes <- function(graph, index = E(graph)) {
     value <- as.list(value)
   }
 
-  if (any(sapply(value, length) != length(index))) {
+  if (any(lengths(value) != length(index))) {
     cli::cli_abort("Invalid attribute value length, must match number of edges")
   }
 

R/cohesive.blocks.R

@@ -428,7 +428,7 @@ print.cohesiveBlocks <- function(x, ...) {
   myb <- blocks(x)
   ch <- cohesion(x)
   pp <- parent(x)
-  si <- sapply(myb, length)
+  si <- lengths(myb)
 
   cs <- 3 +
     2 +

R/conversion.R

@@ -773,7 +773,7 @@ graph_from_graphnel <- function(
   v.n <- names(graph::nodeDataDefaults(graphNEL))
   for (n in v.n) {
     val <- unname(graph::nodeData(graphNEL, attr = n))
-    if (unlist.attrs && all(sapply(val, length) == 1)) {
+    if (unlist.attrs && all(lengths(val) == 1)) {
       val <- unlist(val)
     }
     g <- set_vertex_attr(g, n, value = val)
@@ -789,7 +789,7 @@ graph_from_graphnel <- function(
     el <- paste(sep = "|", el[, 1], el[, 2])
     for (n in e.n) {
       val <- unname(graph::edgeData(graphNEL, attr = n)[el])
-      if (unlist.attrs && all(sapply(val, length) == 1)) {
+      if (unlist.attrs && all(lengths(val) == 1)) {
         val <- unlist(val)
       }
       g <- set_edge_attr(g, n, value = val)

R/epi.R

@@ -33,7 +33,7 @@ time_bins.sir <- function(x, middle = TRUE) {
   sir <- x
 
   big.time <- unlist(sapply(sir, "[[", "times"))
-  medlen <- median(sapply(lapply(sir, "[[", "times"), length))
+  medlen <- median(lengths(lapply(sir, "[[", "times")))
   ## Adhoc use of Freedman-Diaconis binwidth; rescale time accordingly.
   w <- 2 * IQR(big.time) / (medlen^(1 / 3))
   minbt <- min(big.time)

R/indexing.R

@@ -72,7 +72,7 @@ get_adjacency_submatrix <- function(x, i, j, attr = NULL) {
   }
 
   adj <- adjacent_vertices(x, i_seq, mode = "out")
-  i_degree <- map_int(adj, length)
+  i_degree <- lengths(adj)
 
   from_id <- rep(i_seq, i_degree)
   to_id <- unlist(adj)

R/iterators.R

@@ -1595,7 +1595,7 @@ as_igraph_es <- function(graph, e) {
     ## Based on vertex ids/names
     if (length(Pairs) != 0) {
       vv <- strsplit(e[Pairs], "|", fixed = TRUE)
-      vl <- sapply(vv, length)
+      vl <- lengths(vv)
       if (any(vl != 2)) {
         cli::cli_abort("Invalid edge name: ", e[Pairs][vl != 2][1])
       }

R/print.R

@@ -413,7 +413,7 @@
   al <- as_adj_list(x, mode = "out")
   w <- nchar(max(which(degree(x, mode = "in") != 0)))
   mpl <- trunc((getOption("width") - nchar(arrow) - nchar(vc)) / (w + 1))
-  if (any(sapply(al, length) > mpl)) {
+  if (any(lengths(al) > mpl)) {
     ## Wrapping needed
     mw <- nchar(vcount(x))
     sm <- paste(collapse = "", rep(" ", mw + 4))

R/sparsedf.R

@@ -34,7 +34,7 @@ sdf <- function(..., row.names = NULL, NROW = NULL) {
     cli::cli_abort("Columns must be have (unique) names.")
   }
 
-  lens <- sapply(cols, length)
+  lens <- lengths(cols)
   n1lens <- lens[lens != 1]
 
   if (length(unique(n1lens)) > 1) {

tests/testthat/test-cliques.R

@@ -81,7 +81,7 @@ test_that("max_cliques() work", {
   gnp <- simplify(gnp)
 
   mysort <- function(x) {
-    xl <- sapply(x, length)
+    xl <- lengths(x)
     x <- lapply(x, sort)
     xc <- sapply(x, paste, collapse = "-")
     x[order(xl, xc)]
@@ -202,7 +202,7 @@ test_that("max_cliques() work for subsets", {
   gnp <- sample_gnp(100, .5)
 
   mysort <- function(x) {
-    xl <- sapply(x, length)
+    xl <- lengths(x)
     x <- lapply(x, sort)
     xc <- sapply(x, paste, collapse = "-")
     x[order(xl, xc)]
@@ -281,7 +281,7 @@ test_that("largest_ivs() works", {
   g <- sample_gnp(50, 0.8)
   livs <- largest_ivs(g)
   expect_equal(
-    unique(sapply(livs, length)),
+    unique(lengths(livs)),
     ivs_size(g)
   )
 
@@ -299,7 +299,7 @@ test_that("largest_cliques works", {
   expect_length(cliques(g, min = length(lc[[1]]) + 1), 0)
 
   lc_ring <- largest_cliques(make_ring(10))
-  expect_equal(max(sapply(lc_ring, length)), 2)
+  expect_equal(max(lengths(lc_ring)), 2)
 })
 
 test_that("is_clique works", {

tests/testthat/test-glet.R

@@ -1,6 +1,6 @@
 sortgl <- function(x) {
   cl <- lapply(x$cliques, sort)
-  n <- sapply(cl, length)
+  n <- lengths(cl)
   list(cliques = cl[order(n)], thresholds = x$thresholds[order(n)])
 }
 
@@ -55,7 +55,7 @@ threshold.net <- function(graph, level) {
 
   clqt <- unvs(max_cliques(graph.t))
   clqt <- lapply(clqt, sort)
-  clqt[order(sapply(clqt, length), decreasing = TRUE)]
+  clqt[order(lengths(clqt), decreasing = TRUE)]
 }
 
 graphlets.old <- function(graph) {
@@ -81,7 +81,7 @@ graphlets.old <- function(graph) {
   clu <- unique(cls)
 
   ## Delete cliques that consist of single vertices
-  clf <- clu[sapply(clu, length) != 1]
+  clf <- clu[lengths(clu) != 1]
 
   clf
 }