How to generate a random attribute based edge without creating a duplicate edge in igraph?

user_8854291 0
Viewed 51

I currently have a code like this: 

g <- erdos.renyi.game(30, 151 , type = "gnm" , directed = F , loops = F)%>%
  set_vertex_attr("a", value = 0) 

V(g)$a <- sample(c(0, 1), vcount(g), replace = TRUE, prob = c(.25, .75))

g <- add_edges(g,c(sample(V(g)[V(g)$a==0],1), sample(V(g)[V(g)$a == 1], 1)))

I am trying to generate a random, new edge based on attribute values. However, currently due to the high density of edges in the graph, many times the generated edges are duplicates. How can I modify the last line of code so that it doesn't generate a duplicate edge?

igraph r
1 Answers

One way to do this would be to figure out which pairs of nodes have no edge between them and then sample randomly from those pairs. The code below can be packaged into a function so that you can successively add new edges at random.

library(purrr) # For map function

# Create graph reproducibly
set.seed(54)
g <- erdos.renyi.game(30, 151 , type = "gnm" , directed = F , loops = F) %>%
  set_vertex_attr("a", value = 0) 

V(g)$a <- sample(c(0, 1), vcount(g), replace = TRUE, prob = c(.25, .75))

# List all possible pairs of nodes
all_pairs = apply(combn(1:vcount(g), 2), 2, paste, collapse="-")

# List all pairs of nodes with edges between them
current_pairs = apply(get.edgelist(g), 1, paste, collapse="-")

# List all pairs of nodes with no edge between them
eligible_pairs = setdiff(all_pairs, current_pairs)

# Get indices of eligible pairs with desired attribute a criteria
attr_select = map_lgl(strsplit(eligible_pairs, "-"), function(p) {
  (p[1] %in% V(g)[V(g)$a==0] & p[2] %in% V(g)[V(g)$a==1]) |
    (p[1] %in% V(g)[V(g)$a==1] & p[2] %in% V(g)[V(g)$a==0])
})

# Keep only those pairs that meet the attribute a condition above
eligible_pairs = eligible_pairs[attr_select]

# Add an edge at random between two nodes that don't currently have an edge between them 
# and that meet the attribute a criteria
set.seed(10)  # This is just for reproducibility of this example. Remove this if you want a different pair selected each time in your actual use case.
new_edge = unlist(strsplit(sample(eligible_pairs, 1), "-"))

g <- add_edges(g, new_edge)
user_4964880
Related