判别分析之Fisher判别、Bayes判别、距离判别的R实现案例

某企生产的产品，其造型、性能和价位及所属级别数据如下表所示：

某企业产品的造型、性能、价位、级别等指标

题目来自《多元统计分析-基于R》课后习题

下面分别用Fisher判别法和Bayes判别法进行判别分析。

先进性Fisher判别，R程序如下：

#Fisher判别ex5.3<-read.csv("ex5.3.csv",header = T)ex5.3library(MASS) #加载MASS程序包，以便使用其中lda函数ld=lda(G~x1+x2+x3,data=ex5.3)ld

运行结果如下：

程序输出了lda（）所用的函数，各组的先验概率，各组的均值向量，第一及第二判别函数的系数

，两个判别2函数对判别的贡献大小。

下面我们用predict()函数对原始数据进行回判，将lda()函数的分类与原数据分类进行对比，考察误差的大小，R程序如下：

Z=predict(ld)ZnewG=Z$classcbind(G=ex5.3[,4],newG,Z$post)

运行结果如下：

运行结果G列表示原始数据分类，newG表示回判分类，，后三列给出了每个样本判如每个类的后验概率。Fisher判别法把样本判如后验概率最大的那一类，这也是3、6、8、13误判的原因。

若需要进一步判别两个新产品的类别，它们的指标分别为(17,46,79),(77,54,84),利用predict()函数对它们进行判别，R程序如下：

newdata=data.frame(x1=c(17,77),x2=c(46,54),x3=c(79,84))(predict(ld,newdata))

运行结果如下：

判别结果表明，这两个产品分别被判入了第一类和第二类。

下面进行Bayes判别，R程序如下：

ex5.3<-read.csv("ex5.3.csv",header = T)attach(ex5.3)library(MASS) #加载MASS程序包，以便使用其中lda函数ld=lda(G~x1+x2+x3,prior=c(5,9)/14) #用先验概率进行判别ld

运行结果如下：

再用predict进行回判，并且与原始数据分类对比：

Z=predict(ld)newG=Z$classcbind(G,newG,Z$post,Z$x)

运行结果如下：

运行结果表明，第3、6、8、13组样本被误判，若需要进一步判别两个新产品的类别，它们的指标分别为(17,46,79),(77,54,84),利用predict()函数对它们进行判别，R程序如下

若需要进一步判别两个新产品的类别，它们的指标分别为(17,46,79),(77,54,84),利用predict()函数对它们进行判别，R程序如下

运行结果如下：

两个新产品分别被判如第一类和第三类，第二个产品的判别结果与Fisher判别的判别结果不同。

下面式距离判别案例

根据经验今天和昨天的湿温差x1和气温差x2是预报明天下雨或者不下雨的重要因子，根据下表数据用距离判别法进行判别：

R程序如下：

# 距离判别setwd("D:/学习资料/R软件/多元统计分析 基于R》14797268/多元统计分析——基于R(第2版) R-data")ex5.2<-read.csv("ex5.2.csv",header = T)classG1=ex5.2[1:10,2:3]classG2=ex5.2[11:17,2:3]newdata=ex5.3[1:20,2:3]#进行距离判别source("DDA2.R") #载入自编程序DDA2.RDDA2(classG1,classG2)

运行结果如下：

下面对newdata进行判定，R程序如下：

#进行距离判别source("DDA2.R") #载入自编程序DDA2.RDDA2(classG1,classG2,newdata)

运行结果如下：

第18，19，20号样本都被分入第二类，与原始数据分类一致。

附录：DDA2.R程序

 DDA2<-function (TrnG1, TrnG2, TstG = NULL, var.equal = FALSE){if (is.null(TstG) == TRUE) TstG<-rbind(TrnG1,TrnG2)if (is.vector(TstG) == TRUE)TstG<-t(as.matrix(TstG)) else if (is.matrix(TstG) != TRUE)　TstG<-as.matrix(TstG)if (is.matrix(TrnG1) != TRUE) TrnG1<-as.matrix(TrnG1)if (is.matrix(TrnG2) != TRUE) TrnG2<-as.matrix(TrnG2); nx<-nrow(TstG)blong<-matrix(rep(0, nx), nrow=1, byrow=TRUE, dimnames=list("blong", 1:nx))mu1<-colMeans(TrnG1); mu2<-colMeans(TrnG2) if (var.equal == TRUE|| var.equal == T){S<-var(rbind(TrnG1,TrnG2))　w<-mahalanobis(TstG, mu2, S)-mahalanobis(TstG, mu1, S)} else{S1<-var(TrnG1); S2<-var(TrnG2)　w0) blong[i]<-1 else blong[i]<-2}; blong}