Багатьом дослідникам, маркетологам, соціологам цікаво дослідити те, як функціонують різні сторінки у соціальних мережах, зокрема сторінки відомих компаній. Власникам цих компаній дуже просто це зробити: як і Вконтакті, так і Facebook пропонують адміністраторам сторінок хороші можливості для аналізу статистичної інформації про свої спільноти, зокрема дуже цінними є показники досяжності контенту сторінок. Але далеко не завжди нас цікавить інформація про ті сторінки, адміністраторами яких ми є. Цікаво подивитися, яка ситуація в інших сторінок, хто, як, як багато “лайкає” їх і тому подібне. Таку інформацію можна отримати, хоч і не настільки якісну, як за умов володіння правами адміністратора сторінки. Це можливо реалізувати через підключення до API соціальних мереж та подальшого отримання статистичної інформації з них. Можливості аналізу даних з Вконтакті більші, ніж у Facebook. Але з обох мереж можна отримати інформацію про різні групи і сторінки, зокрема показники активності.
Ілюстрація можливостей буде здійснена на прикладі сторінок Carlsberg Ukraine у Вконтакті та Facebook
Великою перевагою Вконтакті над Facebook є те, що для аналізу є доступною інформація про підписників сторінки, чого нема у Facebook, де ми обмежимось тільки аналізом контенту сторінки. Саме тому ми розпочнемо саме з Вконтакті, а вже під кінець покажемо можливості Facebook
Підключим відразу всі необхідні бібліотеки:
library(dplyr)
library(ggplot2)
library(car)
library(lmtest)
library(factoextra)
library(clValid)
library(RCurl)
library(httr)
library(RJSONIO)
library(lubridate)
library(dplyr)
Процес підключення до Вконтакті API уже був описаний [тут] (http://rpubs.com/kirichenko17roman/vk-graphs-in-R). Так само тут є код функції get_members
, яка використовується викачки списку підписників сторінки.
Для отримання інформації про контент сторінки використовується наступна функція:
get_wall_posts <- function(id_min, id_max, id_step=100){
extended <- paste0('extended=', 0)
copy_depth <- paste0('copy_history_depth=', 1)
id_lo=id_min;id_hi=id_min+id_step-1
cat(id_min,'-',id_max,': ')
while (id_lo < id_max) {
cat(min(id_hi, id_max), '. ')
posts_range <- id_lo:id_hi
posts <- paste0('posts=', paste0('-', group_id, '_', posts_range,
collapse=','))
request <- paste('https://api.vk.com/method/wall.getById?v=4.9',
posts, extended, copy_depth, access_token, sep='&')
posts_list <- fromJSON(getURL(request))
if (id_lo == id_min)
df <- wall2df(posts_list$response)
else
df <- rbind(df, wall2df(posts_list$response))
if (id_hi < id_max) Sys.sleep(sleep_time)
id_lo <- id_lo+id_step
id_hi <- id_hi+id_step
}
df
}
wall2df <- function(wall){
df <- data.frame(uid=rep(0, length(wall)))
i <- 0
for (wall_post in wall){
i <- i + 1
df$uid[i] <- wall_post$id
df$author[i] <- wall_post$from_id
df$whodidthis[i] <- ifelse(is.null(wall_post$created_by),
ifelse(is.null(wall_post$signer_id),
NA, wall_post$signer_id),
wall_post$created_by)
df$type[i] <- wall_post$post_type
df$comments[i] <- wall_post$comments[["count"]]
df$likes[i] <- wall_post$likes[["count"]]
df$reposts[i] <- wall_post$reposts[["count"]]
df$date[i] <- wall_post$date
df$text[i] <- wall_post$text
}
df
}
Тепер отримаємо масив інформації про пости в групі (це буде таблиця даних, в якій буде відображено зміст постів, час, лайки, коментарі, поширення для кожного посту окремо):
group_id <- 33305945 # id групи Karlsberg
id_min <- 1
posts <- get_wall_posts(id_min, id_max)
Для інших груп алгоритм той самий, потрібно лише підставити потрібне значення ІД сторінки. Для сторінок з адресою типу vk.com/group12345678
це будуть тільки цифри. Якщо спільно відмовилась від автоматично згенерованою у Вконтакті адреси і має за адресу щось типу vk.com/bestgroup
, то замість ІД вводимо ті символи, що знаходяться після vk.com/
Цікаво глянути, які саме люди лайкають і коментують. У Вконтакті це доволі просто зробити. Але для цього потрібно написати функцію, яка могла б зібрати ці дані.
Функція для отримання списку тих, хто лайкнув, та тих, хто прокоментував:
get_likers_commenters <- function(posts){
posts_likers_commenters <- list()
cat('1-', dim(posts)[1], ': ', sep='')
for (i in 1:dim(posts)[1]){
request_likers <- paste0('https://api.vk.com/method/likes.getList?owner_id=-',
group_id, '&type=post&item_id=', posts$uid[i])
likers <- fromJSON(getURL(request_likers))$response$users
request_comments <- paste0('https://api.vk.com/method/wall.getComments?v=5.50&owner_id=-',
group_id, '&post_id=', posts$uid[i])
comments <- fromJSON(getURL(request_comments))
commenters <- c()
comments_ids <- c()
comments_likers <- c()
if (comments$response$count){
commenters <- sapply(comments$response$items,
function(comment) comment$from_id)
comments_ids <- sapply(comments$response$items,
function(comment) comment$id)
for (comment_id in comments_ids) {
request_comments_likers <- paste0(
'https://api.vk.com/method/likes.getList?owner_id=-',
group_id, '&type=comment&item_id=',
comment_id)
comments_likers = c(comments_likers,
unlist(fromJSON(getURL(request_comments_likers))$response$users))
}
}
posts_likers_commenters[[i]] <- list(likers = likers,
commenters = commenters,
comments_likers = comments_likers)
if( i %% 25 == 0) cat(i, ' . ')
if( i %% 200 == 0) Sys.sleep(10)
}
posts_likers_commenters
}
Вона універсальна, її можна застосувати до будь-якого іншого масиву викачаних з Вконтакті постів.
Тепер застосуємо цю функцію і поглянемо, що вийшло:
posts_likers_commenters <- get_likers_commenters(posts)
## 1-1092: 25 .
head(posts_likers_commenters)
## [[1]]
## [[1]]$likers
## list()
##
## [[1]]$commenters
## NULL
##
## [[1]]$comments_likers
## NULL
##
##
## [[2]]
## [[2]]$likers
## list()
Поки дані у не дуже зручному форматі list. Додамо необхідну інформацію про країни і міста (у первинному файлі тільки їх коди), а також додамо колонку віку (відсіємо також всіх “100-літніх”“):
countries <- rename(countries, country_id=cid, country = name)
cities <- rename(cities, city_id=cid, city = name)
countries$country_id <- as.integer(countries$country_id)
cities$city_id <- as.integer(cities$city_id)
members <- left_join(members, cities, by = 'city_id')
members <- left_join(members, countries, by = 'country_id')
members$country[is.na(members$country)] <- 'не вказана'
members$city[is.na(members$city)] <- 'не вказане'
members$age <- floor(as.numeric(difftime(now(), members$bdate, units = 'days'))/365.25)
members$age[members$age > 100] <- NA
#Додамо все це у первинну таблицю даних
posts$likers <- sapply(posts_likers_commenters, function(plc) plc$likers)
posts$commenters <- sapply(posts_likers_commenters, function(plc) plc$commenters)
posts$comments_likers <- sapply(posts_likers_commenters, function(plc) plc$comments_likers)
Поглянемо тепер на обидва дата фрейми, інформацію до яких ми додали:
head(members[,-3], 3)
## uid first_name sex bdate city_id country_id university
## 1 354869 Dmitri Чол 1904-01-13 444 2 <NA>
## 2 2299816 Andrej Чол 1904-09-29 314 2 <NA>
## 3 2555698 Aleksej Чол <NA> 20926 2 <NA>
## deactivated city.x country.x age city.y country.y
## 1 active Чернiгiв Україна NA Чернiгiв Україна
## 2 active Київ Україна NA Київ Україна
## 3 active Токмак Україна NA Токмак Україна
head(posts, 3)
## uid author whodidthis type comments likes reposts date
## 1 1 -33305945 NA post 0 0 0 2012-01-18 23:50:24
## 2 2 -33305945 NA post 0 0 0 2012-01-18 23:51:45
## 3 3 -33305945 NA post 0 1 0 2012-01-18 23:52:12
## text
## 1 Друзья! Есть ли среди Вас настощие ЗНАТОКИ пива? Наша компания совместно с ассоциацией Укрпиво начинает национальный грандиозный конкурс "Народный дегустатор". Зарегистрироваться и узнать более детальную информацию можно на этом сайте а вот подружиться с конкурсом :-) на вот этой страничке в FB www.facebook.com/narodny.degustator. Уверенны, хорошее пиво ВЫ узнаете с первого глотка!
## 2 Самым дорогим пивным подарком в мире признана пивная кружка, которая изготовлена в Японии и состоит из чистого золота весом 850 грамм. Стоит она $ 50 000 и является традиционной японской кружкой для пива. Как утверждают её создатели, она отлично будет гармонировать с дорогими сортами пива.
## 3 А Вы знаете, что самый труднодоступный бар в мире находится в Антарктиде на украинской станции «Академик Вернадский»? Также бар вошел в десятку самых необычных питейных заведений мира. Его посещение входит в программу чуть ли не всех антарктических экскурсионных туров. Построил бар плотник из Британии. Среди гостей заведения были Билл Гейтс и британская принцесса. И пиво там, наверно, особенно прохладное :)
## likers commenters comments_likers
## 1 NULL NULL NULL
## 2 NULL NULL NULL
## 3 6685040 NULL NULL
Спробуємо тепер дещо візуалізувати. У першу чергу візуалізувати можна розподіл по статі, місту та віку серед підписників сторінки. Крім цього візуалізації піддається динаміка активностей на сторінці.
Для цього потрібно підготувати дані. Міста ми агрегуємо на Київ і не Київ, а вік розіб’ємо на інтервали:
members$sex <- ifelse(membersN$sex==1, 'Жін', 'Чол')
sex <- table(na.omit(members$sex))
#Місто
city_vrn <- table(ifelse(members$city=='Київ', 'Київ', 'інше'))
#Вікові інтервали
age_intervals <- c(16, 21, 26, 31, 36, 41)
age_names <- c('<16', '16-20', '21-25', '26-30', '31-35', '36-40', '40>')
age_bins = table(findInterval(na.omit(members$age), age_intervals))
names(age_bins) <- age_names
Поглянемо, що тепер маємо:
sex
##
## Жін Чол
## 199 363
city_vrn
## інше Київ
## 423 139
age_bins
## <16 16-20 21-25 26-30 31-35 36-40 40>
## 3 7 88 87 27 7 6
Узагальнимо інформацію по активності:
df_sparklines <- posts %>%
mutate(period = as.Date(cut(date, breaks='month')),
comments_likes = sapply(comments_likers,
function(p) length(unlist(p)))) %>%
group_by(period) %>%
summarise(likes=sum(as.numeric(likes)), comments=sum(as.numeric(comments)), reposts=sum(as.numeric(reposts)),
comments_likes=sum(as.numeric(comments_likes)), n=n()) %>%
as.data.frame()
Узагальнимо дані за останнє і передостаннє півріччя:
df_slope <- data.frame(colSums(df_sparklines[35:40,2:5])/
sum(df_sparklines$n[35:40]),colSums(df_sparklines[41:46,2:5])/
sum(df_sparklines$n[35:40]))
names(df_slope) <- format(c(df_sparklines[40,1], df_sparklines[46,1]), '%m/%y')
Поглянемо, що вийшло:
head(df_sparklines)
## period likes comments reposts comments_likes n
## 1 2012-01-01 19 0 2 0 28
## 2 2012-02-01 33 0 7 0 57
## 3 2012-03-01 20 5 6 0 39
## 4 2012-04-01 11 0 4 0 19
## 5 2012-05-01 6 0 3 0 8
## 6 2012-06-01 5 0 3 0 10
df_slope
## 12/15 06/16
## likes 3.74705882 2.000000000
## comments 0.02941176 0.023529412
## reposts 0.68823529 0.264705882
## comments_likes 0.00000000 0.005882353
Тепер наші дані готові до різних візуалізацій!
Зробимо просту візуалізацію за статтю і містом:
par(mfrow=c(1,2))
barplot(sex, main='Стать учасників')
barplot(city_vrn, main='Місто учасників')
Тепер за віком:
par(mfrow=c(1,1))
hist(members$age, main='Вік учасників',
xlab='Вік', ylab='Частота')
Тепер виведемо активність:
ggplot(data=gather(df_sparklines, 'value', 'type', 2:6), aes(period, type)) + geom_line(aes(colour=value))+
labs(title='Активність учасників спільноти', x='Дата', y='Кількість')
Порівняння активності зараз і півроку назад (всередньому на один пост):
ggplot(data=gather(cbind(df_slope, type=row.names(df_slope)), 'x', 'value', 1:2),
aes(x, value, group = type)) + geom_line(aes(colour=type)) +
labs(title='Порівняння активності зараз і півроку назад',
x='Період', y='Зважена активність')
Дані по віку, статі і місту можна помістити в одну красиву візуалізацію.
Але для цього потрібно зробити деякі маніпуляції з даними. Перетворимо частки у відсотки:
get_percent <- function(x, digits=0){
paste0(round(x*100, digits), '%')
}
Функція, що робить візуалізацію пропорцій у вигляді лінії з точками:
propplot_norm <- function(n1, n2, digits = 0){
prop = c(n1, n2) / (n1 + n2)
x <- c(0, 1)
y <- c(0, 0)
plot(x, y, type = 'l', axes=F, xlab="", ylab="")
points(prop[1], 0, pch=16)
text(0, 0.2, names(prop[1]), adj=c(0, NA), family="serif")
text(1, 0.2, names(prop[2]), adj=c(1, NA), family="serif")
text(0, -0.2, get_percent(prop[1], digits), adj=c(0, NA), family="serif")
text(1, -0.2, get_percent(prop[2], digits), adj=c(1, NA), family="serif")
}
Функція, що робить стовбчикову діаграму (модифікація barplot):
brickplot_norm <- function(bins, cuts = .10){
bins = bins / sum(bins)
barplot(bins, xaxt="n", yaxt="n", ylab="",
border=F, width=c(.35), space=1.8)
axis(1, at=(1:length(bins))-.26, labels=names(bins),
tick=F, family="serif")
axis(2, at=seq(cuts, (max(bins) %/% cuts) * cuts, cuts),
labels = get_percent(seq(cuts, (max(bins) %/% cuts) * cuts, cuts)),
las=2, tick=F, family="serif")
abline(h=seq(cuts, (max(bins) %/% cuts) * cuts, cuts), col="white", lwd=3)
abline(h=0, col="gray", lwd=2)
}
Тепер зробимо саму візуалізацію:
layout(matrix(c(1,2,3,3), 2, 2, byrow = TRUE), widths=c(2,2), heights=c(1,2))
par(mar=c(2,6,2,0))
propplot_norm(sex[1],sex[2])
par(mar=c(2,2,2,4))
propplot_norm(city_vrn[2],city_vrn[1])
par(mar=c(2,6,2,4))
brickplot_norm(age_bins, cuts=.05)
Це значно симпатичніше, ніж попередні більш прості варіанти.
Але розподіл по містах цікавіше було б зробити на карті, що ми зараз і зробимо.
Спочатку запустимо команду, яка створить функцію, що переводитиме назви міст в географічні координати за допомогою Яндекс API:
source("https://raw.githubusercontent.com/andriy-gazin/yandex-geocodeR/master/yaGeocode.R")
Це функція geocode
. Для цього можна було б використати однойменну функцію з пакету ggmap
, що використовує Google API. Але версія Яндексу дозволяє отримати не тільки координати, а і дані про країну, адміністративну одиницю. Також варіант Яндексу хороший ще і тим, що для нього дозволено робити в день 25 000 запитів API, для Google ця цифра в 10 разів менша.
Агрегуємо дані по містах в таблицю частот та додамо до неї стовпчики з координатами за допомогою вище закачаної функції:
city <- data.frame(table(members$city))
city.coord <- geocode(city$Var1)
city <- cbind(city,city.coord)
#видалимо стовпчик з невідповіддю, для якого немає координат
city <- city[-62,]
Для створення карти нам потрібна основа карти. Її ми скачаємо з GADM і переформатуємо для роботи:
ukraine <- raster::getData(name = "GADM", country = "UKR", level = 1)
ukraine <- fortify(ukraine)
## Regions defined for each Polygons
А тепер за допомогою пакету ggplot
створюємо саму мапу:
ggplot(ukraine)+
geom_polygon(aes(long, lat, group = group),
color = "#3A3F4A", fill = "#EFF2F4", size = 0.1)+
geom_point(data = city,
aes(lon, lat, size = Freq),
shape = 1, alpha = 0.75, stroke = 1)+
scale_size(name = "Чисельність:",
range = c(0.05, 20),
breaks = c(1, 5, 20, 50, 100),
labels = c("1", "5", "20", "50", "100"))+
labs(title = "Кількість підписників Carlsberg Ukraine")+
coord_map(projection = "mercator",
xlim = range(ukraine$long), ylim = range(ukraine$lat),
orientation = c(90, 0, 0))+
theme(text = element_text(color = "#3A3F4A"),
panel.grid.major = element_blank(),
axis.title = element_blank(),
axis.text = element_blank(),
plot.margin = unit(c(2, 2, 2, 2), "cm"),
legend.position = "top",
legend.margin = unit(0.1, "lines"),
legend.text = element_text(size = 12),
legend.title = element_text(face = "bold", size = 12),
legend.text.align = 0,
legend.box = "horizontal",
legend.box.just = "left",
plot.title = element_text(face = "bold", size = 20, margin = margin(b = 10), hjust = 0.5),
plot.background = element_rect(fill = "#EFF2F4"))
Така візуалізація дає більш повне уявлення про географічний розподіл підписників.
Для її побудови використовується ця функція:
sparklines <- function(dat, smooth=TRUE, box=c('iq', 'ci')[2]){
POINTS <- 201
N <- length(dat[,1])
lwd <- 0.5
ticks = 4
par(mfrow=c(ncol(dat)-1,1), mar=c(1,0,0,8), oma=c(4,1,4,4))
if (smooth) x = seq(1, nrow(dat), len=POINTS)
else x = 1:nrow(dat)
for (i in 2:ncol(dat)){
if (smooth){
y <- dat[,i]
s <- smooth.spline(y, spar = 0.01)
y <- predict(s, x)$y
}
else {
y <- dat[,i]
}
plot(x, y, lwd=lwd, axes=F, ylab="", xlab="", main="", type="n", new=F)
if (box == 'iq'){
y_box_lo <- quantile(df_sparklines$likes)[2]
y_box_hi <- quantile(df_sparklines$likes)[4]
}
else if (box == 'ci'){
y_box_lo <- t.test(dat[,i])$conf.int[1]
y_box_hi <- t.test(dat[,i])$conf.int[2]
}
else {
y_box_lo <- 0
y_box_hi <- 0
}
rect(1, y_box_lo, nrow(dat), y_box_hi, border=0,
col = rgb(192, 192, 192, alpha=90, maxColorValue=255))
lines(x, y, lwd=lwd)
axis(4, at=dat[nrow(dat),i], labels=round(dat[nrow(dat),i]), tick=F,
las=1, line=-1.5, family="serif", cex.axis=1.2)
axis(4, at=dat[nrow(dat),i], labels=names(dat[i]), tick=F, line=.5,
family="serif", cex.axis=1.4, las=1)
ymin <- min(dat[,i]); xmin <- which.min(dat[,i])
ymax<-max(dat[,i]); xmax <- which.max(dat[,i])
text(xmax, ymax, labels=round(max(ymax),0), family="serif", cex=1.2, adj=c(0.5,3))
text(xmin, ymin, labels=round(ymin,0), family="serif",cex=1.2, adj=c(0.5,-2.5))
points(x=c(xmin,xmax), y=c(ymin,ymax), pch=19, cex=1,col=c("red","blue"))
}
if (class(dat[,1]) == 'Date') {
labels = format(seq(dat[1,1], dat[N,1], len=ticks), '%m/%y')
axis(1, at=seq(1, nrow(dat), len=ticks), pos=c(-5), tick=F,
family="serif", cex.axis=1.4, labels=labels)
}
else {
axis(1, at=1:N, labels=dat[,1], pos=c(-5), tick=F,
family="serif", cex.axis=1.4)
}
}
Цю функцію можна застосувати до всіх даних вигляду df_sparklines
Результат виконання вельми симпатичний:
sparklines(df_sparklines)
Графік хороший тим, що не просто відображає певну динаміку, а і фіксує середнє тенденцію, точки мінімуму і максимуму
Ця функція дозволить нам порівняти зміни за останні півріччя:
slopegraph_2col <- function(df){
par(mfrow=c(1,1), mar=c(2,4,1,4), oma=c(4,6,2,6))
x = c(0, 1)
ymin = min(df)
ymax = max(df)
plot(x, c(ymin, ymax), type='n', axes=F, ylab="", xlab="", main="")
apply(df, 1, function(row) lines(x, row, lwd=.5))
at1 = df[,1]; at2 = df[,2]
axis(2, at=at1, labels=format(round(df[,1],1), nsmall = 1), tick=F, las=1, line=-1., family="serif", cex.axis=1.)
axis(4, at=at2, labels=format(round(df[,2],1), nsmall = 1), tick=F, las=1, line=-1., family="serif", cex.axis=1.)
axis(2, at=at1, labels=row.names(df), tick=F, line=1., family="serif", cex.axis=1., las=1)
axis(4, at=at2, labels=row.names(df), tick=F, line=1., family="serif", cex.axis=1., las=1)
axis(1, at = x, labels = names(df), family="serif", cex.axis=1.,las=1, pos=-.5, lwd=1.5)
}
Тепер дивимось на сам результат виконання функції на поданих даних. Ним буде побудований графік:
slopegraph_2col(df_slope)
Коли значення comments і comments_likes буде не нульовим, графік виглядатиме симпатичніше
Найпопулярнішим способом візуалізації текстового аналізу є wordcloud. Створимо його на основі контенту сторінки Carlsberg:
rdm <- posts$text
r_stats_text_corpus <- Corpus(VectorSource(rdm))
r_stats_text_corpus <- tm_map(r_stats_text_corpus,
content_transformer(function(x) iconv(x, to='UTF-8-MAC', sub='byte')),
mc.cores=1
)
r_stats_text_corpus <- tm_map(r_stats_text_corpus, content_transformer(tolower), mc.cores=1)
r_stats_text_corpus <- tm_map(r_stats_text_corpus, removePunctuation, mc.cores=1)
r_stats_text_corpus <- tm_map(r_stats_text_corpus, function(x)removeWords(x,stopwords()), mc.cores=1)
wordcloud(r_stats_text_corpus)
Користувацька активність може бути використана для побудови моделей, зокрема регресійної моделі.
Для цього зрупуємо активність кожного місяця:
month_activity <- posts %>%
mutate(period = as.Date(cut(date, breaks='month')),
comments_likes = sapply(comments_likers,
function(p) length(unlist(p)))) %>%
group_by(period) %>%
summarise(likes=sum(likes), comments=sum(comments), reposts=sum(reposts),
comments_likes=sum(comments_likes), n=n()) %>%
as.data.frame()
head(month_activity)
## period likes comments reposts comments_likes n
## 1 2012-01-01 19 0 2 0 28
## 2 2012-02-01 33 0 7 0 57
## 3 2012-03-01 20 5 6 0 39
## 4 2012-04-01 11 0 4 0 19
## 5 2012-05-01 6 0 3 0 8
## 6 2012-06-01 5 0 3 0 10
І побудуємо саму модель:
fit <- lm(reposts~likes+comments+comments_likes, data = month_activity)
summary(fit)
##
## Call:
## lm(formula = reposts ~ likes + comments + comments_likes, data = month_activity)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12.072 -2.879 -1.283 2.132 15.223
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.95817 1.17427 1.668 0.103
## likes 0.14672 0.01494 9.820 1.49e-12 ***
## comments -0.80600 0.51592 -1.562 0.126
## comments_likes 2.03590 1.47542 1.380 0.175
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.401 on 43 degrees of freedom
## Multiple R-squared: 0.7695, Adjusted R-squared: 0.7534
## F-statistic: 47.84 on 3 and 43 DF, p-value: 9.363e-14
Можна зробити також кластерний аналіз підписників групи, але про це краще поговоримо в іншій публікації.
Запускаємо необхідну нам бібліотеку. При цьому потрібно розуміти, що функціонал роботи з API Facebook менший, ніж з Вконтакті. Аналіз групи охопить тільки кількість коментарів, лайків і поширень, а також сам контент. Натомість ми не можемо, як у Вконтакті дослідити і саму аудиторію сторінки. Ця інформація недоступна.
library(Rfacebook)
Для підключення у Facebook потрібно дізнатися свій токен. Це можна зробити за цим посиланням - https://developers.facebook.com/tools/explorer Його потрібно скопіювати для роботи в R. Крім цього є ще одна його особливість - він дає доступ до API на обмежений час, тому час від часу цей токен потрібно оновлювати.
token <- 'EAACEdEose0cBAGZCnuMt7FvaegzZA3VYDPya52ZBY06bR8LEXayvUnS3AqstZAdqsmdsiF05wywmZCaHmjLKtCCYt8a4473LC2i3o1f5PPWeeJU39QZCvgQjZCdnjx1oLoT0s1g3uoxXGH6yqNcQMlZCg8DTjAyyFIbnNORBKJlfcwZDZD'
Тепер стають доступними функції пакету Rfacebook
. Це не єдиний спосіб підключення до Facebook API, це можна робити і через створення додакту, але такий спосіб є швидшим і простішим.
Скачаємо дані зі сторінки СarlsbergUA:
carl.page <- getPage("CarlsbergUA", token, n = 50000)
Тепер напишемо деякі функції, які допоможуть нам у роботі
Функція, що конвертує Facebook date format до R date format:
format.facebook.date <- function(datestring) {
date <- as.POSIXct(datestring, format = "%Y-%m-%dT%H:%M:%S+0000", tz = "GMT")
}
Функція, що агрегує дані по місяцях:
aggregate.metric <- function(metric) {
m <- aggregate(carl.page[[paste0(metric, "_count")]], list(month = carl.page$month),
mean)
m$month <- as.Date(paste0(m$month, "-15"))
m$metric <- metric
return(m)
}
Конвертуємо час і агрегуємо дані по лайках, коментарях і поширеннях:
carl.page$datetime <- format.facebook.date(carl.page$created_time)
carl.page$month <- format(carl.page$datetime, "%Y-%m")
df.list <- lapply(c("likes", "comments", "shares"), aggregate.metric)
df <- do.call(rbind, df.list)
Поглянемо тепер на дані
head(df)
## month x metric
## 1 1906-12-15 0.00000000 likes
## 2 1909-12-15 0.00000000 likes
## 3 1950-12-15 0.00000000 likes
## 4 1953-12-15 0.00000000 likes
## 5 1976-12-15 0.00000000 likes
## 6 1996-12-15 0.00000000 likes
Як видно, окремі дати публікацій збилися і є нереалістичними, їх ми просто відкинемо. Постійно публікації на сторінці почали з’являтися у травні 2013 року. Це буде нашою часовою межею
df <- df[df$month>"2013-05-01",]
Побудуємо графік, який акцентує увагу на менших відмінностях
library(ggplot2)
library(scales)
ggplot(df, aes(x = month, y = x, group = metric)) +
geom_line(aes(color = metric)) +
scale_x_date(breaks = date_breaks("years"), labels = date_format("%Y")) +
scale_y_log10(breaks = c(10, 20, 50, 100, 150)) + theme_bw() + theme(axis.title.x = element_blank())
До даних можна використати вже створену функцію sparklines
, зробивши форматування даних через бібліотеку reshape2
:
library(reshape2)
df.n <- dcast(df, month ~ metric, value.var = "x")
sparklines(df.n)
rd <- carl.page$message
r_text_corpus <- Corpus(VectorSource(rd))
r_text_corpus <- tm_map(r_text_corpus,
content_transformer(function(x) iconv(x, to='UTF-8-MAC', sub='byte')),
mc.cores=1
)
r_stats_corpus <- tm_map(r_text_corpus, content_transformer(tolower), mc.cores=1)
r_text_corpus <- tm_map(r_text_corpus, removePunctuation, mc.cores=1)
r_text_corpus <- tm_map(r_text_corpus, function(x)removeWords(x,stopwords()), mc.cores=1)
wordcloud(r_text_corpus)
Як бачимо, можливості викачки даних із соцмереж доволі обмеені, особливо, якщо говорити про Facebook. Однак ми не обмежені в тому, що можна робити із цими даними. Це далеко не вичерпний перелік візуалізацій, які можна застосувати до отриманих даних. Крім цього, на даних можна будувати різноманітні моделі, хоч ми і проілюстрували це тільки на прикладі розрахунку коефіцієнтів лінійної регресії