rgraphigraphgreedysubgraph

Creating subgraphs from neighbors with max weight in R using igraph


I am trying to create subgraphs from pairs of edges in a graph a by following procedure:

library(igraph)
library(data.table)

dt <- data.table(from = c("A", "B", "C", "D", "E"),
                 to = c("B", "C", "D", "E", "A"),
                 weight1 = c(1, 2, 3, 4, 5),
                 weight2 = c(0, 0, 1, 0, 1))

a <- graph_from_data_frame(dt, directed = FALSE)
  1. Find all pairs with weight2 == 1, every pair is a start for new sub-graph find, so we could got a list of sub-graph g1, g2, g3, etc... :
G = {g1, g2, g3, ..., g_i} g_i ∈ a, nodes(gi) = 2
  1. For each g_i, find all its neighbors (n1, n2, n3, ..., n_i), for ecah neighbors calaulate the sum of weight1 of all edges n_i connected to graph g_i, denoted as sum_i

  2. if a neighbor node have a max of sum_i of all neighbor nodes, add this node and all its edge (connected to g_i) to graph g_i

  3. repeat step 2-3 for 3 times or no new neighbors found

I trying to use igraph in R, but not work.

g <- a
for (i in 1:length(edges)) {
  g_a <- induced_subgraph(g, ends(g, edges[i]))
  
  for (j in 1:3) {
    neighbors <- unique(unlist(lapply(V(g)[V(g)$name %in% V(g_a)$name], \(x) neighbors(g, x))))
    
    if (length(neighbors) == 0) break
    
    s_values <- sapply(neighbors, function(x) sum(E(g_a, path = c(V(g)[V(g)$name %in% V(g_a)$name], x))$weight1))
    
    max_node <- neighbors[which.max(s_values)]
    
    g_a <- add_vertices(g_a, 1, name = max_node$name)
    new_edges <- E(g, path = c(V(g_a), max_node))
    g_a <- add_edges(g_a, t(as.data.frame(get.edgelist(g, new_edges))), attr = list(weight1 = new_edges$weight1))
  }
}

Solution

  • probably this is what you are after

    edges <- E(a)[E(a)$weight2 == 1]
    ag <- subgraph.edges(a, edges)
    lapply(
        decompose(ag),
        \(h) {
            nbs <- setdiff(
                unique(names(unlist(ego(a, nodes = names(V(h)), mindist = 1)))),
                names(V(h))
            )
            p <- lapply(nbs, \(x) induced_subgraph(a, c(names(V(h)), x)))
            p[[which.max(sapply(p, \(s) sum(E(s)$weight1)))]]
        }
    )
    

    which gives

    [[1]]
    IGRAPH 6913930 UN-- 3 2 --
    + attr: name (v/c), weight1 (e/n), weight2 (e/n)
    + edges from 6913930 (vertex names):
    [1] D--E A--E
    
    [[2]]
    IGRAPH 6914fac UN-- 3 2 --
    + attr: name (v/c), weight1 (e/n), weight2 (e/n)
    + edges from 6914fac (vertex names):
    [1] C--D D--E