步驟一library packages and set working dir

library(showtext)
## Loading required package: sysfonts
## Loading required package: showtextdb
library(ggplot2)
library(tm)
## Loading required package: NLP
## 
## Attaching package: 'NLP'
## The following object is masked from 'package:ggplot2':
## 
##     annotate
library(jiebaRD)
library(jiebaR)
library(SnowballC)
library(slam)
library(Matrix)
library(magrittr)
data.path<-"D:/r/hw4/"
setwd(data.path)

步驟二 讀取文本資料並轉換為Corpus

tm_map(docs, toSpace, )先將文本進行清理

View(inspect(docs[1:5]))檢查文本是否正確匯入

filenames <- list.files(path=paste0(data.path,"source"),all.files = T, pattern="*.txt",full.names = TRUE)
files <- lapply(filenames, readLines)
docs <- Corpus(VectorSource(files))

#clear data
toSpace <- content_transformer(function(x, pattern) gsub(pattern, " ", x))
docs <- tm_map(docs, toSpace, "你")
docs <- tm_map(docs, toSpace, "◆")
docs <- tm_map(docs, toSpace, "‧")
docs <- tm_map(docs, toSpace, "的")
docs <- tm_map(docs, toSpace, "我")
docs <- tm_map(docs, toSpace, "是")
docs <- tm_map(docs, toSpace, "[a-zA-Z]")
docs <- tm_map(docs, toSpace, "水滸傳")
docs <- tm_map(docs, toSpace, "施耐庵輯")
docs <- tm_map(docs, toSpace, "上一回 水滸傳目錄 下一回")
docs <- tm_map(docs, toSpace, "\"x\"")
docs <- tm_map(docs, toSpace, "\"1\" \"")
#move (punctuation)
#move (white space)
docs <- tm_map(docs, removePunctuation)
docs <- tm_map(docs, removeNumbers)
docs <- tm_map(docs, stripWhitespace)
docs <- tm_map(docs, toSpace, "元明")
#View(inspect(docs[120]))
data.frame(text=sapply(docs[120], identity),stringsAsFactors=F)
##                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       text
## 1    第一百二十回 宋公明神聚蓼兒窪 徽宗帝夢遊梁山泊 話說宋江衣錦還鄉還至東京與眾弟兄相會令其各人收拾行裝前往任所當有神行太保戴宗來探宋江二人坐間閒話只見戴宗起身道小弟已蒙聖恩除授袞州都統制今情願納下官誥要去泰安州嶽廟裏陪堂求閒過了此生實為萬幸宋江道賢弟何故行此念頭戴宗道 弟夜夢崔府君勾喚因此發了這片善心宋江道賢弟生身既為神行太保他日必作嶽府靈聰自此相別之後戴宗納還了官誥去到泰安州嶽廟裏陪堂出家每日慇勤奉祀聖帝香火虔誠無忽後數月一夕無恙請眾道伴相辭作別大笑而終後來在嶽廟裏累次顯靈州人廟祝隨塑戴宗神像於廟裏胎骨 他真身 又有阮小七受了誥命辭別宋江已往蓋天軍做都統制職事未及數月被大將王稟趙譚懷挾幫源洞辱罵舊恨纍纍於童樞密前訴說阮小七 過失曾穿著方臘 赭黃袍龍衣玉帶雖 一時戲耍終久懷心不良亦且蓋天軍地僻人蠻必致造反童貫把此事達知蔡京奏過天子請降了聖旨行移公文到彼處追奪阮小七本身 官誥復為庶民阮小七見了心中也自歡喜帶了老母回還梁山泊石碣村依舊打魚為生奉養老母以終天年後來壽至六十而亡 且說小旋風柴進在京師見戴宗納還官誥求閒去了又見說朝廷追奪了阮小七官誥不合戴了方臘 平天冠龍衣玉帶意在學他造反罰為庶反尋思 亦曾在方臘處做駙馬倘或日後奸臣們知得於天子前讒佞見責起來追了誥命豈不受辱不如自識時務免受玷辱推稱風疾病患不時舉發難以任用情願納還官誥求閒為農辭別眾官再回滄州橫海郡為民自在過活忽然一日無疾而終 李應受中山府都統制赴任半年聞知柴進求閒去了自思也推稱風癱不能為官申達省院繳納官誥復還故鄉獨龍岡村中過活後與杜興一處做富豪俱得善終 關勝在北京大名府總管兵馬甚得軍心眾皆欽伏一日操練軍馬回來因大醉失腳落馬得病身亡呼延灼受御營指揮使每日隨駕操備後領大軍大破金兀朮四太子出軍殺至淮西陣亡只有朱仝在保定府管軍有功後隨劉光世破了大金直做到太平軍節度使花榮帶同妻小妹子前赴應天府到任吳用自來單身只帶了隨行安童去武勝軍到任李逵亦 獨自帶了兩個僕從自來潤州到任話說為何只說這三個到任別 都說了絕後結果為這七員正將都不廝見著先說了結果後這五員正將宋江盧俊義花榮吳用李逵還有廝會處以此未說絕了結果下來便見 再說宋江盧俊義在京師都分派了諸將賞賜各各令其赴任去訖歿於王事者止將家眷人口關給與恩賞錢帛金銀仍各送回故鄉聽從其便再有現在朝京偏將一十五員除兄弟宋清還鄉為農外杜興已自跟隨李應還鄉去了黃信仍任青州孫立帶同兄弟孫新顧大嫂並妻小自依舊登州任用鄒潤不願為官回登雲山去了蔡慶跟隨關勝仍回北京為民裴宣自與楊林商議了自回飲馬川受職求閒去了蔣敬思念故鄉願回潭州為民朱武自來投授樊瑞道法兩個做了全真先生雲遊江湖去投公孫勝出家以終天年穆春自回揭陽鎮鄉中復為良民凌振砲手非凡仍受火藥局御營任用舊在京師偏將五員安道全欽取回京就於太醫院做了金紫醫官皇甫端原受御馬監大使金大堅已在內府御寶監為官蕭讓在蔡太師府中受職做門館先生樂和在駙馬王都尉府中盡老清閒終身快樂不在話下 且說宋江自與盧俊義分別之後各自前去赴任盧俊義亦無家眷帶了數個隨行伴當自望廬州去了宋江謝恩辭朝別了省院諸官帶同幾個家人僕從前往楚州赴任自此相別都各分散去了亦不在話下 且說宋朝原來自太宗傳太祖帝位之時說了誓願以致朝代奸佞不清至今徽宗天子至聖至明不期致被奸臣當道讒佞專權屈害忠良深可憫念當此之時卻 蔡京童貫高俅楊戩四個賊臣變亂天下壞國壞家壞民當有殿帥府太尉高俅楊戩因見天子重禮厚賜宋江等這夥將校心內好生不然兩個自來商議道這宋江盧俊義皆 等仇人今日倒喫他做了有功之臣受朝廷這等恩賜卻教他上馬管軍下馬管民 等省院官僚如何不惹人恥笑自古道恨小非君子無毒不丈夫楊戩道 有一計先對付了盧俊義便 絕了宋江一隻臂膊這人十分英勇若先對付了宋江他若得知必變了事倒惹出一場不好高俅道願聞 妙計如何楊戩道排出幾個廬州軍漢來省院首告盧安撫招軍買馬積草屯糧意在造反便與他申呈去太師府啟奏和這蔡太師都瞞了等太師奏過天子請旨定奪卻令人賺他來京師待上皇賜御食與他於內下了些水銀卻墜了那人腰腎做用不得便成不得大事再差天使卻賜御酒與宋江吃酒裏也與他下了慢藥只消半月之間以定沒救高俅道此計大妙有詩堪笑 自古權奸害善良不容忠義立家邦皇天若肯明昭報男作俳優女作倡 兩個賊臣計議定了著心腹人出來尋覓兩個廬州土人寫與他狀子叫他去樞密院首告盧安撫在廬州即日招軍買馬積草屯糧意欲造反使人常往楚州結連安撫宋江通情起義樞密院卻 童貫亦與宋江等有仇當即收了原告狀子逕呈來太師府啟奏蔡京見了申文便會官計議此時高俅楊戩俱各在彼四個奸臣定了計策引領原告人入內啟奏天子上皇曰朕想宋江盧俊義征討四方虜寇掌握十萬兵權尚且不生歹念今已去邪歸正焉肯背反寡人不曾虧負他如何敢叛逆朝廷其中有詐未審虛 難以准信當有高俅楊戩在旁奏道聖上道理雖然人心難忖想必 盧俊義嫌官卑職小不滿其心復懷反意不幸被人知覺上皇曰可喚來寡人親問自取實招蔡京童貫又奏道盧俊義 一猛獸未保其心倘若驚動了他必致走透深為未便今後難以收捕只可賺來京師陛下親賜御膳御酒將聖言撫諭之窺其虛實動靜若無不必究問亦顯陛下不負功臣之念上皇准奏隨即降下聖旨差一使命逕往廬州宣取盧俊義還朝有委用 事天使奉命來到廬州大小官員出郭迎接直至州衙開讀已罷 話休絮煩盧俊義聽了聖旨宣取回朝便同使命離了廬州一齊上了舖馬來京於路無話早至東京皇城司前歇了次日早到東華門外伺候早朝時有太師蔡京樞密院童貫太尉高俅楊戩引盧俊義於偏殿朝見上皇拜舞已罷天子道寡人欲見卿一面又問廬州可容身否盧俊義再拜奏道托賴聖上洪福齊天彼處軍民亦皆安泰上皇又問了些閒話俄延至午尚膳廚官奏道進呈御膳在此未敢擅便乞取聖旨此時高俅楊戩已把水銀暗地著放在裏面供呈在御案上天子當面將膳賜與盧俊義盧俊義拜受而食上皇撫諭道卿去廬州務要盡心安養軍士勿生非意盧俊義頓首謝恩出朝回還廬州全然不知四個賊臣設計相害高俅楊戩相謂曰此後大事定矣 再說盧俊義 夜便回廬州來覺道腰腎疼痛動舉不得不能乘馬坐船回來行至泗州淮河天數將盡自然生出事來其夜因醉要立在船頭上消遣不想水銀墜下腰胯並骨髓裏去冊立不牢亦且酒後失腳落於淮河深處而死可憐河北玉麒麟屈作水中冤抑鬼從人打撈起屍首具棺槨殯於泗州高原深處本州官員動文書申覆省院不在話下 且說蔡京童貫高俅楊戩四個賊臣計較定了將齎泗州申達文書早朝奏聞天子說泗州申覆盧安撫行至淮河因酒醉墜水而死臣等省院不敢不奏今盧俊義已死只恐宋江心內設疑別生他事乞陛下聖鑑可差天使齎御酒往楚州賞賜以安其心上皇沈吟良久欲道不准未知其心意欲准行誠恐有弊上皇無奈終被奸臣讒佞所惑片口張舌花言巧語緩裏取事無不納受遂降御酒二樽差天使一人齎往楚州限目下便行眼見得這使臣亦 高俅楊戩二賊手下心腹之輩天數只注宋公明合當命盡不期被這奸臣們將御酒內放了慢藥在裏面卻教天使齎擎了逕往楚州來 且說宋公明自從到楚州為安撫兼管總領兵馬到任之後惜軍愛民百姓敬之如父母軍校仰之若神明訟庭肅然六事俱備人心既服軍民欽敬宋江公事之暇時常出郭遊玩原來楚州南門外有個去處地名喚做蓼兒窪其山四面都 水港中有高山一座其山秀麗松柏森然甚有風水雖然 個小去處其內山峰環繞龍虎踞盤曲折峰巒陂階臺砌四圍港汊前後湖蕩儼然 梁山泊水滸寨一般宋江看了心中甚喜自己想道 若死於此處堪為陰宅但若身閒常去遊翫樂情消遣 話休絮煩自此宋江到任以來將及半載時 宣和六年首夏初旬忽聽得朝廷降賜御酒到來與眾出郭迎接入到公廨開讀聖旨已罷天使捧過御酒教宋安撫飲畢宋江亦將御酒回勸天使天使推稱自來不會飲酒御酒宴罷天使回京宋江備禮饋送天使天使不受而去宋江自飲御酒之後覺道肚腹疼痛心中疑慮想被下藥在酒裏卻自急令從人打聽那來使時於路館驛卻又飲酒宋江已知中了奸計必 賊臣們下了藥酒乃嘆曰 自幼學儒長而通吏不幸失身於罪人並不曾行半點異心之事今日天子輕聽讒佞賜 藥酒得罪何辜 死不爭只有李逵現在潤州都統制他若聞知朝廷行此奸弊必然再去哨聚山林把 等一世清名忠義之事壞了只除 如此行方可連夜使人往潤州喚取李逵星夜到楚州別有商議 且說李逵自到潤州為都統制只 心中悶倦與眾終日飲酒只愛貪杯聽得宋江差人到來有請李逵道哥哥取 必有話說便同幹人下了船直到楚州逕入州治拜見宋江罷宋江道兄弟自從分散之後日夜只 想念眾人吳用軍師武勝軍又遠花知寨在應天府又不知消耗只有兄弟在潤州鎮江較近特請 來商量一件大事李逵道哥哥甚麼大事宋江道 且飲酒宋江請進後廳現成杯盤隨即管待李逵吃了半晌酒食將至半酣宋江便道賢弟不知 聽得朝廷差人齎藥酒來賜與 吃如死卻 怎 好李逵大叫一聲哥哥反了罷宋江道兄弟軍馬盡都沒了兄弟們又各分散如何反得成李逵道 鎮江有三千軍馬哥哥這裏楚州軍馬盡點起來並這百姓都盡數起去并氣力招軍買馬殺將去只 再上梁山泊倒快活強似在這奸臣們手下受氣宋江道兄弟且慢著再有計較 原來那接風酒內已下了慢藥當夜李逵飲酒了次日具舟相送李逵道哥哥幾時起義兵 那裏也起軍來接應宋江道兄弟 休怪 前日朝廷差天使賜藥酒與 服了死在旦夕 為人一世只主張忠義二字不肯半點欺心今日朝廷賜死無辜寧可朝廷負 忠心不負朝廷 死之後恐怕 造反壞了 梁山泊替天行道忠義之名因此請將 來相見一面昨日酒中已與了 慢藥服了回至潤州必死 死之後可來此處楚州南門外有個蓼兒窪風景盡與梁山泊無異和 陰魂相聚 死之後屍首定葬於此處 已看定了也言訖墮淚如雨李逵見說亦垂淚道罷罷罷生時伏侍哥哥死了也只 哥哥部下一個小鬼言訖淚下便覺道身體有些沈重當時灑淚拜別了宋江下船回到潤州果然藥發身死李逵臨死之時囑咐從人 死了可千萬將 靈柩去楚州南門外蓼兒窪和哥哥一處埋葬囑罷而死從人置備棺槨盛貯不負其言扶柩而往 再說宋江自從與李逵別後心中傷感思念吳用花榮不得會面 夜藥發臨危囑咐從人親隨之輩可依 言將 靈柩安葬此間南門外蓼兒窪高原深處必報 眾人之德乞依 囑言訖而逝宋江從人置備棺槨依禮殯葬楚州官吏聽從其言不負遺囑當與親隨人從本州吏胥老幼扶宋公明靈柩葬於蓼兒窪數日之後李逵靈柩亦從潤州到來葬於宋江墓側不在話下且說宋清在家患病聞知家人回來報說哥哥宋江已故在楚州病在鄆城不能前來津送後又聞說葬於本州南門外蓼兒窪只令得家人到來祭祀看視墳塋修築完備回覆宋清不在話下 卻說武勝軍承宣使軍師吳用自到任之後常常心中不樂每每思念宋公明相愛之心忽一日心情恍惚寢寐不安至夜夢見宋江李逵二人扯住衣服說道軍師 等以忠義為主替天行道於心不曾負了天子今朝廷賜飲藥酒 死無辜身亡之後現已葬於楚州南門外蓼兒窪深處軍師若想舊日之交情可到墳塋親來看視一遭吳用要問備細撒然覺來乃 南柯一夢吳用淚如雨下坐而待旦得了此夢寢食不安次日便收拾行李徑往楚州來不帶從人獨自奔來前至楚州果然宋江已死只聞彼處人民無不嗟嘆吳用安排祭儀直至南門外蓼兒洼尋到墳塋置祭宋公明李逵就於墓前以手摑其墳塚哭道仁兄英靈不昧乞為昭鑒吳用 一村中學究始隨晁蓋後遇仁兄救護一命坐享榮華到今數十餘載皆賴兄之德今日既為國家而死託夢顯靈與 兄弟無以報答願得將此良夢與仁兄同會於九泉之下言罷痛哭正欲自縊只見花榮從船上飛奔到於墓前見了吳用各喫一驚吳學究便問道賢弟在應天府為官緣何得知宋兄已喪花榮道兄弟自從分散到任之後無日身心得安常想念眾兄之情因夜得一異夢夢見宋公明哥哥和李逵前來扯住小弟訴說朝廷賜飲藥酒鴆死現葬於楚州南門外蓼兒洼高原之上兄弟如不棄舊可到墳前看望一遭因此小弟擲了家間不避驅馳星夜到此吳用道 得異夢亦 如此與賢弟無異因此而來今得賢弟到此最好吳某心中想念宋公明恩義難捨交情難報正欲就此處自縊而死魂魄與仁兄同聚一處身後之事託與賢弟花榮道軍師既有此心小弟便當隨從亦與仁兄同歸一處似此真乃死生契合者也有詩為證 紅蓼洼中託夢長花榮吳用各悲傷 一腔義血元同有豈忍田橫獨喪亡 吳用道 指望賢弟看見 死之後葬 於此 如何也行此事花榮道小弟尋思宋兄長仁義難捨恩念難忘 等在梁山泊時已 大罪之人幸然不死感得天子赦罪招安北討南征建立功勛今已姓揚名顯天下皆聞朝廷既已生疑必然來尋風流罪過倘若被他奸謀所施誤受刑戮那時悔之無及如今隨仁兄同死於黃泉也留得個清名於世屍必歸墳矣吳用道賢弟 聽 說 已單身又無家眷死卻何妨 今現有幼子嬌妻使其何依花榮道此事無妨自有囊篋足以餬口妻室之家亦自有人料理兩個大哭一場雙雙懸於樹上自縊而死船上從人久等不見本官出來都到墳前看時只見吳用花榮自縊身死慌忙報與本州官僚置備棺槨葬於蓼兒窪宋江墓側宛然東西四坵楚州百姓感念宋江仁德忠義兩全建立祠堂四時享祭里人祈禱無不感應 且不說宋江在蓼兒窪纍纍顯靈所求立應卻說道君皇帝在東京內院自從賜御酒與宋江之後聖意纍纍設疑又不知宋江消息常只掛念於懷每日被高俅楊戩議論奢華受用所惑只要閉塞賢路謀害忠良忽然一日上皇在內宮閒翫猛然思想起李師師就從地道中和兩個小黃門逕來到他後園中拽動鈴索李師師慌忙迎接聖駕到於臥房內坐定上皇便叫前後關閉了門戶李師師盛妝向前起居已罷天子道寡人近感微疾現令神醫安道全看治有數十日不曾來與愛卿相會思慕之甚今一見卿朕懷不勝悅樂李師師奏道深蒙陛下眷愛之心賤人愧感莫盡房內鋪設酒餚與上皇飲酌取樂才飲過數杯只見上皇神思睏倦點 燈燭熒煌忽然就房裏起一陣冷風上皇見個穿黃衫 立在面前上皇驚起問道 甚人直來到這裏那穿黃衫 人奏道臣乃 梁山泊宋江部下神行太保戴宗上皇道 緣何到此戴宗奏道臣兄宋江只在左右啟請陛下車駕同行上皇曰輕屈寡人車駕何往戴宗道自有清秀好去處請陛下遊翫上皇聽罷此語便起身隨戴宗出得後院來見馬車足備載宗請上皇乘馬而行但見如雲似霧耳聞風雨之聲到一個去處但見 漫漫煙水隱隱雲山不觀日月光明只見水天一色紅瑟瑟滿滿目蓼花綠依依一洲蘆葉雙雙鴻雁哀鳴在沙渚磯頭對對鶺鴒倦宿在敗荷汀畔霜楓簇簇似離人點染淚波風柳疏疏如怨婦蹙顰眉黛淡月寒星長夜景涼風冷露九秋天 當下上皇在馬上觀之不足問戴宗道此 何處要寡人到此戴宗指著山上關路道請陛下行去到彼便知上皇縱馬登山行過三重關道至第三座關前見有上百人俯伏在地儘 披袍掛鎧戎裝革帶金盔金甲之將上皇大驚連問道卿等皆 何人只見為頭一個鳳翅金盔錦袍金甲向前奏道臣乃梁山泊宋江 也上皇曰寡人已教卿在楚州為安撫使卻緣何在此宋江奏道臣等謹請陛下到忠義堂上容臣細訴衷曲枉死之冤上皇到忠義堂前下馬上堂坐定看堂下時煙霧中拜伏著許多人上皇猶豫不定只見為首 宋江上階跪膝向前垂淚啟奏上皇道卿何故淚下宋江奏道臣等雖曾抗拒天兵素秉忠義並無分毫異心自從泰陛下敕命招安之後先退遼兵次平三寇弟兄手足十損其八臣蒙陛下命守楚州到任已來與軍民水米無交天地共知今陛下賜臣藥酒與臣服吃臣死無憾但恐李逵懷恨輒起異心臣特令人去潤州喚李逵到來親與藥酒鴆死吳用花榮亦為忠義而來在臣塚上俱皆自縊而亡臣等四人同葬於楚州南門外蓼兒窪裏人憐憫建立祠堂於墓前今臣等陰魂不散俱聚於此伸告陛下訴平生衷曲始終無異乞陛下聖鑑上皇聽了大驚曰寡人親差天使親賜黃封御酒不知 何人換了藥酒賜卿宋江奏道陛下可問來使便知奸弊所出上皇看見三關寨柵雄壯慘然問曰此 何所卿等聚會於此宋江奏曰此 臣等舊日聚義梁山泊也上皇又曰卿等已死當往受生何故相聚於此宋江奏道天帝哀憐臣等忠義蒙玉帝符牒敕命封為梁山泊都土地眾將已會於此有屈難伸特令戴宗屈萬乘之主親臨水泊懇告平日衷曲上皇曰卿等何不詣九重深院顯告寡人宋江奏道臣乃幽陰魂魄怎得到鳳闕龍樓今者陛下出離宮禁屈邀至此上皇曰寡人可以觀翫否宋江等再拜謝恩上皇下堂回首觀看堂上牌額上書忠義堂三字上皇點頭下階忽見宋江背後轉過李逵手 雙斧厲聲高叫道皇帝皇帝 怎地聽信四個賊臣挑撥屈壞了 們性命今日既見正好報雔黑旋風說罷掄起雙斧逕奔上皇 天子吃這一驚撒然覺來乃 南柯一夢渾身冷汗閃開雙眼見燈燭熒煌李師師猶然未寢上皇問曰寡人恰在何處去來李師師奏道陛下適間伏枕而臥上皇卻把夢中神異之事對李師師一一說知李師師又奏曰凡人正直者必然為神莫非宋江端 已死 他故顯神靈托夢與陛下上皇曰寡人來日必當舉問此事若 如果死了必須與他建立廟宇敕封烈侯李師師奏曰若聖上果然加封顯陛下不負功臣之德上皇當夜嗟嘆不已 次日臨朝傳聖旨會群臣於偏殿當有蔡京童貫高俅楊戩等只慮恐聖上問宋江之事已出宮去了只有宿太尉等幾位大臣在彼侍側上皇便問宿元景曰卿知楚州安撫宋江消息否宿太尉奏道臣雖一向不知宋安撫消息臣昨夜得一異夢甚 奇怪上皇曰卿得異夢可奏與寡人知道宿太尉奏曰臣夢見宋江親到私宅戎裝慣帶頂盔明甲見臣訴說陛下以藥酒見賜而亡楚人憐其忠義葬在楚州南門外蓼兒窪內建立祠堂四時享祭上皇聽罷便顛頭道此誠異事與朕夢一般又分付宿元景道卿可差心腹之人往楚州體察此事有無急來回報宿太尉道 便領了聖旨自出宮禁歸到私宅便差心腹之人前去楚州探聽宋江消息不在話下 次日上皇駕坐文德殿見高俅楊戩在側聖旨問道汝等省院近日知楚州宋江消息否二人不敢啟奏各言不知上皇輾轉心疑龍體不樂 且說宿太尉幹人已到楚州打探回來備說宋江蒙御賜飲藥酒而死已喪之後楚人感其忠義今葬於楚州蓼兒窪高山之上更有吳用花榮李逵三人一處埋葬百姓哀憐蓋造祠堂於墓前春秋祭賽虔誠奉祀士庶祈禱極有靈驗宿太尉聽了慌忙引領幹人入內備將此事回奏天子上皇見說不勝傷感次日早朝天子大怒當百官前責罵高俅楊戩敗國奸臣壞寡人天下二人俯伏在地叩頭謝罪蔡京童貫亦向前奏道人之生死皆由注定省院未有來文不敢妄奏昨夜楚州才有申文到院臣等正欲啟奏上皇終被四賊曲為掩飾不加其罪當即喝退高俅楊戩便教追要原齎御酒使臣不期天使自離楚州回還已死於路 宿太尉次日見上皇於偏殿再以宋江忠義顯靈之事奏聞天子上皇准宣宋江親弟宋清承襲宋江名爵不期宋清已感風疾在身不能為官上表辭謝只願鄆城為農上皇憐其孝道賜錢十萬貫田三千畝以贍其家待有子嗣朝廷錄用後來宋清生一子宋安平應過科舉官至秘書學士這 後話 再說上皇具宿太尉所奏親書聖旨敕封宋江為忠烈義濟靈應侯仍敕賜錢於梁山泊起蓋廟宇大建祠堂妝塑宋江等歿於王事諸多將佐神像敕賜殿宇牌額御筆親書靖忠之廟濟州奉敕於梁山泊起造廟宇但見 金釘朱戶玉柱銀門畫棟雕樑朱簷碧瓦綠欄干低繞軒窗繡簾幕高懸寶檻五間大殿中懸敕額金書兩廡長廊彩畫出朝入相綠槐影裏櫺星門高接青雲翠柳陰中靖忠廟直侵霄漢黃金殿上塑宋公明等三十六員天罡正將兩廊之內列朱武為頭七十二座地煞將軍門前侍從猙獰部下神兵勇猛紙爐巧匠砌樓臺四季焚燒楮帛桅竿高豎掛長旛二社鄉人祭賽庶民恭禮正神祇祀典朝參忠烈帝萬年香火享無窮千載功勛表史記 又有絕句一首詩曰 天罡盡已歸天界地煞還應入地中千古為神皆廟食萬年青史播英雄 後來宋公明纍纍顯靈百姓四時享祭不絕梁山泊內祈風得風禱雨得雨楚州蓼兒窪亦顯靈驗彼處人民重建大殿添設兩廊奏請賜額妝塑神像三十六員於正殿兩廊仍塑七十二將年年享祭萬民頂禮至今古蹟尚存史官有唐律二首哀輓詩曰 莫把行藏怨老天韓彭赤族已堪憐一心報國摧鋒日百戰擒遼破臘年 然曜罡星今已矣讒臣賊子尚依然早知鴆毒埋黃壤學取鴟夷范蠡船 又詩 生當鼎食死封侯男子生平志已酬鐵馬夜嘶山月曉玄猿秋嘯暮雲稠 不須出處求真跡卻喜忠良作話頭千古蓼窪埋玉地落花啼鳥總關愁 全文終 上一回 目錄
# View(inspect(docs[120])) will get error message "cannot coerce class "c("Simple Corpus", "Corpus")" to a dataframe #https://stackoverflow.com/questions/24703920/r-tm-package-vcorpus-error-in-converting-corpus-to-data-frame
#data.frame(text=sapply(docs[120], identity), stringsAsFactors=F) 可處理

步驟三 利用jiebar將文本進行斷詞

roles是主角名單包括綽號，利如宋江叫宋公明、宋押司、及時雨

魯智深之前叫魯達，較後面章節才叫魯智深，後續再把相同字義的綽號合併進行統計

roles<-subset(roles,nchar(roles)>1)將讀入錯誤的空白值進行清理

mixseg = worker()
roles = readLines(paste0(data.path,"role/roles_nickname.txt"), encoding="UTF-8")
roles<-subset(roles,nchar(roles)>1)
new_user_word(mixseg, unlist(roles), rep("n", length(unlist(roles))))
## [1] TRUE
#cutter = worker(bylines = TRUE, stop_word = "stop.txt")
jieba_tokenizer=function(d){
  unlist(segment(d[[1]],mixseg))
}
seg = lapply(docs, jieba_tokenizer)
freqFrame = as.data.frame(table(unlist(seg)))
freqFrame = freqFrame[order(freqFrame$Freq,decreasing=TRUE), ]
head(freqFrame,10)
##       Var1  Freq
## 923     了 10697
## 42108   道  6455
## 15645 宋江  3739
## 12021   在  3494
## 8155    去  3479
## 22376   便  3469
## 7454    他  2897
## 18032   來  2631
## 35412   都  2608
## 22855   卻  2370
seg = lapply(docs, jieba_tokenizer)

步驟四 讀入主角名單(不包括綽號)為rolesi

seg(斷詞)轉為d.corpus再轉為tdm

但發現tdm\(dimnames\)Terms的名字出現亂碼，再用unique取出所有字詞namec進行修正tdm\(dimnames\)Terms

rolesi = readLines(paste0(data.path,"role/roles1.txt"), encoding="UTF-8")
rolesi<-subset(rolesi,nchar(rolesi)>1)
namec<-""
for( i in 1:length(seg)){
  segun<-unlist(seg[[i]])
  segun<-gsub("\\b(魯提轄|魯達|花和尚)\\b", "魯智深", segun)
  segun<-gsub("\\b(宋公明|呼保義|及時雨|宋押司)\\b", "宋江",segun)
  segun<-gsub("\\b(黑旋風|鐵牛)\\b", "李逵", segun)
  v <- as.vector(segun %in% rolesi)
  segun<-segun[v]
  seg [[i]]<-segun
vn<-unique(as.data.frame(segun))
  vxt<-as.character(vn$segun)
 namec<-c(namec,vxt)
 namec<-unique(namec)
}
d.corpus <- Corpus(VectorSource(seg))
inspect(d.corpus[4])
## <<SimpleCorpus>>
## Metadata:  corpus specific: 1, document level (indexed): 0
## Content:  documents: 1
## 
## [1] c("魯智深", "魯智深", "魯智深", "魯智深", "鄭屠", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "鄭屠", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", \n"魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深", "魯智深")
#d.corpus <- tm_map(d.corpus , toSpace, "\n")

tdm <- TermDocumentMatrix(d.corpus,control = list(wordLengths = c(2, Inf)))
head(tdm$dimnames$Terms,20)
##  [1] "洪太尉" "張天師" "王進"   "史進"   "朱武"   "高俅"   "陳達"  
##  [8] "楊春"   "李\xa5" "李忠"   "金翠蓮" "張三"   "智\xb2" "鄭屠"  
## [15] "周通"   "崔道成" "智真"   "小衙內" "王婆"   "林沖"
head(namec,20)
##  [1] ""       "張天師" "洪太尉" "高俅"   "王進"   "史進"   "朱武"  
##  [8] "陳達"   "楊春"   "魯智深" "李忠"   "鄭屠"   "金翠蓮" "張三"  
## [15] "李四"   "周通"   "崔道成" "智真"   "林沖"   "錦兒"
tdm$dimnames$Terms[9]<-'李四'
tdm$dimnames$Terms[13]<-'魯智深'
tdm$dimnames$Terms[46]<-'晁蓋'
tdm$dimnames$Terms[48]<-"公孫勝"
tdm$dimnames$Terms[81]<-"王英"
tdm$dimnames$Terms[126]<-"祝朝奉"
tdm$dimnames$Terms[44]<-"石寶"
tdm$dimnames$Terms[138]<-"孫立"
tdm$dimnames$Terms[139]<-"孫新"
tdm$dimnames$Terms[141]<-"解寶"
tdm$dimnames$Terms[148]<-"白秀英"
tdm$dimnames$Terms[154]<-"呼延灼"
tdm$dimnames$Terms[152]<-"孫安"
tdm$dimnames$Terms[159]<-"徐寧"
tdm$dimnames$Terms[188]<-"單廷珪"
tdm$dimnames$Terms[193]<-"郁保四"
tdm$dimnames$Terms[197]<-"丁得孫"
tdm$dimnames$Terms[204]<-"張叔夜"
tdm$dimnames$Terms[222]<-"瓊英"
tdm$dimnames$Terms[53]<-"白勝"
tdm$dimnames$Terms[184]<-"孫五"
tdm$dimnames$Terms[213]<-"山士奇"

步驟四 計算 tf-idf computation

N = tdm$ncol
tf <- apply(tdm, 2, sum)
idfCal <- function(word_doc)
{ 
  log2( N / nnzero(word_doc) ) 
}
idf <- apply(tdm, 1, idfCal)


doc.tfidf <- as.matrix(tdm)
for(x in 1:nrow(tdm))
{
  for(y in 1:ncol(tdm))
  {
    doc.tfidf[x,y] <- (doc.tfidf[x,y] / tf[y]) * idf[x]
  }
}

步驟四 findFreqTerms 看主角出現的次數 findAssocs看和某主角的關係

畫出宋江主要關係人主要出場在第幾章

result = findFreqTerms(tdm,200)
result
##  [1] "史進"   "魯智深" "林沖"   "柴進"   "楊志"   "朱仝"   "雷橫"  
##  [8] "吳用"   "晁蓋"   "公孫勝" "勝"     "宋江"   "花榮"   "武松"  
## [15] "秦明"   "李俊"   "戴宗"   "張順"   "李逵"   "石秀"   "楊雄"  
## [22] "時遷"   "呼延灼" "徐寧"   "盧俊義" "燕青"   "關勝"   "張清"  
## [29] "王慶"
ass = findAssocs(tdm, "李逵", 0.1)
ass
## $李逵
##     李鬼 李鬼老婆     李達     朱富     戴宗     李雲   羅真人     朱貴 
##     0.54     0.54     0.54     0.50     0.47     0.44     0.37     0.35 
##   公孫勝       勝     高廉     燕青   韓伯龍     侯健   殷天錫   柴皇城 
##     0.28     0.28     0.22     0.18     0.14     0.13     0.13     0.12 
##     焦挺   單廷珪   魏定國 
##     0.11     0.10     0.10
ass = findAssocs(tdm, "宋江", 0.1)
ass
## $宋江
##     宋清   閻婆惜   宋太公     閻婆     張橫   唐牛兒     張三     童猛 
##     0.42     0.38     0.34     0.32     0.31     0.30     0.29     0.29 
##     郭盛     童威     燕順     花榮     呂方     李立     蔣敬     趙譚 
##     0.28     0.28     0.27     0.26     0.26     0.26     0.26     0.26 
##     趙能   王\xb8     穆春     薛永     馬麟     方臘   鄭天壽     石勇 
##     0.25     0.25     0.24     0.24     0.24     0.24     0.23     0.22 
##     李俊   金大堅   張文遠     穆弘     李袞     項充   黃文炳   宿元景 
##     0.22     0.21     0.20     0.20     0.20     0.20     0.19     0.18 
## 劉光\xa5 金芝公主   夏侯成     白勝     侯健   段景住     楊戩     胡顯 
##     0.18     0.18     0.18     0.17     0.17     0.17     0.17     0.17 
##   鄧元覺     石寶     黃信   皇甫端   伍應星     道乙     鄭彪     蕭讓 
##     0.17     0.15     0.15     0.15     0.15     0.15     0.15     0.14 
##   黃文燁     歐鵬   郁保四     萬里     劉高     祝龍     樊瑞   婁敏中 
##     0.14     0.13     0.13     0.12     0.12     0.12     0.12     0.12 
##     蔡京     黃安     戴宗     張順   欒廷玉     曾魁     關勝     吳用 
##     0.11     0.11     0.11     0.11     0.11     0.11     0.11     0.10
topID = lapply(rownames(as.data.frame(ass)), function(x) 
  which(rownames(tdm) == x))
topID = unlist(topID)
library(plotly)
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
plot_ly(data = as.data.frame(doc.tfidf),
        x = as.numeric(colnames(doc.tfidf)),
        y = doc.tfidf[topID[1],], 
        name = rownames(doc.tfidf)[topID[1]],
        type = "scatter", mode= "box") %>%
  add_trace(y = doc.tfidf[topID[2],],
            name = rownames(doc.tfidf)[topID[2]])

##步驟五 取得較小的詞頻矩陣s.tdm ### get short doc matrix

nonzero = (doc.tfidf != rep(0,10))
nonzeroid = which(row_sums(nonzero) != 0)
q <- rownames(doc.tfidf[nonzeroid,])
all.term <- rownames(doc.tfidf)
loc <- which(all.term %in% q)
s.tdm <- doc.tfidf[loc,]
View(s.tdm)

步驟六 cos計算文本相近性

# result : cos similarity ranking
cos.sim <- function(x, y)
{ 
  (as.vector(x) %*% as.vector(y)) / (norm(as.matrix(x)) * norm(y)) 
}
doc.cos <- cos.sim(x=as.matrix(s.tdm[,1]), 
                   y=as.matrix(s.tdm[,2]))
doc.cos <- apply(s.tdm[,2:10], 2, cos.sim,
                 y=as.matrix(s.tdm[,2]))
orderDoc <- doc.cos[order(doc.cos, decreasing = TRUE)]
plot_ly(data = as.data.frame(orderDoc),
        x = rownames(as.data.frame(orderDoc)),
        y = orderDoc, 
        name = rownames(doc.tfidf)[topID[10]],
        type = "bar", mode= "box")

步驟七 計算kmeans及最適分群

水滸傳人物分群數愈多，效果愈好，初步判定分群20組

由pca來看，分群結果相集中，特別在只在第一二章出現的張天師還有洪太尉比較少出現，其餘的分群不明顯

set.seed(7)
km1 = kmeans(doc.tfidf, 10, nstart=100)


mydata <- doc.tfidf
wss <- (nrow(mydata)-1)*sum(apply(mydata,2,var))
for (i in 2:100) wss[i] <- sum(kmeans(mydata,
                                     centers=i)$withinss)
plot(1:100, wss, type="b", xlab="Number of Clusters",
     ylab="Within groups sum of squares",
     main="Assessing the Optimal Number of Clusters with the Elbow Method",
     pch=20, cex=2)

##步驟八 利用pca畫圖

kmeansOut <- kmeans(doc.tfidf, 20, nstart = 100)
library(devtools)
library(ggbiplot)
## Loading required package: plyr
## 
## Attaching package: 'plyr'
## The following objects are masked from 'package:plotly':
## 
##     arrange, mutate, rename, summarise
## Loading required package: scales
## Loading required package: grid
testTfidf = doc.tfidf
tfidf.pca <- prcomp(testTfidf)
tfidf.kmeans <- as.factor(kmeansOut$cluster)

g <- ggbiplot(tfidf.pca, obs.scale = 1, var.scale = 1, 
              groups = tfidf.kmeans, ellipse = TRUE, 
              circle = TRUE, labels = rownames(testTfidf))
g <- g + scale_color_discrete(name = '')
g <- g + theme(legend.direction ="horizontal",legend.position ="top")
#g<-g+ xlim(10, 0.05) + ylim(-0.05, 0)
print(g)

g<-g+ xlim(-0.5, 0.5) + ylim(-0.5, 0.5)
print(g)

g<-g+ xlim(-0.05, 0.05) + ylim(-0.05, 0.05)
## Scale for 'x' is already present. Adding another scale for 'x', which
## will replace the existing scale.
## Scale for 'y' is already present. Adding another scale for 'y', which
## will replace the existing scale.
print(g)

g<-g+ xlim(0.020, 0.030) + ylim(0.020, 0.04)
## Scale for 'x' is already present. Adding another scale for 'x', which
## will replace the existing scale.
## Scale for 'y' is already present. Adding another scale for 'y', which
## will replace the existing scale.
print(g)