聚类评价标准SC,DBI和CH简单解释及R语言实现(附代码)

前段时间做了一个有关聚类分析的项目,在进行结果验证时需要用到一些评价聚类方法性能的标准。其中无监督的验证方法包括轮廓系数(SC),戴维森堡丁指数(DBI)和Calinski-Harabaz(CH)。作者项目的代码是用R跑的,但目前,网络中没有找到现成的可以计算DBI和CH的R程序,python中倒是一堆一堆的。因此作者找到了python计算DBI和CH的源码(R中有直接计算SC的方法),为了以后的方便转译到了R上。在此,分享到网络上。

一. SC,DBI和CH的简单介绍

CH:CH指标通过计算类中各点与类中心的距离平方和,来度量类内的紧密度,通过计算各类中心点与整个数据集中心点距离平方和来度量数据集的分离度,CH指标由分离度与紧密度的比值得到。从而,CH越大代表着类自身越紧密,类与类之间越分散。(图中nj代表类别j中样本数量,m是所有样本的数量,Cpi和Cj是每个类别的类中心点,X拔是整个数据集的中心点)
在这里插入图片描述

SC: SC指标通过计算样本i到同类其他样本的平均距离计算类内的不相似度,通过计算样本i到其他所有类样本的平均距离的最小值计算样本i与类外的不相似度。一个样本i的轮廓系数由类外不相似度减去类内不相似度与类外不相似度和类内不相似度的较大者的比值得到。
下图是一个样本的SC,整体的SC即为所有样本SC取平均。
在这里插入图片描述

DBI:任意两类别的类内样本到类中心平均距离之和除以两类中心点之间的距离,取最大值。DBI越小意味着类内距离越小,同时类间距离越大。
在这里插入图片描述
R代码如下:

SC(现成):

#sc为每个样本的sc
library (cluster)#cluster有众多有关聚类分析的方法,可以自行查阅
sc <- silhouette (label, W)#label为聚类结果,W为样本间距离矩阵

DBI

calDBI <- function(x=data,labels=labesls)
  
  ##data必须行为样本,列为特征
{
  clusters_n <- length(unique(labels))
  cluster_k <- list()
  for (i in c(1:clusters_n)) {
    cluster_k[[i]] <- x[which(labels==i),]
  }
  
  centroids <- list()
  for (i in c(1:clusters_n)) {
    centroids[[i]] <- apply(cluster_k[[i]],2,mean)
  }
  
  s <- list()
  for (i in c(1:clusters_n)) {
    a <- c()
    for (j in c(1:nrow(cluster_k[[i]]))) {
      b <- dist(rbind(cluster_k[[i]][j,],centroids[[i]]),method = "euclidean")
      a <- c(a,b)
    }
    s[[i]] <- mean(a)
  }
  
  Ri <- list()
  for (i in c(1:clusters_n)){
    r <- c()
    for (j in c(1:clusters_n)){
      if (j!=i){
        h <- (s[[i]]+s[[j]])/dist(rbind(centroids[[i]],centroids[[j]]),method = "euclidean")
        r <- c(r,h)
      }
    }
    Ri[[i]] <- max(r)
  }
  dbi <- mean(unlist(Ri))
  return(dbi)
}
#sample
dbi <- calDBI(x,labels)#x为样本——特征矩阵(行为样本,列为特征),labels为聚类结果

CH

calCH <- function(X,labels){ 
  ##X必须行为样本,列为特征
labels_n <- length(unique(labels))
samples_n <- nrow(X)
X_mean <- apply(X,2,mean)
ex_disp <- c()
in_disp <- c()
for (i in c(1:labels_n)) {
 cluster_k <- X[which(labels==i),]
 mean_k <- apply(cluster_k,2,mean)
 a1 <- nrow(cluster_k)*sum((mean_k-X_mean)^2)
 ex_disp <- c(ex_disp,a1)
 a2 <- sum((t(t(cluster_k)-mean_k))^2)
 in_disp <- c(in_disp,a2)
}
k1<- sum(ex_disp)
k2<- sum(in_disp)
if(k2==0)
{
  return(1)
}
else
{
  return((k1*(samples_n-labels_n))/(k2*(labels_n-1)))
}
}
#sample
ch<- calCH(X,labels)#X为样本——特征矩阵(行为样本,列为特征),labels为聚类结果

分享结束!!!!!!!!!!!!!!!!!

评论 15
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值