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

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

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

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

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

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

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

       运行结果如下：

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

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

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

Z=predict(ld)
Z
newG=Z$class
cbind(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$class
cbind(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.R
DDA2(classG1,classG2)

       运行结果如下：

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

#进行距离判别
source("DDA2.R") #载入自编程序DDA2.R
DDA2(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)
　      w<-mahalanobis(TstG, mu2, S2)-mahalanobis(TstG, mu1, S1)
        }
　   for (i in 1:nx){if (w[i]>0) blong[i]<-1 else blong[i]<-2}; blong
}