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

Question

我有大量文档，我想使用 text2vec 和 LDA (Gibbs Sampling) 进行主题建模。

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

1. 从文本中删除数字和符号

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

2. 删除停用词

   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)
   

3. 用术语替换同义词

我有一个 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)

4. 转换为文档术语矩阵

   dtm  <- create_dtm(it, vectorizer)
   

5. 在文档术语矩阵上应用 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 步的输出是词汇，但第 3 步的输入是“tm”语料库。

在这里，我的第一个问题是，如何使用 text2vec 包（和兼容包）完成所有步骤，因为我发现它非常有效；感谢德米特里·塞利瓦诺夫。

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

感谢 Manuel Bickel 在我的帖子中的更正。

谢谢， 山姆

Answer 1

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

第一个问题：这里已经回答了同义词替换的问题：Replace words in text2vec efficiently。特别检查count的答案。模式和替换可能是 ngrams（多词短语）。请注意，Dmitriy Selivanov 的第二个答案使用了word_tokenizer()，并没有涵盖呈现形式中的 ngram 替换情况。

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

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

出于学习的目的，请注意您的代码在两点产生了错误，我已对其进行了修改： (1) 您需要在create_vocabulary() 中使用正确的停用词名称，使用停用词而不是停用词，因为您已将名称定义为这样 (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