使用R和tidytext对Trustpilot 的评论进行主题建模

测试开头

使用R和tidytext对Trustpilot 的评论进行主题建模

笔者邀请您，先思考：

1 如何对文本数据做主题分析和建模？

2 如何理解LDA算法？还有那些主题模型？

在这篇和分析中，我们将主题建模应用于我目前的电信提供商丹麦Trustpilot对“3”（其他国家的“三个”）的评论。我对他们的客户服务不满意，并认为这将是一个有趣的主题建模用例。通过这种方法，我们可以尝试找出客户体验的哪些方面出现在积极和消极的评论中。

我使用Python脚本从trustpilot.dk抓取了从2015年1月到2017年10月期间4000条关于“3”的客户评论。

有关使用Julia Silge和David Robinson的tidytext包进行主题建模的更多详细信息，请查看他们的书。

需要的包

1if(!require("pacman")) install.packages("pacman")
2pacman::p_load(tidyverse,tidytext,tm,topicmodels,magrittr,
3               jtools,gridExtra,knitr,widyr,ggraph,igraph,kableExtra)
4
5if(!require("devtools")) install.packages("devtools")
6devtools::install_github("56north/happyorsad")
7library(happyorsad)

定制化ggplot主题

改善ggplot2中图形的外观非常简单。为了保持一致性，我们将根据jtools包中的APA主题创建一个干净简单的主题，并修改一些功能。背景颜色将设置为浅灰色调。 APA主题中省略了网格线。

1my_theme <- function() {
2  theme_apa(legend.pos   = "none") +
3  theme(panel.background = element_rect(fill = "gray96", colour = "gray96"),
4        plot.background  = element_rect(fill = "gray96", colour = "gray96"),
5        plot.margin      = margin(1, 1, 1, 1, "cm"),
6        panel.border     = element_blank(),        # facet border
7        strip.background = element_blank())        # facet title background
8}

加载和准备数据

我们的数据框有两列：一个名为Name的变量，包含评论者/作者的名字，它将作为一个变量来识别每个文档; 一个名为Review的变量，包含单个评论。

1df <- read_csv2("https://raw.githubusercontent.com/PeerChristensen/trustpilot_reviews/master/3reviewsB.csv")
2
3df %<>% 
4  select(-X1) %>%  
5  filter(Name != "John M. Sebastian")

鉴于我们的评论是丹麦语，我们可以使用happyorsad包计算每个评论的情绪评分。分数基于丹麦的情绪词汇和FinnÅrupNielsen的分数列表。 我们还将确保所有单词都是小写的，并删除一堆预定义的丹麦停用词和频繁的动词。

1df %<>%
2  mutate(Sentiment = map_int(df$Review,happyorsad,"da")) %>%
3  mutate(Review = tolower(Review)) %>%              
4  mutate(Review = removeWords(Review, c("så", "3", "kan","få","får","fik", stopwords("danish"))))

情感分数的分布

在下面的密度图中，我们看到情感分数如何分布，中位数为2.正如您可能知道的那样，我们正在处理一个相当平庸的提供者。但是，我们仍然想知道为什么该公司的评分为10分满分里的6.7分。

我们可以非常粗略地将正面和负面评论放在不同的数据框中，并对每个数据框架进行主题建模，以便探索哪些评论者喜欢和不喜欢3。

1df %>% 
2  ggplot(aes(x = Sentiment)) + 
3  geom_density(size = 1) +
4  geom_vline(xintercept = median(df$Sentiment), 
5             colour = "indianred", linetype = "dashed", size = 1) +
6  ggplot2::annotate("text", x = 15, y = 0.06, 
7                    label = paste("median = ", median(df$Sentiment)), colour = "indianred") +
8  my_theme() +
9  xlim(-40,40)

用于积极评论的主题建模

下面创建的数据框包含2228个正面评论，分数高于1.单词将被分词化，即每行一个单词。

1df_pos <- df            %>%
2  filter(Sentiment > 1) %>%
3  select(-Sentiment)    %>%
4  unnest_tokens(word, Review)

在创建所谓的文档术语矩阵之前，我们需要计算每个文档（评论）的每个单词的频率。

1words_pos <- df_pos              %>%
2  count(Name, word, sort = TRUE) %>%
3  ungroup()
4
5reviewDTM_pos <- words_pos       %>%
6  cast_dtm(Name, word, n)

现在我们有了一个“DTM”，我们可以将它传递给LDA函数，它实现了Latent Dirichlet Allocation算法。它假定每个文档都是主题的混合，每个主题都是单词的混合。 k参数用于指定我们在模型中所需的主题数量。让我们创建一个四主题模型！

1reviewLDA_pos <- LDA(reviewDTM_pos, k = 4, control = list(seed = 347))
2

下图显示了分配给每个主题的评论数量。

1tibble(topics(reviewLDA_pos))       %>%
2  group_by(`topics(reviewLDA_pos)`) %>%
3  count()                           %>% 
4  kable()                           %>%
5  kable_styling(full_width = F, position = "left")

我们还可以得到每个主题每个单词的概率，或“beta”。

1topics_pos <- tidy(reviewLDA_pos, matrix = "beta")
2topics_pos

 1## # A tibble: 46,844 x 3
 2##    topic term            beta
 3##    <int> <chr>          <dbl>
 4##  1     1 telefon    0.00376  
 5##  2     2 telefon    0.00358  
 6##  3     3 telefon    0.0165   
 7##  4     4 telefon    0.00319  
 8##  5     1 abonnement 0.00326  
 9##  6     2 abonnement 0.00871  
10##  7     3 abonnement 0.00193  
11##  8     4 abonnement 0.0130   
12##  9     1 navn       0.000964 
13## 10     2 navn       0.0000227
14## # ... with 46,834 more rows

现在，我们可以找到每个主题的Top术语，即具有最高概率/ beta的单词。在这里，我们选择前五个单词，我们将在一个图片中显示。

1topTerms_pos <- topics_pos %>%
2  group_by(topic)          %>%
3  top_n(5, beta)           %>%
4  ungroup()                %>%
5  arrange(topic, -beta)    %>%
6  mutate(order = rev(row_number()))

针对负面评论的主题建模

让我们首先对负面评论做同样的事情，创建一个包含973条评论的数据框架，其情绪得分低于-1。

 1df_neg <- df                        %>%
 2  filter(Sentiment < -1)            %>%
 3  select(-Sentiment)                %>%
 4  unnest_tokens(word, Review)
 5
 6words_neg <- df_neg                 %>%
 7  count(Name, word, sort = TRUE)    %>%
 8  ungroup()
 9
10reviewDTM_neg <- words_neg          %>%
11  cast_dtm(Name, word, n)
12
13reviewLDA_neg <- LDA(reviewDTM_neg, k = 4, control = list(seed = 347))
14
15tibble(topics(reviewLDA_neg))       %>%
16  group_by(`topics(reviewLDA_neg)`) %>%
17  count()                           %>%
18  kable()                           %>%
19  kable_styling(full_width = F, position = "left")

1topics_neg <- tidy(reviewLDA_neg, matrix = "beta")
2
3topTerms_neg <- topics_neg          %>%
4  group_by(topic)                   %>%
5  top_n(5, beta)                    %>%
6  ungroup()                         %>%
7  arrange(topic, -beta)             %>%
8  mutate(order = rev(row_number()))

绘制主题模型

最后，让我们画出结果。

 1plot_pos <- topTerms_pos %>%
 2  ggplot(aes(order, beta)) +
 3  ggtitle("Positive review topics") +
 4  geom_col(show.legend = FALSE, fill = "steelblue") +
 5  scale_x_continuous(
 6    breaks = topTerms_pos$order,
 7    labels = topTerms_pos$term,
 8    expand = c(0,0)) +
 9  facet_wrap(~ topic,scales = "free") +
10  coord_flip(ylim = c(0,0.02)) +
11  my_theme() +
12  theme(axis.title = element_blank())
13
14plot_neg <- topTerms_neg %>%
15  ggplot(aes(order, beta, fill = factor(topic))) +
16  ggtitle("Negative review topics") +
17  geom_col(show.legend = FALSE, fill = "indianred") +
18  scale_x_continuous(
19    breaks = topTerms_neg$order,
20    labels = topTerms_neg$term,
21    expand = c(0,0))+
22  facet_wrap(~ topic,scales = "free") +
23  coord_flip(ylim = c(0,0.02)) +
24  my_theme() +
25  theme(axis.title = element_blank())
26
27grid.arrange(plot_pos, plot_neg, ncol = 1)

那么，客户在Trustpilot.dk上撰写评论喜欢和不喜欢什么？不幸的是，这些评论都是丹麦语，但考虑到积极和消极评论的四个主题模型，这里是人们倾向于强调的内容：

积极评价：

覆盖面和数据
服务
手机，商店和新商店——也许商店经常更换出故障的手机?
计划(服务)，丹麦克朗(丹麦货币)，支付，账单-计划和支付的积极方面?

消极评价：

客户服务，计划
客户服务，电话，错误，计划
电话，覆盖率，商店
支付，账单，kr，计划

有趣的是，对于几乎相同的主题，客户似乎既有积极的体验，也有消极的体验。一些客户似乎体验到了良好的覆盖率，而另一些客户似乎抱怨覆盖率低。(客户)服务和支付也出现了相同的模式。

让我们进一步探索。

评论中的单词共现

为了查看在我们的两个数据集中是否经常使用“良好服务”和“不良服务”这样的单词对，我们将计算每对单词在标题或描述字段中出现的次数。 使用widyr包中的pairwise_count（）很容易。

1word_pairs_pos <- df_pos %>% 
2  pairwise_count(word, Name, sort = TRUE)
3
4word_pairs_neg <- df_neg %>%
5  pairwise_count(word, Name, sort = TRUE)

然后，我们可以使用igraph和ggraph包绘制评论中同时出现的最常见的单词对。

 1set.seed(611)
 2
 3pairs_plot_pos <- word_pairs_pos %>%
 4  filter(n >= 140)               %>%
 5  graph_from_data_frame()        %>%
 6  ggraph(layout = "fr") +
 7  geom_edge_link(aes(edge_alpha = n, edge_width = n), edge_colour = "steelblue") +
 8  ggtitle("Positive word pairs") +
 9  geom_node_point(size = 5) +
10  geom_node_text(aes(label = name), repel = TRUE,
11                point.padding = unit(0.2, "lines")) +
12  my_theme() +
13  theme(axis.title = element_blank(),
14      axis.text = element_blank(),
15      axis.ticks = element_blank())
16
17pairs_plot_neg <- word_pairs_neg %>%
18  filter(n >= 80)                %>%
19  graph_from_data_frame()        %>%
20  ggraph(layout = "fr") +
21  geom_edge_link(aes(edge_alpha = n, edge_width = n), edge_colour = "indianred") +
22  ggtitle("Negative word pairs") +
23  geom_node_point(size = 5) +
24  geom_node_text(aes(label = name), repel = TRUE,
25                 point.padding = unit(0.2, "lines")) +
26  my_theme() +
27  theme(axis.title = element_blank(),
28        axis.text = element_blank(),
29        axis.ticks = element_blank())
30
31grid.arrange(pairs_plot_pos, pairs_plot_neg, ncol = 2)

在积极的评论中，很明显“好”（“上帝”）这个词倾向于与“服务”，“覆盖”和“总是”这两个词共同出现。在负面评论中，我们看到“坏”（“dårlig”）与“服务”，“覆盖”和“从不”共同发生。模式非常相似，但相反！

词对相关

找出客户认为3的好坏的更直接的方法是使用pairwise_cor（）函数，并专门查找与丹麦语中“好”和“坏”的词最相关的词。 或者，我们可以执行n-gram分析以找出哪些词最常出现“好”和“坏”。

 1cor_pos <- df_pos                       %>% 
 2  group_by(word)                        %>%
 3  filter(n() >= 100)                    %>%
 4  pairwise_cor(word, Name, sort = TRUE) %>%
 5  filter(item1 == "god")                %>%
 6  top_n(7)
 7
 8cor_neg <- df_neg                       %>% 
 9  group_by(word)                        %>%
10  filter(n() >= 100)                    %>%
11  pairwise_cor(word, Name, sort = TRUE) %>% 
12  filter(item1 == "dårlig")             %>%
13  top_n(7)

让我们把这些数据合并成一张图。

 1cor_words <- rbind(cor_pos, cor_neg) %>%
 2    mutate(order = rev(row_number()),
 3           item1 = factor(item1, levels = c("god", "dårlig")))
 4
 5cor_words %>%
 6  ggplot(aes(x = order, y = correlation, fill = item1)) +
 7  geom_col(show.legend = FALSE) +
 8  scale_x_continuous(
 9    breaks = cor_words$order,
10    labels = cor_words$item2,
11    expand = c(0,0)) +
12  facet_wrap(~item1, scales = "free") +
13  scale_fill_manual(values = c("steelblue", "indianred")) + 
14  coord_flip() +
15  labs(x = "words") +
16  my_theme()