1、概述

  • LDA与QDA可以简单理解为有监督的降维,将多个预测变量信息压缩成少数(类别数-1)新的预测变量。

  • 每一个新的预测变量称之为判别函数,由所有原始变量的线性组合。

    所以对类别区分贡献大的变量具有绝对值最大的系数(也称为标准判别函数系数),而包含很少或者不包含类别分离信息的变量的系数约等于0

  • 在分类时,表现最好的是第一个判别函数,其次是第二个…以此类推。

  • LDA(Linear discriminant analysis),为线性判别分析,可以学习不同类别之间的线性的决策边界;

  • QDA(Quadratic discriminant analysis),为二次判别分析,可以学习不同类别之间的曲线的决策边界

  • LDA与QDA均假设所有预测变量呈正态分布;LAD则进一步假设数据集里每一个类别,预测变量之间具有相同的协方差;而QDA没有这一假设。

协方差可以简单理解为变量之间的相关性。

  • 在分类预测时,使用贝叶斯准则预测属于每一种类别的概率,选择概率最大的类别。

image-20220404161906804

2、mlr建模

2.1 葡萄酒数据

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
# install.packages("HDclassif")
data(wine, package = "HDclassif")
wineTib = wine

# set meaning colnames
colnames(wineTib) = c("Class", "Alco", "Malic", "Ash", "Alk", "Mag", 
                      "Phe", "Flav", "Non_flav", "Proan", "Col", "Hue", 
                      "OD", "Prol")
# set class column as factor
wineTib$Class <- as.factor(wineTib$Class)
head(wineTib)
#   Class  Alco Malic  Ash  Alk Mag  Phe Flav Non_flav Proan  Col  Hue   OD Prol
# 1     1 14.23  1.71 2.43 15.6 127 2.80 3.06     0.28  2.29 5.64 1.04 3.92 1065
# 2     1 13.20  1.78 2.14 11.2 100 2.65 2.76     0.26  1.28 4.38 1.05 3.40 1050
# 3     1 13.16  2.36 2.67 18.6 101 2.80 3.24     0.30  2.81 5.68 1.03 3.17 1185
# 4     1 14.37  1.95 2.50 16.8 113 3.85 3.49     0.24  2.18 7.80 0.86 3.45 1480
# 5     1 13.24  2.59 2.87 21.0 118 2.80 2.69     0.39  1.82 4.32 1.04 2.93  735
# 6     1 14.20  1.76 2.45 15.2 112 3.27 3.39     0.34  1.97 6.75 1.05 2.85 1450
##第一列是分类信息,其余是化合物的成分含量信息

2.2 确定预测目标与训练方法

1
2
3
4
5
6
7
#根据化合物不同成分含量信息预测葡萄酒类别
wineTask <- makeClassifTask(data = wineTib, target = "Class")

#(1)使用LDA方法
lda <- makeLearner("classif.lda", predict.type = "prob")
#(2)使用QDA方法
qda <- makeLearner("classif.qda", predict.type = "prob")

2.3 模型训练、预测

(1)LDA模型
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
#训练模型
ldaModel <- train(lda, wineTask)

##查看每个判别函数的原始预测变量的系数
ldaModelData <- getLearnerModel(ldaModel)
ldaModelData$scaling %>% head
#                   LD1           LD2
# Alco     -0.403399781  0.8717930699
# Malic     0.165254596  0.3053797325
# Ash      -0.369075256  2.3458497486
# Alk       0.154797889 -0.1463807654
# Mag      -0.002163496 -0.0004627565
# Phe       0.618052068 -0.0322128171

##查看每个样本在新的预测变量(判别函数)的值
predict(ldaModelData)$x %>% head
#         LD1       LD2
# 1 -4.700244 1.9791383
# 2 -4.301958 1.1704129
# 3 -3.420720 1.4291014
# 4 -4.205754 4.0028715
# 5 -1.509982 0.4512239
# 6 -4.518689 3.2131376

##可视化
ldaPreds <- predict(ldaModelData)$x
wineTib %>%
  mutate(LD1 = ldaPreds[, 1], 
         LD2 = ldaPreds[, 2]) %>%
  ggplot(aes(LD1, LD2, col = Class)) +
  geom_point() +
  stat_ellipse() +
  theme_bw()
image-20220404165400730
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
#模型预测
poisoned <- tibble(Alco = 13, Malic = 2, Ash = 2.2, Alk = 19, Mag = 100, 
                   Phe = 2.3, Flav = 2.5, Non_flav = 0.35, Proan = 1.7,
                   Col = 4, Hue = 1.1, OD = 3, Prol = 750)
predict(ldaModel, newdata = poisoned)
# Prediction: 1 observations
# predict.type: prob
# threshold: 1=0.33,2=0.33,3=0.33
# time: 0.00
#       prob.1    prob.2      prob.3 response
# 1 0.03997738 0.9600226 1.52222e-09        2
(2)QDA
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
#训练模型
qdaModel <- train(qda, wineTask)

##暂时不知道如何提取QDA模型中的DF信息

#模型预测
poisoned <- tibble(Alco = 13, Malic = 2, Ash = 2.2, Alk = 19, Mag = 100, 
                   Phe = 2.3, Flav = 2.5, Non_flav = 0.35, Proan = 1.7,
                   Col = 4, Hue = 1.1, OD = 3, Prol = 750)
predict(qdaModel, newdata = poisoned)
# Prediction: 1 observations
# predict.type: prob
# threshold: 1=0.33,2=0.33,3=0.33
# time: 0.00
#      prob.1     prob.2       prob.3 response
# 1 0.9130142 0.08698577 7.040883e-60        1

注意到LDA与QDA的预测结果并不一致。下面通过交叉验证哪一种模型的性能更好一些。

2.4 交叉验证

  • LDA
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
#50次重复的10折交叉验证
kFold <- makeResampleDesc(method = "RepCV", folds = 10, reps = 50, 
                          stratify = TRUE)
ldaCV <- resample(learner = lda, task = wineTask, resampling = kFold,
                    measures = list(mmce, acc))
ldaCV$aggr
# mmce.test.mean  acc.test.mean 
#     0.01196956     0.98803044

#计算混淆矩阵
calculateConfusionMatrix(ldaCV$pred, relative = FALSE)
#         predicted
# true        1    2    3 -err.-
#   1      2948    2    0      2
#   2        35 3465   50     85
#   3         0   19 2381     19
#   -err.-   35   21   50    106
  • QDA
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
#50次重复的10折交叉验证
kFold <- makeResampleDesc(method = "RepCV", folds = 10, reps = 50, 
                          stratify = TRUE)
qdaCV <- resample(learner = qda, task = wineTask, resampling = kFold,
                    measures = list(mmce, acc))
qdaCV$aggr
# mmce.test.mean  acc.test.mean 
# 0.009331871    0.990668129

#计算混淆矩阵
calculateConfusionMatrix(qdaCV$pred, relative = FALSE)
#         predicted
# true        1    2    3 -err.-
#   1      2933   17    0     17
#   2        49 3501    0     49
#   3         0   17 2383     17
#   -err.-   49   34    0     83

如此看来,还是QDA的性能更好一些,但也容易过拟合。