рекомендации

понедельник, 11 февраля 2019 г.

Сетевой анализ семейных связей Игры Престолов

Перевод. Оригинал: Network analysis of Game of Thrones family ties

В этом посте я изучаю методы сетевого анализа  для изучения семейных связей главных персонажей из игры престолов.

Ничего удивительного в том, что дом Старков (в частности, Нед and Санса) и дом Ланнистеров (особенно Тирион) - это самые важные семейные связи в игре престолов; они также соединяют многие сюжетные линии и являются центральными частями повествования.

Что такое сеть?

Сеть в этом контексте представляет собой график взаимосвязанных узлов/вершин. Узлы могут, например, быть людьми в социальной сети, генами и т. д. Узлы связаны через связи/ребра.

Что может сказать нам сетевой анализ?

Анализ сети может, например, использоваться для изучения отношений в социальных или профессиональных сетях. В таких случаях мы обычно задавали такие вопросы, как:

- сколько соединений имеет каждый человек?
- кто является наиболее связанным (то есть влиятельным или «важным») человеком?
- существуют ли скопления людей с плотными связями?
- есть ли несколько ключевых игроков, которые соединяют кластеры людей?
- и т.п.

Эти ответы могут дать нам много информации о моделях взаимодействия людей.

Сеть персонажей Игры Престолов

Основой для этой сети является Kaggle's Game of Throne dataset (character-deaths.csv). Поскольку большинство семейных отношений в этом наборе данных отсутствовали, я добавил недостающую информацию частично вручную (на основе Wiki of Ice and Fire) и собирая информацию из Game of Thrones wiki. Вы можете найти полный код того, как я создал сеть на моей странице Github.

library(tidyverse)
library(igraph)
library(statnet)

load("union_edges.RData")
load("union_characters.RData")

Я использую igraph для построения начальной сети. Для этого я сначала создаю граф из edge-table и node-table. edge-table содержит исходные и целевые узлы в первых двух столбцах и опционально дополнительные столбцы с атрибутами edge. Здесь у меня есть тип связи (мать, отец или супруг), цвет и тип линии, которые я хочу назначить каждому ребру.

Поскольку книги и телесериалы немного отличаются друг от друга, я ввел ребра, которые поддерживают или намекают на сериал и не являются частью оригинального повествования в книгах. Эти ребра отмечены пунктиром вместо сплошной линии. Также вводится дополнительный цвет для ребер с неуточненным родительским происхождением. Первоначально они служили для связей, которые были извлечены из имен персонажей (то есть персонажей, имена которых заканчивались на «... сын/ дочь ...») и могли означать мать или отца. Теперь они показывают неясное происхождение или случаи, когда есть биологический и де-факто отец, как в случае с Джоном Сноу.

head(union_edges)

##               source            target   type   color   lty
## 1         Lysa Arryn      Robert Arryn mother #7570B3 solid
## 2       Jasper Arryn        Alys Arryn father #1B9E77 solid
## 3       Jasper Arryn         Jon Arryn father #1B9E77 solid
## 4          Jon Arryn      Robert Arryn father #1B9E77 solid
## 110 Cersei Lannister  Tommen Baratheon mother #7570B3 solid
## 210 Cersei Lannister Joffrey Baratheon mother #7570B3 solid

Nodetable содержит одну строку для каждого символа, который является либо источником, либо целью в edgetable. Мы можем указать любое количество и тип атрибутов узла. Здесь я выбрал следующие столбцы из исходного набора данных Kaggle: gender/male (male = 1, female = 0), house (как дом, в котором родился каждый персонаж) и popularity. House2 значит назначить цвет только основным домам. Shape представляет собой пол.

head(union_characters)

##            name male culture          house popularity      house2   color  shape
## 1    Alys Arryn    0        House Arryn 0.08026756             circle
## 2 Elys Waynwood    0     House Waynwood 0.07023411             circle
## 3  Jasper Arryn    1        House Arryn 0.04347826             square
## 4   Jeyne Royce    0        House Royce 0.00000000             circle
## 5     Jon Arryn    1 Valemen    House Arryn 0.83612040             square
## 6    Lysa Arryn    0        House Tully 0.00000000 House Tully #F781BF circle

По умолчанию у нас есть ориентированный граф.

union_graph <- span=""> graph_from_data_frame(union_edges, directed = TRUE, vertices = union_characters)

Для построения легенды я суммирую цвета ребер и узлов.

color_vertices <- span=""> union_characters %>%
  group_by(house, color) %>%
  summarise(n = n()) %>%
  filter(!is.na(color))

colors_edges <- span=""> union_edges %>%
  group_by(type, color) %>%
  summarise(n = n()) %>%
  filter(!is.na(color))

Теперь мы можем построить объект графа (здесь с макетом Фрухтермана-Рейнгольда):

layout <- span=""> layout_with_fr(union_graph)

plot(union_graph,
     layout = layout,
     vertex.label = gsub(" ", "\n", V(union_graph)$name),
     vertex.shape = V(union_graph)$shape,
     vertex.color = V(union_graph)$color, 
     vertex.size = (V(union_graph)$popularity + 0.5) * 5, 
     vertex.frame.color = "gray", 
     vertex.label.color = "black", 
     vertex.label.cex = 0.8,
     edge.arrow.size = 0.5,
     edge.color = E(union_graph)$color,
     edge.lty = E(union_graph)$lty)
legend("topleft", legend = c(NA, "Node color:", as.character(color_vertices$house), NA, "Edge color:", as.character(colors_edges$type)), pch = 19,
       col = c(NA, NA, color_vertices$color, NA, NA, colors_edges$color), pt.cex = 5, cex = 2, bty = "n", ncol = 1,
       title = "") 
legend("topleft", legend = "", cex = 4, bty = "n", ncol = 1,
       title = "Game of Thrones Family Ties")



Цвет узла показывает основные дома, размер узла - популярность персонажа, а форма узла - их пол (квадрат для мужчины, круг для женщины). Цвет ребра показывает тип взаимодействия.

Как мы видим, даже с подмножеством персонажей мира Game of Thrones сеть уже довольно большая. Вы можете щелкнуть по изображению, чтобы открыть PDF-файл и увеличить его в определенных частях графа и прочитать метки/имена узлов.

Мы сразу видим, что между домами существуют только ограниченные связи, и что Грейджои - единственный дом, который не имеет связей ни с одним из других домов.

Сетевой анализ

Как узнать, какие из героев в этой сети главные?

Мы считаем героя «важным», если у него есть связи со многими другими персонажами. Есть несколько свойств сети, которые рассказывают нам об этом подробнее. Для этого я рассматриваю сеть как неориентированную для учета родительских/дочерних отношений как взаимных.

union_graph_undir <- span=""> as.undirected(union_graph, mode = "collapse")

Центральность (Centrality)

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

«Централизация - это метод создания меры централизации графа из показателей центральности вершин». 
Centralize() help

Для всей сети мы можем вычислить центральность по степени (centr_degree()), closeness (centr_clo()) или  центральность собственного вектора (centr_eigen()) вершин.

centr_degree(union_graph_undir, mode = "total")$centralization
## [1] 0.04282795
centr_clo(union_graph_undir, mode = "total")$centralization
## [1] 0.01414082
centr_eigen(union_graph_undir, directed = FALSE)$centralization
## [1] 0.8787532

Степень узла (Node degree)

Степень узла или центральность по степени описывает, насколько централен узел в сети (т. е. сколько входящих и исходящих ребер он имеет или со сколькими другими узлами он напрямую связано через одно ребро).

«Степень вершины - это ее самое основное структурное свойство, число ее смежных ребер». 
Из справочной страницы degree()

Мы можем вычислить количество входящих или исходящих ребер каждого узла, или, как я здесь делаю, сумму обоих.

union_graph_undir_degree <- span=""> igraph::degree(union_graph_undir, mode = "total")

#standardized by number of nodes
union_graph_undir_degree_std <- span=""> union_graph_undir_degree / (vcount(union_graph_undir) - 1)
node_degree <- span=""> data.frame(degree = union_graph_undir_degree,
                          degree_std = union_graph_undir_degree_std) %>%
  tibble::rownames_to_column()

union_characters <- span=""> left_join(union_characters, node_degree, by = c("name" = "rowname"))

node_degree %>%
  arrange(-degree) %>%
  .[1:10, ]
##            rowname degree degree_std
## 1  Quellon Greyjoy     12 0.05797101
## 2      Walder Frey     10 0.04830918
## 3   Oberyn Martell     10 0.04830918
## 4     Eddard Stark      9 0.04347826
## 5    Catelyn Stark      8 0.03864734
## 6       Emmon Frey      7 0.03381643
## 7  Genna Lannister      7 0.03381643
## 8     Merrett Frey      7 0.03381643
## 9    Balon Greyjoy      7 0.03381643
## 10 Jason Lannister      7 0.03381643

В этом случае степень узла отражает количество детей и супругов, которых имел персонаж. С тремя женами и несколькими детьми, Квеллон Грейджой, дед Теона и Ашы/Яры выходит на первое место (конечно, если бы я включил всех потомков и жен Уолдера Фрея, он бы легко занял бы первое место, но сеть получилась бы бесконечно более запутанной).

Близость (Closeness)

Близость узла описывает его расстояние до всех остальных узлов. Узел с наибольшей близостью является более центральным и может распространять информацию на многие другие узлы.

closeness <- span=""> igraph::closeness(union_graph_undir, mode = "total")

#standardized by number of nodes
closeness_std <- span=""> closeness / (vcount(union_graph_undir) - 1)
node_closeness <- span=""> data.frame(closeness = closeness,
                          closeness_std = closeness_std) %>%
  tibble::rownames_to_column()

union_characters <- span=""> left_join(union_characters, node_closeness, by = c("name" = "rowname"))

node_closeness %>%
  arrange(-closeness) %>%
  .[1:10, ]
##             rowname    closeness closeness_std
## 1       Sansa Stark 0.0002013288  9.726028e-07
## 2  Tyrion Lannister 0.0002012882  9.724070e-07
## 3   Tywin Lannister 0.0002011668  9.718201e-07
## 4  Joanna Lannister 0.0002005616  9.688965e-07
## 5      Eddard Stark 0.0002002804  9.675381e-07
## 6     Catelyn Stark 0.0001986492  9.596579e-07
## 7  Cersei Lannister 0.0001984915  9.588960e-07
## 8   Jaime Lannister 0.0001975894  9.545382e-07
## 9    Jeyne Marbrand 0.0001966568  9.500330e-07
## 10  Tytos Lannister 0.0001966568  9.500330e-07

Персонажи с максимальной близостью окружают центральные персонажи, которые соединяют различные сюжетные линии и дома в Игре Престолов.

Центральность по посредничеству (Betweenness centrality)

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

Функция igraph betweenness() вычисляет центральность по посредничеству вершин, edge_betweenness() центральность по посредничеству ребер:

 "центральность по посредничеству вершин и ребер (грубо) определяются числом геодезических (кратчайших путей), проходящих через вершину или ребро". 
 Справка Igraph help для estimate_betweenness()

betweenness <- span=""> igraph::betweenness(union_graph_undir, directed = FALSE)

# standardize by number of node pairs
betweenness_std <- span=""> betweenness / ((vcount(union_graph_undir) - 1) * (vcount(union_graph_undir) - 2) / 2)

node_betweenness <- span=""> data.frame(betweenness = betweenness,
                               betweenness_std = betweenness_std) %>%
  tibble::rownames_to_column() 

union_characters <- span=""> left_join(union_characters, node_betweenness, by = c("name" = "rowname"))

node_betweenness %>%
  arrange(-betweenness) %>%
  .[1:10, ]
##              rowname betweenness betweenness_std
## 1       Eddard Stark    6926.864       0.3248846
## 2        Sansa Stark    6165.667       0.2891828
## 3   Tyrion Lannister    5617.482       0.2634718
## 4    Tywin Lannister    5070.395       0.2378123
## 5   Joanna Lannister    4737.524       0.2221999
## 6  Rhaegar Targaryen    4301.583       0.2017533
## 7    Margaery Tyrell    4016.417       0.1883784
## 8           Jon Snow    3558.884       0.1669192
## 9        Mace Tyrell    3392.500       0.1591154
## 10   Jason Lannister    3068.500       0.1439191
edge_betweenness <- span=""> igraph::edge_betweenness(union_graph_undir, directed = FALSE)

data.frame(edge = attr(E(union_graph_undir), "vnames"),
           betweenness = edge_betweenness) %>%
  tibble::rownames_to_column() %>%
  arrange(-betweenness) %>%
  .[1:10, ]
##    rowname                              edge betweenness
## 1      160      Sansa Stark|Tyrion Lannister    5604.149
## 2      207          Sansa Stark|Eddard Stark    4709.852
## 3      212        Rhaegar Targaryen|Jon Snow    3560.083
## 4      296       Margaery Tyrell|Mace Tyrell    3465.000
## 5      213             Eddard Stark|Jon Snow    3163.048
## 6      131  Jason Lannister|Joanna Lannister    3089.500
## 7      159 Joanna Lannister|Tyrion Lannister    2983.591
## 8      171  Tyrion Lannister|Tywin Lannister    2647.224
## 9      192    Elia Martell|Rhaegar Targaryen    2580.000
## 10     300         Luthor Tyrell|Mace Tyrell    2565.000

Мы можем теперь построить график, задавая центральность по посредничеству вершин как vertex.size и центральность по посредничеству ребер как edge.width для нашей функции plot:

plot(union_graph_undir,
     layout = layout,
     vertex.label = gsub(" ", "\n", V(union_graph_undir)$name),
     vertex.shape = V(union_graph_undir)$shape,
     vertex.color = V(union_graph_undir)$color, 
     vertex.size = betweenness * 0.001, 
     vertex.frame.color = "gray", 
     vertex.label.color = "black", 
     vertex.label.cex = 0.8,
     edge.width = edge_betweenness * 0.01,
     edge.arrow.size = 0.5,
     edge.color = E(union_graph_undir)$color,
     edge.lty = E(union_graph_undir)$lty)
legend("topleft", legend = c("Node color:", as.character(color_vertices$house), NA, "Edge color:", as.character(colors_edges$type)), pch = 19,
       col = c(NA, color_vertices$color, NA, NA, colors_edges$color), pt.cex = 5, cex = 2, bty = "n", ncol = 1)




Нед Старк - персонаж с наивысшей центральностью по посредничеству. Это имеет смысл, поскольку он и его дети (особенно Санса и ее брак с Тирионом) соединяются с другими домами и являются центральными точками, из которых разворачивается история. Тем не менее, мы должны иметь здесь в виду, что мой выбор того, кто достаточно важен для включения в сеть (например, предков Старка), а кто нет (например, весь сложный беспорядок, который является деревом семейств Таргарен и Фреи), делает этот результат несколько предвзятым.

Диаметр (diameter)

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

diameter(union_graph_undir, directed = FALSE)
## [1] 21

В нашей сети самый длинный путь соединяет 21 узел.

"get_diameter возвращает путь с фактическим диаметром. Если есть несколько кратчайших путей с длиной диаметра, тогда она возвращает первый найденный".
Справка по diameter()

Это мы также можем построить:

union_graph_undir_diameter <- span=""> union_graph_undir
node_diameter <- span=""> get.diameter(union_graph_undir_diameter,  directed = FALSE)

V(union_graph_undir_diameter)$color <- span=""> scales::alpha(V(union_graph_undir_diameter)$color, alpha = 0.5)
V(union_graph_undir_diameter)$size <- span=""> 2

V(union_graph_undir_diameter)[node_diameter]$color <- span=""> "red"
V(union_graph_undir_diameter)[node_diameter]$size <- span=""> 5

E(union_graph_undir_diameter)$color <- span=""> "grey"
E(union_graph_undir_diameter)$width <- span=""> 1

E(union_graph_undir_diameter, path = node_diameter)$color <- span=""> "red"
E(union_graph_undir_diameter, path = node_diameter)$width <- span=""> 5

plot(union_graph_undir_diameter,
     layout = layout,
     vertex.label = gsub(" ", "\n", V(union_graph_undir_diameter)$name),
     vertex.shape = V(union_graph_undir_diameter)$shape,
     vertex.frame.color = "gray", 
     vertex.label.color = "black", 
     vertex.label.cex = 0.8,
     edge.arrow.size = 0.5,
     edge.lty = E(union_graph_undir_diameter)$lty)
legend("topleft", legend = c("Node color:", as.character(color_vertices$house), NA, "Edge color:", as.character(colors_edges$type)), pch = 19,
       col = c(NA, color_vertices$color, NA, NA, colors_edges$color), pt.cex = 5, cex = 2, bty = "n", ncol = 1)


Транзитивность (Transitivity)

"Транзитивность измеряет вероятность того, что два ближайших соседа этого узла сами есть ближайшие соседи. Ее иногда также называют коэффициентом кластеризации".
Справка по transitivity()

Мы можем рассчитать транзитивность или отношение треугольников к связанным тройкам для всей сети:

transitivity(union_graph_undir, type = "global")
## [1] 0.2850679

Или для каждого узла:

transitivity <- span=""> data.frame(name = V(union_graph_undir)$name,
      transitivity = transitivity(union_graph_undir, type = "local")) %>%
  mutate(name = as.character(name))

union_characters <- span=""> left_join(union_characters, transitivity, by = "name")

transitivity %>%
  arrange(-transitivity) %>%
  .[1:10, ]
##                 name transitivity
## 1       Robert Arryn            1
## 2   Ormund Baratheon            1
## 3     Selyse Florent            1
## 4  Shireen Baratheon            1
## 5   Amarei Crakehall            1
## 6       Marissa Frey            1
## 7        Olyvar Frey            1
## 8        Perra Royce            1
## 9        Perwyn Frey            1
## 10         Tion Frey            1

Центральность PageRank

Центральность PageRank (первоначально используемая Google для определения важности результатов поиска) похожа на центральность по собственному вектору. Центральность по собственному вектору оценивает узлы в сети в зависимости от количества соединений с узлами высокой степени. Поэтому это мера важности узла. PageRank аналогичным образом рассматривает узлы как более важные, если у них много входящих ребер (или ссылок).

page_rank <- span=""> page.rank(union_graph_undir, directed = FALSE)

page_rank_centrality <- span=""> data.frame(name = names(page_rank$vector),
      page_rank = page_rank$vector) %>%
  mutate(name = as.character(name))

union_characters <- span=""> left_join(union_characters, page_rank_centrality, by = "name")

page_rank_centrality %>%
  arrange(-page_rank) %>%
  .[1:10, ]
##                 name   page_rank
## 1     Oberyn Martell 0.018402407
## 2    Quellon Greyjoy 0.016128129
## 3        Walder Frey 0.012956029
## 4       Eddard Stark 0.011725019
## 5       Cregan Stark 0.010983561
## 6      Catelyn Stark 0.010555473
## 7       Lyarra Stark 0.009876629
## 8  Aegon V Targaryen 0.009688458
## 9      Balon Greyjoy 0.009647049
## 10         Jon Arryn 0.009623742

Оберин Мартелл, Квеллон Грейджой и Уолдер Фрей имеют самое большое количество супругов, детей и внуков, поэтому они имеют наибольшее значение для PageRank.

Матричное представление сети

Соединения между узлами также могут быть представлены как матрица смежности. Мы можем преобразовать наш объект графа в матрицу смежности с помощью  функции as_adjacency_matrix() из igraph. Всякий раз, когда между двумя узлами есть ребро, этому полю в матрице присваивается значение 1, в противном случае оно равно 0.

adjacency <- span=""> as.matrix(as_adjacency_matrix(union_graph_undir))

Центральность по собственному вектору (Eigenvector centrality)

Теперь мы можем вычислить собственные значения и собственные векторы матрицы смежности.

#degree diagonal matrix
degree_diag <- span=""> diag(1 / igraph::degree(union_graph_undir))

# PageRank matrix
pagerank <- span=""> adjacency %*% degree_diag

eigenvalues <- span=""> eigen(pagerank)

Собственный вектор с наибольшим собственным значением высоко оценивает вершины, которые имеют много ребер или которые связаны с вершинами со многими ребрами.

eigenvector <- span=""> data.frame(name = rownames(pagerank),
           eigenvector = as.numeric(eigenvalues$vectors[, which.max(eigenvalues$values)]))

union_characters <- span=""> left_join(union_characters, eigenvector, by = "name")

eigenvector %>%
  arrange(eigenvector) %>%
  .[1:10, ]
##                       name eigenvector
## 1          Quellon Greyjoy  -0.6625628
## 2            Balon Greyjoy  -0.3864950
## 3   Lady of House Sunderly  -0.3312814
## 4           Alannys Harlaw  -0.2760678
## 5  Lady of House Stonetree  -0.2208543
## 6      Asha (Yara) Greyjoy  -0.1656407
## 7            Robin Greyjoy  -0.1104271
## 8            Euron Greyjoy  -0.1104271
## 9          Urrigon Greyjoy  -0.1104271
## 10       Victarion Greyjoy  -0.1104271

Из-за очень связанных семейных уз (т. е. есть только несколько соединений, но они почти все треугольники), Грейджои были оценены самыми высокими собственными значениями.

Мы можем найти оценки центральности по собственному вектору:

eigen_centrality <- span=""> igraph::eigen_centrality(union_graph_undir, directed = FALSE)

eigen_centrality <- span=""> data.frame(name = names(eigen_centrality$vector),
           eigen_centrality = eigen_centrality$vector) %>%
  mutate(name = as.character(name))

union_characters <- span=""> left_join(union_characters, eigen_centrality, eigenvector, by = "name")

eigen_centrality %>%
  arrange(-eigen_centrality) %>%
  .[1:10, ]
##                name eigen_centrality
## 1   Tywin Lannister        1.0000000
## 2  Cersei Lannister        0.9168980
## 3  Joanna Lannister        0.8358122
## 4    Jeyne Marbrand        0.8190076
## 5   Tytos Lannister        0.8190076
## 6   Genna Lannister        0.7788376
## 7   Jaime Lannister        0.7642870
## 8  Robert Baratheon        0.7087042
## 9        Emmon Frey        0.6538709
## 10      Walder Frey        0.6516021
Когда мы рассматриваем центральность по собственному вектору, Тайвин и ядро семьи Ланнистеров имеют наибольшее значение.

Кто самые важные персонажи?

Теперь мы можем сравнить всю информацию об узлах, чтобы решить, какие персонажи являются наиболее важными в Игре Престолов. Такие характеристики уровня узла также могут использоваться в качестве входных данных для алгоритмов машинного обучения.

Давайте посмотрим на всех персонажей из основных домов:

union_characters %>%
  filter(!is.na(house2)) %>%
  dplyr::select(-contains("_std")) %>%
  gather(x, y, degree:eigen_centrality) %>%
  ggplot(aes(x = name, y = y, color = house2)) +
    geom_point(size = 3) +
    facet_grid(x ~ house2, scales = "free") +
    theme_bw() +
    theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))


Взяв их вместе, мы могли бы сказать, что Дом Старков (в частности, Нед and Санса) и Дом Ланнистеров (особенно Тирион) - это самые важные семейные связи в игре Престолов.

Группы узлов

Мы также можем анализировать диады (пары из двух узлов), триады (группы из трех узлов) и большие группы в нашей сети. Для диад мы можем использовать функцию dyad_census() из igraph или dyad.census() из sna. Обе они идентичны и вычисляют Holland and Leinhardt dyad census, то есть классифицируют пары вершин на:

mut: количество пар с взаимными связями (в нашем случае супруги).
asym: количество пар с не взаимными связями (в исходной сети: отношения мать-дитя и отец-ребенок; но в ненаправленной сети их нет).
null: количество пар без связи между ними.

#igraph::dyad_census(union_graph_undir)
sna::dyad.census(adjacency)
##      Mut Asym  Null
## [1,] 326    0 21202

То же самое можно рассчитать для триад (см.?Triad_census для получения детальной информации о том, что означает каждый вывод).

#igraph::triad_census(union_graph_undir)
sna::triad.census(adjacency)
##          003 012   102 021D 021U 021C 111D 111U 030T 030C 201 120D 120U 120C 210 300
## [1,] 1412100   0 65261    0    0    0    0    0    0    0 790    0    0    0   0 105
triad.classify(adjacency, mode = "graph")
## [1] 2

Мы также можем рассчитать количество путей и циклов любой длины, которую мы указываем, например,  length <= 5. Для ребер мы получаем сумму отсчетов для всех путей или циклов до заданной максимальной длины. Для вершин/узлов мы получаем количество путей или циклов, к которым принадлежит каждый узел.

node_kpath <- span=""> kpath.census(adjacency, maxlen = 5, mode = "graph", tabulate.by.vertex = TRUE, dyadic.tabulation = "sum")
edge_kpath <- span=""> kpath.census(adjacency, maxlen = 5, mode = "graph", tabulate.by.vertex = FALSE)
edge_kpath
## $path.count
##     1     2     3     4     5 
##   326  1105  2973  7183 17026
Мы могли бы построить график (но здесь это не даст много дополнительной информации):

gplot(node_kpath$paths.bydyad,
      label.cex = 0.5, 
      vertex.cex = 0.75,
      displaylabels = TRUE,
      edge.col = "grey")
node_kcycle <- span=""> kcycle.census(adjacency, maxlen = 8, mode = "graph", tabulate.by.vertex = TRUE, cycle.comembership = "sum")
edge_kcycle <- span=""> kcycle.census(adjacency, maxlen = 8, mode = "graph", tabulate.by.vertex = FALSE)
edge_kcycle
## $cycle.count
##   2   3   4   5   6   7   8 
##   0 105 136  27  57  58  86
node_kcycle_reduced <- span=""> node_kcycle$cycle.comemb
node_kcycle_reduced <- span=""> node_kcycle_reduced[which(rowSums(node_kcycle_reduced) > 0), which(colSums(node_kcycle_reduced) > 0)]

gplot(node_kcycle_reduced,
      label.cex = 0.5, 
      vertex.cex = 0.75,
      displaylabels = TRUE,
      edge.col = "grey")

Изображение в высоком разрешении

node_clique <- span=""> clique.census(adjacency, mode = "graph", tabulate.by.vertex = TRUE, clique.comembership = "sum")
edge_clique <- span=""> clique.census(adjacency, mode = "graph", tabulate.by.vertex = FALSE, clique.comembership = "sum")
edge_clique$clique.count
##   1   2   3 
##   0  74 105
node_clique_reduced <- span=""> node_clique$clique.comemb
node_clique_reduced <- span=""> node_clique_reduced[which(rowSums(node_clique_reduced) > 0), which(colSums(node_clique_reduced) > 0)]

gplot(node_clique_reduced,
      label.cex = 0.5, 
      vertex.cex = 0.75,
      displaylabels = TRUE,
      edge.col = "grey")
Самая большая группа узлов в этой сети - три, то есть все родительские/дочерние отношения. Поэтому на самом деле не имеет смысла выводить их все, но мы можем нарисовать и раскрасить их с помощью:

vcol <- span=""> rep("grey80", vcount(union_graph_undir))

# highlight first of largest cliques
vcol[unlist(largest_cliques(union_graph_undir)[[1]])] <- span=""> "red"

plot(union_graph_undir,
     layout = layout,
     vertex.label = gsub(" ", "\n", V(union_graph_undir)$name),
     vertex.shape = V(union_graph_undir)$shape,
     vertex.color = vcol, 
     vertex.size = 5, 
     vertex.frame.color = "gray", 
     vertex.label.color = "black", 
     vertex.label.cex = 0.8,
     edge.width = 2,
     edge.arrow.size = 0.5,
     edge.color = E(union_graph_undir)$color,
     edge.lty = E(union_graph_undir)$lty)

Кластеризация

Мы также можем искать группы в нашей сети, кластеризуя группы узлов в соответствии с их центральностью по посредничеству ребер:

ceb <- span=""> cluster_edge_betweenness(union_graph_undir)
modularity(ceb)
## [1] 0.8359884
plot(ceb,
     union_graph_undir,
     layout = layout,
     vertex.label = gsub(" ", "\n", V(union_graph_undir)$name),
     vertex.shape = V(union_graph_undir)$shape,
     vertex.size = (V(union_graph_undir)$popularity + 0.5) * 5, 
     vertex.frame.color = "gray", 
     vertex.label.color = "black", 
     vertex.label.cex = 0.8)


Или на основе распространяющихся меток:

clp <- span=""> cluster_label_prop(union_graph_undir)

plot(clp,
     union_graph_undir,
     layout = layout,
     vertex.label = gsub(" ", "\n", V(union_graph_undir)$name),
     vertex.shape = V(union_graph_undir)$shape,
     vertex.size = (V(union_graph_undir)$popularity + 0.5) * 5, 
     vertex.frame.color = "gray", 
     vertex.label.color = "black", 
     vertex.label.cex = 0.8)


Сетевые свойства

Мы также можем передать нашу матрицу смежности другим функциям, таким как GenInd() из пакетов NetIndices. Эта функция сетевые а, таких как количество сегментов (N), общая пропускная способность системы (T ..), общая пропускная способность системы (TST), количество внутренних ссылок (Lint), общее количество ссылок (Ltot), плотность (LD), связность (C), средний вес канала (Tijbar), средняя пропускная способность сегмента сети (TSTbar) и разобщенность или степень связности подсистем в сети (Cbar).

library(NetIndices)
graph.properties <- span=""> GenInd(adjacency)
graph.properties
## $N
## [1] 208
## 
## $T..
## [1] 652
## 
## $TST
## [1] 652
## 
## $Lint
## [1] 652
## 
## $Ltot
## [1] 652
## 
## $LD
## [1] 3.134615
## 
## $C
## [1] 0.01514307
## 
## $Tijbar
## [1] 1
## 
## $TSTbar
## [1] 3.134615
## 
## $Cbar
## [1] 0.01086163

В качестве альтернативы, пакет network предоставляет дополнительные функции для расчета сетевых свойств. Здесь мы можем снова ввести матрицу смежности нашей сети и преобразовать ее в сетевой объект.

library(network)
adj_network <- span=""> network(adjacency, directed = TRUE)
adj_network
##  Network attributes:
##   vertices = 208 
##   directed = TRUE 
##   hyper = FALSE 
##   loops = FALSE 
##   multiple = FALSE 
##   bipartite = FALSE 
##   total edges= 652 
##     missing edges= 0 
##     non-missing edges= 652 
## 
##  Vertex attribute names: 
##     vertex.names 
## 
## No edge attributes
Из этого сетевого объекта мы можем, например, получить количество диад и ребер в сети и размер сети.

network.dyadcount(adj_network)
## [1] 43056
network.edgecount(adj_network)
## [1] 652
network.size(adj_network)
## [1] 208

«equiv.clust использует определение приблизительной эквивалентности (equiv.fun) для формирования иерархической кластеризации позиций в сети. Если dat состоит из нескольких отношений, все указанные отношения учитываются совместно при формировании кластеризации эквивалентности ».
Справка Equ.clust()
ec <- span=""> equiv.clust(adj_network, mode = "graph", cluster.method = "average", plabels = network.vertex.names(adj_network))
ec
## Position Clustering:
## 
##  Equivalence function: sedist 
##  Equivalence metric: hamming 
##  Cluster method: average 
##  Graph order: 208
ec$cluster$labels <- span=""> ec$plabels
plot(ec)


Из пакета sna мы можем, например, использовать функции, которые дают нам плотность графов и двоичную взаимность вершин или ребер

gden(adjacency)
## [1] 0.01514307
grecip(adjacency)
## Mut 
##   1
grecip(adjacency, measure = "edgewise")
## Mut 
##   1
sessionInfo()
## R version 3.4.0 (2017-04-21)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 7 x64 (build 7601) Service Pack 1
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252    LC_MONETARY=English_United States.1252 LC_NUMERIC=C                           LC_TIME=English_United States.1252    
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] NetIndices_1.4.4     MASS_7.3-47          statnet_2016.9       sna_2.4              ergm.count_3.2.2     tergm_3.4.0          networkDynamic_0.9.0 ergm_3.7.1           network_1.13.0       statnet.common_3.3.0 igraph_1.0.1         dplyr_0.5.0          purrr_0.2.2          readr_1.1.0          tidyr_0.6.2          tibble_1.3.0         ggplot2_2.2.1        tidyverse_1.1.1     
## 
## loaded via a namespace (and not attached):
##  [1] lpSolve_5.6.13    reshape2_1.4.2    haven_1.0.0       lattice_0.20-35   colorspace_1.3-2  htmltools_0.3.6   yaml_2.1.14       foreign_0.8-68    DBI_0.6-1         modelr_0.1.0      readxl_1.0.0      trust_0.1-7       plyr_1.8.4        robustbase_0.92-7 stringr_1.2.0     munsell_0.4.3     gtable_0.2.0      cellranger_1.1.0  rvest_0.3.2       coda_0.19-1       psych_1.7.5       evaluate_0.10     labeling_0.3      knitr_1.15.1      forcats_0.2.0     parallel_3.4.0    DEoptimR_1.0-8    broom_0.4.2       Rcpp_0.12.10      scales_0.4.1      backports_1.0.5   jsonlite_1.4      mnormt_1.5-5      hms_0.3           digest_0.6.12     stringi_1.1.5     grid_3.4.0        rprojroot_1.2     tools_3.4.0       magrittr_1.5      lazyeval_0.2.0    Matrix_1.2-10     xml2_1.1.1        lubridate_1.6.0   assertthat_0.2.0  rmarkdown_1.5     httr_1.2.1        R6_2.2.0          nlme_3.1-131      compiler_3.4.0

Комментариев нет:

Отправить комментарий