-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy path02-setup_daten.Rmd
117 lines (99 loc) · 6.21 KB
/
02-setup_daten.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
# Setup und Daten {#SetupDaten}
## R-Markdown {#R-Markdown}
Ich bin eine passionierte R-Userin. Derzeit spielt diese Programmiersprache insbesondere im Rahmen meiner Lehrtätigkeit an der Universität Koblenz eine große Rolle. Dort unterrichte ich Statistik mit R für Studenten der BioGeowissenschaften. In der Regel verwende ich `ggplot`, weil mich die Stringenz der *"Grammar of Graphics"* überzeugt. Neuerdings begeistere ich mich jedoch zunehmend für interaktive Visualisierungen mit `plotly`.
Diese Beispielanalyse basiert auf [*R-Markdown-Dateien*](https://rmarkdown.rstudio.com/). Ich schätze R-Markdown, weil die Kombination von Fließtext, Code und Output eine für Andere gut nachvollziehbare Arbeitsweise und ein replizierbares Analyseergebnis gewährleistet. R-Markdown bietet vielfältige Ausgabeformate an. Hier wurden die R-Markdown-Dateien mit Hilfe des Paketes [bookdown](https://bookdown.org/) als gitbook gerendert. So kann ich auch die interaktiven Visualisierungen mit `plotly` nutzen. Gemeinsam mit `plotly` lade ich weitere Pakete in meinen workspace.
```{r setup, include = TRUE, message = FALSE, warning = FALSE}
# Pakete laden
library(bookdown)
library(htmltools)
library(httr)
library(jsonlite)
library(knitr)
library(lsa)
library(mclust)
library(plotly)
library(rvest)
library(stringr)
library(tidyverse)
library(tokenizers)
library(umap)
library(viridisLite)
library(xml2)
# r-markdown setup
knitr::opts_chunk$set(warning = FALSE, messages = FALSE)
```
## Daten {#Daten}
Im Rahmen meiner derzeitigen Tätigkeit als Expert Data Science bei pressrelations arbeite ich mit Zeitungsartikeln und Social-Media-Posts. In dieser Arbeitsprobe geht es hingegen um Reviews, die Obikunden auf [www.trustedshops.de](https://www.trustedshops.de/bewertung/info_X8BD75374EABBAC74ABF111D4CBF94A65.html?sort=date) hinterlassen haben. Typischerweise basieren Arbeitsproben auf Standardbeispieldatensätzen, wie wir sie von www.kaggle.com kennen. Ich habe mich hier bewusst gegen ein solches Standardbeispiel entschieden, um Ihnen ein möglichst realistisches Beispiel zu geben. Zu diesem Zwecke stelle ich mit dem ***Scraping*** eine Stichprobe zusammen, welche die ersten 50 Seiten einer nach dem Datum sortierten Abfrage enthält. Diese werden als anonymisierter Datensatz abgespeichert, der nur die analyserelevanten Variablen enthält.
```{r scraping, eval=FALSE, message=FALSE}
# Scraping
url <- "https://www.trustedshops.de/bewertung/info_X8BD75374EABBAC74ABF111D4CBF94A65.html?sort=date"
daten <- data.frame()
for (nr in 1:50){
url_page <- paste0(url, "&page=", nr)
site <- read_html(url_page) %>%
html_nodes("script[type='application/ld+json']") %>%
html_text() %>%
fromJSON()
daten <- bind_rows(daten, site$review)
}
# Tabelle aufräumen
daten <- daten %>% unnest(reviewRating, names_sep = "_") %>%
select(inLanguage, datePublished, reviewBody, reviewRating_ratingValue) %>%
rename("bewertung" = reviewRating_ratingValue,
"datum" = datePublished,
"review" = reviewBody,
"sprache" = inLanguage,) %>%
mutate(id = 1:n(), datum = as.Date(datum),
bewertung = factor(bewertung, ordered = TRUE)) %>%
select(id, datum, bewertung, review, sprache)
# Daten abspeichern
save(daten, file = "./daten_obi.RData")
```
```{r Inspektion, fig.cap = "Die Rohdaten. Wenn Sie mit der Maus über die Abbildung fahren, erscheint oben rechts eine Bildlaufleiste. Mit dieser können Sie durch die Tabelle scrollen."}
# Daten laden
load("./daten_obi.RData")
daten <- daten %>%
mutate(review = str_replace_all(review, pattern = "\\n|<br>|<br/>", replacement = " "),
review = str_trim(review))
# Visualsierung: Tabelle
plot_ly(type = 'table',
columnwidth = c(30, 60, 60, 250, 50),
header = list(
values = c(names(daten) %>% paste("<b>", ., "</b>", sep = "")),
fill = list(color = "#31688EFF")),
cells = list(
values = rbind(t(as.matrix(unname(daten)))),
align = c("center", "center", "center", "left", "center"),
fill = list(color = "#D0E2EF")))
```
Die Rohdaten umfassen insgesamt `r nrow(daten)` Bewertungen (Abb. \@ref(fig:Inspektion)). Die Bewertungen wurden in dem Zeitraum vom `r min(daten$datum)` bis zum `r max(daten$datum)` veröffentlicht. Bei den Bewertungen handelt es sich um Sterne, die Kunden an **Obi** vergeben haben. Ein einzelner Stern stellt das negativste Feedback dar und die bestmögliche Bewertung sind 5 Sterne. In manchen Fällen haben die Kunden keine Review zu ihrer Bewertung geschrieben. Die Sprache der Reviews wird ausnahmslos mit "`r unique(daten$sprache)`" angegeben.
## Large Language Model {#LLM}
Derzeit sind die Large Language Models (LLMs) in aller Munde. Im Hinblick auf die Textanalyse sind diese Modelle insbesondere für eine Umwandlung der Texte in embeddings relevant. Für diese Beispielanalyse brauche ich embeddings, die man sowohl für die Hauptkomponentenanalyse, das Topic Modelling, wie auch für die semantische Suche nutzen kann. Diese Anforderung erfüllt [*"text-embedding-ada-002"*](https://openai.com/blog/new-and-improved-embedding-model), das über die API von Open-AI nutzbar ist. Vorab berechne ich die Kosten für das mit 0.0004 \$ pro 1000 token bepreiste Model.
```{r kosten}
# Kostenkalkulation
costs <- daten$review %>%
tokenize_words() %>%
lengths() %>%
sum()/1000*0.0004
```
Die Kosten sind mit `r round(costs, 4)` \$ sehr gut zu verschmerzen. Weiter geht es mit den Funktionsdefinitionen für die Request!
```{r funktionsdefinitionen}
# Funktionsdefinition: embeddings abfragen
get_embeddings <- function(texts){
response <- POST("https://api.openai.com/v1/embeddings",
add_headers(Authorization = paste("Bearer", api_key)), # api_key ist einzufügen
body = list(model = "text-embedding-ada-002", input = texts),
encode = "json")
}
# Funktionsdefinition: Matrix extrahieren
get_embedding_matrix <- function(response){
matrix_embeddings <-
response$content %>%
rawToChar() %>%
fromJSON() %>%
pluck("data", "embedding") %>%
unlist() %>%
matrix(ncol = 1536, byrow = TRUE)
return(matrix_embeddings)
}
```