Перевод. Оригинал: 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
## 1sessionInfo()
## 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
Комментариев нет:
Отправить комментарий