介绍

《红楼梦》文本分析以及关系网络的挖掘。

该工作为大四上学期《数据挖掘》这门课程的一个作业，在这里做了一些练习，相互交流，也希望能取得好成绩。

在这里主要进行和挖掘了如下内容：

《红楼梦》数据的准备、预处理、分词等
《红楼梦》各个章节的字数、词数、段落等相关方面的关系
《红楼梦》整体词频和词云的展示
《红楼梦》各个章节的聚类分析并可视化，主要进行了根据IF-IDF的系统聚类和根据词频的LDA主题模型聚类
《红楼梦》中关系网络的探索，主要探索了各个章节的关系图和人物关系网路图

1. 《红楼梦》数据的准备、预处理、分词等

## 读取停用词
filename <- "./数据/我的红楼梦停用词.txt"
mystopwords <- readLines(filename)
## 读取红楼梦
filename <-"./数据/红楼梦UTF82.txt"
Red_dream <- readLines(filename,encoding='UTF-8')
## 将读入的文档分章节####
#去除空白行
Red_dream <- Red_dream[!is.na(Red_dream)]
# Red_dream <- as.vector(Red_dream)
# Red_dream[is.na(Red_dream)]
## 删除卷数据
juan <- grep(Red_dream,pattern = "^第+.+卷")
Red_dream <- Red_dream[(-juan)]
## 找出每一章节的头部行数和尾部行数
## 每一章节的名字
Red_dreamname <- data.frame(name = Red_dream[grep(Red_dream,pattern = "^第+.+回")],
                            chapter = 1:120)
## 处理章节名
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)


##-----------------------------------------------------------------------
## 对红楼梦进行分词####
Red_fen <- jiebaR::worker(type = "mix",user = "./数据/红楼梦词典.txt")
Fen_red <- apply_list(as.list(content),Red_fen)
## 去除停用词,使用并行的方法
library(parallel)
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)
## 每章节最终有多少个词
Fen_red2 <- lapply(Fen_red, unique) #去重
Red_dreamname$wordlen <- unlist(lapply(Fen_red2,length))
## 添加分组变量，前80章为1组，后40章为2组
Red_dreamname$Group <- factor(rep(c(1,2),times = c(80,40)),
                              labels = c("前80章","后40章"))

查看第十章的分词的到的结果

# 第10章的内容
content[[10]]

## [1] "话说金荣因人多势众，又兼贾瑞勒令，赔了不是，给秦钟磕了头，宝玉方才不吵闹了。大家散了学，金荣回到家中，越想越气，说：“秦钟不过是贾蓉的小舅子，又不是贾家的子孙，附学读书，也不过和我一样。他因仗着宝玉和他好，他就目中无人。他既是这样，就该行些正经事，人也没的说。他素日又和宝玉鬼鬼祟祟的，只当人都是瞎子，看不见。今日他又去勾搭人，偏偏的撞在我眼睛里。就是闹出事来，我还怕什么不成？”他母亲胡氏听见他咕咕嘟嘟的说，因问道：“你又要争什么闲气？好容易我望你姑妈说了，你姑妈千方百计的才向他们西府里的琏二奶奶跟前说了，你才得了这个念书的地方。若不是仗着人家，咱们家里还有力量请的起先生？况且人家学里，茶也是现成的，饭也是现成的。你这二年在那里念书，家里也省好大的嚼用呢。省出来的，你又爱穿件鲜明衣服。再者，不是因你在那里念书，你就认得什么薛大爷了？那薛大爷一年不给不给，这二年也帮了咱们有七八十两银子。你如今要闹出了这个学房，再要找这么个地方，我告诉你说罢，比登天还难呢！你给我老老实实的顽一会子睡你的觉去，好多着呢。“于是金荣忍气吞声，不多一时他自去睡了。次日仍旧上学去了。不在话下。且说他姑娘，原聘给的是贾家玉字辈的嫡派，名唤贾璜。但其族人那里皆能象宁荣二府的富势，原不用细说。这贾璜夫妻守着些小的产业，又时常到宁荣二府里去请请安，又会奉承凤姐儿并尤氏，所以凤姐儿尤氏也时常资助资助他，方能如此度日。今日正遇天气晴明，又值家中无事，遂带了一个婆子，坐上车，来家里走走，瞧瞧寡嫂并侄儿。闲话之间，金荣的母亲偏提起昨日贾家学房里的那事，从头至尾，一五一十都向他小姑子说了。这璜大奶奶不听则已，听了，一时怒从心上起，说道：“这秦钟小崽子是贾门的亲戚，难道荣儿不是贾门的亲戚？人都别忒势利了，况且都作的是什么有脸的好事！就是宝玉，也犯不上向着他到这个样。等我去到东府瞧瞧我们珍大奶奶，再向秦钟他姐姐说说，叫他评评这个理。”这金荣的母亲听了这话，急的了不得，忙说道：“这都是我的嘴快，告诉了姑奶奶了，求姑奶奶别去，别管他们谁是谁非。倘或闹起来，怎么在那里站得住。若是站不住，家里不但不能请先生，反倒在他身上添出许多嚼用来呢。”璜大奶奶听了，说道：“那里管得许多，你等我说了，看是怎么样！”也不容他嫂子劝，一面叫老婆子瞧了车，就坐上往宁府里来。到了宁府，进了车门，到了东边小角门前下了车，进去见了贾珍之妻尤氏。也未敢气高，殷殷勤勤叙过寒温，说了些闲话，方问道：“今日怎么没见蓉大奶奶？”尤氏说道：“他这些日子不知怎么着，经期有两个多月没来。叫大夫瞧了，又说并不是喜。那两日，到了下半天就懒待动，话也懒待说，眼神也发眩。我说他：。你且不必拘礼，早晚不必照例上来，你就好生养养罢。就是有亲戚一家儿来，有我呢。就有长辈们怪你，等我替你告诉。'连蓉哥我都嘱咐了，我说：。你不许累ц他，不许招他生气，叫他静静的养养就好了。他要想什么吃，只管到我这里取来。倘或我这里没有，只管望你琏二婶子那里要去。倘或他有个好和歹，你再要娶这么一个媳妇，这么个模样儿，这么个性情的人儿，打着灯笼也没地方找去。'他这为人行事，那个亲戚，那个一家的长辈不喜欢他？所以我这两日好不烦心，焦的我了不得。偏偏今日早晨他兄弟来瞧他，谁知那小孩子家不知好歹，看见他姐姐身上不大爽快，就有事也不当告诉他，别说是这么一点子小事，就是你受了一万分的委曲，也不该向他说才是。谁知他们昨儿学房里打架，不知是那里附学来的一个人欺侮了他了。里头还有些不干不净的话，都告诉了他姐姐。婶子，你是知道那媳妇的：虽则见了人有说有笑，会行事儿，他可心细，心又重，不拘听见个什么话儿，都要度量个三日五夜才罢。这病就是打这个秉性上头思虑出来的。今儿听见有人欺负了他兄弟，又是恼，又是气。恼的是那群混帐狐朋狗友的扯是搬非，调三惑四的那些人，气的是他兄弟不学好，不上心念书，以致如此学里吵闹。他听了这事，今日索性连早饭也没吃。我听见了，我方到他那边安慰了他一会子，又劝解了他兄弟一会子。我叫他兄弟到那边府里找宝玉去了，我才看着他吃了半盏燕窝汤，我才过来了。婶子，你说我心焦不心焦？况且如今又没个好大夫，我想到他这病上，我心里倒象针扎似的。你们知道有什么好大夫没有？“金氏听了这半日话，把方才在他嫂子家的那一团要向秦氏理论的盛气，早吓的都丢在爪洼国去了。听见尤氏问他有知道好大夫的话，连忙答道：“我们这么听着，实在也没见人说有个好大夫。如今听起大奶奶这个来，定不得还是喜呢。嫂子倒别教人混治。倘或认错了，这可是了不得的。”尤氏道：“可不是呢。”正是说话间，贾珍从外进来，见了金氏，便向尤氏问道：“这不是璜大奶奶么？”金氏向前给贾珍请了安。贾珍向尤氏说道：“让这大妹妹吃了饭去。”贾珍说着话，就过那屋里去了。金氏此来，原要向秦氏说说秦钟欺负了他侄儿的事，听见秦氏有病，不但不能说，亦且不敢提了。况且贾珍尤氏又待的很好，反转怒为喜，又说了一会子话儿，方家去了。金氏去后，贾珍方过来坐下，问尤氏道：“今日他来，有什么说的事情么？”尤氏答道：“倒没说什么。一进来的时候，脸上倒象有些着了恼的气色似的，及说了半天话，又提起媳妇这病，他倒渐渐的气色平定了。你又叫让他吃饭，他听见媳妇这么病，也不好意思只管坐着，又说了几句闲话儿就去了，倒没求什么事。如今且说媳妇这病，你到那里寻一个好大夫来与他瞧瞧要紧，可别耽误了。现今咱们家走的这群大夫，那里要得，一个个都是听着人的口气儿，人怎么说，他也添几句文话儿说一遍。可倒殷勤的很，三四个人一日轮流着倒有四五遍来看脉。他们大家商量着立个方子，吃了也不见效，倒弄得一日换四五遍衣裳，坐起来见大夫，其实于病人无益。”贾珍说道：“可是。这孩子也糊涂，何必脱脱换换的，倘再着了凉，更添一层病，那还了得。衣裳任凭是什么好的，可又值什么，孩子的身子要紧，就是一天穿一套新的，也不值什么。我正进来要告诉你：方才冯紫英来看我，他见我有些抑郁之色，问我是怎么了。我才告诉他说，媳妇忽然身子有好大的不爽快，因为不得个好太医，断不透是喜是病，又不知有妨碍无妨碍，所以我这两日心里着实着急。冯紫英因说起他有一个幼时从学的先生，姓张名友士，学问最渊博的，更兼医理极深，且能断人的生死。今年是上京给他儿子来捐官，现在他家住着呢。这么看来，竟是合该媳妇的病在他手里除灾亦未可知。我即刻差人拿我的名帖请去了。今日倘或天晚了不能来，明日想必一定来。况且冯紫英又即刻回家亲自去求他，务必叫他来瞧瞧。等这个张先生来瞧了再说罢。”尤氏听了，心中甚喜，因说道：“后日是太爷的寿日，到底怎么办？”贾珍说道：“我方才到了太爷那里去请安，兼请太爷来家来受一受一家子的礼。太爷因说道：。我是清净惯了的，我不愿意往你们那是非场中去闹去。你们必定说是我的生日，要叫我去受众人些头，莫过你把我从前注的<<阴骘文>>给我令人好好的写出来刻了，比叫我无故受众人的头还强百倍呢。倘或后日这两日一家子要来，你就在家里好好的款待他们就是了。也不必给我送什么东西来，连你后日也不必来，你要心中不安，你今日就给我磕了头去。倘或后日你要来，又跟随多少人来闹我，我必和你不依。'如此说了又说，后日我是再不敢去的了。且叫来升来，吩咐他预备两日的筵席。”尤氏因叫人叫了贾蓉来：“吩咐来升照旧例预备两日的筵席，要丰丰富富的。你再亲自到西府里去请老太太，大太太，二太太和你琏二婶子来逛逛。你父亲今日又听见一个好大夫，业已打发人请去了，想必明日必来。你可将他这些日子的病症细细的告诉他。”贾蓉一一的答应着出去了。正遇着方才去冯紫英家请那先生的小子回来了，因回道：“奴才方才到了冯大爷家，拿了老爷的名帖请那先生去。那先生说道：。方才这里大爷也向我说了。但是今日拜了一天的客，才回到家，此时精神实在不能支持，就是去到府上也不能看脉。'他说等调息一夜，明日务必到府。他又说，他。医学浅薄，本不敢当此重荐，因我们冯大爷和府上的大人既已如此说了，又不得不去，你先替我回明大人就是了。大人的名帖实不敢当。'仍叫奴才拿回来了。哥儿替奴才回一声儿罢。”贾蓉转身复进去，回了贾珍尤氏的话，方出来叫了来升来，吩咐他预备两日的筵席的话。来升听毕，自去照例料理。不在话下。且说次日午间，人回道：“请的那张先生来了。”贾珍遂延入大厅坐下。茶毕，方开言道：“昨承冯大爷示知老先生人品学问，又兼深通医学，小弟不胜钦仰之至。”张先生道：“晚生粗鄙下士，本知见浅陋，昨因冯大爷示知，大人家第谦恭下士，又承呼唤，敢不奉命。但毫无实学，倍增颜汗。”贾珍道：“先生何必过谦。就请先生进去看看儿妇，仰仗高明，以释下怀。”于是，贾蓉同了进去。到了贾蓉居室，见了秦氏，向贾蓉说道：“这就是尊夫人了？”贾蓉道：“正是。请先生坐下，让我把贱内的病说一说再看脉如何？”那先生道：“依小弟的意思，竟先看过脉再说的为是。我是初造尊府的，本也不晓得什么，但是我们冯大爷务必叫小弟过来看看，小弟所以不得不来。如今看了脉息，看小弟说的是不是，再将这些日子的病势讲一讲，大家斟酌一个方儿，可用不可用，那时大爷再定夺。”贾蓉道：“先生实在高明，如今恨相见之晚。就请先生看一看脉息，可治不可治，以便使家父母放心。”于是家下媳妇们捧过大迎枕来，一面给秦氏拉着袖口，露出脉来。先生方伸手按在右手脉上，调息了至数，宁神细诊了有半刻的工夫，方换过左手，亦复如是。诊毕脉息，说道：“我们外边坐罢。”贾蓉于是同先生到外间房里床上坐下，一个婆子端了茶来。贾蓉道：“先生请茶。”于是陪先生吃了茶，遂问道：“先生看这脉息，还治得治不得？”先生道：“看得尊夫人这脉息：左寸沉数，左关沉伏，右寸细而无力，右关需而无神。其左寸沉数者，乃心气虚而生火，左关沉伏者，乃肝家气滞血亏。右寸细而无力者，乃肺经气分太虚，右关需而无神者，乃脾土被肝木克制。心气虚而生火者，应现经期不调，夜间不寐。肝家血亏气滞者，必然肋下疼胀，月信过期，心中发热。肺经气分太虚者，头目不时眩晕，寅卯间必然自汗，如坐舟中。脾土被肝木克制者，必然不思饮食，精神倦怠，四肢酸软。据我看这脉息，应当有这些症候才对。或以这个脉为喜脉，则小弟不敢从其教也。”旁边一个贴身伏侍的婆子道：“何尝不是这样呢。真正先生说的如神，倒不用我们告诉了。如今我们家里现有好几位太医老爷瞧着呢，都不能的当真切的这么说。有一位说是喜，有一位说是病，这位说不相干，那位说怕冬至，总没有个准话儿。求老爷明白指示指示。“那先生笑道：“大奶奶这个症候，可是那众位耽搁了。要在初次行经的日期就用药治起来，不但断无今日之患，而且此时已全愈了。如今既是把病耽误到这个地位，也是应有此灾。依我看来，这病尚有三分治得。吃了我的药看，若是夜里睡的着觉，那时又添了二分拿手了。据我看这脉息：大奶奶是个心性高强聪明不过的人，聪明忒过，则不如意事常有，不如意事常有，则思虑太过。此病是忧虑伤脾，肝木忒旺，经血所以不能按时而至。大奶奶从前的行经的日子问一问，断不是常缩，必是常长的。是不是？”这婆子答道：“可不是，从没有缩过，或是长两日三日，以至十日都长过。”先生听了道：“妙啊！这就是病源了。从前若能够以养心调经之药服之，何至于此。这如今明显出一个水亏木旺的症候来。待用药看看。“于是写了方子，递与贾蓉，上写的是：益气养荣补脾和肝汤人参二钱白术二钱土炒云苓三钱熟地四钱归身二钱酒洗白芍二钱炒川芎钱半黄芪三钱香附米二钱制醋柴胡八分怀山药二钱炒真阿胶二钱蛤粉炒延胡索钱半酒炒炙甘草八分引用建莲子七粒去心红枣二枚贾蓉看了，说：“高明的很。还要请教先生，这病与性命终久有妨无妨？”先生笑道：“大爷是最高明的人。人病到这个地位，非一朝一夕的症候，吃了这药也要看医缘了。依小弟看来，今年一冬是不相干的。总是过了春分，就可望全愈了。”贾蓉也是个聪明人，也不往下细问了。于是贾蓉送了先生去了，方将这药方子并脉案都给贾珍看了，说的话也都回了贾珍并尤氏了。尤氏向贾珍说道：“从来大夫不象他说的这么痛快，想必用的药也不错。”贾珍道：“人家原不是混饭吃久惯行医的人。因为冯紫英我们好，他好容易求了他来了。既有这个人，媳妇的病或者就能好了。他那方子上有人参，就用前日买的那一斤好的罢。”贾蓉听毕话，方出来叫人打药去煎给秦氏吃。不知秦氏服了此药病势如何，下回分解。"

# 第10章的分词结果的抽样
Fen_red[[10]][1:100]

##   [1] "金荣"       "人多势众"   "贾瑞"       "勒令"       "秦钟"      
##   [6] "宝玉"       "吵闹"       "金荣"       "回到"       "家中"      
##  [11] "越想"       "越气"       "秦钟"       "贾蓉"       "小舅子"    
##  [16] "贾家"       "子孙"       "附学"       "读书"       "因仗"      
##  [21] "宝玉"       "目中无人"   "该行"       "正经事"     "素日"      
##  [26] "宝玉"       "鬼鬼祟祟"   "瞎子"       "看不见"     "今日"      
##  [31] "勾搭"       "眼睛"       "出事"       "母亲"       "胡氏"      
##  [36] "听见"       "咕咕"       "嘟嘟"       "问道"       "闲气"      
##  [41] "好容易"     "我望"       "姑妈"       "姑妈"       "千方百计"  
##  [46] "西府里"     "琏二奶奶"   "跟前"       "念书"       "地方"      
##  [51] "家里"       "力量"       "学里"       "现成"       "现成"      
##  [56] "二年"       "念书"       "家里"       "嚼用"       "穿件"      
##  [61] "鲜明"       "衣服"       "念书"       "认得"       "薛大爷"    
##  [66] "薛大爷"     "一年"       "二年"       "七八十两"   "银子"      
##  [71] "学房"       "再要"       "地方"       "告诉"       "比登"      
##  [76] "难呢"       "一会"       "觉去"       "多着呢"     "金荣"      
##  [81] "忍气吞声"   "不多"       "自去"       "次日"       "上学"      
##  [86] "不在话下"   "姑娘"       "原聘"       "贾家玉字辈" "嫡派"      
##  [91] "名唤"       "贾璜"       "族人"       "能象"       "宁荣二"    
##  [96] "富势"       "不用"       "细说"       "贾璜"       "夫妻"

# 第10章分词后的词长
length(Fen_red[[10]])

## [1] 1027

我们可以看出，该段分词后一共有1027个词语，并且给出了一些示例

查看每个章节的一些信息

head(Red_dreamname)

##                                       name chapter chapter2
## 1 第一回 甄士隐梦幻识通灵 贾雨村风尘怀闺秀       1   第一回
## 2 第二回 贾夫人仙逝扬州城 冷子兴演说荣国府       2   第二回
## 3 第三回 贾雨村夤缘复旧职 林黛玉抛父进京都       3   第三回
## 4 第四回 薄命女偏逢薄命郎 葫芦僧乱判葫芦案       4   第四回
## 5 第五回 游幻境指迷十二钗 饮仙醪曲演红楼梦       5   第五回
## 6 第六回 贾宝玉初试云雨情 刘姥姥一进荣国府       6   第六回
##                                Name chapbegin chapend chaplen numchars
## 1 甄士隐梦幻识通灵,贾雨村风尘怀闺秀         1      50      49     7775
## 2 贾夫人仙逝扬州城,冷子兴演说荣国府        51      80      29     5882
## 3 贾雨村夤缘复旧职,林黛玉抛父进京都        81     119      38     8481
## 4 薄命女偏逢薄命郎,葫芦僧乱判葫芦案       120     149      29     5898
## 5 游幻境指迷十二钗,饮仙醪曲演红楼梦       150     236      86     7417
## 6 贾宝玉初试云雨情,刘姥姥一进荣国府       237     263      26     7274
##   wordlen  Group
## 1    1531 前80章
## 2    1160 前80章
## 3    1479 前80章
## 4    1106 前80章
## 5    1392 前80章
## 6     997 前80章

我们这里按照章节整理了一些相关的信息，主要有章节名、内容、段落数、字数、词数等信息

2. 《红楼梦》各个章节的字数、词数、段落等相关方面的关系

查看字数、词数、段落等信息的可视化

## 对每章的内容进行探索分析####
## 对相关章节进行分析
## 每章节的段落长度
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 = 7:9,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章还是有一些差异的

查看段落数、字数、词数三维散点图

## 对三个变量绘制三散点图，
par(family = "STKaiti",mfcol = c(1,1),cex = 1)
color <- rep(c("red","blue"),times = c(80,40))
pchs <- rep(c(21,22),times = c(80,40))
scatterplot3d(x =Red_dreamname$chaplen,y = Red_dreamname$numchars,
              z=Red_dreamname$wordlen,color = color,pch = pchs,
              xlab="断落数", ylab="字数", zlab="词数",scale.y=1,
              angle=30,main = "《红楼梦》")
legend("topleft", inset=.05,      # location and inset
       bty="n", cex=1,              # suppress legend box, shrink text 50%
       title="章节",
       legend = c("前80章","后40章"),
       pch = c(21,22),
       col = c("red","blue"))

查看段落数、字数、词数可交互散点图

## 对三个变量绘制三散点图，
## 可交互三维散点图
plot_ly(Red_dreamname, x = ~chaplen, y = ~numchars, z = ~wordlen) %>% 
  add_markers(color = ~Group,text = ~paste("Name: ", name)) %>%
  layout(title = "《红楼梦》")

从三维散点图中可以清晰的看出，三者的空间关系，前80章更加分散，后40章更加的集中

查看段落数、字数、词数矩阵散点图

##矩阵散点图
Red_dreamname_mat <- Red_dreamname[c("chaplen","numchars","wordlen","Group")]
names(Red_dreamname_mat) <- c("断落数","字数","词数","章节")
ggscatmat(Red_dreamname_mat,columns = c("断落数","字数","词数"),color = "章节") +
  theme_bw(base_family = "STKaiti") +
  ggtitle("《红楼梦》")

从散点矩阵图中可以看出三个变量的分布和相关关系，并且给出了前80章和后40章的相关性大小。

3. 《红楼梦》整体词频和词云的展示

构建文档－词项频数矩阵

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

## <<DocumentTermMatrix (documents: 120, terms: 40342)>>
## Non-/sparse entries: 117554/4723486
## Sparsity           : 98%
## Maximal term length: 12
## Weighting          : term frequency (tf)

## 一共有4万多个词

我们可以查看一共有120条文档，4万多个词项

词频统计

频数统计

## 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)
word_freq$word <- as.factor(word_freq$word)

## 2:词频统计
head(word_freq)

##   word freq
## 1 宝玉 3907
## 2 笑道 1955
## 3 贾母 1686
## 4 一个 1440
## 5 凤姐 1228
## 6 袭人 1152

绘制词频图

## 绘制词频图
nn <- 250
sum(word_freq$freq>=nn)

## [1] 69

## 绘制词频图
word_freq[word_freq$freq >= nn,] %>%
  ggplot(aes(x = word,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 = 10)) +
  labs(x = "词项",y = "频数",title = "《红楼梦》词频图")

我们绘制了出现频率大于250的一些词（一共有69个）的频频直方图，可以发现不同词之间出现频率的差异

词云的绘制

## 词云
sum(word_freq$freq>=60)

## [1] 390

一共有390个词的频数大于60 ### 静态词云

### 静态词云
layout(matrix(c(1, 2), nrow=2), heights=c(0.4, 4))
par(mar=rep(0, 4),family = "STKaiti")
plot.new()
text(x=0.5, y=0.3, "红楼梦词云\nMin=60")
wordcloud(words = word_freq$word, freq = word_freq$freq,
          scale = c(4,0.8),min.freq = 60,random.order=FALSE,
          family = "STKaiti",colors = brewer.pal(8,"Dark2"))

可交互词云

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

4. 《红楼梦》各个章节的聚类分析并可视化

根据TF－IDF矩阵进行系统聚类

构建文档－词项TF-IDF矩阵并去稀疏处理

## 对每章节进行聚类分析####
## 1:构建文档－词项tf-IDF矩阵
corpus2 <- Corpus(VectorSource(Fen_red))
Red_dtm_tfidf <- DocumentTermMatrix(corpus2,control = list(wordLengths=c(1,Inf),
                                                    weighting = weightTfIdf))
Red_dtm_tfidf

## <<DocumentTermMatrix (documents: 120, terms: 40342)>>
## Non-/sparse entries: 117314/4723726
## Sparsity           : 98%
## Maximal term length: 12
## Weighting          : term frequency - inverse document frequency (normalized) (tf-idf)

## 一共有4万多个词
## 降低tfidf矩阵的稀疏度
Red_dtm_tfidfr <- removeSparseTerms(Red_dtm_tfidf,0.95)
Red_dtm_tfidfr

## <<DocumentTermMatrix (documents: 120, terms: 3093)>>
## Non-/sparse entries: 59053/312107
## Sparsity           : 84%
## Maximal term length: 6
## Weighting          : term frequency - inverse document frequency (normalized) (tf-idf)

## 只留下了3000多个关键的字

最终处理后可以的到只剩3千多个重要的关键词

聚类为6类时

Red_dtm_tfidfr_mat <- as.matrix(Red_dtm_tfidfr)
## 文本间的距离度量为夹角余弦距离
Red_dtm_tfidfr_dist <- proxy::dist(Red_dtm_tfidfr_mat,method ="cosine")

## 系统聚类，聚为两类
k = 6
Red_clust <- hclust(d = Red_dtm_tfidfr_dist,method = "average")
Red_clust$labels <- Red_dreamname$chapter2
## 可视化绘图
par(family = "STKaiti",cex = 0.6)
plot(Red_clust,
     main = '红楼梦章节聚类\nmethod = average',
     xlab = '', ylab = '', sub = '')
groups <- cutree(Red_clust, k=k)   # "k=" defines the number of clusters you are using   
rect.hclust(Red_clust, k=k, border="red") # draw dendogra

## 每组有多少章
table(groups)

## groups
##  1  2  3  4  5  6 
##  5  6 43 18 36 12

聚类为5类时

k = 5
Red_clust <- hclust(d = Red_dtm_tfidfr_dist,method = "ward.D2")
Red_clust$labels <- Red_dreamname$chapter2
## 可视化绘图
par(family = "STKaiti",cex = 0.6)
plot(Red_clust,
     main = '红楼梦章节聚类\nmethod = word.D2',
     xlab = '', ylab = '', sub = '')
groups <- cutree(Red_clust, k=k)   # "k=" defines the number of clusters you are using   
rect.hclust(Red_clust, k=k, border="red") # draw dendogra

## 每组有多少章
table(groups)

## groups
##  1  2  3  4  5 
## 21  6 49 30 14

使用LDA模型挖掘主题

因为该模型会出的结果在Markdown中不能很好的可视化，所以在另一个单独的文件中展示

5. 《红楼梦》中关系网络的探索

章节的联系探索

如果各章之间距离大于0.8，则视为章节之间没有联系，激励越小，联系越大

# summary(Red_dtm_tfidfr_dist)
threshoud <- 0.8
Red_dist_cut <- as.matrix(Red_dtm_tfidfr_dist)
for (ii in 1:dim(Red_dist_cut)[1]) {
  for (kk in 1:dim(Red_dist_cut)[2]) {
    ## 距离大于的则没有连接
    aa <- Red_dist_cut[ii,kk]
    ## 数值越小权重越大
    aa <- ifelse(aa >=threshoud,0,aa)
    aa <- abs(aa - threshoud)
    aa <- ifelse(aa < threshoud,aa+threshoud,0)
    Red_dist_cut[ii,kk] <- aa
  }
}
# # plot(as.vector(Red_dist_cut))
# # names(Red_dist_cut) <- Red_dreamname$chapter2
row.names(Red_dist_cut) <- Red_dreamname$chapter
## ---------------------------------------------------------

# build a graph from the above matrix
g <- graph.adjacency(Red_dist_cut, weighted=T, mode = "undirected")
# remove loops
g <- simplify(g)
# set labels and degrees of vertices
V(g)$label <- row.names(Red_dist_cut)
V(g)$degree <- degree(g)

## 绘制每章节的网络关系图
set.seed(3952)
par(family ="STKaiti",cex = 1)
layout1 <- layout.kamada.kawai(g)
# plot(g, layout=layout1)
## 美化图形
V(g)$label.cex <- 2.2 * V(g)$degree / max(V(g)$degree) +0.4
V(g)$label.color <- rgb(0, 0, .2, .8)
V(g)$frame.color <- NA
egam <- (log(E(g)$weight)+.4) / max(log(E(g)$weight)+.4)
E(g)$color <- rgb(.5, .9, 0, egam)
E(g)$width <- egam *4
# plot the graph in layout1
plot(g, layout=layout1,main = "《红楼梦》章节的关系")

该可视化图模型算法为能量布局算法

par(family ="STKaiti",cex = 1)
layout2 <- layout.sphere(g)
plot(g, layout=layout2,main = "《红楼梦》章节的关系")

## 文字越大，说明与该章相关的章节数越多
## 连接的线越粗，说明联系越大

文字越大，说明与该章相关的章节数越多,连接的线越粗，说明联系越大

人物社交网络

只分析出现频次大于10的人员 ### 关键人物频数查看

## 读取数据
## 一共有149人出现的频次多余10次
Red_net <- read.csv("./数据/社交网络权重.csv")
Red_net[,1:2] <- apply(Red_net[,1:2],2,as.character)
Name_freq <- read.csv("./数据/红楼梦人物出现频次.csv")
Name_freq <- Name_freq[Name_freq$word %in%(union(unique(Red_net$First),
                                                 unique(Red_net$Second))),]
Name_freq$word <- as.character(Name_freq$word)
# union(unique(Red_net$First),unique(Red_net$Second))

## 可视化人出现的频次
p1 <- ggplot(Name_freq,aes(x = reorder(word,freq),y = freq)) +
  theme_bw(base_size = 9,base_family = "STKaiti")+
  geom_bar(stat = "identity",position = "dodge",fill = "lightblue") +
  theme(axis.text.x = element_text(size = 5,hjust = 1,angle = 90,vjust = 0.5),
        axis.title.x = element_blank()) +
  labs(x = "",y = "频数",title = "《红楼梦》中关键人物出现次数")

p2 <- ggplot(Name_freq[Name_freq$freq>80,],aes(x = reorder(word,freq),y = freq)) +
  theme_bw(base_size = 9,base_family = "STKaiti")+
  geom_bar(stat = "identity",position = "dodge",fill = "lightblue") +
  theme(axis.text.x = element_text(size = 9,hjust = 1,angle = 90,vjust = 0.5)) +
  labs(x = "人名",y = "频数")

grid.arrange(p1,p2,nrow = 2)

根据是否出现在同一章的社交网络

如果两个入伍同时出现在同一章中一次，则两人之间的权重＋1

只分析两人的权重大于10的关系（因为入关节点太多则网络不好查看）

## -----------------------------------------------------------------
## 按照权重1，即章节权重分析人物的社交网络####
# 1:准备社交网络数据
chap_net <- Red_net[Red_net$chapweight > 10,c(1,2,3)]
names(chap_net) <- c("from","to","weight")

chap_vert <- Name_freq[Name_freq$word %in% as.character(union(unique(chap_net$from),
                   unique(chap_net$to))),]

chap_net <- graph_from_data_frame(chap_net,directed = FALSE,
                                  vertices = chap_vert)
chap_net

## IGRAPH UNW- 69 762 -- 
## + attr: name (v/c), freq (v/n), weight (e/n)
## + edges (vertex names):
##  [1] 宝玉--贾母       宝玉--凤姐       宝玉--袭人       宝玉--王夫人    
##  [5] 宝玉--宝钗       宝玉--贾政       宝玉--贾琏       宝玉--平儿      
##  [9] 宝玉--薛姨妈     宝玉--探春       宝玉--紫鹃       宝玉--鸳鸯      
## [13] 宝玉--贾珍       宝玉--李纨       宝玉--尤氏       宝玉--晴雯      
## [17] 宝玉--邢夫人     宝玉--薛蟠       宝玉--林黛玉     宝玉--香菱      
## [21] 宝玉--麝月       宝玉--贾蓉       宝玉--贾赦       宝玉--惜春      
## [25] 宝玉--贾芸       宝玉--周瑞家的   宝玉--芳官       宝玉--贾环      
## [29] 宝玉--妙玉       宝玉--雪雁       宝玉--迎春       宝玉--赵姨娘    
## + ... omitted several edges

# # chap_net$name <- "《红楼梦》章节人物关系"
# V(chap_net)$media
# ## 节点数目
# vcount(chap_net)
# ## 边的数目
# ecount(chap_net)
## 简化网络图
chap_net <- simplify(chap_net,remove.multiple = TRUE,remove.loops = TRUE,
                     edge.attr.comb = "mean")

## 查看节点的度
degrees <- data.frame(name = names(degree(chap_net)),
                      counts = (degree(chap_net)))

ggplot(degrees,aes(x = reorder(name,counts),y = counts)) +
  theme_bw(base_size = 11,base_family = "STKaiti")+
  geom_bar(stat = "identity",position = "dodge",fill = "lightblue") +
  theme(axis.text.x = element_text(size = 8,hjust = 1,angle = 90,vjust = 0.5),
        axis.title.x = element_blank()) +
  labs(x = "人名",y = "节点的度",title = "《红楼梦》")

# ## 判断事否为联通图
# is.connected(chap_net)
# 
# ## 计算图的直径
# diameter(chap_net,directed = FALSE)

## 
set.seed(1234)
par(cex = 0.8,family = "STKaiti")
## 设置图层
layout1 <- layout.lgl(chap_net)
layout2 <- layout.kamada.kawai(chap_net)
layout3 <- layout.reingold.tilford(chap_net)
layout4 <- layout.fruchterman.reingold(chap_net)

#V(chap_net)$size <- Name_freq$freq/10
## 设置节点的字体
V(chap_net)$label.family <- "STKaiti"
E(chap_net)$width <- round(log10(E(chap_net)$weight))*4
egam <- (E(chap_net)$width) / max(E(chap_net)$width)
E(chap_net)$color <- rgb(1,0.5,0.5,egam)
V(chap_net)$size <- log(V(chap_net)$freq) * 2.5
par(cex = 0.8,family = "STKaiti")
plot(chap_net,layout = layout1,main = "《红楼梦》根据章节部分人物关系")

par(cex = 0.8,family = "STKaiti")
plot(chap_net,layout = layout2,main = "《红楼梦》根据章节部分人物关系")

par(cex = 0.8,family = "STKaiti")
plot(chap_net,layout = layout3,main = "《红楼梦》根据章节部分人物关系")

par(cex = 0.8,family = "STKaiti")
plot(chap_net,layout = layout4,main = "《红楼梦》根据章节部分人物关系")

通过不同的网络图表现形式课一比较容易的观察人物之间的关系

根据是否出现在同一段落的社交网络

如果两个入伍同时出现在同一段落中一次，则两人之间的权重＋1