豆瓣阅读统计及可视化(下)
qxde01发表于 2014-01-01 20:07:42
- 书籍页数统计
对collect_df中的时间、页数进行处理，并按月计算页数之和，注意有些书籍没有页数信息，无法计算在内，以缺失值NA处理，使用ggplot2绘制树状图如下：
01 pages<-as.integer(gsub('[页 ]','',collect_df$pages))
02 pg_df<-data.frame(collect_df$title,pages,
03 month=substr(collect_df$reading_date,1,7),
04 year=substr(collect_df$reading_date,1,4))
05 pg_s<-tapply(pg_df$pages,pg_df$month,sum,na.rm = T)
06 pg_sdf<-data.frame(pages=pg_s[],month=names(pg_s),year=substr(names(pg_s),1,4))
07
08 ggplot(pg_sdf, aes(x = month, fill=year,colour=pages)) +
09 geom_bar(stat="identity", ymin=0, aes(y=pages, ymax=pages),position="dodge") +
10 geom_text(aes(x=month, y=pages, ymax=pages,
11 label=pages,hjust=ifelse(sign(pages)>0, 0.5, 0)),
12 vjust=-0.8,size=6,colour='blue',
13 position = position_dodge(width=1)) +
14 labs(x='年-月份', y='读书页数',title =paste0('总共阅读的页数(>=) ',sum(pg_sdf$pages),' 页'))
02 pg_df<-data.frame(collect_df$title,pages,
03 month=substr(collect_df$reading_date,1,7),
04 year=substr(collect_df$reading_date,1,4))
05 pg_s<-tapply(pg_df$pages,pg_df$month,sum,na.rm = T)
06 pg_sdf<-data.frame(pages=pg_s[],month=names(pg_s),year=substr(names(pg_s),1,4))
07
08 ggplot(pg_sdf, aes(x = month, fill=year,colour=pages)) +
09 geom_bar(stat="identity", ymin=0, aes(y=pages, ymax=pages),position="dodge") +
10 geom_text(aes(x=month, y=pages, ymax=pages,
11 label=pages,hjust=ifelse(sign(pages)>0, 0.5, 0)),
12 vjust=-0.8,size=6,colour='blue',
13 position = position_dodge(width=1)) +
14 labs(x='年-月份', y='读书页数',title =paste0('总共阅读的页数(>=) ',sum(pg_sdf$pages),' 页'))
实际上大多数书籍都在200～400也之间，300也左右的最多：
1 m <- ggplot(pg_df, aes(x=pages))
2 m+ geom_histogram(binwidth = 50)
3 m+ geom_histogram(aes(y = ..density..),fill=3) + geom_density()+
4 labs(x='页数', y='概率密度',title ='书籍页数分布')
2 m+ geom_histogram(binwidth = 50)
3 m+ geom_histogram(aes(y = ..density..),fill=3) + geom_density()+
4 labs(x='页数', y='概率密度',title ='书籍页数分布')
- 书籍分类
（1）根据书籍的内容简介信息，将相近的书籍划分为一类。首先将简介文本分词，分词过程如下：
01 text.as.words<-function(x,stopwords=NULL){
02 f_cut <- function(x){
03 library(Rwordseg)
04 unlist(strsplit(segmentCN(x,nature = T), ' '))
05 }
06 text<-gsub('<[^><]*.>','',x)
07 words<-lapply(text,f_cut)
08 words<-lapply(words,function(x){x[nchar(x)>1]})
09 if(!is.null(stopwords)){
10 words<-lapply(words,function(x){x[!x %in% stopwords]})
11 }
12 words<-sapply(words,function(x){paste(x,collapse=' ')})
13 words
14 }
15 ###停止词
16 data(stopwords)
17 intro_word<-text.as.words(x=collect_df$summary,stopwords=stopwords)
02 f_cut <- function(x){
03 library(Rwordseg)
04 unlist(strsplit(segmentCN(x,nature = T), ' '))
05 }
06 text<-gsub('<[^><]*.>','',x)
07 words<-lapply(text,f_cut)
08 words<-lapply(words,function(x){x[nchar(x)>1]})
09 if(!is.null(stopwords)){
10 words<-lapply(words,function(x){x[!x %in% stopwords]})
11 }
12 words<-sapply(words,function(x){paste(x,collapse=' ')})
13 words
14 }
15 ###停止词
16 data(stopwords)
17 intro_word<-text.as.words(x=collect_df$summary,stopwords=stopwords)
（2）使用tm包生成词频--文档矩阵（TermDocumentMatrix）：
1 library(tm)
2 mybook<-data.frame(content=intro_word,title=collect_df$title,stringsAsFactors=F)
3 mybook<-mybook[nchar(mybook$content)>0,]
4 row.names(mybook)<-NULL
5 m <- list(Content = "content", ID = "title")
6 myReader <- readTabular(mapping = m)
7 corpus <- Corpus(DataframeSource(mybook),readerControl = list(reader = myReader,language = "zh_cn"))
8 tdm<-TermDocumentMatrix(corpus, control = list(wordLengths=c(2,Inf)))
2 mybook<-data.frame(content=intro_word,title=collect_df$title,stringsAsFactors=F)
3 mybook<-mybook[nchar(mybook$content)>0,]
4 row.names(mybook)<-NULL
5 m <- list(Content = "content", ID = "title")
6 myReader <- readTabular(mapping = m)
7 corpus <- Corpus(DataframeSource(mybook),readerControl = list(reader = myReader,language = "zh_cn"))
8 tdm<-TermDocumentMatrix(corpus, control = list(wordLengths=c(2,Inf)))
（3）使用层次聚类方法对词频矩阵进行聚类，使用余弦相似度和ward方法：
1 ###利用余弦相似度和层次聚类划分类别
2 diss<-dissimilarity(tdm,method='cosine')
3 hc <- hclust(diss, method = "ward")
4 plot(hc,col=4, main="层次聚类",ylab='',xlab='',sub='')
5 rect.hclust(hc,k=7, border = 2)
2 diss<-dissimilarity(tdm,method='cosine')
3 hc <- hclust(diss, method = "ward")
4 plot(hc,col=4, main="层次聚类",ylab='',xlab='',sub='')
5 rect.hclust(hc,k=7, border = 2)
如果分成7类，从上图可以看出效果一般，从左至右，效果越来越差，最右边的一类十分庞杂。考虑到这些词汇产生于书籍简介，有些就没有意义，比如去掉词汇"作者","这本","一本","这部","简介","本书","读者"7个词语，将产生不同的聚类效果优于上图，效果如下图：
- 关联分析
如果将词语看成一个“购物篮的物品”，那么就可以用这些词语就组成一个项集，即一个事务数据集(transactions)，这样可以用关联分析的方法探索词语之间的关联，从而可以了解书籍简介的内容。使用apriori算法分析如下：
2 library(arulesViz)
3 intro_words<-sapply(mybook$content,function(x) unique(unlist(strsplit(x,' '))))
4 names(intro_words)<-NULL
5 trans<-as(intro_words, "transactions")
6 itemsets<- apriori(trans,parameter = list(supp = 0.05, minlen=1,target = "frequent itemsets"))
可产生480个频繁项集，其中含二个词语的项集238个，三个词语的项集77个。根据下面两个图形可以看出，我所阅读的书籍的主题大致可分为三类：中国历史、未来与太空（科幻）、计算机技术与商业（确切地说是和数据分析相关的技术及商业）。可以说是回顾过去、艰难地活在当下、满怀憧憬的面向未来和太空，真是杞人忧天。
1 subset2<-itemsets[size(itemsets)>1]
2 subset2<-sort(subset2)[1:100]
3 subset3<-itemsets[size(itemsets)>2]
4 png('subset23.png',width=1000,height=500)
5 par(mfrow=c(1,2))
6 plot(subset2, method="graph",control=list(main="至少包含两个词语的前100个项集"))
7 plot(subset3, method="graph",control=list(main="至少包含三个词语的所有项集"))
8 dev.off()
2 subset2<-sort(subset2)[1:100]
3 subset3<-itemsets[size(itemsets)>2]
4 png('subset23.png',width=1000,height=500)
5 par(mfrow=c(1,2))
6 plot(subset2, method="graph",control=list(main="至少包含两个词语的前100个项集"))
7 plot(subset3, method="graph",control=list(main="至少包含三个词语的所有项集"))
8 dev.off()
如果将几个代表性的词语提取出来，可以看出主题更加清晰，如下图，真是在担心人类的未来啊。
01 subwords<-c('历史','中国','人类','宇宙')
02 subset4<-subset(itemsets,subset=items %in% subwords)
03 subset4<-subset4[size(subset4)>1]
04 subwords2<-c('科学','思维','技术','研究','数据','分析','信息')
05 subset5<-subset(itemsets,subset=items %in% subwords2)
06 png('subset45.png',width=1000,height=500)
07 par(mfrow=c(1,2))
08 plot(subset4, method="graph",control=list(main="历史与科幻"))
09 plot(subset5, method="graph",control=list(main="技术与思考"))
10 dev.off()
02 subset4<-subset(itemsets,subset=items %in% subwords)
03 subset4<-subset4[size(subset4)>1]
04 subwords2<-c('科学','思维','技术','研究','数据','分析','信息')
05 subset5<-subset(itemsets,subset=items %in% subwords2)
06 png('subset45.png',width=1000,height=500)
07 par(mfrow=c(1,2))
08 plot(subset4, method="graph",control=list(main="历史与科幻"))
09 plot(subset5, method="graph",control=list(main="技术与思考"))
10 dev.off()
library(Rdouban)
qxde<-user_book_status(userid="qxde01") ##获取阅读数据
data(stopwords) ## 中文停止词
## 生成用户qxde01的2013年阅读信息可视化图形
user_book_viz(x=qxde,YEAR="2013",stopwords=stopwords,back=TRUE)生成的图形包括以下内容：
