I am using the wordvector package extensively in my projects because document vectors are often a better way to represent texts. One type of analysis I use is topic classification of documents based on K-means clustering. This worked reasonably well with document vectors, but it can take time if implemented using R’s basic function, `kmeans`.
An alternative approach is to cluster if documents using DBSCAN combined with UMAP. BERTopic takes this approach but I did not want to further reduce the dimensionality of document vectors using UMAP. Without it, DBSCAN’s density-based algorithm does not work particularly well because document vectors are very dense.
Another approach is to use of Gaussian mixture models, which identify a given number of normal distributions in the data. I thought this could work well because document vectors should have similar distributions when they comprise similar words. I tested a Gaussian mixture model using the flexmix package and found that the results were very good, but the package struggled even with a small corpus… I thought I might have to implement a simple model myself to speed up the computation but fortunately the Armadillo library already had multi-threaded C++ implementation of Gaussian mixture models and k-means. In this case, I only needed to write an R wrapper around it and create a package!
Actually, Gaussian mixture models and k-means from the Armadillo package are already available in the ClusterR package, but I decided to create my own package because ClusterR does not allow me to set the initial cluster centers. This is necessary for dynamic analysis, where the parameters of the current model are passed to the next next model to initialize clustering. This type of dynamic analysis allows us to capture the evolution of topics over time.
My new R package is called GMTM (Gaussian Mixture Topic Models). The package’s design is similar to seededlda, another topic analysis package I developed. GMTM takes document vectors from various sources but works seamlessly with the wordvector package. In the example below, I fit GMTM and seededlda on a corpus of 65,000 short news texts and compare the speed and the quality of the topics. On my desktop computer (an Intel i7 processor with 20 cores), GMTM’s execution time is less than 3 seconds, even including the training of document vectors, whereas seededlda took more than 11 seconds. GMTM is about four times faster! GMTM’s topic words are also as intuitive as those identified by seededlda. I especially like that “1-0” and “2-0” appear in the same topic as “rugby” (topic 7) because this shows that we can handle numeric expressions more effectively using document embedding.
> library(quanteda)
> library(wordvector)
> library(seededlda)
> library(GMTM)
>
> # preprocessing
> corp <- corpus_reshape(data_corpus_news2014) # from wordvector package
> ndoc(corp)
[1] 65863
> toks <- tokens(corp, remove_punct = TRUE, remove_symbols = TRUE, remove_number = TRUE) |>
+ tokens_remove(stopwords("en"), min_nchar = 2) |>
+ tokens_tolower() |>
+ tokens_trim(min_termfreq = 5)
> dfmt <- dfm(toks)
>
> # GMM
> system.time({
+ wov <- textmodel_word2vec(toks, dim = 100)
+ dov <- as.textmodel_doc2vec(dfmt, wov)
+ gmm <- textmodel_gmm(dov, k = 10)
+ })
user system elapsed
25.59 0.55 2.70
> GMTM::terms(gmm, dfmt)
topic1 topic2 topic3 topic4 topic5 topic6
[1,] "percent" "pistorius" "killed" "ap" "said" "editing"
[2,] "growth" "ap" "militants" "krasnaya" "co" "writing"
[3,] "futures" "court" "said" "polyana" "agency" "stonestreet"
[4,] "earnings" "sentenced" "sunni" "sochi" "inc" "tait"
[5,] "quarterly" "trial" "islamic" "olympic" "sources" "chizu"
[6,] "cents" "said" "gunmen" "rio" "snowden" "nomiyama"
[7,] "index" "guilty" "iraq" "coach" "corp" "maler"
[8,] "stocks" "police" "syria" "cannes" "ltd" "hepinstall"
[9,] "data" "lawyer" "troops" "world" "intelligence" "pomeroy"
[10,] "stock" "killing" "attack" "janeiro" "company's" "bangalore"
topic7 topic8 topic9 topic10
[1,] "rugby" "president" "said" "lavrov"
[2,] "championship" "minister" "ap" "ukraine"
[3,] "champions" "polls" "people" "said"
[4,] "beats" "parliament" "ferry" "kerry"
[5,] "1-0" "prime" "ebola" "peace"
[6,] "england" "party" "leone" "sanctions"
[7,] "coach" "government" "killed" "russia"
[8,] "ap" "elections" "south" "obama"
[9,] "scored" "election" "dead" "crimea"
[10,] "2-0" "said" "sierra" "nato"
> table(GMTM::topics(gmm))
topic1 topic2 topic3 topic4 topic5 topic6 topic7 topic8 topic9 topic10
5284 5842 8374 7596 6927 898 5999 6138 7872 10933
>
> system.time({
+ lda <- textmodel_lda(dfmt, k = 10, batch_size = 0.01, auto_iter = TRUE)
+ })
user system elapsed
258.21 0.39 11.64
>
> # LDA
> seededlda::terms(lda)
topic1 topic2 topic3 topic4 topic5 topic6 topic7
[1,] "south" "percent" "said" "said" "court" "ukraine" "new"
[2,] "united" "said" "state" "police" "former" "russia" "ap"
[3,] "said" "reuters" "killed" "ap" "ap" "u.s" "reporting"
[4,] "israel" "million" "islamic" "people" "president" "said" "editing"
[5,] "gaza" "billion" "iraq" "city" "government" "president" "one"
[6,] "nations" "u.s" "group" "two" "years" "russian" "years"
[7,] "israeli" "year" "militants" "say" "trial" "washington" "york"
[8,] "peace" "bank" "forces" "authorities" "case" "obama" "u.s"
[9,] "talks" "company" "syria" "killed" "hong" "states" "australian"
[10,] "korea" "oil" "security" "dead" "leader" "moscow" "search"
topic8 topic9 topic10
[1,] "said" "new" "ap"
[2,] "minister" "first" "world"
[3,] "prime" "ap" "cup"
[4,] "government" "election" "league"
[5,] "told" "open" "team"
[6,] "iran" "australia" "brazil"
[7,] "foreign" "vote" "win"
[8,] "nuclear" "party" "sochi"
[9,] "president" "test" "first"
[10,] "state" "second" "saturday"
> table(seededlda::topics(lda))
topic1 topic2 topic3 topic4 topic5 topic6 topic7 topic8 topic9 topic10
5671 8516 7406 6962 6798 6338 5653 6425 5572 6363 Next steps for me in this project are testing the accuracy of the result more thoroughly, examining their sensitivity to hyper-parameters, and supporting seed words for semi-supervised topic classification. The GMTM package is already available on Gitub, so please give it a try and let me know how it works with your data.
