倚天屠龙记人物角色分析

#加载所需的R包 library(ggplot2) library(data.table) library(reshape2) #设置文件路径 setwd("C:/Users/lenovo/Desktop/big data/倚天屠龙记分析") #载入主角名单 roles = readLines("主角名单.txt") roles[1:5]

#载入小说文本数据 yitian = readLines("倚天屠龙记.txt") #将原小说进行分段 para_head = grep("\\s+", yitian, perl = T) cut_para1 = cbind(para_head[1:(length(para_head)-1)], para_head[-1]-1) yitian_para = sapply(1:nrow(cut_para1), function(i) paste(yitian[cut_para1[i,1]:cut_para1[i,2]], collapse = "")) writeLines(yitian_para, "C:/Users/lenovo/Desktop/big data/倚天屠龙记分析/yitian_para.txt") #对角色进行统计 roles1 = paste0("(", gsub(" ", ")|(", roles), ")") roles_l = strsplit(roles, " ") # 总结每个人的不同称呼 #计算每个人物名称的出现次数 role_para = sapply(roles1, grepl, yitian_para) colnames(role_para) = sapply(roles_l, function(x) x[1]) #将角色出现次数赋值到一个数据框中以便作图 role_count = data.frame(role = factor(colnames(role_para), levels = colnames(role_para)[order(colSums(role_para), decreasing = T)]), count = colSums(role_para)) #根据出现次数绘图 ggplot(role_count, aes(x = role, y = count, fill = role)) + geom_bar(stat = "identity", width = 0.75) + xlab("Role") + ylab("Count") + theme(axis.text=element_text(size=30, angle = 90), axis.title=element_text(size=20,face="bold"), axis.title.x = element_text(vjust=-2), legend.position="none")

#将人物出场顺序放入数据框中以便作图 main_roles = c("殷离","周芷若","赵敏","小昭", "张无忌") role_para_df = data.frame(role = factor(rep(main_roles, colSums(role_para)[1:5])), para = which(role_para[,(1:5)], arr.ind = T)[,1]) #提取出三个主角的出场顺序 role_para_df1 = role_para_df[is.element(role_para_df$role, c("赵敏","周芷若", "张无忌")),] #作出三个主角的出场顺序密度图 (p<-ggplot(role_para_df1, aes(para, fill = role, fill = role)) + geom_density(aes(y = ..density..), alpha=I(0.3), color="white" ,size = 0) + labs(x="\n出场顺序",y="密 度\n") + scale_fill_manual("角 色",values=terrain.colors(7)[3:1]) + theme(plot.margin = unit(c(0,1,1,0), "cm"), axis.text=element_text(size=30), axis.title.x = element_text(vjust=-2), axis.title.y = element_text(), axis.title=element_text(size=30,face="bold"), panel.background = element_rect(fill="white"), panel.grid.major = element_line(color="white"), panel.grid.minor = element_line(color="white"), axis.line = element_line(color="grey40"), legend.key.size = unit(0.8,"cm"), legend.text = element_text(size = 25), legend.title = element_text(size = 25)))

#计算亲密度逻辑值 co_para = crossprod(role_para) #将无意义的矩阵对角线元素化为0 diag(co_para) <- 0 #构建前5个人物亲密度矩阵 intimacy_main <- co_para[1:5,1:5] #调整数据组织形式以便画图 intimacy_main <- melt(intimacy_main) #绘制亲密度矩阵图 (p <- ggplot(intimacy_main,aes(Var1,Var2,fill=value)) + geom_tile(color="#32CD32") + geom_text(data=intimacy_main,aes(Var2,Var1,label=value),size=13,color="black") + scale_fill_gradient(low = "white", high = "#32CD32") + xlab("") + ylab("") + scale_x_discrete(expand=c(0,0),limits = c(张无忌,赵敏,周芷若,殷离,小昭))+ scale_y_discrete(expand=c(0,0),limits = c(张无忌,赵敏,周芷若,殷离,小昭)[5:1]) + theme(legend.position="none", axis.text.y = element_text(color="grey20",size=37), axis.text.x = element_text(angle=90,color="grey20",size=37)))

#将不同人物分开 rolesl = strsplit(roles, " ") #计算殷离不同称呼的出现段落 roles_para = sapply(rolesl[[1]], grepl, yitian_para) colnames(roles_para) = rolesl[[1]] #生成新数据框roles_para_df,罗列表示殷离不同称呼所出现的段落标号 roles_para_df = data.frame(role = factor(rep(colnames(roles_para), colSums(roles_para))),para = which(roles_para>0, arr.ind = T)[,1]) #根据殷离不同称呼绘制折线图 (p <- ggplot(roles_para_df, aes(para, fill = role)) + geom_density(aes(y = ..density..), alpha=I(0.5), size = 0,color="white") + labs(x="\n出现段落",y="密 度\n") + xlim(0, 4614)+ scale_fill_manual("称 谓",values=terrain.colors(6)[5:1]) + theme(plot.margin = unit(c(0,1,1,0), "cm"), axis.text=element_text(size=30), axis.title.x = element_text(vjust=-2), axis.title=element_text(size=30,face="bold"), panel.background = element_rect(fill="white"), panel.grid.major = element_line(color="white"), panel.grid.minor = element_line(color="white"), axis.line = element_line(color="grey40"), legend.key.size = unit(1,"cm"), legend.text = element_text(size = 25), legend.title = element_text(size = 25)))

#计算周芷若不同名称的出现段落 roles_para = role_para[,5]*sapply(rolesl[[2]], grepl, yitian_para)[,c(2,3,4,7)] colnames(roles_para) = rolesl[[2]][c(2,3,4,7)] #生成新数据框roles_para_df,罗列表示周芷若不同称呼所出现的段落标号 roles_para_df = data.frame(role = factor(rep(colnames(roles_para), colSums(roles_para))), para = which(roles_para>0, arr.ind = T)[,1]) #根据周芷若不同称呼绘制折线图 (p <- ggplot(roles_para_df, aes(para, fill = role)) + geom_density(aes(y = ..density..), alpha=I(0.5), size = 0,color="white") + labs(x="\n出现段落",y="密 度\n") + xlim(0, 4614)+ scale_fill_manual("称 谓",values=terrain.colors(6)[4:1]) + theme(plot.margin = unit(c(0,1,1,0), "cm"), axis.text=element_text(size=30), axis.title.x = element_text(vjust=-2), axis.title=element_text(size=30,face="bold"), panel.background = element_rect(fill="white"), panel.grid.major = element_line(color="white"), panel.grid.minor = element_line(color="white"), axis.line = element_line(color="grey40"), legend.key.size = unit(1,"cm"), legend.text = element_text(size = 25), legend.title = element_text(size = 25)))

#计算赵敏不同称呼的出场段落 roles_para = role_para[,5]*sapply(rolesl[[3]], grepl, yitian_para)[,c(1,4,5,6)] colnames(roles_para) = rolesl[[3]][c(1,4,5,6)] #生成新数据框roles_para_df,罗列表示赵敏不同称呼所出现的段落标号 roles_para_df = data.frame(role = factor(rep(colnames(roles_para), colSums(roles_para))), para = which(roles_para>0, arr.ind = T)[,1]) #根据赵敏不同称呼绘制折线图 (p <- ggplot(roles_para_df, aes(para, fill = role)) + geom_density(aes(y = ..density..), alpha=I(0.5), size = 0,color="white") + labs(x="\n出现段落",y="密 度\n") + xlim(2700, 4600)+ scale_fill_manual("称 谓",values=terrain.colors(6)[4:1]) + theme(plot.margin = unit(c(0,1,1,0), "cm"), axis.text=element_text(size=30), axis.title.x = element_text(vjust=-2), axis.title=element_text(size=30,face="bold"), panel.background = element_rect(fill="white"), panel.grid.major = element_line(color="white"), panel.grid.minor = element_line(color="white"), axis.line = element_line(color="grey40"), legend.key.size = unit(1,"cm"), legend.text = element_text(size = 25), legend.title = element_text(size = 25)))

#分析兵器信息 (weapon = readLines("兵器.txt", encoding = "UTF-8")[-1]) yitian_para = readLines("yitian_para.txt") weapon_para = sapply(weapon, grepl, yitian_para) #计算各兵器出现次数 weaponN = colSums(weapon_para) weapon_count_df = data.frame(weapon = factor(weapon, levels = weapon[order(weaponN, decreasing = T)]), count = weaponN) #根据各种兵器的出现次数绘图 ggplot(weapon_count_df, aes(x = weapon, y = count, fill = weapon)) + geom_bar(stat = "identity", width = 0.75) + xlab("") + ylab("出现次数") + theme(axis.text=element_text(size=30), axis.title=element_text(size=30,face="bold"), axis.title.x = element_text(vjust=-2), legend.position="none")

#分析角色使用武功信息 roles1 = paste0("(", gsub(" ", ")|(", roles), ")") rolesl = strsplit(roles, " "); roles_all = sapply(rolesl, function(x) x[1]) #将每个角色第一个称呼作为其主要称呼 role_para = sapply(roles1, grepl, yitian_para) role_weapon = t(role_para)%*%weapon_para rownames(role_weapon) = roles_all role_weapon = 1/rowSums(role_weapon)*role_weapon #计算主角使用不同武器的频率 role_weapon_df = data.frame(role = factor(rep(roles_all, length(weapon)), levels = roles_all), weapon = factor(rep(weapon, each = length(roles_all)), levels = weapon), value = as.vector(role_weapon)) #根据各主角使用不同武器频率进行绘图 maincharacter <- c("张无忌","殷离","赵敏","周芷若","小昭") colorvector <- terrain.colors(7)[1:5] #依次计算对主角使用不同武器频率 for(i in 1:length(maincharacter)){ role_weapon_temper <- subset(role_weapon_df,role_weapon_df$role==maincharacter[i]) role_weapon_temper <- role_weapon_temper[order(role_weapon_temper$value,decreasing = T),] #按照从高到底顺序排列主角使用不同武器频率，依次做出四个角色使用武器频率图 p <- ggplot(role_weapon_temper,aes(x = weapon,y = value)) + geom_bar(fill=colorvector[i],stat="identity",width=0.4) + labs(x=" ",y=" ",title=paste(maincharacter[i],"的武功使用频率",sep="")) + scale_x_discrete(limits = role_weapon_temper$weapon[order(role_weapon_temper$value,decreasing = T)][1:4]) + scale_y_continuous(breaks = seq(from=0,to=500,by=100),labels = seq(from=0,to=0.5,by=0.1)) + theme(panel.background=element_rect(fill="white"), axis.line.x=element_line(color="grey70"), axis.line.y=element_line(color="grey70"), axis.text = element_text(size=30), plot.title = element_text(size=30)) print(p) }

#四个门派各选取两个代表人物 people <- c("周芷若","灭绝师太","张三丰","张翠山","杨逍","张无忌","赵敏","鹤笔翁") weapon_mp <- role_weapon_df[is.element(role_weapon_df$role,people),] mp <- c("峨眉派","武当派","明教","郡主府") #根据代表人物计算其各武器使用频率 colorvector <- terrain.colors(8)[1:7] for(i in 1:4){ #依次计算代表人物武器使用频率 weapon_temp1 <- subset(weapon_mp,weapon_mp$role==people[2*i-1]) weapon_temp2 <- subset(weapon_mp,weapon_mp$role==people[2*i]) weapon_temp <- rbind(weapon_temp1,weapon_temp2) #绘制条形图 (p <- ggplot(weapon_temp,aes(x = weapon,y = value,fill=factor(role))) + geom_bar(width=0.5,stat = "identity",position = "dodge") + scale_fill_manual("代表人物",values = c(colorvector[1],colorvector[4])) + labs(x=" ",y=" ",title=paste(mp[i],"代表人物武功使用频率",sep="")) + scale_y_continuous(breaks = seq(from=0,to=500,by=100),labels = seq(from=0,to=0.5,by=0.1)) + theme(panel.background=element_rect(fill="white"), axis.line.x=element_line(color="grey70"), axis.line.y=element_line(color="grey70"), axis.text = element_text(size=30), plot.title = element_text(size=30), legend.key.size = unit(1,"cm"), legend.text = element_text(size = 25), legend.title = element_text(size = 25))) print(p) }

#加载所需要的R包 library(igraph) library(sna) library(network) library(ggraph) #构造适用于gephi作图的数据social_net #co_para为每两个人出现在同一段落的次数，将其中出现在同一段落的次数超过25次的两个角色定义为有联系 social_net=melt(co_para) social_net=social_net[social_net$value>25,] social_net$Type=rep("Undirected",nrow(social_net)) colnames(social_net)=c("Source","Target","Weight","Type") social_net1 = graph_from_data_frame(social_net) ggraph(social_net1,layout = "fr")+ theme_grey()+ geom_edge_link() + geom_node_point() + geom_node_text(aes(label = name), vjust = 1, hjust = 1)

ggraph(social_net1, layout = "fr") + geom_edge_link(aes(edge_alpha = Weight), show.legend = FALSE, end_cap = circle(.07, inches)) + geom_node_point(color = "green", size = 5) + geom_node_text(aes(label = name), vjust = 1, hjust = 1,family="STKaiti") + theme_void()

set.seed(2019) a <- grid::arrow(type = "closed", length = unit(.15, "inches")) ggraph(social_net1, layout = "fr") + geom_edge_link(aes(edge_alpha = Weight), show.legend = FALSE, arrow = a, end_cap = circle(.07, inches)) + geom_node_point(color = "green", size = 5) + geom_node_text(aes(label = name), vjust = 1, hjust = 1,family="STKaiti") + theme_void()

#输出可用于gephi作图的边数据social_net write.csv(social_net,file = "social_net.csv") #网络统计量计算# #将co_para变为01邻接矩阵 a=matrix(0,31,31) a=(co_para>25)*1 a=a[!colSums(a)==0,!rowSums(a)==0] #构造图对象 g <- graph.adjacency(a,mode = "undirected") #顶点数 length(V(g)) #结果是30个人 #边数 length(E(g)) #91条边 #网络密度计算方法1 graph.density(g) #0.2091954 #网络密度计算方法2 sum(a!=0)/(nrow(a)*(nrow(a)-1)) #0.2091954 #度分布直方图 par(cex.lab = 1,cex.main = 2) #a.r为度数分布向量 a.r = rowSums(a) hist(a.r, col = "#32CD32",xlab="度数",ylab="频数",main="度数分布图",breaks = 20,xlim=c(0,30)) text(27,2,"张无忌",cex=1) text(15.5,1.5,"赵敏",cex=1) text(12,1.5,"周芷若",cex=1)

mean(a.r) #6.066667 #平均度数6.07，即平均每个人都与另外6个人有联系

#加载所需R包 library(jiebaR) library(wordVectors) library(ape) #注意wordVectors包需要用devtools::install.github函数下载 #代码如下 #install.packages("devtools") #library(devtools) #install_github("bmschmidt/wordVectors") #根据词语将整本小说分成不同字符串 cutter = worker(bylines = TRUE, stop_word = "stop.txt") #根据主角名称进行分词 new_user_word(cutter, unlist(rolesl), rep("n", length(unlist(rolesl)))) #输出分词后的段落文本 yitian_words = cutter[yitian_para] yitian_split = sapply(yitian_words, paste, collapse = " ") writeLines(yitian_split, "yitian_split.txt") #训练词向量 model = train_word2vec("yitian_split.txt", output="yitian_split.bin", threads = 3, vectors = 100, window=12, force = T) vec = read.vectors("yitian_split.bin") #计算和三位主角共同出现次数最多的词语 nearest_to(model,model[["张无忌"]]) nearest_to(model,model[["赵敏"]]) nearest_to(model,model[["周芷若"]]) #提取出所有主角 rr = sapply(rolesl, function(x) x[1]) cos_dist = cosineDist(vec[rr,],vec[rr,]) #计算其不同人物词语向量化后的cos夹角 hc = hclust(as.dist(cos_dist), method = "average") #设置颜色向量以便画图 colorvec <- c("white","#F36838","#90FFFF","#C0EBD7","#FFC773","#CCA4E3","#D3B17D") #设置图片背景颜色 op = par(bg = "grey20") class <- cutree(hc,7) #利用ape包将hc对象转为phylo对象，并绘制分类图 plot(as.phylo(hc),type="fan", tip.color=colorvec[class], edge.color="#C0EBD7", cex=3, edge.width=3)