uid в chat это айди сообщения, не игрока, игрока – ppid
names(r.chat)[names(r.chat) == "uid"] <- "id"
r.players$ppid <- r.players$uid
r.players$uid <- NULL #не мешаться при джойнах
r.all <- plyr::join(r.chat, r.players, by = "ppid")
to_info <- r.players[, c("level", "league", "type", "faction", "recharge", "lords.name")]
names(to_info) <- str_c("to_", names(to_info))
names(to_info)[names(to_info) == "to_lords.name"] <- "toName"
r.all.to_msg <- plyr::join(r.all, to_info)
## Joining by: toName
Выгрузка по плеерам запоздала на сутки, убиваем из чата всех, о ком ничего не знаем (на 25 октября – примерно 1800 сообщений)
r <- subset(r.all.to_msg, !is.na(lords.name))
Группировки по кол-ву сообщений и топ юзеров
r.grouped.1 <- group_by(r, faction, league, type, channel, name)
r.grouped.2 <- group_by(r, faction, league, type, channel, name, toName)
rgsm <- summarise(r.grouped.1, nmesg = length(ppid))
# разгруппируем чтобы получить абсолютный топ, а не в рамках группы
topmsg <- arrange(ungroup(rgsm), desc(nmesg))
topmsg
## Source: local data frame [1,117 x 6]
##
## faction league type channel name nmesg
## 300 Bright Kill_me_black Player League Kill_me_тьма 1406
## 525 Bright РЫЦАРИ Player League Arvut 759
## 950 Dark Легион Player League Master0k 508
## 453 Bright Закон Player World Dikia 501
## 164 Bright Dark_Legion Player League Albanec1993 485
## 225 Bright EVOLUTION Player League RUSK 423
## 1041 Dark Тьма Player League Варяг 354
## 886 Dark RedAlert Player League Лилу 343
## 489 Bright ЛИГА-СВЕТА Player League Алиса 336
## 1046 Dark Тьма Player League Шайтане 336
## .. ... ... ... ... ... ...
qplot(nmesg, data = topmsg)
## stat_bin: binwidth defaulted to range/30. Use 'binwidth = x' to adjust this.
qplot(factor(type), nmesg, data = topmsg, stat = "summary", geom = "bar", fun.y = "sum",
fill = factor(type))
Теперь посмотрим на адресатов:
r.grouped.1.to <- group_by(subset(r, !is.na(to_type)), to_faction, to_league,
to_type, channel, toName)
rgsm_to <- summarise(r.grouped.1.to, nmesg = length(ppid))
topmsg_to <- arrange(ungroup(rgsm_to), desc(nmesg))
topmsg_to
## Source: local data frame [116 x 6]
##
## to_faction to_league to_type channel toName nmesg
## 37 Bright Джедаи Player Private Светлая 187
## 17 Bright Help GM Private r15help04 122
## 52 Bright Сибирь Player Private Каин 106
## 67 Dark Asgard Player Private Reptile 104
## 89 Dark Дюрандаль Player Private ღ♥ღAngelღ♥ღ 89
## 104 Dark Тьма Player Private Kiss 85
## 70 Dark Danger Player Private Helgram 74
## 39 Bright Закон Player Private Dikia 72
## 20 Bright Help GM Private r15help08 68
## 19 Bright Help GM Private r15help07 57
## .. ... ... ... ... ... ...
qplot(nmesg, data = topmsg_to)
## stat_bin: binwidth defaulted to range/30. Use 'binwidth = x' to adjust this.
qplot(factor(to_type), nmesg, data = topmsg_to, stat = "summary", geom = "bar",
fun.y = "sum", fill = factor(to_type))
Потенциальные субгипотезы вопросы по структуре связей:
С добавлением текстмайнинга/лингвистики:
Соцлингв:
Частоты слов:
library("Rstem")
library("tm")
splitwords <- function(inchar) {
unlist(strsplit(inchar, " "))
}
wordStem.ruwrapper <- function(inchar) {
iconv(wordStem(iconv(inchar, to = "koi8-r"), language = "russian"), from = "koi8-r")
}
wordStemDocument <- function(indoc) {
mywords <- unlist(strsplit(indoc, " "))
str_c(wordStem.ruwrapper(mywords), " ")
}
countfreq <- function(inchar) {
stemmedchar <- wordStem.ruwrapper(inchar)
names(stemmedchar) <- NULL
sort(table(stemmedchar), decreasing = T)
}
# tm example: http://www.rdatamining.com/examples/text-mining
tmcleaning <- function(inchar) {
wCorpus <- Corpus(VectorSource(inchar))
wCorpus <- tm_map(wCorpus, tolower)
wCorpus <- tm_map(wCorpus, removePunctuation)
wCorpus <- tm_map(wCorpus, removeNumbers)
wCorpus <- tm_map(wCorpus, removeWords, stopwords("russian"))
wCorpus <- tm_map(wCorpus, wordStemDocument)
wCorpus
}
library(wordcloud)
## Loading required package: Rcpp
## Loading required package: RColorBrewer
library(RColorBrewer)
library(Cairo)
genwordcloud <- function(intdm, min.freq) {
pal <- brewer.pal(8, "Dark2")
m <- as.matrix(intdm)
# calculate the frequency of words
freq <- sort(rowSums(m), decreasing = TRUE)
terms <- names(freq)
CairoFonts(regular = "Ubuntu:style=Italic", bold = "Ubuntu:style=Bold",
italic = "Ubuntu:style=Italic", bolditalic = "Ubuntu:style=Bold Italic,BoldItalic",
symbol = "Symbol")
wordcloud(terms, freq, min.freq = min.freq, colors = pal)
}
Стемминг видимо надо брать через Rstem и враппер, в tm он тоже есть, тоже из snowball, но используя другой пакет, которого тоже нет в кран и я его пока не собирал.
//–ПОКА СТЕММИНГА НЕТ (например смотри “лиги”, “лигу”)
UPD: добавил базовый стемминг в tmcleaning по логике надо сначала делить на типы сообщений потом строить три разных корпуса и применять фильтры
chcontent <- r[, c("content", "channel")]
content.Private.raw <- subset(chcontent, channel == "Private")[["content"]]
content.League.raw <- subset(chcontent, channel == "League")[["content"]]
content.World.raw <- subset(chcontent, channel == "World")[["content"]]
rm(chcontent)
ndoc.Private <- length(content.Private.raw)
ndoc.League <- length(content.League.raw)
ndoc.World <- length(content.World.raw)
content.Private <- tmcleaning(content.Private.raw)
content.League <- tmcleaning(content.League.raw)
content.World <- tmcleaning(content.World.raw)
Выдаются какие-то предупреждения, связанные с кодировкой. Нужно посмотреть позже, пока отключил
content.Private.Corpus <- Corpus(VectorSource(content.Private), readerControl = list(reader = readPlain,
language = "russian"))
tdm.Private <- TermDocumentMatrix(content.Private.Corpus)
ft.Private <- findFreqTerms(tdm.Private, lowfreq = ndoc.Private * 0.004)
genwordcloud(tdm.Private, ndoc.Private * 0.004)
content.League.Corpus <- Corpus(VectorSource(content.League), readerControl = list(reader = readPlain,
language = "russian"))
tdm.League <- TermDocumentMatrix(content.League.Corpus)
ft.League <- findFreqTerms(tdm.League, ndoc.League * 0.004)
genwordcloud(tdm.League, ndoc.League * 0.004)
content.World.Corpus <- Corpus(VectorSource(content.World), readerControl = list(reader = readPlain,
language = "russian"))
tdm.World <- TermDocumentMatrix(content.World.Corpus)
ft.World <- findFreqTerms(tdm.World, ndoc.World * 0.004)
genwordcloud(tdm.World, ndoc.World * 0.004)
# Private
setdiff(ft.Private, union(ft.League, ft.World))
## [1] "ахах" "бонус" "будеш" "быстр" "вообщ" "вступ"
## [7] "давн" "дан" "заб" "заход" "котор" "крест"
## [13] "кстат" "моб" "нам" "напиш" "основн" "ответ"
## [19] "палатк" "писа" "подскаж" "пойд" "покупк" "получа"
## [25] "помощник" "понятн" "приятн" "саппорт" "смотр" "смысл"
## [31] "точн" "тьму" "хот" "ясн"
# League
setdiff(ft.League, union(ft.Private, ft.World))
## [1] "арм" "атак" "втор" "гер" "главн"
## [6] "дерев" "захватыва" "защит" "золот" "камн"
## [11] "кача" "кон" "маг" "мал" "народ"
## [16] "нет" "отправ" "очен" "пуст" "ряд"
## [21] "скок" "став" "сто" "стоун" "тво"
# World
setdiff(ft.World, union(ft.League, ft.Private))
## [1] "dikia" "артур" "добр" "знач"
## [5] "конунг" "набор" "нов" "пиш"
## [9] "пожалуйст" "почт" "предупрежден" "пришл"
## [13] "работа" "свет" "син" "слов"
## [17] "ссылк" "форум" "фракц" "хелпер"
## [21] "хоч"
Зачатки LDA (пока не выполняем)
#http://cran.r-project.org/web/packages/topicmodels/vignettes/topicmodels.pdf
#http://www.jstatsoft.org/v40/i13/paper
library("topicmodels")
VEM = LDA(tdm.Private, k = 30)
topics(VEM, 1)