确保颜色正确放置在图表中

Question

我编写了这段代码，试图在方形网格上制作彩色图案，这样对于给定的颜色，该颜色的所有方块都可以到达该颜色的所有其他方块，而无需踩到任何其他颜色。**

首先我制作了网格：

library(igraph)

create_lattice_graph <- function(width, height) {
    coords <- expand.grid(x = 1:width, y = 1:height)
    n_nodes <- nrow(coords)
    
    horizontal_edges <- cbind(1:(n_nodes-1), 2:n_nodes)
    horizontal_edges <- horizontal_edges[horizontal_edges[,1] %% width != 0, ]
    
    vertical_edges <- cbind(1:(n_nodes-width), (width+1):n_nodes)
    
    edges <- rbind(horizontal_edges, vertical_edges)
    g <- make_graph(edges = t(edges), n = n_nodes, directed = FALSE)
    
    return(list(graph = g, layout = as.matrix(coords)))
}

然后，我编写了一个函数来检查颜色选择是否有效：

is_valid_move <- function(position, player, territories, g) {
    neighbors <- neighbors(g, position)
    has_same_territory_neighbor <- any(territories[neighbors] == player)
    return(has_same_territory_neighbor)
}

从这里设置颜色（选择一组源节点）：

generate_territories <- function(width, height, source_nodes) {
    lattice <- create_lattice_graph(width, height)
    g <- lattice$graph
    n_nodes <- vcount(g)
    n_players <- length(source_nodes)
    
    territories <- rep(NA, n_nodes)
    
    for(i in 1:n_players) {
        territories[source_nodes[i]] <- i
    }
    
    while(any(is.na(territories))) {
        empty_positions <- which(is.na(territories))
        valid_moves <- list()
        
        for(pos in empty_positions) {
            neighbors <- neighbors(g, pos)
            neighbor_territories <- unique(territories[neighbors])
            neighbor_territories <- neighbor_territories[!is.na(neighbor_territories)]
            
            if(length(neighbor_territories) > 0) {
                for(territory in neighbor_territories) {
                    if(is_valid_move(pos, territory, territories, g)) {
                        valid_moves[[length(valid_moves) + 1]] <- list(
                            position = pos,
                            territory = territory
                        )
                    }
                }
            }
        }
        
        if(length(valid_moves) == 0) break
        
        selected_move <- sample(length(valid_moves), 1)
        position <- valid_moves[[selected_move]]$position
        territory <- valid_moves[[selected_move]]$territory
        territories[position] <- territory
    }
    
    return(territories)
}

最后，结果可视化：

convert_to_color_matrix <- function(territories, width, height) {
    color_matrix <- matrix(".", nrow = height, ncol = width)
    color_map <- c("R", "B", "G", "Y", "P")
    
    for(i in 1:length(territories)) {
        row <- ceiling(i/width)
        col <- ((i-1) %% width) + 1
        color_matrix[row, col] <- color_map[territories[i]]
    }
    
    return(color_matrix)
}

plot_color_matrix <- function(color_matrix, source_nodes = NULL) {
    plot(NULL, xlim = c(0, ncol(color_matrix)), ylim = c(0, nrow(color_matrix)),
         xlab = "", ylab = "", axes = FALSE, asp = 1)
    
    color_map <- c(
        "R" = "#FF6B6B",  # Red
        "B" = "#4DABF7",  # Blue
        "G" = "#69DB7C",  # Green
        "Y" = "#FFD93D",  # Yellow
        "P" = "#DA77F2",  # Purple
        "." = "#F8F9FA"   # Empty
    )
    
    for(i in 1:nrow(color_matrix)) {
        for(j in 1:ncol(color_matrix)) {
            linear_idx <- (i-1)*ncol(color_matrix) + j
            is_source <- linear_idx %in% source_nodes
            
            rect(j-1, nrow(color_matrix)-i, j, nrow(color_matrix)-i+1,
                 col = color_map[color_matrix[i,j]],
                 border = if(is_source) "black" else "gray90",
                 lwd = if(is_source) 2 else 0.5)
            
            # Add node numbers
            text(j-0.5, nrow(color_matrix)-i+0.5, linear_idx,
                 col = "black", cex = 0.4)
        }
    }
}

完整的模拟如下所示：

width <- 10
height <- 10
source_nodes <- c(1, 10, 91, 100, 45) 
territories <- generate_territories(width, height, source_nodes)
color_matrix <- convert_to_color_matrix(territories, width, height)
plot_color_matrix(color_matrix, source_nodes)
title("Territory Simulation")

当我运行多次模拟时，我注意到有时会违反此颜色连接规则：

例如，在上面我可以看到有一块红色，然后是紫色，然后是红色......这样一些红色就与其余的红色被锁定了。

有办法解决这个问题吗？

谢谢

Answer 1

下面的代码在分割方面没有给出完全的随机性（由于使用了

bfs

），但我尝试使用

rmultinom

来弥补这个缺点。

请注意，代码将您的

create_lattice_graph

作为其中的一部分：

f <- function(width, height, source_nodes, rndSeed = 0) {
  set.seed(rndSeed)
  # create graph
  s <- create_lattice_graph(width, height)
  g <- s$graph
  lo <- s$layout

  # define number of sub graphs
  nrsubg <- length(source_nodes)
  g <- g %>%
    set_vertex_attr("name", value = seq.int(vcount(.)))

  # iteratively partition the graph from given source node
  repeat {
    gg <- g
    valid <- TRUE
    vlst <- setNames(vector("list", nrsubg), seq.int(nrsubg))
    szsubg <- rmultinom(1, vcount(g) - nrsubg, runif(nrsubg)) + 1
    for (i in seq_along(szsubg)) {
      u <- names(bfs(gg, as.character(source_nodes[i]), callback = \(graph, data, extra) data["rank"] == szsubg[i])$order)
      if (is_connected(induced_subgraph(gg, u)) & sum(source_nodes %in% u) == 1) {
        gg <- induced_subgraph(gg, V(gg)[!names(V(gg)) %in% u])
        vlst[[i]] <- u
      } else {
        valid <- FALSE
        break
      }
    }
    if (vcount(gg) == 0) break
  }

  # visualize the partitions
  g %>%
    set_vertex_attr("color",
      value = with(stack(vlst), ind[match(names(V(.)), values)])
    ) %>%
    plot(
      layout = lo,
      vertex.label = V(.)$name,
      vertex.label.color = "black",
      vertex.size = 15,
      edge.color = "gray",
      main = sprintf("territory simulation (random seed = %i)",rndSeed)
    )
}

示范

给定输入参数如下

width <- 10
height <- 10
source_nodes <- c(1, 10, 91, 100, 45)

我们将分别获得随机种子

0

到

4

的分割