#srfarena: Was regt Diskussionen an und wer führt sie?
Jonas Glatthard
16.6.2019
Datengrundlage
Als erstes müssen wir an die Daten kommen. Die Twitter API funktioniert zwar gut, gibt aber nur Zugriff auf die Tweets der letzten sieben Tage - ausser, man bezahlt viel Geld. Ich will mehr Daten, habe für dieses Projekt aber kein Budget im vierstelligen Bereich. Hierbei hilft das Python-Tool twitterscraper. Damit können wir die Tweets mit #srfarena seit Juni 2012 scrapen. Die folgenden Bash-Befehle speichern ein .csv file ab, das wir danach einfach in R einlesen können. Damit die einzelnen Sessions nicht zu gross und somit anfällig auf Fehler sind, suche ich die einzelnen Jahre separat.
twitterscraper '#srfarena' --poolsize=50 -bd 2012-06-04 -ed 2013-06-03 --output=/Users/Jonas/Desktop/Twitter/2012_tweets.csv --csv
twitterscraper '#srfarena' --poolsize=50 -bd 2013-06-04 -ed 2014-06-03 --output=/Users/Jonas/Desktop/Twitter/2013_tweets.csv --csv
twitterscraper '#srfarena' --poolsize=50 -bd 2014-06-04 -ed 2015-06-03 --output=/Users/Jonas/Desktop/Twitter/2014_tweets.csv --csv
twitterscraper '#srfarena' --poolsize=50 -bd 2015-06-04 -ed 2016-06-03 --output=/Users/Jonas/Desktop/Twitter/2015_tweets.csv --csv
twitterscraper '#srfarena' --poolsize=50 -bd 2016-06-04 -ed 2017-06-03 --output=/Users/Jonas/Desktop/Twitter/2016_tweets.csv --csv
twitterscraper '#srfarena' --poolsize=50 -bd 2017-06-04 -ed 2018-06-03 --output=/Users/Jonas/Desktop/Twitter/2017_tweets.csv --csv
twitterscraper '#srfarena' --poolsize=50 -bd 2018-06-04 --output=/Users/Jonas/Desktop/Twitter/2018_tweets.csv --csv Nun können wir die Daten mit R öffnen und einen ersten Blick darauf werfen, was alles enthalten ist.
library(tidyverse)
library(readtext)
library(quanteda)tweets <- readtext("~/Desktop/Twitter/*.csv", text_field = "text")
head(tweets)## readtext object consisting of 6 documents and 9 docvars.
## # Description: df[,11] [6 × 11]
## doc_id text user fullname tweet.id timestamp url likes replies
## * <chr> <chr> <chr> <chr> <dbl> <chr> <chr> <int> <int>
## 1 2012_… "\"E… ingi… Franzis… 3.19e17 2013-04-… /ing… 0 0
## 2 2012_… "\"D… UrsW… Urs Wie… 2.79e17 2012-12-… /Urs… 0 0
## 3 2012_… "\"N… ingi… Franzis… 3.01e17 2013-02-… /ing… 0 0
## 4 2012_… "\"d… andr… Andri S… 3.00e17 2013-02-… /and… 1 1
## 5 2012_… "\"@… bwer… beatric… 3.00e17 2013-02-… /bwe… 0 0
## 6 2012_… "\"#… petr… Schelle… 3.00e17 2013-02-… /pet… 0 0
## # … with 2 more variables: retweets <int>, html <chr>Wurden auch alle Tweets erwischt? Mit einem Plot über die Zeit sollte erkennbar sein, ob es grössere Lücken gibt.
num_days <- max(as.Date(tweets$timestamp)) - min(as.Date(tweets$timestamp)) + 1
ggplot(tweets, aes(x = as.Date(timestamp))) +
geom_histogram(bins = num_days)
Um die Anfangs- und Endpunkte der Suche herum (jeweil mitte Jahr) scheint es immer Lücken zu haben. Die kleinen Lücken zum Jahreswechsel dürften dagegen davon kommen, dass in dieser Zeit Sendepause ist. Eine kurze Suche mit #srfarena in Twitters eigener Suchkonsole zeigt, dass dann wirklich kaum unter diesem Hashtag getweeted wird. Im Sommer (Juli) gibt es ebenfalls eine Sendepause, die Lücke wirkt jedoch etwas gross. Daher scrapen wir nach diesen Zeiträumen nochmals separat.
twitterscraper '#srfarena' --poolsize=20 -bd 2013-05-04 -ed 2013-08-03 --output=/Users/Jonas/Desktop/Twitter/gap/2013_tweets_gap.csv --csv
twitterscraper '#srfarena' --poolsize=20 -bd 2014-05-04 -ed 2014-08-03 --output=/Users/Jonas/Desktop/Twitter/gap/2014_tweets_gap.csv --csv
twitterscraper '#srfarena' --poolsize=20 -bd 2015-05-04 -ed 2015-08-03 --output=/Users/Jonas/Desktop/Twitter/gap/2015_tweets_gap.csv --csv
twitterscraper '#srfarena' --poolsize=20 -bd 2016-05-04 -ed 2016-08-03 --output=/Users/Jonas/Desktop/Twitter/gap/2016_tweets_gap.csv --csv
twitterscraper '#srfarena' --poolsize=20 -bd 2017-05-04 -ed 2017-08-03 --output=/Users/Jonas/Desktop/Twitter/gap/2017_tweets_gap.csv --csv
twitterscraper '#srfarena' --poolsize=20 -bd 2018-05-04 -ed 2018-08-03 --output=/Users/Jonas/Desktop/Twitter/gap/2018_tweets_gap.csv --csvDiese Daten können wir mit den bereits geladenen kombinieren und erneut plotten.
tweets_gaps <- readtext("~/Desktop/Twitter/gap/*.csv", text_field = "text")
tweets_comb <- rbind(tweets, tweets_gaps)
num_days_comb <- max(as.Date(tweets_comb$timestamp)) - min(as.Date(tweets_comb$timestamp)) + 1
ggplot(tweets_comb, aes(x = as.Date(timestamp))) +
geom_histogram(bins = num_days_comb)
Nichts hat sich geändert, daher ist wohl wirklich die Sendepause für die Einbrüche der Twitterfrequenz verantwortlich. Es lohnt sich darum nicht, möglicherweise nun mehrfache Tweets zu entfernen, sondern wir arbeiten mit dem tweets dataframe weiter.
Allerdings wird ebenfalls ersichtlich, dass in den ersten Jahren des Datensatzes noch spärlich zur Arena getweeted wurde. Um einen aussagekräftigen Vergleich zu ermöglichen, legen wir den Fokus auf den Zeitraum von 2016-2018.
tweets %>%
.[! as.Date(.$timestamp) < "2016-01-01",]%>%
.[! as.Date(.$timestamp) > "2019-02-23",] %>%
.[! is.na(.$text),] %>%
saveRDS("~/Desktop/Uni/Polito/DJ/Blogbeitrag/data/tweets_dj.rds")SRF-Arena Untertitel
Die Daten von SRF-Arena wurden uns für den Kurs zur Verfügung gestellt.
arena <- readtext("~/Desktop/Uni/Polito/DJ/Textanalyse/02-SRF-Arena.csv")%>%
.[! as.Date(.$datum) < "2016-01-01",]
names(arena)## [1] "doc_id" "text" "datum"
## [4] "sendungstitel" "moderation" "sendungsdeskriptoren"Der Korpus umfasst die Untertitel aller Arenasendungen vom Juni 2010 bis im Februar 2019. Der Grund, wieso der Zeitraum für das Scrapen der Tweets später ansetzt, liegt daran, dass die SRF-Arena erst um 2013 auf Twitter aktiv wurde.
Verknüpfung von Tweets und Arenasendungen
tweets <- readRDS("~/Desktop/Uni/Polito/DJ/Blogbeitrag/data/tweets_dj.rds")Welche Tweets gehören zu welcher Arenasendung? Um das zu bestimmen, schauen wir uns an einem Beispiel an, wie die Tweets über die Wochentage verteilt sind
tweets_time <- tweets %>%
subset(as.Date(tweets$timestamp) > "2018-11-01" & as.Date(tweets$timestamp) < "2018-11-30")
num_days <- max(as.Date(tweets_time$timestamp)) - min(as.Date(tweets_time$timestamp)) + 1
ggplot(tweets_time, aes(x = as.Date(timestamp))) +
geom_histogram(bins = num_days)
Die meisten Tweets gibt es am Freitag. Das überrascht nicht, denn dann wird die Sendung jeweils ausgestrahlt. Danach flacht die Diskussion meist ab. Bis am Mittwoch gibt es dann beinahe keine Tweets mehr. Am Donnerstag gibt es meist einen (kleinen) Anstieg. Wahrschinlich, da zu diesem Zeitpunkt die “Werbung” und Gästeankündigung für die nächste Sendung läuft.
Es schein daher sinnvoll, Tweets von Donnerstag bis Mittwoch zu einer Sendung zu zählen.
library(lubridate)
tweets$wday <- as.character(wday(as.Date(tweets$timestamp), label = TRUE))
tweets$arena_date <- NA
tweets$arena_date[tweets$wday == "Mo"] <- as.character(as.Date(tweets$timestamp[tweets$wday == "Mo"])-3)
tweets$arena_date[tweets$wday == "Di"] <- as.character(as.Date(tweets$timestamp[tweets$wday == "Di"])-4)
tweets$arena_date[tweets$wday == "Mi"] <- as.character(as.Date(tweets$timestamp[tweets$wday == "Mi"])-5)
tweets$arena_date[tweets$wday == "Do"] <- as.character(as.Date(tweets$timestamp[tweets$wday == "Do"])+1)
tweets$arena_date[tweets$wday == "Fr"] <- as.character(as.Date(tweets$timestamp[tweets$wday == "Fr"]))
tweets$arena_date[tweets$wday == "Sa"] <- as.character(as.Date(tweets$timestamp[tweets$wday == "Sa"])-1)
tweets$arena_date[tweets$wday == "So"] <- as.character(as.Date(tweets$timestamp[tweets$wday == "So"])-2)
tweets_ar <- arena %>%
select(datum, sendungstitel, sendungsdeskriptoren) %>%
rename(arena_date = datum)%>%
merge(tweets)
saveRDS(tweets_ar, "~/Desktop/Uni/Polito/DJ/Blogbeitrag/data/tweets_ar.rds")Wann wird über #srfarena getweeted?
Einen groben Überblick, an welchen Wochentagen über die Arena getweeted wird, konnten wir vorhin bereits gewinnen. Wie sieht das etwas detaillierter aus? Eine Heatmap mit Wochentagen und Stunden scheint dafür eine geeignete Visualisierung zu sein. Da die Ansammlung an Tweets am Freitag Abend sehr viel grösser ist als zu allen anderern Zeitpunkten, wird die Farbskalierung so angepasst, dass der dunkelste Farbton bereits vor dem Maximum an Tweets angezeigt wird. So bleiben feinere Unterschiede sichtbar.
df_datetime <- tweets_ar%>%
select(timestamp, wday)
# Stunde extrahieren
df_datetime$timestamp <- as.POSIXct(df_datetime$timestamp)
df_datetime$wday <- wday(df_datetime$timestamp, label = TRUE)
df_datetime$hour <- df_datetime$timestamp%>%
str_extract("[:digit:]{2}(?=\\:[:graph:]{5})")
# Tweets pro Wochentags-Stunde
df_sums <- group_by(df_datetime, wday, hour)%>%
summarise()
df_sums$tweets <- NA
for(i in 1:nrow(df_sums)){
tweets_i <- df_datetime[df_datetime$wday == df_sums$wday[i] & df_datetime$hour == df_sums$hour[i] , ]
df_sums$tweets[i] <- nrow(tweets_i)
}
# Wochentage ordnen
df_sums$wday <- ordered(as.factor(df_sums$wday), levels = c("Mo", "Di", "Mi", "Do", "Fr", "Sa", "So"))
df_sums$tweets[df_sums$wday == "Mi"] <- df_sums$tweets[df_sums$wday == "Mi"]/2
# Heatmap ohne Legende
p_heatmap <- ggplot(df_sums, mapping = aes(x = wday, y = as.numeric(hour),
fill = tweets)) +
geom_tile(colour="white") +
scale_fill_gradient(low = "#ffffff", high="#0484d3",
name="Anzahl Tweets",
# Legende anpassen
rescaler = function(x, to = c(0, 1), from = NULL) {
ifelse(x<2000,
scales::rescale(x,
to = to,
from = c(min(x, na.rm = TRUE), 2000)
),
1)})+
scale_y_reverse(breaks=c(23:0), labels=c(23:0), expand = c(0,0))+
scale_x_discrete(expand = c(0,0), position = "top") +
labs(title = "Anzahl Tweets pro Wochentag und Stunde", y = "Uhrzeit", x = "",
subtitle = "#srfarena, 2016-2018") +
theme_light()+
theme(panel.grid = element_blank(),
panel.border = element_blank(),
axis.ticks = element_blank())+
theme(legend.position = "")
# Plot für Legende
q <- ggplot(df_sums, mapping = aes(x = wday, y = as.numeric(hour),
fill = tweets)) +
geom_tile(colour="white") +
scale_fill_gradient(low = "#ffffff", high="#0484d3",
rescaler = function(x, to = c(0, 1), from = NULL) {
ifelse(x<=2000,
scales::rescale(x,
to = to,
from = c(min(x, na.rm = TRUE), 2500)),
1)},
breaks=c(0,1000,2000),
labels=c('0','1000','>2500'),
limits=c(0,2000),
name='Anzahl Tweets')+
scale_y_reverse(breaks=c(23:0), labels=c(23:0), expand = c(0,0))+
scale_x_discrete(expand = c(0,0), position = "top") +
labs(title = "Anzahl Tweets pro Wochentag und Stunde", y = "Uhrzeit", x = "",
subtitle = "#srfarena, 2016-2018")
# Legende extrahieren
library(gridExtra)
library(grid)
get_legend<- function(a.gplot){
tmp <- ggplot_gtable(ggplot_build(a.gplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
legend <- get_legend(q)
# Legende und Heatmap zusammenfügen
grid.arrange(p_heatmap, legend, widths=c(10,5))
## Welche Sendungen wurden am meisten kommentiert?
sendung_tweets <- as.data.frame(table(tweets_ar$sendungstitel))
names(sendung_tweets) <- c("sendungstitel", "anzahl_tweets")
arena <- merge(arena, sendung_tweets)
arena_t15 <- arena[order(arena$anzahl_tweets, decreasing = T),]%>%
head(15)
# Plot
ggplot(arena_t15, aes(x=reorder(sendungstitel, anzahl_tweets), y = anzahl_tweets)) +
geom_bar(stat = "identity", fill = "#1DA1F2") +
labs(y= "Anzahl Tweets", x = "", title ="Twitter-Resonanz nach Sendung",
subtitle= "Top 15 Sendungen mit den meisten Tweets: 2016-2018")+
theme_minimal()+
theme(text = element_text(family = 'Arial'))+
coord_flip()
Welche Themen kommen am häufigsten vor?
Die Einteilung der Themen geschieht “manuell”, d.h. nach eigener Einschätzung aufgrund der Titel und der Sendungsdeskriptoren.
arena$thema <- c("Gesundheits- und Sozialpolitik", "Migration", "Gesundheits- und Sozialpolitik", "Gesundheits- und Sozialpolitik", "Wirtschaft",
"Migration", "Wirtschaft", "Wirtschaft", "Wirtschaft", "Umwelt und Energie",
"Verkehr", "Medienpolitik", "Medienpolitik", "Gesundheits- und Sozialpolitik", "Umwelt und Energie",
"Umwelt und Energie", "Gesundheits- und Sozialpolitik", "Migration", "Migration", "Wirtschaft",
"Wirtschaft", "Verkehr", "Wirtschaft", "Landwirtschaft", "Gesundheits- und Sozialpolitik",
"Gleichstellung", "Wirtschaft", "Verteidigung und Sicherheit", "Medienpolitik", "Auslandbeziehungen",
"Verkehr", "Gesundheits- und Sozialpolitik", "Wirtschaft", "Umwelt und Energie", "Verkehr",
"Wirtschaft", "Auslandbeziehungen", "Wahlen und Parteien", "Wahlen und Parteien", "Migration",
"Religion und Glaube", "Migration", "Verteidigung und Sicherheit", "Auslandbeziehungen", "Landwirtschaft",
"Auslandbeziehungen", "Auslandbeziehungen", "Verteidigung und Sicherheit", "Religion und Glaube", "Migration",
"Wahlen und Parteien", "Auslandbeziehungen", "Auslandbeziehungen", "Migration", "Auslandbeziehungen",
"Verkehr", "Umwelt und Energie", "Umwelt und Energie", "Wahlen und Parteien", "Auslandbeziehungen",
"Wirtschaft", "Migration", "Umwelt und Energie", "Verteidigung und Sicherheit", "Auslandbeziehungen",
"Wirtschaft", "Umwelt und Energie", "Gleichstellung", "Verteidigung und Sicherheit", "Wahlen und Parteien",
"Gesundheits- und Sozialpolitik", "Gleichstellung", "Migration", "Migration", NA,
"Gesundheits- und Sozialpolitik", "Wirtschaft", "Gesundheits- und Sozialpolitik", "Verteidigung und Sicherheit", "Wirtschaft",
"Medienpolitik", "Gesundheits- und Sozialpolitik", "Wirtschaft", "Gesundheits- und Sozialpolitik", "Auslandbeziehungen",
"Wirtschaft", "Wahlen und Parteien", "Auslandbeziehungen", "Medienpolitik", "Medienpolitik",
"Wahlen und Parteien", "Wahlen und Parteien", "Wahlen und Parteien", "Wirtschaft", "Auslandbeziehungen",
"Gesundheits- und Sozialpolitik", "Gesundheits- und Sozialpolitik", "Gesundheits- und Sozialpolitik", "Gesundheits- und Sozialpolitik", "Gesundheits- und Sozialpolitik",
"Religion und Glaube", "Religion und Glaube", "Auslandbeziehungen", "Auslandbeziehungen", "Wirtschaft",
"Auslandbeziehungen", "Gleichstellung", "Gleichstellung", "Gesundheits- und Sozialpolitik", "Gesundheits- und Sozialpolitik",
"Medienpolitik", "Gesundheits- und Sozialpolitik", "Verkehr", "Auslandbeziehungen","Auslandbeziehungen",
"Medienpolitik", "Auslandbeziehungen", "Verkehr", "Auslandbeziehungen", "Wirtschaft",
"Landwirtschaft", "Wahlen und Parteien", "Wahlen und Parteien", "Verteidigung und Sicherheit", "Gesundheits- und Sozialpolitik",
"Migration", "Gesundheits- und Sozialpolitik", "Gleichstellung", "Wahlen und Parteien", "Auslandbeziehungen",
"Migration", "Migration")Mit diesen Informationen kann ausgezählt werden, zu welchen Themen pro Sendung im Schnitt am meisten getweetet wird. Zu jedem Tweet kann zudem das zugehörige Thema ausfindig gemacht werden.
# Wie viele Tweets zu welchem Thema?
themen <- as.data.frame(matrix(data = NA, nrow = length(unique(arena$thema)), ncol = 4))
names(themen) <- c("thema", "tweets", "sentiment", "sentiment_tw")
themen$thema <- unique(arena$thema)
themen <- themen[-13,]
for(i in themen$thema){
themen$tweets[themen$thema == i ] <- mean(na.omit(arena$anzahl_tweets[arena$thema == i ]))
}
saveRDS(arena, "~/Desktop/Uni/Polito/DJ/Blogbeitrag/data/arena.rds")
# Welche Tweets zu welchem Thema?
tweets_ar <- readRDS("~/Desktop/Uni/Polito/DJ/Blogbeitrag/data/tweets_ar.rds")
arena_m <- arena%>%
select(sendungstitel, thema)
tweets_ar <- merge(tweets_ar, arena_m)
saveRDS(tweets_ar, "~/Desktop/Uni/Polito/DJ/Blogbeitrag/data/tweets_ar.rds")Das sieht dann folgendermassen aus:
# Plot
ggplot(themen, aes(x=reorder(thema, tweets), y = tweets)) +
geom_bar(stat = "identity", fill = "#1DA1F2") +
labs(y= "Durchschnittliche Anzahl Tweets pro Sendung", x = "", title ="Twitter-Resonanz nach Thema",
subtitle= "2016-2018")+
theme_minimal()+
theme(text = element_text(family = 'Arial'))+
coord_flip()
Geschlechterverhältnis
Um das Geschlecht der User zu bestimmen, nutzen wir ein eigens dafür entwickeltes R-Package mit dem passenden Namen gender.
library(gender)
names <- unique(str_extract(tweets_ar$fullname, "^[:graph:]+"))
gender_test <- gender(names)
tweets_ar$name <- str_extract(tweets_ar$fullname, "^[:graph:]+")
gender_test_m <- gender_test%>%
select(name, gender)
tweets_gender <- merge(tweets_ar, gender_test_m)
frauenquote <- nrow(tweets_gender[tweets_gender$gender == "female",])/nrow(tweets_gender)
# [1] 0.2762473
# Geschlechterverhältnis pro Thema berechnen
themen$frauen <- NA
for(i in themen$thema){
gender <- as.data.frame(table(tweets_gender$gender[tweets_gender$thema == i]))
themen$frauen[themen$thema == i] <- gender$Freq[1]/(gender$Freq[1] + gender$Freq[2])
}
saveRDS(themen, "~/Desktop/Uni/Polito/DJ/Blogbeitrag/data/themen.rds")Da doch einige Namen mit diesem Prozess keinem Geschlecht zugeordnet werden können, steigt die Unsicherheit über die Prezision, je weniger Tweets zu einem Thema vorhanden sind. Daher vergleiche ich das Geschlechterverhältnis aller Tweets nur mit jenem zu Gleichstellungsthemen. Hier ist das Verhältnis besonders interessant, zudem sind einige Tweets dazu vorhanden.
f_anteil <- as.data.frame(matrix(NA, nrow=4,ncol =3))
names(f_anteil) <- c("thema", "Anteil", "Geschlecht")
f_anteil$thema <- c("Thema Gleichstellung", "Thema Gleichstellung","Alle Sendungen","Alle Sendungen")
f_anteil$Anteil <- c(themen$frauen[themen$thema == "Gleichstellung"], 1-themen$frauen[themen$thema == "Gleichstellung"], 0.2762473, 1-0.2762473)
f_anteil$Geschlecht <- as.factor(c("Frauen", "Männer", "Frauen", "Männer"))
f_anteil$Geschlecht <- relevel(f_anteil$Geschlecht, "Männer")
ggplot(f_anteil, aes(x=thema, y = Anteil, fill = Geschlecht)) +
geom_bar(stat = "identity") +
labs(y= "Anteil an Kommentaren", x = "", title ="Geschlechterverhältnis der Kommentierenden",
subtitle = "Tweets zu Arena-Sendungen 2016-2018")+
theme_minimal()+
theme(text = element_text(family = 'Arial'),
legend.title = element_blank())+
scale_y_continuous(labels = scales::percent)+
coord_flip()+
scale_fill_manual(values=c("#87CEFA", "#FFA07A"))+
guides(fill = guide_legend(reverse = TRUE))
Auswertung der Twitter-Bios
Herunterladen der Daten
Die User-Descriptions werden über die Twiter-API geholt.
# Verbindung zur Twitter API herstellen
setup_twitter_oauth(consumer_key = "consumer.key", consumer_secret ="consumer.secret",
access_token = "acces.token",
access_secret = "acces.secret")
# (nicht die richtigen Keys, hier nur als Beispiel)
#### User Informationen holen
# Twitternamen
user <- unique(tweets_ar$user)
# Über Twitter-API suchen
users <- lookupUsers(user)
# Zu dataframe umwandeln
df_users <- do.call("rbind", lapply(users, as.data.frame))Übersetzung
Nicht alle Bios sind in der selben Sprache verfasst. Ein weiteres R-package hilft, die Sprache zu identifieren. Dafür werden die Texte zuerst etwas gesäubert.
df_users$description_c <- df_users$description%>%
str_replace_all("https\\://t.co/[A-Za-z\\d]+|http://[A-Za-z\\d]+|&|<|>|RT|https|<[A-Za-z\\d]>|\\|and", "")%>%
str_replace_all("[^[:alpha:]]", " ")
df_users_clean <- df_users[! df_users$description_c == "",]
# Nicht alle Descriptions sind in derselben Sprache, doch welche sind es?
library(cldr)
languages <- detectLanguage(df_users_clean$description_c)
df_users_clean$language <- languages$detectedLanguageUm die Vergleichbarkeit zu ermöglichen, werden alle Texte, die nicht bereits in Englisch verfasst sind, ins Englische übersetzt. Das geschieht über Deepl.
library(RSelenium)
library(wdman)
# Selenium Server öffnen und Port Information holen
selServ <- selenium(jvmargs = c("-Dwebdriver.firefox.verboseLogging=true"), port = 4567L)
remDr <- remoteDriver(port = 4567L, browserName = "firefox") # driver
remDr$open() # firefox öffnen
remDr$navigate('https://www.deepl.com/translator') # zu deepL navigieren
ip <- remDr$findElement(using='css', '.lmt__source_textarea')
ip1 <- remDr$findElement(using='css', '.lmt__language_select--source')
ip2 <- remDr$findElement(using = 'css', '.lmt__language_select.lmt__language_select--target')
ip2$clickElement()
# Englisch aus Zielsprache auswählen
option <- remDr$findElement("css", "#dl_translator > div.lmt__sides_container > div.lmt__side_container.lmt__side_container--target > div.lmt__language_container > div > div > button:nth-child(2)")
option$clickElement()
# leerer character vector für Resultate
translated <- c()
# nur descriptions auswählen, die nicht englisch sind
t <- df_users_clean$description_c[!df_users_clean$language == "ENGLISH"]
# loop
for(i in 1:length(t)){
print(paste('Iteration:',i,'/ ', length(t)))
# Browser alle 30 Iterationen erneuern
if(is.integer(i/30)){
remDr$refresh()
Sys.sleep(30)
}
start_t <- Sys.time()
# übersetzen
ip$clickElement()
ip$sendKeysToElement(list(t[i])) # text zum input container senden
Sys.sleep(8)
tes<- remDr$findElement(using='css selector',".lmt__language_select--source")$getElementText()
if(any(tes=='?bersetze Englisch (erkannt)')) {
ip$clearElement() # input container leeren
# batch speichern
translated <- c(translated, t[i])
stop_t <- Sys.time()
print(paste('Timediff:', stop_t - start_t))
next(i)
}
{Sys.sleep(5)
# inject js: übersetzer Text holen
clsf <- remDr$executeScript(script = 'return $(".lmt__target_textarea").val();', args = list("dummy"))[[1]]
# falls (transl.) '...' (loading) beinhaltet, 10 Sekunden warten und nochmals versuchen
if(any(c('[...]', "") %in% clsf)) {
Sys.sleep(10)
clsf <- remDr$executeScript(script = 'return $(".lmt__target_textarea").val();', args = list("dummy"))[[1]]
}
ip$clearElement() # input container leeren
# batch speichern
translated <- c(translated, clsf)
stop_t <- Sys.time()
print(paste('Timediff:', stop_t - start_t))}
}
saveRDS(translated, "~/Desktop/Uni/Polito/DJ/blogbeitrag/Data/df_users_clean.rds")
saveRDS(df_users_clean, "~/Desktop/Uni/Polito/DJ/blogbeitrag/Data/df_users_clean.rds")
# browser schliessen
remDr$close()
# selenium server anhalten
selServ$stop()
# Übersetzte und bereits Englische descriptions wieder zusammenbringen
df_users_clean_en <- df_users_clean[df_users_clean$language == "ENGLISH",]
df_users_clean_tl <- df_users_clean[! df_users_clean$language == "ENGLISH",]
df_users_clean_tl$description_en <- translated
df_users_clean_en$description_en <- df_users_clean_en$description_c
df_users_clean_en <- rbind(df_users_clean_tl, df_users_clean_en)
saveRDS(df_users_clean_en, "~/Desktop/Uni/Polito/DJ/blogbeitrag/Data/df_users_clean_en.rds")Häufigste Wörter
# Allein stehende Buchstaben entfernen
df_users_clean_en$description_en <- df_users_clean_en$description_en%>%
str_replace_all("(?<=\\s)[:alpha:](?=\\s)", " ")
# quanteda-corpus erstellen
corpus_users <- corpus(df_users_clean_en, text_field = "description_en")
# document-feature-matrix erstellen, Stopwörter entfernen und Wörter stemmen
dfm_users <- corpus_users%>%
dfm(remove = stopwords("en"), remove_punct = TRUE)%>%
dfm_wordstem(language = "en")
# die häufigsten 20 Wörter herausgeben
top20words <- topfeatures(dfm_users, n = 20)%>%
data.frame(word=names(.), counts=.,row.names=NULL)
# Barplot mit den häufigsten Wörter
ggplot(top20words, aes(x=reorder(word, counts), y = counts)) +
geom_bar(stat = "identity", fill = "darkgrey") +
labs(y= "Anzahl Nennungen", x = "", title ="Top 20 Wörter in User-Beschrieben",
subtitle= "Twitter-User, die #srfarena genutzt haben, 2016-2018")+
theme_minimal()+
theme(text = element_text(family = 'Arial'))+
coord_flip()