Preliminaries —–

Daten —–

Ich hatte zuerst versucht STM (und Keyness etc.) auf meinen vollen Datensatz (ski1) anzuwenden, die Resultate waren aber nicht interessant weil:

\(\bullet\) die starke Präsenz an Eigennnamen
\(\bullet\) die ungenaue Zuordnung der Artikel nach Geschlecht
\(\bullet\) die enrome Menge an Daten

Aus diesem Grund habe ich mich entschieden den dd_kwic Datensatz zu gebrauchen aus dem ich schon die (mit POS erkannten) Eigennamen entfernt habe.

dd_kwic_stm <- read.csv("Inputs/kwic_filtered.csv")

Preprocesing —–

Ingest —–

ACHTUNG hat grossen Einfluss auf die Analyse

Wörter die nicht in der Analyse einbezogen werden sollen:

\(\bullet\) theoretisch sollten diese schon im “Eigennamen” enthalten sein, aber da ich sie eh schon für die vorherige Versuche ausgeschrieben habe, integriere ich diese trotzddem.

names_m <- c("didier", "cuche", "urs", "imboden", "didier", "défago", "didier", "defago", "daniel", "albrecht", "konrad", "hari", "bruno", "kernen", "tobias", "grünenfelder", "tobias", "gruenenfelder", "marc", "berthod", "marc", "gini", "stéphane", "de", "siebenthal", "stephane", "de", "siebenthal", "dimitri", "cuche", "silvan", "zurbriggen", "patrick", "küng", "patrick", "kueng", "justin", "murisier", "ami", "oreiller", "markus", "vogel", "christian", "spescha", "mauro", "caviezel", "reto", "schmidiger", "beat", "feuz", "vitus", "lüönd", "vitus", "lueoend", "thomas", "tumler", "luca", "aerni", "luca", "ärni", "sandro", "viletta", "urs", "kryenbühl", "urs", "kryenbuehl", "bernhard", "niederberger", "fernando", "schmed", "loïc", "meillard", "loic", "meillard", "gino", "caviezel", "marco", "odermatt", "ramon", "zenhäusern", "ramon", "zenhaeusern", "sandro", "simonet", "gilles", "roulin", "cédric", "noger", "cedric", "noger", "josua", "mettler", "marco", "reymond", "noel", "von", "grünigen", "noel", "von", "gruenigen", "reto", "mächler", "reto", "maechler", "ralph", "weber", "lars", "rösti", "lars", "roesti", "denis", "corthay", "lenz", "hächler", "lenz", "haechler")

names_f <- c("tamara", "müller", "tamara", "mueller", "sonja", "nef", "marlies", "oester", "marlies", "öster", "nadia", "styger", "tanja", "pieren", "fabienne", "suter", "erika", "dicht", "fränzi", "aufdenblatten", "fraenzi", "aufdenblatten", "franziska", "christine", "aufdenblatten", "franziska", "aufdenblatten", "lilian", "kummer", "eliane", "volken", "miriam", "gmür", "miriam", "gmuer", "marianne", "abderhalden", "tina", "weirather", "christina", "weirather", "aita", "camastral", "andrea", "dettling", "sylviane", "berthod", "lara", "gut", "lara", "gut-behrami", "behrami", "pascale", "berthod", "aline", "bonjour", "martina", "schild", "rabea", "grand", "jessica", "pünchera", "jessica", "puenchera", "nadja", "jnglin-kamer", "nadja", "kamer", "marina", "nigg", "jasmine", "flury", "esther", "good", "margaux", "givel", "wendy", "holdener", "corinne", "suter", "dominique", "gisin", "dominique", "sabine", "gisin", "jasmina", "suter", "denise", "feierabend", "fabienne", "suter", "aline", "danioth", "rahel", "kopp", "mélanie", "meillard", "melanie", "meillard", "priska", "nufer", "nathalie", "gröbli", "nathalie", "groebli", "vivianne", "härri", "vivianne", "haerri", "camille", "rast", "luana", "flütsch", "luana", "fluetsch", "amélie", "klopfenstein", "amelie", "klopfenstein", "delia", "durrer", "noémie", "kolly", "noemie", "kolly", "delphine", "darbellay", "anuk", "brändli", "anuk", "braendli")

names <- c(names_f, names_m)

#weitere Stopwörter entfernen
weiterewörter <- c("sagt", "mehr", "dass",
                          "immer", "november",
                          "uhr", "luzern",
                          "usa", "jährige",
                          "federer", "ferner",
                          "schweizer", "schweiz",
                          "junioren", "engelberg", 
                          "swiss", "gibt", 
                          "luzern", "krien", "surse",
                          "emmenbrück", "willisau",
                          "österreich", "schweden",
                          "lüönd", "www", "tel",
                          "usa", "schon", "ganz", "mehr",
                          "schwyz", "sotchi",
                          "gibt","fussball",
                          "div", "class", "span", "href",
                          "ebikon", "ääätsch", "äär",
                          "aaretal", "aaa", "dzf",
                          "akw", "gesichtserkennung",
                          "blocher", "aabach", "aaa",
                          "aarefeldplatz", "aargauerstalden",
                          "kernen","nie","adelboden", "viel",
                          "schiffrin", "hirscher", "nie",
                          "simon", "sei", "kitzbühel", "wengen",
                   "lauberhorn", "beim", "weiss",
                   "zeit", "einfach", "miller", "maier",
                   "michael", "miller", "bild",
                   "wurde", "seit", "bern", "mai",
                   "ersten", "woche", "einfach",
                   "sursee", "schneider", "janka",
                   "jahr", "st-gallen", "gallen",
                   "vonn", "hotel", "jahren", "roger",
                   "zwei", "geht", "wäre",
                   "china", "prozent", "srf",
                   "krienz", "männer", "frauen",
                   "kriens", "krienseregg", "sui",
                   "ita", "italien", "aut", "nor", "fra",
                   "frankreich", "cologna", "giro",
                   "gemeinde", "toggenburg", "jahr", "jahren",
                   "jährlich", "oktober", "vonn", "lake", "louis",
                   "bern", "februar", "berner", "februar",
                   "dezember", "sonntag", "samstag", "srf",
                   "maze", "maria", "riesch", "zürich", 
                   "lindsey", "grindelwald", "gallen",
                   "st-gallen", "pirmin", "girardelli", 
                   "wäre", "viel", "geht", "sagt", "sagte",
                   "vielleicht", "yule", "kristofferson",
                   "henrik", "sagten", "gestern", "hätte",
                   "hoffmann", "ambrosi", "herman", "walchof",
                   "lässt", "jedoch", "dürfte", "brunner",
                   "sepp", "lässt", "marcel", "lehmann",
                   "janka", "carlo", "svindal", "hergiswil",
                   "emmenbrück", "shiffrin", "mikaela", "michelle",
                   "ammann", "deutschland", "wattwil",
                   "thun", "wicki", "stucki", "joel",
                   "schwinger", "keystone", "basel",
                   "reuter", "ag", "österreicher",
                   "streif", "gröden", "aksel", "raich",
                   "badia", "alta", "mayer", "bromio",
                   "pinturault", "beaver", "jansrud", 
                   "creek", "norweger", "walchhofer",
                   "kristoffersen", "emmentaler",
                   "kilde", "bündner", "pd",
                   "chuenisbärgli", "bm", "kjetil",
                   "bode", "miller", "kriechmayr",
                   "walliser", "reichelt",
                   "wil", "emmenbrücke",
                   "neuenburger", "perren",
                   "nidwaldner", "kantonspolizei",
                   "kvitfjell", "bormio",
                   "chamonix", "auto", "franz",
                   "vierter", "fünfter", "lund",
                   "lauberhornrennen", "lauberhornabfahrt",
                   "alexis", "gardena","lauberhorn-abfahrt",
                   "ligety", "gmbh",
                   "hundschopf", "kapo", "eberharter",
                   "w", "matthias", "st.gallen", "dz",
                   "hintermann", "dominik", "kröll", "aleksander",
                   "ivica", "hannes", "neurenther", "büchel",
                   "tessinerin", "schweizerinnen", "schweizerin",
                   "schwyzerin", "amerikanerin", "goggia", "vlhova",
                   "österreichererin", "brignone", "may", "fenninger",
                   "cortina", "rebensburg", "st", "sofia", "italienerin")  

additional_stopwords <- c(names, weiterewörter)

default_stopwords <- quanteda::stopwords("de")

stopwords <- c(default_stopwords, additional_stopwords)
#saveRDS(stopwords, "Inputs/stopwords.rds")

Corpus bilden

#corpus
kwic_corpus_stm <- textProcessor(dd_kwic_stm$text, metadata = as.data.frame(dd_kwic_stm),
                            lowercase = T, removestopwords = T, removenumbers = T,
                            removepunctuation = T, stem = T, language = 'de', verbose = T,
                            onlycharacter = T, striphtml = T, 
                            customstopwords = stopwords)

Prepare —-

kwic_corpus_stm <- prepDocuments(documents = kwic_corpus_stm$documents,
                            vocab = kwic_corpus_stm$vocab, 
                            meta = kwic_corpus_stm$meta,
                            verbose = T)

#speichern
saveRDS(kwic_corpus_stm, "kwic_corpus_stm.rds")

Plot removed:

plotRemoved(documents = kwic_corpus_stm$document, lower.thresh = seq(1, 200, by = 20))

Evaluate —-

Search K —-

Dauert extrem lange. Ich erwarte nicht, dass die Resultate extrem von denen der vorherigen Analyse abweichen.

#berechnen
# ski1_corpus_stm_search <- searchK(ski1_corpus_stm$documents,ski1_corpus_stm$vocab,
#                            K = seq(5, 55, by = 10), max.em.its = 100)

##Für 55 Topics: Model terminated before convergence reached

#speichern
# saveRDS(ski1_corpus_stm_search, "ski1_corpus_stm_search.rds")
#einlesen
ski1_corpus_stm_search <- readRDS("ski1_corpus_stm_search.rds")

#plotten
plot(ski1_corpus_stm_search)

\(\bullet\) Held-out likelihood: Je höher desto besser. Am höchsten bei 55 aber ab 25 sieht ok aus.
\(\bullet\) Residuals: Je tiefer desto besser. Am tiefsten bei 55.
\(\bullet\) Semantic Coherence: Je höher desto besser. 15, 25 ?
\(\bullet\) Lower Bound: Je höher desto besser: Am besten 55.

Exclusivity —-

plot(unlist(ski1_corpus_stm_search$results$K), unlist(ski1_corpus_stm_search$results$exclus),
     xlab = "K", ylab = "Exclusivity", type = "b")

\(\bullet\) Je höher desto besser weil trennschärfer aber semantisch nicht unbedingt am besten: 55. Aber ab 15 sieht schon gut aus.

selectModel —-

\(\bullet\) mit K = 15 und K = 35 berechnet (mehr braucht wirklich zu lange)

#berechnen
# ski1_stm_select <- selectModel(ski1_corpus_stm$documents, 
#                                ski1_corpus_stm$vocab, 
#                                K = 15, runs = 20)
#speichern
# saveRDS(ski1_stm_select, "ski1_stm_select.rds")

#einlesen
ski1_stm_select <- readRDS("ski1_stm_select.rds")

#plot
plotModels(ski1_stm_select,
legend.position = "bottomleft")
selected4 <- ski1_stm_select$runout[[4]]


#alternative berechnen
# ski1_stm_select35 <- selectModel(ski1_corpus_stm$documents, 
#                                ski1_corpus_stm$vocab, 
#                                K = 35, runs = 20)
#speichern
#saveRDS(ski1_stm_select35, "ski1_stm_select35.rds")

#einlesen
ski1_stm_select35 <- readRDS("ski1_stm_select35.rds")

#plot
plotModels(ski1_stm_select35,
legend.position = "bottomleft")

selected1 <- ski1_stm_select$runout[[1]] #hier 1 besser was nun?
#ski1_stm_select35 <- selectModel(ski1_corpus_stm$documents, 
                                #ski1_corpus_stm$vocab, 
                                #K = 55, runs = 20)

Estimate and Understand —-

STM no covariates —-

#simple_stm <- stm(kwic_corpus_stm$documents, kwic_corpus_stm$vocab, K = 15)

STM with 1 prevalence covariate: Geschlecht —–

15 Topics
#geschlecht as factor
kwic_corpus_stm$meta$sex <- as.factor(kwic_corpus_stm$meta$sex)

#15 Topics
kwic_stm_15 <- stm(kwic_corpus_stm$documents, 
                              kwic_corpus_stm$vocab,
                              K = 15,
                              data=kwic_corpus_stm$meta,
                              prevalence =~ sex)
kwic_stm_15

#speichern
saveRDS(kwic_stm_15, "kwic_stm_15.rds")

#einlesen
#kwic_stm_15 <- readRDS("kwic_stm_15.rds")

#plot
plot.STM(kwic_stm_15)

#label
labelTopics(kwic_stm_15)

Output: Topic 1: ski, jahr, franken, sport, star Topic 2: wurden, jahr, fis, worden, neu Topic 3: team, trainer, disziplinen, speed, cheftrain Topic 4: fahrer, lauf, klassiert, gestartet, ausgeschieden Topic 5: abfahrt, kombin, super, gewann, bronz Topic 6: abfahrt, hählen, neben, weiteren, weiter Topic 7: lauf, sölden, zweiten, slalom, bereit Topic 8: sattel, kombi, züger, mädchen, accola Topic 9: weltcup, sieg, rennen, podest, abfahrt Topic 10: viel, wer, macht, eigentlich, natürlich Topic 11: foto, sturz, knie, wochen, train Topic 12: val, oben, isèr, pist, streck Topic 13: zurück, rennen, lie, ausgeschieden, lauf Topic 14: rang, platz, top, zweiten, sekunden Topic 15: rennen, heut, louis, train, dabei

25 Topics
kwic_stm_25 <- stm(kwic_corpus_stm$documents, 
                              kwic_corpus_stm$vocab,
                              K = 25,
                              data=kwic_corpus_stm$meta,
                              prevalence =~ sex)
kwic_stm_25

saveRDS(kwic_stm_25, "kwic_stm_25.rds")

plot.STM(kwic_stm_25)

labelTopics(kwic_stm_25)

Output: Topic 1: verletzt, knie, franken, anfang, sturz Topic 2: sowi, kader, wurden, europacup, jungen Topic 3: team, speed, cheftrain, derzeit, jung Topic 4: lauf, fahrer, starten, ausgeschieden, besten Topic 5: olympischen, spielen, sichert, goldmedaill, spiel Topic 6: hählen, klassiert, fahrerinnen, gestartet, weiteren Topic 7: zweiten, lauf, schi, durchgang, qualifik Topic 8: züger, sattel, rahlv, guay, hofer Topic 9: abfahrt, kombin, weltcup, super, gewann Topic 10: wer, eigentlich, frage, kommen, klar Topic 11: oben, kopf, oft, eigenen, sah Topic 12: tage, schwester, kur, jahr, hand Topic 13: zurück, rennen, wild, weltcup, gesamt Topic 14: platz, rang, top, best, weiter Topic 15: wegen, wochen, jahr, januar, sturz Topic 16: rennen, podest, sieg, mal, weltcup Topic 17: foto, macht, wichtig, richtig, gemacht Topic 18: frei, zug, meier, buoch, beckenri Topic 19: stand, niel, vincent, rogentin, fahrern Topic 20: sekunden, hundertstel, ziel, rückstand, fahrt Topic 21: link, bott, jean, christoph, skirennfahr Topic 22: gab, medaillen, moment, rücktritt, viel Topic 23: ski, disziplinen, athleten, alpinen, jahr Topic 24: russi, grossen, siegen, namen, heinzer Topic 25: überhaupt, letzten, erst, bereit, beiden

35 Topics
kwic_stm_35 <- stm(kwic_corpus_stm$documents, 
                              kwic_corpus_stm$vocab,
                              K = 35,
                              data=kwic_corpus_stm$meta,
                              prevalence =~ sex)
kwic_stm_35

saveRDS(kwic_stm_35, "kwic_stm_35.rds")

labelTopics(kwic_stm_35)

Output: Topic 1: unten, skirennfahrerin, positiv, fühlt, bilder Topic 2: sowi, kader, wurden, europacup, beid Topic 3: team, männern, derzeit, jung, sieht Topic 4: fahrer, final, rund, starten, duell Topic 5: olympiasieg, olympischen, spielen, sichert, goldmedaill Topic 6: fahrerinnen, weiteren, wild, siegerin, simon Topic 7: qualifik, überzeugt, levi, tor, ebenso Topic 8: züger, sattel, accola, rahlv, hofer Topic 9: abfahrt, super, kombin, gewann, bronz Topic 10: wer, eigentlich, frage, mann, fan Topic 11: seit, konkurrenz, welt, leistungen, oft Topic 12: haus, gleichen, überrascht, vergleich, nimmt Topic 13: rennen, punkt, liegt, erst, letzten Topic 14: top, best, weiter, einzig, neben Topic 15: schnell, ging, möglich, abfahr, schnee Topic 16: podest, mal, verpasst, fährt, erstmal Topic 17: foto, macht, richtig, gemacht, wichtig Topic 18: frei, zug, beckenri, buoch, andermatt Topic 19: stand, pist, gesamtweltcup, spitz, damal Topic 20: sekunden, hundertstel, ziel, rückstand, fahrt Topic 21: streck, link, skirennfahr, bott, jean Topic 22: gab, medaillen, viel, tag, moment Topic 23: ski, disziplinen, speed, startet, kombin Topic 24: grossen, skisport, skifahr, vater, russi Topic 25: fahren, vorn, überhaupt, stellt, meint Topic 26: train, louis, sölden, sturz, verletzt Topic 27: jahr, fünf, tage, später, cheftrain Topic 28: zweiten, lauf, durchgang, schi, dank Topic 29: weltcup, sieg, karrier, slalom, erfolg Topic 30: zurück, klassiert, ausgeschieden, lauf, gestartet Topic 31: hählen, rogentin, niel, nil, vincent Topic 32: start, wegen, kommen, gehen, müssen Topic 33: ski, blick, sport, neuen, unser Topic 34: platz, rang, belegt, dritten, vierten Topic 35: beiden, letzten, bereit, erst, heut

45 Topics
kwic_stm_45 <- stm(kwic_corpus_stm$documents, 
                              kwic_corpus_stm$vocab,
                              K = 45,
                              data=kwic_corpus_stm$meta,
                              prevalence =~ sex)
kwic_stm_45

saveRDS(kwic_stm_45, "kwic_stm_45.rds")

labelTopics(kwic_stm_45)

Output: Topic 1: skirennfahrerin, positiv, fühlt, schwyzer, getestet Topic 2: kader, wurden, sowi, elia, neu Topic 3: team, wissen, fehlen, geholt, event Topic 4: starten, schwarz, viertelfin, weltcuppunkt, final Topic 5: olympischen, spielen, sichert, goldmedaill, spiel Topic 6: fahrerinnen, weiteren, lie, wild, zurück Topic 7: levi, rochat, out, weiteren, weltcup Topic 8: züger, sattel, borghi, accola, götschl Topic 9: abfahrt, kombin, super, bronz, gewann Topic 10: wer, frage, eigentlich, spiel, kennt Topic 11: sah, dürfen, leistung, boden, gesicht Topic 12: vergleich, deutsch, deutschen, konkurrenten, mithalten Topic 13: liechtensteinerin, führung, europacup, stund, schlussklass Topic 14: top, rang, platz, weiter, drei Topic 15: schnee, eigenen, ging, voraus, derart Topic 16: podest, mal, verpasst, auf, hundertstel Topic 17: foto, wichtig, richtig, famili, sehen Topic 18: buoch, stan, meier, plus, nidwalden Topic 19: stand, fahrern, gesamtweltcup, zielraum, schatten Topic 20: podestplatz, fahrt, fehler, teil, freut Topic 21: nzz, heim, letzten, begleitet, skirennfahr Topic 22: gab, moment, vorbei, sorgen, rücktritt Topic 23: ski, disziplinen, team, kombin, alpinen Topic 24: russi, heinzer, vreni, namen, skisport Topic 25: überhaupt, stellt, schaffen, könne, stellen Topic 26: louis, sturz, verletzt, train, schwer Topic 27: jahr, sportler, tage, alt, premier Topic 28: anfang, märz, zudem, total, offen Topic 29: sieg, weltcup, feiert, endlich, erster Topic 30: zurück, lauf, ausgeschieden, klassiert, gestartet Topic 31: hählen, niel, rogentin, vincent, nil Topic 32: start, wegen, knie, glück, kommen Topic 33: ski, blick, star, fischer, geboren Topic 34: platz, franken, belegt, verdient, rang Topic 35: gesetzt, startplatz, grund, neben, startplätz Topic 36: skifahr, einsatz, leut, fernsehen, weihnachten Topic 37: sölden, zweiter, dritter, plätzen, auftakt Topic 38: best, platz, ergebni, weltcup, resultat Topic 39: rennen, punkt, weltcup, liegt, fest Topic 40: zweiten, lauf, sekunden, rückstand, platz Topic 41: medaillen, bisher, genau, problem, vier Topic 42: cheftrain, recht, link, freud, bott Topic 43: riesenslalom, slalom, speed, riesen, parallel Topic 44: gehört, gehen, niemand, glarner, bald Topic 45: letzten, erst, weltcup, bereit, winter

55 Topics
kwic_stm_55 <- stm(kwic_corpus_stm$documents, 
                              kwic_corpus_stm$vocab,
                              K = 55,
                              data=kwic_corpus_stm$meta,
                              prevalence =~ sex)
kwic_stm_55

saveRDS(kwic_stm_55, "kwic_stm_55.rds")

labelTopics(kwic_stm_55)

Die Resultate der Topic Models auch nach dem strengeren Preprocessing sind nicht sinnvoller geworden. Trotzdem wollte ich gewisse Topics näher anschauen aber alle die ich in dieser Funktion versucht habe geben ein leeres Ouptut zurück, was darauf hinweist, dass keine Dokumente oder Sätze im Datensatz, die stark mit den gesuchten Themen übereinstimmen. Das weist weiter darauf hin, dass STM nicht eine angepasste Methode ist für diese Analyse.

findThoughts(kwic_stm_35,
             texts = kwic_stm_35$meta$text, topics = 17, n = 1)
# estimateEffect(
#   17 ~ sex,
#   kwic_stm_25,
#   metadata = kwic_corpus_stm,
#   nsims = 25
# )
#wordcloud
topic17_words <- labelTopics(kwic_stm_35, topics = 17)
topic17_words_freq <- table(unlist(topic17_words))
wordcloud(names(topic17_words_freq), freq = topic17_words_freq, random.order = FALSE)

Hier sieht mal nochmals anhand des Wordclouds das die Topics nicht unbedingt sinnvoll sind.

Weitere Versuche —–

Die Ergebnisse des STM sind leider nicht aussagekräftig, ausser, dass es beim Skifahren hauptsächlich ums Skifahren geht (aber auch dort unterscheiden sich die Topics nicht so). Deswegen probiere ich mal was anderes.

stm_corpus_neu <- corpus(dd_kwic_stm)
stm_tokens_neu <- tokens(stm_corpus_neu, remove_punct = T,
                         remove_numbers = T, 
                         remove_symbols = T)

stm_tokens_neu <- tokens_remove(stm_tokens_neu, stopwords('de'))
stm_tokens_neu <- tokens_remove(stm_tokens_neu, stopwords)

dfm_stm_neu <- dfm(stm_tokens_neu)
metadata <- data.frame(sex = dd_kwic_stm$sex)
metadata$sex <- factor(metadata$sex)

model_neu <- stm(documents = dfm_stm_neu, K = 15 + 1, data = metadata)
attr(model_neu, "metadata") <- metadata

#saveRDS(model_neu, "Inputs/model_neu15.rds")

#gender_effect <- estimateEffect(~sex, model_neu)

Topic 1: links, foto, rechts, vater, schnee Topic 2: franken, rund, erhalten, pro, skirennfahrer Topic 3: swiss-ski, wurden, athleten, fahrer, neben Topic 4: lauf, ausgeschieden, klassiert, gestartet, s Topic 5: podest, sieg, gewann, mal, gewonnen Topic 6: olympischen, spielen, konnte, tage, freude Topic 7: team, medaillen, trainer, derzeit, cheftrainer Topic 8: kombination, bronze, silber, knie, sturz Topic 9: fahrt, fehler, gute, leistung, ziel Topic 10: rang, platz, zweiten, lauf, top Topic 11: ja, wer, macht, viele, oft Topic 12: abfahrt, zurück, sattel, a, b Topic 13: sekunden, training, hundertstel, rückstand, hählen Topic 14: ö, rennen, it, sowie, punkte Topic 15: ski, jahres, sportler, km, langlauf Topic 16: rennen, letzten, heute, beiden, morgen

model_neu35 <- stm(documents = dfm_stm_neu, K = 35 + 1, data = metadata)
#saveRDS(model_neu35, "Inputs/model_neu35.rds")

Topic 1: nzz, jüngeren, prix, dabei, kreuzband Topic 2: franken, rund, pro, total, erhalten Topic 3: elia, a-kader, neu, nationalmannschaft, pleisch Topic 4: rennen, schwarz, video, ger, zurück Topic 5: sieg, gewann, abfahrt, gewinnt, zweiter Topic 6: olympischen, spielen, spiele, vancouver, goldmedaille Topic 7: team, wissen, geholt, fehlen, trainer Topic 8: ski, knie, si, fährt, linken Topic 9: leistung, leistungen, gute, dürfen, gezeigt Topic 10: lauf, zweiten, durchgang, schied, rang Topic 11: wer, frage, ja, kennt, eigentlich Topic 12: tor, sestriere, innerhofer, italiener, tore Topic 13: fahrer, klassiert, gestartet, ausgeschieden, fahrerinnen Topic 14: abfahrt, kombination, rennen, bronze, gewann Topic 15: deutsche, km, tempo, h, rennen Topic 16: donnerstag, schritt, kaum, oben, rennen Topic 17: wurden, natürlich, seite, titel, positiv Topic 18: mädchen, knaben, stoos, beckenried, i Topic 19: platz, rang, top, beste, weitere Topic 20: gehen, start, patrizia, deutschen, rennen Topic 21: skifahrer, einsatz, kommen, skifahrerinnen, weihnachten Topic 22: hählen, zurück, weiteren, rogentin, niels Topic 23: ö, it, sd, no, zurück Topic 24: louise, sturz, verletzt, januar, abfahrten Topic 25: sölden, gesetzt, startplatz, neben, grund Topic 26: heute, foto, sehen, morgen, links Topic 27: richtig, wichtig, deshalb, genau, macht Topic 28: sekunden, hundertstel, rückstand, podestplatz, rang Topic 29: gab, medaillen, moment, vorbei, sorgen Topic 30: s, a, final, sattel, u Topic 31: russi, siege, vreni, namen, accola Topic 32: punkte, rang, dienstag, liegt, kurz Topic 33: fünf, jahre, tage, cheftrainer, vier Topic 34: podest, stand, aufs, standen, mal Topic 35: jahres, sportler, skirennfahrerin, skirennfahrer, team Topic 36: rennen, letzten, drei, beiden, erst

Seeded Model:

# kwic_corpus_stm_seed <- readRDS("kwic_corpus_stm.rds")
# 
# seed_words <- c("familie", "kinder", "mutter", "vater", "schwangerschaft",
#                 "kind", "hochzeit", "eltern", "geburt", "heirat",
#                 "ehepartner", "ehepartnerin", "verlobung", "verlobt",
#                 "verliebt", "liebe", "alleinerziehend", "familienleben",
#                 "trennung", "scheidung", "eherfrau", "ehemann")
# 
# 
# seed_dictionary <- dictionary(list(seed = seed_words))
# 
# kwic_corpus_stm_seed$meta$sex <- as.factor(kwic_corpus_stm_seed$meta$sex)
# 
# #15 Topics
# stm_set_seed(123)
# kwic_stm_seed15 <- stm(kwic_corpus_stm_seed$documents,
#                               kwic_corpus_stm_seed$vocab,
#                               K = 15,
#                               data=kwic_corpus_stm_seed$meta,
#                               seed = seed_dictionary)