Use vctrs for vector recycling

R/centrality.R

@@ -2042,7 +2042,7 @@ alpha.centrality.dense <- function(
 ) {
   ensure_igraph(graph)
 
-  exo <- rep(exo, length.out = vcount(graph))
+  exo <- vctrs::vec_recycle(exo, vcount(graph))
   exo <- matrix(exo, ncol = 1)
 
   if (is.null(weights) && "weight" %in% edge_attr_names(graph)) {
@@ -2121,7 +2121,7 @@ alpha.centrality.sparse <- function(
   )
 
   ## exo
-  exo <- cbind(rep(exo, length.out = vc))
+  exo <- cbind(vctrs::vec_recycle(exo, vc))
 
   ## Solve the equation
   M3 <- M2 - alpha * M

R/epi.R

@@ -173,7 +173,7 @@ plot.sir <- function(
   if (is.null(quantile_color)) {
     quantile_color <- c(NI = "blue", NS = "red", NR = "gold")[comp]
   }
-  quantile_color <- rep(quantile_color, length.out = length(quantiles))
+  quantile_color <- vctrs::vec_recycle(quantile_color, length(quantiles))
 
   ns <- length(sir)
   xlim <- xlim %||% c(0, max(sapply(sir, function(x) max(x$times))))

R/games.R

@@ -2568,10 +2568,12 @@ sbm <- function(...) constructor_spec(sample_sbm, ...)
 #' @cdocs igraph_hsbm_game
 #' @cdocs igraph_hsbm_list_game
 sample_hierarchical_sbm <- function(n, m, rho, C, p) {
+  # Determine sizes, treating non-lists as single elements
   mlen <- length(m)
   rholen <- if (is.list(rho)) length(rho) else 1
   Clen <- if (is.list(C)) length(C) else 1
 
+  # Use vctrs to find common size, allowing recycling from length 1
   commonlen <- unique(c(mlen, rholen, Clen))
 
   if (length(commonlen) == 1 && commonlen == 1) {
@@ -2587,16 +2589,16 @@ sample_hierarchical_sbm <- function(n, m, rho, C, p) {
     if (length(commonlen) != 1) {
       cli::cli_abort("Lengths of {.arg m}, {.arg rho} and {.arg C} must match.")
     }
-    m <- rep(m, length.out = commonlen)
+    m <- vctrs::vec_recycle(m, commonlen)
     rho <- if (is.list(rho)) {
-      rep(rho, length.out = commonlen)
+      vctrs::vec_recycle(rho, commonlen)
     } else {
-      rep(list(rho), length.out = commonlen)
+      vctrs::vec_recycle(list(rho), commonlen)
     }
     C <- if (is.list(C)) {
-      rep(C, length.out = commonlen)
+      vctrs::vec_recycle(C, commonlen)
     } else {
-      rep(list(C), length.out = commonlen)
+      vctrs::vec_recycle(list(C), commonlen)
     }
     hsbm_list_game_impl(
       n = n,

R/plot.R

@@ -148,7 +148,7 @@ plot.igraph <- function(
     "i" = "It is recommended to store the layout as x and y vertex attributes and not as a matrix graph attribute."))
   }
   margin <- params("plot", "margin")
-  margin <- rep(margin, length.out = 4)
+  margin <- vctrs::vec_recycle(margin, 4)
   rescale <- params("plot", "rescale")
   asp <- params("plot", "asp")
   frame.plot <- params("plot", "frame.plot")
@@ -273,19 +273,19 @@ plot.igraph <- function(
     mark.groups <- communities(mark.groups)
   }
 
-  mark.shape <- rep(mark.shape, length.out = length(mark.groups))
-  mark.border <- rep(mark.border, length.out = length(mark.groups))
-  mark.col <- rep(mark.col, length.out = length(mark.groups))
-  mark.expand <- rep(mark.expand, length.out = length(mark.groups))
-  mark.lwd <- rep(mark.lwd, length.out = length(mark.groups))
+  mark.shape <- vctrs::vec_recycle(mark.shape, length(mark.groups))
+  mark.border <- vctrs::vec_recycle(mark.border, length(mark.groups))
+  mark.col <- vctrs::vec_recycle(mark.col, length(mark.groups))
+  mark.expand <- vctrs::vec_recycle(mark.expand, length(mark.groups))
+  mark.lwd <- vctrs::vec_recycle(mark.lwd, length(mark.groups))
 
   for (g in seq_along(mark.groups)) {
     .members <- mark.groups[[g]]
     v <- V(graph)[.members]
     if (length(vertex.size) == 1) {
       vs <- vertex.size
     } else {
-      vs <- rep(vertex.size, length.out = vcount(graph))[v]
+      vs <- vctrs::vec_recycle(vertex.size, vcount(graph))[v]
     }
     igraph.polygon(
       layout[v, , drop = FALSE],
@@ -335,7 +335,7 @@ plot.igraph <- function(
     )
   } else {
     ## different vertex shapes, do it by "endpoint"
-    shape <- rep(shape, length.out = vcount(graph))
+    shape <- vctrs::vec_recycle(shape, vcount(graph))
     ec <- edge.coords
     ec[, 1:2] <- t(sapply(seq(length.out = nrow(el)), function(x) {
       .igraph.shapes[[shape[el[x, 1]]]]$clip(
@@ -707,7 +707,7 @@ plot.igraph <- function(
     } else {
       ## different kinds of arrows drawn separately as 'arrows' cannot
       ## handle a vector as the 'code' argument
-      curved <- rep(curved, length.out = ecount(graph))[nonloops.e]
+      curved <- vctrs::vec_recycle(curved, ecount(graph))[nonloops.e]
       lc.x <- lc.y <- numeric(length(curved))
       for (code in 0:3) {
         valid <- arrow.mode == code
@@ -772,10 +772,10 @@ plot.igraph <- function(
       ecex <- ecex[nonloops.e]
     }
     en <- length(nonloops.e)
-    ecol <- rep(ecol, length.out = en)
-    efam <- rep(efam, length.out = en)
-    efon <- rep(efon, length.out = en)
-    ecex <- rep(ecex, length.out = en)
+    ecol <- vctrs::vec_recycle(ecol, en)
+    efam <- vctrs::vec_recycle(efam, en)
+    efon <- vctrs::vec_recycle(efon, en)
+    ecex <- vctrs::vec_recycle(ecex, en)
 
     invisible(mapply(
       function(x, y, label, col, family, font, cex) {
@@ -826,13 +826,13 @@ plot.igraph <- function(
   y <- layout[, 2] +
     label.dist * sin(-label.degree) * (vertex.size + 6 * 8 * log10(2)) / 200
   if (vc > 0) {
-    label.col <- rep(label.color, length.out = vc)
-    label.fam <- rep(label.family, length.out = vc)
-    label.fnt <- rep(label.font, length.out = vc)
-    label.cex <- rep(label.cex, length.out = vc)
-    label.ang <- rep(label.angle, length.out = vc)
-    label.adj <- rep(list(label.adj), length.out = vc)
-    label.text <- rep(labels, length.out = vc)
+    label.col <- vctrs::vec_recycle(label.color, vc)
+    label.fam <- vctrs::vec_recycle(label.family, vc)
+    label.fnt <- vctrs::vec_recycle(label.font, vc)
+    label.cex <- vctrs::vec_recycle(label.cex, vc)
+    label.ang <- vctrs::vec_recycle(label.angle, vc)
+    label.adj <- vctrs::vec_recycle(list(label.adj), vc)
+    label.text <- vctrs::vec_recycle(labels, vc)
 
     # Draw vertex labels
     invisible(mapply(
@@ -1742,24 +1742,22 @@ igraph.Arrows <- function(
   h.lty = sh.lty,
   curved = FALSE
 ) {
-  n <- length(x1)
-
-  recycle <- function(x) rep(x, length.out = n)
-
-  x1 <- recycle(x1)
-  y1 <- recycle(y1)
-  x2 <- recycle(x2)
-  y2 <- recycle(y2)
-  size <- recycle(size)
-  width <- recycle(width)
-  curved <- recycle(curved)
-  sh.lwd <- recycle(sh.lwd)
-  sh.col <- recycle(sh.col)
-  sh.lty <- recycle(sh.lty)
-  h.col <- recycle(h.col)
-  h.col.bo <- recycle(h.col.bo)
-  h.lwd <- recycle(h.lwd)
-  h.lty <- recycle(h.lty)
+  n <- vctrs::vec_size_common(x1, y1, x2, y2)
+
+  x1 <- vctrs::vec_recycle(x1, n)
+  y1 <- vctrs::vec_recycle(y1, n)
+  x2 <- vctrs::vec_recycle(x2, n)
+  y2 <- vctrs::vec_recycle(y2, n)
+  size <- vctrs::vec_recycle(size, n)
+  width <- vctrs::vec_recycle(width, n)
+  curved <- vctrs::vec_recycle(curved, n)
+  sh.lwd <- vctrs::vec_recycle(sh.lwd, n)
+  sh.col <- vctrs::vec_recycle(sh.col, n)
+  sh.lty <- vctrs::vec_recycle(sh.lty, n)
+  h.col <- vctrs::vec_recycle(h.col, n)
+  h.col.bo <- vctrs::vec_recycle(h.col.bo, n)
+  h.lwd <- vctrs::vec_recycle(h.lwd, n)
+  h.lty <- vctrs::vec_recycle(h.lty, n)
 
   uin <- 1 / xyinch()
 

R/plot.common.R

@@ -560,7 +560,7 @@ i.parse.plot.params <- function(graph, params) {
         if (length(v) == 1) {
           return(rep(v, length(range)))
         } else {
-          return(rep(v, length.out = max(range) + 1)[[range + 1]])
+          return(vctrs::vec_recycle(v, max(range) + 1)[[range + 1]])
         }
       }
     }

R/plot.shapes.R

@@ -493,7 +493,7 @@ add_shape <- function(
   if (length(vertex.size) != 1 && !is.null(v)) {
     vertex.size <- vertex.size[v]
   }
-  vertex.size <- rep(vertex.size, length.out = nrow(coords))
+  vertex.size <- vctrs::vec_recycle(vertex.size, nrow(coords))
 
   # Handle vertex.frame.width <= 0 by hiding the border
   vertex.frame.color[vertex.frame.width <= 0] <- NA
@@ -648,7 +648,7 @@ add_shape <- function(
   if (length(vertex.size) != 1 && !is.null(v)) {
     vertex.size <- vertex.size[v]
   }
-  vertex.size <- rep(vertex.size, length.out = nrow(coords))
+  vertex.size <- vctrs::vec_recycle(vertex.size, nrow(coords))
 
   # Handle vertex.frame.width <= 0 by hiding the border
   vertex.frame.color[vertex.frame.width <= 0] <- NA
@@ -891,7 +891,7 @@ add_shape <- function(
   if (length(vertex.size) != 1 && !is.null(v)) {
     vertex.size <- vertex.size[v]
   }
-  vertex.size <- rep(vertex.size, length.out = nrow(coords))
+  vertex.size <- vctrs::vec_recycle(vertex.size, nrow(coords))
   vertex.size2 <- params("vertex", "size2")
 
   if (length(vertex.size2) != 1 && !is.null(v)) {
@@ -1146,11 +1146,11 @@ mypie <- function(
       par("fg")
     }
   }
-  col <- rep(col, length.out = nx)
-  border <- rep(border, length.out = nx)
-  lty <- rep(lty, length.out = nx)
-  angle <- rep(angle, length.out = nx)
-  density <- rep(density, length.out = nx)
+  col <- vctrs::vec_recycle(col, nx)
+  border <- vctrs::vec_recycle(border, nx)
+  lty <- vctrs::vec_recycle(lty, nx)
+  angle <- vctrs::vec_recycle(angle, nx)
+  density <- vctrs::vec_recycle(density, nx)
   t2xy <- function(t) {
     t2p <- twopi * t + init.angle * pi / 180
     list(x = radius * cos(t2p), y = radius * sin(t2p))

R/sparsedf.R

@@ -73,7 +73,7 @@ as.data.frame.igraphSDF <- function(x, row.names, optional, ...) {
     cli::cli_abort("The row index must be numeric.")
   }
   if (missing(i)) {
-    rep(x[[j]], length.out = attr(x, "NROW"))
+    vctrs::vec_recycle(x[[j]], attr(x, "NROW"))
   } else {
     if (length(x[[j]]) == 1) {
       rep(x[[j]], length(i))
@@ -100,7 +100,7 @@ as.data.frame.igraphSDF <- function(x, row.names, optional, ...) {
     if (length(value) != length(i) && length(value) != 1) {
       cli::cli_abort("Replacement value has the wrong length.")
     }
-    tmp <- rep(x[[j]], length.out = attr(x, "NROW"))
+    tmp <- vctrs::vec_recycle(x[[j]], attr(x, "NROW"))
     tmp[i] <- value
     if (length(unique(tmp)) == 1) {
       tmp <- tmp[1]

R/tkplot.R

@@ -377,12 +377,12 @@ tkplot <- function(graph, canvas.width = 450, canvas.height = 450, ...) {
   edge.label.color <- params("edge", "label.color")
   arrow.size <- params("edge", "arrow.size")[1]
   curved <- params("edge", "curved")
-  curved <- rep(curved, length.out = ecount(graph))
+  curved <- vctrs::vec_recycle(curved, ecount(graph))
 
   layout <- unname(params("plot", "layout"))
   layout[, 2] <- -layout[, 2]
   margin <- params("plot", "margin")
-  margin <- rep(margin, length.out = 4)
+  margin <- vctrs::vec_recycle(margin, 4)
 
   # the new style parameters can't do this yet
   arrow.mode <- i.get.arrow.mode(graph, arrow.mode)