首页
学习
活动
专区
圈层
工具
发布
社区首页 >专栏 >文本挖掘和情感分析的基础示例

文本挖掘和情感分析的基础示例

作者头像
AiTechYun
发布2018-08-16 11:49:10
发布2018-08-16 11:49:10
5.6K0
举报
文章被收录于专栏:ATYUN订阅号ATYUN订阅号

编译:yxy

出品:ATYUN订阅号

经过研究表明,在旅行者的决策过程中,TripAdvisor(猫途鹰,全球旅游点评网)正变得越来越重要。然而,了解TripAdvisor评分与数千个评论文本中的每一个的细微差别是很有挑战性的。为了更彻底地了解酒店客人的评论是否会影响酒店的加班表现,我从TripAdvisor截取了一家酒店 – 希尔顿夏威夷度假村(Hilton Hawaiian Village)的所有英语评论 (Web抓取的细节和Python代码在文末)。

加载库

代码语言:javascript
复制
library(dplyr)
代码语言:javascript
复制
library(readr)
代码语言:javascript
复制
library(lubridate)
代码语言:javascript
复制
library(ggplot2)
代码语言:javascript
复制
library(tidytext)
代码语言:javascript
复制
library(tidyverse)
代码语言:javascript
复制
library(stringr)
代码语言:javascript
复制
library(tidyr)
代码语言:javascript
复制
library(scales)
代码语言:javascript
复制
library(broom)
代码语言:javascript
复制
library(purrr)
代码语言:javascript
复制
library(widyr)
代码语言:javascript
复制
library(igraph)
代码语言:javascript
复制
library(ggraph)
代码语言:javascript
复制
library(SnowballC)
代码语言:javascript
复制
library(wordcloud)
代码语言:javascript
复制
library(reshape2)
代码语言:javascript
复制
theme_set(theme_minimal())

数据

代码语言:javascript
复制
df <- read_csv("Hilton_Hawaiian_Village_Waikiki_Beach_Resort-Honolulu_Oahu_Hawaii__en.csv")
代码语言:javascript
复制
df <- df[complete.cases(df), ]
代码语言:javascript
复制
df$review_date <- as.Date(df$review_date, format = "%d-%B-%y")
代码语言:javascript
复制
dim(df); min(df$review_date); max(df$review_date)

在TripAdvisor上希尔顿夏威夷度假村共有13,701条评论,评论日期范围是2002-03-21到2018-08-02。

代码语言:javascript
复制
df %>%
代码语言:javascript
复制
  count(Week = round_date(review_date, "week")) %>%
代码语言:javascript
复制
  ggplot(aes(Week, n)) +
代码语言:javascript
复制
  geom_line() +
代码语言:javascript
复制
  ggtitle('The Number of Reviews Per Week')

2014年底收到的每周评论数量最多。该酒店在那一周收到了70多条评论。

评论文本的文本挖掘

代码语言:javascript
复制
df <- tibble::rowid_to_column(df, "ID")
代码语言:javascript
复制
df <- df %>%
代码语言:javascript
复制
  mutate(review_date = as.POSIXct(review_date, origin = "1970-01-01"),month = round_date(review_date, "month"))
代码语言:javascript
复制
review_words <- df %>%
代码语言:javascript
复制
  distinct(review_body, .keep_all = TRUE) %>%
代码语言:javascript
复制
  unnest_tokens(word, review_body, drop = FALSE) %>%
代码语言:javascript
复制
  distinct(ID, word, .keep_all = TRUE) %>%
代码语言:javascript
复制
  anti_join(stop_words, by = "word") %>%
代码语言:javascript
复制
  filter(str_detect(word, "[^\\d]")) %>%
代码语言:javascript
复制
  group_by(word) %>%
代码语言:javascript
复制
  mutate(word_total = n()) %>%
代码语言:javascript
复制
  ungroup()
代码语言:javascript
复制
word_counts <- review_words %>%
代码语言:javascript
复制
  count(word, sort = TRUE)
代码语言:javascript
复制
word_counts %>%
代码语言:javascript
复制
  head(25) %>%
代码语言:javascript
复制
  mutate(word = reorder(word, n)) %>%
代码语言:javascript
复制
  ggplot(aes(word, n)) +
代码语言:javascript
复制
  geom_col(fill = "lightblue") +
代码语言:javascript
复制
  scale_y_continuous(labels = comma_format()) +
代码语言:javascript
复制
  coord_flip() +
代码语言:javascript
复制
  labs(title = "Most common words in review text 2002 to date",
代码语言:javascript
复制
       subtitle = "Among 13,701 reviews; stop words removed",
代码语言:javascript
复制
       y = "# of uses")

我们肯定可以做得更好一些,将“stay ”和“stayed ”,“pool”和“pools ”合起来。这被称为词干,词干是将变形(或有时是衍生)的词语变回到词干,基词或根词格式的过程。

代码语言:javascript
复制
word_counts %>%
代码语言:javascript
复制
  head(25) %>%
代码语言:javascript
复制
  mutate(word = wordStem(word)) %>%
代码语言:javascript
复制
  mutate(word = reorder(word, n)) %>%
代码语言:javascript
复制
  ggplot(aes(word, n)) +
代码语言:javascript
复制
  geom_col(fill = "lightblue") +
代码语言:javascript
复制
  scale_y_continuous(labels = comma_format()) +
代码语言:javascript
复制
  coord_flip() +
代码语言:javascript
复制
  labs(title = "Most common words in review text 2002 to date",
代码语言:javascript
复制
       subtitle = "Among 13,701 reviews; stop words removed and stemmed",
代码语言:javascript
复制
       y = "# of uses")
BIGRAM

我们经常想要了解评论中单词之间的关系。在评论文本中,有哪些常见的单词序列?给定一些单词,哪些单词最有可能跟随在这个单词后面?哪些词关联最紧密?因此,许多有趣的文本分析都是基于这种关联。当我们检查两个连续单词的对时,它被称为“bigram”(二元语法)。

那么,这家酒店的评论中最常见的bigram评论是什么?

代码语言:javascript
复制
review_bigrams <- df %>%
代码语言:javascript
复制
  unnest_tokens(bigram, review_body, token = "ngrams", n = 2)
代码语言:javascript
复制
bigrams_separated <- review_bigrams %>%
代码语言:javascript
复制
  separate(bigram, c("word1", "word2"), sep = " ")
代码语言:javascript
复制
bigrams_filtered <- bigrams_separated %>%
代码语言:javascript
复制
  filter(!word1 %in% stop_words$word) %>%
代码语言:javascript
复制
  filter(!word2 %in% stop_words$word)
代码语言:javascript
复制
bigram_counts <- bigrams_filtered %>%
代码语言:javascript
复制
  count(word1, word2, sort = TRUE)
代码语言:javascript
复制
bigrams_united <- bigrams_filtered %>%
代码语言:javascript
复制
  unite(bigram, word1, word2, sep = " ")
代码语言:javascript
复制
bigrams_united %>%
代码语言:javascript
复制
  count(bigram, sort = TRUE)

最常见的bigram是“rainbow tower”,其次是“hawaiian village”。

我们可以在单词网络中可视化bigram:

代码语言:javascript
复制
review_subject <- df %>%
代码语言:javascript
复制
  unnest_tokens(word, review_body) %>%
代码语言:javascript
复制
  anti_join(stop_words)
代码语言:javascript
复制
my_stopwords <- data_frame(word = c(as.character(1:10)))
代码语言:javascript
复制
review_subject <- review_subject %>%
代码语言:javascript
复制
  anti_join(my_stopwords)
代码语言:javascript
复制
title_word_pairs <- review_subject %>%
代码语言:javascript
复制
  pairwise_count(word, ID, sort = TRUE, upper = FALSE)
代码语言:javascript
复制
set.seed(1234)
代码语言:javascript
复制
title_word_pairs %>%
代码语言:javascript
复制
  filter(n >= 1000) %>%
代码语言:javascript
复制
  graph_from_data_frame() %>%
代码语言:javascript
复制
  ggraph(layout = "fr") +
代码语言:javascript
复制
  geom_edge_link(aes(edge_alpha = n, edge_width = n), edge_colour = "cyan4") +
代码语言:javascript
复制
  geom_node_point(size = 5) +
代码语言:javascript
复制
  geom_node_text(aes(label = name), repel = TRUE,
代码语言:javascript
复制
                 point.padding = unit(0.2, "lines")) +
代码语言:javascript
复制
  ggtitle('Word network in TripAdvisor reviews')
代码语言:javascript
复制
  theme_void()

上面显示了TripAdvisor评论中常见的bigram组合,显示了至少出现了1000次且不是停用词的单词。

网络图显示了前几个词(“hawaiian ”,“village ”,“ocean ”和“view ”)之间的紧密联系。然而,我们在网络中并没有看到清晰的聚类结构。

TRIGRAM

Bigram有时是不够的,让我们看看希尔顿夏威夷度假村在TripAdvisor评论中最常见的trigram(三元语法)?

代码语言:javascript
复制
review_trigrams <- df %>%
代码语言:javascript
复制
  unnest_tokens(trigram, review_body, token = "ngrams", n = 3)
代码语言:javascript
复制
代码语言:javascript
复制
trigrams_separated <- review_trigrams %>%
代码语言:javascript
复制
  separate(trigram, c("word1", "word2", "word3"), sep = " ")
代码语言:javascript
复制
代码语言:javascript
复制
trigrams_filtered <- trigrams_separated %>%
代码语言:javascript
复制
  filter(!word1 %in% stop_words$word) %>%
代码语言:javascript
复制
  filter(!word2 %in% stop_words$word) %>%
代码语言:javascript
复制
  filter(!word3 %in% stop_words$word)
代码语言:javascript
复制
代码语言:javascript
复制
trigram_counts <- trigrams_filtered %>%
代码语言:javascript
复制
  count(word1, word2, word3, sort = TRUE)
代码语言:javascript
复制
代码语言:javascript
复制
trigrams_united <- trigrams_filtered %>%
代码语言:javascript
复制
  unite(trigram, word1, word2, word3, sep = " ")
代码语言:javascript
复制
代码语言:javascript
复制
trigrams_united %>%
代码语言:javascript
复制
  count(trigram, sort = TRUE)

最常见的trigram 是“hilton hawaiian village”,其次是“hilton hawaiian village”,依此类推。

评论中的重要的词汇趋势

随着时间的推移,哪些词语和话题变得更频繁(或者更频繁)了?这些可以让我们了解酒店不断变化的生态系统,例如服务,翻新,问题解决,让我们预测哪些话题的关联词将继续增长。

我们需要了解的问题是:在TripAdvisor评论中,随着时间的推移,哪些词的频率在增加?

代码语言:javascript
复制
reviews_per_month <- df %>%
代码语言:javascript
复制
  group_by(month) %>%
代码语言:javascript
复制
  summarize(month_total = n())
代码语言:javascript
复制
word_month_counts <- review_words %>%
代码语言:javascript
复制
  filter(word_total >= 1000) %>%
代码语言:javascript
复制
  count(word, month) %>%
代码语言:javascript
复制
  complete(word, month, fill = list(n = 0)) %>%
代码语言:javascript
复制
  inner_join(reviews_per_month, by = "month") %>%
代码语言:javascript
复制
  mutate(percent = n / month_total) %>%
代码语言:javascript
复制
  mutate(year = year(month) + yday(month) / 365)
代码语言:javascript
复制
mod <- ~ glm(cbind(n, month_total - n) ~ year, ., family = "binomial")
代码语言:javascript
复制
slopes <- word_month_counts %>%
代码语言:javascript
复制
  nest(-word) %>%
代码语言:javascript
复制
  mutate(model = map(data, mod)) %>%
代码语言:javascript
复制
  unnest(map(model, tidy)) %>%
代码语言:javascript
复制
  filter(term == "year") %>%
代码语言:javascript
复制
  arrange(desc(estimate))
代码语言:javascript
复制
slopes %>%
代码语言:javascript
复制
  head(9) %>%
代码语言:javascript
复制
  inner_join(word_month_counts, by = "word") %>%
代码语言:javascript
复制
  mutate(word = reorder(word, -estimate)) %>%
代码语言:javascript
复制
  ggplot(aes(month, n / month_total, color = word)) +
代码语言:javascript
复制
  geom_line(show.legend = FALSE) +
代码语言:javascript
复制
  scale_y_continuous(labels = percent_format()) +
代码语言:javascript
复制
  facet_wrap(~ word, scales = "free_y") +
代码语言:javascript
复制
  expand_limits(y = 0) +
代码语言:javascript
复制
  labs(x = "Year",
代码语言:javascript
复制
       y = "Percentage of reviews containing this word",
代码语言:javascript
复制
       title = "9 fastest growing words in TripAdvisor reviews",
代码语言:javascript
复制
       subtitle = "Judged by growth rate over 15 years")

在2010年之前,我们可以看到关于“friday fireworks”和“lagoon”的讨论高峰。像“resort fee”和“busy”这样的词在2005年之前增长最快。

在评论中,哪些词的频率在下降?

代码语言:javascript
复制
word_month_counts %>%
代码语言:javascript
复制
  filter(word %in% c("service", "food")) %>%
代码语言:javascript
复制
  ggplot(aes(month, n / month_total, color = word)) +
代码语言:javascript
复制
  geom_line(size = 1, alpha = .8) +
代码语言:javascript
复制
  scale_y_continuous(labels = percent_format()) +
代码语言:javascript
复制
  expand_limits(y = 0) +
代码语言:javascript
复制
  labs(x = "Year",
代码语言:javascript
复制
       y = "Percentage of reviews containing this term", title = "service vs food in terms of reviewers interest")

服务和食品都是2010年之前的主要话题。关于服务和食品的讨论在2003年左右的数据开始时达到顶峰,在2005年之后一直呈下降趋势,偶尔出现高峰。

情绪分析

情感分析广泛应用于客户反馈,需要分析的有:评论和调查结果,在线和社交媒体。它适用于从营销到客户服务以及临床医学的各种应用。

在我们的案例中,我们的目的是确定评论者(即酒店客人)对他过去对酒店的体验的看法。这种可能是判断或评价。

评论中最常见的正面和负面词汇。

代码语言:javascript
复制
reviews <- df %>%
代码语言:javascript
复制
  filter(!is.na(review_body)) %>%
代码语言:javascript
复制
  select(ID, review_body) %>%
代码语言:javascript
复制
  group_by(row_number()) %>%
代码语言:javascript
复制
  ungroup()
代码语言:javascript
复制
tidy_reviews <- reviews %>%
代码语言:javascript
复制
  unnest_tokens(word, review_body)
代码语言:javascript
复制
tidy_reviews <- tidy_reviews %>%
代码语言:javascript
复制
  anti_join(stop_words)
代码语言:javascript
复制
代码语言:javascript
复制
bing_word_counts <- tidy_reviews %>%
代码语言:javascript
复制
  inner_join(get_sentiments("bing")) %>%
代码语言:javascript
复制
  count(word, sentiment, sort = TRUE) %>%
代码语言:javascript
复制
  ungroup()
代码语言:javascript
复制
代码语言:javascript
复制
bing_word_counts %>%
代码语言:javascript
复制
  group_by(sentiment) %>%
代码语言:javascript
复制
  top_n(10) %>%
代码语言:javascript
复制
  ungroup() %>%
代码语言:javascript
复制
  mutate(word = reorder(word, n)) %>%
代码语言:javascript
复制
  ggplot(aes(word, n, fill = sentiment)) +
代码语言:javascript
复制
  geom_col(show.legend = FALSE) +
代码语言:javascript
复制
  facet_wrap(~sentiment, scales = "free") +
代码语言:javascript
复制
  labs(y = "Contribution to sentiment", x = NULL) +
代码语言:javascript
复制
  coord_flip() +
代码语言:javascript
复制
  ggtitle('Words that contribute to positive and negative sentiment in the reviews')

让我们试试另一个情绪库,看看结果是否相同。

代码语言:javascript
复制
contributions <- tidy_reviews %>%
代码语言:javascript
复制
  inner_join(get_sentiments("afinn"), by = "word") %>%
代码语言:javascript
复制
  group_by(word) %>%
代码语言:javascript
复制
  summarize(occurences = n(),
代码语言:javascript
复制
            contribution = sum(score))
代码语言:javascript
复制
contributions %>%
代码语言:javascript
复制
  top_n(25, abs(contribution)) %>%
代码语言:javascript
复制
  mutate(word = reorder(word, contribution)) %>%
代码语言:javascript
复制
  ggplot(aes(word, contribution, fill = contribution > 0)) +
代码语言:javascript
复制
  ggtitle('Words with the greatest contributions to positive/negative
代码语言:javascript
复制
          sentiment in reviews') +
代码语言:javascript
复制
  geom_col(show.legend = FALSE) +
代码语言:javascript
复制
  coord_flip()

有趣的是,“diamond ”(diamond head)被归类为积极的情绪。

这里有一个可能出现的问题,例如,“clean”,在不通的上下文,如前面带有“not”,则会产生负面情绪。事实上,在大多数unigram(一元模型)会有这个否定的问题。所以我们需要进行下一步:

使用Bigrams在情感分析中提供语境

我们想知道单词前面有“not”这样的单词的频率。

代码语言:javascript
复制
bigrams_separated %>%
代码语言:javascript
复制
  filter(word1 == "not") %>%
代码语言:javascript
复制
  count(word1, word2, sort = TRUE)

数据中有850次单词“a”前面有单词“not”,而698次单词“the”前面单词“not”。但这些信息没有意义。

代码语言:javascript
复制
AFINN <- get_sentiments("afinn")
代码语言:javascript
复制
not_words <- bigrams_separated %>%
代码语言:javascript
复制
  filter(word1 == "not") %>%
代码语言:javascript
复制
  inner_join(AFINN, by = c(word2 = "word")) %>%
代码语言:javascript
复制
  count(word2, score, sort = TRUE) %>%
代码语言:javascript
复制
  ungroup()
代码语言:javascript
复制
代码语言:javascript
复制
not_words

这告诉我们,在数据中,跟随“not”的最常见的情感关联词是“worth”,而跟随“not”的第二个常见情感关联词是“recommend”,这通常得分为2分。

那么,在我们的数据中,哪些词在错误的方向上做了最大的“贡献”呢?

代码语言:javascript
复制
not_words %>%
代码语言:javascript
复制
  mutate(contribution = n * score) %>%
代码语言:javascript
复制
  arrange(desc(abs(contribution))) %>%
代码语言:javascript
复制
  head(20) %>%
代码语言:javascript
复制
  mutate(word2 = reorder(word2, contribution)) %>%
代码语言:javascript
复制
  ggplot(aes(word2, n * score, fill = n * score > 0)) +
代码语言:javascript
复制
  geom_col(show.legend = FALSE) +
代码语言:javascript
复制
  xlab("Words preceded by \"not\"") +
代码语言:javascript
复制
  ylab("Sentiment score * number of occurrences") +
代码语言:javascript
复制
  ggtitle('The 20 words preceded by "not" that had the greatest contribution to
代码语言:javascript
复制
          sentiment scores, positive or negative direction') +
代码语言:javascript
复制
  coord_flip()

“not worth”,“not great”,“not good”,“not recommend”和“not like”的最大的错误识别原因,这使得文本看起来比实际上更积极。

除了“not”之外,还有其他词语否定后续词语,例如“no”,“never”和“without”。

代码语言:javascript
复制
negation_words <- c("not", "no", "never", "without")
代码语言:javascript
复制
代码语言:javascript
复制
negated_words <- bigrams_separated %>%
代码语言:javascript
复制
  filter(word1 %in% negation_words) %>%
代码语言:javascript
复制
  inner_join(AFINN, by = c(word2 = "word")) %>%
代码语言:javascript
复制
  count(word1, word2, score, sort = TRUE) %>%
代码语言:javascript
复制
  ungroup()
代码语言:javascript
复制
代码语言:javascript
复制
negated_words %>%
代码语言:javascript
复制
  mutate(contribution = n * score,
代码语言:javascript
复制
         word2 = reorder(paste(word2, word1, sep = "__"), contribution)) %>%
代码语言:javascript
复制
  group_by(word1) %>%
代码语言:javascript
复制
  top_n(12, abs(contribution)) %>%
代码语言:javascript
复制
  ggplot(aes(word2, contribution, fill = n * score > 0)) +
代码语言:javascript
复制
  geom_col(show.legend = FALSE) +
代码语言:javascript
复制
  facet_wrap(~ word1, scales = "free") +
代码语言:javascript
复制
  scale_x_discrete(labels = function(x) gsub("__.+$", "", x)) +
代码语言:javascript
复制
  xlab("Words preceded by negation term") +
代码语言:javascript
复制
  ylab("Sentiment score *# of occurrences") +
代码语言:javascript
复制
  ggtitle('The most common positive or negative words to follow negations
代码语言:javascript
复制
          such as "no", "not", "never" and "without"') +
代码语言:javascript
复制
  coord_flip()

看起来把一个词误认为是正面情绪的最大来源是“not worth/great/good/recommend”,而错误分类的负面情绪的最大来源是“not bad”和“no problem”。

最后,让我们找出最正面和最负面的评论。

代码语言:javascript
复制
sentiment_messages <- tidy_reviews %>%
代码语言:javascript
复制
  inner_join(get_sentiments("afinn"), by = "word") %>%
代码语言:javascript
复制
  group_by(ID) %>%
代码语言:javascript
复制
  summarize(sentiment = mean(score),
代码语言:javascript
复制
            words = n()) %>%
代码语言:javascript
复制
  ungroup() %>%
代码语言:javascript
复制
  filter(words >= 5)
代码语言:javascript
复制
sentiment_messages %>%
代码语言:javascript
复制
  arrange(desc(sentiment))

最正面的评论ID是2363:

代码语言:javascript
复制
df [which(df $ ID == 2363),] $ review_body [1]
代码语言:javascript
复制
sentiment_messages %>%
代码语言:javascript
复制
  arrange(sentiment)

最负面评论的ID为3748:

代码语言:javascript
复制
df [which(df $ ID == 3748),] $ review_body [1]

Github:https://github.com/susanli2016/Data-Analysis-with-R/blob/master/Text%20Mining%20Hilton%20Hawaiian%20Village%20TripAdvisor%20Reviews.Rmd

负责抓取的Python代码:https://github.com/susanli2016/NLP-with-Python/blob/master/Web%20scraping%20Hilton%20Hawaiian%20Village%20TripAdvisor%20Reviews.py

本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2018-08-09,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 ATYUN订阅号 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
目录
  • 加载库
  • 数据
  • 评论文本的文本挖掘
    • BIGRAM
    • TRIGRAM
    • 评论中的重要的词汇趋势
  • 情绪分析
  • 使用Bigrams在情感分析中提供语境
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档