模拟范围内的随机数总和为常数？

Question

这是我之前发布的问题的后续问题。

不久前，我发布了这个关于如何将图随机拆分为连接的子图的问题：随机将图拆分为迷你图：

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 = "Rectangular Undirected Network")

我使用提供的（令人惊叹的）答案之一多次运行此函数（https://stackoverflow.com/a/78982967/26653497）：

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("Partition", i),  
             cex.main = 0.8)     
    }
}

plot_multiple_subgraphs()

我现在想知道 - 有没有办法向这个函数添加约束？例如，我想要 7 个随机连接的子图，使得每个图最少占所有节点的 5%，最多占所有节点的 25%？

我编写了这个小函数，它生成 7 个随机数，总和为 100，使得最小数大于 5，最大数小于 25：

generate_one_set <- function(n = 7, total = 100, min_val = 5, max_val = 25) {
  repeat {
    points <- sort(c(0, runif(n-1), 1))
    numbers <- diff(points) * total
    if(min(numbers) >= min_val && max(numbers) <= max_val) {
      return(round(numbers, 2))
    }
  }
}

set.seed(123) 
for(i in 1:5) {
    result <- generate_one_set()
    print(result)
    cat("Sum:", sum(result), "\n\n")
}

[1] 12.75  7.90 16.79 18.65 19.24 14.17 10.50
Sum: 100 

[1]  9.48 17.95 10.96  6.45 21.66 14.95 18.54
Sum: 99.99 

[1] 18.38  8.19 14.71 21.72 11.66 11.71 13.64
Sum: 100.01 

[1] 16.81  9.95 13.69 12.67  6.20 19.22 21.47
Sum: 100.01 

[1]  8.63 11.57  8.10 13.74 16.68 21.94 19.33
Sum: 99.99 

我可以以某种方式将此约束引入到之前的函数中吗？

Answer 1

或许你可以尝试一下

N <- n_rows * n_cols
minRho <- 0.05
maxRho <- 0.25
minSz <- ceiling(minRho * N)
repeat {
    p <- rmultinom(1, N - minSz * 7, rep(1, 7)) + minSz
    if (all(p <= maxRho * N)) break
}
p

你会得到类似的东西

> p
     [,1]
[1,]    6
[2,]    9
[3,]    6
[4,]    6
[5,]    7
[6,]    7
[7,]    9

> sum(p)
[1] 50