---
title: "第10章: 文本挖掘和社交网络分析"
output:
  html_document:
    df_print: default
---

## 统一设置ggplot2的绘图风格

```{r}
library(ggplot2)
theme_set(theme_bw(base_family = "STKaiti"))

```



## 10.1：文本数据预处理

数据网址：http://www.cs.cornell.edu/people/pabo/movie-review-data/

### 英文文本预处理

该数据集为电影评论数据集，一共有1000条正向的评论和1000条负向的评论

### 数据读取，从文件夹中批量读取数据

```{r}
library(stringr)

## 从文件夹中批量读取数据
# 查看工作文件夹下的文件名
flodername <- "data/chap10/review_polarity/txt_sentoken/neg"
filenames <- dir(flodername)
length(filenames)  ## 100个数据文件
head(filenames)
## 连接每个评论文件的工作目录
filenames <- str_c(flodername,filenames,sep = "/")
head(filenames)
## 定义读取单个文本的函数
readonetxt <- function(fn){
  return(readChar(fn,file.info(fn)$size))
}
## 读取所有文件
neg_text <- sapply(filenames, readonetxt)
length(neg_text)  
neg_text[[1]]
## 以相同的方法读取pos文件夹里的数据
flodername <- "data/chap10/review_polarity/txt_sentoken/pos"
filenames <- dir(flodername)
length(filenames)  ## 100个数据文件
head(filenames)
## 连接每个评论文件的工作目录
filenames <- str_c(flodername,filenames,sep = "/")
head(filenames)
## 读取所有文件
pos_text <- sapply(filenames, readonetxt)
length(pos_text)  
pos_text[[1]]

## 连接两个list文本文件
polarity <- append(pos_text,neg_text)
length(polarity)
## 删除列表的名称
names(polarity) <- NULL
length(polarity[[1]])


## 探索这2000条文档中，每个文档包含多少个字符
charnum <- as.vector(sapply(polarity,nchar))
hist(charnum,breaks = 20)

```

### 对文本数据进行预处理和探索

```{r}
library(tm)

## 创建一个语料库,前1000条为正向内容，后1000条为负向内容
pol_cp <- Corpus(VectorSource(polarity))
## 输出语料库的内容
print(pol_cp)

## 查看语料库中的内容
inspect(pol_cp[1])

pol_cp[[1]]$meta

##  tm_map() 作用于语料库上的转换函数，和lapply函数的用法相似，都是并行运算

## 去处语料库中的所有数字
pol_clearn <- tm_map(pol_cp,removeNumbers)
inspect(pol_clearn[1])
## 从文本文档中删除标点符号
pol_clearn <- tm_map(pol_clearn,removePunctuation)
inspect(pol_clearn[1])
## 将所有的字母均转化为小写
pol_clearn <- tm_map(pol_clearn,tolower)
inspect(pol_clearn[1])
## 去除停用词
pol_clearn <- tm_map(pol_clearn,removeWords,stopwords())
inspect(pol_clearn[1])
head(stopwords())
## 去除额外的空格
pol_clearn <- tm_map(pol_clearn,stripWhitespace)
inspect(pol_clearn[1])

## 清洗语料库

inspect(pol_cp[c(1,1001)])
inspect(pol_clearn[c(1,1001)])
```

### 文本数据可视化

```{r}
library(RColorBrewer)
library(wordcloud)
library(wordcloud2)

## 将清洗好的语料库转化为文档－词项矩阵
pol_dtm <- DocumentTermMatrix(pol_clearn)
dim(pol_dtm)
## 查看每个词语的词频
freq.terms <- sort(colSums(as.matrix(pol_dtm)),decreasing = TRUE)
freq.terms <- data.frame(name = names(freq.terms),
                         fre = freq.terms,row.names = NULL)
head(freq.terms,10)

length(which(freq.terms$fre>500))

## 可视化所有文档的词云
set.seed(375) # to make it reproducible
wordcloud(words=freq.terms$name, freq=freq.terms$fre,
          min.freq = 500,random.color = FALSE,
          scale=c(4,0.5), colors=brewer.pal(8,"Dark2"))


##  对比分析两种不同情感的评论的词云,使用可交互的词云
## 计算不同类型数据的词频
freq.pos <- sort(colSums(as.matrix(pol_dtm[1:1000,])),decreasing = TRUE)
freq.pos <- data.frame(name = names(freq.pos),fre = freq.pos,
                       row.names = NULL)
freq.neg <- sort(colSums(as.matrix(pol_dtm[1001:2000,])),decreasing = TRUE)
freq.neg <- data.frame(name = names(freq.neg),fre = freq.neg,
                       row.names = NULL)

dim(freq.neg[freq.neg$fre>300,])
set.seed(375)
freq.neg[freq.neg$fre>200,] %>%
  wordcloud2()
freq.pos[freq.pos$fre>200,] %>%
  wordcloud2()
```

### 将文本数据从语料库中转化为dataframe

```{r}

## 将文本数据从语料库中转化为dataframe
polaritydf <- data.frame(text=sapply(pol_clearn, identity), stringsAsFactors=F)
polaritydf$label <- rep(c("pos","neg"),each = 1000)
head(polaritydf,2)

## 对比分析两种情感评论的用词长度
wordlist <- str_split(polaritydf$text,"[[:space:]]+")
wordlen <- unlist(lapply(wordlist,length))
polaritydf$wordlen <- wordlen

ggplot(polaritydf,aes(x = label,y = wordlen))+
  geom_violin(fill = "red",alpha = 0.5)

t.test(wordlen~label,data = polaritydf)
## mean in group neg mean in group pos 
##           337.027           377.339 
## 说明人们愿意写更多的字来表达正向的情感。

## 将处理好的数据表格保存
write.csv(polaritydf,"data/chap10/review_polarity.csv",row.names = FALSE)

```


### 中文文本预处理

红楼梦数据集预处理，使用jiebar分词

```{r}
library(jiebaR)
library(stringr)
library(parallel)
library(ggplot2)
library(GGally)
library(ggExtra)
library(tm)
library(wordcloud2)
library(dplyr)
## 读取停用词
filename <- "data/chap10/Red_dream/红楼梦停用词.txt"
mystopwords <- readLines(filename)
## 读取红楼梦文本
filename <-"data/chap10/Red_dream/红楼梦文本_UTF8.txt"
Red_dream <- readLines(filename,encoding='UTF-8')
head(Red_dream)

## 提取读入的文本的每个章节数据
## 去除空白行
Red_dream <- Red_dream[!is.na(Red_dream)]

## 删除卷数据
juan <- grep(Red_dream,pattern = "^第+.+卷")
Red_dream <- Red_dream[(-juan)]
## 找出每一章节的头部行数和尾部行数
## 每一章节的名字
nameindex <- grep(Red_dream,pattern = "^第+.+回")
Red_dreamname <- data.frame(name = Red_dream[nameindex],
                            chapter = 1:120)
head(Red_dreamname)
## 处理章节名,切分字符串
names <- data.frame(str_split(Red_dreamname$name,pattern = " ",simplify =TRUE))
Red_dreamname$chapter2 <- names$X1
## 连接字符串
Red_dreamname$Name <- apply(names[,2:3],1,str_c,collapse = ",")
## 每章的开始行数
Red_dreamname$chapbegin<- grep(Red_dream,pattern = "^第+.+回")
## 每章的结束行数
Red_dreamname$chapend <- c((Red_dreamname$chapbegin-1)[-1],length(Red_dream))
## 每章的段落长度
Red_dreamname$chaplen <- Red_dreamname$chapend - Red_dreamname$chapbegin
## 每章的内容
for (ii in 1:nrow(Red_dreamname)){
  ## 将一章的所有段落连接起来连接
  chapstrs <- str_c(Red_dream[(Red_dreamname$chapbegin[ii]+1):Red_dreamname$chapend[ii]],collapse = "")
  ## 剔除不必要的空格
  Red_dreamname$content[ii] <- str_replace_all(chapstrs,pattern = "[[:blank:]]",replacement = "")
}
## 每章节的内容
content <- Red_dreamname$content
Red_dreamname$content <- NULL
## 计算每章有多少个字
Red_dreamname$numchars <- nchar(content)
head(Red_dreamname)

## save(content,file = "data/chap10/Readdream_content.RData")
```


### 分词等相关的操作

```{r}
##-----------------------------------------------------------------------
## 对红楼梦进行分词####
## 使用自定义词典的分词器,分词方式为"mix"：最大概率分割模型
Red_fen <- jiebaR::worker(type = "mix",
                          user = "data/chap10/Red_dream/红楼梦词典.txt")
Fen_red <- apply_list(as.list(content),Red_fen)
length(Fen_red)

lapply(Fen_red[1:5],head)

# 第10章的分词结果的抽样
Fen_red[[10]][20:40]

## 去除停用词,使用并行的方法

cl <- makeCluster(4)
Fen_red <- parLapply(cl = cl,Fen_red, filter_segment,filter_words=mystopwords)
stopCluster(cl)
# Fen_red <- lapply(Fen_red, filter_segment,filter_words=mystopwords)
## 每章节最终有多少个词
Red_dreamname$wordlen <- unlist(lapply(Fen_red,length))
## 添加分组变量，前80章为1组，后40章为2组
Red_dreamname$Group <- factor(rep(c(1,2),times = c(80,40)),
                              labels = c("前80章","后40章"))
Red_dreamname$name <- NULL
head(Red_dreamname)


## 对每章的内容进行探索分析####
## 对相关章节进行分析
## 每章节的段落长度
p1 <- ggplot(Red_dreamname,aes(x = chapter,y = chaplen)) +
  theme_bw(base_family = "STKaiti",base_size = 10) +
  geom_point(colour = "red",size = 1) +geom_line() +
  geom_text(aes(x = 25,y = 0.9*max(Red_dreamname$chaplen)),
            label="前80章",family = "STKaiti",colour = "Red") +
  geom_text(aes(x = 100,y = 0.9*max(Red_dreamname$chaplen)),
            label="后40章",family = "STKaiti",colour = "Red") +
  geom_vline(xintercept = 80.5,colour = "blue") +
  labs(x = "章节",y = "段数",title = "《红楼梦》每章段数")
## 每章节的字数
p2 <- ggplot(Red_dreamname,aes(x = chapter,y = numchars)) +
  theme_bw(base_family = "STKaiti",base_size = 10) +
  geom_point(colour = "red",size = 1) +geom_line() +
  geom_text(aes(x = 25,y = 0.9*max(Red_dreamname$numchars)),
            label="前80章",family = "STKaiti",colour = "Red") +
  geom_text(aes(x = 100,y = 0.9*max(Red_dreamname$numchars)),
            label="后40章",family = "STKaiti",colour = "Red") +
  geom_vline(xintercept = 80.5,colour = "blue") +
  labs(x = "章节",y = "字数",title = "《红楼梦》每章字数")

p3 <- ggplot(Red_dreamname,aes(x = chapter,y = wordlen)) +
  theme_bw(base_family = "STKaiti",base_size = 10) +
  geom_point(colour = "red",size = 1) +geom_line() +
  geom_text(aes(x = 25,y = 0.9*max(Red_dreamname$wordlen)),
            label="前80章",family = "STKaiti",colour = "Red") +
  geom_text(aes(x = 100,y = 0.9*max(Red_dreamname$wordlen)),
            label="后40章",family = "STKaiti",colour = "Red") +
  geom_vline(xintercept = 80.5,colour = "blue") +
  labs(x = "章节",y = "词数",title = "《红楼梦》每章词数")
## 绘制每一章节的平行坐标图
p4 <- ggparcoord(Red_dreamname,columns = 6:8,scale = "center",
                 groupColumn = "Group",showPoints = TRUE,
                 title = "《红楼梦》") +
  theme_bw(base_family = "STKaiti",base_size = 10) +
  theme(legend.position =  "bottom",axis.title.x = element_blank()) +
  scale_x_discrete(labels = c("断落数","字数","词数")) +
  ylab("中心化数据大小")
  
gridExtra::grid.arrange(p1,p2,p3,p4,ncol = 2)

## 针对前80章和后40章在段数、字数和词数是否有差异进行检验
colnames(Red_dreamname)
t.test(chaplen~Group,data = Red_dreamname)

t.test(numchars~Group,data = Red_dreamname)

t.test(wordlen~Group,data = Red_dreamname)
## 从t检验结果可以发现，前80章与后40章的段落数差异较大，
## 但字数、词数的差异在显著性水平为0.05下是不显著的

```

## 统计词频并可视化为词云

```{r}

## 去除分词中的无效字符
Fen_red2 <- Fen_red
for(ii in 1:length(Fen_red)){
  Fenone <- str_c(Fen_red[ii],sep = " ") 
  # 删除标点
  Fenone <- str_remove_all(Fenone,pattern = "[:punct:]")
  # 删除\n
  Fenone <- str_remove_all(Fenone,pattern = "\n")
  # 删除c
  Fenone <- str_remove_all(Fenone,pattern = "c")
  Fen_red2[ii] <- Fenone
}


## 词频统计##-----------------------------------------------------------
## 1:构建文档－词项频数矩阵
#corpus <- Corpus(VectorSource(Fen_red))
corpus <- Corpus(VectorSource(Fen_red2))
Red_dtm <- DocumentTermMatrix(corpus,control = list(wordLengths=c(1,Inf)))
Red_dtm

## 2:词频统计
word_freq <- sort(colSums(as.matrix(Red_dtm)),decreasing = TRUE)
word_freq <- data.frame(word = names(word_freq),freq=word_freq,row.names = NULL)
head(word_freq)

dim(word_freq[word_freq$freq >= 300,])
## 绘制词频图
nn = 300
word_freq[word_freq$freq >= nn,] %>%
  ggplot(aes(x = reorder(word,-freq),y = freq)) +
  theme_bw(base_size = 12,base_family = "STKaiti") +
  geom_bar(stat = "identity",fill= "red",colour = "lightblue",alpha = 0.6) +
  scale_x_discrete() +
  theme(axis.text.x = element_text(angle = 75,hjust = 1,size = 8),
        plot.title = element_text(hjust = 0.5)) +
  labs(x = "词项",y = "频数",title = "《红楼梦》词频图")


##  可交互的红楼梦词云

## 动态词云
set.seed(123)
word_freq[word_freq$freq>60,] %>%
  wordcloud2(color = 'random-dark',backgroundColor = "white",
             shape = 'star' )


```


## 10.2：文本主题模型挖掘

### 电影评论数据的LDA主题模型

```{r}
library(lda)
library(LDAvis)
library(stringr)
library(servr)
## 读取数据
polarity <- read.csv("data/chap10/review_polarity.csv")
textlist <- str_split(polarity$text,"[[:space:]]+")
## 计算词的频率

# 获取模型所需要使用的词库
term_table <- table(unlist(textlist))
term_table <- sort(term_table, decreasing = TRUE)
term_table[1:20]
dim(term_table)
## 剔除空的数据
del <- (names(term_table)) %in% c("")
term_table <- term_table[!del]
dim(term_table)
# 删除出现次数小于10次的词语
del <- term_table < 10
term_table <- term_table[!del]
vocab <- names(term_table)

# 将数据整理为lda包可使用的形式
get_terms <- function(x) {
  index <- match(x, vocab)
  index <- index[!is.na(index)]
  rbind(as.integer(index - 1), as.integer(rep(1, length(index))))
}
documents <- lapply(textlist, get_terms)

## documents[[i]]：表示第i个文档
## documents[[i]][1,j] : 表示文档i中第j个单词对应在词库中的（索引－1）
## documents[[i]][2,j] : 表示文档i中第j个单词出现的次数

## 使用lda模型
alpha <-  0.02
eta <- 0.02
set.seed(357)
t1 <- Sys.time()
fit <- lda.collapsed.gibbs.sampler(documents = documents, K = 4, 
                                   vocab = vocab, 
                                   num.iterations = 50, alpha = alpha, 
                                   eta = eta, initial = NULL, burnin = 0,
                                   compute.log.likelihood = TRUE)
t2 <- Sys.time()
t2 - t1  # about 24 minutes on laptop

dim(fit$topics)
## 可视化lda模型
## 对模型进行可视化

theta <- t(apply(fit$document_sums + alpha, 2, function(x) x/sum(x)))
phi <- t(apply(t(fit$topics) + eta, 2, function(x) x/sum(x)))
doc_length <- sapply(documents, function(x) sum(x[2, ]))
term_frequency <- as.vector(term_table)
pol_ldavis <- list(phi = phi,theta = theta,doc_length = doc_length,
                   vocab = vocab,term_frequency = term_frequency)

# create the JSON object to feed the visualization:
json <- createJSON(phi = pol_ldavis$phi, 
                   theta = pol_ldavis$theta, 
                   doc.length = pol_ldavis$doc_length, 
                   vocab = pol_ldavis$vocab, 
                   term.frequency = pol_ldavis$term_frequency)

serVis(json, out.dir = "data/chap10/vis")



```


## 使用topicmodel包进行LDA主题模型分析

### 使用《红楼梦》数据集的文档－词项矩阵Red_dtm

```{r}
library(topicmodels)
library(tidytext)
library(tidyr)
Red_dtm
## 减少文档－词项矩阵Red_dtm的稀疏性
Red_dtm2 <- removeSparseTerms(Red_dtm,0.98)
Red_dtm2
## 词项从原来的4万多减少到8000多

## LDA主题模型
lda <- LDA(Red_dtm2,k = 2,method= "Gibbs",
                control = list(seed = 1234))

lda
## 查看每个主题都有哪些词,每个主题的前10个词
terms(lda,10)
## 每个文档最有可能的主题
d_topic <- topics(lda,1)
table(d_topic)

## 计算每个词项属于每个主题的可能性，词项－主题矩阵
term_topics <- tidy(lda, matrix = "beta")
## 数据有三列，分别为主题，词项和对应的取值大小
head(term_topics,20)
## 将3个变量的数组转化词项－主题矩阵
term_topicsm <- spread(term_topics,key = "topic",value = "beta")
colna <- colnames(term_topicsm)
colnames(term_topicsm) <- c(colna[1],paste("topic",
                                         colna[-1],sep = ""))

## 可视化每个主题的常用词
topicplotdata <- term_topics %>% group_by(topic) %>%
  ## 前30个词
  top_n(30,beta)%>%ungroup()%>%
  arrange(topic,desc(beta))%>%
  mutate(term = reorder(term, beta))
head(topicplotdata)
## 直方图
ggplot(topicplotdata,aes(x = term,y = beta))+
  geom_bar(aes(fill = factor(topic)),stat = "identity",
           show.legend = FALSE)+
  facet_wrap(~topic,scales = "free",ncol = 2)+
  coord_flip()+
  theme(axis.text.x = element_text(size = 6))+
  labs(x = "",y = "")
  
  

## 文档主题矩阵，即：评论－主题矩阵
doc_topics <- tidy(lda, matrix = "gamma")
doc_topics$document <- as.integer(doc_topics$document)
doc_topics$topic <- factor(doc_topics$topic)
## 数据有三列，分别为文档，词项和对应的取值大小
head(doc_topics,20)
## 直方图可视化属于相应主题的可能性
ggplot(doc_topics,aes(x = document,y = gamma,fill = topic))+
  geom_bar(stat = "identity")+
  geom_hline(yintercept = 0.5)+
  geom_vline(xintercept = 80)+
  labs(x = "章节",y = "可能性",
       title = "《红楼梦》每章表示的主题")+
  theme(legend.position = "top",
        plot.title = element_text(hjust = 0.5))+
  scale_x_continuous(seq(0,120,by = 10),seq(0,120,by = 10))
  


```



## 10.3：文本情感分析

情感分析（Sentiment analysis），又称倾向性分析，意见抽取（Opinion extraction），意见挖掘（Opinion mining），情感挖掘（Sentiment mining），主观分析（Subjectivity analysis）等，它是对带有情感色彩的主观性文本进行分析、处理、归纳和推理的过程，如从评论文本中分析用户对“数码相机”的“变焦、价格、大小、重量、闪光、易用性”等属性的情感倾向。

### 使用n-gramt特征的TF－IDF矩阵和glmnet包lasso分类模型进行情感分类。

```{r}
library(text2vec)
library(dplyr)
library(glmnet)
library(Metrics)
##  使用无监督的方式来识别评论的情感
polarity <- read.csv("data/chap10/review_polarity.csv",
                     stringsAsFactors = FALSE)
polarity$label2 <- as.factor(ifelse(polarity$label == "neg", 0,1))
## 切分训练集和测试集,70%训练，30%测试
set.seed(123)
index <- sample(nrow(polarity),round(nrow(polarity)*0.7))
pol_train <- polarity[index,]
pol_test <- polarity[-index,]
## 对训练集和测试集进行处理，获取分类所需的N-grams分类特征
## 数据集迭代器
pol_train_it <- pol_train$text%>%word_tokenizer()%>%itoken()
## 获取N-grams得到的词,并对词库进行修剪
vocab = create_vocabulary(pol_train_it, ngram = c(1L, 2L))%>%
  prune_vocabulary(term_count_min=15,doc_proportion_max=0.5)
## 得到每个词项的哈希矢量化
vocab_vect <- vocab_vectorizer(vocab)
## 计算TF——IDF矩阵
pol_train_tfidf <- create_dtm(pol_train_it,vocab_vect)%>%
  fit_transform(TfIdf$new())
dim(pol_train_tfidf)
## 获取测试集特征
pol_test_it <- pol_test$text%>%word_tokenizer()%>%itoken()
pol_test_tfidf <- create_dtm(pol_test_it,vocab_vect)%>%
  fit_transform(TfIdf$new())
dim(pol_test_tfidf)

## 使用Lasso分类器进行二分类模型
set.seed(123)
lasso_cv = cv.glmnet(x = pol_train_tfidf, y = pol_train$label2,alpha = 1,
                     family = 'binomial',type.measure = "auc",
                     nfolds = 3,maxit = 1e3)

## 可视化不同参数下训练集的精度
plot(lasso_cv)
## 使用最优的lambda参数训练分类器
lasso_cv$lambda.min
best_lam <- lasso_cv$lambda.min
lasso_cla <- glmnet(x = pol_train_tfidf, y = pol_train$label2,
                    family = 'binomial',alpha = 1,
                    lambda = best_lam,maxit = 1e3)
summary(lasso_cla)
lasso_cla
## 输出在测试集上的识别精度
test_pre <- predict(lasso_cla,pol_test_tfidf)
test_pre <- ifelse(test_pre > 0.5,1,0)
sprintf("在测试集上的情感识别精度为: %f",accuracy(pol_test$label2,test_pre))
table(pol_test$label2,test_pre)
```

这里主要使用无监督的情感分析方法

### 评论数据的情感分类

```{r}
library(gmodels)
library(SentimentAnalysis)
library(tm)
##  使用无监督的方式来识别评论的情感
polarity <- read.csv("data/chap10/review_polarity.csv",
                     stringsAsFactors = FALSE)
polarity$label2 <- ifelse(polarity$label == "neg", "negative","positive")
pol_cp <- Corpus(VectorSource(polarity$text))
pol_dtm <- DocumentTermMatrix(pol_cp)
result <- analyzeSentiment(pol_dtm,removeStopwords = FALSE)
head(result)
## 可视化情感得分
plotSentiment(result$SentimentLM)
## LM: Loughran-McDonald Financial dictionary
## GI: Harvard-IV dictionary as used in the General Inquirer software
## HE: Henry’s Financial dictionary
## QDAP:qdap package dictionary

## 将情感得分转化为两种情感
result01 <- convertToBinaryResponse(result)
head(result01)

summary(result01[,c("SentimentGI","SentimentHE","SentimentLM","SentimentQDAP")])
## 检查不同词典和实际的情感是否识别一致
table(result01$SentimentGI,polarity$label2)
CrossTable(result01$SentimentGI,polarity$label2,prop.r=F, prop.c=T,
           prop.t=F, prop.chisq=F)
CrossTable(result01$SentimentHE,polarity$label2,prop.r=F, prop.c=T,
           prop.t=F, prop.chisq=F)
CrossTable(result01$SentimentLM,polarity$label2,prop.r=F, prop.c=T,
           prop.t=F, prop.chisq=F)

CrossTable(result01$SentimentQDAP,polarity$label2,prop.r=F, prop.c=T,
           prop.t=F, prop.chisq=F)
## 
table(result01$SentimentGI,polarity$label2)
table(result01$SentimentHE,polarity$label2)
table(result01$SentimentLM,polarity$label2)
table(result01$SentimentQDAP,polarity$label2)



```

### 红楼梦数据的无监督情感走向

```{r}
library(jiebaR)
library(ggplot2)
library(dplyr)
library(tidyr)
##  读取数据
load("data/chap10/Readdream_content.RData")
## 读取情感辞典
ntusd_neg <- readLines("data/chap10/ntusd-negative.txt",warn = F)
ntusd_pos <- readLines("data/chap10/ntusd-positive.txt",warn = F)
length(ntusd_neg)
length(ntusd_pos)

## 将两个情感词典也作为分词的词典进行分词
Red_fen <- jiebaR::worker(type = "mix",
                          user = "data/chap10/Red_dream/红楼梦词典.txt")

new_user_word(Red_fen,ntusd_neg)
new_user_word(Red_fen,ntusd_pos)
Fen_red <- apply_list(as.list(content),Red_fen)
## 去除停用词
mystopwords <- readLines("data/chap10/Red_dream/红楼梦停用词.txt")
Fen_red <- lapply(Fen_red, filter_segment,filter_words=mystopwords)
length(Fen_red)

lapply(Fen_red[1:5],head)

## 简单的方式，就是计算分词后的文本中，有多少negative和positive的词语
neg_score <- unlist(as.vector(lapply(Fen_red, function(x){sum(x %in% ntusd_neg)})))
pos_score <- unlist(as.vector(lapply(Fen_red, function(x){sum(x %in% ntusd_pos)})))
red_pol <- data.frame(neg_score=-neg_score,pos_score=pos_score,
                      chap = 1:120)
head(red_pol)
## 可视化每个章节积极词汇和消极词汇使用的数量
red_pol%>%gather(key = "pol",value = "score",-chap)%>%
  ggplot(aes(x =chap,fill =pol))+
  geom_bar(aes(y = score),stat = "identity")+
  theme(legend.position = "top")+
  labs(x = "章节",y = "得分",title = "《红楼梦》各章情感")+
  theme(plot.title = element_text(hjust = 0.5))
  


```


## 10.4：网络数据可视化及描述


```{r}
## 社交网络数据可视化
library(igraph)
library(igraphdata)
library(ggplot2)
## 读取并查看数据
data("karate")
karate

## 因为网络图形式的数据并不容易理解，转化为数据表格的形式
## 将网络图数据转化为数据表
karate_df <- as_data_frame(karate,what = "both")
head(karate_df$vertices)
head(karate_df$edges)


## 弹簧模型图网络图可视化
set.seed(12)
plot(karate,layout = layout.fruchterman.reingold)
karate2 <- karate
## 可视化调整后的图像
# 生成节点的颜色和形状
colrs <- c("pink","tomato", "gold")
V(karate2)$color <- colrs[V(karate2)$color]
## 单独设置主管和教练节点的颜色
V(karate2)[V(karate2)$label %in% c("H","A")]$color <- "lightblue"
## 调整节点的形状
V(karate2)$shape <- "circle"
V(karate2)[V(karate2)$label %in% c("H","A")]$shape <- "rectangle"
## 设置节点的大小
V(karate2)$size <- 12+degree(karate2)
## 设置边的粗细
E(karate2)$width <- E(karate2)$weight
## 可视化调整后的网络图
plot(karate2,layout = layout.fruchterman.reingold)


```

图的相关描述

```{r}
## 图的描述
## 查看每个节点的度
degree(karate)
## 判断图是否为简单图
is.simple(karate)
## 查看图中某个节点的邻居节点
neighbors(karate,"Mr Hi")
## 判断图是否为连通图
is.connected(karate)
## 计算图的直径
diameter(karate,directed = F)
## 判断图是否为有向无环图
is.dag(karate)
## 计算边的数目
ecount(karate)
## 计算节点的数目
vcount(karate)
## 计算节点邻居平均度
graph.knn(karate,c("Mr Hi","John A"))$knn

## 节点的接近中心性：如果一个节点和很多其它节点接近，那么该节点处于网络中心位置
clos <- closeness(karate)
data.frame(vex = names(clos),weight = clos)%>%
  ggplot(aes(x=reorder(vex,weight),y = weight))+
  geom_bar(stat = "identity",fill = "tomato")+coord_flip()+
  labs(x="节点",y = "节点中心性")

## 计算极大团的尺寸和数量
table(unlist(lapply(max_cliques(karate),length)))
## 图的密度：实际出现的边与可能的边的比值
graph.density(karate)



```



## 10.5：网络图的分割

```{r}


## 使用聚类分割关系网络图
kclu1 <- cluster_fast_greedy(karate2)
sizes(kclu1)
## 可视化聚类结果
set.seed(12)
plot(kclu1,karate2)
## 可视化系统聚类树
par(cex=0.8)
dendPlot(kclu1,mode = "hclust")

## 模块化的多级优化算法对网络结构进行聚类
kclu2 <- cluster_louvain(karate2)
sizes(kclu2)
plot(kclu2,karate2)







```




