Пример визуализации сети
Матрица смежности
Взвешенная направленная сеть
# Загрузка необходимых для работы пакетов
library(igraph)
library(statnet)
library(tidygraph)
library(intergraph)
library(dplyr)
library(openxlsx)
# Импорт данных из CSV файла
edges_5000 <- read.csv("retweets_political_5000.csv")
# Отбор нужных для работы столбцов
edges_5000_1 <- edges_5000 %>%
select(source, target)
# Создание сетевого объекта из табличных данных
tg_5000 <- as_tbl_graph(edges_5000_1) %>%
activate(nodes) %>% # Активируем таблицу узлов
activate(edges) # Активируем таблицу ребер
# Переключение формата под требования пакета statnet для дальнейшего анализа сети
tg_5000 <- intergraph::asNetwork(tg_5000)
# Проверка класса изучаемого объекта
class(tg_5000)
# Расчет описательных статистик сети, включая показатель плотности сети
summary(tg_5000)
# Расчет показателей центральности по степени и по посредничеству для каждой вершины сети
deg <- degree(tg_5000)
bet <- betweenness(tg_5000)
# Сведение полученных показателей центральности в таблицу
df_tg_5000 <- data.frame(deg, bet)
# Переключение формата под требования пакета igraph для дальнейшего анализа сети
net_to_graph_5000 <- asIgraph(tg_5000)
# Извлечение наименований вершин графа и запись их в отдельную переменную
nodes_name <- vertex_attr(net_to_graph_5000,
name = "vertex.names", index = V(net_to_graph_5000))
# Добавление полученной переменной в ранее сформированную таблицу
df_tg_5000 <- add_column(df_tg_5000, nodes_name, .before = 1)
# Сохранение получившейся таблицы в рабочую папку в формате .xlsx
write.xlsx(df_tg_5000, 'df_tg_5000.xlsx')
# Сортировка данных по убыванию на основе значений переменной deg;
# Фильтрация полученных значений по следующему условию: значения переменной deg >=40;
# Отбор для анализа только столбцов, содержащих значения переменной deg и наименования узлов
deg_1 <- df_tg_5000 %>%
arrange(desc(deg)) %>%
filter(deg >= 40) %>%
select(nodes_name, deg)
# Сохранение получившейся таблицы в рабочую папку в формате .xlsx
write.xlsx(deg_1, 'deg_1.xlsx')
# Сортировка данных по убыванию на основе значений переменной bet;
# Фильтрация полученных значений по следующему условию: значения переменной bet >= 10000;
# Отбор для анализа только столбцов, содержащий значения переменной bet и наименования узлов
bet_1 <- df_tg_5000 %>%
arrange(desc(bet)) %>%
filter(bet >= 10000) %>%
select(nodes_name, bet)
# Сохранение получившейся таблицы в рабочую папку в формате .xlsx
write.xlsx(bet_1, 'bet_1.xlsx')
# Визуализация сетевых данных
plot(net_to_graph_5000, vertex.label = NA)
#Запись варианта укладки визуализации сети в отдельную переменную
lo <- layout_with_kk(net_to_graph_5000)
#Настройка визуализации сети
plot(net_to_graph_5000,
vertex.size= log(deg), #Размер узлов пропорционален логарифму центральности по степени
vertex.label = NA, #Наименования узлов не будут отображаться
vertex.color = deg, #Привязка цвета узлов к показателю центральности по степени
edge.arrow.size = .25, #Настройка размера направления ребер
layout=lo*1) #Алгоритм укладки Камады-Каваи минимизирует пересечения рёбер
#Фильтрация сети на основе параметра центральность по степени (degree), значения которого >= 40
filtr_net_to_graph_5000_deg <- get.inducedSubgraph(tg_5000, which(deg >= 40))
#Переключение формата под требования пакета igraph
для дальнейшего анализа сети
net_to_graph_5000_deg <- asIgraph(filtr_net_to_graph_5000_deg)
# Запись варианта укладки визуализации сети в отдельную переменную
lo_deg <- layout_with_kk(net_to_graph_5000_deg)
# Загрузка таблицы с атрибутами вершин
deg_1_at <- read.xlsx("deg_1_at.xlsx")
#Визуализация отфильтрованной сети
my_pal <- brewer.pal(5, "Dark2")
rolecat <- as.factor(deg_1_at$type)
plot(net_to_graph_5000_deg, vertex.size= log(deg),
edge.arrow.width = .25,
edge.arrow.size = .25,
layout = lo_deg*1,
vertex.color = my_pal[rolecat],
vertex.label = deg_1_at[,3],
asp = 0.35)
# Определение k-ядерной структуры сети
coreness_5000 <- graph.coreness(net_to_graph_5000)
table(coreness_5000)
maxcoreness <- max(coreness_5000)
# Присвоение меток, подбор цветов и визуализация k-ядерной структуры
Vname <- vertex_attr(net_to_graph_5000, name = "vertex.names",
index = V(net_to_graph_5000))
V(net_to_graph_5000)$name <- Vname
V(net_to_graph_5000)$color <- coreness_5000
plot(net_to_graph_5000, vertex.label = NA,
edge.arrow.width = 0.25,
edge.arrow.size = 0.25, layout=lo*1,
vertex.size = 1.0, asp = 0.35)
# Удаление k-ядер, не соответствующих заданному условию
net_to_graph_5000_10_22 <- induced.subgraph(net_to_graph_5000,
vids = which(coreness_5000 >= 10))
# Визуализация результата фильтрации
V(net_to_graph_5000)$color <- coreness_5000
V(net_to_graph_5000)$name <- coreness_5000
plot(net_to_graph_5000_10_22, layout = lo[which(coreness_5000 >= 10),],
edge.arrow.width = 0.25,
edge.arrow.size = 0.1, asp = 0.35,
vertex.size= 3.0, vertex.label = deg_1_at[,3],
vertex.label.cex = 0.6,
main = "Графическое отображение отфильтрованной k-ядерной
структуры сети")