咪蒙文章考

咪蒙文章考

载入必要的分析包

In strsplit(code, "\n", fixed = TRUE) :
  input string 1 is invalid in this locale

library(tidytext) # 整洁文本操作

载入文本数据

先载入我通过python爬取下来的文本 ps.R语言不能像python一样在字符串前面加上r修饰符，因为我的系统是windows，所以每次都要复制路径后，在每个\后面再手动插入一个\，不知道有没有人有更好的办法

text_path = "C:\\Users\\lhs\\Desktop\\TEMP\\Machine Learning\\Data Sets\\mimeng\\mimeng_text_cut_search.csv"
mimeng <- read_delim(text_path, delim = "\t")

Parsed with column specification:
cols(
  text = col_character(),
  title = col_character()
)

mimeng

原始文本一共两列，text和title。 title表示标题。 text是咪蒙文章中的每一段话，我事先在python中用jieba分词对每段话都进行了分词。

简单词频分析

我们先简单统计一下每篇文章的段落数量：

mimeng_p <- mimeng %>%
  group_by(title) %>%
  summarize(p_num = n()) %>%
  arrange(desc(p_num))
mimeng_p

段落数量最多的文章是《80本最棒的幼儿绘本推荐》,339段傲视群雄，看标题像篇软文，我找到原文看了一下，文章介绍了80个绘本，每个绘本下面配了一段介绍，所以是咪蒙最长的文章了，连她自己也在文章中吐槽自己写了篇1万字的长文。 我们把段落数量的频率分布直方图画出来，瞧一瞧整体的分布是啥样：

mimeng_p %>%
  ggplot(aes(p_num )) +
  geom_histogram(bins = 20) + 
  geom_vline(aes(xintercept = mean(mimeng_p$p_num[mimeng_p$p_num < 339])), size = 1, color = "red", linetype = 2) +
  labs(x = "文章段落数量",
       y = "篇数")

刨去推荐绘本的那片文章，咪蒙文章段落数量分布整体是很接近正态分布的，平均来看一篇文章大概90段是最常见的长度。

接下来我们将每段话转化为单个词。

mimeng_word <- mimeng %>%
  unnest_tokens(word, text)
mimeng_word

为每篇文章统计词频：

words <- mimeng_word %>%
  count(title, word, sort = TRUE)
words

我们挑选频数最高的词，画个条形图看一看：

words %>%
  count(word, wt = n, sort = TRUE) %>% 
  top_n(10, nn) %>%
  mutate(word = reorder(word, nn)) %>%
  ggplot(aes(word, nn)) +
  geom_col(show.legend = FALSE) +
  labs(x = "词条",
       y = NULL)  +
  coord_flip()

可以看到，词条中出现了很多意义不大的词条，我你他/她、的、了之类的，但其实咪蒙擅长以大白话的口吻以类似对话的方式编写文章，特别是标题，所以出现很多的人称代词就很正常了。

我们载入停止词，看看排除掉停止词后的咪蒙文章的词频如何。

my_stop_words <- read_csv("C:\\Users\\lhs\\Desktop\\TEMP\\Machine Learning\\Data Sets\\mimeng\\stopwords.csv")
words2 <- mimeng_word %>% 
  anti_join(my_stop_words) %>%
  count(title, word, sort = TRUE)
words2

去除掉停止词之后就很有意思了，我们看头十条数据，次数最多的北、宽、木、图、椰子和萌都是对应文章中的人名，而孩子和出版社是跟主题相关。可见咪蒙很喜欢讲故事，而出现频率最高的词理所当然也就是各篇文章中的男女主角了。

统计每个词在全部文章中出现的频率，并画出词频最高的20个单词的条形图：

words2 %>%
  count(word, wt = n, sort = TRUE) %>% 
  top_n(20, nn) %>%
  mutate(word = reorder(word, nn)) %>%
  ggplot(aes(word, nn)) +
  geom_col(show.legend = FALSE) +
  labs(x = "词条",
       y = NULL)  +
  coord_flip()

“说”这个词的频繁度真是远超其他一切动词，连中国人最爱的“吃”字在其面前也要汗颜。 “朋友”算是全文频次最高的名词了，在咪蒙的文章里是个不可撼动的角色，充分体现了她“我有一个朋友”型故事的本色，毕竟女生都爱跟朋友聊天、聊八卦。 紧接着“朋友”高频出现的名词就是“孩子”了，果然孩子是女人心中重要的主题之一，除了“孩子”，“喜欢”、“爱”、“买”、“钱”、“妈”这些词也是非常的普遍，跟现实中女生的话题偏好也是重合的。我觉得有意思的是男人这种群体倒是咪蒙文章中的稀有生物，包括”老公“、”爸“等，可见咪蒙对男人并不待见。我们看一下跟男性相关的词汇出现的频率：

In strsplit(code, "\n", fixed = TRUE) :
  input string 1 is invalid in this locale

words_men <- words2 %>%
  filter(word %in% men) %>%
  count(word, wt = n, sort = TRUE)
  
words_men

这些词汇，跟前面频次上千的话题比起来，真是九牛一毛。特别是“前夫”，尤其不招人待见~

画个词云看一下：

library(wordcloud2)
words2 %>%
  count(word, wt = n, sort = TRUE) %>% 
  head(100) %>%
  wordcloud2(color = "random-light", backgroundColor = "grey")

the condition has length > 1 and only the first element will be used

我们最后看一下根据tf-idf算出来的词汇排名：

words_tf_idf <- words2 %>%
  bind_tf_idf(word, title, n) %>%
  arrange(desc(tf_idf))
words_tf_idf

结果其实也差不多，排名靠前的主要也是人名，因为分词工具没办法正确识别出人名，而将人名切分成单个的字，所以导致一些人名的tf—idf的值很低。

文章情感分析

载入情感词典，本文采用大连理工大学情感词汇本体库（特别鸣谢~）：

library(readxl)
sen_path = "C:\\Users\\lhs\\Desktop\\TEMP\\Machine Learning\\Data Sets\\mimeng\\情感词汇本体.xlsx"
my_sentiments <- read_xlsx(sen_path)

Expecting logical in K26363 / R26363C11: got 'NE'Expecting logical in K26523 / R26523C11: got 'NC'

my_sentiments

其中极性表示褒贬，0代表中性，1代表褒义，2代表贬义，3代表不确定。 我们利用该情感词汇文本对咪蒙的文章进行情感打分：

word_sentiments <- words2 %>%
  inner_join(my_sentiments %>% select(`词语`, `极性`), by = c(word = "词语")) %>%
  filter(`极性` != 3) %>%
  mutate(sentiment = case_when(
    `极性` == 1 ~ 1,
    `极性` == 2 ~ -1,
    TRUE ~ 0
  ))
word_sentiments

我们统计一下总体上，不同词汇对文章情感的贡献度

total_contribution <- word_sentiments %>%
  count(word, wt = n * sentiment, sort = TRUE) %>%
  transmute(word = word, contribution = nn)
total_contribution

我们挑出贡献度最高的40个词汇看一下：

total_contribution %>%
  arrange(desc(abs(contribution))) %>%
  head(40) %>%
  mutate(word = reorder(word, contribution)) %>%
  ggplot(aes(word, contribution, fill = contribution > 0)) +
  geom_col(show.legend = FALSE) +
  labs(x = "词汇",
       y = "情感贡献") +
  coord_flip() +
  theme(axis.text.x = element_text(size = 15),
        axis.text.y = element_text(size = 15))

很明显，情感分析的结果被“朋友”、“喜欢”整两个词给带偏了。 首先，“朋友”更多只是一个没有褒贬含义的主语或者谓语，比如“我的一个朋友”。 而“喜欢”这个词更多的是在论述某个问题，比如“你喜欢不喜欢某个人”、“你喜不喜欢这个工作”等。

我们画个单词网络看看， 首先将文本拆分成二元组：

token_2grams <- function(string) {
  string1 <- str_split(string, " ")[[1]]
  string2 <- lead(string1)
  string2[is.na(string2)] <- ""
  
  str_c(string1, string2, sep = " ")
}
gen_2grams <- function(x) map(x, token_2grams)
mimeng_bigrams <- mimeng %>%
  unnest_tokens(bigram, text, token = gen_2grams)
bigrams_separated <- mimeng_bigrams %>%
  separate(bigram, c("word1", "word2"), sep = " ")
bigrams_filtered <-  bigrams_separated %>%
  filter(!word1 %in% my_stop_words$word) %>%
  filter(!word2 %in% my_stop_words$word)
bigrams_filtered

我们看看和朋友搭配的词语有哪些：

bigrams_filtered %>%
  filter(word1 == "朋友") %>%
  filter(!str_detect(word2, "朋友")) %>%
  count(word1, word2, sort = TRUE)

“朋友说”这个组合是频率最高的。

我们再把同时出现次数超过100次的词汇联系图画出来：

library(igraph)
library(ggraph)
set.seed(2018)
bigrams_filtered %>%
  filter(!(word1 == "" | word2 == "")) %>%
  count(word1, word2, sort = TRUE) %>%
  filter(n > 100) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = n, edge_width = n), edge_colour = "cyan4") +
  geom_node_point(size = 5) +
  geom_node_text(aes(label = name), repel = TRUE,
                 point.padding = unit(0.2, "lines")) +
  theme_void()

可以很明显看到，因为中文分词的原因，联系最紧密的词往往都是重合度很高的词，如“朋友-男朋友-女朋友-朋友圈” 我们把这类词过滤掉再看看：

bigrams_filtered %>%
  filter(!(word1 == "" | word2 == "")) %>%
  filter(!str_detect(word1, word2)) %>%
  filter(!str_detect(word2, word1)) %>%
  count(word1, word2, sort = TRUE) %>%
  filter(n > 80) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = n, edge_width = n), edge_colour = "cyan4") +
  geom_node_point(size = 5) +
  geom_node_text(aes(label = name), repel = TRUE,
                 point.padding = unit(0.2, "lines")) +
  theme_void()

主题建模

我们探索一下，咪蒙的文章可以分为哪些主题,这里采用LDA建模。

Warning message:
In strsplit(code, "\n", fixed = TRUE) :
  input string 1 is invalid in this locale

library(topicmodels)
mimeng_lda <- LDA(mimeng_dtm, k = 4, control = list(seed = 2018))
tidy_lda <- tidy(mimeng_lda)
tidy_lda

beta对应这个词在该文档中生成该主题中的概率，即这个词属于这个主题的概率。 我们再来看看每个主题排名前十的词汇：

top_terms <- tidy_lda %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)
top_terms

画出每个主题排名前十的词汇

top_terms %>%
  mutate(term = reorder(term, beta)) %>%
  group_by(topic, term) %>%
  arrange(desc(beta)) %>%
  ungroup() %>%
  mutate(term = factor(paste(term, topic, sep="__"),
                      levels = rev(paste(term, topic, sep = "__")))) %>%
  ggplot(aes(term, beta, fill = as.factor(topic))) +
  geom_col(show.legend = FALSE) +
  coord_flip() +
  scale_x_discrete(labels = function(x) gsub("__.+$", "", x)) +
  labs(title = "每个LDA主题中排名前十的词汇",
       x = NULL, y = expression(beta)) +
  facet_wrap(~ topic, ncol = 2, scales = "free")

第一个主题貌似是讲恋爱的， 第二个主题像是说孩子的， 第三个主题则是谈工作的， 第四个主题就是说妈妈的。 以上四个主题除了第二个的概率高一点，其余的概率都比较第，主题不是很清晰。

结语

这篇分析算是我学完《Text Mining with R》后的一次独立尝试，先后对词频、情感、主题进行了探索式分析。 总得来说，咪蒙的文章具有简短易读、故事性强等特点，涉及的话题为女性关注的焦点问题。 通过这次实践，也让自己对使用R语言进行文本分析有了进一步的提高。但整个过程依然存在不少问题，特别是中文文本的分词和情感分析，相较英语有着很大的分析难度，一方面是由于汉语言书写形式导致的分词困难，另一个就是中文自然语言处理相关的基础设施很不完善，比如情感语料库。希望中文的自然语言处理能越做越好，越做越开放，让普通人都能参与进来。 下次准备分析小马宋，你们说好不好~