Gutes Ergebnis mit oder trotz Risiko?

Der Jahresabschluss 2023 der Daimler Truck AG hat fast 300 teils eng beschriebene Seiten. Das Finanzergebnis war sehr gut; doch wie werden die Zahlen beschrieben? Dieser Frage wollen wir im Folgenden nachgehen. Als erstes laden wir die benötigten libraries für unsere Untersuchung:

library(dplyr)
library(ggplot2)
library(knitr)
library(ldatuning)
library(pdftools)
library(readr)
library(SnowballC)
library(scales)
library(tibble)
library(tidytext)
library(tm)
library(wordcloud2)
library(topicmodels)
library(tidyr)

Nun laden wir den Jahresabschluss (via direkt-link) und bereiten den Text so auf, dass jede Zeile separat ausgegeben wird. Das Ergebnis der ersten zehn Zeilen sieht dann wiefolgt aus:

link <- "https://www.daimlertruck.com/fileadmin/user_upload/documents/investors/reports/annual-reports/2023/daimler-truck-ir-annual-report-2023-incl-combined-management-report-dth-ag.pdf"
text <- pdf_text(pdf=link) %>% 
  read_lines() %>%
  data.frame(matrix(unlist(.), byrow=T),stringsAsFactors=FALSE) %>%
  rowid_to_column(., "line") %>%
  `colnames<-`(c("line", "text")) %>% select("line", "text")
kable(head(text,10))

line	text
1	2023 Annual Report
2	Daimler Truck | 2023 Annual Report 2
3
4
5
6
7	Key Figures for the Group
8	2023 2022 2023/2022
9	Amounts in millions of euros % change
10

Doch mit diesem Text können wir noch nicht so viel anfangen. Entsprechend filtern wir direkt häufige Füllwörter (stop_words) als auch eigen-gesammelte Füllwörter heraus. Auch Zahlen interessieren uns nicht und werden entfernt. Das Resultat der ersten Zeilen sieht nun schon mehr nach einem Datensatz aus, mit welchem wir arbeiten können:

custom_stop_words <- bind_rows(tibble(
  word = c("daimler", "§", "mercedes", "benz", "ag", "report", "statement", "management", "supervisory", "financial", "truck", "board", "consolidated", "statements", "ü", "ä", "ssc", "aa", "aktg", "corporation", "thereof", "table", "www.daimlertruck.com"),
  lexicon = c("custom")), stop_words)
tidy_text <- text %>%
  unnest_tokens(word, text) %>% #aus der Zeile werden die einzelnen Wörter
  anti_join(custom_stop_words) %>% #die Füllwörter werden entfernt
  .[-grep("\\b\\d+\\b", .$word),] %>% #Zahlen werden entfernt
  select(line, word) %>%
  na.omit(.)
head(tidy_text,10)

##    line     word
## 2     1   annual
## 4     2   annual
## 6     7      key
## 7     7  figures
## 12    9  amounts
## 13    9 millions
## 14    9    euros
## 15    9   change
## 16   12     unit
## 17   12    sales

Ein Blick auf die Wordcloud verrät bereits, was interessantes in dem Jahresabschluss stehen könnte:

tidy_text %>%
  count(word) %>%
  wordcloud2(color="grey", size=0.5)

Für ein geneueres Verständnis schauen wir nun auf die Worthäufigkeiten. Dafür benutzen wir die Wortstämme, sodass sowohl Plural als auch Singular als ein Begriff gezählt werden können. Verwunderlich ist die Häufigkeit des Begriffs “Risiko”; ein super Geschäftsergebnis und dennoch “Risiko” als häufigster Begriff? Klar, jedes Unternehmen hat ein Risikomanagement und jede Prognose hat Risiken. Aber ist hier noch mehr dahinter?

tidy_text %>%
  mutate(word = wordStem(word)) %>%
  count(word, sort = TRUE) %>%
  top_n(20) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip() +
  ggtitle("die häufigsten Begriffe") +
  theme(plot.title = element_text(size = 10, hjust = 0.5),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank())

Ein Blick auf die häufigsten Bigramme, also Wortpaare, hilft hier vielleicht weiter. Nicht überraschend tauchen hier viele Finanzbegriffe auf; aber auch Human Rights taucht auf. Dies lässt sich auch mit Risiken und Auflagen zB dem neuen Lieferkettengesetz erklären. Also nichts verwunderliches hier.

bigrams <-text %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2) %>%  
  select(bigram) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>%
  filter(!word1 %in% custom_stop_words$word,
         !word2 %in% custom_stop_words$word) %>%
  drop_na(word1) %>%
  drop_na(word2) %>%
  .[-grep("\\b\\d+\\b", .$word1),] %>% #Zahlen werden entfernt
  .[-grep("\\b\\d+\\b", .$word2),] %>% #Zahlen werden entfernt
  mutate(word1 = wordStem(word1)) %>%
  mutate(word2 = wordStem(word2)) %>%
  unite(bigram, word1, word2, sep = " ")
bigrams %>%
  count(bigram, sort = TRUE) %>%
  top_n(20) %>% #hier anpassen
  mutate(bigram = reorder(bigram, n)) %>%
  ggplot(aes(bigram, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip() +
  ggtitle("die häufigsten Begriffspaare") +
  theme(plot.title = element_text(size = 10, hjust = 0.5),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank())

Ähnlich kann man bei den häufigsten Trigrammen argumentieren. Viele Begriffe überraschen nicht in der Auflistung; doch “climate change mitigation” weist auf Programme zur Risikominierung hin, während “russia ukraine war” auf Risiken im Geschäftsumfeld hinweist.

trigrams <-text %>%
  unnest_tokens(trigram, text, token = "ngrams", n = 3) %>%  
  select(trigram) %>%
  separate(trigram, c("word1", "word2", "word3"), sep = " ") %>%
  filter(!word1 %in% custom_stop_words$word,
         !word2 %in% custom_stop_words$word,
         !word3 %in% custom_stop_words$word) %>%
  drop_na(word1) %>%
  drop_na(word2) %>%
  drop_na(word3) %>%
  .[-grep("\\b\\d+\\b", .$word1),] %>% 
  .[-grep("\\b\\d+\\b", .$word2),] %>% 
  .[-grep("\\b\\d+\\b", .$word3),] %>% 
  mutate(word1 = wordStem(word1)) %>%
  mutate(word2 = wordStem(word2)) %>%
  mutate(word3 = wordStem(word3)) %>%
  unite(trigram, word1, word2, word3, sep = " ")
trigrams %>%
  count(trigram, sort = TRUE) %>%
  top_n(20) %>%
  mutate(trigram = reorder(trigram, n)) %>%
  ggplot(aes(trigram, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip() +
  ggtitle("die häufigsten Trigramme") +
  theme(plot.title = element_text(size = 10, hjust = 0.5),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank())

Ist der Bericht also gar nicht so positiv, wie es das Geschäftsergebnis vermuten lässt? Dafür können wir nun schauen, wie positiv oder negativ der Bericht generell ist; also was sein Sentimentwert ist. Die NRC-library kategorisiert die Begriffe des Texts bestimmten Emotionen zu. “Positiv” überwiegt in der Anzahl der Begriffe; passend zum Geschäftsergebnis.

Die nrc-Bibliothek zur Sentimentanalyse wird hier beschrieben: Crowdsourcing a Word-Emotion Association Lexicon, Saif Mohammad and Peter Turney, Computational Intelligence, 29 (3), 436-465, 2013. Emotions Evoked by Common Words and Phrases: Using Mechanical Turk to Create an Emotion Lexicon, Saif Mohammad and Peter Turney, In Proceedings of the NAACL-HLT 2010 Workshop on Computational Approaches to Analysis and Generation of Emotion in Text, June 2010, LA, California.

#get_sentiments("afinn") #assigns words with a score that runs between -5 and 5
#get_sentiments("nrc") #LICENSE NEEDED - categorizes words in a binary fashion (“yes”/“no”) into categories of positive, negative, anger, anticipation, disgust, fear, joy, sadness, surprise, and trust
tidy_text %>%  
  inner_join(get_sentiments("nrc")) %>%
  count(sentiment, sort=TRUE) %>%
  mutate(sentiment = reorder(sentiment, n)) %>%
  ggplot(aes(sentiment, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip() +
  ggtitle("Welche Emotionen werden angesprochen?") +
  theme(plot.title = element_text(size = 10, hjust = 0.5),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank())

Es sind die folgenden Begriffe, welchen positiven Assoziationen zugeschrieben werden und somit den Bericht positiv erscheinen lassen:

tidy_text %>%
  inner_join(get_sentiments("nrc") %>% filter(sentiment == "positive")) %>% 
  count(word, sort = TRUE) %>%
  top_n(20) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip() +
  ggtitle("Welche Begriffe zu Positiv überwiegen?") +
  theme(plot.title = element_text(size = 10, hjust = 0.5),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank())

Die library bing hingegen kategorisiert Wörter binär in positiv und negativ. Hier sehen wir, dass sehr wohl positive als auch negativ-konnotierte Passagen im Bericht erkennbar sind. Anbei dargestellt ist der Sentimentwert (also #positive - #negative Begriffe) per 80 Zeilen:

text_sentiment <- tidy_text %>%
  inner_join(get_sentiments("bing")) %>% #categorizes words in a binary fashion into positive and negative categories
  count(index = line %/% 80, sentiment) %>% ## die Entwicklung des Sentiment-Scores per 80-Zeilen
  spread(sentiment, n, fill = 0) %>%
  mutate(sentiment = positive - negative)
ggplot(text_sentiment, aes(index, sentiment)) +
  geom_col(show.legend = FALSE) +
  ggtitle("die Entwicklung des Sentiment-Scores per 80-Zeilen") +
  theme(plot.title = element_text(size = 10, hjust = 0.5),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank())

Maßgeblich für die jeweils negative und positive Konnotierung sind hier diese Begriffe:

bing_word_counts <- tidy_text %>%
  mutate(word = wordStem(word)) %>%
  inner_join(get_sentiments("bing")) %>%
  count(word, sentiment, sort = TRUE) %>%
  ungroup()
bing_word_counts %>%
  group_by(sentiment) %>%
  top_n(20) %>%
  ungroup() %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~sentiment, scales = "free_y") +
  labs(y = "Contribution to sentiment",
       x = NULL) +
  coord_flip() +
  ggtitle("die häufigsten positiv & negativ-konnotierten Wörter") +
  theme(plot.title = element_text(size = 10, hjust = 0.5),
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
      panel.background = element_blank())

Die negativen Passagen im Text können wir noch weiter spezifizieren. Im Folgenden werten nun die Bigramme im Umfeld des negativsten Sentimentwerts aus. Die Begriffe lassen auf den Teil schließen, in welchem über die Risiken berichtet wird. Insofern haben wir hier eine Erklärung, warum der Begriff Risiko trotz des so erfolgreichen Jahres so oft vorkommt.

sentiment_min <- text_sentiment %>%
  top_n(-1) %>%
  select(index) * 80
bigrams_min <- text %>%
  filter(line >= sentiment_min$index & line < sentiment_min$index +80) %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>%
  filter(!word1 %in% custom_stop_words$word,
         !word2 %in% custom_stop_words$word) %>%
  .[-grep("\\b\\d+\\b", .$word1),] %>% 
  .[-grep("\\b\\d+\\b", .$word2),] %>% 
  drop_na(word1) %>%
  drop_na(word2)
bigrams_min <- bigrams_min %>%
  unite(bigrams, word1, word2, sep = " ")
bigrams_min %>%
  count(bigrams, sort = TRUE) %>%
  head(n=20) %>% 
  mutate(bigrams = reorder(bigrams, n)) %>%
  ggplot(aes(bigrams, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip() +
  ggtitle("Wo ist der Sentiment-Score am niedrigsten?") + 
  theme(plot.title = element_text(size = 10, hjust = 0.5),
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
      panel.background = element_blank())

Ähnlich können wir uns auch die Trigramme aus den am positivsten konnotierten Passagen ausgeben lassen. Hier fallen Begriffe wie Nachhaltigkeit oder Autonomous Driving zu dominieren. Es scheint also um die Strategie zu gehen.

sentiment_max <- text_sentiment %>%
  top_n(1) %>%
  select(index) * 80
bigrams_max <- text %>%
  filter(line >= sentiment_max$index & line < sentiment_max$index +80) %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>%
  filter(!word1 %in% custom_stop_words$word,
         !word2 %in% custom_stop_words$word) %>%
  .[-grep("\\b\\d+\\b", .$word1),] %>% 
  .[-grep("\\b\\d+\\b", .$word2),] %>% 
  drop_na(word1) %>%
  drop_na(word2)
bigrams_max <- bigrams_max %>%
  unite(bigrams, word1, word2, sep = " ")
bigrams_max %>%
  count(bigrams, sort = TRUE) %>%
  head(n=20) %>%
  mutate(bigrams = reorder(bigrams, n)) %>%
  ggplot(aes(bigrams, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip() +
  ggtitle("Wo ist der Sentiment-Score am höchsten??") + 
  theme(plot.title = element_text(size = 10, hjust = 0.5),
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
      panel.background = element_blank())

Wir können die Analyse noch fortfahren und schauen, ob es weitere interessante Details gibt. Sind spezielle Themen erkennbar? Hierfür können wir mit unterschiedlichen Methoden die Menge an Themen identifizieren und in folgender Grafik ausgeben lassen. Die gleichzeitige Minimierung der beiden oberen Linien und Maximierung der beiden unteren ergibt die Anzahl von vier Themen:

texts_DTM <- tidy_text  %>%
  mutate(document = "text1") %>%
  count(document, word) %>%
  cast_dtm(document, word, n)
result <- FindTopicsNumber(
  texts_DTM,
  topics = seq(from = 2, to = 10, by = 1),
  metrics = c("Griffiths2004", "CaoJuan2009", "Arun2010", "Deveaud2014"),
  method = "Gibbs",
  control = list(seed = 77),
  mc.cores = 2L,
  verbose = TRUE
)

## fit models... done.
## calculate metrics:
##   Griffiths2004... done.
##   CaoJuan2009... done.
##   Arun2010... done.
##   Deveaud2014... done.

FindTopicsNumber_plot(result)

Im Folgenden geben wir nun die Begriffe aus, aus denen diese Themen bestehen. Zwar lassen sich bestimmte Themengebiete erahnen; diese geben uns aber ohne tiefergehende Analyse keinen Mehrwert:

topics <- LDA(texts_DTM, k = 4, control = list(seed = 1234)) #vier Themen
topics_prob <- tidy(topics, matrix = "beta")
topic_terms <- topics_prob %>%
  group_by(topic) %>%
  top_n(15, beta) %>% 
  ungroup() %>%
  arrange(topic, -beta)
topic_terms %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(term, beta)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip() +
  scale_x_reordered()  +
  ggtitle("Themen im Jahresabschluss") +
  theme(plot.title = element_text(size = 10, hjust = 0.5),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank())

Und bringt eventuell ein Vergleich des Texts zum Jahresabschluss im Vorjahr einen Mehrwert? Im Folgender Grafik können wir sehen, welche Begiffe häufiger im Abschluss 2024 und im Abschluss 2023 benutzt wurden:

link2023 <- "https://www.daimlertruck.com/fileadmin/user_upload/documents/investors/reports/annual-reports/2022/daimler-truck-ir-annual-report-2022-incl-combined-management-report-dth-ag.pdf"
text2 <- pdf_text(pdf=link2023) %>% 
  read_lines() %>%
  data.frame(matrix(unlist(.), byrow=T),stringsAsFactors=FALSE) %>%
  rowid_to_column(., "line") %>%
  `colnames<-`(c("line", "text")) %>%
  select("line", "text")
joined_texts <- bind_rows(text %>% 
                            mutate(source = "JA_2023"),
                          text2 %>% 
                            mutate(source = "JA_2022"))
tidy_texts <- joined_texts %>%
  unnest_tokens(word, text) %>%
  anti_join(custom_stop_words) %>%
  .[-grep("\\b\\d+\\b", .$word),]  #remove numbers

# Plot16: Vergleich der häufigsten Wörter
frequency <- tidy_texts %>%
  group_by(source) %>% 
  count(word, sort = TRUE) %>% 
  left_join(tidy_texts %>% 
              group_by(source) %>% 
              summarise(total = n())) %>%
  mutate(freq = n/total)
frequency <- frequency %>%
  select(source, word, freq) %>% 
  spread(source, freq) %>%
  arrange(JA_2023, JA_2022)
ggplot(frequency, aes(JA_2023, JA_2022)) +
  geom_jitter(alpha = 0.1, size = 2.5, width = 0.25, height = 0.25) +
  geom_text(aes(label = word), check_overlap = TRUE, vjust = 1.5) +
  scale_x_log10(labels = percent_format()) +
  scale_y_log10(labels = percent_format()) +
  geom_abline(color = "red") +
  ggtitle("Vergleich der häufigsten Wörter") +
  theme(plot.title = element_text(size = 10, hjust = 0.5),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank())

Eine Ähnlichkeit der beiden Berichte ist - erwartungsgemäß - gegeben bei einer Korrelation von 0.96.

# Statist. Ähnlichkeit zwischen den beiden Texten nach Worthäufigkeit
cor.test(data = frequency[,],~ JA_2023 + JA_2022)

## 
##  Pearson's product-moment correlation
## 
## data:  JA_2023 and JA_2022
## t = 234.45, df = 5591, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.9502394 0.9550817
## sample estimates:
##      cor 
## 0.952721

Die Begriffe wiederum, welche den Unterschied zwischen beiden Texten ausmachen sind bezeichnend: zB das Share Buyback Programm in 2023 oder die neue CFO Eva Scherer.

texts_words <- tidy_texts %>%
    mutate(word=wordStem(word)) %>%
  count(source, word, sort = TRUE) %>%
  ungroup()
tw_idf <- texts_words %>%
  bind_tf_idf(word, source, n) %>%
  arrange(desc(tf_idf))
tw_idf %>%
  arrange(desc(tf_idf)) %>%
  mutate(word = factor(word, levels = rev(unique(word)))) %>% 
  group_by(source) %>% 
  top_n(20) %>% 
  ungroup() %>%
  ggplot(aes(word, tf_idf)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~source, ncol = 2, scales = "free") +
  coord_flip() +
  ggtitle("Wichtige Begriffe, welche die beiden Texte im Vergleich ausmachen (nach Zipf`s Law)") +
  theme(plot.title = element_text(size = 10, hjust = 0.5),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank())