Topic Modeling

19.06.2019 - Valentin Gold - Reading time ~97 Minutes


Einführung

Diese Seite fasst die wesentliche Schritte von den Folien zusammen und dient gleichzeitig als Beispiel dafür, wie Sie ein RMarkdown-Dokument schreiben, das dann auf der Webseite des Kurses veröffentlicht werden kann. Damit ich Ihr Dokument erfolgreich auf die Webseite stellen kann, benötige ich zusätzlich zu Ihrem RMarkdown-Dokument noch die folgenden Daten und Dateien:

  1. Den Datensatz, den Sie für Ihre Analyse benutzen. Wenn Sie einen der verfügbaren Datensätze nutzen, dann genügt die genaue Bezeichnung des Datensatzes – ich habe diese Datensätze ja alle vorliegen.
  2. Wenn Sie sehr rechenintensive Berechnungen vornehmen, dann speichern Sie bitte das Ergebnis in einer R-Datei ab und schicken mir dieses ebenfalls. Für die Webseite müssen nämlich alle Skripte noch einmal ausgeführt werden. Wie Sie das machen können, wird in diesem Skript demonstriert (siehe Code-Block Argumente echo=TRUE, eval=FALSE).
  3. Falls dies schief geht, schicken Sie mir bitte auch die html-Seite zu; dann kann ich im Notfall darauf zurückgreifen und diese Seite online stellen.
  4. Falls Sie Bilder einbinden, dann schicken Sie mir diese bitte ebenfalls zu. Achten Sie darauf, dass Sie entsprechend die Quelle der extrenen Bilddateien angeben.

Wenn mir das RMarkdown-Dokument, die html-Seite und evtl. die Daten und Bilddateien vorliegen, dann muss ich eigentlich in Ihrem Dokument nur noch ein paar Pfade anpassen und kann alle Gruppenpräsentationen online bereit stellen.

Die Daten und diese Seite finden Sie auf Google Drive.

LDA Topic Modeling

Wie gesagt: Hier fasse ich die Folien kurz angewandt zusammen und demonstriere die Anwendung des LDA-Verfahrens. Einen Überblick liefert die folgende Abbildung von Blei (2012: 78) – und demonstriert gleichzeitig, wie Sie Abbildungen in ein RMarkdown Dokument einbinden können:

Funktionsweise Topic Modeling, Quelle: Blei 2012: 78

Figure 1: Funktionsweise Topic Modeling, Quelle: Blei 2012: 78

Pakete laden

Zuerst müssen, wie immer, die Pakete geladen werden (und evtl. vorher installiert werden.)

#Pakete laden
library(tibble)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(magrittr)
library(stringr)
library(quanteda)
## Package version: 1.4.3
## Parallel computing: 2 of 4 threads used.
## See https://quanteda.io for tutorials and examples.
## 
## Attaching package: 'quanteda'
## The following object is masked from 'package:utils':
## 
##     View
library(topicmodels)
library(tidytext)
library(tidyr)
## 
## Attaching package: 'tidyr'
## The following object is masked from 'package:magrittr':
## 
##     extract
library(ggplot2)
library(stm)
## stm v1.3.3 (2018-1-26) successfully loaded. See ?stm for help. 
##  Papers, resources, and other materials at structuraltopicmodel.com

Daten laden

In einem zweiten Schritt lade ich die Dateiens

#EuroParl-UdS Daten
load("../../../daten/EuroParl_UdS/europarl_de_agg.rda")

Exploration der Daten

Vergessen Sie nicht: Je besser Sie die Daten kennen, umso einfacher die Interpretation jeglicher (statistischer) Ergebnisse. Die Exploration hängt auch davon ab, welche Forschungsfrage Sie bearbeiten wollen\(\ldots\)

#Dimensionen
europarl_de_agg %>% 
  dim()
## [1] 181994     24

#Variablen(namen)
europarl_de_agg %>% 
  names()
##  [1] "f"              "cumsum_speaker" "sl"             "id"            
##  [5] "speaker_id"     "name"           "text"           "is_mep"        
##  [9] "mode"           "nationality"    "birth_date"     "birth_place"   
## [13] "n_party"        "p_group"        "m_state"        "sec_id"        
## [17] "sec_title"      "doc_id"         "doc_lang"       "doc_date"      
## [21] "doc_place"      "doc_edition"    "rowid"          "speaker"

#Übersicht
europarl_de_agg %>% 
  glimpse()
## Observations: 181,994
## Variables: 24
## $ f              <chr> "19990720.DE.xml", "19990720.DE.xml", "19990720.D…
## $ cumsum_speaker <dbl> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,…
## $ sl             <chr> "unknown", "en", "unknown", "it", "unknown", "en"…
## $ id             <chr> "2-001", "2-002", "2-003", "2-005", "2-006", "2-0…
## $ speaker_id     <chr> "1103", "2109", "1103", "4740", "1103", "2155", "…
## $ name           <chr> "Giorgio NAPOLITANO", "Brian CROWLEY", "Giorgio N…
## $ text           <chr> "Ich erkläre die am 7. Mai 1999 unterbrochene Sit…
## $ is_mep         <fct> True, True, True, True, True, True, True, True, T…
## $ mode           <chr> "spoken", "spoken", "spoken", "spoken", "spoken",…
## $ nationality    <chr> "Italy", "Ireland", "Italy", "Italy", "Italy", "U…
## $ birth_date     <chr> "1925-06-29", "1964-03-04", "1925-06-29", "1971-0…
## $ birth_place    <chr> "Napoli", "Dublin", "Napoli", "Milano", "Napoli",…
## $ n_party        <chr> "Democratici di Sinistra (Italy)", "Fianna Fáil P…
## $ p_group        <chr> "Group of the Party of European Socialists", "Uni…
## $ m_state        <chr> "IT", "IE", "IT", "IT", "IT", "GB", "IT", "FR", "…
## $ sec_id         <chr> "creitem1", "creitem1", "creitem1", "creitem2", "…
## $ sec_title      <chr> "Wiederaufnahme der Sitzungsperiode", "Wiederaufn…
## $ doc_id         <chr> "19990720.DE", "19990720.DE", "19990720.DE", "199…
## $ doc_lang       <fct> de, de, de, de, de, de, de, de, de, de, de, de, d…
## $ doc_date       <chr> "1999-07-20", "1999-07-20", "1999-07-20", "1999-0…
## $ doc_place      <chr> "Straßburg", "Straßburg", "Straßburg", "Straßburg…
## $ doc_edition    <chr> "Ausgabe im ABl.", "Ausgabe im ABl.", "Ausgabe im…
## $ rowid          <int> 1, 3, 10, 18, 19, 21, 22, 28, 29, 31, 32, 50, 57,…
## $ speaker        <chr> "1103", "2109", "1103", "4740", "1103", "2155", "…

#Anzahl Reden pro Nationalität
europarl_de_agg %>% 
  count(nationality) %>% 
  arrange( desc(n) )
## # A tibble: 29 x 2
##    nationality        n
##    <chr>          <int>
##  1 Germany        24840
##  2 United Kingdom 17628
##  3 <NA>           17338
##  4 France         14490
##  5 Austria        14381
##  6 Portugal       12731
##  7 Italy          11745
##  8 Spain          11487
##  9 Poland          8123
## 10 Netherlands     6354
## # … with 19 more rows

#Tagesordnungspunkte
europarl_de_agg %>% 
  count(sec_title) %>% 
  arrange( desc(n) ) %>% 
  head(20)
## # A tibble: 20 x 2
##    sec_title                                                  n
##    <chr>                                                  <int>
##  1 Abstimmungen                                            7104
##  2 7. Stimmerklärungen                                     5648
##  3 9. Stimmerklärungen                                     5556
##  4 8. Stimmerklärungen                                     3905
##  5 Fragestunde (Kommission)                                3683
##  6 Fragestunde (Rat)                                       3624
##  7 10. Stimmerklärungen                                    2896
##  8 6. Stimmerklärungen                                     2609
##  9 Stimmerklärungen                                        2018
## 10 ABSTIMMUNGEN                                            1934
## 11 5. Stimmerklärungen                                     1617
## 12 Abstimmungen (Fortsetzung)                              1479
## 13 14. Stimmerklärungen                                    1173
## 14 Arbeitsplan                                             1167
## 15 12. Stimmerklärungen                                    1095
## 16 11. Stimmerklärungen                                     853
## 17 Genehmigung des Protokolls der vorangegangenen Sitzung   816
## 18 Menschenrechte                                           791
## 19 15. Fragestunde (Anfragen an die Kommission)             739
## 20 13. Stimmerklärungen                                     734

#Ansicht der Daten
europarl_de_agg %>% 
  slice(1:50) %>% #nur 50 Beobachtungen
  select(f, cumsum_speaker, name, nationality, text) %>% 
  DT::datatable()

Auswahl relevanter Daten

Ich wähle hier nur diejenigen Daten aus, die für die Analyse relevant sind. Die Auswahl der Daten basiert in diesem Beispiel auf praktischen Überlegungen, v.a. hinsichtlich der Größe des zu analysierenden Datensatzes.

#nur Reden von Deutschen MPs behalten
speeches_de <- europarl_de_agg %>% 
  filter(nationality=="Germany")

speeches_de %>% 
  dim()
## [1] 24840    24

Quanteda Korpus und DFM

Wie immer: quanteda-Korpus und dfm erstellen.

#Korpus
speeches_corpus <- speeches_de %>% 
  corpus()

#Dokumentennamen
speeches_de <- speeches_de %>% 
  mutate(f_temp = str_replace(f, "\\.xml", "")) %>% 
  mutate(id = str_c(f_temp, "_", cumsum_speaker))

docnames(speeches_corpus) <- speeches_de %>% 
  pull(id)

#Dokumentenvariablen
docvars(speeches_corpus) <- speeches_de %>% 
  select(f, cumsum_speaker, name, is_mep, nationality, p_group, sec_title)

#Exploration
speeches_corpus %>% 
  summary(10)
## Corpus consisting of 24840 documents, showing 10 documents:
## 
##            Text Types Tokens Sentences               f cumsum_speaker
##  19990720.DE_14   247    490        17 19990720.DE.xml             14
##  19990721.DE_36    79    120         8 19990721.DE.xml             36
##  19990721.DE_45   530   1263        55 19990721.DE.xml             45
##  19990721.DE_46   387    922        40 19990721.DE.xml             46
##  19990721.DE_48   310    574        24 19990721.DE.xml             48
##  19990721.DE_49   399    724        33 19990721.DE.xml             49
##  19990721.DE_53   246    444        20 19990721.DE.xml             53
##  19990721.DE_61   201    332        15 19990721.DE.xml             61
##  19990721.DE_63   156    280        14 19990721.DE.xml             63
##  19990721.DE_67    75    111         7 19990721.DE.xml             67
##                    name is_mep nationality
##     Hans-Gert PÖTTERING   True     Germany
##     Hans-Gert PÖTTERING   True     Germany
##     Hans-Gert PÖTTERING   True     Germany
##            Klaus HÄNSCH   True     Germany
##             Heide RÜHLE   True     Germany
##  Sylvia-Yvonne KAUFMANN   True     Germany
##        Hartmut NASSAUER   True     Germany
##          Ingo FRIEDRICH   True     Germany
##   Christa RANDZIO-PLATH   True     Germany
##   Peter Michael MOMBAUR   True     Germany
##                                                                            p_group
##  Group of the European People's Party (Christian Democrats) and European Democrats
##  Group of the European People's Party (Christian Democrats) and European Democrats
##  Group of the European People's Party (Christian Democrats) and European Democrats
##                                          Group of the Party of European Socialists
##                                         Group of the Greens/European Free Alliance
##                     Confederal Group of the European United Left/Nordic Green Left
##  Group of the European People's Party (Christian Democrats) and European Democrats
##  Group of the European People's Party (Christian Democrats) and European Democrats
##                                          Group of the Party of European Socialists
##  Group of the European People's Party (Christian Democrats) and European Democrats
##                                       sec_title
##                            Wahl des Präsidenten
##                      Genehmigung des Protokolls
##                                              3.
##                                              3.
##                                              3.
##                                              3.
##                                              3.
##                                              3.
##                                              3.
##  Wahl der Quästoren des Europäischen Parlaments
## 
## Source: /Users/vgold/Documents/teaching/goettingen/-2019.1_mmzs12/webpage/content/intro/* on x86_64 by vgold
## Created: Fri Jul 12 16:20:04 2019
## Notes:

#DFM erstellen
speeches_dfm <- speeches_corpus %>% 
  dfm(remove_punct = TRUE, #Punktuation löschen
      remove_numbers = TRUE, #Zahlen löschen
      remove = stopwords("german"), #Deutsche Stoppwörter löschen
      stem = TRUE) #Zurückführen auf Wortstamm
      
speeches_dfm %>% 
  dim()
## [1]  24840 108853
speeches_dfm[1:10, 1:5]
## Document-feature matrix of: 10 documents, 5 features (86.0% sparse).
## 10 x 5 sparse Matrix of class "dfm"
##                 features
## docs             madam la président verehrt frau
##   19990720.DE_14     1  1         1       1    4
##   19990721.DE_36     0  0         0       0    1
##   19990721.DE_45     0  0         0       0    0
##   19990721.DE_46     0  0         0       0    1
##   19990721.DE_48     0  0         0       0    0
##   19990721.DE_49     0  0         0       0    0
##   19990721.DE_53     0  0         0       0    0
##   19990721.DE_61     0  0         0       0    0
##   19990721.DE_63     0  0         0       0    0
##   19990721.DE_67     0  0         0       0    0

Topic Modeling

Da jetzt der Datensatz vorliegt, kann nun der LDA-Algorithmus angewandt werden. Vorgeschaltet ist hier noch eine Analyse der Anzahl der Topics, die zumindest den Metriken nach optimal für die Extraktion der Themen ist.

#Konvertierung 
input_dfm <- speeches_dfm %>% 
  convert(to = "topicmodels")

#DFM trimmen, d.h. Features löschen
#hier: nur Features behalten, die einen größeren TF-IDF Wert als den Medianwert haben
#für weitere Eläuterungen siehe die Vignette des Paketes:
#https://cran.r-project.org/web/packages/topicmodels/vignettes/topicmodels.pdf
library(slam)
summary(col_sums(input_dfm))
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##     1.00     1.00     2.00    26.31     5.00 70695.00
term_tfidf <- tapply(
  input_dfm$v /
    row_sums(input_dfm)[input_dfm$i], input_dfm$j, mean) *
    log2(nrow(input_dfm)/col_sums(input_dfm > 0))
summary(term_tfidf)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## 0.007164 0.067929 0.092367 0.117795 0.131535 5.840151

input_dfm <- input_dfm[, term_tfidf >= median(term_tfidf)]
input_dfm <- input_dfm[row_sums(input_dfm) > 0, ] #leere Spalten löschen
summary(col_sums(input_dfm))
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    1.000    1.000    2.000    7.018    4.000 2896.000

#Inspektion
input_dfm %>% 
  dim()
## [1] 24756 54427

input_dfm %>% 
  glimpse()
## List of 6
##  $ i       : int [1:309487] 1 2537 3151 4108 10107 10406 16154 16340 19026 19097 ...
##  $ j       : int [1:309487] 1 1 1 1 1 1 1 1 1 1 ...
##  $ v       : num [1:309487] 1 1 3 1 3 2 1 1 1 1 ...
##  $ nrow    : int 24756
##  $ ncol    : int 54427
##  $ dimnames:List of 2
##   ..$ Docs : chr [1:24756] "19990720.DE_14" "19990721.DE_36" "19990721.DE_45" "19990721.DE_46" ...
##   ..$ Terms: chr [1:54427] "madam" "beglückwünschen" "tue" "freundschaftlich" ...
##  - attr(*, "class")= chr [1:2] "DocumentTermMatrix" "simple_triplet_matrix"
##  - attr(*, "weighting")= chr [1:2] "term frequency" "tf"

Bestimmung der optimalen Anzahl an Themen – wägen Sie immer zwischen theoretischen Überlegungen und den empirischen Maßzahlen ab. Und berücksichtigen Sie bitte auch, dass dieses Verfahren sehr rechenintensiv ist. Mit den gegebenen Spezifikationen benötigt die Modellierung auf meinem Rechner ca. 3 Stunden.

Wenn Sie in das RMarkdown-Skript schauen, dann sehen Sie die Argumente echo=TRUE, eval=FALSE. Diese bewirken, dass der Code zwar angezeigt (echo), aber nicht durchgeführt (evaluiert) wird. Ansonsten würde bei jedem Durchlauf des Dokuments erneut der rechenintensive Schritt durchgeführt werden. Ich handhabe dies immer so, dass ich solche Schritte nur einmal ausführe, das Ergebnis dann speicher und im nächsten Code-Block lade und analysiere. Damit ist gewährleistet, dass Änderungen im Quelldokument jederzeit möglich sind ohne wieder 3 Stunden auf ein Ergebnis warten zu müssen.

#Identifikation Anzahl der Topics
#install.packages("ldatuning")
library(ldatuning)

#Metriken für verschiedene Modelle berechnen
number_topics <- FindTopicsNumber(
  input_dfm, 
  topics = seq(from = 5, to = 150, by = 10), 
  metrics = c("Griffiths2004", "CaoJuan2009", "Arun2010", "Deveaud2014"),
  method = "Gibbs",
  control = list(seed = 42),
  mc.cores = 2L,
  verbose = TRUE
)

#Ergebnis speichern
save(number_topics, file="../../../daten/webpage_demo/number_topics.rda")
#Ergebnis laden
load("../../../daten/webpage_demo/number_topics.rda")

#Inspektion
number_topics %>% 
  str()
## 'data.frame':    15 obs. of  5 variables:
##  $ topics       : num  151 141 131 121 111 101 91 81 71 61 ...
##  $ Griffiths2004: num  -2271566 -2272546 -2265346 -2262496 -2265779 ...
##  $ CaoJuan2009  : num  0.01062 0.01098 0.01045 0.00969 0.00978 ...
##  $ Arun2010     : num  2485 2548 2585 2639 2698 ...
##  $ Deveaud2014  : num  1.85 1.89 1.95 2.01 2.07 ...

#Ergebnisse anzeigen
number_topics %>% 
  DT::datatable()

#Grafische Darstellung
number_topics %>% 
  FindTopicsNumber_plot()


#Aus der Abbildung ergibt sich, dass um die 60 Themen optimal sind. 
#Sie könnten das Verfahren nun noch einmal für 50 bis 70 Themen laufen lassen
#und sich dann auf Basis der verfeinerten Ergebnisse für eine Anzahl an Themen entscheiden. 
#In diesem Beispiel wähle ich 60 Themen. 

Da wir nun wissen, dass die optimale Anzahl an Themen ungefähr 60 ist, können wir das LDA-Verfahren für genau diese Anzahl an Themen laufen lassen. Alternativ können Sie auch noch einmal das obige Verfahren anpassen und erneut für einen kleineren Ausschnitt an möglichen Werten die Metriken berechnen lassen.

Auch hier gilt wieder: Befehl einmal laufen lassen, Ergebnis speichern und im nächsten Code-Block aufrufen. Wenn die Argumente echo=TRUE, eval=FALSE diesem Code-Block hinzugefügt werden, dann wird der Code bei einem erneuten kompilieren in eine html-Seite nicht ausgeführt.

#LDA
speeches_lda <- input_dfm %>% 
  LDA(k = 60)

#Ergebnis speichern
save(speeches_lda, file="../../../daten/webpage_demo/speeches_lda.rda")

Ergebnisse

Die nächsten Schritte analysieren und interpretieren das Ergebnis.

#Ergebnis laden
load("../../../daten/webpage_demo/speeches_lda.rda")

#Topfeatures
speeches_lda %>% 
  get_terms(10) %>% 
  t() %>% #Ansicht drehen
  DT::datatable()

#Diskriminierende Features
lda_topics <- speeches_lda %>%
  tidy(matrix="beta")

#z.B. für Topic 1 und 2
beta_spread <- lda_topics %>%
  mutate(topic = str_c("topic", topic)) %>%
  spread(topic, beta) %>%
  filter(topic1 > .001 | topic2 > .001) %>%
  mutate(log_ratio = log2(topic2 / topic1))

beta_spread %>%
  group_by(direction = log_ratio > 0) %>%
  top_n(10, abs(log_ratio)) %>%
  ungroup() %>%
  mutate(term = reorder(term, log_ratio)) %>%
  ggplot(aes(term, log_ratio)) +
  geom_col() +
  labs(y = "Log2 ratio of beta in topic 2 / topic 1") +
  coord_flip() +
  theme_bw()


STM Topic Modeling

Als Alternative zu LDA bietet sich das Paket stm an. Hier im Schnelldurchlauf ein paar der Möglichkeiten, die ausführlicher auf den Folien zu finden sind. Weitere Informationen – auch zu weiteren Paketen, die für die Analyse und visuelle Darstellung der Ergebnisse geeignet sind – finden Sie auf der Webpage des stm-Paketes: https://www.structuraltopicmodel.com/.

1.Konvertierung DFM in stm-Format

Sie könnten ansonsten auch die Original-DFM einlesen und evtl. mittels dfm_trim() Features löschen, dann sind aber die Ergebnisse nicht mehr so gut vergleichbar.

#Vorgeschaltet: dfm_trim, d.h. 
#1. Löschen von Features, die in weniger als 5% der Dokumente vorkommen UND
#2. Löschen von Features, die in mehr als 90% aller Dokumente vorkommen
#Sie können alternativ auch ein ähnliches Verfahren wie oben beschrieben anwenden
speeches_dfm %>% 
  dim()
## [1]  24840 108853

speeches_tfidf <- speeches_dfm %>% 
  dfm_tfidf(scheme_tf = "prop", 
            scheme_df = "inverse")
speeches_tfidf[1:5, 1:5]
## Document-feature matrix of: 5 documents, 5 features (72.0% sparse).
## 5 x 5 sparse Matrix of class "dfm"
##                 features
## docs                  madam         la  président     verehrt        frau
##   19990720.DE_14 0.01783914 0.01340474 0.02084059 0.007885097 0.010890019
##   19990721.DE_36 0          0          0          0           0.010035900
##   19990721.DE_45 0          0          0          0           0          
##   19990721.DE_46 0          0          0          0           0.001325987
##   19990721.DE_48 0          0          0          0           0

summary(colSums(speeches_tfidf))
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##   0.00216   0.02764   0.05426   0.39822   0.16374 105.82795

speeches_dfm_trim <- speeches_dfm %>% 
  dfm_trim(min_docfreq = 0.001, 
           max_docfreq = 0.95, 
           docfreq_type = "prop")

speeches_dfm_trim %>% 
  dim()
## [1] 24840  9149

speeches_dfm_trim[1:5, 1:5]
## Document-feature matrix of: 5 documents, 5 features (52.0% sparse).
## 5 x 5 sparse Matrix of class "dfm"
##                 features
## docs             la verehrt frau präsidentin fraktion
##   19990720.DE_14  1       1    4           5        3
##   19990721.DE_36  0       0    1           1        5
##   19990721.DE_45  0       0    0           0        2
##   19990721.DE_46  0       0    1           0        2
##   19990721.DE_48  0       0    0           0        1

#Konvertierung
input_stm <- speeches_dfm_trim %>% 
  convert(to = "stm")
  1. Anzahl der Themen

Sie könnten hier bereits Kovariaten mit ins Modell aufnehmen – der Nachteil ist, dass dann das Verfahren zur Bestimmung der Anzahl der Themen sehr sehr lange (wirklich lange!) läuft. Ohne die Spezifizierung ist das gerade noch zeitlich akzeptabel, vor allem für die stark reduzierte (getrimmte) DFM. Mit diesen Spezifikationen läuft das Modell auf meinem Rechner ungefähr 8 Stunden (also über Nacht).

#Verschiedene Modelle berechnen
stm_store <- searchK(input_stm$documents,
                     vocab = input_stm$vocab,
                     K = seq(5, 100, by=10),
                     #prevalence = ~ name + s(cumsum_speaker),
                     #content = ~ p_group,
                     data = input_stm$meta,
                     max.em.its = 125,
                     init.type = "Spectral")

#Ergebnis speichern
save(stm_store, file="../../../daten/webpage_demo/stm_store.rda")
#Ergebnisse laden
load("../../../daten/webpage_demo/stm_store.rda")

#Grafische Darstellung
stm_store %>% 
  plot()

  1. Modell für 60 Themen

In diesem Modell habe ich einige Metavariablen mit aufgenommen, die sehr wahrscheinlich einen Einfluss auf die Wahl des Themas haben (hier: speaker und zeitliche Abfolge) und über die Wortwahl entscheiden (hier: parlamentarische Fraktion). Sie können aber durchaus auch andere Kovariaten ins Modell mit aufnehmen, z.B. die Tagesordnung, zu der die Sprecher*innen reden Beachten Sie aber, dass für den Inhalt (content) nur eine Kovariate bestimmt werden kann – und dass auch dieses Modell knapp 7 Stunden läuft.

#Anzahl Themen
k <- 60

#Algorithmus
res_stm <- stm(documents = input_stm$documents,
               vocab = input_stm$vocab,
               K = k,
               prevalence = ~ name + s(cumsum_speaker),
               content = ~ p_group,
               data = input_stm$meta,
               max.em.its = 125,
               init.type = "Spectral")

#Ergebnis speichern
save(res_stm, file="../../../daten/webpage_demo/res_stm.rda")
  1. Analyse und Interpretation (beispielhaft)

Ein paar mögliche Analysen werden hier vorgestellt; für weitere Möglichkeiten siehe die ausführliche Vignette des Paketes unter https://www.structuraltopicmodel.com/. Es wäre hier auch denkbar, sich ein für die Forschungsfrage relevantes Thema herauszusuchen (z.B. Migration) und den Zeitverlauf für dieses Theme und/oder für die Fraktionen abzutragen und zu interpretieren.

#Ergebnis laden
load("../../../daten/webpage_demo/res_stm.rda")

#Anzahl Themen
k <- 60

#Label topics
res_stm %>% 
  labelTopics(c(1:10), n=5)
## Topic Words:
##  Topic 1: hintergrund, norden, süden, verbrauchen, zivilgesellschaft 
##  Topic 2: deutsch, bundesregierung, deutschen, deutschland, csu 
##  Topic 3: punkt, einzelheiten, setzen, sonstig, nächste 
##  Topic 4: tagesordnungspunkt, entgegenzutreten, dank, dolmetschern, vielen 
##  Topic 5: luftverkehr, verkehrspolitik, schien, tonnen, transport 
##  Topic 6: urteil, informiert, gab, klagen, gerichtshof 
##  Topic 7: änderungsantrag, änderungsanträgen, eingebracht, änderungsanträg, werb 
##  Topic 8: schulz, vorgang, martin, äußerung, swoboda 
##  Topic 9: eg, empfehlung, rate, änderung, erlass 
##  Topic 10: end, palästinensisch, satz, isra, israelischen 
##  
##  Covariate Words:
##  Group Confederal Group of the European United Left: freiem, konzernen, eu-politik, weichenstellungen, protestiert 
##  Group Confederal Group of the European United Left/Nordic Green Left: prinzipiel, entscheidungsfindung, verschiedensten, eingeschätzt, verwiesen 
##  Group Europe of Freedom and Direct Democracy Group: eu-parla, freilich, wozu, vorschub, brüsseler 
##  Group Europe of Nations and Freedom Group: vermutlich, kommunisten, händen, maßstäben, mitgemacht 
##  Group European Conservatives and Reformists Group: fiskalisch, leistungsfähigkeit, wiederholten, festgelegten, transfer 
##  Group Group of the Alliance of Liberals and Democrats for Europe: gerechnet, werner, revisionsklausel, unwahrscheinlich, intransparenz 
##  Group Group of the European People's Party (Christian Democrats): hinausgehend, ärger, bandbreit, implementieren, intransparenz 
##  Group Group of the European People's Party (Christian Democrats) and European Democrats: insoweit, schnellsten, vierzig, bestreben, unsererseit 
##  Group Group of the Greens/European Free Alliance: armutszeugni, systematischen, vorstoß, fände, südlich 
##  Group Group of the Party of European Socialists: irgend, widersprech, ergänzungen, bühne, atem 
##  Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: ach, zufriedenheit, fängt, circa, fach 
##  Group Non-attached Members: abzielt, hauptproblem, jedwed, türken, unkontrolliert 
##  Group Socialist Group in the European Parliament: wermutstropfen, ann, bühne, fach, fahrlässig 
##  
##  Topic-Covariate Interactions:
##  Topic 1, Group Confederal Group of the European United Left: demokrati, sofortigen, gespart, mio, bütikof 
##  Topic 1, Group Confederal Group of the European United Left/Nordic Green Left: palästina, anerkennung, block, morgigen, entschließung 
##  Topic 1, Group Europe of Freedom and Direct Democracy Group: hamburg, trump, migrantinnen, afd, ecal 
##  Topic 1, Group Europe of Nations and Freedom Group: eisenbahnunternehmen, wettbewerbspolitik, eisenbahnpaket, daten, ratspräsidentin 
##  Topic 1, Group European Conservatives and Reformists Group: unternehmen, sozialdump, kmu, regulieren, mindestlöhn 
##  Topic 1, Group Group of the Alliance of Liberals and Democrats for Europe: unionsbürg, bürgerinnen, anhörung, leitlinien, mitsprach 
##  Topic 1, Group Group of the European People's Party (Christian Democrats): zivilgesellschaft 
##  Topic 1, Group Group of the European People's Party (Christian Democrats) and European Democrats: ausschuß, plenum, antrag, enthalten 
##  Topic 1, Group Group of the Greens/European Free Alliance: geschlechtsspezifisch, sacharow-preis, aufrüstung, rüstungsexport, repress 
##  Topic 1, Group Group of the Party of European Socialists: luftraum, betreib, häfen, sozialstandard, schiff 
##  Topic 1, Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: bloße, konzentr, tier, nah 
##  Topic 1, Group Non-attached Members: antisemitismus, nordisch, wahlen, mandat, fraktion 
##  Topic 1, Group Socialist Group in the European Parliament: eur, rule 
##  
##  Topic 2, Group Confederal Group of the European United Left: bulgarischen, bundesrepublik, polen, deutschland, deutschen 
##  Topic 2, Group Confederal Group of the European United Left/Nordic Green Left: unser, sicht, fraktion, palästinensern, rechnungen 
##  Topic 2, Group Europe of Freedom and Direct Democracy Group: gsvp, galileo, zivilisten, somalia, töten 
##  Topic 2, Group Europe of Nations and Freedom Group: rechtsstaat, akp, sicherheitskräft, transatlantisch, israelischen 
##  Topic 2, Group European Conservatives and Reformists Group: steuern, moscovici, steuerpolitik, konzern, verrückt 
##  Topic 2, Group Group of the Alliance of Liberals and Democrats for Europe: guantánamo, beziehungen, pakistan, zentralasien, einfuhr 
##  Topic 2, Group Group of the European People's Party (Christian Democrats): bundesrepublik, deutschland 
##  Topic 2, Group Group of the European People's Party (Christian Democrats) and European Democrats: legislativvorschlag, einsetzung 
##  Topic 2, Group Group of the Greens/European Free Alliance: tschetschenien, rußland, russisch, russischen, osz 
##  Topic 2, Group Group of the Party of European Socialists: türkisch, eingestuft, türkischen, anstrebt, türkei 
##  Topic 2, Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: berlin, risikokapit, kompromiß, gentechnik, komponenten 
##  Topic 2, Group Non-attached Members: verkehr, fremdenverkehr, regionalpolitik, industriepolitik, tagung 
##  Topic 2, Group Socialist Group in the European Parliament: statement 
##  
##  Topic 3, Group Confederal Group of the European United Left: plätze, beendet, setzen 
##  Topic 3, Group Confederal Group of the European United Left/Nordic Green Left: iii, vertragsänderung, donald, lobbyisten, fragestellungen 
##  Topic 3, Group Europe of Freedom and Direct Democracy Group: juncker, steueroasen, list, malta, panama 
##  Topic 3, Group Europe of Nations and Freedom Group: china, nachbarschaft, exportiert, östlichen, vietnam 
##  Topic 3, Group European Conservatives and Reformists Group: sparpolitik, lohndump, liberalisierung, austeritätspolitik, harmonisierung 
##  Topic 3, Group Group of the Alliance of Liberals and Democrats for Europe: banken, schulden, schuldenschnitt, ezb, löhne 
##  Topic 3, Group Group of the European People's Party (Christian Democrats):  
##  Topic 3, Group Group of the European People's Party (Christian Democrats) and European Democrats: polen, roma, terroristischen, rentenalt, arbeitslosigkeit 
##  Topic 3, Group Group of the Greens/European Free Alliance: tourismus, galileo, innovativen, binnenschifffahrt, eu-gesetzgebung 
##  Topic 3, Group Group of the Party of European Socialists: tendenzen, äußeren, inneren, wirklichkeit 
##  Topic 3, Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: zollunion, auseinandersetzung, oostland, propaganda, züge 
##  Topic 3, Group Non-attached Members: altersvorsorg, wettbewerb, risiken, finanzmärkten, chancen 
##  Topic 3, Group Socialist Group in the European Parliament: gebäud 
##  
##  Topic 4, Group Confederal Group of the European United Left: frattini, aussprach, tagesordnungspunkt 
##  Topic 4, Group Confederal Group of the European United Left/Nordic Green Left: gaza, grenzen, journalisten, israelischen, krankenhaus 
##  Topic 4, Group Europe of Freedom and Direct Democracy Group: wto-verhandlungen, erzwingen, gucht, morden, venezuela 
##  Topic 4, Group Europe of Nations and Freedom Group: gemeinschaften, erika, tunesien, sport, transatlantischen 
##  Topic 4, Group European Conservatives and Reformists Group: swift, frauen, zwang, männer, prostitut 
##  Topic 4, Group Group of the Alliance of Liberals and Democrats for Europe: michel, syrien, forum, zuhören, bürgernah 
##  Topic 4, Group Group of the European People's Party (Christian Democrats): haarder, entgegenzutreten 
##  Topic 4, Group Group of the European People's Party (Christian Democrats) and European Democrats: europarat, gefangen, gefangenen, menschenrecht, häftling 
##  Topic 4, Group Group of the Greens/European Free Alliance: sis, kuba, informationssystem, schengen, demonstranten 
##  Topic 4, Group Group of the Party of European Socialists: sieben, vertreterin, tagung, absatz, artikel 
##  Topic 4, Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: sitzen, ergänzen, ratspräsidentin 
##  Topic 4, Group Non-attached Members: listen, iranisch, opposit, iranischen, iran 
##  Topic 4, Group Socialist Group in the European Parliament: entgegenzutreten 
##  
##  Topic 5, Group Confederal Group of the European United Left: rüstungsexport, dual, schengen-besitzstand, erd, voraussichtlich 
##  Topic 5, Group Confederal Group of the European United Left/Nordic Green Left: christen, zeitgründen, redezeit, gefangen, nr 
##  Topic 5, Group Europe of Freedom and Direct Democracy Group: sprachen, laeken, verfassungsvertrag, direktor, tragweit 
##  Topic 5, Group Europe of Nations and Freedom Group: usa, risikobewertung, modell, nordkorea, eigenkapit 
##  Topic 5, Group European Conservatives and Reformists Group: industriepolitik, benennt, wirtschaften, inhaftierten, momentum 
##  Topic 5, Group Group of the Alliance of Liberals and Democrats for Europe: quartett, gedenken, fluchtursachen, getreid, simbabw 
##  Topic 5, Group Group of the European People's Party (Christian Democrats): maßstäb, indonesien, flughäfen, schiff, gütern 
##  Topic 5, Group Group of the European People's Party (Christian Democrats) and European Democrats: festgenommen, kurden, repressionen, frieden, dörfer 
##  Topic 5, Group Group of the Greens/European Free Alliance: verfassungsvertrag, unterstütz, tschechisch, konvent, duff 
##  Topic 5, Group Group of the Party of European Socialists: humanitär, katastrophen, kaukasus, naturkatastrophen, süden 
##  Topic 5, Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: wto-verhandlungen, zugeständniss, wto, welthandel, wasser 
##  Topic 5, Group Non-attached Members: terrorismus, beitrittsprozess, erd, befürchtungen, befördert 
##  Topic 5, Group Socialist Group in the European Parliament: jugendgaranti, brexit, römischen, eigenmitteln, briten 
##  
##  Topic 6, Group Confederal Group of the European United Left: futter, erdoğan, staat, recht, stattfand 
##  Topic 6, Group Confederal Group of the European United Left/Nordic Green Left: vorratsdatenspeicherung, verstand, schengen, terrorismusbekämpfung, softwar 
##  Topic 6, Group Europe of Freedom and Direct Democracy Group: königreich, nbsp, netzneutralität, bildungssystem, iwf 
##  Topic 6, Group Europe of Nations and Freedom Group: traditionen, repress, kaukasus, atomkraft, zukunftsfähig 
##  Topic 6, Group European Conservatives and Reformists Group: auswärtig, angelegenheiten, dr, berichterstatterin, verfass 
##  Topic 6, Group Group of the Alliance of Liberals and Democrats for Europe: beitrittsprozess, beitrittskandidaten, senat, statut, lohndump 
##  Topic 6, Group Group of the European People's Party (Christian Democrats): fraktionen, schlussfolgerungen, lupe, anträg, lebensmittelsicherheit 
##  Topic 6, Group Group of the European People's Party (Christian Democrats) and European Democrats: beratenden, weißbuch, unternehm, volkswirtschaftlich, gremien 
##  Topic 6, Group Group of the Greens/European Free Alliance: datenschutz, verstand, illeg, migranten, geistig 
##  Topic 6, Group Group of the Party of European Socialists: absenkung, einsatz, altern, dezentral, höherer 
##  Topic 6, Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: ostdeutschland, angelegenheiten, ausschuss, berichterstatt 
##  Topic 6, Group Non-attached Members: menschenrechtskonvent, freiem, iii, massenarbeitslosigkeit, ansprechen 
##  Topic 6, Group Socialist Group in the European Parliament: begeht, gericht, richter, frist, gerichtshof 
##  
##  Topic 7, Group Confederal Group of the European United Left: philippinen, bericht, ngl-fraktion, zulassung, be 
##  Topic 7, Group Confederal Group of the European United Left/Nordic Green Left: integr, ökonomisch, augenblick, glaub, sozial 
##  Topic 7, Group Europe of Freedom and Direct Democracy Group: rednern, ratspräsid, mitarbeitern, berichterstatterin, abschließend 
##  Topic 7, Group Europe of Nations and Freedom Group: afrikanischen, afrika, entwicklungshilf, z, b 
##  Topic 7, Group European Conservatives and Reformists Group: doha-rund, genf, entwicklungsländ, akp-staaten, finanzierungsinstru 
##  Topic 7, Group Group of the Alliance of Liberals and Democrats for Europe: ruhezeiten, biometrisch, lenk, verkehrspolitik, straßen 
##  Topic 7, Group Group of the European People's Party (Christian Democrats): verkehrssicherheit, lkw, fahrzeug, stoff, transit 
##  Topic 7, Group Group of the European People's Party (Christian Democrats) and European Democrats: erweiterung, vertrauen 
##  Topic 7, Group Group of the Greens/European Free Alliance: morillon, tschechisch, ausgezeichnet, gebührt 
##  Topic 7, Group Group of the Party of European Socialists: nachbarschaft, weitreichenden, tschechischen, umweltfragen, haushaltsmittel 
##  Topic 7, Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: jugendlich, jugendlichen, banken, konzern, zuzugehen 
##  Topic 7, Group Non-attached Members: wirtschaftspolitik, stabilitätspakt, inflat, investitionen, stabilität 
##  Topic 7, Group Socialist Group in the European Parliament: see, is, right, on, to 
##  
##  Topic 8, Group Confederal Group of the European United Left: myanmar, stiftung, nachfrag, nochmal, woch 
##  Topic 8, Group Confederal Group of the European United Left/Nordic Green Left: sis, bankenaufsicht, eba, sicht, bankenunion 
##  Topic 8, Group Europe of Freedom and Direct Democracy Group: bangladesch, einmütig, prekären, kultur, rohstoff 
##  Topic 8, Group Europe of Nations and Freedom Group: cia, menschenrecht, sudan, regierung, europarat 
##  Topic 8, Group European Conservatives and Reformists Group: importeur, planungen, analys, ordnungsgemäß, analysieren 
##  Topic 8, Group Group of the Alliance of Liberals and Democrats for Europe: sprachlich, angenommen, änderungsanträg, crespo, barón 
##  Topic 8, Group Group of the European People's Party (Christian Democrats): prodi, ansehen, festzustellen, geschrieben, anschließen 
##  Topic 8, Group Group of the European People's Party (Christian Democrats) and European Democrats: strafgerichtshof, benennt, sicherheitspolitik, kyoto, unterdrückt 
##  Topic 8, Group Group of the Greens/European Free Alliance: europol, territorial, wunderbar, arme, kontin 
##  Topic 8, Group Group of the Party of European Socialists: ehrgeizigen, hebel, aktiv 
##  Topic 8, Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: prestig, ordnungsgemäß, analysieren 
##  Topic 8, Group Non-attached Members:  
##  Topic 8, Group Socialist Group in the European Parliament: ratspräsidentschaft, slowakei, einzusehen, sekunden, ministerpräsid 
##  
##  Topic 9, Group Confederal Group of the European United Left: haftbefehl, josé, haushaltsbehörd, erfindungen, erika 
##  Topic 9, Group Confederal Group of the European United Left/Nordic Green Left: barcelona-prozess, verhütung, roth-behrendt, währungsunion, abstimmung 
##  Topic 9, Group Europe of Freedom and Direct Democracy Group: fukushima, stresstest, tschernobyl, europaweiten, atomkraftwerk 
##  Topic 9, Group Europe of Nations and Freedom Group: posselt, olympischen, öffentlich-rechtlichen, energiemarkt, informationsgesellschaft 
##  Topic 9, Group European Conservatives and Reformists Group: eu-recht, vertrag, model, hoheitsgebiet, irland 
##  Topic 9, Group Group of the Alliance of Liberals and Democrats for Europe: sanktionen, weißrussland, quot, lukaschenko, politisch 
##  Topic 9, Group Group of the European People's Party (Christian Democrats): vermittlungsausschuss, richtlini, tätigkeiten, festlegung 
##  Topic 9, Group Group of the European People's Party (Christian Democrats) and European Democrats: bericht, darstellung 
##  Topic 9, Group Group of the Greens/European Free Alliance: zurückgewiesen, asylbewerbern 
##  Topic 9, Group Group of the Party of European Socialists: fahrer, fahrzeug, straßenverkehrssicherheit, selbständigen, unfällen 
##  Topic 9, Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: nein 
##  Topic 9, Group Non-attached Members: crespo, barón, deprez, präventiv, dutzend 
##  Topic 9, Group Socialist Group in the European Parliament: globalisierung, supranational, zahlungen, geschäftsmodel, eu-eben 
##  
##  Topic 10, Group Confederal Group of the European United Left: türkisch, türkischen, türkei, beitrittsverhandlungen, kurdischen 
##  Topic 10, Group Confederal Group of the European United Left/Nordic Green Left: mörder, mali, ombudsmann, nennt, putsch 
##  Topic 10, Group Europe of Freedom and Direct Democracy Group: mfr, bankenunion, esf, farag, spd 
##  Topic 10, Group Europe of Nations and Freedom Group: zeugt, antrag, lambert, duff, zulässig 
##  Topic 10, Group European Conservatives and Reformists Group: tourismus, lärm, florenz, vollmitgliedschaft, meer 
##  Topic 10, Group Group of the Alliance of Liberals and Democrats for Europe:  
##  Topic 10, Group Group of the European People's Party (Christian Democrats): zivilisten, zerstörung, israelisch, israelischen, infrastruktur 
##  Topic 10, Group Group of the European People's Party (Christian Democrats) and European Democrats: diktatoren, multilateralen, massenvernichtungswaffen, saddam, hebt 
##  Topic 10, Group Group of the Greens/European Free Alliance: laeken, gemeinschaftsmethod, wirtschaftsregierung, un-sicherheitsrat, bürgerinnen 
##  Topic 10, Group Group of the Party of European Socialists: sterckx, ludford, äußern, posselt, thema 
##  Topic 10, Group Group of the Progressive Alliance of Socialists and Democrats in the European Parliament: globalisierung, parlamentsverwaltung, fischler, wettbewerbsrecht, anpassung 
##  Topic 10, Group Non-attached Members:  
##  Topic 10, Group Socialist Group in the European Parliament: ukrain, visafreiheit, briefkastenfirmen, euro-zon, bürgerkrieg 
## 

Ein paar “grafische” Darstellungen

#Grafische Darstellungen
res_stm %>% 
  plot(type = "labels", 
       topics = c(1:10),
       n = 5, 
       text.cex = .7)


res_stm %>% 
  plot(type = "summary", 
       xlim = c(0, .1), 
       text.cex = .3)


res_stm %>% 
  plot(type = "hist", 
       topics = c(1:10))


#Unterschiede zwischen Parteien
res_stm %>% 
  plot(type = "perspective", 
       covarlevels = c("Group of the European People's Party (Christian Democrats) and European Democrats", "Group of the Party of European Socialists"), 
       plabels = c("Christian Democrats", "European Socialists"),
       text.cex = .7,
       topics = 9, 
       main = "Topic 1")


#Unterschiede zwischen Topics
res_stm %>% 
  plot(type = "perspective", 
       topics = c(1, 10), 
       main = "Topic 1")

#Effektschätzung
res_prep <- estimateEffect(1:k ~ p_group + s(cumsum_speaker), 
                           res_stm, 
                           meta = input_stm$meta, 
                           uncertainty = "Global")
save(res_prep, file="../../../daten/webpage_demo/res_prep.rda")
#Grafische Darstellungen
res_prep %>% 
  plot("p_group", 
       model = stm, 
       method = "pointestimate", 
       topics = c(1))


res_prep %>% 
  plot(covariate = "p_group", 
       topics = c(1, 10), 
       model = res_stm, 
       method = "difference", 
       cov.value1 = "Group of the European People's Party (Christian Democrats) and European Democrats", 
       cov.value2 = "Group of the Party of European Socialists")


#Zeitlicher Verlauf
max_rowid <- speeches_de %>% 
  select(cumsum_speaker) %>% 
  max()

par(mfrow=c(3,ceiling(10/3)), mar=c(2,2,2,2))
for (i in 1:12){
    plot(res_prep, 
         "cumsum_speaker", 
         method = "continuous", 
         topics = c(i), 
         model = res_stm, 
         printlegend = FALSE, 
         xlab = "Elapsed Turns since Start of the First Debate", 
         xlim = c(1, max_rowid))
  title(main = str_c("Topic ", i) )
}