This is a follow-up question from my previous question Assign Random Colors in R
(After much trial and error) I wrote this function which randomly colors some nodes on a network and colors 3 of their neighbors with the same color (notice the coloring scale – dark color for the original node, light color for the neighbors).
library(igraph)
library(colorspace)
create_colored_network <- function(width, height, colors, source_nodes, neighbor_degree = 3) {
num_nodes <- width * height
# Create a grid
x <- rep(1:width, each = height)
y <- rep(1:height, times = width)
g <- make_empty_graph(n = num_nodes, directed = FALSE)
# Function to get node index
get_node_index <- function(i, j) (i - 1) * height + j
# Add edges
edges <- c()
for(i in 1:width) {
for(j in 1:height) {
current_node <- get_node_index(i, j)
# Connect to right neighbor
if(i < width) edges <- c(edges, current_node, get_node_index(i + 1, j))
# Connect to bottom neighbor
if(j < height) edges <- c(edges, current_node, get_node_index(i, j + 1))
}
}
g <- add_edges(g, edges)
V(g)$x <- x
V(g)$y <- y
# Select random nodes and color them
all_nodes <- 1:num_nodes
V(g)$color <- "white"
for (i in 1:length(colors)) {
available_nodes <- all_nodes[!all_nodes %in% unlist(sapply(colors[1:i-1], function(c) V(g)[color == c]))]
source <- sample(available_nodes, source_nodes[i])
V(g)[source]$color <- colors[i]
# Color neighbors
neighbors <- unique(unlist(neighborhood(g, order = neighbor_degree, nodes = source)))
neighbor_color <- lighten(colors[i], amount = 0.7) # Create a lighter version of the color
V(g)[neighbors]$color <- ifelse(V(g)[neighbors]$color == "white", neighbor_color, V(g)[neighbors]$color)
}
plot(g, vertex.size = 7, vertex.label = NA, main = "Colored Network")
legend_colors <- c(colors, sapply(colors, function(c) lighten(c, amount = 0.7)), "white")
legend_labels <- c(paste(capitalize(colors), "nodes"),
paste(capitalize(colors), "neighbors"),
"Other nodes")
legend("bottom",
legend = legend_labels,
col = legend_colors,
pch = 19,
pt.cex = 1.5,
cex = 0.8,
bty = "n",
horiz = TRUE)
}
capitalize <- function(x) {
paste0(toupper(substr(x, 1, 1)), substr(x, 2, nchar(x)))
}
Here is how to call this function:
width <- 30
height <- 20
colors <- c("red", "blue", "green", "purple")
source_nodes <- c(2, 2, 3, 9)
create_colored_network(width, height, colors, source_nodes)
I am trying to make the following changes to this:
-
There is a lot of white space on the network. I was trying to get the colors to “diffuse” more across the network by trying different numbers of node numbers. I thought I could just color all the white nodes a different color … but is there some approach I can take to make sure the diffusion colors all nodes?
-
Intersections are guaranteed to happen (depends on which color expands first), e.g.
Is it possible to track which nodes have been colored over by multiple colors?
Much appreciated …
2
This might not be quite what you asked, instead of traversing through graph and tracking / updating node attributes it aims to partition all nodes into clusters.
Voronoi diagram is often used for such task and it’s also available in igraph through voronoi_cells(). Usability of resulting clusters probably depends on your actual use case, though a bit smarter approach for sampling source node locations should provide finer control over resulting cluster distribution (perhaps spatstat.random::runifpoint() for uniform distribution, or spatstat.random::rstrat() to generate spatially stratified point locations) .
library(igraph, warn.conflicts = FALSE)
# width, height - lattice dimensions
# colors - character vector of colors
# source_nodes - number of source nodes for each color in `colors`
# tiebreaker - what to do when a vertex is at the same distance from multiple generators
# ("random", "first", "last")
create_colored_network <- function(width, height, colors, source_nodes, tiebreaker = "random") {
# create lattice graph
g <- make_lattice(dimvector = c(height,width))
V(g)$x <- rep(seq_len(width), each = height)
V(g)$y <- rep(seq_len(height), times = width)
# generate a shuffled vector of source nodes, colors as names
# Named num [1:16] 375 101 229 490 199 132 586 36 571 178 ...
# - attr(*, "names")= chr [1:16] "green" "purple" "red" "blue" ...
# sample from graph vertex sequnece
# source_idx <-
# sample(vcount(g), sum(source_nodes)) |>
# setNames(rep(colors, source_nodes) |> sample())
# sample through x-y coordinates
source_idx <-
# sample x & w coordinates for source nodes
sapply(list(width, height), sample, sum(source_nodes)) |>
# calculate node inidices from sampled coordinates
apply(MARGIN = 1, (xy, h) (xy[1] - 1) * h + xy[2], h = height) |>
# shuffle colors, affects tiebreaking in voronoi_cells
setNames(rep(colors, source_nodes) |> sample())
# use Voronoi partitioning to cluster all network nodes by source_idx nodes,
# clu$membership includes source node sequence number (0-based)
clu <- voronoi_cells(g, source_idx, tiebreaker = tiebreaker)
# set all node colors to lightened varaiants of colors from source_idx names
V(g)$color <-
# sequence numbers are 0-based
source_idx[clu$membership + 1] |>
names() |>
colorspace::lighten(amount = 0.7)
# override source node colors
V(g)$color[source_idx] <- names(source_idx)
# store source node flag and cluster id in vertex attributes
V(g)$is_source <- FALSE
V(g)$is_source[source_idx] <- TRUE
V(g)$membership <- clu$membership
# return graph
g
}
set.seed(42)
g <- create_colored_network(
width = 30, height = 20,
colors = c("red", "blue", "green", "purple"),
source_nodes = c(2, 2, 3, 9),
tiebreaker = "first")
withr::with_par(
list(mar = c(0,0,0,0)),
plot(g, layout = cbind(V(g)$x, V(g)$y),
vertex.size = 7,
vertex.label = V(g)$membership,
vertex.label.cex = .75,
vertex.frame.color = V(g)$membership,
vertex.frame.width = .5,
edge.arrow.size = 0.5,
edge.color = "lightgray")
)
You might also want test with other tiebreaker values of voronoi_cells(), default is "random", which is more likely to result with some scattered nodes surrounded by another cluster. Here are all 3 options, ("random", "first", "last"):
withr::with_par(
list(mfrow = c(1, 3), mar = c(10,0,5,0)),
lapply(c("random", "first", "last"),
(tb) {
set.seed(42)
create_colored_network(width = 30, height = 20,
colors = c("red", "blue", "green", "purple"),
source_nodes = c(2, 2, 3, 9), tiebreaker = tb) |>
plot(layout = cbind(V(g)$x, V(g)$y), vertex.size = 7,
vertex.label = V(g)$membership, vertex.label.cex = .75,
vertex.frame.color = V(g)$membership, vertex.frame.width = .5,
edge.arrow.size = 0.5, edge.color = "lightgray",
main = paste0("tiebreaker = ", tb))
}
)
)
Created on 2024-09-05 with reprex v2.1.1
2