如何修正R中igraph图随机分割为5个连通子图的代码？

1. 初始网络构建 #

先通过以下代码创建一个矩形无向网格图：

library(igraph)
n_rows <- 10
n_cols <- 5
g <- make_lattice(dimvector = c(n_cols, n_rows))

layout <- layout_on_grid(g, width = n_cols)

n_nodes <- vcount(g)
node_colors <- rep("white", n_nodes)

for (row in 0:(n_rows-1)) {
    start_index <- row * n_cols + 1
    node_colors[start_index:(start_index+2)] <- "orange"  
    node_colors[(start_index+3):(start_index+4)] <- "purple"    
}

node_labels <- 1:n_nodes

plot(g, 
     layout = layout, 
     vertex.color = node_colors,
     vertex.label = node_labels,
     vertex.label.color = "black",
     vertex.size = 15,
     edge.color = "gray",
     main = "矩形无向网络")

![矩形无向网络]

2. 核心需求 #

目标：将上述网络随机分割为5个连通子图，要求每个节点恰好属于一个子图。

初步思路：随机选定一个节点，随机确定子图包含的节点数量，通过BFS选择节点并从原图中移除，重复该过程直到所有节点分配完毕。需处理细节：当随机节点数超过剩余节点数时取最大值，确保子图连通性等。

3. 首次尝试与问题 #

以下是首次实现的代码：

get_connected_subgraph <- function(graph, available_nodes, min_nodes = 5, max_nodes = 15) {
    if (length(available_nodes) == 0) return(NULL)
    
    start_node <- sample(available_nodes, 1)
    
    bfs_result <- bfs(graph, root = start_node, unreachable = FALSE, order = TRUE, rank = TRUE, father = TRUE)
    
    bfs_order <- intersect(bfs_result$order, available_nodes)
    
    n_subgraph_nodes <- min(sample(min_nodes:max_nodes, 1), length(bfs_order))
    
    subgraph_nodes <- bfs_order[1:n_subgraph_nodes]
    
    return(subgraph_nodes)
}

create_5_subgraphs <- function(graph) {
    available_nodes <- V(graph)
    subgraphs <- list()
    
    for (i in 1:5) {
        subgraph_nodes <- get_connected_subgraph(graph, available_nodes)
        if (is.null(subgraph_nodes)) break
        
        subgraphs[[i]] <- subgraph_nodes
        available_nodes <- setdiff(available_nodes, subgraph_nodes)
    }
    
    return(subgraphs)
}

set.seed(42) 
subgraphs <- create_5_subgraphs(g)

subgraph_colors <- c("red", "blue", "green", "yellow", "purple")

node_subgraph_colors <- rep("lightgray", vcount(g))
for (i in 1:length(subgraphs)) {
    node_subgraph_colors[subgraphs[[i]]] <- subgraph_colors[i]
}

edge_subgraph_colors <- rep("lightgray", ecount(g))
for (i in 1:length(subgraphs)) {
    subgraph_edges <- E(g)[.inc(subgraphs[[i]])]
    edge_subgraph_colors[subgraph_edges] <- subgraph_colors[i]
}

plot(g, 
     layout = layout,
     vertex.color = node_subgraph_colors,
     vertex.label = node_labels,
     vertex.label.color = "black",
     vertex.size = 15,
     edge.color = edge_subgraph_colors,
     edge.width = 2,
     main = "分割后的网络")

![分割后的网络]

存在问题：结果中黄色节点（如节点29）所在的子图不满足连通性要求，子图节点间无连接路径。

4. 节点信息对比代码 #

为了直观对比分割前后的节点归属，编写以下代码生成节点信息表：

node_info <- data.frame(
    Node_Index = 1:vcount(g),
    Original_Color = node_colors,
    New_Color = node_subgraph_colors
)

get_subgraph_number <- function(node) {
    subgraph_num <- which(sapply(subgraphs, function(x) node %in% x))
    if (length(subgraph_num) == 0) return(NA)
    return(subgraph_num)
}

node_info$Subgraph_Number <- sapply(node_info$Node_Index, get_subgraph_number)

head(node_info)

5. 修正方案与适配绘图函数 #

参考jblood94的解答，编写了确保子图连通性的分割函数，并适配了批量绘图函数以验证多次分割结果：

library(igraph)
library(data.table)

f <- function(g, n) {
    m <- length(g)
    dt <- setDT(as_data_frame(g))
    dt <- rbindlist(list(dt, dt[,.(from = to, to = from)]))
    dt[,group := 0L]
    used <- logical(m)
    s <- sample(m, n)
    used[s] <- TRUE
    m <- m - n
    dt[from %in% s, group := .GRP, from]
    
    while (m) {
        dt2 <- unique(
            dt[group != 0L & !used[to], .(grow = to, onto = group)][sample(.N)],
            by = "grow"
        )
        dt[dt2, on = .(from = grow), group := onto]
        used[dt2[[1]]] <- TRUE
        m <- m - nrow(dt2)
    }
    
    unique(dt[,to := NULL])[,.(vertices = .(from)), group]
}


plot_multiple_subgraphs <- function(n_plots = 25, n_rows = 10, n_cols = 5, n_subgraphs = 5) {
    g <- make_lattice(dimvector = c(n_cols, n_rows))
    layout <- layout_on_grid(g, width = n_cols)
    n_nodes <- vcount(g)
    
    color_palette <- c("red", "blue", "green", "yellow", "purple")
    
    par(mfrow = c(5, 5), mar = c(0.5, 0.5, 2, 0.5))
    
    for (i in 1:n_plots) {
        subgraphs <- f(g, n_subgraphs)
        
        node_colors <- rep("white", n_nodes)
        
        for (j in 1:nrow(subgraphs)) {
            nodes <- unlist(subgraphs$vertices[j])
            node_colors[nodes] <- color_palette[j]
        }
        
        plot(g, 
             layout = layout, 
             vertex.color = node_colors,
             vertex.label = NA,  
             vertex.size = 15,   
             edge.color = "gray",
             edge.width = 0.5,  
             main = paste("分割结果", i),  
             cex.main = 0.8)     
    }
}

plot_multiple_subgraphs()

![多分割结果图]

内容的提问来源于stack exchange，提问作者farrow90