判别分析及R使用Part2-距离判别法

这部分笔记是MOOC课程《多元统计分析及R语言建模》第6章第二讲“距离判别分析”。在判别分析及R使用-Part1中提到，确定性判别可用Fisher判别法，除此之外还可以用距离判别分析。

两总体距离判别

老师在讲课的时候画了张图，可以直观的理解什么是距离判别法：

设，，，分别为两个类，的均值向量和协方差矩阵。

距离判别.jpeg

简单来讲，若想知道一个样本x属于哪个总体，可以计算并比较x到两个总体的距离，距离谁近则属于谁。距离计算方法用的是马氏距离：

判别准则：

• 当，则
• 当，则
• 当，待判。

按照与是否相等，距离判别分析又可分为直线判别和曲线判别。

直线判别

当时，就是直线判别。若想知道一个未知的点距离谁近，可以做减法：

然后把无伤大雅的2去掉，就可以把写成，此时，。这个其实就是Fisher判别分析里的，换句话说，当两总体协方差矩阵相等时，距离判别分析和Fisher判别分析是一样的。

其实吧，上面公式是怎么推倒的，我还没整的特别明白，先记录下来，回头再扣

曲线判别

曲线判别就是时的情况，不等则不能像相等时将代入展开:

举例说明

还是之前的天气的例子，这回我们使用距离判别分析天气数据，在R语言中使用qda()函数即可：

> qd <- qda(G~x1+x2)
> qp<- predict(qd)
> G2 <- qp$class
> data.frame(G,G1,G2)##G1是使用Fisher判别法时预测的结果，不明白的可以去看上一张笔记的内容
  G G1 G2
1  1  1  2
2  1  1  1
3  1  1  1
4  1  1  1
5  1  1  1
6  1  2  1
7  1  1  1
8  1  1  1
9  1  1  1
10 1  1  1
11 2  2  2
12 2  2  2
13 2  2  2
14 2  2  2
15 2  1  1
16 2  2  1
17 2  2  2
18 2  2  2
19 2  2  2
20 2  2  2
##计算正确率
> sum(diag(prop.table( table(G,G2))))
[1] 0.85
##做天气预测
> predict(qd,data.frame(x1=8.1,x2=2.0))
$class
[1] 1
Levels: 1 2

$posterior
          1           2
1 0.9939952 0.006004808

多总体距离判别

多总体时就不能像两总体那样做距离的减法了，需要带着对公式进行下变换，若协方差矩阵相同（直线判别）：

其中，，当，则。
而协方差矩阵若不相等（非线性判别），则马氏距离公式无法展开，此时是当时，。

举例说明

表6.3.png

20个电视机，5种畅销，8种平销，7种滞销，试建立判别函数，当一新产品其质量评分为8.0，功能评分为7.5，销售价格为65元，问该厂产品的销售前景如何？
首先使用直线判别：

> d6.3 <- read.xlsx("/home/my/桌面/MOOC/多元统计分析/mvstats5.xlsx",sheet="d6.3")
> d6.3
     Q   C  P G3
1  8.3 4.0 29  1
2  9.5 7.0 68  1
3  8.0 5.0 39  1
4  7.4 7.0 50  1
5  8.8 6.5 55  1
6  9.0 7.5 58  2
7  7.0 6.0 75  2
8  9.2 8.0 82  2
9  8.0 7.0 67  2
10 7.6 9.0 90  2
11 7.2 8.5 86  2
12 6.4 7.0 53  2
13 7.3 5.0 48  2
14 6.0 2.0 20  3
15 6.4 4.0 39  3
16 6.8 5.0 48  3
17 5.2 3.0 29  3
18 5.8 3.5 32  3
19 5.5 4.0 34  3
20 6.0 4.5 36  3
> attach(d6.3)
> ld3 <- lda(G3~Q+C+P)
> ld3
Call:
lda(G3 ~ Q + C + P)

Prior probabilities of groups:
   1    2    3 
0.25 0.40 0.35 

Group means:
         Q        C      P
1 8.400000 5.900000 48.200
2 7.712500 7.250000 69.875
3 5.957143 3.714286 34.000

Coefficients of linear discriminants:
          LD1         LD2
Q -0.81173396  0.88406311
C -0.63090549  0.20134565
P  0.01579385 -0.08775636

Proportion of trace:
   LD1    LD2 
0.7403 0.2597 
> lp3<- predict(ld3)
> lG3 <- lp3$class
> data.frame(G3,lG3)
   G3 lG3
1   1   1
2   1   1
3   1   1
4   1   1
5   1   1
6   2   1
7   2   2
8   2   2
9   2   2
10  2   2
11  2   2
12  2   2
13  2   3
14  3   3
15  3   3
16  3   3
17  3   3
18  3   3
19  3   3
20  3   3
> ltab3 <- table(G3,lG3)
> ltab3
   lG3
G3  1 2 3
  1 5 0 0
  2 1 6 1
  3 0 0 7
> plot(lp3$x)
> text(lp3$x[,1],lp3$x[,2],lG3,adj=-0.8,cex=0.75)

lp3.png

> predict(ld3,data.frame(Q=8,C=7.5,P=65))
$class
[1] 2
Levels: 1 2 3

$posterior
          1        2           3
1 0.2114514 0.786773 0.001775594

$x
        LD1        LD2
1 -1.537069 -0.1367865

若协方差矩阵不等，使用pda()函数：

> qd3 <- qda(G3~Q+C+P)
> qd3
Call:
qda(G3 ~ Q + C + P)

Prior probabilities of groups:
   1    2    3 
0.25 0.40 0.35 

Group means:
         Q        C      P
1 8.400000 5.900000 48.200
2 7.712500 7.250000 69.875
3 5.957143 3.714286 34.000
> qp3 <- predict(qd3)
> qG3 <- qp3$class
> data.frame(G3,lG3,qG3)
   G3 lG3 qG3
1   1   1   1
2   1   1   1
3   1   1   1
4   1   1   1
5   1   1   1
6   2   1   2
7   2   2   2
8   2   2   2
9   2   2   2
10  2   2   2
11  2   2   2
12  2   2   2
13  2   3   3
14  3   3   3
15  3   3   3
16  3   3   3
17  3   3   3
18  3   3   3
19  3   3   3
20  3   3   3
> qtab3<-table(G3,lG3)
> predict(qd3,data.frame(Q=8,C=7.5,P=6.5))
$class
[1] 2
Levels: 1 2 3

$posterior
              1 2             3
1 5.080497e-225 1 1.498709e-158

无论哪种方法，正确率大于0.8就是可以的。