R语言聚类树状图 r语言文本聚类分析实例

目录

• 1、数据爬取及预处理

• 1.1 基本介绍
• 1.2 R语言爬虫代码

• 2、数据预处理
• 3、描述统计分析
• 4、Kmeans聚类分析

1、数据爬取及预处理

1.1 基本介绍

数据来源：当当网五星图书榜单，该网页为静态网页，易爬取且翻页机制明显，在此不展开详细分析，本次爬取的内容为童书所有分类，爬取每个图书的字段如下表所示

数据字段	含义
book_title	图书标题
book_comments	评论人数
book_recommend	推荐指数
book_price_now	现价
book_price_origin	原价
book_price_cutoff	折扣
cato	图书类型

这里主要介绍R语言爬虫rvest包，其下主要函数用法如表所示

函数名	主要作用
read_html	访问网页并解析页面数据
read_nodes	用于抽取页码节点数据，抽取的方式类似CSS选择器
html_text	用于抽取节点中的字符串
%>%	管道运算符，可将前一个函数运行结果作为参数直接传给后一个函数，免去了变量命名的麻烦

1.2 R语言爬虫代码

library(rvest)
library(stringi)

#所有分类栏目对应ID
all_types = c("绘本/图画书"=70, "中国儿童文学"=26, "外国儿童文学"=27,
              "科普/百科"="05","动漫/卡通"=50,"幼儿/启蒙"=45,
              "益智游戏"=46,"婴儿读物"=44,"玩具书"=48,
              "少儿励志成长"=71,"少儿英语"=51,"少儿期刊"=69,
              "阅读工具书"=59,"进口儿童书"=57
              )

base_url<-"http://bang.dangdang.com/books/fivestars/01.41."
right_url<-".00.00.00-all-0-0-1-"
book_data_all<-data.frame(matrix(0,0,0))

crawl_book<-function(url,cato){
  html_text<-read_html(url,encoding='gbk')
  li_list<-html_text%>%html_nodes("ul.bang_list")%>%html_nodes("li")
  
  #图书名称
  book_title<-li_list%>%html_nodes("div.name")%>%
    html_nodes("a")%>%html_text("title")
  
  #评论人数
  book_comments<-li_list%>%html_nodes("div.star")%>%
    html_nodes("a")%>%
    html_text()%>%
    stri_replace_all(replacement="",regex="条评论")%>%
    as.numeric()
  
  #推荐指数
  book_recommend<-li_list%>%html_nodes("div.star")%>%
    html_nodes("span.tuijian")%>%
    html_text()%>%
    stri_replace_all(replacement="",regex="推荐")
    
  #五星评分次数
  book_score_count<-li_list%>%html_nodes("div.biaosheng")%>%
    html_text()%>%
    stri_extract(regex="(\\d+)")%>%
    as.numeric()
  
  #现价
  book_price_now<-apply(as.matrix(1:length(html_nodes(li_list,"div.price"))),1,
    function(x){
      out<-html_nodes(html_nodes(li_list,"div.price")[x],"span.price_n")%>%
        html_text()
      price<-as.numeric(stri_extract(out[1],regex="(\\d+\\.\\d+)"))
      return(price)
    })
  
  #原价
  book_price_origin<-apply(as.matrix(1:length(html_nodes(li_list,"div.price"))),1,
     function(x){
       out<-html_nodes(html_nodes(li_list,"div.price")[x],"span.price_r")%>%
         html_text()
       price<-as.numeric(stri_extract(out[1],regex="(\\d+\\.\\d+)"))
       return(price)
     })

  #折扣
  book_price_cutoff<-apply(as.matrix(1:length(html_nodes(li_list,"div.price"))),1,
     function(x){
       out<-html_nodes(html_nodes(li_list,"div.price")[x],"span.price_s")%>%
         html_text()
       price<-as.numeric(stri_extract(out[1],regex="(\\d+\\.\\d+)"))
       return(price)
     })

  #图书所属分类
  cato<-rep(cato,length(book_title))
  
  book_data<-data.frame(
    book_title,
    book_comments,
    book_recommend,
    book_score_count,
    book_price_now,
    book_price_origin,
    book_price_cutoff,
    cato
  )
  return(book_data)
}

for(i in 1:length(all_types)){
  cat(names(all_types)[i],"部分开始爬取\n")
  for(page in 1:25){
    url<-paste0(base_url,all_types[i],right_url,page)
    go<-try({data<-crawl_book(url,names(all_types)[i])}) #异常处理
    if("try-error"%in%class(go)){
      cat(names(all_types)[i],"部分出现问题\n")
      break
    }else{
      book_data_all<-rbind(book_data_all,data)
      cat("第",page,"页爬取完成\n")
      Sys.sleep(1)
      }
    rm(data)  #释放内存
  }
}

write.csv(book_data_all,
          "当当网TOP五星榜单数据.csv",
          row.names = F)

2、数据预处理

• 将推荐指数中的百分号去除，并转为数值型字段
• 删除缺失值

library(stringi)
data<-read.csv('当当网TOP五星榜单数据.csv')
data$book_recommend<-apply(as.matrix(data$book_recommend),1,
      function(x){
      as.numeric(stri_replace_all(x,replacement="",regex="%"))
      })
data<-na.omit(data)

3、描述统计分析

1、图书类型分类

library(plotly)
library(dplyr)

explor_book_category<-group_by(data,cato)%>%
    summarise(count=n(),
              percent=n()/nrow(data)*100)%>%
  arrange(desc(count))

plot_ly(data<-explor_book_category,
        labels=~cato,
        values=~count,
        name="图书类别构成"
        )%>%add_pie(hole=0.5)

2、图书价格分布情况

• 原价分布

• 现价分布

• 折扣分布

#自定义直方图
ExplorHistogramplot<-function(data,titleX=NULL,titleY=NULL){
  plot_ly(x=~data,
          type="histogram",
          marker=list(color="rgb(158,202,225)",
          line=list(color="rgb(8,48,107)",width=1.5)),
          histnorm="count",
          name="直方图")%>%
          layout(xaxis=list(title=titleX),
                 yaxis=list(title=titleY))
}

#自定义箱线图
ExplorBoxPlot<-function(data,titleX=NULL,titleY=NULL){
  plot_ly(x=~data,
          type="box",
          name="箱线图")%>%
    layout(xaxis=list(title=titleX),
           yaxis=list(title=titleY))
}

#绘制现价组合图
p1<-ExplorHistogramplot(data=data$book_price_now,titleY="频次")
p2<-ExplorBoxPlot(data=data$book_price_now,titleY="",titleX="图书现价")
subplot(p1,p2,nrows=2,widths=1,heights=c(0.8,0.2),margin=0,
        shareX=T,shareY=F,titleX=T,titleY=F)

#绘制原价组合图
p3<-ExplorHistogramplot(data=data$book_price_origin,titleY="频次")
p4<-ExplorBoxPlot(data=data$book_price_origin,titleY="",titleX="图书原价")
subplot(p3,p4,nrows=2,widths=1,heights=c(0.8,0.2),margin=0,
        shareX=T,shareY=F,titleX=T,titleY=F)

#绘制折扣分布图
p5<-ExplorHistogramplot(data=data$book_price_cutoff,titleY="频次")
p6<-ExplorBoxPlot(data=data$book_price_cutoff,titleY="",titleX="图书折扣")
subplot(p5,p6,nrows=2,widths=1,heights=c(0.8,0.2),margin=0,
        shareX=T,shareY=F,titleX=T,titleY=F)

3、各变量相关分析

library(corrplot)
corrplot(cor(data[,2:7]),
         method="number",
         type="upper",tl.srt=45)

4、Kmeans聚类分析

1、标准化处理

scale_data<-apply(data[,2:7],2,scale,center=T,scale=T)
colnames(scale_data)<-paste0(colnames(data)[2:7],"_z")
scale_data<-na.omit(scale_data)

2、聚类可视化
本次聚类暂定聚类数目K=3

library(ggfortify)
set.seed(4869)
book_cluster<-kmeans(x=scale_data,centers=3,iter.max=100,nstart=30)
autoplot(book_cluster,data<-scale_data,label=F,lable.size=2,frame=TRUE)+theme_bw()

3、聚类结果检验
现对三种分类进行平均数差异检验，从统计学上判断各项指标是否存在显著差异，使用的是oneway.test()函数

#添加聚类标签
data_cluster<-data.frame(scale_data,
                         book_cluster=book_cluster$cluster,
                         stringsAsFactors=F)
                         
Ftest<-function(x,group){
  data<-data.frame(x,group)
  rst<-c(tapply(data$x,data$group,mean),c(unlist(oneway.test(x~group)))[c(1:4)])
  rst<-round(as.numeric(rst),3)
  names(rst)<-c("类别1均值","类别2均值","类别3均值","F值","分子自由度","分母自由度","P值")
  return(rst)
}

test_cluster<-t(apply(data_cluster,2,Ftest,group=data_cluster$book_cluster))
test_cluster[1:nrow(test_cluster)-1,]

从检验结果可知，各指标均通过显著性检验，则表明三种聚类类型在这五个指标上均存在明显差异，可用于后续分析。根据3种聚类变量在价格和评价上的评价差异，可将其分为三类：性价比高（聚类1，价格适中，评价高），性价比低（聚类2，价格低，评价低），性价比适中（聚类3，价格高，但评价居中）

4、图书性价比分析
现在上述人工分类的基础上，展开进一步分析
1、不同性价比图书价格分布

data$book_cluster<-book_cluster$cluster
data$book_cluster<-factor(data$book_cluster,
                          levels=c(1,2,3),
                          labels=c("性价比高","性价比低","性价比适中"),
                          ordered=T)

CompareBoxPlot<-function(x,group,titleX=NULL,titleY=NULL){
  data<-data.frame(x,group)
  plot_ly(data=data,
         x=~x,
         color=~group,
         type="box",
         showlegend=FALSE)%>%
    layout(xaxis=list(title=titleX),
           yaxis=list(title=titleY))
}

p7<-CompareBoxPlot(x=data$book_price_now,
                   group=data$book_cluster,
                   titleX="图书现价")
p8<-CompareBoxPlot(x=data$book_price_origin,
                   group=data$book_cluster,
                   titleX="图书原价")
p9<-CompareBoxPlot(x=data$book_price_cutoff,
                   group=data$book_cluster,
                   titleX="图书折扣")
subplot(p7,p8,p9,nrows=1,widths=c(0.33,0.33,0.33),
        heights=1,margin=0.05,shareX=F,shareY=F,
        titleX=T,titleY=T)

2、不同性价比图书评价分布

p10<-CompareBoxPlot(x=data$book_recommend,
                   group=data$book_cluster,
                   titleX="推荐指数")
p11<-CompareBoxPlot(x=data$book_comments,
                   group=data$book_cluster,
                   titleX="评论次数")
p12<-CompareBoxPlot(x=data$book_score_count,
                   group=data$book_cluster,
                   titleX="五星推荐次数")
subplot(p10,p11,p12,nrows=1,widths=c(0.33,0.33,0.33),
        heights=1,margin=0.05,shareX=F,shareY=F,
        titleX=T,titleY=T)

由箱线图分析可知，性价比高的图书在评价指标上整体优于其他两个类别

以上就是本次分享的全部内容~