{"ref":"master","ref_type":"branch","master_branch":"master","description":"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]<dmin){              dmin<-D[i,j]; blong[j]<-i#判给距离最近的类，再循环       }    }    blong }  #多总体距离判别例子 X<-iris[,1:4] G<-gl(3,50) source(\"distinguish.distance.R\") distinguish.distance(X,G)   discriminiant.bayes<-function#对两正态总体的贝叶斯判别函数P474    (TrnX1, TrnX2, rate=1, TstX = NULL, var.equal = FALSE){#输入中的rate为错判代价比乘以先验概率比    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))    mu1<-colMeans(TrnX1); mu2<-colMeans(TrnX2)     if (var.equal == TRUE  || var.equal == T){       S<-var(rbind(TrnX1,TrnX2)); beta<-2*log(rate)#协方差阵相等时的beta       w<-mahalanobis(TstX, mu2, S)-mahalanobis(TstX, mu1, S)    }    else{       S1<-var(TrnX1); S2<-var(TrnX2)       beta<-2*log(rate)+log(det(S1)/det(S2))#协方差阵不等时的beta       w<-mahalanobis(TstX, mu2, S2)-mahalanobis(TstX, mu1, S1)    }        for (i in 1:nx){       if (w[i]>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]<dmin){#判别规则：判给广义距离最近者              dmin<-D[i,j]; blong[j]<-i       }    }    blong } #多总体贝叶斯判别的例子 X<-iris[,1:4] G<-gl(3,50) source(\"distinguish.bayes.R\") distinguish.bayes(X,G)    discriminiant.fisher<-function(TrnX1, TrnX2, TstX = NULL){#Fisher判别函数    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))    n1<-nrow(TrnX1); n2<-nrow(TrnX2)     mu1<-colMeans(TrnX1); mu2<-colMeans(TrnX2)     S<-(n1-1)*var(TrnX1)+(n2-1)*var(TrnX2)     mu<-n1/(n1+n2)*mu1+n2/(n1+n2)*mu2    w<-(TstX-rep(1,nx) %o% mu) %*% solve(S, mu2-mu1);    for (i in 1:nx){        if (w[i]<=0)            blong[i]<-1        else            blong[i]<-2    }    blong }   #两总体fisher判别例子 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.fisher.R\") discriminiant.fisher(classX1, classX2)","pusher_type":"user"}
{"actor":{"display_login":"sherry-xl"}}