使用 text2vec 包进行文本预处理和主题建模

Question

我有大量文档，我想使用 text2vec 和 LDA（吉布斯采样）进行主题建模。

我需要的步骤如下（按顺序）：

从文本中删除数字和符号

library(stringr)
docs$text <- stringr::str_replace_all(docs$text,"[^[:alpha:]]", " ")
docs$text <- stringr::str_replace_all(docs$text,"\s+", " ")

删除停用词

library(text2vec)        
library(tm)

stopwords <- c(tm::stopwords("english"),custom_stopwords)

prep_fun <- tolower
tok_fun <- word_tokenizer
tok_fun <- word_tokenizer    
tokens <- docs$text%>% 
         prep_fun %>% 
         tok_fun
it <- itoken(tokens, 
            ids = docs$id,
            progressbar = FALSE)

v <- create_vocabulary(it, stopwords = stopwords) %>% 
    prune_vocabulary(term_count_min = 10)

vectorizer <- vocab_vectorizer(v)

用术语替换同义词

我有一个 excel 文件，其中第一列是主要单词，同义词列在第二、第三和...列中。我想用主要词替换所有同义词（第 1 列）。每个术语可以有不同数量的同义词。这是使用 "tm" 包的代码示例（但我对 text2vec 包中的代码感兴趣）：

replaceSynonyms <- content_transformer(function(x, syn=NULL)
       {Reduce(function(a,b) {
       gsub(paste0("\b(", paste(b$syns, collapse="|"),")\b"), b$word,     a, perl = TRUE)}, syn, x)  })

 l <- lapply(as.data.frame(t(Synonyms), stringsAsFactors = FALSE), #
          function(x) { 
            x <- unname(x) 
            list(word = x[1], syns = x[-1])
          })
names(l) <- paste0("list", Synonyms[, 1])
list2env(l, envir = .GlobalEnv)

synonyms <- list()        
for (i in 1:length(names(l))) synonyms[i] = l[i]

MyCorpus <- tm_map(MyCorpus, replaceSynonyms, synonyms)

转换为文档术语矩阵
```
dtm  <- create_dtm(it, vectorizer)
```

在文档术语矩阵上应用 LDA 模型

doc_topic_prior <- 0.1  # can be chosen based on data? 
lda_model <- LDA$new(n_topics = 10, 
          doc_topic_prior = doc_topic_prior, topic_word_prior = 0.01)
doc_topic_distr <- lda_model$fit_transform(dtm, n_iter = 1000, convergence_tol <- 0.01, check_convergence_every_n = 10)

步骤3中的MyCorpurs是使用"tm"包得到的语料库。第 2 步和第 3 步不能一起工作，因为第 2 步的输出是 vocab，但第 3 步的输入是 "tm" 语料库。

我的第一个问题是如何使用 text2vec 包（和兼容包）完成所有步骤，因为我发现它非常有效；感谢 Dmitriy Selivanov。

其次：我们如何在步骤5中为LDA中的参数设置最优值？是否可以根据数据自动设置？

感谢 Manuel Bickel 对我的 post 进行更正。

谢谢，山姆

Answer 1

针对您的评论更新的答案：

第一个问题：这里已经回答了同义词替换的问题：. Check the answer of count in partiular. Patterns and replacements may be ngrams (multi word phrases). Please note that the second answer of Dmitriy Selivanov使用word_tokenizer()，不涵盖ngram替换的情况呈现的表格。

有什么理由需要在删除停用词之前替换同义词吗？通常这个顺序应该不会引起问题；或者您有一个示例，其中切换顺序会产生显着不同的结果吗？如果您真的想在删除停用词后替换同义词，我猜，您必须在使用 text2vec 时将此类更改应用于 dtm。如果这样做，您需要在您的 dtm 中允许 ngram 具有同义词中包含的最小 ngram 长度。我在下面的代码中提供了一个解决方法作为一个选项。请注意，在您的 dtm 中允许更高的 ngram 会产生可能会或可能不会影响您的下游任务的噪音（您可能可以在词汇步骤中修剪大部分噪音）。因此，早点替换ngrams似乎是一个更好的解决方案。

第二个问题：您可以查看 textmineR 包的包（和源代码），它可以帮助您 select主题或此问题的答案 Topic models: cross validation with loglikelihood or perplexity。关于先验的处理我还没有弄清楚，不同的包，例如 text2vec（WarpLDA 算法），lda（Collaped Gibbs Sampling 算法等），或 topicmodels（'standard' 吉布斯采样和变分期望最大化算法）详细处理这些值。作为起点，您可以查看 topicmodels 的详细文档，“2.2. 估计”一章告诉您如何估计“2.1 模型规范”中定义的 alpha 和 beta 参数。

为了学习，请注意您的代码有两处错误，我已修改： (1) 您需要在 create_vocabulary() 中使用正确的停用词名称，而不是 stop_words 中的停用词，因为您是这样定义名称的 (2) 你的 lda 模型定义中不需要 vocabulary =... - 也许你使用了旧版本的 text2vec?

library(text2vec) 
library(reshape2)
library(stringi)

#function proposed by @count
mgsub <- function(pattern,replacement,x) {
  if (length(pattern) != length(replacement)){
    stop("Pattern not equal to Replacment")
  } 
  for (v in 1:length(pattern)) {
    x  <- gsub(pattern[v],replacement[v],x, perl = TRUE)
  }
  return(x )
}

docs <- c("the coffee is warm",
          "the coffee is cold",
          "the coffee is hot",
          "the coffee is boiling like lava",
          "the coffee is frozen",
          "the coffee is perfect",
          "the coffee is warm almost hot"
)

synonyms <- data.frame(mainword = c("warm", "cold")
                       ,syn1 = c("hot", "frozen")
                       ,syn2 = c("boiling like lava", "")
                       ,stringsAsFactors = FALSE)

synonyms[synonyms == ""] <- NA

synonyms <- reshape2::melt(synonyms
                           ,id.vars = "mainword"
                           ,value.name = "synonym"
                           ,na.rm = TRUE)

synonyms <- synonyms[, c("mainword", "synonym")]


prep_fun <- tolower
tok_fun <- word_tokenizer
tokens <- docs %>% 
  #here is where you might replace synonyms directly in the docs
  #{ mgsub(synonyms[,"synonym"], synonyms[,"mainword"], . ) } %>%
  prep_fun %>% 
  tok_fun
it <- itoken(tokens, 
             progressbar = FALSE)

v <- create_vocabulary(it,
                       sep_ngram = "_",
                       ngram = c(ngram_min = 1L
                                 #allow for ngrams in dtm
                                 ,ngram_max = max(stri_count_fixed(unlist(synonyms), " "))
                                 )
)

vectorizer <- vocab_vectorizer(v)
dtm <- create_dtm(it, vectorizer)

#ngrams in dtm
colnames(dtm)

#ensure that ngrams in synonym replacement table have the same format as ngrams in dtm
synonyms <- apply(synonyms, 2, function(x) gsub(" ", "_", x))

colnames(dtm) <- mgsub(synonyms[,"synonym"], synonyms[,"mainword"], colnames(dtm))


#only zeros/ones in dtm since none of the docs specified in my example
#contains duplicate terms
dim(dtm)
#7 24
max(dtm)
#1

#workaround to aggregate colnames in dtm
#I think there is no function `colsum` that allows grouping
#therefore, a workaround based on rowsum
#not elegant because you have to transpose two times, 
#convert to matrix and reconvert to sparse matrix
dtm <- 
  Matrix::Matrix(
    t(
      rowsum(t(as.matrix(dtm)), group = colnames(dtm))
    )
    , sparse = T)


#synonyms in columns replaced
dim(dtm)
#7 20
max(dtm)
#2

使用 text2vec 包进行文本预处理和主题建模

Text preprocessing and topic modelling using text2vec package

r

tm

topic-modeling

synonym

text2vec