项目作者： sherry-xl
项目描述 ：
discriminiant.distance<-function#两总体的距离判别函数 (TrnX1, TrnX2, TstX = NULL, var.equal = FALSE){ if (is.null(TstX) == TRUE) TstX<-rbind(TrnX1,TrnX2)#若无测试集，用训练集做测试集回判 if (is.vector(TstX) == TRUE) TstX<-t(as.matrix(TstX))#若测试集是一个待测样本（即一个向量），则需转置做一个样本 else if (is.matrix(TstX) != TRUE) TstX<-as.matrix(TstX)#若测试集不是矩阵（也不是向量，即如果是数据框，则转化为矩阵） if (is.matrix(TrnX1) != TRUE) TrnX1<-as.matrix(TrnX1)#第一个总体训练集若不是矩阵，则转化为矩阵 if (is.matrix(TrnX2) != TRUE) TrnX2<-as.matrix(TrnX2)#第二个总体训练集若不是矩阵，则转化为矩阵 nx<-nrow(TstX)#测试集的行数 blong<-matrix(rep(0, nx), nrow=1, byrow=TRUE, dimnames=list("blong", 1:nx))#定义测试集的归属类别向量为blong mu1<-colMeans(TrnX1); mu2<-colMeans(TrnX2) #分别提取两个训练集的样本均值向量 if (var.equal == TRUE || var.equal == T){ S<-var(rbind(TrnX1,TrnX2))#如果两总体方差相等，则用联合样本协方差阵作为协方差阵的估计 w<-mahalanobis(TstX, mu2, S)-mahalanobis(TstX, mu1, S)#计算测试集第二总体距离与第一总体距离之差 } else{#如果协方差阵不等，则分别估计两个总体协方差阵 S1<-var(TrnX1); S2<-var(TrnX2) w<-mahalanobis(TstX, mu2, S2)-mahalanobis(TstX, mu1, S1)#计算测试集第二总体距离与第一总体距离之差 } for (i in 1:nx){ if (w[i]>0)#若到2距离大于到1距离 blong[i]<-1#则判归1 else#否则 blong[i]<-2#判归2 } blong#返回测试集的归属类别 } #两总体距离判别例子 classX1<-data.frame( x1=c(6.60, 6.60, 6.10, 6.10, 8.40, 7.2, 8.40, 7.50, 7.50, 8.30, 7.80, 7.80), x2=c(39.00, 39.00, 47.00, 47.00, 32.00, 6.0, 113.00, 52.00, 52.00,113.00,172.00,172.00), x3=c(1.00, 1.00, 1.00, 1.00, 2.00, 1.0, 3.50, 1.00, 3.50, 0.00, 1.00, 1.50), x4=c(6.00, 6.00, 6.00, 6.00, 7.50, 7.0, 6.00, 6.00, 7.50, 7.50, 3.50, 3.00), x5=c(6.00, 12.00, 6.00, 12.00, 19.00, 28.0, 18.00, 12.00, 6.00, 35.00, 14.00, 15.00), x6=c(0.12, 0.12, 0.08, 0.08, 0.35, 0.3, 0.15, 0.16, 0.16, 0.12, 0.21, 0.21), x7=c(20.00, 20.00, 12.00, 12.00, 75.00, 30.0, 75.00, 40.00, 40.00,180.00, 45.00, 45.00) ) classX2<-data.frame( x1=c(8.40, 8.40, 8.40, 6.3, 7.00, 7.00, 7.00, 8.30, 8.30, 7.2, 7.2, 7.2, 5.50, 8.40, 8.40, 7.50, 7.50, 8.30, 8.30, 8.30, 8.30, 7.80, 7.80), x2=c(32.0 ,32.00, 32.00, 11.0, 8.00, 8.00, 8.00, 161.00, 161.0, 6.0, 6.0, 6.0, 6.00,113.00,113.00, 52.00, 52.00, 97.00, 97.00,89.00,56.00,172.00,283.00), x3=c(1.00, 2.00, 2.50, 4.5, 4.50, 6.00, 1.50, 1.50, 0.50, 3.5, 1.0, 1.0, 2.50, 3.50, 3.50, 1.00, 1.00, 0.00, 2.50, 0.00, 1.50, 1.00, 1.00), x4=c(5.00, 9.00, 4.00, 7.5, 4.50, 7.50, 6.00, 4.00, 2.50, 4.0, 3.0, 6.0, 3.00, 4.50, 4.50, 6.00, 7.50, 6.00, 6.00, 6.00, 6.00, 3.50, 4.50), x5=c(4.00, 10.00, 10.00, 3.0, 9.00, 4.00, 1.00, 4.00, 1.00, 12.0, 3.0, 5.0, 7.00, 6.00, 8.00, 6.00, 8.00, 5.00, 5.00,10.00,13.00, 6.00, 6.00), x6=c(0.35, 0.35, 0.35, 0.2, 0.25, 0.25, 0.25, 0.08, 0.08, 0.30, 0.3, 0.3, 0.18, 0.15, 0.15, 0.16, 0.16, 0.15, 0.15, 0.16, 0.25, 0.21, 0.18), x7=c(75.00, 75.00, 75.00, 15.0, 30.00, 30.00, 30.00, 70.00, 70.00, 30.0, 30.0, 30.0, 18.00, 75.00, 75.00, 40.00, 40.00,180.00,180.00,180.00,180.00, 45.00, 45.00) ) source("discriminiant.distance.R") discriminiant.distance(classX1, classX2, var.equal=TRUE) discriminiant.distance(classX1, classX2) distinguish.distance<-function#多总体距离判别函数 (TrnX, TrnG, TstX = NULL, var.equal = FALSE){#输入分别为训练集，训练集的类别，测试集，方差是否相等 if ( is.factor(TrnG) == FALSE){#如果TrnG不是因子，此时把TrnG看成第二个训练样本，即此法兼容了两总体判别问题 mx<-nrow(TrnX); mg<-nrow(TrnG) TrnX<-rbind(TrnX, TrnG)#把TrnX和TrnG合并成一个新的训练集 TrnG<-factor(rep(1:2, c(mx, mg)))#重新定义了新的训练集的分类情况，至此对两总体的兼容结束 } if (is.null(TstX) == TRUE) TstX<-TrnX#如果没输入测试集，则把训练集作为测试集回判测试 if (is.vector(TstX) == TRUE) TstX<-t(as.matrix(TstX))#若测试集是一个待测样本（即一个向量），则需转置做一个样本 else if (is.matrix(TstX) != TRUE) TstX<-as.matrix(TstX)#若测试集不是矩阵（也不是向量，即如果是数据框，则转化为矩阵） if (is.matrix(TrnX) != TRUE) TrnX<-as.matrix(TrnX)#若训练集不是矩阵，则转化为矩阵 nx<-nrow(TstX)#测试集的行数 blong<-matrix(rep(0, nx), nrow=1, dimnames=list("blong", 1:nx))#定义测试集的样本归属向量 g<-length(levels(TrnG))#训练集的水平数目，即总体数 mu<-matrix(0, nrow=g, ncol=ncol(TrnX))#定义训练集的均值向量，每行代表一个样本均值 for (i in 1:g) mu[i,]<-colMeans(TrnX[TrnG==i,]) D<-matrix(0, nrow=g, ncol=nx)#定义样本到各训练集的距离，每行代表一个类别，每列代表一个测试样品到各总体距离 if (var.equal == TRUE || var.equal == T){#若方差相等，则用联合协方差阵估计协方差阵 for (i in 1:g) D[i,]<- mahalanobis(TstX, mu[i,], var(TrnX))#计算测试的每个样本到i总体的距离保存在D的第i行 } else{ for (i in 1:g) D[i,]<- mahalanobis(TstX, mu[i,], var(TrnX[TrnG==i,])) } for (j in 1:nx){#第j个样品 dmin<-Inf for (i in 1:g)#到第i类的距离 if (D[i,j]beta)#判别规则 blong[i]<-1 else blong[i]<-2 } blong } TrnX1<-matrix( c(24.8, 24.1, 26.6, 23.5, 25.5, 27.4, -2.0, -2.4, -3.0, -1.9, -2.1, -3.1), ncol=2) TrnX2<-matrix( c(22.1, 21.6, 22.0, 22.8, 22.7, 21.5, 22.1, 21.4, -0.7, -1.4, -0.8, -1.6, -1.5, -1.0, -1.2, -1.3), ncol=2) source("discriminiant.bayes.R") #### 样本协方差相同 discriminiant.bayes(TrnX1, TrnX2, rate=8/6, var.equal=TRUE) #### 样本协方差不同 discriminiant.bayes(TrnX1, TrnX2, rate=8/6) #两总体贝叶斯判别例子 distinguish.bayes<-function#对多正态总体贝叶斯判别函数,假设错判代价相等时的判别 (TrnX, TrnG, p=rep(1, length(levels(TrnG))), TstX = NULL, var.equal = FALSE){ if ( is.factor(TrnG) == FALSE){ mx<-nrow(TrnX); mg<-nrow(TrnG) TrnX<-rbind(TrnX, TrnG) TrnG<-factor(rep(1:2, c(mx, mg))) } if (is.null(TstX) == TRUE) TstX<-TrnX if (is.vector(TstX) == TRUE) TstX<-t(as.matrix(TstX)) else if (is.matrix(TstX) != TRUE) TstX<-as.matrix(TstX) if (is.matrix(TrnX) != TRUE) TrnX<-as.matrix(TrnX)#之前跟多总体距离判别相同，修改各种输入格式和兼容两总体情况 nx<-nrow(TstX) blong<-matrix(rep(0, nx), nrow=1, dimnames=list("blong", 1:nx)) g<-length(levels(TrnG)) mu<-matrix(0, nrow=g, ncol=ncol(TrnX)) for (i in 1:g) mu[i,]<-colMeans(TrnX[TrnG==i,]) D<-matrix(0, nrow=g, ncol=nx) if (var.equal == TRUE || var.equal == T){ for (i in 1:g){ d2 <- mahalanobis(TstX, mu[i,], var(TrnX)) D[i,] <- d2 - 2*log(p[i])#协方差阵相等时，每个样品到第i个类别的广义平方距离 } } else{ for (i in 1:g){ S<-var(TrnX[TrnG==i,]) d2 <- mahalanobis(TstX, mu[i,], S) D[i,] <- d2 - 2*log(p[i])-log(det(S))#协方差阵不相等时，每个样品到第i个类别的广义平方距离 } } for (j in 1:nx){ dmin<-Inf for (i in 1:g) if (D[i,j]
高级语言：
项目地址: git://github.com/sherry-xl/R-for-cluster.git