Fading Colors in a Graph

Question

I have a random graph in R in which one random node is colored red (square) - and all other nodes are colored lighter shades of red relative to their distance from the original node (i.e. based on "degree"):

 library(igraph)
library(colorRamps)

set.seed(123)

n_nodes <- 20  
n_edges <- 30 
g <- erdos.renyi.game(n_nodes, n_edges, type = "gnm")

random_red_node <- sample(1:n_nodes, 1)

distances <- distances(g, v = random_red_node, to = V(g))
max_distance <- max(distances)

color_palette <- colorRampPalette(c("red", "white"))(max_distance + 1)

node_colors <- color_palette[distances + 1]
node_colors[random_red_node] <- "red"

node_shapes <- rep("circle", n_nodes)
node_shapes[random_red_node] <- "square"

node_labels <- distances + 1

par(mar = c(5, 4, 4, 8), xpd = TRUE)

plot(g,
     vertex.color = node_colors,
     vertex.size = 15,
     vertex.label = node_labels,
     vertex.label.color = "black",
     vertex.shape = node_shapes,
     vertex.frame.color = "black",
     edge.arrow.size = 0.5,
     main = "Network with Distance-Based Node Coloring")

I am trying to change this so that now I can have multiple square nodes of different colors, and the same fading is applied:

The idea is to mimic diffusion of colors such that they create natural boundaries.

Thank you.

Here is a question that might help: How to tell if a point has been colored twice in R?

---

edit: My approach - this only works for a few nodes and will not work for multiple source nodes of the same color (e.g. multiple reds)

First, I use a function to define the color gradients:

library(igraph)
library(colorRamps)

set.seed(123)

blend_colors <- function(colors, weights) {
    if (length(colors) != length(weights)) stop("")
    
    rgb_colors <- col2rgb(colors)
    blended <- rowSums(rgb_colors %*% diag(weights)) / sum(weights)
    rgb(blended[1], blended[2], blended[3], maxColorValue = 255)
}

I then generate a network for the problem:

n_nodes <- 20
n_edges <- 30
g <- erdos.renyi.game(n_nodes, n_edges, type = "gnm")

n_colored_nodes <- 4
colored_nodes <- sample(1:n_nodes, n_colored_nodes)
node_colors <- c("red", "blue", "green", "purple")[1:n_colored_nodes]

The fading is a function of distance, I tried to capture this idea:

distances_list <- lapply(colored_nodes, function(node) {
  distances(g, v = node, to = V(g))
})
max_distance <- max(unlist(distances_list))
normalized_distances <- lapply(distances_list, function(d) {
  1 - (d / max_distance)
})

Here is how I call this :

blended_colors <- sapply(1:n_nodes, function(i) {
  weights <- sapply(normalized_distances, function(d) d[i])
  blend_colors(node_colors, weights)
})

node_shapes <- rep("circle", n_nodes)
node_shapes[colored_nodes] <- "square"

par(mar = c(5, 4, 4, 8), xpd = TRUE)

plot(g,
     vertex.color = blended_colors,
     vertex.size = 15,
     vertex.label = NA,
     vertex.shape = node_shapes,
     vertex.frame.color = "black",
     edge.arrow.size = 0.5,
     main = "Network with Multi-Color Diffusion")

legend("topright", inset = c(-0.2, 0), 
       legend = paste("Node", colored_nodes), 
       fill = node_colors, 
       title = "Source Nodes", 
       bty = "n")

Answer 1

Not sure what's the big picture here, but I changed the logic a bit:

• source node colors are fixed and not updated
• distance calculation through breath-first search starting from source (color) nodes, other source nodes are excluded from each search; this means that source nodes that are only accessible through other source nodes do not contribute anymore, for example in a network 1 - Red - Blue - 2, 1 becomes Red and not 2/3 Red + 1/3 Blue; and 2 becomes Blue
• color blending with colorjam::blend_colors(), it blends multiple colors and uses alpha values for weights; and as jamba comes as a dependency anyway, jamba::alpha2col() for setting alpha values; colorjam is currently only available from Github, remotes::install_github("jmw86069/colorjam")
• inverse distance weights for each non-source node sum up to 1, so there should be no issues with different number of source nodes or with multiple source nodes of the same color; this also plays nice with jamba::alpha2col() & colorjam::blend_colors() defaults.

# remotes::install_github("jmw86069/colorjam")
library(igraph, warn.conflicts = FALSE)

blend_colors <- function(colors, weights) {
  colors  <- na.omit(colors)
  weights <- na.omit(weights)
  if (length(colors) != length(weights)) stop("legth mismatch")
  # weights should add to 1, but let's leave some floating point margin
  if (sum(weights) > 1.1) stop("weights sum > 1.1")
  
  jamba::alpha2col(colors, weights) |> 
    colorjam::blend_colors()
}

color_g <- function(g, node_colors = c("red", "green", "blue")){
  # named vertices to get named lists and named matrices
  V(g)$name <- V(g)
  # for more convenient source / non-source vertex subsets
  V(g)$src <- FALSE
  
  # mark a set of length(node_colors) as src nodes, assign input colors
  # V(g)[sample(name, length(node_colors))]$src <- TRUE
  V(g)[sample(V(g), length(node_colors))]$src <- TRUE
  V(g)[ src]$color <- sample(node_colors)
  V(g)[!src]$color <- "white"
  
  V(g)[ src]$shape <- "square"
  V(g)[!src]$shape <- "circle"
  
  # breath-first search from each src node, restricted to non-src nodes + itself to
  # find distances without going through other src nodes; -1 == unreachable (not in a restricted list) 
  dist_from_src <- 
    lapply(
      V(g)[src], 
      \(v_src) bfs(g, v_src, unreachable = FALSE, restricted = c(v_src, V(g)[!src]), dist = TRUE)$dist
    ) |> 
    do.call(what = rbind)
  # with 10 nodes, 15 edges, 3 src/color nodes (3:R, 5:G, 9:B):
  #   1 2  3 4  5 6 7 8  9 10
  # 3 2 2  0 1 -1 2 1 1 -1 -1
  # 5 3 2 -1 3  0 1 1 2 -1  1
  # 9 1 2 -1 1 -1 4 3 3  0  1  

  # exclude source node columns, transpose; 
  # with actual colors in column names we can later conveniently 
  # extract named weight vectors
  color_dist <- 
    dist_from_src[, -V(g)[src]] |> 
    `rownames<-`(V(g)[src]$color) |> 
    t()
  color_dist[color_dist < 1] <- NA
  
  inv_dist_color_weights <- (1/color_dist) / rowSums(1/color_dist, na.rm = TRUE)
  # with 10 nodes, 15 edges, 3 colors:
  #     red green blue <- V: 3 5 9
  # 1  0.27  0.18 0.55
  # 2  0.33  0.33 0.33
  # 4  0.43  0.14 0.43
  # 6  0.29  0.57 0.14
  # 7  0.43  0.43 0.14
  # 8  0.55  0.27 0.18
  # 10   NA  0.50 0.50  

  # each row in inv_dist_color_weights matrix is a set of weights, 
  # colors in column names, NA colors did not contribute; 
  # extract named vectors, omit NAs, pass names(colors) and weights 
  # to blend_colors(); update non-source vertices
  V(g)[!src]$color <- 
    apply(inv_dist_color_weights, 1, c, simplify = F) |> 
    lapply(na.omit) |> 
    sapply(\(cw) blend_colors(names(cw), cw))
  
  g
}

set.seed(123)
n_nodes <- 20
n_edges <- 30

g <- sample_gnm(n_nodes, n_edges)
g_c <- color_g(g, c("red", "blue", "green", "red", "blue"))
withr::with_par(
  list(mar = c(0, 0, 0, 0)),
  plot(g_c)
)

---

Few others:

g_2 <- color_g(make_tree(n = 33, mode = "undirected"), colorjam::rainbowJam(5, preset = "ryb"))
g_3 <- color_g(make_lattice(dimvector = c(5,5)), c("red", "red", "gold"))
withr::with_par(
  list(mfrow = c(1,2), mar = c(0, 0, 0, 0)),
  {
    plot(g_2)
    plot(g_3)
  }
)

^{Created on 2024-09-13 with reprex v2.1.1}