前言
上期关于判别分析的内容中，主要介绍了判别分析的基本概念以及涉及到的降维和 Baye’s rule 等的统计思想，小编已经对如何建立判别分析模型摩拳擦掌了 基于 R语言的判别分析介绍与实践（1）......本期，小编和读者们将会化身某神秘谋杀案的侦探，揭秘葡萄酒案件背后的故事......
建立线性判别和二次判别模型
首先，加载我们要用的 R 包。
library(mlr) library(tidyverse)
1. 加载和探索数据集
想象你是一名神秘谋杀案的侦探，当地一位名叫罗纳德·费雪 (Ronald Fisher) 的葡萄酒生产商在一次晚宴上被人下毒身亡，已经明确死因是有人将葡萄酒换成了有毒的葡萄酒。其他三名葡萄酒生产商(竞争对手)也在晚宴上，他们是你的主要嫌疑人，凶手就在其中。你拥有的信息是每个葡萄园葡萄酒的化学分析和犯罪现场毒葡萄酒的化学分析。你的任务是建立一个模型来判断有毒的葡萄酒来自哪个葡萄园，故找到谁是凶手。
葡萄酒数据集（wine）存在于 HDclassif 包中，安装包加载数据集并转换为 tibble 形式。
install.packages("HDclassif")#安装数据集所在的包 data(wine, package = "HDclassif")#加载数据集 wineTib <- as_tibble(wine)#转换为 tibble 形式 wineTib # A tibble: 178 × 14 # class V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 # <int> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> # 1 1 14.2 1.71 2.43 15.6 127 2.8 3.06 0.28 2.29 5.64 1.04 # 2 1 13.2 1.78 2.14 11.2 100 2.65 2.76 0.26 1.28 4.38 1.05 # 3 1 13.2 2.36 2.67 18.6 101 2.8 3.24 0.3 2.81 5.68 1.03 # 4 1 14.4 1.95 2.5 16.8 113 3.85 3.49 0.24 2.18 7.8 0.86 # 5 1 13.2 2.59 2.87 21 118 2.8 2.69 0.39 1.82 4.32 1.04 # 6 1 14.2 1.76 2.45 15.2 112 3.27 3.39 0.34 1.97 6.75 1.05 # 7 1 14.4 1.87 2.45 14.6 96 2.5 2.52 0.3 1.98 5.25 1.02 # 8 1 14.1 2.15 2.61 17.6 121 2.6 2.51 0.31 1.25 5.05 1.06 # 9 1 14.8 1.64 2.17 14 97 2.8 2.98 0.29 1.98 5.2 1.08 #10 1 13.9 1.35 2.27 16 98 2.98 3.15 0.22 1.85 7.22 1.01 # … with 168 more rows, and 2 more variables: V12 <dbl>, V13 <int>
该数据集的变量名称让我们很难知道哪个变量是哪个，为了方便，我们对每个变量命名，并将变量 class 转换为因子。
names(wineTib) <- c("Class", "Alco", "Malic", "Ash", "Alk", "Mag", "Phe", "Flav", "Non_flav", "Proan", "Col", "Hue", "OD", "Prol")#变量命名 wineTib$Class <- as.factor(wineTib$Class)#将class转换为因子 wineTib # A tibble: 178 × 14 # Class Alco Malic Ash Alk Mag Phe Flav Non_flav Proan Col # <fct> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> # 1 1 14.2 1.71 2.43 15.6 127 2.8 3.06 0.28 2.29 5.64 # 2 1 13.2 1.78 2.14 11.2 100 2.65 2.76 0.26 1.28 4.38 # 3 1 13.2 2.36 2.67 18.6 101 2.8 3.24 0.3 2.81 5.68 # 4 1 14.4 1.95 2.5 16.8 113 3.85 3.49 0.24 2.18 7.8 # 5 1 13.2 2.59 2.87 21 118 2.8 2.69 0.39 1.82 4.32 # 6 1 14.2 1.76 2.45 15.2 112 3.27 3.39 0.34 1.97 6.75 # 7 1 14.4 1.87 2.45 14.6 96 2.5 2.52 0.3 1.98 5.25 # 8 1 14.1 2.15 2.61 17.6 121 2.6 2.51 0.31 1.25 5.05 # 9 1 14.8 1.64 2.17 14 97 2.8 2.98 0.29 1.98 5.2 #10 1 13.9 1.35 2.27 16 98 2.98 3.15 0.22 1.85 7.22 # … with 168 more rows, and 3 more variables: Hue <dbl>, OD <dbl>, # Prol <int>
这里是对 178 瓶葡萄酒进行了 13 次连续测量，每一次测量都是葡萄酒中不同化合物/元素的含量。我们还有一个分类变量 class，它告诉我们这瓶葡萄酒来自哪个葡萄园。
2. 绘制数据
接下来我们来绘制数据以了解不同葡萄园的化合物是如何变化的。和之前的泰坦尼克数据集相似，使用 gather() 函数将数据转化为 untidy 形式，这样便可以作出各个变量的分面图 （facet）。
wineUntidy <- gather(wineTib, "Variable", "Value", -Class)#转换数据形式 ggplot(wineUntidy, aes(Class, Value)) + ##ggplot绘图 facet_wrap(~ Variable, scales = "free_y") + geom_boxplot() + theme_bw()
Fig 1. 所有变量三个类别分布箱线图
3. 训练模型
3.1 LDA
首先，和之前一样，定义任务（task）和学习者（learner），指定 classif.lda 为 makeLearner() 的参数来说明我们将使用线性判别分析（LDA）。
wineTask <- makeClassifTask(data = wineTib, target = "Class")#定义任务 lda <- makeLearner("classif.lda")#定义学习者 ldaModel <- train(lda, wineTask)#训练
- 注：该函数警告：makeClassifTask()的数据是一个 tibble，而不是一个纯粹的 data.frame，可以安全地忽略此警告。
接下来，使用 getLearnerModel() 函数提取模型信息，并使用 predict() 函数为每个实例获取判别函数值。通过打印 head(ldaPreds)，我们可以看到模型已经学习了两个判别函数: LD1 和 LD2，predict() 函数确实为 wineTib 数据集中的每个实例返回了这些函数的值。
ldaModelData <- getLearnerModel(ldaModel)#提取模型信息 ldaPreds <- predict(ldaModelData)$x#得到判别函数 head(ldaPreds) # 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
为了形象化地描述这两个学习的判别函数是如何从三个葡萄园中区分葡萄酒的，接下来作可视化。首先，将数据集 wineTib 作为 mutate() 的调用，为每个判别函数创建一个新列。将这个 mutate() 得到的 tibble 作为 ggplot() 的调用，并将 LD1、LD2 分别设置为 x、y，颜色按 class 区分。
wineTib %>% mutate(LD1 = ldaPreds[, 1], LD2 = ldaPreds[, 2]) %>% ggplot(aes(LD1, LD2, col = Class)) + geom_point() + stat_ellipse() + theme_bw()
Fig 2. 画出判别函数
可以看到，LDA 将 13 个预测变量简化为两个判别函数，在葡萄酒分类中做得很好。
3.2 QDA
我们可以用完全相同的过程来构建 QDA 模型:
qda <- makeLearner("classif.qda") qdaModel <- train(qda, wineTask)
遗憾的是，从 QDA 的 mlr 的实现中提取判别函数来绘制图并不容易。
3.3 交叉验证 LDA 和 QDA 模型
接下来，交叉验证 LDA 和 QDA 模型，以估计它们在新数据上的表现:
kFold <- makeResampleDesc(method = "RepCV", folds = 10, reps = 50, stratify = TRUE) ldaCV <- resample(learner = lda, task = wineTask, resampling = kFold,#lda交叉验证 measures = list(mmce, acc)) qdaCV <- resample(learner = qda, task = wineTask, resampling = kFold,#qda交叉验证 measures = list(mmce, acc)) ldaCV$aggr #mmce.test.mean acc.test.mean # 0.01295197 0.98704803 qdaCV$aggr #mmce.test.mean acc.test.mean # 0.009939026 0.990060974
可见，LDA 模型平均正确分类了 98.7% 的葡萄酒，QDA 模型成功地对 99.0% 的实例进行了正确分类。
3.4 QDA 预测
毒葡萄酒的化学分析已经出来了，接下来我们可以用建立的 QDA 模型来预测毒酒来自哪个葡萄园。
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: response #threshold: #time: 0.00 # response #1 1
该模型预测，毒葡萄酒来自葡萄园 1。
注：罗纳德·费雪(Ronald Fisher，1890 - 1962)是一位著名的生物统计学家，后来被称为统计之父。Fisher 开发了许多我们今天使用的统计工具和概念，包括判别分析。事实上，线性判别分析通常与 Fisher 判别分析相混淆，后者是 Fisher 提出的判别分析的原始形式(但略有不同)。
小编有话说
判别分析的内容就到此结束啦！下期小编将继续学习第 6 章 —— 基于概率和超平面的分类：朴素贝叶斯和支持向量机，二者都是用于分类的有监督学习算法。好了，化身为侦探的你我已经知道凶手是谁了，该去抓人了！
