This R Markdown Notebook provides syntax (but not data) for fitting the STM fit_graf provided in replication material for “Facts Shape Feelings”.

Because LDA models lead to multi-modal posteriors, particular model fits are not guaranteed to be reproducible. The fit below uses (the package default) spectral initialization, which should provide pretty good guarantees that STM will “give exactly the same answer for a given machine,” but you can’t set a seed with spectral initialization, and differences across machines could still exist, according to Brandon Stewart.

library(stm)

### Fit an STM on Paragraph Data ###
# Create DTMs
paras <- textProcessor(grafs$text, metadata = cbind.data.frame(resp = grafs$resp, seg = grafs$seg), 
                       customstopwords = c("know", "like", "just", "dont", "didnt",
                                           "get", "that", "thing", "want", "said", "say",
                                           "think", "got", "people", "told", "tell"))

# Preserve kept documents
texts <- grafs$text[-paras$docs.removed] 

# Fit the model
fit_graf <- stm(documents = paras$documents,
           vocab = paras$vocab,
           K = 10,
           data = paras$meta,
           prevalence = ~ resp) # respondent ID, because transcripts are broken into paragraph-length documents


labelTopics(fit_graf)

# Get just the anger scores expanded 
ds <- cbind.data.frame(resp = dat$ID,
                      P1.Angry = dat$P1.Angry,
                      P1.Anger.Index = dat$P1.Anger.Index,
                      P1.Afraid = dat$P1.Afraid,
                      P1.Fear.Index = dat$P1.Fear.Index)

covars <- left_join(paras$meta, ds)
covars[is.na(covars)] <- 0
LS0tCnRpdGxlOiAiU1RNIFJlcGxpY2F0aW9uIENvZGUiCnN1YnRpdGxlOiAiRm9yOiBGYWN0cyBTaGFwZSBGZWVsaW5ncyIKYXV0aG9yOiAiQWlkYW4gTWlsbGlmZiIKZGF0ZTogIjEgQXVndXN0IDIwMjIiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KClRoaXMgW1IgTWFya2Rvd25dKGh0dHA6Ly9ybWFya2Rvd24ucnN0dWRpby5jb20pIE5vdGVib29rIHByb3ZpZGVzIHN5bnRheCAoYnV0IG5vdCBkYXRhKSBmb3IgZml0dGluZyB0aGUgU1RNIGBmaXRfZ3JhZmAgcHJvdmlkZWQgaW4gW3JlcGxpY2F0aW9uIG1hdGVyaWFsXShodHRwczovL2RhdGF2ZXJzZS5oYXJ2YXJkLmVkdS9kYXRhc2V0LnhodG1sP3BlcnNpc3RlbnRJZD1kb2k6MTAuNzkxMC9EVk4vVEQ2WUhSKSBmb3IgIkZhY3RzIFNoYXBlIEZlZWxpbmdzIi4gCgpCZWNhdXNlIExEQSBtb2RlbHMgbGVhZCB0byBtdWx0aS1tb2RhbCBwb3N0ZXJpb3JzLCBwYXJ0aWN1bGFyIG1vZGVsIGZpdHMgYXJlIG5vdCAqZ3VhcmFudGVlZCogdG8gYmUgcmVwcm9kdWNpYmxlLiBUaGUgZml0IGJlbG93IHVzZXMgKHRoZSBwYWNrYWdlIGRlZmF1bHQpIHNwZWN0cmFsIGluaXRpYWxpemF0aW9uLCB3aGljaCBzaG91bGQgcHJvdmlkZSBwcmV0dHkgZ29vZCBndWFyYW50ZWVzIHRoYXQgU1RNIHdpbGwgImdpdmUgZXhhY3RseSB0aGUgc2FtZSBhbnN3ZXIgZm9yIGEgZ2l2ZW4gbWFjaGluZSwiIGJ1dCB5b3UgY2FuJ3Qgc2V0IGEgc2VlZCB3aXRoIHNwZWN0cmFsIGluaXRpYWxpemF0aW9uLCBhbmQgZGlmZmVyZW5jZXMgYWNyb3NzIG1hY2hpbmVzIGNvdWxkIHN0aWxsIGV4aXN0LCBbYWNjb3JkaW5nIHRvIEJyYW5kb24gU3Rld2FydF0oaHR0cHM6Ly9naXRodWIuY29tL2JzdGV3YXJ0L3N0bS9pc3N1ZXMvMTMzKS4gCgpgYGB7ciwgZXZhbD1GQUxTRX0KbGlicmFyeShzdG0pCgojIyMgRml0IGFuIFNUTSBvbiBQYXJhZ3JhcGggRGF0YSAjIyMKIyBDcmVhdGUgRFRNcwpwYXJhcyA8LSB0ZXh0UHJvY2Vzc29yKGdyYWZzJHRleHQsIG1ldGFkYXRhID0gY2JpbmQuZGF0YS5mcmFtZShyZXNwID0gZ3JhZnMkcmVzcCwgc2VnID0gZ3JhZnMkc2VnKSwgCiAgICAgICAgICAgICAgICAgICAgICAgY3VzdG9tc3RvcHdvcmRzID0gYygia25vdyIsICJsaWtlIiwgImp1c3QiLCAiZG9udCIsICJkaWRudCIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiZ2V0IiwgInRoYXQiLCAidGhpbmciLCAid2FudCIsICJzYWlkIiwgInNheSIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAidGhpbmsiLCAiZ290IiwgInBlb3BsZSIsICJ0b2xkIiwgInRlbGwiKSkKCiMgUHJlc2VydmUga2VwdCBkb2N1bWVudHMKdGV4dHMgPC0gZ3JhZnMkdGV4dFstcGFyYXMkZG9jcy5yZW1vdmVkXSAKCiMgRml0IHRoZSBtb2RlbApmaXRfZ3JhZiA8LSBzdG0oZG9jdW1lbnRzID0gcGFyYXMkZG9jdW1lbnRzLAogICAgICAgICAgIHZvY2FiID0gcGFyYXMkdm9jYWIsCiAgICAgICAgICAgSyA9IDEwLAogICAgICAgICAgIGRhdGEgPSBwYXJhcyRtZXRhLAogICAgICAgICAgIHByZXZhbGVuY2UgPSB+IHJlc3ApICMgcmVzcG9uZGVudCBJRCwgYmVjYXVzZSB0cmFuc2NyaXB0cyBhcmUgYnJva2VuIGludG8gcGFyYWdyYXBoLWxlbmd0aCBkb2N1bWVudHMKCgpsYWJlbFRvcGljcyhmaXRfZ3JhZikKCiMgR2V0IGp1c3QgdGhlIGFuZ2VyIHNjb3JlcyBleHBhbmRlZCAKZHMgPC0gY2JpbmQuZGF0YS5mcmFtZShyZXNwID0gZGF0JElELAogICAgICAgICAgICAgICAgICAgICAgUDEuQW5ncnkgPSBkYXQkUDEuQW5ncnksCiAgICAgICAgICAgICAgICAgICAgICBQMS5Bbmdlci5JbmRleCA9IGRhdCRQMS5Bbmdlci5JbmRleCwKICAgICAgICAgICAgICAgICAgICAgIFAxLkFmcmFpZCA9IGRhdCRQMS5BZnJhaWQsCiAgICAgICAgICAgICAgICAgICAgICBQMS5GZWFyLkluZGV4ID0gZGF0JFAxLkZlYXIuSW5kZXgpCgpjb3ZhcnMgPC0gbGVmdF9qb2luKHBhcmFzJG1ldGEsIGRzKQpjb3ZhcnNbaXMubmEoY292YXJzKV0gPC0gMAoKYGBgCgoK