R语言实战——谱系聚类分析与动态聚类分析

一、理论

二、实战分析

x1 <- c(5,7,3,6,6)
x2 <- c(7,1,2,5,6)
X <- cbind(x1,x2)

# 计算初始距离矩阵
dist(X)    # 默认计算欧式距离
dist(X,diag=TRUE)   # 显示对角线元素
dist(X,diag=TRUE,upper = TRUE)  # 显示对角线元素和上三角元素

dist(X,method = 'manhattan')
dist(X,method = 'minkowski',p=1)   # 计算绝对距离
dist(X,method = 'minkowski',p = 2)   # 计算欧式距离

# 最短距离法
hc <- hclust(dist(X), 'single')
cbind(hc$merge,hc$height)
plot(hc,hang=-1,main='陈炜')

# Ward法
hc <- hclust(dist(X), 'ward.D')
cbind(hc$meige,hc$height)
plot(hc,main='陈炜')

# 自编系统聚类函数
H.clust <- function(X,d="euc",m="comp",proc=F,plot=T)
{
  D=dist(X,d)
  hc <- hclust(D,m)            
  #if(proc){ cat("\n cluster procdure: \n"); print(cbind(hc$merge,hc$height)) }
  PROC=cbind(merge=hc$merge,height=hc$height)
  if(proc) print(PROC)
  if(plot) plot(hc,ylab=d,main='陈炜')    
  #plot(hc,hang=hang,xlab="",ylab="",main="")    
  #hc1=as.dendrogram(hc)
  #plot(hc1,xlab="G",ylab="D",horiz=TRUE) 
  #list(D=D,hc=hc,proc=proc)
  return(hc)
} #C=H.clust(X)

# 设置工作路径
path2 <- 'E:\\桌面文档\\学习文件\\大三\\多元统计\\实验\\第二次上机\\第二次上机课的数据\\第二次上机课的数据\\聚类分析\\'
setwd(path2)
d7.2 <- read.table('7.2.txt',header = T)
plot(d7.2,main='陈炜')

H.clust(d7.2,'euclidean','single',plot=T)  # 最短距离法
# title(main='陈炜')
H.clust(d7.2,'euclidean','complete',plot=T)  # 最长距离法
H.clust(d7.2,'euclidean','median',plot=T)  # 中间距离法
H.clust(d7.2,'euclidean','average',plot=T)  # 类平均法
H.clust(d7.2,'euclidean','centroid',plot=T)  # 重心法
H.clust(d7.2,'euclidean','ward.D2',plot=T)  # Ward法

# K-means聚类
x1 <- matrix(rnorm(1000,mean=0,sd=0.3),ncol=10)
x2 <- matrix(rnorm(1000,mean=1,sd=0.3),ncol=10)
x <- rbind(x1,x2)
H.clust(x,'euclidean','complete')

cl <- kmeans(x,2)
str(cl)

pch1 <- rep('1',100)
pch2 <- rep('2',100)
plot(x,col=cl$cluster,pch=c(pch1,pch2),cex=.7,main='陈炜')
points(cl$centers,col=3,pch='*',cex=3)

# k-means处理大样本
x1 <- matrix(rnorm(100000,mean=0,sd=0.3),ncol=10)
x2 <- matrix(rnorm(100000,mean=1,sd=0.3),ncol=10)
x <- rbind(x1,x2)
H.clust(x,'euclidean','complete')

cl <- kmeans(x,2)

pch1 <- rep('1',100)
pch2 <- rep('2',100)
plot(x,col=cl$cluster,pch=c(pch1,pch2),cex=.7,main='陈炜')
points(cl$centers,col=3,pch='*',cex=3)

# case study
Case6 <- read.table('7_case.txt',header = T)
Z <- scale(Case6)
hc <- hclust(dist(Z))   # 层次聚类
# rect可以画出框框
plot(hc,main='陈炜');rect.hclust(hc,2);cutree(hc,2)
plot(hc,main='陈炜');rect.hclust(hc,3);cutree(hc,3)
plot(hc,main='陈炜');rect.hclust(hc,4);cutree(hc,4)
plot(hc,main='陈炜');rect.hclust(hc,5);cutree(hc,5)
plot(hc,hang=-1,main='陈炜')  # 类从底部画起

opar <- par(mfrow=c(2,1),mar=c(5.2,4,1,0))
plot(hc,hang=-1,main='陈炜');rect.hclust(hc,4);cutree(hc,4)
plot(hc,hang=-1,main='陈炜');rect.hclust(hc,2);cutree(hc,2)
par(opar)

# kmeans聚类
kmeans(Z,2)$cluster  # 2类
kmeans(Z,3)$cluster  # 3类
kmeans(Z,4)$cluster  # 4类
kmeans(Z,5)$cluster  # 5类