datatable(data6_1,rownames = FALSE)第六章 样本相似性可视化
1 案例数据
1.1 data6_1：地区区域八项消费数据
地区、区域划分和地带为因子变量
其余八个消费项目为数值变量
2 平行坐标图和雷达图
2.1 平行坐标图
2.1.1 数据预处理
- 利用
gather()函数将原数据框转化为长型数据； - 八项消费名称转化为因子变量——
支出项目，按原数据消费名称的顺序定义因子水平； - 八项消费数值转化为数值变量——
支出金额。
df <- data6_1 |> gather(食品烟酒:其他用品及服务,key=支出项目,value=支出金额) |>
mutate(支出项目=fct_inorder(支出项目))
datatable(df,rownames = FALSE)2.1.2 ggplot平行坐标图——以个案分类
ggplot(group=id)+geom_line+geom_point支出项目作为横轴，支出金额作为纵轴，地区（省份）区分不同线图和配色
# 绘制平行坐标图
ggplot(df,aes(x=支出项目,y=支出金额,group=地区,color=地区))+
geom_line(linewidth=0.5)+ # 绘制折线
geom_point(shape=21,size=1.5,fill="gray50")+ # 绘制点
theme(legend.position=c(0.75,0.66),
legend.text=element_text(size=7,color="blue4"),
legend.direction="horizontal", # 设置图例位置和摆放方向
legend.background=element_rect(fill="grey90",color="grey"))+
guides(color=guide_legend(nrow=8,title=NULL))+ # 设置图例摆放方式(8行，去掉图例标题)
scale_x_discrete(labels=function(x) str_wrap(x,width=8)) # 设置x轴标签宽度
- 利用
区域划分和地带划分配色 - 如果去除映射
group=地区会有什么后果？group=地区起到什么作用？
p1<-ggplot(df,aes(x=支出项目,y=支出金额,group=地区,color=区域划分))+
geom_line(size=0.5)+ # 绘制折线
geom_point(shape=21,size=1.5,fill="gray50")+ # 绘制点
scale_x_discrete(guide=guide_axis(n.dodge=2))+ # 设置x轴标签为2行
theme(legend.position=c(0.8,0.8), # 设置图例位置
legend.background=element_blank())+ # 移除图例整体边框
guides(color=guide_legend(nrow=3,title=NULL))+ # 图例排成3行,去掉图例标题
ggtitle("(a) 按区域划分分组") # 添加标题
p2<-ggplot(df,aes(x=支出项目,y=支出金额,group=地区,color=地带划分))+
geom_line(size=0.5)+
geom_point(shape=21,size=1.5,fill="gray50")+
scale_x_discrete(guide=guide_axis(n.dodge=2))+
theme(legend.position=c(0.8,0.8),
legend.background=element_blank())+
guides(color=guide_legend(nrow=3,title=NULL))+
ggtitle("(b) 按地带划分分组")
gridExtra::grid.arrange(p1,p2,ncol=2) # 组合图形
2.1.3 GGally::ggparcoord绘制平行坐标图
GGally::ggparcoord：不需要数据转化即可作平行坐标图；scale="uniminmax"：将个变量的数据尺度归一化处理；scale_color_manual(values=rainbow(3))设定配色的调色板。
mytheme<-theme(axis.text.x=element_text(size=9,angle=20,hjust=1,vjust=1))+
theme(legend.position="bottom",
legend.background=element_blank())
p1<-ggparcoord(data6_1,columns=4:11, # 选择第4~11列
groupColumn=3, # 选择第3列（地带划分）作为分组变量
scale="globalminmax", # 不进行缩放，使用原始数据绘图
splineFactor=10, # 使用样条插值
showPoints=TRUE,alphaLines=0.5)+ # 绘制点
scale_color_manual(values=rainbow(3))+ # 设置线的颜色
xlab("支出项目")+ylab("支出金额")+ # 设置x轴和y轴标签
mytheme+ggtitle("(a) 使用样条插值")
# 图（b）将数据缩放到[0，1]的范围
p2<-ggparcoord(data6_1,columns=4:11,groupColumn=3,
scale="uniminmax", # 将数据缩放到[0，1]的范围
showPoints=TRUE,alphaLines=0.5)+
scale_color_manual(values=rainbow(3))+
xlab("支出项目")+ylab("支出金额")+
mytheme+ggtitle("(b) 数据缩放到[0,1]范围")
gridExtra::grid.arrange(p1,p2,ncol=2) # 组合图形
2.1.4 ggiraphExtra::ggPair绘制只有两个变量的平行坐标图
ggiraphExtra::ggPair：不需要数据转化即可作平行坐标图；scale="uniminmax"：将个变量的数据尺度归一化处理；scale_color_manual(values=rainbow(3))设定配色的调色板。
mytheme<-theme_grey()+
theme(legend.position=c(0.2,0.85),
legend.background=element_blank()) # 移除图例整体边框
p1<-ggPair(data6_1,aes(x=c(食品烟酒,居住),color=地带划分))+ # 按地带划分分组
mytheme+
guides(color=guide_legend(nrow=3,title=NULL))+ # 图例排成2行,去掉图例标题
xlab("支出项目")+ylab("支出金额")+ # 设置x轴和y轴标签
ggtitle("(a) 按地带划分分组")
# 图（b）按区域划分分组
p2<-ggPair(data6_1,aes(x=c(食品烟酒,居住),color=区域划分))+# 按区域划分分组
mytheme+
guides(color=guide_legend(nrow=3,title=NULL))+
xlab("支出项目")+ylab("支出金额")+
ggtitle("(b) 按区域划分分组")
gridExtra::grid.arrange(p1,p2,ncol=2) # 组合图形
2.2 雷达图
2.2.1 ggRadar 雷达图
采用
dplyr::filter函数选出北京、天津和上海3个地区ggiraphExtra::ggRadar默认将全部数值变量都用于绘图通过
ylim参数可以控制图形外观；rescale参数控制归一化theme(axis.text.x=element_text(angle=myangle))控制标签旋转角度df<-filter(data6_1,地区%in%c("北京","天津","上海")) # 选出北京、天津和上海3个地区 # 设置图形主题 myangle<-seq(-20,-340,length.out=8) # 设置标签角度，使之垂直于坐标轴 mytheme<-theme_bw()+ # 使用黑白主题 theme(legend.position="bottom", # 设置图例位置 axis.text.x=element_text(size=9,color="blue4",angle=myangle)) # 设置坐标轴标签字体大小、颜色和和角度 # 图（a）使用原始数据 p1<-ggRadar(data=df,aes(group=地区), # 按地区分组 rescale=FALSE, # 数据不归一化 ylim=c(-200,20000), # 设置y轴范围 alpha=0, # 设置颜色透明度 size=2)+ # 设置点的大小 mytheme+xlab("支出项目")+ylab("支出金额")+ # 设置x轴和y轴标签 ggtitle("(a) 原始数据雷达图") # 添加标题 # 图（b）使用归一化数据 p2<-ggRadar(data=df,aes(group=地区), # 按地区分组 rescale=TRUE, # 数据标准化(缩放到[0,1]范围) ylim=c(-0.3,1), # 设置y轴范围 alpha=0.3, # 设置颜色透明度 size=2)+ # 设置点的大小 mytheme+xlab("支出项目")+ylab("归一化值")+ ggtitle("(b) 归一化雷达图") # 添加标题 gridExtra::grid.arrange(p1,p2,ncol=2) # 按2列组合图形p1和p2
ggRadar(aes(facet=地区))按地区分面
df<-dplyr::filter(data6_1,区域划分=="中南") # 选出中南地区的省份
# 设置图形主题
myangle<-seq(-20,-340,length.out=8) # 设置标签角度，使之垂直于坐标轴
mytheme<-theme(legend.position="bottom", # 设置标题位置
axis.text.x=element_text(size=9,color="blue4",angle=myangle))
# 设置坐标轴标签字体大小、颜色和和角度
ggRadar(data=df,aes(facet=地区), # 按地区分面
rescale=TRUE,alpha=0.3,size=2)+
theme_light()+theme(legend.position="none", # 使用light主题，删除图例
axis.text.x=element_text(size=7,color="blue4",angle=myangle))
- 能直接分类汇总作图，先计算各类均值后作图。
p1<-ggRadar(data=data6_1,rescale=FALSE,aes(group=区域划分),
alpha=0.1,size=2.5,ylim=c(-0.2,1))+# 按区域划分分组
mytheme+xlab("支出项目")+ylab("支出金额")+ # 设置x轴和y轴标签
guides(color=guide_legend(nrow=2))+ # 把图例排成2行
ggtitle("(a) 按区域划分分组")
p2<-ggRadar(data=data6_1,rescale=FALSE,aes(group=地带划分),
alpha=0.1,size=2.5,ylim=c(-0.2,1))+# 按地带划分分组
mytheme+xlab("支出项目")+ylab("支出金额")+ # 设置x轴和y轴标签
guides(color=guide_legend(nrow=2))+ # 图例排成2行
ggtitle("(b) 按地带划分分组")
gridExtra::grid.arrange(p1,p2,ncol=2) # 按2列组合图形p1和p2
3 星图和脸谱图
3.1 星图
3.1.1 stars
stars(matrix/dataframe)：输入对象可以为矩阵或数据框，默认将行名作为图像标签，其它变量必须为数值变量。draw.segments=T/F：控制星图外观，T为圆弧，F为多边形。
mat<-data6_1%>%select(-c(地区,区域划分,地带划分))%>%as.matrix() # 转换成矩阵
rownames(mat)=data6_1[,1] # 设置矩阵行名称
stars(mat,
full=TRUE, # 绘制出满圆
scale=TRUE, # 将数据缩放到[0,1]的范围
nrow=5, # 5行布局
len=1, # 设置半径或线段长度的比例
frame.plot=TRUE, # 添加边框
draw.segments=TRUE,key.loc=c(13.5,2,5), # 绘制圆弧图，并设置位置
mar=c(0.5,0.1,0.1,0.1), # 设置图形边界
cex=0.6) # 设置标签字体大小
# 图6-8（b）的绘制代码
stars(mat,
full=TRUE, # 绘制出满圆
scale=TRUE, # 将数据缩放到[0,1]的范围
nrow=5, # 5行布局
len=1, # 设置半径或线段长度的比例
draw.segments=F,key.loc=c(13.2,2,5), # 绘制多边形图，并设置位置
#col.lines=rainbow(31),
col.stars = rainbow(31), # 设置每个星（样本）的颜色
frame.plot=TRUE, # 添加边框
mar=c(0.5,0.1,0.1,0.1), # 设置图形边界
cex=0.6) # 设置标签字体大小
3.2 脸谱图
3.2.1 faces
aplpack::faces()：对每行作脸谱图，默认将行名作为图像标签，其它变量必须为数值变量。
library(aplpack)
faces(mat,face.type=1, # 设置脸谱图的类型
ncol.plot=8, # 绘制成7列
scale=TRUE, # 数据标准化
cex=1) # 设置脸谱图标签字体的大小
effect of variables:
modified item Var
"height of face " "食品烟酒"
"width of face " "衣着"
"structure of face" "居住"
"height of mouth " "生活用品及服务"
"width of mouth " "交通通信"
"smiling " "教育文化娱乐"
"height of eyes " "医疗保健"
"width of eyes " "其他用品及服务"
"height of hair " "食品烟酒"
"width of hair " "衣着"
"style of hair " "居住"
"height of nose " "生活用品及服务"
"width of nose " "交通通信"
"width of ear " "教育文化娱乐"
"height of ear " "医疗保健" plot.faces函数可以将笑脸图添加到plot函数输出对象中，需要先通过plot函数生成一个空图。
par(mai=c(0.8,0.8,0.4,0.4),cex=0.8)
plot(mat[1:31,c(1,7)],xlim=c(5000,12000),ylim=c(900,4000),
bty="n",type="n") # 绘制食品烟酒和医疗保健的散点图空图
f<-faces(mat[1:31,],plot=FALSE) # 绘制脸谱图的空图effect of variables:
modified item Var
"height of face " "食品烟酒"
"width of face " "衣着"
"structure of face" "居住"
"height of mouth " "生活用品及服务"
"width of mouth " "交通通信"
"smiling " "教育文化娱乐"
"height of eyes " "医疗保健"
"width of eyes " "其他用品及服务"
"height of hair " "食品烟酒"
"width of hair " "衣着"
"style of hair " "居住"
"height of nose " "生活用品及服务"
"width of nose " "交通通信"
"width of ear " "教育文化娱乐"
"height of ear " "医疗保健" plot.faces(f,mat[1:31,1],mat[1:31,7], # 绘制脸谱散点图
width=600,height=400, # 设置脸谱图的宽度和高度
cex=0.6)
4 聚类图和热图
4.1 聚类图
4.1.1 fviz_dend ：系统聚类树状图
factoextra::fviz_dend：对系统聚类结果作树状图，输入对象为系统聚类结果。
library(factoextra)
d<-dist(scale(mat),method="euclidean")# 采用euclidean距离计算样本的点间距离
hc<-hclust(d,method="ward.D2")
# 采用ward.D法计算类间距离并用层次聚类法进行聚类
cols=brewer.pal(4,"Set1")
# 绘制聚类图
fviz_dend(hc,k=4, # 设置分类数
cex=0.6, # 设置数据标签的字体大小
horiz=FALSE, # 垂直摆放图形
k_colors=brewer.pal(4,"Set1"), # 设置聚类集群的线条颜色
color_labels_by_k=TRUE, # 自动设置数据标签颜色
lwd=0.6, # 设置分支和矩形的线宽
type="rectangle", # 设置绘图类型为矩形
rect=TRUE, # 绘制聚类集群矩形
rect_fill=TRUE, # 设置标记框的填充颜色
main="") # 不显示标题
- 通过
type参数修改树状图的外观
# 图6-13（a）的绘制代码（4类）
fviz_dend(hc,k=4, # 分成4类
cex=0.6, # 设置数据标签的总体大小
horiz=FALSE, # 垂直摆放图形
k_colors=brewer.pal(4,"Set1") , # 设置聚类集群的线条颜色
color_labels_by_k=TRUE, # 自动设置数据标签颜色
lwd=0.8, # 设置分支和矩形的线宽
type="circular", # 设置绘图类型为矩形
rect=TRUE, # 使用不同的颜色矩形标记类别
rect_lty=1,rect_fill=TRUE) # 设置标记框的线型和填充颜色
# 图6-13（b）的绘制代码（4类）
fviz_dend(hc,k=4, # 分成4类
cex=0.6, # 设置数据标签的大小
horiz=FALSE, # 垂直摆放图形
k_colors=brewer.pal(4,"Set1") , # 设置聚类集群的线条颜色
color_labels_by_k=TRUE , # 自动设置数据标签颜色
lwd=0.8, # 设置分支和矩形的线宽
type="phylogenic", # 设置绘图类型为矩形
rect=TRUE, # 使用不同的颜色矩形标记类别
repel=TRUE, # 避免图中的文本标签重叠
rect_lty=1,rect_fill=TRUE) # 设置标记框的线型和填充颜色
4.1.2 kmeans：K-menas聚类主成分图
factoextra::fviz_cluster：对K-menas聚类结果作树状图，输入对象为K-menas聚类结果。输出图形以第一和第二主成分作为横轴和纵轴
km<-kmeans(mat,centers=4) # 分成4类
fviz_cluster(km,mat[,-1],
repel=TRUE, # 避免图中的文本标签重叠
ellipse.type="norm", # 画出正态置信椭圆
labelsize=9, # 设置文本字体的大小
pointsize=2, # 设置中心点的大小
main = "K-means聚类（分成4类）")
- 通过
ellipse.type参数可以改变类别的轮廓形状
km<-kmeans(mat,centers=3) # 分成4类
fviz_cluster(km,mat[,-1],
repel=TRUE,
ellipse.type="convex",
labelsize=8,
main="K-means聚类（分成3类）")
4.2 热图
4.2.1 heatmap
heatmap：将各变量归一化后作为热力图，颜色越深数值越大默认添加行列的系统聚类树状图
par(cex.main=0.7,font.main=1)
# 图（a）双边聚类
heatmap(mat,scale="column",margins=c(4,3),
cexRow=0.6,cexCol=0.7,main="(a) 双边聚类")# 对矩阵按列做标准化后绘制热图
# 图（b）去掉聚类图
heatmap(mat,Rowv=NA,Colv=NA, # 去掉聚类图
scale="column",margins=c(5,3),
cm.colors(256,start=02,end=0.5),cexRow=0.8,cexCol=0.9,main="(b) 去掉聚类图")
4.2.2 heatmap.2
gplots::``heatmap.2``()：参数对象ggplot类图形scale="none"：不对变量标准化
library(gplots)
heatmap.2(mat,
scale="none",col=rainbow(256),tracecol="grey50",
dendrogram="both",cexRow=0.6,cexCol=0.7,
srtCol=30,adjCol = c(0.6,1), # 设置x轴标签角度和位置调整
margins=c(5.3,3),keysize=2, key.title="色键与直方图")
- 通过col参数选择调色板
gplots::heatmap.2(mat,
col=bluered,tracecol="gray50",scale="column",
dendrogram="both",cexRow=0.6,cexCol=0.7,
srtCol=30,adjCol = c(0.6,1), # 设置x轴标签角度和位置调整
margins=c(5.3,3),keysize=2,key.title="色键与直方图")
4.2.3 pheatmap
pheatmap::pheatmap：如果数据需要标准化，需要先使用scale函数标准化cutree_col/cutree_row：可以指定行列聚类个数
library(pheatmap)
mat<-scale(mat) # 对矩阵做标准化
pheatmap(mat,
color=colorRampPalette(c("navy","white","firebrick3"))(10),
# 热图中使用的颜色向量
display_numbers=FALSE, # 默认FALSE，不显示矩阵单元的数据
cellheight_row=6, # 设置单元格行高度
fontsize=7, # 设置文本字体大小
angle_col=45, # 设置列标签的角度
treeheight_row=50,treeheight_col=35, # 设置行和列聚类树的高度
cutree_col=2, # 设置聚类列数
cutree_row=4) # 设置聚类行数
display_numbers=TRUE可以在单元格中显示数值
pheatmap(mat,
color = colorRampPalette(c("navy","white","firebrick3"))(100),
# 热图中使用的颜色向量
display_numbers=TRUE, # 显示矩阵单元的数据（默认FALSE）
cellheight_row=6, # 设置单元格行高度
fontsize=7, # 设置文本字体大小
angle_col=0, # 设置列标签的角度
treeheight_row=50,treeheight_col=35, # 设置行和列聚类树的高度
cluster_col=FALSE, # 不对列聚类
cutree_row=3) # 设置聚类行数