r igraph - создает связь между узлами на основе их общего соединения и того же типа связи с третьим узлом

Question

Узлы A и B в настоящее время не связаны, и я хочу подключить их, если они удовлетворяют двум условиям: 1) оба подключены к одному и тому же третьему узлу;2) тип привязки к третьему узлу такой же.Скажем, А и Б - сыновья одного и того же отца, тогда я хочу назвать их родными братьямиКак мне поручить igraph создать этот новый галстук?Возьмите следующий пример.

edgelist <- read.table(text = "
A C
B C
C D")
graph <- graph.data.frame(edgelist, directed = F)
E(graph)[1]$weight <- 2
E(graph)[2]$weight <- 2
E(graph)[3]$weight <- 1

IGRAPH 0dd6cf1 DNW- 4 3 -- 
+ attr: name (v/c), weight (e/n)
+ edges from 0dd6cf1 (vertex names):
[1] A->C B->C C->D

В этом примере A и B подключены к C, и оба их соединения имеют вес 2. Как мне соединить A и B друг с другом, но не с D?В моей реальной сети тысячи узлов, поэтому мне нужно автоматизировать процесс.

Answer 1

Вероятно, есть более простой способ сделать это, но я думаю, что это может дать вам то, что вы хотите.Я немного расширил ваш пример, чтобы добавить несколько случаев.

library(igraph)

options(stringsAsFactors = FALSE)

edgelist <- read.table(text = "
                       A C
                       B C
                       C D
                       D A
                       E C
                       D F
                       D G")

g <- graph.data.frame(edgelist, directed = F)

E(g)$weight <- c(2,2,1,1,2,2,2)

#plot graph, scaling the weights just to make them more obvious
plot(g, edge.width = E(g)$weight*3)

#convert back to edgelist
el <- as.data.frame(get.edgelist(g))
el$weight <- E(g)$weight

ids <- unique(c(el$V1, el$V2))

#select sets of alters of all nodes that have edge weight equal to 2 
y <- lapply(ids, function(id) {

  x <- el[which(el$V1 == id | el$V2 == id),]
  x <- x[which(x$weight == 2),]
  alt_nodes <- setdiff(unique(c(x$V1, x$V2)), id)

})

#select sets that have 2 or more edges with weight 2
ly <- which(unlist(lapply(y, length))>= 2)

#add connections of weight 1 between all of these sets of nodes
res <- lapply(ly, function (i) {

  new_edge <- y[[i]]
  ne <- t(combn(new_edge,2))
  ne <- cbind(ne, rep(1, nrow(ne)))
  colnames(ne) <- names(el)
  el< <- rbind(el, ne)

})

#convert back to graph
g2  <-  graph.data.frame(el, directed  =  F)
E(g2)$weight <- el$weight

plot(g2, edge.width = as.numeric(E(g2)$weight)*3)