Побудова графів на основі даних з vk.com
Roman Kyrychenko
June 20, 2016
У цій статті піде мова про побудову графів у середовищі R на основі даних про підписників публічних сторінок Вконтакті. Для цього нам потрібно підключитися до Вконтакті API, викачати дані про обрані публічні сторінки, переформатувати дані для того, щоб на їх основі можна було зробити візуалізацію, обрати алгоритми виділення кластерів у графах та візуалізувати дані.
Аналіз Вконтакті
З Вконтакті можна викачувати списки підписників публічних сторінок (при цьому існує обмеження в 1000 акаунтів). Це далеко не єдина інформація, яку можна отримати від Вконтакті API, але в цьому випадку нас цікавить саме це. З цих спиків підписників можна зрозуміти, яка приблизно кількість спільних підписників у різних спільнот. Спільних підписників можна трактувати як показник інтенсивності зв’язку між спільнотами, ознаку їх подібності
Підключення до vk.com API
Перед тим, як починати роботу в R, необхідно створити додаток у Вконтакті, через який відбуватиметься викачка даних. За лінком https://new.vk.com/dev потрібно створити додаток. Додаток реєструється як Standalone. У розділі Налаштування потрібно дізнатись свої client_id i client_secret. Там же знизу потрібно розгорнути вікно, в якому прописати поле Адреса сайту (тут вводимо адресу, яку консоль R видає, якщо в нього ввести функцію oauth_callback()) та Базовий домен (пишемо localhost). client_id i client_secret зберігаємо у файлі secret_keys.R як змінні з відповідними назвами. Сам файл має виглядати десь так:
client_id <- "5506289"
client_secret <- "doeH1Hlv3KAqxCfGqQRy"
app_name <- "my_apps"Після цього можна переходити до роботи в R
Підключимо необхідні бібліотеки:
library(RCurl)
library(httr)
library(RJSONIO)
library(lubridate)
library(dplyr)Функція, яка створює підключення до vk.com API
get_access_token <- function(){
accessURL <- "https://oauth.vk.com/access_token"
authURL <- "https://oauth.vk.com/authorize"
vk <- oauth_endpoint(authorize = authURL,
access = accessURL)
myapp <- oauth_app(app_name, client_id, client_secret)
ig_oauth <- oauth2.0_token(vk, myapp,
type = "application/x-www-form-urlencoded",
cache=FALSE)
my_session <- strsplit(toString(names(ig_oauth$credentials)), '"')
access_token <- paste0('access_token=', my_session[[1]][4])
access_token
}Власне, підключка. У цьому нам допомагає заздалегідь створений додаток (його ключі у файлі secret_keys.R) та написана вище функція
source('secret_keys.R')
access_token <-get_access_token()У консолі R буде писатись:
## Waiting for authentication in browser...## Press Esc/Ctrl + C to abortБраузер видасть:
## Authentication complete.Після цього продовжуємо роботу в R
Створюємо функцію викачки списку підписників:
get_members <- function(group_domain, sort = 'sort=id_asc') {
fields <- 'fields=sex,bdate,city,country,photo_50,photo_100,photo_200_orig,photo_200,photo_400_orig,photo_max,photo_max_orig,online,online_mobile,lists,domain,has_mobile,contacts,connections,site,education,universities,schools,can_post,can_see_all_posts,can_see_audio,can_write_private_message,status,last_seen,relation,relatives,counters'
api <- paste0('https://api.vk.com/method/groups.getMembers?group_id=', group_domain)
request <- paste(api, fields, sort, access_token, sep='&')
members_list <- fromJSON(getURL(request))
members <- members2df(members_list$response$users)
members
}Функція, яка створює таблицю даних з викачаного списку друзів
members2df <- function(members){
df <- data.frame(uid = rep(0,length(members)))
i <- 0
for (member in members) {
i <- i + 1
df$uid[i] <- member$uid # id користувача
df$first_name[i] <- member$first_name # ім'я
df$last_name[i] <- member$last_name # прізвище
df$sex[i] <- member$sex # стать
df$bdate[i] <- ifelse(is.null(member$bdate), NA,
ifelse(nchar(member$bdate)<6,
as.character(dmy(paste0(member$bdate,'.1904'))),
as.character(dmy(member$bdate)))) # дата народження
df$city_id[i] <- ifelse(is.null(member$city), NA, member$city) # місто
df$country_id[i] <- ifelse(is.null(member$country), NA, member$country) # країна
df$university[i] <- ifelse(is.null(member$university_name), NA,
ifelse(member$university_name=='', NA,
member$university_name)) # ВНЗ
df$deactivated[i] <- ifelse(is.null(member$deactivated), 'active',
member$deactivated)
}
df
}Ці функції викачують ідентифікаційні номери користувачів, їх імена, прізвища, рідні міста, країни, рік народження, їх ВНЗ та статус акаунту (існуючий, забанений чи видалений). Цю інформацію також можна окремо аналізувати, але в нашому випадку нас цікавлять тільки ідентифікаційні номери користувачів. Детальніше про викачку даних з Вконтакті можна почитати тут:https://rpubs.com/yurkai/runvrn_part1. Також можна використовувати для цього бібліотеку vkR.
Викачка даних з vk.com
Для прикладу я обрав найбільш популярні групи Вконтакті. Підозрюю, що контингент підписників у них буде схожим, тому їх розбавив парою популярних українських пабліків
#Чоткий паца
#MDK
#Орленок
#Вконтакті Україна
#команда ВК
#Вконтакте для бизнеса
#МДК.Девочки
#Родственники
#Бизнес-цитатник
#Психология Джокера
#Бук
#Український простір
#Fitness Gym — спорт / бодибилдинг / фитнес / зож
#Новинки Музыки 2016
#Киномания
#Смейся до слёз :D
#Палата №6
#Корпорация Зла
#БОРЩ
#Психология отношений
#Science|Наука
#40 КГ
#Трахни нормальность
#5 умных мыслей
#Лепра
#Мужские мысли
#Институт Благородных Девиц
# та іншіСтворення списку користувачів з обраних груп. Викачка даних із них.
vk.gr.list <- list("chotkiy_paca",
"mudakoff",
"onlyorly",
"ua",
"team",
"adsnews",
"mdk.girls",
"mdk.rodstvenniki",
"businessquotes",
"wicked.mind",
"bukra",
"uarevo",
"fitness_gym",
"exclusive_muzic",
"kinomania",
"ifun",
"pn6",
"evil_incorparate",
"borsch",
"psy.people",
"sci",
"40kg",
"trahninormalnost1",
"v5umm",
"leprum",
"strog_pocan",
"thesmolny",
"kino_mania",
"fuck_humor",
"oroom",
"ilikes",
"lhack",
"smeyaka",
"ti_nepoverish",
"fucking_humor",
"xfilm",
"sh.cook",
"9o_6o_9o",
"black_humor",
"vk.krasota",
"s_arcazm",
"be.beauty",
"kino_kaif",
"i.kino",
"cook_good",
"dfilm",
"humour.page",
"smsin",
"o_ptimist",
"cosec",
"onlinekinoteatr",
"bon",
"smechno_do_boli",
"mzk",
"iface",
"science_technology",
"live",
"un_horoscope",
"girls.blog",
"i.cook",
"e_goist",
"shutniki_ru",
"h.made",
"be.women",
"hitrosti_jizni_ru",
"1poetry",
"psyxov",
"lo_horoscope",
"vinevinevine",
"igm",
"i_want_love_dream",
"smart_log",
"thahahah",
"i.like.this",
"i.moda")
#vk.groups <- lapply(vk.gr.list, get_members)Oб’єднання в список елементів іншого списку. Оскільки функція викачує і масу інших даних, а нам потрібні тільки ідентифікаційні номери (uid), то відсіємо зайве. Створимо спочатку функцію для цього
al <- function (x){
al <- x$uid
al
}А тепер створимо спискок, що об’єднає тільки ідентифікатори:
s <- lapply(vk.groups,al)Основою графу є матриця, що містить число усіх збігів між векторами (кожен вектор - це ідентифікаційні номери підписників однієї із груп). Всього у нас 75 векторів. Нижче ми будуємо матрицю 75x75, що показує число однакових елементів (однакових ідентифікаційних номерів) у кожному з векторів
df <- crossprod(table(stack(s)))Попередня функція зробила так, що по діагоналі матриці кожен елемент = 1000 (по діагоналі матриця показує число збігів вектора самим із собою, тому просто повертає його розмір). Нам це не потрібно, тому зробимо, щоб діагональ матриці = 0:
diag(df) <- 0Тепер можна перейти до саме побудови графів
Побудова графів
Підключаємо бібліотеку igraph, за допомогою функцій якої ми тепер будемо будувати графи:
library(igraph)Переформатування матриці у формат, необхідний для побудови графів:
g <- graph.adjacency(df, weighted=T, mode = "undirected")Бібліотека igraph використовує на вхід однойменний тип даних, що є по суті матрицею з набором властивостей.
Функція, що показує у відповідності до алгоритму номер кластера, до якого належить змінна. Про самі алгоритми можна детальніше почитати тут:https://www.hse.ru/data/2013/06/10/1283702757/dzh.pdf
network.funk <- function(x){
a <- edge.betweenness.community(x)
b <- fastgreedy.community(x)
c <- walktrap.community(x)
d <- spinglass.community(x)
e <- leading.eigenvector.community(x)
f <- label.propagation.community(x)
h <- c(V(x)$name)
res <- data.frame(c(a$membership),
c(b$membership),
c(c$membership),
c(d$membership),
c(e$membership),
c(f$membership))
colnames(res) <- c("between.","fastgr.","walktr.","spingl.","eigenv.","propag.")
rownames(res) <- h
res
}Функція повертає таблицю даних:
network.funk(g)## between. fastgr. walktr. spingl. eigenv. propag.
## 1poetry 1 2 2 2 1 1
## 40kg 1 2 2 2 1 1
## 9o_6o_9o 1 2 2 3 1 1
## adsnews 2 2 2 2 1 1
## be.beauty 1 2 2 3 1 1
## be.women 1 2 2 3 2 1
## black_humor 3 1 1 1 2 1
## bon 4 2 2 2 1 1
## borsch 1 2 2 2 1 1
## bukra 5 1 1 1 2 1
## businessquotes 1 2 2 2 1 1
## chotkiy_paca 6 1 1 1 2 1
## cook_good 7 2 2 2 1 1
## cosec 8 1 1 1 2 1
## dfilm 1 2 2 2 1 1
## e_goist 1 1 1 1 2 1
## evil_incorparate 1 2 2 2 1 1
## exclusive_muzic 1 2 2 2 1 1
## fitness_gym 9 1 1 1 2 1
## fuck_humor 1 1 2 2 2 1
## fucking_humor 1 1 1 1 2 1
## girls.blog 1 2 2 3 1 1
## h.made 1 2 2 3 1 1
## hitrosti_jizni_ru 10 1 1 1 2 1
## humour.page 1 1 1 1 2 1
## i_want_love_dream 1 2 2 3 1 1
## i.cook 1 2 2 3 1 1
## i.kino 1 2 2 2 1 1
## i.like.this 1 1 1 1 2 1
## i.moda 1 2 2 3 1 1
## iface 11 1 1 1 2 1
## ifun 1 1 1 1 2 1
## igm 12 1 1 1 2 1
## ilikes 1 1 1 1 2 1
## kino_kaif 1 1 2 1 2 1
## kino_mania 1 2 2 2 1 1
## kinomania 1 2 2 2 1 1
## leprum 13 2 2 2 1 1
## lhack 1 1 2 1 2 1
## live 14 2 2 2 1 1
## lo_horoscope 15 1 1 1 2 1
## mdk.girls 16 1 1 1 2 1
## mdk.rodstvenniki 17 1 1 1 2 1
## mudakoff 18 2 2 2 1 1
## mzk 1 2 2 2 1 1
## o_ptimist 1 1 1 1 2 1
## onlinekinoteatr 19 2 2 2 1 1
## onlyorly 1 1 1 1 2 1
## oroom 20 1 1 1 2 1
## pn6 1 2 2 2 1 1
## psy.people 21 2 2 3 1 1
## psyxov 1 2 2 3 1 1
## s_arcazm 1 2 2 2 1 1
## sci 22 2 2 2 1 1
## science_technology 1 2 2 2 1 1
## sh.cook 1 2 2 3 1 1
## shutniki_ru 1 1 1 1 2 1
## smart_log 23 1 1 1 2 1
## smechno_do_boli 1 1 1 1 2 1
## smeyaka 24 1 1 1 2 1
## smsin 25 1 1 1 2 1
## strog_pocan 1 1 2 1 2 1
## team 26 2 2 2 1 1
## thahahah 27 1 1 1 2 1
## thesmolny 28 1 1 1 2 1
## ti_nepoverish 1 2 2 2 1 1
## trahninormalnost1 1 2 2 2 1 1
## ua 29 1 1 1 2 1
## uarevo 30 1 1 1 2 1
## un_horoscope 31 1 1 1 2 1
## v5umm 1 2 2 2 1 1
## vinevinevine 1 1 1 1 2 1
## vk.krasota 1 1 1 1 2 1
## wicked.mind 32 1 1 1 2 1
## xfilm 1 2 2 2 1 1Iнший варіант попередньої функції повертає нам тільки число кластерів, які виокремлює той чи інший алгоритм. Це потрібно для того, шоб ми обрали найбільш підходящі алгоритми для побудови графів
network.clusters <- function(x){
a <- edge.betweenness.community(x)
b <- fastgreedy.community(x)
c <- walktrap.community(x)
d <- spinglass.community(x)
e <- leading.eigenvector.community(x)
f <- label.propagation.community(x)
res <- data.frame(c(length(unique(a$membership))),
c(length(unique(b$membership))),
c(length(unique(c$membership))),
c(length(unique(d$membership))),
c(length(unique(e$membership))),
c(length(unique(f$membership))))
rownames(res) <- "clusters"
colnames(res) <- c("betweenness","fastgreedy","walktrap","spinglass","eigenvector","propagation")
res
}Кількість кластерів, які виокремлюють наші алгоритми:
network.clusters(g)## betweenness fastgreedy walktrap spinglass eigenvector propagation
## clusters 32 2 2 3 2 1Тепер ми бачимо, що алгоритими edge.betweenness, fastgreedy, walktrap, spinglass та leading.eigenvector розбивають графи на 2 чи більше кластерів. Отже, можна їх використати для візуалізації.
Створюємо списки за алгоритмами кластеризації - вони додають до попередньої матриці властивості кластера:
a <- edge.betweenness.community(g)
b <- fastgreedy.community(g)
c <- walktrap.community(g)
d <- spinglass.community(g)
e <- leading.eigenvector.community(g)Додамо деякі властивості до графів:
V(g)$label.cex=0.8 #зменшимо розмір шрифту, аби всі назви "влізли"
V(g)$label.color="black" #колір шрифту зробимо більш читабельним чорнимРезультат побудови
Граф edge.betweenness
plot(a, edge.width=E(g)$weight/400, edge.color =rgb(141/255, 255/255, 0/255), as.undirected(g))
plot of chunk edge.betweenness
Граф fastgreedy
plot(b, edge.width=E(g)$weight/400, edge.color =rgb(141/255, 255/255, 0/255), as.undirected(g))
plot of chunk fastgreedy
Граф walktrap
plot(c, edge.width=E(g)$weight/400, edge.color =rgb(141/255, 255/255, 0/255), as.undirected(g))
plot of chunk walktrap
Граф spinglass
plot(d, edge.width=E(g)$weight/400 , edge.color =rgb(141/255, 255/255, 0/255), as.undirected(g))
plot of chunk spinglass
Граф leading.eigenvector
plot(e, edge.width=E(g)$weight/400 , edge.color =rgb(141/255, 255/255, 0/255), as.undirected(g))
plot of chunk leading.eigenvector
Як видно, окремі кластери погано виокремлюються з усієї маси зв’язків. Це в принципі не дивно, оскільки для аналізу ми взяли найпопулярніші спільноти, у яких чисельність більше 3 млн підписників. Користувачі у них доволі типові. І у всіх 75 пабліків є доволі помітна частка спільних користувачі в з іншими 74-ма пабліками. Чіткіше виділити кластери можна, якщо прирівняти деякий поріг значень до 0. Наприклад, ми будемо вважати, що 49 спільних підписників (межа нижнього квартилю) - це не показник зв’язку і прирівняємо його і все, що менше за нього до 0.
Беремо уже створену матрицю, що містить число спільних елементів і від кожного значення в ній віднімаємо 49:
lol <- df-49Все, що менше 0, прирівняємо до 0:
lol[lol<0]<-0Переформатуємо в потрібний для графу формат:
l <- graph.adjacency(lol, weighted=T, mode = "undirected")Поглянемо, які алгоритми годяться для побудови графів:
network.clusters(l)## betweenness fastgreedy walktrap spinglass eigenvector propagation
## clusters 17 3 6 4 2 1Уже видно, що за таких умов алгоритми виокремлюють більше число кластерів
Додаємо властивості кластерів:
k <- edge.betweenness.community(l)
f <- fastgreedy.community(l)
w <- walktrap.community(l)
y <- spinglass.community(l)
q <- leading.eigenvector.community(l)Налаштуємо шрифт:
V(l)$label.cex=0.8 #зменшимо розмір шрифту, аби всі назви "влізли"
V(l)$label.color="black" #колір шрифту зробимо більш читабельним чорнимІ побудуємо нові графи:
plot(k, edge.width=E(g)$weight/400 , edge.color =rgb(141/255, 255/255, 0/255), as.undirected(l))
plot(f, edge.width=E(g)$weight/400 , edge.color =rgb(141/255, 255/255, 0/255), as.undirected(l))
plot(w, edge.width=E(g)$weight/400 , edge.color =rgb(141/255, 255/255, 0/255), as.undirected(l))
plot(y, edge.width=E(g)$weight/400 , edge.color =rgb(141/255, 255/255, 0/255), as.undirected(l))
plot(q, edge.width=E(g)$weight/400 , edge.color =rgb(141/255, 255/255, 0/255), as.undirected(l))
У них кластери краще графічно викоремлюються, зокрема дуже сильно виділяються українські спільноти серед російських.
За умов великої кількості графів вони стають важко читабельними. Цю проблему можна вирішити за рахунок побудови інтерактивних візуалізацій, які можна зробити за допомогою пакетів network,ndtv та networkD3. Але це вже окрема історія ;)