juliasilge
commented
2 years ago Unfortunately I cannot yet reproduce the problem you are experiencing. Can you create a reprex (a minimal reproducible example) for this? The goal of a reprex is to make it easier for us to recreate your problem so that we can understand it and/or fix it. If you've never heard of a reprex before, you may want to start with the tidyverse.org help page. Thanks! 🙌
Here is an example that shows this code working:
library(tidyverse)
library(tidytext)
library(janeaustenr)
library(stm)
#> stm v1.3.6 successfully loaded. See ?stm for help.
#> Papers, resources, and other materials at structuraltopicmodel.com
books <- austen_books() %>%
group_by(book) %>%
mutate(chapter = cumsum(str_detect(text, regex("^chapter ", ignore_case = TRUE)))) %>%
ungroup() %>%
filter(chapter > 0) %>%
unite(document, book, chapter, remove = FALSE)
austen_sparse <- books %>%
unnest_tokens(word, text) %>%
anti_join(stop_words) %>%
count(document, word) %>%
cast_sparse(document, word, n)
#> Joining, by = "word"
topic_model <- stm(
austen_sparse,
K = 4,
init.type = "Spectral",
verbose = FALSE
)
summary(topic_model)
#> A topic model with 4 topics, 269 documents and a 13908 word dictionary.
#> Topic 1 Top Words:
#> Highest Prob: elizabeth, darcy, miss, bennet, lady, jane, bingley
#> FREX: darcy, bennet, bingley, wickham, collins, lydia, lizzy
#> Lift: baronetage, condescended, presumptive, gowland, finances, landlady, creditors
#> Score: darcy, bennet, bingley, elizabeth, wickham, collins, jane
#> Topic 2 Top Words:
#> Highest Prob: emma, miss, harriet, weston, knightley, elton, jane
#> FREX: weston, knightley, elton, woodhouse, fairfax, churchill, hartfield
#> Lift: martin, goddard's, bangs, broadway, brunswick, cleverer, curtseys
#> Score: emma, weston, knightley, elton, woodhouse, fairfax, churchill
#> Topic 3 Top Words:
#> Highest Prob: catherine, anne, captain, miss, time, tilney, wentworth
#> FREX: tilney, thorpe, morland, allen, eleanor, henrietta, benwick
#> Lift: ship, plunge, curl, heroic, castle, edifice, france
#> Score: tilney, catherine, thorpe, morland, allen, wentworth, isabella
#> Topic 4 Top Words:
#> Highest Prob: fanny, elinor, miss, time, crawford, sir, marianne
#> FREX: elinor, crawford, marianne, edmund, thomas, bertram, dashwood
#> Lift: distract, nanny, heath, knoll, spunging, terrace, admirals
#> Score: elinor, marianne, fanny, crawford, edmund, thomas, dashwood
chapters <- books %>%
group_by(document) %>%
summarize(text = str_c(text, collapse = " ")) %>%
ungroup() %>%
inner_join(books %>%
distinct(document, book))
#> Joining, by = "document"
chapters
#> # A tibble: 269 × 3
#> document text book
#> <chr> <chr> <fct>
#> 1 Emma_1 "CHAPTER I Emma Woodhouse, handsome, clever, and rich, with… Emma
#> 2 Emma_10 "CHAPTER X Though now the middle of December, there had yet… Emma
#> 3 Emma_11 "CHAPTER XI Mr. Elton must now be left to himself. It was n… Emma
#> 4 Emma_12 "CHAPTER XII Mr. Knightley was to dine with them--rather ag… Emma
#> 5 Emma_13 "CHAPTER XIII There could hardly be a happier creature in t… Emma
#> 6 Emma_14 "CHAPTER XIV Some change of countenance was necessary for e… Emma
#> 7 Emma_15 "CHAPTER XV Mr. Woodhouse was soon ready for his tea; and w… Emma
#> 8 Emma_16 "CHAPTER XVI The hair was curled, and the maid sent away, a… Emma
#> 9 Emma_17 "CHAPTER XVII Mr. and Mrs. John Knightley were not detained… Emma
#> 10 Emma_18 "CHAPTER XVIII Mr. Frank Churchill did not come. When the t… Emma
#> # … with 259 more rows
effects <- estimateEffect(1:3 ~ book, topic_model, chapters)
summary(effects)
#>
#> Call:
#> estimateEffect(formula = 1:3 ~ book, stmobj = topic_model, metadata = chapters)
#>
#>
#> Topic 1:
#>
#> Coefficients:
#> Estimate Std. Error t value Pr(>|t|)
#> (Intercept) 0.031673 0.027522 1.151 0.251
#> bookPride & Prejudice 0.906982 0.035294 25.698 < 2e-16 ***
#> bookMansfield Park -0.018987 0.036336 -0.523 0.602
#> bookEmma -0.003074 0.036239 -0.085 0.932
#> bookNorthanger Abbey -0.001549 0.040821 -0.038 0.970
#> bookPersuasion 0.291445 0.063176 4.613 6.2e-06 ***
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#>
#> Topic 2:
#>
#> Coefficients:
#> Estimate Std. Error t value Pr(>|t|)
#> (Intercept) 1.858e-02 1.673e-02 1.111 0.268
#> bookPride & Prejudice 1.895e-03 2.440e-02 0.078 0.938
#> bookMansfield Park -4.086e-05 2.308e-02 -0.002 0.999
#> bookEmma 9.087e-01 3.211e-02 28.302 <2e-16 ***
#> bookNorthanger Abbey 1.953e-03 2.895e-02 0.067 0.946
#> bookPersuasion 2.479e-03 3.041e-02 0.081 0.935
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#>
#> Topic 3:
#>
#> Coefficients:
#> Estimate Std. Error t value Pr(>|t|)
#> (Intercept) 0.023527 0.026388 0.892 0.373
#> bookPride & Prejudice -0.001951 0.036241 -0.054 0.957
#> bookMansfield Park 0.033284 0.042596 0.781 0.435
#> bookEmma -0.003720 0.034816 -0.107 0.915
#> bookNorthanger Abbey 0.903470 0.045303 19.943 <2e-16 ***
#> bookPersuasion 0.612319 0.059020 10.375 <2e-16 ***
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
tidy(effects)
#> # A tibble: 18 × 6
#> topic term estimate std.error statistic p.value
#> <int> <chr> <dbl> <dbl> <dbl> <dbl>
#> 1 1 (Intercept) 0.0314 0.0275 1.14 2.54e- 1
#> 2 1 bookPride & Prejudice 0.908 0.0353 25.7 1.00e-73
#> 3 1 bookMansfield Park -0.0194 0.0368 -0.526 5.99e- 1
#> 4 1 bookEmma -0.00252 0.0365 -0.0690 9.45e- 1
#> 5 1 bookNorthanger Abbey -0.00134 0.0403 -0.0331 9.74e- 1
#> 6 1 bookPersuasion 0.292 0.0628 4.65 5.27e- 6
#> 7 2 (Intercept) 0.0186 0.0165 1.13 2.60e- 1
#> 8 2 bookPride & Prejudice 0.00214 0.0241 0.0889 9.29e- 1
#> 9 2 bookMansfield Park 0.000182 0.0228 0.00796 9.94e- 1
#> 10 2 bookEmma 0.909 0.0317 28.7 5.66e-83
#> 11 2 bookNorthanger Abbey 0.00217 0.0286 0.0757 9.40e- 1
#> 12 2 bookPersuasion 0.00269 0.0304 0.0885 9.30e- 1
#> 13 3 (Intercept) 0.0236 0.0262 0.898 3.70e- 1
#> 14 3 bookPride & Prejudice -0.00201 0.0360 -0.0558 9.56e- 1
#> 15 3 bookMansfield Park 0.0325 0.0424 0.767 4.44e- 1
#> 16 3 bookEmma -0.00331 0.0349 -0.0948 9.25e- 1
#> 17 3 bookNorthanger Abbey 0.903 0.0450 20.1 5.71e-55
#> 18 3 bookPersuasion 0.612 0.0591 10.3 2.92e-21Created on 2022-07-21 by the reprex package (v2.0.1)
kangutsa
github-actions[bot]
Hello Julia, I am learning a lot from your book and videos. Thank you. I am conducting a text mining analysis with topic modeling. While following your instructions, I have come up with the following error message. Could you advise on this? Thank you again.
Error in qr.lm(thetasims[, k], qx) : number of covariate observations does not match number of docs
The entire script is below.
library(tidyverse) news <-read_csv('/Users/Seok1/Desktop/mining/ukraine1.csv') news %>% distinct(TITLE) news %>% distinct(TITLE, DESCRIPTION)
library(tidytext)
tidy_news <- news %>% unnest_tokens(word, DESCRIPTION) %>% anti_join(get_stopwords())
tidy_news %>% count(word, sort = TRUE) tidy_news %>% count(TITLE, word, sort = TRUE)
train topic model
news_sparse <- tidy_news %>% count(TITLE, word) %>% cast_sparse(TITLE, word, n)
library(stm)
topic_model <- stm(news_sparse, K = 4)
summary(topic_model)
Explore topic model results
word_topics <- tidy(topic_model, matrix = "beta") word_topics
word_topics %>% group_by(topic) %>% slice_max(beta, n = 10) %>% ungroup() %>% mutate(topic = paste("Topic", topic)) %>% ggplot(aes(beta, reorder_within(term, beta, topic), fill = topic)) + geom_col(show.legend = FALSE) + facet_wrap(vars(topic), scales = "free_y") + scale_y_reordered() + labs(x = expression(beta), y = NULL)
title_topics <- tidy(topic_model, matrix = "gamma", document_names = rownames(news_sparse))
title_topics
title_topics %>% mutate(document = fct_reorder(document, gamma), topic = factor(topic)) %>% ggplot(aes(gamma, topic, fill = topic)) + geom_col(show.legend = FALSE) + facet_wrap(vars(document), ncol = 4) + labs(x = expression(gamma), y = "Topic")
effects <- estimateEffect( 1:4 ~ CATEGORY, topic_model, tidy_news %>% distinct (TITLE, CATEGORY) %>% arrange(TITLE) )
summary(effects) Error in qr.lm(thetasims[, k], qx) : number of covariate observations does not match number of docs