Twitter wird häufig zur Kommentierung von und Kommunikation mit Unternehmen genutzt. Dies ist ein Grund, warum Tweets zur Analyse von Aktienverläufen genutzt werden. Im Folgenden versuche ich den Zusammenhang zwischen den Sentimentwerten von Tweets und Aktienkursen aufzuzeigen; dies nur rudimentär über einen relativ kurzen Zeitraum und mit täglichen Werten. Untersucht wird das öffentlich-präsente Unternehmen Boeing und Abbvie, das weniger im Rampenlicht steht. Spoiler: Ein Zusammenhang lässt sich (in dieser Untersuchung) nicht feststellen.
Der Verlauf der Anzahl an Tweets zeigt eine große Volatilität mit einigen Hochpunkten. Es wird sichtbar, dass über Boeing sehr viel öfter getweetet wird. Es wird auch sichtbar, dass ich an einigen Tagen Ende Juni keine Tweets zu Boeing gesammelt habe.
Betrachten wir die jeweils häufigsten Begriffe in den Tweets zu den beiden Firmen so sehen wir den Unterschied zwischen den Firmen. Es wird deutlich, dass über Abbvie als Pharma- und Boeing als Luftfahrtunternehmen thematisch unterschiedlich geschrieben wird.
Auch die Wahrnemung der beiden Firmen ist unterschiedlich. Im folgenden wird die Anzahl der negativen und positiven Wörter vom Abgleich mit dem bing-Lexikon angezeigt, deren Differenz den Sentimentwert Bing ergeben. Der Afinn-Sentimentwert ergibt sich wiederum aus der Summe der Scores von -5 bis 5, welche Signalwörtern zugeordnet sind. Angezeigt wird der absolute Wert (ohne diesen zB mit der Anzahl an Tweets oder Begriffen zu normieren), um auch die Häufigkeit der Nennungen und Emotionen einzufangen; je häufiger positiv über eine Firma geschrieben wird, desto relevanter diese Tatsache.
Es wird sichtbar, dass über Abbvie - als möglicher Hersteller eines Covid19-Impfstoffes - positiv geschrieben wird. Die Entwicklung des Scores mit dem Bing und Afinn-Lexicon ist ähnlich; bei Afinn ist der Verlauf ausgeprägter und besser sichtbar. Über Boeing wird hingegen vor allem negativ geschrieben; wohl auch wegen den anhaltenden Problemen beim 737 Max. Auch hier ist der Verlauf des Sentimentwerts sichtbar.
Ein weiteres ist das NRC-Lexikon, welches Begriffen bestimmten Emotionen zuordnet, als auch einen eigenen Sentimentwert herausgibt; in der Grafik dargestellt zusammen mit der Anzahl der positiven und negativen Wörter. "trust" ist die jeweils am häufigsten vertretene Emotion.
Einen (signifikanten) Zusammenhang mit dem Aktienkurs lässt sich für Abbvie nicht feststellen. Hier der Verlauf der Sentimentwerte und des Aktienkurses:
Zwei signifikante und interessante Zusammenhänge lassen sich in den Daten aber finden. So gibt es einen negativen Zusammenhang zwischen dem Handelsvolumen und dem NRC-Sentimentwert:
Bei Boeing sieht das Schaubild mit Sentimentwerten und Aktienkurs wiefolgt aus:
Hier gibt es nur einen (interessanten) signifikanten Zusammenhang:
Zwar gibt es bei beiden Firmen Zusammenhänge, doch scheinen diese eher zufällig zu sein. Tatsächlich könnte eine stündliche Untersuchung interessanter sein; dafür sind die eingesetzten Pakete quantmod (Aktiendaten) und rtweet (Twitterdaten) aber nicht ausgelegt. Einen wirklichen Zusammenhang zwischen Sentimentwerten und den jeweiligen Aktienkursen lässt sich in dieser Untersuchung nicht feststellen.
Und hier noch der Code in RStudio
library(rtweet)
library(ggplot2)
library(tidytext)
library(viridis)
library(quantmod)
library(lubridate)
library(tidyverse)
library(dplyr)
library(reshape)
library(Hmisc)
library(corrplot)
library(gridExtra)
# Zugang zur Twitter-API
get_token()
# Twitterdaten laden
#tweets_abbvie <- search_tweets(q = "abbvie", n = 18000, include_rts = FALSE, lang = "en") #ausgeführt 27.5.
#tweets_boeing <- search_tweets(q = "boeing", n = 18000, include_rts = FALSE, lang = "en") #ausgeführt 27.5.
tweets_data_prep_abbvie <- tweets_data_abbvie %>%
mutate(tweet_number = row_number()) %>%
select(tweet_number, text, created_at)
tweets_data_prep_boeing <- tweets_data_boeing %>%
mutate(tweet_number = row_number()) %>%
select(tweet_number, text, created_at)
tweets_data <- bind_rows(tweets_data_prep_abbvie %>%
mutate(source = "Abbvie"),
tweets_data_prep_boeing %>%
mutate(source = "Boeing")) %>%
distinct() %>%
as_tibble() %>%
mutate(text = str_replace_all(text, "[^\x01-\x7F]", ""),
text = str_replace_all(text, "\\.|[[:digit:]]+", ""),
text = str_replace_all(text, "https|amp|t.co", ""))
# Plot 1 - zeitl. Verlauf der Tweets
tweets_number <- tweets_data %>%
mutate(created_at = as.Date(created_at, format="%m/%d/%Y")) %>%
group_by(created_at) %>%
count(created_at, source)
tweets_number %>%
ggplot(aes(x=created_at, y=n, colour=source))+
geom_line() +
facet_grid(source~., scales="free") +
theme_minimal() +
labs(
x = NULL, y = NULL,
title = paste("Anzahl an Tweets zu Abbvie & Boeing"),
subtitle = ("in englischer Sprache, tägliche Werte"),
caption = "Plot1")
# Plot 2 - die häufigsten Begriffe
custom_stop_words <- bind_rows(tibble(word = c("boeing", "tco", "abbvie", "abbv", "abbvie's", "ft", "ba", "faa", "fda"),
lexicon = c("custom")),
stop_words)
tweets_data_token <- tweets_data %>%
unnest_tokens(word, text) %>%
anti_join(custom_stop_words, by = "word")
plot1 <- tweets_data_token %>%
filter(source=="Abbvie") %>%
count(word, source, sort = TRUE) %>%
top_n(20) %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(x = word, y = n, fill = word))+
geom_col(show.legend = FALSE) +
facet_grid(~source, scales="free") +
coord_flip() +
theme_minimal() +
scale_fill_viridis(discrete = TRUE, option="cividis") +
labs(
x = NULL, y = NULL,
caption = " ")
plot2 <- tweets_data_token %>%
filter(source=="Boeing") %>%
count(word, source, sort = TRUE) %>%
top_n(20) %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(x = word, y = n, fill = word))+
geom_col(show.legend = FALSE) +
facet_grid(~source, scales="free") +
coord_flip() +
theme_minimal() +
scale_fill_viridis(discrete = TRUE, option="cividis") +
labs(
x = NULL, y = NULL,
caption = "Plot 2")
grid.arrange(plot1, plot2, ncol=2, nrow=1, top = "häufigste Begriffe der Tweets")
# Plot 3 - Sentimentwerte
dat_sentiment1 <- tweets_data_token %>%
group_by(Date=floor_date(created_at, "1 day"), source) %>%
inner_join(get_sentiments("bing"), by="word") %>%
count(Date, sentiment) %>%
spread(sentiment, n, fill = 0) %>%
mutate(sentiment_bing = positive - negative) %>%
`colnames<-`(c("Date","source","negative_bing","positive_bing","sentiment_bing")) %>%
ungroup() %>%
mutate(Date = as.Date(Date))
dat_sentiment2 <- tweets_data_token %>%
group_by(Date=floor_date(created_at, "1 day"), source) %>%
inner_join(get_sentiments("afinn"), by="word") %>%
summarise(sentiment_afinn = sum(value)) %>%
ungroup() %>%
mutate(Date = as.Date(Date))
dat_sentiment <- left_join(dat_sentiment1, dat_sentiment2, by=c("Date","source"))
dat_sentiment %>%
as.data.frame() %>%
melt(., id.vars=c("Date", "source")) %>%
ggplot(aes(x=Date, y=value, col=variable)) +
geom_line(size=0.2) +
geom_smooth(se=FALSE) +
geom_hline(aes(yintercept = 0), colour="grey") +
facet_grid(vars(source), scales="free") +
theme_minimal() +
labs(
x = NULL , y=NULL,
title = paste("Sentimentwerte der Tweets zu Abbvie & Boeing"),
subtitle = ("in englischer Sprache, tägliche Werte"),
caption = "Plot3")
# Plot 4 - Emotionen
dat_sentiment3 <- tweets_data_token %>%
group_by(Date=floor_date(created_at, "1 day"), source) %>%
inner_join(get_sentiments("nrc"), by="word") %>%
count(Date, sentiment) %>%
spread(sentiment, n, fill = 0) %>%
mutate(sentiment_nrc = positive - negative) %>%
ungroup() %>%
mutate(Date = as.Date(Date))
dat_sentiment3 %>%
as.data.frame() %>%
melt(., id.vars=c("Date", "source")) %>%
mutate(category = ifelse(variable %in% c("anger", "anticipation", "disgust", "fear", "joy", "sadness", "surprise", "trust"), 'emotion', 'sentiment')) %>%
ggplot() +
geom_line(data = . %>% filter(variable == "sentiment_nrc"), aes(x=Date, y=value, colour=variable), size=0.2) +
geom_line(data = . %>% filter(variable != "sentiment_nrc"), aes(x=Date, y=value, colour=variable), size=0.1) +
geom_smooth(data = . %>% filter(variable == "sentiment_nrc"), aes(x=Date, y=value, colour=variable), se=FALSE, size=1.2, n=50) +
geom_smooth(data = . %>% filter(variable != "sentiment_nrc"), aes(x=Date, y=value, colour=variable), se=FALSE, size=0.5, n=50) +
geom_hline(aes(yintercept = 0), colour="grey") +
facet_grid(vars(source), vars(category), scales="free") +
scale_size(guide="none") +
scale_fill_viridis(option="magma") +
theme_minimal() +
labs(
x = NULL , y=NULL,
title = paste("Emotionen der Tweets zu Abbvie & Boeing"),
subtitle = ("in englischer Sprache, tägliche Werte"),
caption = "Plot4")
# Aktiendaten & Sentimentwerte
stocks <- c("ABBV","BA")
getSymbols(stocks,src="yahoo", from="2020-05-19")
stock_abbvie <- data.frame(date=index(ABBV), coredata(ABBV$ABBV.Adjusted), coredata(ABBV$ABBV.Close),Volume=coredata(ABBV$ABBV.Volume), source="Abbvie") %>%
`colnames<-`(c("date", "Adjusted", "Close", "Volume", "source")) %>%
select("date","source","Adjusted", "Close", "Volume")
stock_boeing <- data.frame(date=index(BA), coredata(BA$BA.Adjusted), coredata(BA$BA.Close), coredata(BA$BA.Volume), source="Boeing") %>%
`colnames<-`(c("date", "Adjusted", "Close", "Volume", "source"))
dat_sentiment <- left_join(dat_sentiment, dat_sentiment3, by=c("Date","source"))
joined_data <- merge(stock_abbvie, stock_boeing, all=TRUE) %>%
left_join(., dat_sentiment, by=c("date"="Date", "source"))
# Korrelation Abbvie
joined_data_Abbvie <- joined_data %>%
filter(source=="Abbvie")
joined_data_Abbvie %>%
select_if(is.numeric) %>%
cor(., use="complete.obs") %>%
round(., 3) %>%
corrplot(., type = "upper", tl.col = "black", tl.srt = 45)
#Positive correlations in blue, negative in red color intensity & size of circle proportional to correlation coefficients
joined_data_Abbvie %>%
select_if(is.numeric) %>%
as.matrix() %>%
rcorr()
# Plot 5 - Zusammenhang Abbvie
joined_data_Abbvie %>%
select(date, Adjusted, sentiment_bing, sentiment_afinn, sentiment_nrc) %>%
as.data.frame() %>%
melt(., id.vars=c("date")) %>%
mutate(category = ifelse(variable %in% c("sentiment_bing", "sentiment_afinn", "sentiment_nrc"), 'sentiment', 'stock')) %>%
filter(complete.cases(.)) %>%
ggplot(aes(x=date, y=value, col=variable)) +
geom_line(n=30, size=0.2) +
geom_smooth(se=FALSE) +
theme_minimal() +
facet_grid(category~., scales="free") +
labs(
x=NULL, y=NULL,
title = paste("Abbvie - Aktienkurs & Twitter-Sentiment"),
subtitle = paste("tägliche Werte"),
caption = "Plot 5")
# Plot 6 - Zusammenhang Abbvie
Korr <- cor.test(joined_data_Abbvie$Volume, joined_data_Abbvie$sentiment_nrc, use="complete.obs") # Korrelation
ylim.primary <- c(0, ceiling(max(joined_data_Abbvie$Volume/1000000)))
ylim.secondary <- c(0, ceiling(max(joined_data_Abbvie$sentiment_nrc)))
b_1 <- diff(ylim.primary)/diff(ylim.secondary)
a_1 <- b_1*(ylim.primary[1] - ylim.secondary[1])
plot1 <- ggplot(joined_data_Abbvie, aes(x = date, y = Volume/1000000)) +
geom_line(color="#3399FF", size=0.2) +
geom_smooth(se=FALSE)+
geom_line(aes(y = a_1 + sentiment_nrc*b_1), color = "#404040", size=0.2) +
geom_smooth(aes(y = a_1 + sentiment_nrc*b_1), se=FALSE, color = "#404040")+
scale_y_continuous("Volume [mio]", sec.axis = sec_axis(~ (. - a_1)/b_1, name = "sentiment NRC")) +
theme_classic()+
theme(axis.line.y.right = element_line(color = "#404040"),
axis.ticks.y.right = element_line(color = "#404040"),
axis.text.y.right = element_text(color = "#404040"),
axis.title.y.right = element_text(color = "#404040")) +
theme(axis.line.y.left = element_line(color = "#0080FF"),
axis.ticks.y.left = element_line(color = "#0080FF"),
axis.text.y.left = element_text(color = "#0080FF"),
axis.title.y.left = element_text(color = "#0080FF")) +
labs(
x=NULL,
subtitle = paste("Korrelation:", round(Korr$estimate,4), " & p-Value:", format.pval(Korr$p.value, digits = 4, nsmall = 3, eps = 0.001)))
Korr <- cor.test(joined_data_Abbvie$Adjusted, joined_data_Abbvie$anger, use="complete.obs") # Korrelation
ylim.primary <- c(0, ceiling(max(joined_data_Abbvie$Adjusted)))
ylim.secondary <- c(0, ceiling(max(joined_data_Abbvie$anger)))
b_2 <- diff(ylim.primary)/diff(ylim.secondary)
a_2 <- b_2*(ylim.primary[1] - ylim.secondary[1])
plot2 <- ggplot(joined_data_Abbvie, aes(x = date, y = Adjusted)) +
geom_line(color="#3399FF", size=0.2) +
geom_smooth(se=FALSE)+
geom_line(aes(y = a_2 + anger*b_2), color = "#404040", size=0.2) +
geom_smooth(aes(y = a_2 + anger*b_2), se=FALSE, color = "#404040")+
scale_y_continuous("Adjusted", sec.axis = sec_axis(~ (. - a_2)/b_2, name = "anger")) +
theme_classic()+
theme(axis.line.y.right = element_line(color = "#404040"),
axis.ticks.y.right = element_line(color = "#404040"),
axis.text.y.right = element_text(color = "#404040"),
axis.title.y.right = element_text(color = "#404040")) +
theme(axis.line.y.left = element_line(color = "#0080FF"),
axis.ticks.y.left = element_line(color = "#0080FF"),
axis.text.y.left = element_text(color = "#0080FF"),
axis.title.y.left = element_text(color = "#0080FF")) +
labs(
x=NULL,
subtitle = paste("Korrelation:", round(Korr$estimate,4), " & p-Value:", format.pval(Korr$p.value, digits = 4, nsmall = 3, eps = 0.001)),
caption = "Plot 6")
grid.arrange(plot1, plot2, ncol=1, nrow=2, top = "Abbvie - Aktienkurs & Emotionen auf Twitter")
# Korrelation Boeing
joined_data_Boeing <- joined_data %>%
filter(source=="Boeing")
joined_data_Boeing %>%
select_if(is.numeric) %>%
cor(., use="complete.obs") %>%
round(., 3) %>%
corrplot(., type = "upper", tl.col = "black", tl.srt = 45)
#Positive correlations in blue, negative in red color intensity & size of circle proportional to correlation coefficients
joined_data_Boeing %>%
select_if(is.numeric) %>%
as.matrix() %>%
rcorr()
# Plot 7 - Zusammenhang Boeing
joined_data_Boeing %>%
select(date, Adjusted, sentiment_bing, sentiment_afinn, sentiment_nrc) %>%
as.data.frame() %>%
melt(., id.vars=c("date")) %>%
mutate(category = ifelse(variable %in% c("sentiment_bing", "sentiment_afinn", "sentiment_nrc"), 'sentiment', 'stock')) %>%
filter(complete.cases(.)) %>%
ggplot(aes(x=date, y=value, col=variable)) +
geom_line(n=30, size=0.2) +
geom_smooth(se=FALSE) +
facet_grid(category~., scales="free") +
theme_minimal() +
labs(
x=NULL, y=NULL,
title = paste("Boeing - Aktienkurs & Twitter-Sentiment"),
caption = "Plot 7")
# Plot 8 - Zusammenhang Abbvie
Korr <- cor.test(joined_data_Boeing$Adjusted, joined_data_Boeing$sentiment_afinn, use="complete.obs") # Korrelation
ylim.primary <- c(0, ceiling(max(joined_data_Boeing$Adjusted)))
ylim.secondary <- c(min(joined_data_Boeing$sentiment_afinn, na.rm=TRUE),max(joined_data_Boeing$sentiment_afinn, na.rm=TRUE))
b <- diff(ylim.primary)/diff(ylim.secondary)
a <- b*(ylim.primary[1] - ylim.secondary[1])
ggplot(joined_data_Boeing, aes(x = date, y = Adjusted)) +
geom_line(color="#3399FF", size=0.2) +
geom_smooth(se=FALSE)+
geom_line(aes(y = a + sentiment_afinn*b), color = "#404040", size=0.2) +
geom_smooth(aes(y = a + sentiment_afinn*b), se=FALSE, color = "#404040")+
scale_y_continuous("Adjusted", sec.axis = sec_axis(~ (. - a_2)/b_2, name = "sentiment Afinn")) +
theme_classic()+
theme(axis.line.y.right = element_line(color = "#404040"),
axis.ticks.y.right = element_line(color = "#404040"),
axis.text.y.right = element_text(color = "#404040"),
axis.title.y.right = element_text(color = "#404040")) +
theme(axis.line.y.left = element_line(color = "#0080FF"),
axis.ticks.y.left = element_line(color = "#0080FF"),
axis.text.y.left = element_text(color = "#0080FF"),
axis.title.y.left = element_text(color = "#0080FF")) +
labs(
x=NULL,
title = paste("Boeing - Aktienkurs & Emotionen auf Twitter"),
subtitle = paste("Korrelation:", round(Korr$estimate,4), " & p-Value:", format.pval(Korr$p.value, digits = 4, nsmall = 3, eps = 0.001)),
caption = "Plot 8")
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.
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.