library(quanteda)
library(tidyr)
library(topicmodels)
library(tidytext)
library(dplyr)
library(stringr)
df = read.csv("/home/voskresenskiiv/lda_lab/un_news.csv") # загружаем датасет с названием
#сообщения, полным текстом, датой
04 03 2017
library(quanteda)
library(tidyr)
library(topicmodels)
library(tidytext)
library(dplyr)
library(stringr)
df = read.csv("/home/voskresenskiiv/lda_lab/un_news.csv") # загружаем датасет с названием
#сообщения, полным текстом, датой
stop_words = stopwords("english")
df$story = df$story %>% as.character() # делаем текстовую переменную
myDfm = dfm(df$story,stem = T, removeNumbers = TRUE,
remove = stop_words, removePunct = TRUE)
# создаем document-feature matrix,
# в которой пересечения между нашими токенами и
# документами, при
# помощи аргумента stem проводим стемминг (приводим слова к основе),
# а при помощи аргумента remove удаляем стоп-слова
# ap_lda = LDA(myDfm,k=20,control = list(seed = 1234,verbose=TRUE)) # делаем тематическую модель, k отвечает за кол-во топиков # control включает в себя ряд параметров, # например, seed это идентификатор, который позволяет при желании # восстановить именно эту модель в будущем, а verbose отражает #основные этапы работы алгоритма
load('/home/voskresenskiiv/lda_lab/lda_model.rda')
ap_lda_td <- tidy(ap_lda)
# превращаем результаты моделирования в датасет:
# первая колонка -- номер топика (их у нас 50),
# вторая -- токен, третья -- вероятность
ap_gamma <- tidy(ap_lda, matrix = "gamma")
# делаем документ-топик датасет:
# первая колонка -- номер документа,
# вторая -- номер топика, третья -- вероятность
topic.per.word = ap_lda_td %>% spread(topic,beta) # делаем матрицу, строчки -- токены, столбцы -- топики, # на пересечении -- вероятность vocabulary = topic.per.word$term vocabulary = as.character(vocabulary) rownames(topic.per.word) = topic.per.word$term topic.per.word = select(topic.per.word,-1) %>% t() %>% as.matrix() # теперь у нас есть матрица, в которой строчки -- топики, # столбцы -- токены, на пересечении -- вероятность
topic.per.doc = ap_gamma %>% spread(topic, gamma) rownames(topic.per.doc) = topic.per.doc$document topic.per.doc = select(topic.per.doc,-1) %>% as.matrix() # а это вторая важная матрица для нас, в которой строчки -- документы, # столбцы -- топики, пересечение -- вероятность wordcounts = myDfm %>% tidy() %>% group_by(term) %>% filter(term %in% vocabulary) %>% summarise(n=sum(count)) doc.length = df %>% unnest_tokens(word,story) %>% group_by(id) %>% count() doc.length = doc.length$n
# визуализируем наш LDA # размер кружка показывает, сколько прцоентов #текстового корпуса на него приходится # дистанция также важна; чем ближе топики, #тем они более похожи друг на друга #topic.per.word[topic.per.word==0] = 0.00000000000000001 #так работает #library(LDAvis) #library(servr) #json <- createJSON(phi = topic.per.word, theta=topic.per.doc, #doc.length=doc.length, vocab=vocabulary, term.frequency=wordcounts$n) #serVis(json, out.dir="lda100", open.browser=TRUE)
#ap_gamma %>% filter(topic == 6) %>% arrange(-gamma) %>% top_n(5) #df$story[470] #df$story[698] #ap_gamma %>% filter(topic == 15) %>% arrange(-gamma) %>% top_n(5) #df$story[739]
topic.words = ap_lda_td %>% group_by(topic) %>% top_n(20) doc.topics = ap_gamma %>% group_by(document) %>% top_n(3)
library(ggplot2) p4 = ap_lda_td[ap_lda_td$topic==c(16,13,6),] %>% mutate(term = reorder(term, beta)) %>% top_n(20) %>% ggplot(aes(term, beta)) + geom_bar(stat = "identity", show.legend = FALSE) + facet_wrap(~ topic, scales = "free_y") + coord_flip()
p4
df$document = str_c("text",df$id)
doc.topics = left_join(doc.topics,select(df,year, document))
doc.topics = doc.topics %>% group_by(topic,year) %>% summarise(mean.prob = mean(gamma))
doc.topics$year = doc.topics$year %>% as.integer()
ggplot(data=doc.topics[doc.topics$topic == 2,]) + geom_line(aes(y=mean.prob,x=year))
ggplot(data=doc.topics[doc.topics$topic < 11,]) + geom_line(aes(y=mean.prob,x=year)) +facet_wrap(~topic)
#ggplot(data=doc.topics[doc.topics$topic < 11,]) + #geom_line(aes(y=mean.prob,x=year)) +facet_wrap(~topic,scales="free_y")