0Knowledge
0Knowledge

Reputation: 755

How to add an edge between components of a graph based on the maximum degree of a node of the component

I have a graph that contains 4 components of different cluster sizes. Main Graph

I can see the details using the below code

cl <- components(graph1)

The details are looks like

$membership
ID_00104 ID_00136 ID_00169 ID_00178 ID_00180 ID_06663 ID_06791 ID_09099 ID_00910 ID_00790 ID_01013 ID_01130 ID_01260 ID_00394 ID_00860 ID_00959 ID_01222 ID_00288 ID_00324 ID_00663 ID_00846 ID_01047 ID_06781 ID_06786 
       1        2        2        3        4        1        1        1        2        3        4        4        4        4        4        4        4        4        4        4        4        4        4        4 

$csize
[1]  4  3  2 15

$no
[1] 4

I can also get the number of degree of a node using the below code

degree(graph1)

and the output is

ID_00104 ID_00136 ID_00169 ID_00178 ID_00180 ID_06663 ID_06791 ID_09099 ID_00910 ID_00790 ID_01013 ID_01130 ID_01260 ID_00394 ID_00860 ID_00959 ID_01222 ID_00288 ID_00324 ID_00663 ID_00846 ID_01047 ID_06781 ID_06786 
       3        2        2        1       14        1        1        1        2        1        1        1        1        1        1        1        1        1        1        1        1        1        1        1 

I can add all components (randomly choosing 2 nodes from 2 components) using the below code (solution from one of my previous posts)

graph1 <-  graph_from_data_frame(g, directed = FALSE)
E(graph1)$weight <- g$values
cl <- components(graph1)
graph2 <- with(
  stack(membership(cl)),
  add.edges(
    graph1,
    c(combn(sapply(split(ind, values), sample, size = 1), 2)),
    weight = 0.01))

Now, I want to add an edge between those nodes that have the highest number of degree e.g: ID_00180 has degree 14 (left side component of the attached image) and ID_00104 has degree 3 (the top component of the attached image). At the time of combining these 2 components, I want to add an edge between ID_00180 and ID_00104 (instead of taking randomly).

If any components have multiple same numbers of highest degree e.g: the right bottom components of the attached image (all nodes have degree 2) then we can take anyone randomly from the highest degree node. Say, we can add an edge between ID_00180 and any nodes

Reproducible Data

g <- structure(list(query = structure(c(1L, 1L, 1L, 2L, 2L, 3L, 4L, 
                                        5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L), .Label = c("ID_00104", 
                                                                                                            "ID_00136", "ID_00169", "ID_00178", "ID_00180"), class = "factor"), 
                    target = structure(c(16L, 19L, 20L, 1L, 9L, 9L, 6L, 11L, 
                                         13L, 15L, 4L, 8L, 10L, 14L, 2L, 3L, 5L, 7L, 12L, 17L, 18L
                    ), .Label = c("ID_00169", "ID_00288", "ID_00324", "ID_00394", 
                                  "ID_00663", "ID_00790", "ID_00846", "ID_00860", "ID_00910", "ID_00959", 
                                  "ID_01013", "ID_01047", "ID_01130", "ID_01222", "ID_01260", "ID_06663", 
                                  "ID_06781", "ID_06786", "ID_06791", "ID_09099"), class = "factor"), 
                    values = c(0.654172560113154, 0.919096895578551, 0.925821596244131, 
                                0.860406091370558, 0.746376811594203, 0.767195767195767, 
                                0.830379746835443, 0.661577608142494, 0.707520891364902, 
                                0.908193484698914, 0.657118786857624, 0.687664041994751, 
                                0.68586387434555, 0.874513618677043, 0.836646499567848, 0.618361836183618, 
                                0.684163701067616, 0.914728682170543, 0.876297577854671, 
                                0.732707087959009, 0.773116438356164)), row.names = c(NA, 
                                                                                      -21L), class = "data.frame")

Upvotes: 4

Views: 102

Answers (2)

ThomasIsCoding
ThomasIsCoding

Reputation: 101247

Update

graph2 <- add.edges(
  graph1,
  combn(
    sapply(
      decompose(graph1),
      function(p) sample(names(V(p))[degree(p) == max(degree(p))], 1)
    ), 2
  ),
  weight = 0.01
)

plot(graph2, layout = layout_nicely(graph1))

gives

enter image description here


Previous Answer

You can try

out <- combn(
  decompose(graph1),
  2,
  FUN = function(x) {
    add.edges(
      graph1,
      sapply(x, function(p) sample(names(V(p))[degree(p) == max(degree(p))], 1)),
      weight = 0.01
    )
  },
  simplify = FALSE
)

sapply(out,plot)

Upvotes: 2

G5W
G5W

Reputation: 37641

## Save the layout from graph1
set.seed(2021)
LO = layout_nicely(graph1)
plot(graph1, layout=LO)

MaxNode <- rep("", max(cl$membership))
for(i in 1:max(cl$membership)) {
    MaxNode[i] <- names(which.max(degree(graph1)[cl$membership == i])) 
}
graph2 <-add.edges(graph1, combn(MaxNode, 2), weight = 0.01)
plot(graph2, layout=LO)

Graph with extra edges

Upvotes: 3

Related Questions