Для анализа взята сеть из 777 комиксов. В первую очередь посмотрим, как выглядит сеть на графике:
Отметим, что есть две достаточно большие группы так или иначе связанных между собой комиксов. Остальные комиксы “объединяются” в группы поменьше из 3-10 книг. Три комикса из 777 не связаны ни с какими другими.
Связь в сети возникает, если комиксы похожи по пользовательским оценкам. Что влияет на похожесть оценок и, следовательно, на образование связи. Первое предположение заключается в том, что между комиксами более вероятно будет воникать связь, если они одного жанра/ одной категории. Чтобы подтвердить или опровергнуть это предположение, рассчитаем значение ассортативности по жанру/категории из переменной popular_shelves.0.name датафрейма с информацией о книгах.
#в сети и в датафрейме с атрибутами книги отсортированы в разном порядке, что делает невозможным корректное присоединение атрибутов к вершинам. Исправим это, отсортируем датафрейм в том порядке, в котором расположены вершины в сети:
a = factor(V(comics_net), levels = unique(V(comics_net)), ordered = TRUE)
b = data.frame(book_id = as.numeric(names(a)))
books = left_join(b,books)
Какие вообще есть категории?
library(DT)
c =books$popular_shelves.0.name %>% as.factor() %>% summary()
datatable(data.frame(quantity = c))
Стоит отметить, что некоторые категории разделены, хотя обозначают одно и то же (например “mangá” и “manga”). Исправим это с помощью stringr.
library(stringr)
books$popular_shelves.0.name = books$popular_shelves.0.name %>% str_replace_all("cómics","comics") %>% str_replace_all("còmics","comics") %>% str_replace_all("dc-comics","dc") %>% str_replace_all("graphic-novelss","graphic-novels") %>% str_replace_all("mangá","manga") %>% str_replace_all("graphic-novels","graphic-novel")
d = books$popular_shelves.0.name %>%as.factor %>% summary()
datatable(data.frame(quantity = d))
Считаем ассортативность:
V(comics_net)$genre =books$popular_shelves.0.name
assort = assortativity_nominal(comics_net, as.factor(V(comics_net)$genre), directed = F)
Значение ассортативности - 0.109847. Оно совсем незначительно. Вывод - мы не можем утверждать, что узлы склонны образовывать связи с похожими по категории.
Заметим, что самая популярная категория - to-read (683 наблюдения). Она, на самом деле, не дает никакого представления о жанре произведения. Уберем вершины с этой категорией (значительно урезав сеть) и посмотрим на значение ассортативности, а также на внешний вид графа после этого преобразования.
g <-delete.vertices(comics_net, V(comics_net)[ V(comics_net)[genre == "to-read"] ])
ggraph(g)+
geom_edge_link() +
geom_node_point(aes(color = genre))
assort_2= assortativity_nominal(g, as.factor(V(g)$genre), directed = F)
Значение ассортативности - 0.6751428. Оно гораздо больше, чем в предыдущем случае. В урезанной сети узлы действительно склонны образовывать связи со схожими по категории. Это видно даже по графику. Так, например, выделяется группа комиксов “манга”, для них связи образуются только внутри этой категории (за исключением одной вершины).
Следующая гипотеза заключается в том, что чем больше отзывов у конкретного произведения - тем больше вероятность того, что оно образует связь с каким-нибудь другим (больше шанс того, что пользовательские оценки совпадут). То есть, у комиксов с большим количеством отзывов в сети будет большее значение степени (degree). Для проверки этого предположения посчитаем корреляцию между количеством отзывов и степенью.
#считаем степень
deg = degree(comics_net)
deg_df = data.frame(book_id = as.numeric(names(deg)), degree=as.numeric(deg))
deg_df_1 = books %>% inner_join(deg_df)
deg_df_1$ratings_count=books$ratings_count %>% as.numeric()
corr = cor(deg_df_1$degree,deg_df_1$ratings_count, method = "spearman")
Значение корреляции 0.4575725. Оно не очень велико, однако, мы можем сделать вывод, что связь между величинами есть и она положительная - действительно, чем больше количество отзывов у книги, тем больше значение степени у вершины.
Для дальнейшей работы с сетью выделим в ней подгруппу. Из всех вершин выберем только комиксы Marvel (по переменной publisher). Графики в выделенной сети будут более “читаемыми”, можно будет делать более содержательные выводы. Внутри “вселенной Marvel” сохраняется много связей между вершинами, что удобно для анализа.
Посмотрим, как будет выглядеть сеть, состоящая из комиксов Marvel:
V(comics_net)$pub = books$publisher
marvel = delete.vertices(comics_net, V(comics_net)[ V(comics_net)[pub != "Marvel"] ])
ggraph(marvel)+
geom_node_point(color = 3, size = 2)+
geom_edge_link(width = 0.1)
Отметим, что в самой сети невооруженным глазом видны выделяющиеся подгруппы-сообщества. Так же есть группы из 2-4 вершин, отделившиеся от основной массы вершин. Вероятно, эти небольшие группы связаны общей серией комиксов или общим автором. Проверим это на примере “группы-треугольника”:
Выясняем, какие именно книги включает в себя этот треугольник.
books_m = books %>% filter(publisher == "Marvel")
V(marvel)$id = books_m$book_id
ggraph(marvel)+
geom_node_point(color = 3, size = 2)+
geom_edge_link(width = 0.1)+
geom_node_text(aes(label=case_when(degree(marvel)==2~V(marvel)$id)))
tit_1 = books_m$title[books_m$book_id == "6584405"]
tit_2=books_m$title[books_m$book_id == "1795583"]
tit_3 = books_m$title[books_m$book_id == "106033"]
ill = books_m$authors.1.author_id[books_m$book_id == "106033"]
Это книги с id 6584405, 106033 и 1795583. Их названия: Incognito ; Criminal, Vol. 2: Lawless (Criminal, #2) ; Criminal, Vol. 1: Coward (Criminal, #1). Википедия подсказала, что у них один и тот же иллюстратор Sean Phillips, а упомянутые произведения - его самые известные работы. Его id в нашей сети - 22671. Посмотрим, какие еще его работы, помимо попавших в рассматриваемый треугольник у него есть.
illu = books_m %>% filter(authors.1.author_id=="22671") %>% select (authors.1.author_id, title)
datatable(illu)
Как оказалось, эти три произведения - единственные работы этого художника в нашей сети. Эти три книги связаны между собой, но не связаны ни с какими другими вершинами графа. Можно предположить, что у автора особый, уникальный почерк, который выделяет его среди всех остальных, что в свою очередь отражается в отзывах.
В первую очередь посчитаем показатель степени вершин и выясним, у какого комикса он наибольший.
deg_m = data.frame(book_id = names(degree(marvel)), degree = degree(marvel))
deg_id = deg_m$book_id[deg_m$degree == max(deg_m$degree)]
degree_name = books_m$title[books_m$book_id == deg_id]
Наибольшее значение степени у произведения Hawkeye, Volume 1: My Life as a Weapon.
Зададим размер вершин графа таким образом, чтобы он соответствовал значению степени.
Далее рассчитаем показатель центральности по посредничеству.
betw= data.frame(book_id = names(betweenness(marvel)), bet =betweenness(marvel))
betw_id = betw$book_id[betw$bet == max(betw$bet)]
betw_name = books_m$title[books_m$book_id == betw_id]
Наибольшее значение битвинности также у Hawkeye, Volume 1: My Life as a Weapon. Этот комикс является своеобразным центром нашего графа. У него наибольшее количество связий и при этом он связывает разные группы вершин.
Отразим значение битвинности на графике:
ggraph(marvel)+
geom_node_point(size = betweenness(marvel)/105,color = 3)+
geom_edge_link(width = 0.1)
Следующая гипотеза заключается в том, что связи более вероятно будут возникать между комиксами, выпущенными в одном временном промежутке. Чтобы проверить это, разобьем годы публикации на четыре временных промежутка: 2005-2007, 2008-2010, 2011-2013, 2014-2016.
books_m$publication_year = books_m$publication_year %>% as.numeric()
books_m$pub_year = case_when(books_m$publication_year <=2007~"2005-2007",books_m$publication_year <=2010~ "2008-2010", books_m$publication_year <=2013~ "2011-2013", TRUE~"2014-2016")
V(marvel)$year = books_m$pub_year
year_assort = assortativity_nominal(marvel,as.factor(V(marvel)$year), directed = F)
Значение ассортативности 0.5222834. Оно достаточно велико - узлы действительно склонны образовывать связи со схожими по времени публикации. Отразим распределение по времени публикации на графике.
ggraph(marvel)+
geom_node_point(aes(color = year))+
geom_edge_link(width = 0.1)
По графику можно сказать, что комиксы в сети образуют группы по времени публикации. На рисунке выделяется группа более старых комиксов, группа более новых. В целом, между узлами с одинаковым временем публикации больше связей, чем между выделенными группами.
Возможно, при попытке выделения сообществ внутри графа, используя какой-либо из алгоритмов, мы получим примерно похожую картину.
Следующим шагом разбиваем граф на сообщества (использован алгоритм walktrap, так как он дал наибольшее значение модулярности).
commun <- walktrap.community(marvel)
modu = modularity(commun)
Значение модулярности составило 0.5205234 (заметим, что это примерно равно ассортативности по годам). Разбиение получилось достаточно качественным. Было выделено 8 сообществ.
Наконец, посмотрим на получившееся с помощью walktrap разбиение на графике и сопоставим его с разбиением по годам.
V(marvel)$color = case_when(V(marvel)$year=="2005-2007" ~ "red",
V(marvel)$year=="2008-2010" ~ "green",
V(marvel)$year =="2011-2013" ~ "yellow",
V(marvel)$year =="2014-2016" ~ "blue")
plot(commun, marvel,vertex.size = 4,vertex.label = NA,edge.width = 0.5, edge.color = "black", main = "Разбиение walktrap")
plot(marvel, vertex.size = 4, vertex.label = NA,edge.width = 0.5, edge.color = "black", vertex.color = V(marvel)$color, main = "Разбиение по годам публикации")
Разбиения получились похожими. Алгоритм walktrap, однако, дополнительно выделяет группы, “отстраненные” от общей массы узлов. Мы можем утверждать, что год публикации является одной из основ образования подгрупп внутри сети комиксов Marvel.