График отдельной темы LDA по дате (в R)

У меня есть группа текстовых файлов из нескольких журналов (назовем их журнал А и журнал Б), на которых я пытаюсь запустить LDA. Я разделяю их каждый на свой корпус, затем присоединяю имена файлов к каждому корпусу, сохраняю журнал происхождения под меткой origin и, наконец, объединяю два корпуса в myCorpus:

library(tm); library(topicmodels);

txtfolder <- "~/Path/to/txtfiles/"
source <- DirSource(txtfolder)
A.names <- list.files(path=txtfolder, pattern="A")
B.names <- list.files(path=txtfolder, pattern="B")
A.names <- lapply(X=A.names, FUN=function(i){gsub(".txt", '', x=i)})
B.names <- lapply(X=B.names, FUN=function(i){gsub(".txt", '', x=i)})
A.corpus <- Corpus(A.source, readerControl=list(reader=readPlain))
for (i in 1:length(A.corpus)){
  meta(A.corpus[[i]], tag = "origin") <- "A"
}
B.corpus <- Corpus(B.source, readerControl=list(reader=readPlain))
for (i in 1:length(B.corpus)){
  meta(B.corpus[[i]], tag = "origin") <- "B"
}
myCorpus <- c(A.corpus, B.corpus) # combining the two corpuses

Отсюда я запускаю LDA на myCorpus:

myCorpus <- tm_map(myCorpus, PlainTextDocument)
dtm <- DocumentTermMatrix(myCorpus, control = list(minWordLength=3))
n.topics <- 5
lda.model <- LDA(dtm, n.topics)
terms(lda.model,10)

Отсюда я хотел бы создать график, измеряющий долю каждого журнала, связанного с определенной темой, с течением времени (я могу определить время публикации каждого выпуска журналов путем анализа файлов txt и сохранить их в векторе аналогично тому, как я сделал с тегом origin). Я не уверен, как лучше хранить эту информацию, чтобы я мог использовать дату публикации в качестве горизонтальной оси. Что еще более важно, как я могу создать график, который я упомянул?


person mlinegar    schedule 25.07.2015    source источник


Ответы (1)


Я предполагаю, что вы хотите использовать ggplot, так как вы добавили этот тег. Сначала вам нужно собрать данные во фрейме данных.

Предполагая, что lda является результатом LDA(), а corpus является корпусом, вы найдете темы с topics(lda) и различную информацию о документах с использованием meta(corpus). Возможно, вам придется настроить это на свой корпус:

df <- data.frame(id=names(topics(lda)),
                 topic=topics(lda),
                 date=as.POSIXct(unlist(lapply(meta(corpus,type="local",tag="datetimestamp"),as.character))),
                 origin=unlist(meta(corpus,type="local",tag="origin"))    )

Затем вам нужно рассчитать статистику, которую вы хотите построить: частоту каждой темы по дате и по происхождению, а также

library(dplyr)
library(tidyr)
M <- df %>% gather(key,value,topic) %>%
  group_by(date,origin,value) %>%
  summarize(n=n()) %>%
  mutate(f=n/sum(n))

Наконец, чтобы построить его:

library(ggplot2)

ggplot(data=M,aes(x=date,fill=factor(value),y=f)) + 
  geom_bar(stat="identity",position="stack") +
  facet_grid(~origin)

Вот что он дает с смоделированными данными

set.seed(100)
df <- data.frame(date=sample(seq.Date(as.Date("2015-07-27 10:12:25"),as.Date("2015-07-31 10:12:25"),by=1),100,replace=TRUE),
       id=1:100,
       topic=sample(1:5,100,replace=TRUE),
       origin=sample(c("A","B"),100,replace=TRUE))

введите здесь описание изображения

person scoa    schedule 26.07.2015
comment
Это здорово @scoa! Вот только одну вещь я не смог понять - когда я использую topics(lda), я получаю только одну тему для каждого выпуска A и B - как я могу составить эту тему? Кроме того, как я могу измерить долю каждого журнала, связанного с одной темой (вероятно, на линейном графике)? В основном я просто не знаю, как выделить одну тему. - person mlinegar; 28.07.2015
comment
@mlinegar, вы можете получить доступ к тем, у кого есть posterior(lda)$topics. cbind(df,posterior(lda)$topics) должно работать. Ваш второй вопрос слишком много для комментариев. Не могли бы вы отредактировать свой вопрос или задать новый с желаемым результатом? - person scoa; 28.07.2015
comment
вы определенно правы, что мне нужно вернуться ко второму вопросу, который я разместил, но я застрял, работая с фреймами данных по пути туда. Когда df определено так, как вы, я затем использую td <- posterior(lda)$topics и dfr <- cbind(df,td), что дает мне Warning message: In data.row.names(row.names, rowsi, i) : some row.names duplicated: 2,3, .... Если я все равно проигнорирую ошибку и график, я получу ту же проблему, что и раньше. Еще раз большое спасибо за вашу помощь! - person mlinegar; 29.07.2015