Eu escrevi este código que tenta criar padrões coloridos em uma grade quadrada de modo que, para uma determinada cor, todos os quadrados daquela cor possam alcançar todos os outros quadrados daquela cor sem pisar em nenhuma outra cor.**

Primeiro fiz a grade:

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)))
}

Então, escrevi uma função que verifica se uma escolha de cor é válida:

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)
}

A partir daqui, a cor é definida (um conjunto de nós de origem são escolhidos):

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)
}

Por fim, os resultados são visualizados:

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)
        }
    }
}

A simulação completa se parece com isso:

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")

Quando executei várias simulações, percebi que essa regra de conectividade de cores às vezes é violada:

Por exemplo, acima posso ver que há um bloco vermelho, seguido de roxo, seguido de vermelho... de modo que parte do vermelho está bloqueada do resto do vermelho.

Existe alguma maneira de resolver esse problema?

Obrigado