Создание нового графа на основе кластера anylise с ребрами, которые являются соединителями из созданной группы - PullRequest
0 голосов
/ 26 ноября 2018
library(network)
library(networkD3)
library(igraph)
library(visNetwork)

df <- read.table(header = TRUE, 
                 text = "src   target
                 cllient1  cllient2
                 cllient1  cllient4
                 cllient1  cllient6
                 cllient2  cllient3
                 cllient4  cllient1
                 cllient4  cllient3
                 cllient5  cllient6
                 cllient6  cllient5")

df_graph <- graph_from_data_frame(df)
simpleNetwork(df,zoom = T,fontSize = 9)

enter image description here

wc <- cluster_walktrap(df_graph)

members <- membership(wc)

df_graph_cntrctd <- contract(df_graph, members, vertex.attr.comb = toString)

df_graph_cntrctd <-as.undirected(df_graph_cntrctd)

df_graph_cntrctd <- as_long_data_frame(df_graph_cntrctd)

idLabel <- df_graph_cntrctd[,c(2,4)]

idLabel <- idLabel[!duplicated(df_graph_cntrctd[c("to","ver2[el[, 2], ]")]),]

colnames(idLabel)[1] <- "id"
colnames(idLabel)[2] <- "title"
idLabel['label'] <- idLabel$id

FromTo <-df_graph_cntrctd[,c(1,2)]
FromTo <- FromTo[!duplicated(FromTo[c("from","to")]),]

nodes <- data.frame(id = idLabel$id, 
                    label = idLabel$label,
                    title = idLabel$title)      

edges <- data.frame(from = FromTo$from, to = FromTo$to)


network<-(visNetwork(nodes, edges, width = "100%",height = 900 ) %>% 
            visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE))

enter image description here Пока у нас есть сеть :) И можно получить список клиентовкем есть связь между группами, созданными walktrap.Идея состоит в том, чтобы показать этих клиентов по краям.Были созданы строки кода, которые показывают список всех соединений только в порядке убывания

V(df_graph)$name <- members
x <- as_edgelist(df_graph, names = T)
V(df_graph)$name <- 1:vcount(df_graph)
E(df_graph)[x[,1] != x[,2]]

В результате мы получаем

+ 1/8 edge from c92bcba (vertex names):
[1] 1->5

, что означает, что группа с меткой "1"связан с группой (метка" 2 ")" client1 "с помощью идентификатора номер 1 и" client6 "с идентификатором номер 5, насколько я понял. Мой вопрос , как получить такой результат, как здесь, где мы можем создать после всей таблицы, как это:

  from  to  label
    1   1   NA
    1   2   Client1,Client6
    2   2   NA

, где "from" и "to" - это имена групп, созданных изкластерный анализ и Client1 и Client6 - это те клиенты, которые соединяют эти две группы

enter image description here

Ответы [ 2 ]

0 голосов
/ 27 ноября 2018

Используя код Бена Натцера:

df_result$label <- paste(df_result$label1, df_result$label2, sep = ",") 

, мы можем определить, сколько связей существует между сообществами, используя такую ​​функцию:

library(plyr)
ddply(df_result,.(from,to),nrow)

и получить:

from to V1 1 1 1 5 2 1 2 1 3 2 2 2

, который говорит нам, что существует только одна связь между группами

0 голосов
/ 26 ноября 2018

Это работает, но очень не элегантно:

df <- read.table(header = TRUE, 
             text = "src   target
             cllient1  cllient2
             cllient1  cllient4
             cllient1  cllient6
             cllient2  cllient3
             cllient4  cllient1
             cllient4  cllient3
             cllient5  cllient6
             cllient6  cllient5")

df_graph <- graph_from_data_frame(df)
wc <- cluster_walktrap(df_graph)
df_graph0 <- df_graph
V(df_graph)$name <- membership(wc)

получить список ребер на основе членства, который в вашем запросе переводится в from и to.

x <- as_edgelist(df_graph, names = T)
communities <- ends(df_graph, E(df_graph))

сброс именидентификаторы вершин (не запрашиваются, но могут быть полезны)

V(df_graph)$name <- 1:vcount(df_graph)
ids <- ends(df_graph, E(df_graph))

установить имена вершин, соответствующие клиентам (label)

V(df_graph)$name <- V(df_graph0)$name
label <- ends(df_graph, E(df_graph))

хранить в dataframe

df_result <- data.frame(from = communities[,1], to = communities[,2],
                    label1 = label[,1], label2 = label[,2], ids1 = ids[,1], ids2 = ids[,2])

Что приводит к этому:

  from to   label1   label2 ids1 ids2
1    1  1 cllient1 cllient2    1    2
2    1  1 cllient1 cllient4    1    3
3    1  2 cllient1 cllient6    1    5
4    1  1 cllient2 cllient3    2    6
5    1  1 cllient4 cllient1    3    1
6    1  1 cllient4 cllient3    3    6
7    2  2 cllient5 cllient6    4    5
8    2  2 cllient6 cllient5    5    4

Кроме того, вы можете вставить label1 и label2, чтобы разделить запятую label столбца.

РЕДАКТИРОВАТЬ: В порядкечтобы «свернуть» метки, вы можете сделать что-то вроде этого:

 library(tidyr) 
 library(dplyr) 
 df_result$label <- paste(df_result$label1, df_result$label2, sep = ",") 
 df_nested <- df_result %>% select(from, to, label) %>% nest(-from, -to) 

Чтобы использовать эти вложенные метки в качестве меток или строк, вставьте их вместе:

 df_nested$data <- sapply(1:nrow(df_nested), 
                     function(x) paste(unlist(df_nested$data[[x]]), collapse = " "))
...