Edit
ich habe eine LDA mit vier Topics durchgeführt. Die Topics basieren auf Kundenreviews zu vier verschiedenen Smartphones auf Amazon.
Code: Alles auswählen
library(tidyverse)
library(tidytext)
library(tm)
library(topicmodels)
glimpse(datsub)
Observations: 14,108
Variables: 6
$ Product.Name <chr> "iphone 4s", "iphone 4s", "iphone 4s", "iphone 4s", "iphone 4s", "iphone 4...
$ Brand.Name <chr> "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""...
$ Price <dbl> 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,...
$ Rating <int> 5, 1, 4, 5, 5, 3, 5, 5, 5, 1, 5, 5, 1, 5, 2, 5, 5, 4, 5, 1, 4, 1, 1, 1, 4,...
$ Reviews <chr> "new great price phone really quick great seller", "star product false adv...
$ Review.Votes <int> 2, 1, 0, 1, 2, 2, 2, 5, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,...
Das Ergebnis sieht wie folgt aus - Bild 2 (Die Anzahl der Dimensionen ist nicht willkürlich, sondern wurde im Vorfeld ermittelt, was ich aber hier nicht aufführe):
Code: Alles auswählen
corpus = Corpus(VectorSource(datsub$Reviews))
dtm = DocumentTermMatrix(corpus)
ap_lda = LDA(dtm,
method = "Gibbs",
k = 4,
control = list(seed = 1))
ap_topics = tidy(ap_lda, matrix = "beta")
ap_top_terms = ap_topics %>%
group_by(topic) %>%
top_n(6, beta) %>%
arrange(topic, -beta)
ap_top_terms %>%
ggplot(aes(reorder(term, beta), beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
labs(x = "terms") +
coord_flip()
Ziel der LDA ist es Image-Dimensionen zu extrahieren. Die Reviews wurden im Vorfeld bereinigt und ein POS_Tagging durchgeführt, sodass nur diejenigen Terme erhalten bleiben, die sich zur Beschreibung eines Smartphones eignen. Topic 1 könnte heißen "Kamera", Topic 2 "Akku", Topic 3 "Features" und Topic 4 "Zufriedenheit". Das Ergebnis der LDA möchte ich über eine MDS visualisieren. Ziel ist die Ähnlichkeit der Smartphones bezogen auf die Image-Dimensionen (Topics) zu verdeutlichen.
Meine Frage ist wie man das am besten macht?
Folgende Überlegung habe ich: Für jedes Smartphone kann ich über alle Reviews hinweg die relative Häufigkeit der Terme berechnen. Die Smartphones kann ich hinsichtlich der relativen Häufigkeiten der Terme vergleichen. Annnahme: Je höher die relative Häufigkeit der Terme je Smartphone bezogen auf die Terme je Topic mit dem höchsten Gewicht, desto eher wird ein Smartphone mit einem Topic assoziert. Dadurch kann ich die Wortvektoren der Smartphones bezogen auf ein Topic vergleichen.
In R würde das folgendermaßen aussehen (hier für Topic 1):
Ich nehme die z.B. die 6 Terme mit den höchsten Gewichten je Topic,
Code: Alles auswählen
top_terms1 = ap_topics %>%
filter(topic == 1) %>%
top_n(6, beta)
top_terms1
# A tibble: 6 x 3
topic term beta
<int> <chr> <dbl>
1 1 price 0.143
2 1 good 0.518
3 1 nice 0.0387
4 1 camera 0.0925
5 1 quality 0.0790
6 1 picture 0.0459
berechne die relativen Häufigkeiten aller Terme je Smartphone,
Code: Alles auswählen
dtmframe = as.data.frame(as.matrix(dtm))
dtmSparse$Brand = datsub$Product.Name
dtmframe = dtmframe %>%
group_by(Brand) %>%
summarise_all(., funs(sum))
dtmframe[-1] = dtmframe[-1]/rowSums(dtmframe[-1])
Code: Alles auswählen
topic1 = dtmSparse %>%
select(Brand, one_of(top_terms1$term))
topic1
# A tibble: 4 x 7
Brand price good nice camera quality picture
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 BLU Studio 5.0 0.0382 0.120 0.0175 0.0283 0.0239 0.0139
2 iphone 4s 0.0114 0.111 0.0150 0.00203 0.00671 0.00219
3 Motorola Moto E 0.0544 0.155 0.0182 0.0437 0.0202 0.0130
4 Samsung Galaxy II 0.0282 0.154 0.0257 0.0144 0.0111 0.00770
Code: Alles auswählen
BLU_BLU = BLU_Iphone = hellinger(as.numeric(topic1[1, -1]), as.numeric(topic1[1, -1]))
BLU_Iphone = hellinger(as.numeric(topic1[1, -1]), as.numeric(topic1[2, -1]))
BLU_Motorola = hellinger(as.numeric(topic1[1, -1]), as.numeric(topic1[3, -1]))
BLU_Samsung = hellinger(as.numeric(topic1[1, -1]), as.numeric(topic1[4, -1]))
Iphone_BLU = hellinger(as.numeric(topic1[2, -1]), as.numeric(topic1[1, -1]))
Iphone_Iphone = hellinger(as.numeric(topic1[2, -1]), as.numeric(topic1[2, -1]))
Iphone_Motorola = hellinger(as.numeric(topic1[2, -1]), as.numeric(topic1[3, -1]))
Iphone_Samsung = hellinger(as.numeric(topic1[2, -1]), as.numeric(topic1[4, -1]))
Motorola_BLU = hellinger(as.numeric(topic1[3, -1]), as.numeric(topic1[1, -1]))
Motorola_Iphone = hellinger(as.numeric(topic1[3, -1]), as.numeric(topic1[2, -1]))
Motorola_Motorola = hellinger(as.numeric(topic1[3, -1]), as.numeric(topic1[3, -1]))
Motorola_Samsung = hellinger(as.numeric(topic1[3, -1]), as.numeric(topic1[4, -1]))
Samsung_BLU = hellinger(as.numeric(topic1[4, -1]), as.numeric(topic1[1, -1]))
Samsung_Iphone = hellinger(as.numeric(topic1[4, -1]), as.numeric(topic1[2, -1]))
Samsung_Motorola = hellinger(as.numeric(topic1[4, -1]), as.numeric(topic1[3, -1]))
Samsung_Samsung = hellinger(as.numeric(topic1[4, -1]), as.numeric(topic1[4, -1]))
BLU = c(BLU_BLU, BLU_Iphone, BLU_Motorola, BLU_Samsung)
Iphone = c(Iphone_BLU, Iphone_Iphone, Iphone_Motorola, Iphone_Samsung)
Motorola = c(Motorola_BLU, Motorola_Iphone, Motorola_Motorola, Motorola_Samsung)
Samsung = c(Samsung_BLU, Samsung_Iphone, Samsung_Motorola, Samsung_Samsung)
dist1 = data.frame(BLU, Iphone, Motorola, Samsung)
row.names(dist1) = colnames(dist1)
dist1
BLU Iphone Motorola Samsung
BLU 0.0000000 0.3396236 0.2101617 0.1973540
Iphone 0.3396236 0.0000000 0.4487546 0.3082306
Motorola 0.2101617 0.4487546 0.0000000 0.1598695
Samsung 0.1973540 0.3082306 0.1598695 0.0000000
mds1 = cmdscale(dist1, k= 1)
mds1
[,1]
BLU 0.04644946
Iphone -0.26484136
Motorola 0.18322084
Samsung 0.03517106
Code: Alles auswählen
c1= data.frame(mds1, mds2) %>%
ggplot() +
geom_point(aes(x = dim1, y = dim2, color = topic1$Brand)) +
labs(x = "Picture quality", y = "Features", color = "Brand") +
theme_minimal()
c2 = data.frame(mds3, mds4) %>%
ggplot() +
geom_point(aes(x = dim3, y = dim4, color = topic1$Brand)) +
labs(x = "Battery Life", y = "Satisfaction", color = "Brand") +
theme_minimal()
ggarrange(c1, c2, ncol = 1, nrow = 2)