1、读取数据

library(pacman)
p_load(dplyr,tidytext)

# 使用已经分好词的微信签名数据
txt <- read.csv("signature.jieba.csv",header = T,stringsAsFactors = F) %>%
  select(id,content) %>% filter(content != "")

2、n-grams增加文字信息量

如果是1-ngrams，有一句话：you need many money
分割成：

    terms
1: you 
2: need 
3: many 
4: money

那么2-ngrams呢？

        terms 
1: you need
2: need many
3: many money
4:  need many 

txt.grams <- txt %>% unnest_tokens(words,content,token = "ngrams",n=2);txt.grams

##       id         words
## 1   V102     修身 齐家
## 2   V102       齐家 兼
## 3   V102         兼 济
## 4   V102       济 天下
##  [ reached 'max' / getOption("max.print") -- omitted 2099 rows ]

3、n-grams的计数和过滤

# 计数。分词是对的，但是计数时显示分词不准确，可能是tidytext对中文支持不好
txt.n <- txt.grams %>% dplyr::count(words,sort = T);txt.n

## # A tibble: 2,340 x 2
##    words       n
##    <chr>   <int>
##  1 <NA>       20
##  2 才 是       7
##  3 的 人       6
##  4 每 一天     5
##  5 我 的       5
##  6 爱 自己     4
##  7 的 时候     4
##  8 都 是       4
##  9 而 不       4
## 10 命 里       4
## # ... with 2,330 more rows

# 将每一行按空格切分
txt.separate <- txt.grams %>% tidyr::separate(words,c("wd1","wd2"),sep=" ")
txt.separate

##       id      wd1    wd2
## 1   V102     修身   齐家
## 2   V102     齐家     兼
## 3   V102       兼     济
## 4   V102       济   天下

##  [ reached 'max' / getOption("max.print") -- omitted 2559 rows ]

# 加载停止词
stop.words <- read.csv("./dict/characters-master/stop_words",
                       col.names = "words",stringsAsFactors = F)

# 去除包含停止词的行
txt.filter <- txt.separate %>%
  filter(!wd1 %in% stop.words$words) %>%
  filter(!wd2 %in% stop.words$words) ;txt.filter

# 重新计数
txt.count <- txt.filter %>% dplyr::count(wd1,wd2,sort = T);txt.count

## # A tibble: 2,330 x 3
##    wd1   wd2       n
##    <chr> <chr> <int>
##  1 <NA>  <NA>     20
##  2 才    是        7
##  3 的    人        6
##  4 每    一天      5
##  5 我    的        5
##  6 爱    自己      4
##  7 的    时候      4
##  8 都    是        4
##  9 而    不        4
## 10 命    里        4
## # ... with 2,320 more rows

# 再次组合，从而清除不包含停止词的词语组合
txt.united <- txt.filter %>%
  tidyr::unite(words,wd1,wd2,sep = " ");txt.united

##       id         words
## 1   V102     修身 齐家
## 2   V102       齐家 兼
## 3   V102         兼 济
## 4   V102       济 天下

##  [ reached 'max' / getOption("max.print") -- omitted 2539 rows ]

4、TF-IDF矩阵

检查词语组合的 tf-idf 相比检查单个词语的有利也有弊。词语组合可能捕捉到单词计数时没有出现的结构，并且可能提供使单词更容易理解的上下文(例如“格外 清晰”比“清晰”的信息量更大)。 然而“格外 清晰”的数量组合也很少：词语组合对比它的任何一个组成词都要稀少。 因此，当您有一个非常大的文本数据集时，bigrams 可能特别有用。

txt.tf.idf <- txt.united %>%
  dplyr::count(words,id,sort = T) %>%
  bind_tf_idf(words,id,n) %>%
  arrange(desc(tf_idf));head(txt.tf.idf)

## # A tibble: 6 x 6
##   words     id        n    tf   idf tf_idf
##   <chr>     <chr> <int> <dbl> <dbl>  <dbl>
## 1 啦 啦     V518      2     1  5.97   5.97
## 2 爱 家人   V498      1     1  5.97   5.97
## 3 宝藏 女孩 V627      1     1  5.97   5.97
## 4 点点 妈妈 V93       1     1  5.97   5.97
## 5 殿 武     V425      1     1  5.97   5.97
## 6 独自 旅行 V60       1     1  5.97   5.97

5、使用n-grams语料进行情绪分析

在前面的情感分析中（30-tidytext包学习：文本整理与情绪分析：https://www.jianshu.com/p/5620b63f15f5）仅仅是根据一个词汇来计算积极或消极词汇的出现次数。这种方法的一个问题是，一个词的上下文也很重要。 例如，“高兴”和“喜欢”这两个词会被视为积极的，即使是在“我不高兴，我不喜欢它!”这样的句子中。通过对 bigram 数据进行情绪分析，我们可以检查与情绪相关的词前面是否存在“不”或其他否定词。利用这一点来忽略甚至逆转他们对情绪得分的贡献。

negation.words <- c("不","不是","从不","没有")
txt.negation <- txt.separate %>%
  filter(wd1 %in% negation.words) %>%
  count(wd1,wd2,id,sort = TRUE);txt.negation

## # A tibble: 53 x 4
##    wd1   wd2   id        n
##    <chr> <chr> <chr> <int>
##  1 不    可以  V401      2
##  2 不    辩    V326      1
##  3 不    读书  V401      1
##  4 不    多    V159      1
##  5 不    多    V76       1
##  6 不    付出  V149      1
##  7 不    辜负  V420      1
##  8 不    归    V516      1
##  9 不    害怕  V571      1
## 10 不    好奇  V546      1
## # ... with 43 more rows

另一方面，在给情感词赋权程度分值的时候，为了减少该词在“错误”的方向上的贡献，可以根据其前面出现否定词的频率适当降低分值。

6、bigram的网络图

p_load(igraph)
txt.separate %>%
  filter(wd1 %in% negation.words) %>%
  count(wd1,wd2,sort = TRUE) %>%
  graph_from_data_frame()

## IGRAPH 2546b8d DN-- 54 51 -- 
## + attr: name (v/c), n (e/n)
## + edges from 2546b8d (vertex names):
##  [1] 不  ->多   不  ->可以 不  ->困于 不  ->辩  
##  [5] 不  ->读书 不  ->付出 不  ->辜负 不  ->归  
##  [9] 不  ->害怕 不  ->好奇 不  ->后悔 不  ->坚强
## [13] 不  ->将   不  ->经   不  ->惊   不  ->卡  
## [17] 不  ->开始 不  ->哭   不  ->离   不  ->恋  
## [21] 不  ->怒   不  ->弃   不  ->轻言 不  ->轻易
## [25] 不  ->入   不  ->上学 不  ->是   不  ->谈  
## [29] 不  ->唐   不  ->完美 不  ->忘   不  ->写  
## + ... omitted several edges

p_load(ggraph)
txt.separate %>%
  filter(wd1 %in% negation.words) %>%
  count(wd1,wd2,sort = TRUE) %>%
  ggraph(layout = "fr") +
  geom_edge_link() +
  geom_node_point() +
  geom_node_text(aes(label=name),vjust=1,hjust=1)

网络图

6、马尔可夫链（Markov chain）

a <- grid::arrow(type = "closed",length = unit(.15,"inches"))

txt.separate %>%
  filter(wd1=="好") %>%
  count(wd1,wd2,sort = TRUE) %>%
  ggraph(layout = "fr") +
      geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
  theme_void()

马尔可夫链

7、找出签名数据中常见的词语组合

p_load(widyr)

word.pairs <- txt %>%
  unnest_tokens(content,content) %>%
  filter(!content %in% stop.words) %>%
  pairwise_count(content,id,sort=T);word.pairs

## # A tibble: 20,482 x 3
##    item1 item2     n
##    <chr> <chr> <dbl>
##  1 是    的       26
##  2 的    是       26
##  3 你    的       14
##  4 的    你       14
##  5 的    有       10
##  6 的    我       10
##  7 有    的       10
##  8 我    的       10
##  9 人    的       10
## 10 的    人       10
## # ... with 20,472 more rows

# 找出第二个词为“的”的词语组合
word.pairs %>% filter(item2=="的")

## # A tibble: 460 x 3
##    item1 item2     n
##    <chr> <chr> <dbl>
##  1 是    的       26
##  2 你    的       14
##  3 有    的       10
##  4 我    的       10
##  5 人    的       10
##  6 了    的        8
##  7 都    的        8
##  8 自己  的        8
##  9 在    的        7
## 10 和    的        7
## # ... with 450 more rows

8、词语组合之间的相关性

word.cors <- txt %>%
  unnest_tokens(content,content) %>%
  dplyr::count(content,id,sort = T) %>%
  group_by(id) %>%
  filter(n>3) %>%
  pairwise_cor(content,id,sort=T);word.cors

## # A tibble: 20 x 3
##    item1 item2 correlation
##    <chr> <chr>       <dbl>
##  1 可以  不          1    
##  2 不    可以        1    
##  3 决定  不         -0.333
##  4 再    不         -0.333
##  5 珍惜  不         -0.333
##  6 不    决定       -0.333
##  7 可以  决定       -0.333
##  8 再    决定       -0.333
##  9 珍惜  决定       -0.333
## 10 决定  可以       -0.333
## 11 再    可以       -0.333
## 12 珍惜  可以       -0.333
## 13 不    再         -0.333
## 14 决定  再         -0.333
## 15 可以  再         -0.333
## 16 珍惜  再         -0.333
## 17 不    珍惜       -0.333
## 18 决定  珍惜       -0.333
## 19 可以  珍惜       -0.333
## 20 再    珍惜       -0.333

# 找出与“珍惜”最相关的词语
word.cors %>% filter(item1=="珍惜")

## # A tibble: 4 x 3
##   item1 item2 correlation
##   <chr> <chr>       <dbl>
## 1 珍惜  不         -0.333
## 2 珍惜  决定       -0.333
## 3 珍惜  可以       -0.333
## 4 珍惜  再         -0.333

# 连线的颜色深浅代表关系的强弱
word.cors %>%
  filter(correlation < 0) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name), repel = TRUE) +
  theme_void()

词语相关性