精通-R-机器学习第二版-全-

精通 R 机器学习第二版（全）

原文：annas-archive.org/md5/cf7d3847339310bf4cce5e1d4c83d049

译者：飞龙

协议：CC BY-NC-SA 4.0

前言

“一个人应该得到第二次机会，但也要留心他”

约翰·韦恩

在生活中，你并不经常得到第二次机会。我记得在我们停止编辑第一版后的几天里，我一直在问自己：“我为什么不……？”或者“我到底在想什么，竟然这么说？”等等。事实上，在我出版的第一个项目之后，我开始着手的工作与第一版中的任何方法都没有关系。我在心里记下了一个笔记，如果有机会，它将进入第二版。

当我开始着手第一版时，我的目标是创造一些不同的事物，也许甚至能创作出一部在主题限制下仍令人愉悦的著作。在收到所有反馈后，我认为我达到了目标。然而，总有改进的空间，如果你试图满足所有人的需求，那么你最终对所有人来说都无足轻重。我想起了我最喜欢的一句弗里德里希大帝的名言：“谁保卫一切，谁就保卫不了任何东西”。因此，我试图提供足够的技能和工具，但不是全部，以便读者能够尽可能快速且痛苦地用 R 和机器学习入门。我认为我增加了一些有趣的新技术，这些技术建立在第一版的基础上。可能总会有人抱怨它提供的数学不够或没有做这个、那个或其他事情，但我的回答是它们已经存在了！为什么重复已经做得很好的事情呢？再次强调，我寻求提供一些不同的事物，一些能够吸引读者的注意力并帮助他们在这个竞争激烈的领域取得成功的事物。

在我提供第二版中逐章融入的更改/改进列表之前，让我先解释一些普遍的更改。首先，我在努力抵制使用赋值运算符<-而不是仅仅使用=方面已经放弃了。随着我越来越多地与他人分享代码，我意识到我独自使用=而没有使用<-。当我为第二版签订合同时，我首先逐行检查代码并进行更改。也许更重要的是，要清理和标准化代码。当你不得不与同事和，我敢说，监管机构共享代码时，这也是很重要的。使用 RStudio 在最新版本中促进了这种标准化。什么样的标准！好吧，首先是要正确地间隔代码。例如，我过去不会犹豫地写下c(1,2,3,4,5,6)。现在不再是这样了！现在，我会在逗号后加上一个空格来写下这个--c(1, 2, 3, 4, 5, 6)--，这使得它更容易阅读。如果你想要其他想法，请查看谷歌的 R 风格指南，google.github.io/styleguide/Rguide.xml/。我还收到了许多电子邮件，说从网上抓取的数据不可用。国家曲棍球联盟决定推出他们统计数据的全新版本，所以我不得不从头开始。类似的问题导致我将数据放在 GitHub 上。

总的来说，我投入了相当大的努力，将最好的工具放在你们手中，以便你们开始使用。另一方面，在 2017 年 2 月，网络上的许多关注都集中在这位企业家马克·库班的评论上：

“人工智能、深度学习、机器学习——无论你在做什么，如果你不理解它——就去学习它。因为否则，你将在 3 年内变成一个恐龙。”
“我个人认为，在 10 年后，对于文科专业的需求将大于编程专业，甚至可能超过工程学，因为当所有数据都为你自动生成，选项也为你自动生成时，你需要一个不同的视角来对数据进行不同的解读。而且，拥有一个更自由思考的人也同样重要。”

除了这些评论在博客圈引起了一些波澜之外，乍一看，它们似乎也是相互矛盾的。但想想他在这里说了什么。我认为他触及了我写作这本书的初衷。以下是我相信的，机器学习需要在某种程度上被大众接受和利用：疲惫的、贫穷的、饥饿的、无产阶级和资产阶级。计算能力和信息的日益可用将使机器学习成为几乎每个人的事情。然而，另一方面，以及在我看来，一直并将继续存在的问题是结果的沟通。当你描述真正阳性率和假阳性率时，你会怎么做，而对方却露出茫然的神情？你如何快速讲述一个能够启发听众的故事？如果你认为这种情况不会发生，请给我发个信息，我会非常乐意分享我的故事。

我们必须有人能够领导这些努力并影响他们的组织。如果历史学或音乐欣赏学位有助于这项事业，那就这样吧。我每天都在学习历史，这对我帮助很大。古巴的评论加强了我的信念，即从许多方面来看，本书的第一章是最重要的。如果你没有向你的商业伙伴询问“他们计划如何改变”，你最好从明天开始。有太多人过于努力地完成一个与组织及其决策完全无关的分析。

本书涵盖的内容

这里是第一版按章节列出的更改列表：

第一章，成功的过程，流程图已重新绘制以更新一个意外的错误并添加额外的方法论。

第二章，线性回归 – 机器学习的攻防技巧，代码得到了改进，并提供了更好的图表；除此之外，它相对接*原文。

第三章，逻辑回归和判别分析，代码得到了改进和精简。我非常喜欢的一种技术，多元自适应回归样条，已被添加；它表现良好，处理非线性，且易于解释。这是我的基础模型，其他模型则成为“挑战者”试图超越它。

第四章，线性模型中的高级特征选择，不仅包括回归技术，还包括分类问题中的技术。

第五章，更多分类技术 – K 最*邻和支持向量机，代码得到了精简和简化。

第六章，分类和回归树，增加了 XGBOOST 包提供的非常流行的技术。此外，我还增加了使用随机森林作为特征选择工具的技术。

第七章，神经网络和深度学习，增加了关于深度学习方法的额外信息，并改进了 H2O 包的代码，包括超参数搜索。

第八章，聚类分析，增加了使用随机森林进行无监督学习的方法。

第九章，主成分分析，使用了不同的数据集，并添加了样本外预测。

第十章，市场篮子分析、推荐引擎和序列分析，增加了序列分析，我发现它越来越重要，尤其是在市场营销方面。

第十一章，创建集成和多元分类，包含了完全新的内容，使用了几个优秀的包。

第十二章，时间序列和因果关系，增加了几年的气候数据，以及不同因果关系测试方法的演示。

第十三章，文本挖掘，增加了额外的数据和改进的代码。

第十四章，R 在云端，是另一章新内容，让您可以简单快速地将 R 部署到云端。

附录 A，R 基础知识，增加了额外的数据处理方法。

附录 B，来源，列出了参考资料和来源列表。

您需要为这本书准备的东西

由于 R 是免费和开源软件，您只需从 www.r-project.org/ 下载并安装它。尽管这不是强制性的，但强烈建议您从 www.rstudio.com/products/RStudio/ 下载 IDE 和 RStudio。

这本书面向的对象

这本书是为数据科学专业人士、数据分析师或任何有 R 语言机器学习实际知识的人编写的，他们现在希望将技能提升到下一个层次，成为该领域的专家。

习惯用法

在这本书中，您将找到许多不同的文本样式，以区分不同类型的信息。以下是一些这些样式的示例及其含义的解释。

文本中的代码单词、数据库表名、文件夹名、文件名、文件扩展名、路径名、虚拟 URL、用户输入和推特用户名如下所示：“数据框在 R 的 MASS 包下以 biopsy 命名可用。”

任何命令行输入或输出都应如下编写：

 > bestglm(Xy = biopsy.cv, IC="CV", 
   CVArgs=list(Method="HTF", K=10, 
   REP=1), family=binomial)

新术语和重要词汇以粗体显示。屏幕上显示的单词，例如在菜单或对话框中，在文本中如下所示：“为了下载新模块，我们将转到文件 | 设置 | 项目名称 | 项目解释器。”

警告或重要说明以如下框的形式出现。

技巧和窍门如下所示。

读者反馈

我们欢迎读者的反馈。告诉我们您对这本书的看法——您喜欢或不喜欢什么。读者反馈对我们很重要，因为它帮助我们开发出您真正能从中获得最大价值的标题。

要向我们发送一般反馈，只需发送电子邮件至feedback@packtpub.com，并在邮件主题中提及本书的标题。

如果您在某个主题上具有专业知识，并且您有兴趣撰写或为书籍做出贡献，请参阅我们的作者指南www.packtpub.com/authors。

客户支持

现在，您已经成为 Packt 图书的骄傲拥有者，我们有一些事情可以帮助您从您的购买中获得最大收益。

下载示例代码

您可以从www.packtpub.com的账户下载本书的示例代码文件。如果您在其他地方购买了此书，您可以访问www.packtpub.com/support并注册，以便将文件直接通过电子邮件发送给您。

您可以通过以下步骤下载代码文件：

使用您的电子邮件地址和密码登录或注册我们的网站。
将鼠标指针悬停在顶部的 SUPPORT 标签上。
点击代码下载和错误清单。
在搜索框中输入书籍名称。
选择您想要下载代码文件的书籍。
从下拉菜单中选择您购买此书的来源。
点击代码下载。

文件下载完成后，请确保您使用最新版本解压缩或提取文件夹：

适用于 Windows 的 WinRAR / 7-Zip
适用于 Mac 的 Zipeg / iZip / UnRarX
适用于 Linux 的 7-Zip / PeaZip

本书代码包也托管在 GitHub 上，网址为github.com/PacktPublishing/Mastering-Machine-Learning-with-R-Second-Edition。我们还有其他来自我们丰富图书和视频目录的代码包，可在github.com/PacktPublishing/找到。查看它们吧！

下载本书的彩色图像

我们还为您提供了一个包含本书中使用的截图/图表彩色图像的 PDF 文件。这些彩色图像将帮助您更好地理解输出的变化。您可以从www.packtpub.com/sites/default/files/downloads/MasteringMachineLearningwithRSecondEdition_ColorImages.pdf下载此文件。

错误清单

尽管我们已经尽一切努力确保内容的准确性，但错误仍然会发生。如果您在我们的书中发现错误——可能是文本或代码中的错误——如果您能向我们报告这一点，我们将不胜感激。通过这样做，您可以节省其他读者的挫败感，并帮助我们改进本书的后续版本。如果您发现任何勘误，请通过访问www.packtpub.com/submit-errata，选择您的书籍，点击勘误提交表单链接，并输入您的勘误详情来报告它们。一旦您的勘误得到验证，您的提交将被接受，勘误将被上传到我们的网站或添加到该标题的勘误表部分。

要查看之前提交的勘误表，请访问www.packtpub.com/books/content/support，并在搜索字段中输入书籍名称。所需信息将出现在勘误表部分。

海盗行为

在互联网上对版权材料的盗版是所有媒体中持续存在的问题。在 Packt，我们非常重视保护我们的版权和许可证。如果您在互联网上发现我们作品的任何非法副本，请立即提供位置地址或网站名称，以便我们可以寻求补救措施。

请通过copyright@packtpub.com与我们联系，并提供疑似盗版材料的链接。

我们感谢您在保护我们作者和我们为您提供有价值内容的能力方面的帮助。

问题

如果您对本书的任何方面有问题，您可以通过questions@packtpub.com与我们联系，我们将尽力解决问题。

第一章：成功的过程

“如果你不知道你要去哪里，任何路都能带你到那里。”

Robert Carrol

“如果你不能将你所做的事情描述为一个流程，你就不知道你在做什么。”

W. Edwards Deming

初看，这一章似乎与机器学习无关，但实际上它与机器学习息息相关（特别是其实现和促成变革）。最聪明的人、最好的软件和最好的算法并不能保证成功，无论定义得多好。

在大多数，如果不是所有项目中，成功解决问题或改善决策的关键不是算法，而是更软性的、更定性的沟通和影响力技能。我们很多人对这个问题有困难，是因为很难量化在这些技能上的有效性。我们中许多人之所以陷入这种境地，可能是因为我们想要避免它。毕竟，高度成功的电视喜剧《生活大爆炸》就是基于这个前提建立的。因此，本章的目标是为你设定成功的基础。意图是提供一个流程，一个灵活的流程，让你可以成为一个变革推动者：一个能够影响并转化为行动的人，而不需要职位权力。我们将重点关注数据挖掘跨行业标准流程（CRISP-DM）。这可能是所有分析流程中最知名和最受尊重的。即使你使用其他行业流程或专有技术，本章中仍有一些宝贵的经验可以借鉴。

我毫不犹豫地说，这一切说起来容易做起来难；毫无疑问，我在本章将要讨论的每一个罪过（无论是犯下还是遗漏）我都犯过。凭借技巧和一些运气，你可以避免我在过去 12 年里积累的许多身体和情感上的创伤。

最后，我们还将查看一个流程图（一个速查表），你可以用它来帮助你确定针对当前问题的应用方法。

流程

CRISP-DM 流程是专门为数据挖掘设计的。然而，它足够灵活和全面，可以应用于任何分析项目，无论是预测分析、数据科学还是机器学习。不要因为众多任务列表而感到害怕，因为你可以在过程中运用你的判断力，并根据任何现实世界的情况进行调整。以下图表提供了流程的视觉表示，并显示了使其如此灵活的反馈循环：

图 1：CRISP-DM 1.0，逐步数据挖掘指南

该流程包含以下六个阶段：

业务理解
数据理解
数据准备
建模
评估
部署

对于对整个流程及其所有任务和子任务的深入审查，你可以查看 SPSS、CRISP-DM 1.0、逐步数据挖掘指南的论文，该指南可在the-modeling-agency.com/crisp-dm.pdf找到。

我将讨论流程中的每个步骤，涵盖重要任务。然而，它不会像指南那样详细，而是更高级别。我们不会跳过任何关键细节，而是更多地关注可以应用于任务的技巧。记住，这些流程步骤将在后续章节中作为实际应用机器学习方法和特别是 R 代码框架使用。

商业理解

在实现成功的过程中，不能低估这个第一步的重要性。这是基础步骤，这里的失败或成功很可能会决定整个项目的失败或成功。这个步骤的目的是确定业务需求，以便你可以将它们转化为分析目标。它有以下四个任务：

确定商业目标。
评估情况。
确定分析目标。
制定项目计划。

确定商业目标

这个任务的关键是确定组织的目标，并界定问题。一个有效的问题可以是：“我们将要做什么不同？”这个问题可能看起来无害，但它确实可以挑战人们从分析的角度思考他们需要什么，并触及需要做出的决策的根本。它还可以防止你进行大量不必要的“钓鱼式”工作。因此，对你来说，关键是要确定决策。可以向团队提出一个关于决策的工作定义，即是否承诺或放弃资源的不可撤销的选择。此外，记住，不做任何不同的事情实际上也是一种决策。

这并不意味着如果选择不是绝对清晰的话，项目就不应该启动。有时问题可能没有定义，或者无法定义；用前国防部长唐纳德·拉姆斯菲尔德的话来说，这就是已知的未知。实际上，可能有很多时候问题没有定义，项目的主要目标是为了进一步理解问题并生成假设；再次引用拉姆斯菲尔德部长的话，这就是未知的未知，意味着你不知道你不知道的东西。然而，对于没有定义的问题，可以根据假设探索的各种结果，基于对资源投入的理解继续前进。

在这个任务中，还需要考虑的一个问题是期望的管理。无论数据的深度和广度如何，都没有完美无缺的数据。现在不是保证的时候，而是要沟通你所拥有的专业知识所能实现的内容。

我建议从这个任务中产生几个输出。第一个是一个使命宣言。这并不是一个组织的触动人心的使命宣言，而是你的使命宣言，或者更重要的是，由项目赞助商批准的使命宣言。我从多年的军事经验中借鉴了这个想法，我可以写很多关于为什么它有效的理由，但那是另一天的事。让我们只说，在没有明确方向或指导的情况下，使命宣言，或者你想要称之为任何名称的东西，成为所有利益相关者的统一声明，并有助于防止范围蔓延。它包括以下要点：

谁：这是你自己、团队或项目名称；每个人都喜欢一个酷炫的项目名称，例如，项目 Viper、项目融合等
做什么：这是你要执行的任务，例如，进行机器学习
何时：这是截止日期
在哪里：这可能涉及地理、功能、部门、倡议等方面
为什么：这是实施项目的目的，即业务目标

第二个任务是尽可能清晰地定义成功。字面上来说，问“成功是什么样子？”帮助团队/赞助商描绘出你可以理解的成功的画面。然后你的工作是将其转化为建模需求。

评估情况

这个任务通过收集有关可用资源、约束和假设的信息，识别风险，制定应急计划来帮助你进行项目规划。我还会进一步补充说，这也是确定将受决策（或决策）影响的关键利益相关者的时机。

这里有几个要点。在检查可用的资源时，不要忽视查阅过去和当前项目的记录。很可能会有人在这个组织里工作，或者正在解决相同的问题，并且可能需要与他们的工作同步。不要忘记考虑时间、人员和金钱方面的风险。尽你所能创建一个利益相关者的列表，包括那些影响你的项目和可能受到你的项目影响的那些人。确定这些人是谁，以及他们如何能够影响/被决策所影响。一旦完成，与项目赞助商合作，制定与这些利益相关者的沟通计划。

确定分析目标

在这里，你需要将业务目标转化为技术需求。这包括将成功标准从创建业务目标的任务转变为技术成功。这可能包括诸如 RMSE 或预测准确度水*等事项。

制定项目计划

此处的任务是构建一个有效的项目计划，其中包括到目前为止收集到的所有信息。无论你使用什么技术，无论是甘特图还是其他图形，都要制作出来，并将其作为你沟通计划的一部分。使此计划对利益相关者广泛可用，并定期更新，并根据情况变化进行调整。

数据理解

在经历了至关重要的第一步的所有痛苦之后，你现在可以开始忙于数据了。此过程中的任务包括以下内容：

收集数据。
描述数据。
探索数据。
验证数据质量。

这一阶段是经典的提取、转换、加载（ETL）案例。这里有一些考虑因素。你需要做出初步判断，即可用的数据是否足以满足你的分析需求。在探索数据时，无论是视觉上还是其他方式，确定变量是否稀疏，并确定数据可能缺失的程度。这可能会驱动你使用的学习方法，并/或确定是否需要和可行地插补缺失数据。

验证数据质量至关重要。花时间了解谁收集数据，如何收集，甚至为什么收集数据。你可能会遇到数据收集不完整的情况，或者由于意外的 IT 问题导致数据错误，或者业务规则的变化。在时间序列中，业务规则如何对数据进行分类通常会随时间变化。最后，在此步骤开始记录任何代码也是一个好主意。作为文档过程的一部分，如果数据字典不可用，请保存自己潜在的心痛，并制作一个。

数据准备

差不多完成了！这一步有以下五个任务：

选择数据。
清洗数据。
构建数据。
整合数据。
格式化数据。

这些任务相对容易理解。目标是使数据准备好输入算法。这包括合并、特征工程和转换。如果需要插补，那么它也在这里进行。此外，使用 R 时，请注意结果需要如何标记。如果你的结果/响应变量是是/否，它可能在某些包中不起作用，需要转换或使用 1/0 的变量。在此阶段，如果你适用，还应将数据分成各种测试集：训练、测试或验证。这一步可能是一个无法避免的负担，但大多数经验丰富的人都会告诉你，这是你能够与你的同行区分开来的地方。有了这个，让我们继续前进到回报阶段，在那里你可以赚到钱。

建模

这是你到目前为止所做的一切工作可能导致兴奋或沮丧的地方。但嘿，如果这很容易，每个人都会这么做。任务如下：

选择建模技术。
生成测试设计。
建立模型。
评估模型。

奇怪的是，这个流程步骤包括了您已经考虑并准备好的考虑因素。在第一步，您至少需要有一些关于您将如何建模的想法。请记住，这是一个灵活的、迭代的流程，而不是像机组人员清单那样的严格线性流程图。

本章中包含的速查表应有助于指导您在建模技术上的正确方向。测试设计指的是创建您的测试和训练数据集以及/或使用交叉验证，这应该在数据准备阶段就已经考虑并计入。

模型评估涉及将模型与在业务理解中开发的准则/标准进行比较，例如 RMSE、Lift、ROC 等。

评估

在评估过程中，主要目标是确认在此阶段选择的模型是否符合业务目标。问问自己和他人：“我们是否实现了对成功的定义？”在这里，Netflix 大奖可以作为警示。我相信您知道 Netflix 授予了一项 100 万美元的奖金给那个能够根据最低 RMSE 定义产生最佳推荐算法的团队。然而，Netflix 并没有实施它，因为获得的增量准确性不值得工程努力！始终应用奥卡姆剃刀原则。无论如何，以下是任务：

评估结果。
检查整个过程。
确定下一步行动。

在审查过程中，可能需要，正如您无疑在早期过程中确定的，将结果提交给治理机构，并与其他利益相关者沟通，以获得他们的支持。至于下一步，如果您想成为变革推动者，请确保您在利益相关者的心中回答了是什么、为什么和接下来做什么。如果您能将他们的接下来做什么与您之前做出的决策联系起来，您就赚到了钱。

部署

如果到目前为止一切按计划进行，那么可能只是切换一个开关，您的模型就会上线。假设情况并非如此，以下是这一步骤的任务：

部署计划。
监控和维护计划。
制作最终报告。
审查项目。

在部署和监控/维护进行中之后，对你和那些将跟随你脚步的人来说，制作一份写得好的最终报告至关重要。这份报告应包括一份白皮书和简报幻灯片。我必须说我抵制了将我的发现放入白皮书的冲动，因为我是一个军事对 PowerPoint 幻灯片热情的契约仆人。然而，幻灯片可能会被用来对付你，被各种当事人为了自己的利益挑选或曲解。相信我，这不会发生在白皮书上，因为它成为了你发现和信念的延伸。使用 PowerPoint 向利益相关者简报，但使用白皮书作为记录文件和预读文件，如果你的组织坚持要求的话。我的标准程序是使用 knitr 和 LaTeX 在 R 中创建这份白皮书。

现在进行至关重要的过程审查，你可能有自己的专有方式来执行它；但以下是你应该涵盖的内容，无论你以正式还是非正式的方式进行：

计划是什么？
实际上发生了什么？
为什么会发生或没有发生？
未来项目中应该保持什么？
未来项目中应该改进什么？
制定一个行动计划以确保持续改进的发生

这就完成了对 CRISP-DM 过程的审查，它提供了一个全面且灵活的框架，以确保你项目的成功，并使你成为变革的推动者。

算法流程图

本节的目的是为你创建一个工具，帮助你不仅选择可能的建模技术，而且更深入地思考问题。残余的好处是它可能帮助你与项目赞助商/团队一起构建问题框架。流程图中的技术当然不是全面的，但足够详尽，可以让你开始。它还包括本书未讨论的技术。

以下图开始选择潜在建模技术的流程。随着你回答问题，它将带你到四个附加图表中的一个：

图 2

如果数据是文本或时间序列格式，那么你将遵循以下图中的流程：

图 3

在这个算法分支中，你没有文本或时间序列数据。你也不想预测一个类别，因此你正在寻找做出推荐、理解关联或预测数量的方法：

图 4

要到达这一部分，你将拥有非文本或非时间序列的数据。你想要对数据进行分类，但它没有结果标签，这使我们来到了聚类方法，如下所示：

图 5

这使我们来到了一个想要对数据进行分类且数据已标记的情况，即分类：

图 6

摘要

本章讲述了如何为你在任何你承担的项目中设置你和你的团队以取得成功。CRISP-DM 流程被提出作为一个灵活且全面的框架，以便促进沟通和影响力等软技能。流程的每一步以及每一步的任务都被列举出来。不仅如此，评论还提供了一些关于流程执行的技术和考虑因素。通过关注这个流程，你确实可以成为任何组织的积极变革的推动者。

本章提出的另一项内容是一个算法流程图；一张帮助识别在解决商业问题时应用的一些适当技术的速查表。在这个基础建立之后，我们现在可以继续将这些技术应用到现实世界的问题中。

第二章：线性回归——机器学习的阻挡和冲撞

"有些人试图在这场比赛中寻找不存在的东西，但足球只关乎两件事——阻挡和冲撞。"

文斯·隆巴迪，名人堂足球教练

我们开始使用一种简单而极其有效的技术，这种技术已经被使用了很长时间：线性回归。阿尔伯特·爱因斯坦曾说过，事情应该尽可能简单，但不能更简单。这是明智的建议，也是开发机器学习算法时的一条好规则。考虑到我们稍后将要讨论的其他技术，没有比经过检验的线性回归更简单的模型了，它使用最小二乘法来预测定量结果。事实上，我们可以将其视为我们稍后将要讨论的所有方法的基石，其中许多只是扩展。如果您能掌握线性回归方法，那么坦白说，我相信您也可以掌握这本书的其余部分。因此，让我们把这视为我们成为机器学习大师之旅的一个良好起点。

本章涵盖了入门材料，该领域的专家可以跳过直接进入下一主题。否则，在尝试其他更复杂的学习方法之前，请确保您彻底理解这个主题。我相信您会发现，许多项目只需应用以下章节中讨论的内容就可以解决。线性回归可能是向客户解释的最简单的模型，他们中的大多数至少对R-squared有一个初步的了解。其中许多人已经对其有深入的了解，因此对变量贡献、多重共线性等问题感到舒适。

单变量线性回归

我们首先探讨一种简单的方法来预测一个定量响应Y，其中一个预测变量x，假设Y与x之间存在线性关系。这个模型的公式可以写成，Y = B0 + B1x + e。我们可以将其表述为Y的期望值是参数B0（截距）加上B1（斜率）乘以x，再加上一个误差项e。最小二乘法选择模型参数，以最小化预测y值与实际Y值之间的残差*方和（RSS）。以一个简单的例子来说，假设我们得到的Y1和Y2的实际值分别为10和20，以及y1和y2的预测值分别为12和18。为了计算 RSS，我们将*方差相加，即RSS = (Y1 - y1)² + (Y2 - y2)²，通过简单的代入，得到(10 - 12)² + (20 - 18)² = 8。

我曾在我们的精益六西格玛黑带培训期间对一位同行说过，这关乎*方和的总和；理解*方和，其他问题就会自然而然地解决。也许这是真的，至少在某种程度上。

在我们开始应用之前，我想指出，如果您阅读各种研究突破的头版新闻，您应该带着怀疑的眼光和批判性的思维去阅读，因为媒体提出的结论可能并不有效。正如我们将看到的，R 和任何其他软件都将给出一个解决方案，无论输入如何。然而，仅仅因为数学上有意义，或者报告了高相关系数或 R *方统计量，并不意味着结论是有效的。

为了使这个观点更加明确，让我们看看著名的Anscombe数据集，该数据集在 R 中可用。统计学家 Francis Anscombe 制作了这个集合，以强调数据分析时数据可视化和异常值的重要性。它由四对具有相同统计特性的X和Y变量组成，但绘制时却显示出非常不同的结果。我已使用这些数据来培训同事，并教育商业伙伴关于专注于统计数据而不探索数据和检查假设的危险。如果您有类似的需求，我认为这是一个很好的开始。这是在继续进行严肃建模之前的一个简短离题：

    > #call up and explore the data

    > data(anscombe)

    > attach(anscombe)

    > anscombe
       x1 x2 x3 x4    y1   y2    y3    y4
    1  10 10 10  8  8.04 9.14  7.46  6.58
    2   8  8  8  8  6.95 8.14  6.77  5.76
    3  13 13 13  8  7.58 8.74 12.74  7.71
    4   9  9  9  8  8.81 8.77  7.11  8.84
    5  11 11 11  8  8.33 9.26  7.81  8.47
    6  14 14 14  8  9.96 8.10  8.84  7.04
    7   6  6  6  8  7.24 6.13  6.08  5.25
    8   4  4  4 19  4.26 3.10  5.39 12.50
    9  12 12 12  8 10.84 9.13  8.15  5.56
    10  7  7  7  8  4.82 7.26  6.42  7.91
    11  5  5  5  8  5.68 4.74  5.73  6.89

正如我们将看到的，每一对都有相同的相关系数：0.816。前两个如下所示：

    > cor(x1, y1) #correlation of x1 and y1
    [1] 0.8164205

    > cor(x2, y1) #correlation of x2 and y2

    [1] 0.8164205

正如Anscombe所意图的，真正的洞察在于我们将所有四个对一起绘制时，如下所示：

    > par(mfrow = c(2,2)) #create a 2x2 grid for 
       plotting

    > plot(x1, y1, main = "Plot 1")

    > plot(x2, y2, main = "Plot 2")

    > plot(x3, y3, main = "Plot 3")

    > plot(x4, y4, main = "Plot 4")

下载示例代码

您可以从www.packtpub.com的账户下载您购买的所有 Packt 书籍的示例代码文件。如果您在其他地方购买了这本书，您可以访问www.packtpub.com/support并注册，以便将文件直接通过电子邮件发送给您。

上一段代码的输出如下：

如我们所见，图 1似乎有一个真正的线性关系，图 2是曲线关系，图 3有一个危险的异常值，而图 4则是由一个异常值驱动的。这就是一个关于仅依赖相关性的危险警告故事。

商业理解

我们的第一案例关注的是预测美国怀俄明州蛇河流域的水产量（以英寸为单位），作为当年降雪含水量的函数。这个预测将有助于管理水流和水库水*，因为蛇河为几个西部州提供了急需的灌溉用水。snake数据集可在alr3包中找到（注意，alr 代表应用线性回归）：

    > install.packages("alr3")
    > library(alr3)
    > data(snake)
    > dim(snake)
    [1] 17  2
    > head(snake)
         X    Y
    1 23.1 10.5
    2 32.8 16.7
    3 31.8 18.2
    4 32.0 17.0
    5 30.4 16.3
    6 24.0 10.5

现在我们有了17个观测值，可以开始数据探索。但在开始之前，让我们将X和Y改为有意义的变量名，如下所示：

    > names(snake) <- c("content", "yield")
    > attach(snake) # attach data with new names
    > head(snake)

      content yield
    1    23.1  10.5
    2    32.8  16.7
    3    31.8  18.2
    4    32.0  17.0
    5    30.4  16.3
    6    24.0  10.5

    > plot(content, yield, xlab = "water content of 
        snow", ylab = "water yield")

上一段代码的输出如下：

这是一个有趣的图，因为数据呈线性，并且由于两端存在两个潜在的异常值而呈现出轻微的曲线形状。因此，转换数据或删除异常观测值可能是合理的。

要在 R 中执行线性回归，可以使用 lm() 函数以标准形式 fit = lm(Y ~ X) 创建模型。然后，你可以使用以下代码通过拟合模型上的各种函数来测试你的假设：

    > yield.fit <- lm(yield ~ content)

    > summary(yield.fit)

    Call:
    lm(formula = yield ~ content)

    Residuals:
            Min      1Q  Median      3Q     Max
    -2.1793 -1.5149 -0.3624  1.6276  3.1973

    Coefficients: Estimate Std. Error t value Pr(>|t|) 
    (Intercept)  0.72538    1.54882   0.468    0.646 
    content      0.49808    0.04952  10.058 4.63e-08 
    ***
    ---
    Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 
      '.' 0.1 ' ' 1

    Residual standard error: 1.743 on 15 degrees of 
      freedom
    Multiple R-squared:  0.8709,    Adjusted R-squared:  
       0.8623
    F-statistic: 101.2 on 1 and 15 DF,  p-value: 
       4.632e-08

使用 summary() 函数，我们可以检查包括模型规范、残差的描述性统计、系数、模型显著性的代码以及模型误差和拟合的总结在内的多个项目。现在，让我们专注于参数系数估计，看看我们的预测变量是否有显著的 p-value，以及整体模型的 F-检验是否有显著的 p-value。查看参数估计，模型告诉我们 yield 等于 0.72538 加上 0.49808 乘以 content。可以说，对于 content 的每 1 个单位变化，yield 将增加 0.49808 个单位。F-统计量 用于检验模型系数都为 0 的原假设。

由于 p-value 非常显著，我们可以拒绝原假设，并继续进行内容检验的 t-检验，该检验检验的是原假设为 0。再次，我们可以拒绝原假设。此外，我们还可以看到 Multiple R-squared 和 Adjusted R-squared 的值。Adjusted R-squared 将在多元回归主题下进行讨论，所以让我们专注于 Multiple R-squared；在这里我们看到它是 0.8709。从理论上讲，它可以从 0 到 1 变化，是 X 和 Y 之间关联强度的度量。在这种情况下，解释是 87% 的 水产量 变化可以由 雪水含量 解释。顺便提一下，R-squared 仅仅是 [X, Y] 的相关系数的*方。

我们可以回忆我们的散点图，并使用以下代码添加由我们的模型产生的最佳拟合线：

    > plot(content, yield)

    > abline(yield.fit, lwd=3, col="red")

上述代码的输出如下：

线性回归模型的好坏取决于其假设的有效性，可以总结如下：

线性关系：这是预测变量和响应变量之间的线性关系。如果这种关系不明显，可以通过对 X 或 Y 进行变换（对数、多项式、指数等）来解决问题。
误差的非相关性：在时间序列和面板数据中，这是一个常见问题，其中 e[n] = beta[n-1]；如果误差相关，你可能会创建一个定义不良的模型。
同方差性：通常误差的正态分布和恒定方差，这意味着误差的方差在不同输入值上是恒定的。违反这个假设可以创建有偏的系数估计，导致显著性检验过高或过低。这反过来又会导致错误的结论。这种违反被称为异方差性。
无多重共线性：两个预测变量之间没有线性关系，也就是说，特征之间应该没有相关性。这同样可能导致有偏的估计。
异常值的存在：异常值会严重扭曲估计，理想情况下，在用线性回归拟合模型之前必须将其移除；正如我们在 Anscombe 示例中看到的那样，这可能导致有偏的估计。

由于我们正在构建一个独立于时间的单变量模型，我们只关心线性性和异方差性。其他假设将在下一节中变得重要。最初检查假设的最好方法是生成图表。当plot()函数与线性模型拟合结合使用时，将自动生成四个图表，允许你检查假设。R 一次生成一个图表，你可以通过按Enter键来浏览它们。最好同时检查所有四个，我们以下列方式进行检查：

    > par(mfrow = c(2,2))

    > plot(yield.fit)

上述代码的输出如下：

左侧的两个图表允许我们检查误差的同方差性和非线性。我们寻找的是某种类型的模式，或者更重要的是，没有任何模式存在。鉴于只有 17 个观测值的样本量，没有什么明显的可以观察到。常见的异方差误差看起来像是 U 形、倒 U 形，或者紧密地聚集在图表的左侧。随着拟合值的增加，它们会变得更宽（漏斗形状）。可以安全地得出结论，我们的模型中没有出现同方差性的违反。

上右角的正态 Q-Q 图帮助我们确定残差是否呈正态分布。分位数-分位数（Q-Q）图表示一个变量的分位数值与另一个变量的分位数值相对应。看起来异常值（观测值7、9和10）可能导致了假设的违反。残差与杠杆图可以告诉我们哪些观测值（如果有），过度影响了模型；换句话说，如果有任何异常值，我们应该关注。这个统计量是库克距离或库克 D，通常认为大于 1 的值值得进一步检查。

究竟什么是进一步检查？这正是艺术与科学的交汇点。最简单的解决办法可能是简单地删除观察结果，在这种情况下是数字9，然后重新构建模型。然而，更好的选择可能是转换预测变量和/或响应变量。如果我们仅仅删除观察结果9，那么观察结果10和13可能会超出大于 1 的带区。我相信这正是领域专业知识可能至关重要的地方。我数不清有多少次发现，探索和理解异常值可以带来宝贵的见解。当我们第一次检查之前的散点图时，我指出了潜在的异常值，而这些恰好是观察结果编号9和13。作为一个分析师，与适当的主题专家讨论以了解这种情况的原因是至关重要的。这是一个测量错误吗？这些观察结果有逻辑上的解释吗？我当然不知道，但这是一个增加你为组织带来价值的机会。

话虽如此，我们可以通过更详细地检查当前的模型，特别是正态 Q-Q 图来深入挖掘。R 默认的 Q-Q 图不提供置信区间，鉴于我们对基础图的担忧，我们应该检查置信区间。car包中的qqPlot()函数自动提供这些置信区间。由于car包与alr3包一起加载，我可以用一行代码生成该图：

    > qqPlot(yield.fit)

上述代码的输出如下：

根据图示，残差呈正态分布。我认为这可以让我们有信心选择包含所有观察结果的模型。尝试其他模型需要清晰的推理和判断。如果我们能够明确地拒绝误差正态分布的假设，那么我们可能不得不检查变量转换和/或观察结果删除。

多元线性回归

你可能会问自己，在现实世界中你是否会只有一个预测变量。这确实是一个公*的问题，当然是一个非常罕见的情况（时间序列可能是一个常见的例外）。很可能会包含几个，如果不是很多预测变量或特征——在机器学习中亲切地称为特征——必须包含在你的模型中。有了这个，让我们继续讨论多元线性回归和新的业务案例。

业务理解

按照水资源保护/预测的主题，让我们看看 alr3 包中的另一个数据集，它恰当地命名为 water。在本书第一版编写期间，南加州的严重干旱引起了极大的恐慌。即使是州长杰里·布朗也开始采取行动，呼吁公民减少 20% 的用水量。在这个练习中，让我们假设我们已被加利福尼亚州委托预测水资源可用性。提供给我们的数据包含 43 年的雪降水量，测量了奥文谷六个不同地点的数据。它还包含一个响应变量，即加利福尼亚州比什普附*的溪流径流体积，该径流最终流入奥文谷水渠，并最终流入洛杉矶水渠。准确的径流预测将允许工程师、规划者和政策制定者更有效地制定节水措施。我们试图创建的模型将具有以下形式 Y = B0 + B1x1 +...Bnxn + e，其中预测变量（特征）可以是 1 到 n。

数据理解和准备

首先，我们将加载名为 water 的数据集，并定义 str() 函数的结构如下：

    > data(water)

    > str(water)
    'data.frame':   43 obs. of  8 variables:
    $ Year   : int  1948 1949 1950 1951 1952 1953 1954 
      1955 1956 1957 ...
    $ APMAM  : num  9.13 5.28 4.2 4.6 7.15 9.7 5.02 6.7 
       10.5 9.1 ...
    $ APSAB  : num  3.58 4.82 3.77 4.46 4.99 5.65 1.45 
       7.44 5.85 6.13 ...
    $ APSLAKE: num  3.91 5.2 3.67 3.93 4.88 4.91 1.77 
       6.51 3.38 4.08 ...
    $ OPBPC  : num  4.1 7.55 9.52 11.14 16.34 ...
    $ OPRC   : num  7.43 11.11 12.2 15.15 20.05 ...
    $ OPSLAKE: num  6.47 10.26 11.35 11.13 22.81 ...
    $ BSAAM  : int  54235 67567 66161 68094 107080 
       67594 65356 67909 92715 70024 ...

在这里，我们有八个特征和一个响应变量 BSAAM。观测数据从 1943 年开始，连续进行了 43 年。由于在这个练习中我们并不关心观测发生在哪一年，因此创建一个新的数据框，排除年份向量是有意义的。这相当简单。我们只需一行代码就可以创建新的数据框，然后使用 head() 函数来验证它是否工作：

    > socal.water <- water[ ,-1] #new dataframe with 
      the deletion of 
      column 1

    > head(socal.water)
      APMAM APSAB APSLAKE OPBPC  OPRC OPSLAKE  BSAAM
    1  9.13  3.58    3.91  4.10  7.43    6.47  54235
    2  5.28  4.82    5.20  7.55 11.11   10.26  67567
    3  4.20  3.77    3.67  9.52 12.20   11.35  66161
    4  4.60  4.46    3.93 11.14 15.15   11.13  68094
    5  7.15  4.99    4.88 16.34 20.05   22.81 107080
    6  9.70  5.65    4.91  8.88  8.15    7.41  67594

由于所有特征都是定量数据，查看相关统计并生成散点图矩阵是有意义的。相关系数或 Pearson's r 是衡量两个变量之间线性关系强度和方向的指标。该统计量将是一个介于 -1 和 1 之间的数字，其中 -1 是完全负相关，+1 是完全正相关。系数的计算是两个变量的协方差除以它们标准差的乘积。正如之前讨论的，如果你*方相关系数，你将得到 R-squared。

有许多方法可以生成相关图矩阵。有些人喜欢生成热图，但我非常喜欢 corrplot 包生成的结果。它可以生成多种不同的变体，包括椭圆、圆形、方形、数字、阴影、颜色和饼图。我喜欢椭圆方法，但你可以自由地尝试其他方法。让我们加载 corrplot 包，使用基本的 cor() 函数创建一个相关对象，并检查以下结果：

    > library(corrplot)

    > water.cor <- cor(socal.water)

    > water.cor
  APMAM      APSAB    APSLAKE      OPBPC 
    APMAM   1.0000000 0.82768637 0.81607595 0.12238567 
    APSAB   0.8276864 1.00000000 0.90030474 0.03954211 
    APSLAKE 0.8160760 0.90030474 1.00000000 0.09344773 
    OPBPC   0.1223857 0.03954211 0.09344773 1.00000000 
    OPRC    0.1544155 0.10563959 0.10638359 0.86470733 
    OPSLAKE 0.1075421 0.02961175 0.10058669 0.94334741 
    BSAAM   0.2385695 0.18329499 0.24934094 0.88574778 
             OPRC    OPSLAKE     BSAAM
    APMAM   0.1544155 0.10754212 0.2385695
    APSAB   0.1056396 0.02961175 0.1832950
    APSLAKE 0.1063836 0.10058669 0.2493409
    OPBPC   0.8647073 0.94334741 0.8857478
    OPRC    1.0000000 0.91914467 0.9196270
    OPSLAKE 0.9191447 1.00000000 0.9384360
    BSAAM   0.9196270 0.93843604 1.0000000

那么，这告诉我们什么呢？首先，响应变量与 OP 特征高度正相关，其中OPBPC为0.8857，OPRC为0.9196，OPSLAKE为0.9384。此外，请注意，AP 特征彼此之间以及与 OP 特征高度相关。这意味着我们可能会遇到多重共线性问题。相关图矩阵提供了以下相关性的良好视觉表示：

    > corrplot(water.cor, method = "ellipse")

以下代码片段的输出如下：

另一种流行的可视化方法是散点图矩阵。这可以通过pairs()函数调用。它加强了我们在前一个输出中的相关图所看到的内容：

 > pairs(~ ., data = socal.water)

以下代码片段的输出如下：

建模与评估

我们在这里要讨论的关键要素之一是至关重要的特征选择任务。在本章中，我们将讨论使用leaps包的逐步最佳子集回归方法。后面的章节将介绍更高级的技术。

正向逐步选择从一个没有特征的模型开始；然后逐个添加特征，直到所有特征都被添加。在创建具有最低 RSS 的模型的过程中添加了一个选定的特征。所以从理论上讲，第一个选定的特征应该是比其他任何特征更好地解释响应变量的那个，依此类推。

需要注意的是，添加一个特征总是会降低 RSS 并增加 R-squared，但它并不一定会改善模型的拟合度和可解释性。

反向逐步回归从模型中的所有特征开始，逐个移除最不有用的特征。有一种混合方法，其中特征通过正向逐步回归添加，但算法随后检查是否可以移除任何不再提高模型拟合度的特征。一旦构建了模型，分析师可以检查输出并使用各种统计量来选择他们认为提供最佳拟合的特征。

在这里补充一点很重要，逐步技术可能会遇到严重的问题。你可以在数据集上执行正向逐步，然后是反向逐步，最终得到两个完全冲突的模型。底线是，逐步可能会产生有偏的回归系数；换句话说，它们太大，置信区间太窄（Tibshirani，1996）。

最佳子集回归可以是特征选择中逐步方法的满意替代。在最佳子集回归中，算法为所有可能的特征组合拟合模型；因此，如果您有 3 个特征，将创建 7 个模型。与逐步回归一样，分析师需要应用判断或统计分析来选择最佳模型。模型选择将是以下讨论的关键主题。正如您可能已经猜到的，如果您的数据集具有许多特征，这可能是一项相当大的任务，并且当您有比观察值更多的特征时（p大于n），该方法表现不佳。

当然，这些最佳子集的限制不适用于我们当前的任务。鉴于其局限性，我们将放弃逐步方法，但请随意尝试。我们将首先加载leaps包。为了了解特征选择是如何工作的，我们将首先构建并检查包含所有特征的模型，然后通过最佳子集进行深入选择以确定最佳拟合。

要构建包含所有特征的线性模型，我们再次可以使用lm()函数。其形式如下：fit = lm(y ~ x1 + x2 + x3...xn)。如果您想包含所有特征，可以使用波浪号后的点号作为快捷方式，而不是必须全部输入。为了开始，让我们加载leaps包并构建一个包含所有特征的模型以供检查，如下所示：

    > library(leaps)

    > fit <- lm(BSAAM ~ ., data = socal.water)

    > summary(fit)

    Call:
    lm(formula = BSAAM ~ ., data = socal.water)

    Residuals:
       Min     1Q Median     3Q    Max
    -12690  -4936  -1424   4173  18542

    Coefficients:
 Estimate Std. Error t value Pr(>|t|) 
    (Intercept) 15944.67    4099.80   3.889 0.000416 
      ***
    APMAM         -12.77     708.89  -0.018 0.985725 
    APSAB        -664.41    1522.89  -0.436 0.665237 
    APSLAKE      2270.68    1341.29   1.693 0.099112 . 
    OPBPC          69.70     461.69   0.151 0.880839 
    OPRC         1916.45     641.36   2.988 0.005031 **
    OPSLAKE      2211.58     752.69   2.938 0.005729 **
    ---
    Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 
      '.' 0.1 '' 1
    Residual standard error: 7557 on 36 degrees of 
      freedom
    Multiple R-squared:  0.9248,    Adjusted R-squared:  
      0.9123
    F-statistic: 73.82 on 6 and 36 DF,  p-value: < 
      2.2e-16

就像单变量回归一样，我们检查F-统计量上的p-value以验证至少有一个系数不为零。实际上，p-value非常显著。我们还应该有对OPRC和OPSLAKE参数的显著p-value。有趣的是，尽管与响应变量高度相关，但OPBPC并不显著。简而言之，当我们控制其他 OP 特征时，OPBPC不再解释预测变量的任何有意义的变化，也就是说，特征OPBPC在模型中与OPRC和OPSLAKE一起不再从统计角度增加任何内容。

在构建了第一个模型之后，让我们继续转向最佳子集。我们使用leaps包中的regsubsets()函数创建sub.fit对象，如下所示：

    > sub.fit <- regsubsets(BSAAM ~ ., data = 
       socal.water)

然后，我们创建best.summary对象以进一步检查模型。与所有 R 对象一样，您可以使用names()函数列出可用的输出：

    > best.summary <- summary(sub.fit)

    > names(best.summary)
    [1] "which"  "rsq"    "rss"    "adjr2"  "cp"     
       "bic"    "outmat" "obj"

模型选择中其他有价值的函数包括which.min()和which.max()。这些函数将提供具有最小或最大值的模型，如下代码片段所示：

    > which.min(best.summary$rss)
    [1] 6

代码告诉我们，具有六个特征的模型具有最小的 RSS，这是应该的，因为那是最大数量的输入，更多的输入意味着更低的 RSS。这里的一个重要观点是，添加特征总是会降低 RSS！此外，它总是会增加 R-squared。我们可以添加一个完全不相关的特征，比如洛杉矶湖人队的胜利次数，RSS 会降低，R-squared 会增加。这个数量可能非常小，但确实存在。因此，我们需要一个有效的方法来正确选择相关特征。

对于特征选择，在本章中我们将讨论四种统计方法：赤池信息量准则（AIC）、马尔可夫 Cp 准则（Cp）、贝叶斯信息准则（BIC）和调整后的 R-squared。对于前三种，目标是使统计量的值最小化；对于调整后的 R-squared，目标是使统计量的值最大化。这些统计量的目的是创建尽可能简约的模型，换句话说，就是惩罚模型复杂性。

这四个统计量的公式如下：

在线性模型中，AIC和Cp是成比例的，所以我们只关注Cp，它遵循leaps包中的输出。BIC倾向于选择比Cp变量更少的模型，因此我们将比较两者。为此，我们可以创建并分析两个并排的图。让我们先对Cp进行操作，然后是BIC，以下代码片段将帮助我们：

    > par(mfrow = c(1,2))

    > plot(best.summary$cp, xlab = "number of 
       features", ylab = "cp")

    > plot(sub.fit, scale = "Cp")

前一个代码片段的输出如下：

在左侧的图中，具有三个特征的模型具有最低的cp。右侧的图显示了提供最低Cp的特征。阅读这个图的方法是选择 y 轴顶部的最低Cp值，即1.2。然后，向右移动并查看对应于 x 轴的彩色方块。这样做，我们看到APSLAKE、OPRC和OPSLAKE是包含在这个特定模型中的特征。通过使用which.min()和which.max()函数，我们可以确定cp与 BIC 和调整后的 R-squared 的比较：

    > which.min(best.summary$bic)
    [1] 3

    > which.max(best.summary$adjr2)
    [1] 3

在这个例子中，BIC 和调整后的 R-squared 与最优模型的Cp相匹配。现在，就像多元回归一样，我们需要检查模型并测试假设。我们将通过创建一个线性模型对象并检查与之前相同的图来完成这项工作，如下所示：

    > best.fit <- lm(BSAAM ~ APSLAKE + OPRC + OPSLAKE, 
      data = 
      socal.water)

    > summary(best.fit)
    Call:
    lm(formula = BSAAM ~ APSLAKE + OPRC + OPSLAKE)

    Residuals:
       Min     1Q Median     3Q    Max
    -12964  -5140  -1252   4446  18649

    Coefficients:
    Estimate Std. Error t value Pr(>|t|) 
    (Intercept)  15424.6     3638.4   4.239 0.000133 
    ***
    APSLAKE       1712.5      500.5   3.421 0.001475 **
    OPRC          1797.5      567.8   3.166 0.002998 **
    OPSLAKE       2389.8      447.1   5.346 4.19e-06 
    ***
    ---
    Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 
      '.' 0.1 ' ' 1

    Residual standard error: 7284 on 39 degrees of 
      freedom
    Multiple R-squared:  0.9244,    Adjusted R-squared:  
      0.9185
    F-statistic: 158.9 on 3 and 39 DF,  p-value: < 
      2.2e-16

使用三特征模型，F 统计量和所有 t 检验都具有显著的 p 值。通过第一次测试后，我们可以生成我们的诊断图：

    > par(mfrow = c(2,2))

    > plot(best.fit)

前一个代码片段的输出如下：

观察图表，可以安全地假设残差具有恒定的方差，并且服从正态分布。在杠杆图中没有迹象表明需要进一步调查。

为了调查共线性问题，可以调用方差膨胀因子（VIF）统计量。VIF 是特征系数在拟合完整模型时的方差与特征系数在单独拟合时的方差之比。公式是1 / (1-R²[i])，其中R²i是我们感兴趣的特征i的 R-squared 值，通过所有其他特征进行回归。VIF 可以取的最小值是 1，这意味着完全没有共线性。没有硬性规则，但一般来说，VIF 值超过 5（或者有人说 10）表明存在问题的共线性量（James，第 101 页，2013 年）。精确值难以选择，因为没有多共线性使你的模型不可接受的硬性统计截止点。

car包中的vif()函数是生成这些值所需的所有，如下面的代码片段所示：

    > vif(best.fit)

    APSLAKE     OPRC  OPSLAKE
    1.011499 6.452569 6.444748

根据相关性分析，我们与OPRC和OPSLAKE（值大于 5）存在潜在的共线性问题并不令人惊讶。以下截图中的两个变量的图表清楚地说明了这一点：

    > plot(socal.water$OPRC, socal.water$OPSLAKE, xlab 
      = "OPRC", ylab = "OPSLAKE")

上述命令的输出如下：

解决共线性问题的简单方法是通过删除变量来消除问题，同时不损害预测能力。如果我们查看最佳子集的调整 R-squared 值，我们可以看到，APSLAKE 和 OPSLAKE 的双变量模型产生了0.90的值，而添加 OPRC 仅略微将其增加到0.92：

    > best.summary$adjr2 #adjusted r-squared values
    [1] 0.8777515 0.9001619 0.9185369 0.9168706 
      0.9146772 0.9123079

让我们来看看双变量模型并测试其假设：

    > fit.2 <- lm(BSAAM ~ APSLAKE+OPSLAKE, data = 
      socal.water)

    > summary(fit.2)

    Call:
    lm(formula = BSAAM ~ APSLAKE + OPSLAKE)

    Residuals:
              Min       1Q   Median       3Q      Max
    -13335.8  -5893.2   -171.8   4219.5  19500.2

    Coefficients:
 Estimate Std. Error t value Pr(>|t|) 
    (Intercept)  19144.9     3812.0   5.022  1.1e-05 
    ***
    APSLAKE       1768.8      553.7   3.194  0.00273 **
    OPSLAKE       3689.5      196.0  18.829  < 2e-16  
    ***
    ---
    Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 
      '.' 0.1 ' ' 1

    Residual standard error: 8063 on 40 degrees of 
      freedom
    Multiple R-squared:  0.9049,    Adjusted R-squared:  
      0.9002
    F-statistic: 190.3 on 2 and 40 DF,  p-value: < 
      2.2e-16

    > par(mfrow=c(2,2))

    > plot(fit.2)

上述代码片段的输出如下：

模型是显著的，诊断结果似乎没有引起担忧。这应该也解决了我们的共线性问题，我们可以使用vif()函数再次检查：

    > vif(fit.2)

     APSLAKE  OPSLAKE
    1.010221 1.010221

如我之前所述，我认为拟合值与残差的关系图并不令人担忧，但如果你有任何疑问，可以在 R 中正式测试误差常量方差的假设。这个测试被称为布雷斯-帕甘（BP）测试。为此，我们需要加载lmtest包，并运行一行代码。BP 测试的零假设是误差方差为零，备择假设不是零：

    > library(lmtest)

    > bptest(fit.2)

    studentized Breusch-Pagan test

    data:  fit.2
    BP = 0.0046, df = 2, p-value = 0.9977

由于p-value = 0.9977，我们没有证据拒绝零假设，即误差方差为零。测试摘要中的BP = 0.0046值是卡方值。

考虑到所有因素，似乎最佳预测模型是包含两个特征 APSALA 和 OPSALA 的模型。该模型可以解释流量径流体积变化的 90%。为了预测径流，它等于 19,145（截距）加上 APSALA 测量值的 1,769 倍加上 OPSALA 测量值的 3,690 倍。可以使用基础 R 中的拟合值和响应变量值来绘制预测值 vs. 实际值的散点图，如下所示：

    > plot(fit.2$fitted.values, socal.water$BSAAM, xlab 
     = "predicted", ylab = "actual", main = "Predicted 
       vs.Actual")

上述代码片段的输出如下：

虽然信息丰富，但 R 的基础图形不一定适合向商业伙伴展示。然而，我们可以在 R 中轻松地美化这个图形。对于这个例子，有几个用于改进图形的包可用，我将使用ggplot2。在生成图形之前，我们必须将预测值放入我们的数据框socal.water中。我还想将BSAAM重命名为Actual，并在数据框中放入一个新的向量，如下所示：

    > socal.water["Actual"] = water$BSAAM #create the 
       vector Actual

    > socal.water$Forecast = predict(fit.2) #populate 
       Forecast with the predicted values

接下来，我们将加载ggplot2包，并使用一行代码生成更美观的图形：

    > library(ggplot2)

    > ggplot(socal.water, aes(x = Forecast, y = 
       Actual)) + geom_point() + geom_smooth(method = 
          lm) + labs(title = "Forecast versus Actuals")

输出如下：

在继续之前，让我们考察一种最终模型选择技术。在接下来的章节中，我们将详细讨论交叉验证。交叉验证是模型选择和测试中广泛使用且有效的方法。为什么这有必要呢？这归结于偏差-方差权衡。赖特州立大学的 Tarpey 教授对这个主题有一个很好的引用：

“我们经常使用回归模型来预测未来的观测值。我们可以使用我们的数据来拟合模型。然而，使用估计模型时使用的相同数据来评估模型的好坏是作弊行为——这往往会给出过于乐观的结果，关于模型预测未来观测值的能力。如果我们省略一个观测值，拟合模型然后预测省略的响应，这将给出一个更少偏差的想法，关于模型预测能力的好坏。”

在前引引用中，Tarpey 教授讨论的交叉验证技术被称为留一法交叉验证（LOOCV）。在线性模型中，你可以通过检查预测误差*方和（PRESS）统计量，选择具有最低值的模型来轻松执行 LOOCV。R 库MPV会为你计算这个统计量，如下所示：

    > library(MPV) 

    > PRESS(best.fit) 
    [1] 2426757258 

    > PRESS(fit.2) 
    [1] 2992801411

仅凭这个统计量，我们就可以选择我们的最佳拟合模型。然而，如前所述，我认为在这种情况下，更简约的模型更好。你可以构建一个简单的函数来计算这个统计量，利用以下代码中所示的一些优雅的矩阵代数：

    > PRESS.best = sum((resid(best.fit)/(1 - 
       hatvalues(best.fit)))²) 

    > PRESS.fit.2 = sum((resid(fit.2)/(1  -
       hatvalues(fit.2)))²)

    > PRESS.best 
    [1] 2426757258 

    > PRESS.fit.2 
    [1] 2992801411

“什么是hatvalues？”你可能会问。嗯，如果我们考虑我们的线性模型 Y = B0 + B1x + e，我们可以将其转换为矩阵表示：Y = XB + E。在这个表示法中，Y保持不变，X是输入值的矩阵，B是系数，而E代表误差。这个线性模型求解B的值。不深入矩阵乘法的痛苦细节，回归过程产生了一个被称为帽子矩阵的结果。这个矩阵映射，或者说有些人说是投影，你的模型计算值到实际值；因此，它捕捉了特定观察在你模型中的影响力。所以，残差*方和除以 1 减去hatvalues与 LOOCV 相同。

其他线性模型考虑因素

在继续之前，我们需要讨论两个额外的线性模型主题。第一个是包含定性特征，第二个是交互项；这两个主题将在以下章节中解释。

定性特征

一个定性特征，也称为因子，可以具有两个或更多级别，例如男性/女性或差/中性/好。如果我们有一个具有两个级别的特征，比如说性别，那么我们可以创建一个所谓的指示符或虚拟特征，任意地将一个级别分配为0，另一个分配为1。如果我们只创建一个指示符模型，我们的线性模型仍然遵循之前的公式，即Y = B0 + B1x + e。如果我们把特征编码为男性等于 0，女性等于 1，那么男性的期望值就只是截距B0，而女性的期望值就是B0 + B1x。在你有特征超过两个级别的情况下，你可以创建 n-1 个指示符；所以，对于三个级别，你会有两个指示符。如果你创建了与级别一样多的指示符，你就会陷入虚拟变量陷阱，这会导致完美的多重共线性。

我们可以通过一个简单的例子来学习如何解释输出。让我们加载ISLR包，并使用以下代码片段使用Carseats数据集构建一个模型：

    > library(ISLR)

    > data(Carseats)

    > str(Carseats)

    'data.frame':   400 obs. of  11 variables:
    $ Sales      : num  9.5 11.22 10.06 7.4 4.15 ...
    $ CompPrice  : num  138 111 113 117 141 124 115 136 
       132 132 ...
    $ Income     : num  73 48 35 100 64 113 105 81 110 
       113 ...
    $ Advertising: num  11 16 10 4 3 13 0 15 0 0 ...
    $ Population : num  276 260 269 466 340 501 45 425 
       108 131 ...
    $ Price      : num  120 83 80 97 128 72 108 120 124        
       124 ...
    $ ShelveLoc  : Factor w/ 3 levels 
       "Bad","Good","Medium": 1 2 3 3 1 
      1 3 2 3 3 ...
    $ Age        : num  42 65 59 55 38 78 71 67 76 76 
      ...
    $ Education  : num  17 10 12 14 13 16 15 10 10 17 
      ...
    $ Urban      : Factor w/ 2 levels "No","Yes": 2 2 2 
      2 2 1 2 2 1 1 
      ...
    $ US         : Factor w/ 2 levels "No","Yes": 2 2 2 
      2 1 2 1 2 1 2 
      ..

对于这个例子，我们将仅使用Advertising（广告），一个定量特征和定性特征ShelveLoc（货架位置），它是一个有三个级别的因子：Bad（差），Good（好）和Medium（中等）来预测Carseats的销售。对于因子，R 会自动为分析编码指示符。我们按照以下方式构建和分析模型：

    > sales.fit <- lm(Sales ~ Advertising + ShelveLoc, 
       data = Carseats)

    > summary(sales.fit)

    Call:
    lm(formula = Sales ~ Advertising + ShelveLoc, data = 
    Carseats)

    Residuals:
        Min      1Q  Median      3Q     Max
    -6.6480 -1.6198 -0.0476  1.5308  6.4098

    Coefficients:
 Estimate Std. Error t value Pr(>|t|) 
    (Intercept)      4.89662    0.25207  19.426  < 2e-
      16 ***
    Advertising      0.10071    0.01692   5.951 5.88e-
      09 ***
    ShelveLocGood    4.57686    0.33479  13.671  < 2e-
      16 ***
    ShelveLocMedium  1.75142    0.27475   6.375 5.11e-
      10 ***
    ---
    Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 
      '.' 0.1 ' ' 1

    Residual standard error: 2.244 on 396 degrees of 
      freedom
    Multiple R-squared:  0.3733,    Adjusted R-squared:  
      0.3685
    F-statistic: 78.62 on 3 and 396 DF,  p-value: < 
      2.2e-16

如果货架位置是好的，给定截距4.89662，销售估计几乎是位置差时的两倍。要查看 R 如何编码指示符特征，你可以使用contrasts()函数：

    > contrasts(Carseats$ShelveLoc)

            Good Medium
    Bad       0      0
    Good      1      0
    Medium    0      1

交互项

在 R 中，交互项同样容易编码。如果某个特征对预测的影响取决于另一个特征的价值，则两个特征之间存在交互。这遵循以下公式：Y = B0 + B1x + B2x + B1B2x + e。一个例子可以在MASS包中的Boston数据集中找到。响应是中值房屋价值，输出中的medv。我们将使用两个特征：低社会经济地位房屋的百分比，称为lstat，以及房屋的年龄（以年为单位），在以下输出中称为age：

    > library(MASS)

    > data(Boston)

    > str(Boston)

    'data.frame':   506 obs. of  14 variables:
    $ crim   : num  0.00632 0.02731 0.02729 0.03237 
       0.06905 ...
    $ zn     : num  18 0 0 0 0 0 12.5 12.5 12.5 12.5 
       ...
    $ indus  : num  2.31 7.07 7.07 2.18 2.18 2.18 7.87 
       7.87 7.87 7.87 
      ...
    $ chas   : int  0 0 0 0 0 0 0 0 0 0 ...
    $ nox    : num  0.538 0.469 0.469 0.458 0.458 0.458 
      0.524 0.524 
      0.524 0.524 ...
    $ rm     : num  6.58 6.42 7.18 7 7.15 ...
    $ age    : num  65.2 78.9 61.1 45.8 54.2 58.7 66.6 
      96.1 100 85.9 
      ...
    $ dis    : num  4.09 4.97 4.97 6.06 6.06 ...
    $ rad    : int  1 2 2 3 3 3 5 5 5 5 ...
    $ tax    : num  296 242 242 222 222 222 311 311 311 
      311 ...
    $ ptratio: num  15.3 17.8 17.8 18.7 18.7 18.7 15.2 
      15.2 15.2 15.2 
      ...
    $ black  : num  397 397 393 395 397 ...
    $ lstat  : num  4.98 9.14 4.03 2.94 5.33 ...
    $ medv   : num  24 21.6 34.7 33.4 36.2 28.7 22.9 
      27.1 16.5 18.9 ...

在代码中使用lm()函数和feature1feature2*将两个特征及其交互项都放入模型中，如下所示：

    > value.fit <- lm(medv ~ lstat * age, data = 
      Boston)

    > summary(value.fit)

    Call:
    lm(formula = medv ~ lstat * age, data = Boston)

    Residuals:
        Min      1Q  Median      3Q     Max
    -15.806  -4.045  -1.333   2.085  27.552

    Coefficients:
 Estimate Std. Error t value Pr(>|t|) 
    (Intercept) 36.0885359  1.4698355  24.553  < 2e-16 
      ***
    lstat       -1.3921168  0.1674555  -8.313 8.78e-16 
      ***
    age         -0.0007209  0.0198792  -0.036   0.9711 
    lstat:age    0.0041560  0.0018518   2.244   0.0252 
      * 
    ---
    Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 
      '.' 0.1 ' ' 1

    Residual standard error: 6.149 on 502 degrees of 
      freedom
    Multiple R-squared:  0.5557,    Adjusted R-squared:  
      0.5531
    F-statistic: 209.3 on 3 and 502 DF,  p-value: < 
      2.2e-16

检查输出，我们可以看到，尽管社会经济地位是一个高度预测的特征，但房屋的年龄并不是。然而，这两个特征有一个显著的交互作用，可以正解释房屋价值。

摘要

在机器学习的背景下，我们训练一个模型并对其进行测试，以预测或预报一个结果。在本章中，我们深入探讨了线性回归这一简单而极其有效的方法，用于预测定量响应。后续章节将涵盖更多高级技术，但其中许多只是本章所学内容的扩展。我们讨论了不直观检查数据集，而仅仅依赖统计数据来指导模型选择的问题。

只需几行代码，你就可以做出强大而有洞察力的预测，以支持决策。这不仅简单有效，而且你还可以包括特征之间的定量变量和交互项。实际上，这是任何深入研究机器学习世界的人都必须掌握的方法。

第三章：逻辑回归和判别分析

"这个世界的真正逻辑是概率论。"

詹姆斯·克拉克·麦克斯韦，苏格兰物理学家

在上一章中，我们探讨了使用普通最小二乘法（OLS）来预测定量结果，换句话说，就是线性回归。现在是时候转换一下方向，看看我们如何开发算法来预测定性结果。这样的结果变量可以是二元的（男性与女性，购买与未购买，良性肿瘤与恶性肿瘤）或多项式分类（教育水*或眼睛颜色）。无论感兴趣的结果是二元还是多项式，分析师的任务是预测观察值属于结果变量特定类别的概率。换句话说，我们开发算法是为了对观察值进行分类。

为了开始探索分类问题，我们将讨论为什么应用 OLS 线性回归不是正确的技术，以及本章介绍的计算算法如何解决这些问题。然后，我们将研究一个预测活检肿瘤是否为良性或恶性的问题。数据集是众所周知的、广泛可用的威斯康星乳腺癌数据。为了解决这个问题，我们将首先构建和解释逻辑回归模型。我们还将开始研究选择特征和最合适的模型的方法。接下来，我们将讨论线性判别分析和二次判别分析，并将它们与逻辑回归进行比较和对比。然后，我们将基于乳腺癌数据构建预测模型。最后，我们将通过查看多元回归样条和选择最佳整体算法的方法来总结，以解决手头的问题。这些方法（创建测试/训练数据集和交叉验证）将为后续章节中更高级的机器学习方法奠定基础。

分类方法和线性回归

那么，为什么我们不能直接使用我们在上一章中学到的最小二乘回归方法来处理一个定性结果呢？嗯，实际上你可以这样做，但风险自负。让我们假设一下，你有一个你试图预测的结果，它有三个不同的类别：轻微、中度和严重。你和你的同事也假设轻微和中度以及中度和严重之间的差异是一个等效的度量，并且是线性关系。你可以创建一个虚拟变量，其中 0 代表轻微，1 代表中度，2 代表严重。如果你有理由相信这一点，那么线性回归可能是一个可接受的解决方案。然而，像之前那样的定性评估可能会带来高水*的测量误差，这可能会偏误 OLS。在大多数商业问题中，没有科学上可接受的方法将定性响应转换为定量响应。如果你有一个有两种结果（比如失败和通过）的响应呢？再次，使用虚拟变量方法，我们可以将失败结果编码为0，通过结果编码为1。使用线性回归，我们可以构建一个模型，其中预测值是观察通过或失败的概率。然而，模型中Y的估计很可能会超过[0,1]的概率约束，因此解释起来可能有些困难。

逻辑回归

如前所述，我们的分类问题最好用受限于0和1的概率来建模。我们可以用许多不同的函数来做所有观察，但在这里我们将专注于逻辑函数。逻辑回归中使用的逻辑函数如下：

如果你曾经在对赛马或世界杯的友好赌注中下注，你可能更了解赔率的概念。逻辑函数可以通过以下公式转换为赔率：概率（Y）/ 1 - 概率（Y）。例如，如果巴西赢得世界杯的概率是 20%，那么赔率是0.2 / 1 - 0.2，等于0.25，这相当于四分之一赔率。

要将赔率转换回概率，将赔率除以一个加上的赔率。因此，世界杯的例子是0.25 / 1 + 0.25，等于 20%。此外，让我们考虑一下赔率比。假设德国赢得奖杯的赔率是0.18。我们可以用赔率比来比较巴西和德国的赔率。在这个例子中，赔率比将是巴西赔率除以德国赔率。我们最终会得到一个赔率比等于0.25/0.18，等于1.39。在这里，我们将说巴西赢得世界杯的可能性比德国高1.39倍。

一种看待逻辑回归与线性回归之间关系的方法是将逻辑回归表示为对数几率或 log (P(Y)/1 - P(Y)) 等于 Bo + B1x。系数是通过最大似然估计而不是 OLS 来估计的。最大似然背后的直觉是我们正在计算 Bo 和 B1 的估计值，这将创建一个预测概率，该概率与实际观察到的 Y 的结果尽可能接*，这被称为似然。R 语言所做的与其它软件包对最大似然所做的相同，即找到最大化似然的 beta 值的最佳组合。

考虑到这些事实，逻辑回归是一种非常强大的技术，可以预测涉及分类的问题，并且通常是此类问题建模的起点。因此，在本章中，我们将首先使用逻辑回归来处理即将到来的业务问题。

业务理解

威斯康星大学的威廉·H·沃尔伯格博士于 1990 年委托收集了威斯康星乳腺癌数据。他收集数据背后的目标是确定肿瘤活检是否为恶性。他的团队使用 细针穿刺活检 (FNA) 收集样本。如果医生通过检查或影像学检查发现异常组织区域，则下一步是收集活检。FNA 是一种相对安全的组织收集方法，并发症很少。病理学家检查活检并试图确定诊断（恶性或良性）。正如你可以想象的那样，这不是一个微不足道的结论。良性乳腺癌并不危险，因为没有风险使异常生长扩散到身体的其他部位。如果良性肿瘤足够大，可能需要进行手术来移除它。另一方面，恶性肿瘤需要医疗干预。治疗水*取决于许多因素，但最可能的是需要手术，随后可能是放疗和/或化疗。

因此，误诊的后果可能是广泛的。对恶性的误诊可能导致昂贵且不必要的治疗，使患者承受巨大的情感和身体负担。另一方面，误诊可能导致患者得不到他们需要的治疗，使癌细胞扩散，导致过早死亡。对乳腺癌患者的早期治疗干预可以大大提高他们的生存率。

因此，我们的任务就是开发出最好的诊断机器学习算法，以便协助患者的医疗团队确定肿瘤是否为恶性。

数据理解和准备

这个数据集包含来自 699 名患者的组织样本。它在一个包含 11 个变量的数据框中，如下所示：

ID: 样本代码号
V1: 厚度
V2: 细胞大小的均匀性
V3: 细胞形状的均匀性
V4: 边缘粘附
V5: 单个上皮细胞大小
V6: 裸核（16 个观测值缺失）
V7: *滑染色质
V8: 正常核仁
V9: 有丝分裂
class: 肿瘤诊断是否为良性或恶性；这是我们试图预测的结果

医疗团队已经对九个特征在每个1到10的量表上进行了评分和编码。

数据框在 R 的MASS包下以biopsy名称可用。为了准备这些数据，我们将加载数据框，确认结构，将变量重命名为有意义的名称，并删除缺失的观测值。到这一点，我们可以开始从视觉上探索数据。以下是当我们首次加载库和数据集时将开始的代码；使用str()函数，我们将检查数据的底层结构：

    > library(MASS)
    > data(biopsy)
    > str(biopsy)
    'data.frame':   699 obs. of  11 variables:
     $ ID   : chr  "1000025" "1002945" "1015425" 
       "1016277" ...
     $ V1   : int  5 5 3 6 4 8 1 2 2 4 ...
     $ V2   : int  1 4 1 8 1 10 1 1 1 2 ...
     $ V3   : int  1 4 1 8 1 10 1 2 1 1 ...
     $ V4   : int  1 5 1 1 3 8 1 1 1 1 ...
     $ V5   : int  2 7 2 3 2 7 2 2 2 2 ...
     $ V6   : int  1 10 2 4 1 10 10 1 1 1 ...
     $ V7   : int  3 3 3 3 3 9 3 3 1 2 ...
     $ V8   : int  1 2 1 7 1 7 1 1 1 1 ...
     $ V9   : int  1 1 1 1 1 1 1 1 5 1 ...
     $ class: Factor w/ 2 levels "benign","malignant": 1 1 1 1 1 2 1 1 
     1 1 ...

检查数据结构显示，我们的特征是整数，结果是一个因子。不需要将数据转换为不同的结构。

我们现在可以删除ID列，如下所示：

 > biopsy$ID = NULL

接下来，我们将重命名变量并确认代码是否按预期工作：

 > names(biopsy) <- c("thick", "u.size", "u.shape", 
        "adhsn", "s.size", "nucl",    "chrom", "n.nuc", 
            "mit", "class")
 > names(biopsy)
 [1] "thick"   "u.size"  "u.shape" "adhsn"   
        "s.size"  "nucl" "chrom"   "n.nuc"
 [9] "mit"     "class"

现在，我们将删除缺失的观测值。由于只有 16 个观测值带有缺失数据，它们只占所有观测值的 2%，因此可以安全地删除它们。如何处理缺失数据的详细讨论超出了本章的范围，已在附录 A，“R 基础”，中包含，我在那里介绍了数据处理。在删除这些观测值时，将创建一个新的工作数据框。一行代码通过na.omit函数完成这个技巧，该函数删除所有缺失的观测值：

    > biopsy.v2 <- na.omit(biopsy)

根据你使用的 R 包来分析数据，结果需要是数值型，即0或1。为了满足这一要求，创建变量y，其中良性为0，恶性为1，如以下所示使用ifelse()函数：

 > y <- ifelse(biopsy$class == "malignant", 1, 0)

在分类问题中，我们可以通过多种方式直观地理解数据，我认为这很大程度上取决于个人喜好。在这些情况下，我喜欢做的事情之一是检查由分类结果分割的特征的箱线图。这是一种理解哪些特征可能对算法很重要的极好方式。箱线图是一种简单的方法，可以一眼看出数据的分布。根据我的经验，这还为你提供了一个有效的方式来构建你将向客户展示的演示故事。快速完成这项任务有多种方法，lattice和ggplot2包在这方面做得相当不错。在这种情况下，我将使用ggplot2，并附加reshape2包。在加载这些包之后，你需要使用melt()函数创建一个数据框。这样做的原因是，熔化特征将允许创建一个箱线图矩阵，使我们能够轻松地进行以下视觉检查：

    > library(reshape2)
    > library(ggplot2)

以下代码通过它们的值将数据熔化成一个整体特征，并按类别分组：

    > biop.m <- melt(biopsy.v2, id.var = "class")

通过ggplot2的魔力，我们可以创建一个 3x3 的箱线图矩阵，如下所示：

    > ggplot(data = biop.m, aes(x = class, y = value)) 
    + geom_boxplot() + facet_wrap(~ variable, ncol = 3)

以下代码的输出如下：

我们如何解释箱线图？首先，在前面的截图上，粗白框构成了数据的上四分位数和下四分位数；换句话说，所有观察值的一半都落在粗白框区域内。穿过框的深色线是中位数。从框延伸出来的线也是四分位数，终止于最大值和最小值，不考虑异常值。黑色点构成了异常值。

通过检查图表并应用一些判断，很难确定哪些特征将在我们的分类算法中很重要。然而，鉴于中位数值和相应分布的分离，我认为可以安全地假设核特征将很重要。相反，似乎有很少的类别的有丝分裂特征分离，它可能是一个无关紧要的特征。我们将拭目以待！

由于所有特征都是定量数据，我们也可以像在线性回归中做的那样进行相关性分析。与逻辑回归的共线性可能会像我们在线性回归中讨论的那样，对我们的估计产生偏差。让我们加载corrplot包，并像上一章那样检查相关性，这次使用不同类型的相关性矩阵，该矩阵在同一图表中既有阴影椭圆又有相关性系数，如下所示：

    > library(corrplot)
    > bc <- cor(biopsy.v2[, 1:9]) #create an object of 
       the features
    > corrplot.mixed(bc)

以下代码的输出如下：

相关系数表明我们可能存在共线性问题，特别是那些具有统一形状和统一大小的特征。作为逻辑回归建模过程的一部分，我们需要像线性回归那样进行 VIF 分析。数据准备的最后任务是创建我们的train和test数据集。从原始数据集中创建两个不同的数据集的目的是为了提高我们准确预测先前未使用或未见过的数据的能力。

在本质上，在机器学习中，我们不应该过于关注我们如何预测当前的观测值，而应该更多地关注我们如何预测那些未被用于创建算法的观测值。因此，我们可以使用训练数据创建和选择最佳算法，以最大化我们在test集上的预测。我们将在本章中构建的模型将根据这一标准进行评估。

有许多方法可以将我们的数据按比例分成train和test集：50/50、60/40、70/30、80/20 等等。你选择的数据分割应该基于你的经验和判断。对于这个练习，我将使用 70/30 的分割，如下所示：

    > set.seed(123) #random number generator
    > ind <- sample(2, nrow(biopsy.v2), replace = TRUE, 
       prob = c(0.7, 0.3))
    > train <- biopsy.v2[ind==1, ] #the training data 
       set
    > test <- biopsy.v2[ind==2, ] #the test data set
    > str(test) #confirm it worked
    'data.frame':   209 obs. of  10 variables:
     $ thick  : int  5 6 4 2 1 7 6 7 1 3 ...
     $ u.size : int  4 8 1 1 1 4 1 3 1 2 ...
     $ u.shape: int  4 8 1 2 1 6 1 2 1 1 ...
     $ adhsn  : int  5 1 3 1 1 4 1 10 1 1 ...
     $ s.size : int  7 3 2 2 1 6 2 5 2 1 ...
     $ nucl   : int  10 4 1 1 1 1 1 10 1 1 ...
     $ chrom  : int  3 3 3 3 3 4 3 5 3 2 ...
     $ n.nuc  : int  2 7 1 1 1 3 1 4 1 1 ...
     $ mit    : int  1 1 1 1 1 1 1 4 1 1 ...
     $ class  : Factor w/ 2 levels benign","malignant": 
       1 1 1 1 1 2 1 
       2 1 1 ...

为了确保我们在两个数据集之间有一个*衡的因变量，我们将执行以下检查：

    > table(train$class)
       benign malignant
          302       172
    > table(test$class)
       benign malignant
          142        67

这是我们两个数据集结果的合理比率；有了这个比率，我们可以开始建模和评估。

建模和评估

在这个过程的部分，我们将从一个包含所有输入变量的逻辑回归模型开始，然后缩小到最佳子集的特征。之后，我们将尝试判别分析和多元自适应回归样条（MARS）。

逻辑回归模型

我们已经讨论了逻辑回归背后的理论，因此我们可以开始拟合我们的模型。R 安装包自带了glm()函数，用于拟合广义线性模型，其中包括逻辑回归。代码语法与我们之前章节中使用的lm()函数类似。一个很大的不同之处在于，我们必须在函数中使用family = binomial参数，这告诉 R 运行逻辑回归方法而不是其他广义线性模型的版本。我们将首先创建一个包含train集上所有特征的模型，并查看它在test集上的表现，如下所示：

    > full.fit <- glm(class ~ ., family = binomial, 
      data = train)
    > summary(full.fit)
    Call:
    glm(formula = class ~ ., family = binomial, data = 
      train) 
    Deviance Residuals:
    Min       1Q   Median       3Q      Max 
    -3.3397  -0.1387  -0.0716   0.0321   2.3559 
    Coefficients:
    Estimate Std. Error z value Pr(>|z|) 
    (Intercept)  -9.4293     1.2273  -7.683 1.55e-14 
      ***
    thick         0.5252     0.1601   3.280 0.001039 **
    u.size       -0.1045     0.2446  -0.427 0.669165 
    u.shape       0.2798     0.2526   1.108 0.268044 
    adhsn         0.3086     0.1738   1.776 0.075722 . 
    s.size        0.2866     0.2074   1.382 0.167021 
    nucl          0.4057     0.1213   3.344 0.000826 
      ***
    chrom         0.2737     0.2174   1.259 0.208006 
    n.nuc         0.2244     0.1373   1.635 0.102126 
    mit           0.4296     0.3393   1.266 0.205402 
    ---
    Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 
      '.' 0.1 ' ' 1
    (Dispersion parameter for binomial family taken to 
       be 1)
        Null deviance: 620.989  on 473  degrees of 
       freedom
    Residual deviance:  78.373  on 464  degrees of 
       freedom
    AIC: 98.373
    Number of Fisher Scoring iterations: 8

summary()函数允许我们检查系数及其 p 值。我们可以看到只有两个特征的 p 值小于0.05（厚度和核）。我们可以使用confint()函数来检查 95%置信区间，如下所示：

    > confint(full.fit)
                       2.5 %     97.5 %
    (Intercept) -12.23786660 -7.3421509
    thick         0.23250518  0.8712407
    u.size       -0.56108960  0.4212527
    u.shape      -0.24551513  0.7725505
    adhsn        -0.02257952  0.6760586
    s.size       -0.11769714  0.7024139
    nucl          0.17687420  0.6582354
    chrom        -0.13992177  0.7232904
    n.nuc        -0.03813490  0.5110293
    mit          -0.14099177  1.0142786

注意，两个显著特征的有信心区间没有穿过零。你不能像在逻辑回归中翻译系数那样翻译系数，因为Y的变化是基于X的一个单位变化。这就是为什么优势比可以非常有帮助。对数函数的 beta 系数可以通过指数（beta）转换为优势比。

为了在 R 中生成优势比，我们将使用以下exp(coef())语法：

    > exp(coef(full.fit))
     (Intercept)        thick       u.size      u.shape        
     adhsn
    8.033466e-05 1.690879e+00 9.007478e-01 1.322844e+00 
     1.361533e+00
   s.size         nucl        chrom        n.nuc  mit
   1.331940e+00 1.500309e+00 1.314783e+00 1.251551e+00 
    1.536709e+00

优势比的解释是特征单位变化导致的结果优势的变化。如果值大于 1，这表明随着特征的增加，结果的优势增加。相反，一个小于 1 的值意味着随着特征的增加，结果的优势减少。在这个例子中，除了u.size之外的所有特征都会增加对数优势。

在数据探索期间指出的问题之一是多共线性的潜在问题。我们可以用以下方式在逻辑模型中生成我们在线性回归中生成的 VIF 统计量：

    > library(car)
    > vif(full.fit)
       thick  u.size  u.shape  adhsn   s.size   nucl   
      chrom   n.nuc
     1.2352 3.2488  2.8303   1.3021  1.6356   1.3729 
       1.5234  1.3431
       mit
    1.059707

没有任何一个值大于 VIF 经验法则的五个标准，所以共线性似乎不是问题。特征选择将是下一个任务；但，现在，让我们编写一些代码来查看这个模型在train和test集上的表现如何。

你首先需要创建一个预测概率的向量，如下所示：

    > train.probs <- predict(full.fit, type = 
       "response")
    > train.probs[1:5] #inspect the first 5 predicted 
        probabilities
    [1] 0.02052820 0.01087838 0.99992668 0.08987453 
        0.01379266

接下来，我们需要评估模型在训练中的表现，然后评估它在测试集中的拟合度。快速做到这一点的一种方法就是生成一个混淆矩阵。在后面的章节中，我们将检查caret包提供的版本。InformationValue包也提供了一个版本。这里我们需要结果为 0 和 1。函数选择良性或恶性的默认值是 0.50，也就是说，任何概率在 0.50 或以上的都被分类为恶性：

 > trainY <- y[ind==1]
 > testY <- y[ind==2]
 > confusionMatrix(trainY, train.probs)
 0    1
 0 294    7
 1   8  165

行表示预测，列表示实际值。对角线元素是正确的分类。右上角的值7是假阴性的数量，左下角的值8是假阳性的数量。我们还可以查看错误率，如下所示：

 > misClassError(trainY, train.probs)
 [1] 0.0316

我们似乎在训练集上做得相当不错，只有3.16%的错误率。正如我们之前讨论的，我们必须能够准确预测未见数据，换句话说，我们的test集。

为test集创建混淆矩阵的方法与我们为训练数据所做的方法类似：

    > test.probs <- predict(full.fit, newdata = test, 
       type = "response")
    > misClassError(testY, test.probs)
    [1] 0.0239
    > confusionMatrix(testY, test.probs)
        0    1
    0 139    2
    1   3   65

看起来我们在创建一个具有所有功能的模型方面做得相当不错。大约 98%的预测准确率相当令人印象深刻。然而，我们仍然需要检查是否还有改进的空间。想象一下，如果你或你的亲人被错误地诊断了。正如之前提到的，其影响可能相当严重。考虑到这一点，也许有更好的方法来创建一个分类算法？让我们看看吧！

带有交叉验证的逻辑回归

交叉验证的目的是提高我们对测试集的预测，并最小化过拟合的机会。在K 折交叉验证中，数据集被分成 K 个大小相等的部分。算法通过交替地保留一个K-集来学习；它将模型拟合到其他K-1 部分，并为遗漏的 K 集获得预测。然后*均这些结果以最小化误差，并选择适当的特征。你也可以执行留一法交叉验证（LOOCV）方法，其中 K 等于 1。模拟表明，LOOCV 方法可以有*均估计值，其方差较高。因此，大多数机器学习专家会建议 K 折数应该是 5 或 10。

一个自动为逻辑回归执行CV的 R 包是bestglm包。此包依赖于我们用于线性回归的leaps包。数据的语法和格式需要一些注意，让我们详细说明这一点：

    > library(bestglm)
    Loading required package: leaps

在加载包之后，我们需要将我们的结果编码为0或1。如果保留为因子，则不会工作。要使用该包的另一个要求是，你的结果或y是最后一列，并且所有无关的列都已删除。以下代码将为我们创建一个新的数据框：

 > X <- train[, 1:9]
 > Xy <- data.frame(cbind(X, trainY))

下面是运行代码以使用我们的数据中的CV技术：

    > bestglm(Xy = biopsy.cv, IC="CV", 
      CVArgs=list(Method="HTF", K=10, 
      REP=1), family=binomial)

语法Xy = Xy指向我们正确格式化的数据框。IC = "CV"告诉包使用的信息标准是交叉验证。CVArgs是我们想要使用的CV参数。HTF方法是 K 折，后面跟着折数，K = 10，我们要求它只进行一次随机折叠的迭代，REP = 1。就像glm()一样，我们还需要使用family = binomial。顺便说一下，你也可以通过指定family = gaussian使用bestglm进行线性回归。因此，在运行分析后，我们将得到以下输出，给出最佳模型的三个特征，例如thick、u.size和nucl。关于Morgan-Tatar 搜索的陈述仅仅意味着对所有可能的子集进行了简单的穷举搜索，如下所示：

    Morgan-Tatar search since family is non-gaussian.
    CV(K = 10, REP = 1)
    BICq equivalent for q in (7.16797006619085e-05, 
    0.273173435514231)
    Best Model:
    Estimate Std. Error   z value     Pr(>|z|)
    (Intercept) -7.8147191 0.90996494 -8.587934 
     8.854687e-18
    thick        0.6188466 0.14713075  4.206100 
     2.598159e-05
    u.size       0.6582015 0.15295415  4.303260 
     1.683031e-05
    nucl         0.5725902 0.09922549  5.770596 
     7.899178e-09

我们可以将这些特征放入glm()中，然后看看模型在测试集上的表现如何。predict()函数与bestglm不兼容，所以这是一个必要的步骤：

    > reduce.fit <- glm(class ~ thick + u.size + nucl, 
       family = binomial, data = train)

如前所述，以下代码允许我们在测试集上比较预测标签与实际标签：

    > test.cv.probs <- predict(reduce.fit, newdata = 
       test, type = "response")
    > misClassError(testY, test.cv.probs)
    [1] 0.0383
    > confusionMatrix(testY, test.cv.probs)
        0    1
    0 139    5
    1   3   62

减少特征模型略逊于完整特征模型，但并非全然无望。我们可以再次利用bestglm包，这次使用最佳子集，将信息标准设置为BIC：

    > bestglm(Xy = Xy, IC = "BIC", family = binomial)
    Morgan-Tatar search since family is non-gaussian.
    BIC
    BICq equivalent for q in (0.273173435514231, 
      0.577036596263757)
    Best Model:
     Estimate Std. Error   z value     Pr(>|z|)
    (Intercept) -8.6169613 1.03155250 -8.353391 
      6.633065e-17
    thick        0.7113613 0.14751510  4.822295 
      1.419160e-06
    adhsn        0.4537948 0.15034294  3.018398 
      2.541153e-03
    nucl         0.5579922 0.09848156  5.665956 
      1.462068e-08
    n.nuc        0.4290854 0.11845720  3.622282 
      2.920152e-04

这四个特征为所有可能的子集提供了最小的BIC分数。让我们尝试一下，看看它如何预测test集，如下所示：

    > bic.fit <- glm(class ~ thick + adhsn + nucl + 
       n.nuc, family = binomial, data = train)
    > test.bic.probs <- predict(bic.fit, newdata = 
       test, type = "response")
    > misClassError(testY, test.bic.probs)
    [1] 0.0239
    > confusionMatrix(testY, test.bic.probs)
        0    1
    0 138    1
    1   4   66

在这里我们有五个错误，就像完整模型一样。那么明显的疑问是：哪一个更好？在任何正常情况下，根据泛化能力的相等性，通常的规则是默认选择最简单或最容易解释的模型。我们可以进行完全新的分析，使用新的随机化以及train和test集之间的不同比率等。然而，让我们暂时假设我们已经用尽了逻辑回归能为我们做的极限。我们将在最后回到完整模型和我们基于BIC最小值开发的模型，并讨论模型选择的方法。现在，让我们继续我们的判别分析方法，我们也将将其作为最终建议的可能性之一。

判别分析概述

判别分析（DA），也称为费舍尔判别分析（FDA），是另一种流行的分类技术。当类别分离良好时，它可以是逻辑回归的有效替代。如果你有一个分类问题，其中结果类别分离良好，逻辑回归可能会有不稳定的估计，也就是说，置信区间很宽，估计本身可能从一个样本到另一个样本变化（James，2013）。DA 不受此问题的影响，因此可能优于逻辑回归，并且具有更广泛的泛化能力。相反，如果特征和结果变量之间存在复杂关系，它可能在分类任务上表现不佳。在我们的乳腺癌例子中，逻辑回归在测试集和训练集上表现良好，类别没有很好地分离。为了与逻辑回归进行比较，我们将探索 DA，包括线性判别分析（LDA）和二次判别分析（QDA）。

DA 利用贝叶斯定理来确定每个观察值的类别成员概率。例如，如果你有两个类别，比如良性肿瘤和恶性肿瘤，那么 DA 将计算观察值属于这两个类别的概率，并选择最高概率作为正确的类别。

贝叶斯定理指出，在给定X发生的情况下Y发生的概率等于Y和X同时发生的概率除以X发生的概率，可以表示如下：

这个表达式的分子是观察值属于该类别级别并且具有这些特征值的可能性。分母是具有这些特征值的观察值在所有级别上的可能性。再次强调，分类规则说，如果你有X和Y的联合分布，并且如果X已知，那么将观察值分配给哪个类别的最优决策是通过选择具有较大概率（后验概率）的类别。

获得后验概率的过程包括以下步骤：

收集具有已知类别成员资格的数据。
计算先验概率；这代表样本属于每个类别的比例。
通过它们的类别计算每个特征的均值。
计算每个特征的方差-协方差矩阵；如果是 LDA，那么这将是一个所有类别的汇总矩阵，给我们一个线性分类器，如果是 QDA，那么为每个类别创建的方差-协方差矩阵。
为每个类别估计正态分布（高斯密度）。
计算用于分类新对象的判别函数。
根据判别函数将观察值分配给一个类别。

这将提供关于确定后验概率的扩展说明，如下所示：

尽管 LDA 简洁优雅，但它受限于每个类别的观察值具有多元正态分布的假设，并且类别之间存在共同的协方差。QDA 仍然假设观察值来自正态分布，但它还假设每个类别都有自己的协方差。

这有什么关系呢？当你放宽了常见的协方差假设，你现在允许将二次项纳入判别分数的计算中，这在 LDA 中是不可能的。这一数学原理可能有点令人畏惧，并且超出了本书的范围。需要记住的重要部分是，QDA 比逻辑回归更灵活的技术，但我们必须牢记我们的偏差-方差权衡。使用更灵活的技术，你可能会拥有更低的偏差，但可能具有更高的方差。像许多灵活的技术一样，需要一个健壮的训练数据集来减轻高分类器的方差。

判别分析应用

LDA 在MASS包中执行，我们已经加载了它，以便我们可以访问活检数据。语法与lm()和glm()函数非常相似。

我们现在可以开始拟合我们的 LDA 模型，如下所示：

    > lda.fit <- lda(class ~ ., data = train)
    > lda.fit
    Call:
    lda(class ~ ., data = train)
    Prior probabilities of groups:
       benign malignant
    0.6371308 0.3628692
    Group means:
 thick  u.size u.shape   adhsn  s.size    nucl   
      chrom
    benign    2.9205 1.30463 1.41390 1.32450 2.11589 
      1.39735 2.08278
    malignant 7.1918 6.69767 6.68604 5.66860 5.50000 
      7.67441 5.95930
                n.nuc     mit
    benign    1.22516 1.09271
    malignant 5.90697 2.63953
    Coefficients of linear discriminants:
                    LD1
    thick    0.19557291
    u.size   0.10555201
    u.shape  0.06327200
    adhsn    0.04752757
    s.size   0.10678521
    nucl     0.26196145
    chrom    0.08102965
    n.nuc    0.11691054
    mit     -0.01665454

这个输出显示，组的先验概率大约为 64%对良性，36%对恶性。接下来是组均值。这是每个特征按其类别的*均值。线性判别系数是用于确定观察值判别分数的特征的标准化线性组合。分数越高，分类为恶性的可能性就越大。

LDA 中的plot()函数会为我们提供判别分数的直方图和/或密度，如下所示：

    > plot(lda.fit, type = "both")

以下是在先前的命令输出：

我们可以看到组之间存在一些重叠，这表明将有一些分类错误的观察值。

LDA 提供的predict()函数有三个元素：类别、后验和 x。类别元素是良性或恶性的预测，后验是 x 属于每个类别的概率分数，x 是线性判别分数。让我们只提取观察值是恶性的概率：

    > train.lda.probs <- predict(lda.fit)$posterior[, 
      2]
    > misClassError(trainY, train.lda.probs)
 [1] 0.0401
 > confusionMatrix(trainY, train.lda.probs)
 0    1
 0 296   13
 1   6  159

好吧，不幸的是，我们的 LDA 模型表现远不如逻辑回归模型。主要问题是看看它在测试数据上的表现如何：

    > test.lda.probs <- predict(lda.fit, newdata = 
       test)$posterior[, 2]
    > misClassError(testY, test.lda.probs)
    [1] 0.0383
    > confusionMatrix(testY, test.lda.probs)
        0    1
    0 140    6
    1   2   61

考虑到在训练数据上的表现较差，这实际上并没有我想象的那么糟糕。从正确分类的角度来看，它仍然没有逻辑回归（96%与逻辑回归几乎 98%）表现得那么好。

我们现在将转向拟合一个 QDA 模型。在 R 中，QDA 也是MASS包的一部分，函数是qda()。构建模型再次相当直接，我们将将其存储在一个名为qda.fit的对象中，如下所示：

    > qda.fit = qda(class ~ ., data = train) 
    > qda.fit
    Call:
    qda(class ~ ., data = train)
    Prior probabilities of groups:
       benign malignant
    0.6371308 0.3628692
    Group means:
 Thick u.size u.shape  adhsn s.size   nucl  chrom  
     n.nuc
    benign    2.9205 1.3046  1.4139 1.3245 2.1158 
      1.3973 2.0827 1.2251
    malignant 7.1918 6.6976  6.6860 5.6686 5.5000 
      7.6744 5.9593 5.9069
                   mit
    benign    1.092715
    malignant 2.639535

与 LDA 一样，输出有组均值，但没有系数，因为它是一个二次函数，如前所述。

训练和测试数据的预测遵循与 LDA 相同的代码流程：

 > train.qda.probs <- predict(qda.fit)$posterior[,          
      2]
 > misClassError(trainY, train.qda.probs)
 [1] 0.0422
 > confusionMatrix(trainY, train.qda.probs)
 0    1
 0 287    5
 1  15  167
 > test.qda.probs <- predict(qda.fit, newdata = 
      test)$posterior[, 2]
 > misClassError(testY, test.qda.probs)
 [1] 0.0526
 > confusionMatrix(testY, test.qda.probs)
 0    1
 0 132    1
 1  10   66

我们可以快速从混淆矩阵中看出，QDA 在训练数据上的表现最差，并且它对测试集的分类也很差，有 11 个预测错误。特别是，它有很高的假阳性率。

多变量自适应回归样条（MARS）

你想要一种提供以下所有功能的建模技术吗？

提供了构建回归和分类的线性和非线性模型的灵活性
可以支持变量交互项
简单易懂
需要很少的数据预处理
处理所有类型的数据：数值型、因子型等
在未见过的数据上表现良好，也就是说，它在偏差-方差权衡中做得很好

如果这一切听起来都很吸引人，那么我强烈推荐使用 MARS 模型。几个月前，这种方法引起了我的注意，我发现它的表现极其出色。事实上，在我最*的一个案例中，它在测试/验证数据上优于随机森林和提升树。它迅速成为我的基准模型，其他所有模型都是竞争对手。我看到的另一个好处是，它消除了我进行的大部分特征工程。其中很大一部分是使用证据权重（WOE）和信息值（IV）来捕捉非线性并重新编码变量。这种 WOE/IV 技术是我计划在这第二版中详细讨论的内容。然而，我已经进行了许多测试，发现 MARS 在执行这项技术（即捕捉非线性）方面做得非常出色，因此我将完全不讨论 WOE/IV。

要理解 MARS 相当简单。首先，就像我们之前讨论的那样，从一个线性或广义线性模型开始。然后，为了捕捉任何非线性关系，添加一个hinge函数。这些hinges是输入特征中的点，相当于系数的变化。例如，假设我们有Y = 12.5（我们的截距）+ 1.5（变量 1）+ 3.3（变量 2）；其中变量 1 和 2 的取值范围是 1 到 10。现在，让我们看看变量2的hinge函数如何发挥作用：

Y = 11（新的截距）+ 1.5（变量 1）+ 4.26734（max(0, 变量 2 - 5.5)

因此，我们读取hinge函数的方式是：我们取0或变量2减去 5.50中的最大值。所以，当变量2的值大于5.5*时，该值将乘以系数；否则，它将为零。该方法将适应每个变量的多个hinges以及交互项。

MARS 的另一个有趣之处在于自动变量选择。这可以通过交叉验证来完成，但默认是通过正向传递来构建模型，类似于正向逐步回归，然后通过反向传递来修剪模型，这可能导致模型在正向传递后过度拟合数据。这个反向传递会修剪输入特征并基于广义交叉验证（GCV）移除hinges：

GCV = RSS / (N * (1 - 有效参数数量 / N)²)

有效参数数量 = 输入特征数量 + 惩罚 * (输入特征数量 - 1) / 2

在earth包中，对于加性模型，惩罚 = 2，对于乘性模型，惩罚 = 3，即带有交互项的模型。

在 R 中，有很多参数可以调整。我将在示例中展示一种有效且简单的方法来实现这种方法。如果你有兴趣，你可以在斯蒂芬·米尔博沃（Stephen Milborrow）的出色在线资源earth 包笔记中了解更多关于其灵活性的信息，链接如下：

www.milbo.org/doc/earth-notes.pdf

在介绍这部分完成后，让我们开始吧。你可以使用 MDA 包，但我是在 earth 上学习的，所以这就是我将展示的内容。代码与之前的例子类似，我们使用了 glm()。然而，重要的是要指定你想要如何修剪模型，以及它是一个二项响应变量。在这里，我指定了一个五折交叉验证的模型选择（pmethod = "cv" 和 nfold = 5），重复 3 次（ncross = 3），作为一个只有加性模型而没有交互作用的模型（degree = 1）以及每个输入特征只有一个 hinge（minspan = -1）。在我处理的数据中，交互项和多个 hinge 都导致了过拟合。当然，你的结果可能会有所不同。代码如下：

 > library(earth)
 > set.seed(1)
 > earth.fit <- earth(class ~ ., data = train,
 pmethod = "cv",
 nfold = 5,
 ncross = 3,
 degree = 1,
 minspan = -1,
 glm=list(family=binomial)
 )

现在我们来检查模型摘要。一开始，可能会有些令人困惑。当然，我们有模型公式和逻辑系数，包括 hinge 函数，然后是一些与广义 R *方等相关的评论和数字。发生的情况是，首先在数据上构建了一个 MARS 模型，作为一个标准线性回归，其中响应变量被内部编码为 0 和 1。在特征/变量修剪和最终模型创建后，然后将其转换为 GLM。所以，请忽略 R *方值：

 > summary(earth.fit)
 Call: earth(formula=class~., data=train, 
      pmethod="cv",
 glm=list(family=binomial), degree=1, ncross=3, 
      nfold=5, minspan=-1)
 GLM coefficients
 malignant
 (Intercept) -6.5746417
 u.size 0.1502747
 adhsn 0.3058496
 s.size 0.3188098
 nucl 0.4426061
 n.nuc 0.2307595
 h(thick-3) 0.7019053
 h(3-chrom) -0.6927319
 Earth selected 8 of 10 terms, and 7 of 9 predictors 
      using pmethod="cv"
 Termination condition: RSq changed by less than 
      0.001 at 10 terms
 Importance: nucl, u.size, thick, n.nuc, chrom, 
      s.size, adhsn, 
      u.shape-unused,  ...
 Number of terms at each degree of interaction: 1 7 
      (additive model)
 Earth GRSq 0.8354593 RSq 0.8450554 mean.oof.RSq 
      0.8331308 (sd 0.0295)
 GLM null.deviance 620.9885 (473 dof) deviance 
      81.90976 (466 dof) 
      iters 8
 pmethod="backward" would have selected the same 
      model:
 8 terms 7 preds, GRSq 0.8354593 RSq 0.8450554 
      mean.oof.RSq 
      0.8331308

该模型给出了八个项，包括截距和七个预测因子。其中两个预测因子具有 hinge 函数——厚度和染色质。如果厚度大于 3，则 0.7019 的系数乘以该值；否则，为 0。对于染色质，如果小于 3，则系数乘以这些值；否则，为 0。

可用图表。第一个使用 plotmo() 函数生成的图表显示了当改变预测因子并保持其他因素不变时模型响应的图表。你可以清楚地看到厚度上的 hinge 函数在起作用：

 > plotmo(earth.fit)

以下为前一个命令的输出结果：

使用 plotd()，你可以看到按类别标签预测概率的密度图：

 > plotd(earth.fit)

以下为前一个命令的输出结果：

可以查看相对变量重要性。在这里我们看到变量名 nsubsets，这是在修剪传递后包含该变量的模型子集数量，而 gcv 和 rss 列显示了变量对相应值减少的贡献（gcv 和 rss 被缩放到 0 到 100）：

 > evimp(earth.fit)
 nsubsets   gcv   rss
 nucl          7 100.0 100.0
 u.size        6  44.2  44.8
 thick         5  23.8  25.1
 n.nuc         4  15.1  16.8
 chrom         3   8.3  10.7
 s.size        2   6.0   8.1
 adhsn         1   2.3   4.6

让我们看看它在测试数据集上的表现如何：

 > test.earth.probs <- predict(earth.fit, newdata = 
      test, type = "response")
 > misClassError(testY, test.earth.probs)
 [1] 0.0287
 > confusionMatrix(testY, test.earth.probs)
 0    1
 0 138    2
 1   4   65

这与我们的逻辑回归模型非常相似。我们现在可以比较模型，看看我们的最佳选择是什么。

模型选择

从所有这些工作中，我们应得出什么结论？我们有模型的混淆矩阵和错误率来指导我们，但在选择分类模型时，我们可以更加复杂。分类模型比较的有效工具是受试者工作特征（ROC）图。非常简单地说，ROC 是一种基于性能可视化、组织和选择分类器的方法（Fawcett, 2006）。在 ROC 图上，y 轴是真正率（TPR），x 轴是假正率（FPR）。以下是一些相当简单的计算：

TPR = 正确分类的阳性/总阳性

FPR = 错误分类的阴性/总阴性

绘制 ROC 结果将生成一条曲线，因此你可以生成曲线下面积（AUC）。AUC 为你提供了一个有效的性能指标，并且可以证明 AUC 等于观察者在随机选择的一对案例中正确识别阳性案例的概率，其中一对案例中一个是阳性，一个是阴性（Hanley JA & McNeil BJ, 1982）。在我们的情况下，我们将用我们的算法替换观察者，并相应地进行评估。

要在 R 中创建 ROC 图，你可以使用ROCR包。我认为这是一个非常好的包，它允许你仅用三行代码就构建一个图表。该包还有一个优秀的配套网站（包含示例和演示），可以在以下链接找到：

rocr.bioinf.mpi-sb.mpg.de/

我想要展示的是我们 ROC 图上的三个不同曲线：完整模型、使用 BIC 选择特征的简化模型、MARS 模型，以及一个不良模型。这个所谓的“不良模型”将只包含一个预测特征，并将为我们其他模型提供一个有效的对比。因此，让我们加载ROCR包，构建这个表现不佳的模型，为了简便起见，我们将其命名为bad.fit，使用thick特征：

    > library(ROCR)
    > bad.fit <- glm(class ~ thick, family = binomial, 
      data = test)
    > test.bad.probs = predict(bad.fit, type = 
      "response") #save 
      probabilities

现在可以使用test数据集，每行代码构建一个 ROC 图。我们首先创建一个保存预测概率和实际分类的对象。然后，我们将使用此对象创建另一个包含计算出的 TPR 和 FPR 的对象。然后，我们将使用plot()函数构建图表。让我们从使用所有特征的模型开始，或者，正如我所说的，完整模型。这是我们在本章的逻辑回归模型部分构建的初始模型：

    > pred.full <- prediction(test.probs, test$class)

以下是与 TPR 和 FPR 相关的性能对象：

    > perf.full <- performance(pred.full, "tpr", "fpr")

以下带有标题ROC和col=1的plot命令将线条颜色设置为黑色：

    > plot(perf.full, main = "ROC", col = 1)

前一个命令的输出如下：

如前所述，曲线代表 y 轴上的 TPR 和 x 轴上的 FPR。如果你有一个完美的分类器，没有假阳性，那么线将在 x 轴上的0.0处垂直运行。如果一个模型的表现不如随机，那么线将从左下角斜向右上角。提醒一下，完整的模型漏掉了五个标签：三个假阳性和两个假阴性。现在我们可以使用类似的代码添加其他模型进行比较，从使用 BIC 构建的模型开始（参考本章的带有交叉验证的逻辑回归部分），如下所示：

    > pred.bic <- prediction(test.bic.probs, 
      test$class)
    > perf.bic <- performance(pred.bic, "tpr", "fpr")
    > plot(perf.bic, col = 2, add = TRUE)

plot命令中的add=TRUE参数将线添加到现有的图表中。最后，我们将添加表现不佳的模型，即 MARS 模型，并包含一个legend图表，如下所示：

    > pred.bad <- prediction(test.bad.probs, 
      test$class)
    > perf.bad <- performance(pred.bad, "tpr", "fpr")
    > plot(perf.bad, col = 3, add = TRUE)
    > pred.earth <- prediction(test.earth.probs, 
      test$class)
    > perf.earth <- performance(pred.earth, "tpr", 
      "fpr")
    > plot(perf.earth, col = 4, add = TRUE)
    > legend(0.6, 0.6, c("FULL", "BIC", "BAD", 
      "EARTH"), 1:4)

以下是对前面代码片段的输出：

我们可以看到，FULL模型、BIC模型和MARS模型几乎重叠。也很明显，BAD模型的表现正如预期的那样糟糕。

我们在这里能做的最后一件事是计算 AUC。这同样是在ROCR包中通过创建一个performance对象来完成的，除了你必须用auc替换tpr和fpr。代码和输出如下：

 > performance(pred.full, "auc")@y.values
 [[1]]
 [1] 0.9972672
 > performance(pred.bic, "auc")@y.values
 [[1]]
 [1] 0.9944293
 > performance(pred.bad, "auc")@y.values
 [[1]]
 [1] 0.8962056
 > performance(pred.earth, "auc")@y.values
 [[1]]
 [1] 0.9952701

最高 AUC 是完整模型，为0.997。我们还看到 BIC 模型的百分比为99.4，坏模型的百分比为89.6，MARS 的百分比为99.5。所以，从所有意图和目的来看，除了坏模型外，我们在预测能力上没有差异。我们该怎么办？一个简单的解决方案是对train和test集重新随机化，并再次尝试这种分析，也许使用 60/40 的分割和不同的随机化种子。但如果我们得到相似的结果，那又如何呢？我认为一个统计纯粹主义者会建议选择最简约的模型，而其他人可能更倾向于包含所有变量。这归结为权衡，即模型精度与可解释性、简单性和可扩展性之间的权衡。在这种情况下，默认选择更简单的模型似乎是安全的，因为它具有相同的精度。不言而喻，我们不会总是只用 GLMs 或判别分析就能达到这种预测水*。我们将在接下来的章节中使用更复杂的技术来处理这些问题，并希望提高我们的预测能力。机器学习的美妙之处在于有几种方法可以“杀猫”。

摘要

在本章中，我们探讨了使用概率线性模型通过三种方法来预测定性响应：逻辑回归、判别分析和 MARS。此外，我们还开始了使用 ROC 图表的过程，以便从视觉和统计上探索模型选择。我们还简要讨论了您需要考虑的模型选择和权衡。在未来的章节中，我们将重新审视乳腺癌数据集，以查看更复杂的技术表现如何。

第四章：线性模型中的高级特征选择

“我发现数学对我来说变得过于抽象，而计算机科学似乎关注细节——试图在计算中节省一微秒或一千字节。在统计学中，我发现了一个结合了数学和计算机科学之美的学科，它们被用来解决现实世界的问题。”

这是由斯坦福大学的教授、Rob Tibshirani引用的：

statweb.stanford.edu/~tibs/research_page.html。

到目前为止，我们已经探讨了线性模型在定量和定性结果中的应用，重点介绍了特征选择的技术，即排除无用或不需要的预测变量的方法和技巧。我们看到线性模型在机器学习问题中非常有效。然而，在过去几十年中开发并完善的新的技术可以进一步提高预测能力和可解释性，超越我们在前几章中讨论的线性模型。在这个时代，许多数据集与观测数相比具有许多特征，这被称为高维性。如果你曾经从事过基因组学问题，这会很快变得显而易见。此外，随着我们被要求处理的数据量的大小，像最佳子集或逐步特征选择这样的技术可能需要不寻常的时间才能收敛，即使在高速计算机上也是如此。我说的不是分钟：在许多情况下，需要数小时的系统时间才能得到最佳子集解。

在这些情况下，有更好的方法。在本章中，我们将探讨正则化的概念，其中系数受到约束或缩小到零。正则化方法及其变体有很多，但我们将重点关注岭回归、最小绝对收缩和选择算子（LASSO），以及最终结合两种技术优势的弹性网络。

正则化概述

你可能还记得，我们的线性模型遵循以下形式，Y = B0 + B[1]x[1] +...B[n]x[n] + e，以及最佳拟合尝试最小化 RSS，即实际值与估计值之差的*方和，或e[1]² + e[2]² + ... e[n]²。

在正则化的过程中，我们将应用所谓的收缩惩罚，与最小化均方误差（RSS）相结合。这个惩罚包括一个 lambda（符号 λ），以及 beta 系数和权重的归一化。这些权重如何归一化在不同的技术中有所不同，我们将相应地讨论它们。简单来说，在我们的模型中，我们是在最小化 (RSS + λ(归一化系数)). 我们将在模型构建过程中选择λ，这被称为调整参数。请注意，如果 lambda 等于 0，那么我们的模型就等同于 OLS，因为归一化项被抵消了。

这对我们有什么好处，为什么它有效？首先，正则化方法在计算上非常高效。在最佳子集法中，我们正在搜索2^p 个模型，在大数据集中，这可能不可行。在 R 中，我们只针对每个 lambda 值拟合一个模型，这要高效得多。另一个原因追溯到我们的偏差-方差权衡，这在前言中已经讨论过。在线性模型中，响应和预测变量之间的关系接*线性时，最小二乘估计将具有低偏差但可能具有高方差。这意味着训练数据中的微小变化可能导致最小二乘系数估计发生大的变化（James，2013）。通过适当选择 lambda 和规范化进行正则化可以帮助你通过优化偏差-方差权衡来提高模型拟合度。最后，系数的正则化有助于解决多重共线性问题。

岭回归

让我们从探索岭回归是什么以及它能为你们做什么开始。使用岭回归，规范化项是权重*方的和，被称为L2 范数。我们的模型试图最小化RSS + λ(sum Bj²)。随着 lambda 的增加，系数会缩小到零，但永远不会变成零。好处可能是一个改进的预测精度，但它不会为零化任何特征权重，这可能导致模型解释和沟通的问题。为了帮助解决这个问题，我们将转向 LASSO。

LASSO

LASSO 应用L1 范数而不是岭回归中的 L2 范数，即特征权重的绝对值之和，从而最小化RSS + λ(sum |Bj|)。这种收缩惩罚确实会迫使特征权重为零。这相对于岭回归是一个明显的优势，因为它可能会大大提高模型的可解释性。

L1 范数允许权重/系数变为零的原因背后的数学原理超出了本书的范围（有关更详细的信息，请参阅 Tibsharini，1996）。

如果 LASSO 如此出色，那么岭回归显然已经过时了。但并非如此快！在高共线性或高成对相关性的情况下，LASSO 可能会将预测特征强制设为零，从而你可能会失去预测能力；也就是说，如果特征 A 和 B 都应该在你的模型中，LASSO 可能会将它们中的一个系数缩小到零。以下引用很好地总结了这个问题：

“人们可能会期望在相对少数的预测变量具有较大系数，而其余预测变量的系数非常小或等于零的环境中，lasso 的表现更好。当响应是许多具有大致相等系数的预测变量的函数时，岭回归将表现得更好。”

-(James, 2013)

有可能实现两者的最佳结合，这引出了下一个主题，弹性网络。

弹性网络

弹性网络的力量在于，它执行了岭回归没有进行的特征提取，并且它将 LASSO 无法做到的特征分组。再次强调，LASSO 倾向于从一组相关特征中选择一个特征，而忽略其余的。弹性网络通过包括一个混合参数 alpha，与 lambda 结合来实现这一点。alpha 将在0和1之间，并且像之前一样，lambda 将调节惩罚的大小。请注意，alpha 为零等于岭回归，alpha 为一等于 LASSO。本质上，我们通过包括一个具有二次（*方）项的 beta 系数的第二个调整参数，将 L1 和 L2 惩罚混合在一起。我们的目标将是最小化(RSS + λ[(1-alpha) (sum|Bj|²)/2 + alpha (sum |Bj|)])/N)。

让我们将这些技术付诸实践。我们将主要利用leaps、glmnet和caret包来选择适当特征，从而在我们的商业案例中选择适当的模型。

商业案例

对于本章，我们将坚持使用癌症——在这种情况下是前列腺癌。这是一个包含 97 个观测值和九个变量的小型数据集，但通过允许与传统技术的比较，它使你能够完全理解正则化技术的工作原理。我们将首先执行最佳子集回归来识别特征，并以此作为我们比较的基线。

商业理解

斯坦福大学医学中心为即将进行根治性前列腺切除术（完全切除前列腺）以治疗前列腺癌的 97 名患者提供了术前前列腺特异性抗原（PSA）数据。美国癌症协会（ACS）估计，2014 年* 30,000 名美国男性因前列腺癌去世(www.cancer.org/)。PSA 是由前列腺腺体产生并在血液中发现的蛋白质。目标是开发一个基于提供的临床指标的 PSA 预测模型。PSA 可以作为有效的预后指标之一，表明患者手术后可以并且应该做得如何。患者的 PSA 水*在手术后的不同时间间隔内进行测量，并用于各种公式，以确定患者是否无癌。术前预测模型与术后数据（此处未提供）相结合，可能每年能改善数千名男性的癌症护理。

数据理解和准备

97 名男性的数据集在一个包含 10 个变量的数据框中，如下所示：

lcavol: 这是癌症体积的对数
lweight: 这是前列腺重量的对数
age: 这是患者的年龄（以年为单位）
lbph: 这是良性前列腺增生（BPH）数量的对数，良性前列腺增生是前列腺的非癌性增大
svi：这是精囊侵犯，是一个指示变量，表示癌细胞是否已侵犯前列腺壁外的精囊（1 = 是，0 = 否）
lcp：这是囊性渗透的对数，表示癌细胞在前列腺覆盖层中扩展的程度
gleason：这是患者的 Gleason 评分；病理学家在活检后提供的评分（2-10），表示癌细胞外观的异常程度——评分越高，癌症的假设侵略性越强
pgg4：这是 Gleason 模式的百分比——四或五（高级癌症）
lpsa：这是 PSA 的对数；它是响应/结果
train：这是一个逻辑向量（真或假），表示训练集或测试集

数据集包含在 R 包 ElemStatLearn 中。在加载所需的包和数据框后，我们可以开始探索变量和任何可能的关系，如下所示：

    > library(ElemStatLearn) #contains the data
    > library(car) #package to calculate Variance Inflation Factor
    > library(corrplot) #correlation plots
    > library(leaps) #best subsets regression
    > library(glmnet) #allows ridge regression, LASSO and elastic net
    > library(caret) #parameter tuning

加载了包之后，调用 prostate 数据集并探索其结构：

    > data(prostate)
    > str(prostate)
    'data.frame':97 obs. of  10 variables:
     $ lcavol : num  -0.58 -0.994 -0.511 -1.204 0.751 ...
     $ lweight: num  2.77 3.32 2.69 3.28 3.43 ...
     $ age    : int  50 58 74 58 62 50 64 58 47 63 ...
     $ lbph   : num  -1.39 -1.39 -1.39 -1.39 -1.39 ...
     $ svi    : int  0 0 0 0 0 0 0 0 0 0 ...
     $ lcp    : num  -1.39 -1.39 -1.39 -1.39 -1.39 ...
     $ gleason: int  6 6 7 6 6 6 6 6 6 6 ...
     $ pgg45  : int  0 0 20 0 0 0 0 0 0 0 ...
     $ lpsa   : num  -0.431 -0.163 -0.163 -0.163 0.372 ...
     $ train  : logi  TRUE TRUE TRUE TRUE TRUE TRUE ...

结构的检查应该会引发一些我们需要再次检查的问题。如果你查看特征，svi、lcp、gleason 和 pgg45 在前 10 个观察值中具有相同的数量，除了一个——gleason 中的第七个观察值。为了确保这些可以作为输入特征，我们可以使用图表和表格来理解它们。首先，使用以下 plot() 命令并输入整个数据框，这将创建一个散点图矩阵：

    > plot(prostate)

前一个命令的输出如下：

在一个图表上展示这么多变量，理解起来可能会有些困难，所以我们将进一步深入分析。看起来我们的结果 lpsa 和 lcavol 之间存在明显的线性关系。还看起来，之前提到的特征在将成为我们的 train 和 test 集合的分布中具有足够的分散性，并且*衡良好，可能的例外是 gleason 评分。注意，这个数据集中捕获的 gleason 评分只有四个值。如果你查看 train 和 gleason 相交的图表，其中一个值既不在 test 也不在 train 中。这可能会在我们的分析中引起潜在问题，可能需要转换。因此，让我们为这个特征创建一个特定的图表，如下所示：

    > plot(prostate$gleason)

以下是为前一个命令的输出：

这里我们遇到了一个问题。每个点代表一个观察值，x 轴是数据框中的观察值编号。只有一个 Gleason 评分为 8.0，只有五个评分为 9.0。你可以通过生成特征表来查看确切的计数：

    > table(prostate$gleason)
    6  7  8  9 
    35 56  1  5

我们有哪些选择？我们可以做以下任何一项：

完全排除这个特征
只移除 8.0 和 9.0 的评分
重新编码这个特征，创建一个指示变量

我想如果我们创建一个boxplot来比较Gleason 评分与PSA 对数可能会有所帮助。我们在前一章中使用了ggplot2包来创建箱线图，但也可以使用基础 R 来实现，如下所示：

    > boxplot(prostate$lpsa ~ prostate$gleason, xlab = "Gleason Score", 
      ylab = "Log of PSA")

前一个命令的输出如下：

观察前面的图表，我认为最好的选择是将它转换为一个指标变量，其中0代表6分，1代表7分或更高分。移除这个特征可能会造成预测能力的损失。缺失值也不会与我们将使用的glmnet包兼容。

您可以使用ifelse()命令通过指定要更改的数据框中的列来用一行代码编码一个指标变量。然后遵循以下逻辑：如果观测值是数字x，则编码为y，否则编码为z：

    > prostate$gleason <- ifelse(prostate$gleason == 6, 0, 1)

和往常一样，让我们通过以下方式创建一个表格来验证转换是否按预期进行：

    > table(prostate$gleason)
    0  1 
    35 62

这一切完美无缺！由于散点图矩阵难以阅读，让我们继续到一个相关性图，它表明特征之间是否存在关系/依赖。我们将使用cor()函数创建一个相关性对象，然后利用corrplot库的corrplot.mixed()函数，如下所示：

    > p.cor = cor(prostate)
    > corrplot.mixed(p.cor)

前一个命令的输出如下：

在这里有几个亮点。首先，PSA（前列腺特异性抗原）与癌症体积的对数（lcavol）高度相关；你可能还记得，在散点图矩阵中，它似乎有一个高度线性的关系。其次，多重共线性可能成为一个问题；例如，癌症体积也与囊性浸润相关，而这与精囊浸润相关。这应该是一个有趣的练习！

在学习开始之前，必须创建训练集和测试集。由于观测值已经编码为是否在train集中，我们可以使用subset()命令，将train编码为TRUE的观测值作为我们的训练集，FALSE作为我们的测试集。同时，删除train也很重要，因为我们不希望它作为一个特征：

    > train <- subset(prostate, train == TRUE)[, 1:9]
    > str(train)
    'data.frame':67 obs. of  9 variables:
     $ lcavol : num  -0.58 -0.994 -0.511 -1.204 0.751 ...
     $ lweight: num  2.77 3.32 2.69 3.28 3.43 ...
     $ age    : int  50 58 74 58 62 50 58 65 63 63 ...
     $ lbph   : num  -1.39 -1.39 -1.39 -1.39 -1.39 ...
     $ svi    : int  0 0 0 0 0 0 0 0 0 0 ...
     $ lcp    : num  -1.39 -1.39 -1.39 -1.39 -1.39 ...
     $ gleason: num  0 0 1 0 0 0 0 0 0 1 ...
     $ pgg45  : int  0 0 20 0 0 0 0 0 0 30 ...
     $ lpsa   : num  -0.431 -0.163 -0.163 -0.163 0.372 ...
    > test <- subset(prostate, train == FALSE)[, 1:9]
    > str(test)
    'data.frame':30 obs. of  9 variables:
     $ lcavol : num  0.737 -0.777 0.223 1.206 2.059 ...
     $ lweight: num  3.47 3.54 3.24 3.44 3.5 ...
     $ age    : int  64 47 63 57 60 69 68 67 65 54 ...
     $ lbph   : num  0.615 -1.386 -1.386 -1.386 1.475 ...
     $ svi    : int  0 0 0 0 0 0 0 0 0 0 ...
     $ lcp    : num  -1.386 -1.386 -1.386 -0.431 1.348 ...
     $ gleason: num  0 0 0 1 1 0 0 1 0 0 ...
     $ pgg45  : int  0 0 0 5 20 0 0 20 0 0 ...
     $ lpsa   : num  0.765 1.047 1.047 1.399 1.658 ...

建模与评估

数据准备就绪后，我们将开始建模过程。为了比较，我们将创建一个与前面两章类似的最佳子集回归模型，然后利用正则化技术。

最佳子集

以下代码基本上是我们第二章中开发的，线性回归 - 机器学习的基石的重复。我们将使用regsubsets()命令创建最佳子集对象，并指定data的train部分。然后，选定的变量将用于test集上的模型，我们将通过均方误差计算来评估它。

我们正在构建的模型以lpsa ~ .的形式写出，波浪线和句点表示我们想要使用数据框中除响应变量之外的所有剩余变量：

    > subfit <- regsubsets(lpsa ~ ., data = train)

模型构建完成后，你可以用两行代码生成最佳子集。第一行将summary模型转换为对象，我们可以从中提取各种子集，并使用which.min()命令确定最佳子集。在这种情况下，我将使用 BIC，这在第二章中讨论过，线性回归 - 机器学习的技巧和策略，如下所示：

    > b.sum <- summary(subfit)
    > which.min(b.sum$bic)
      [1] 3

输出告诉我们，具有3个特征的模型具有最低的bic值。可以生成一个图表来检查子集组合的性能，如下所示：

    > plot(b.sum$bic, type = "l", xlab = "# of Features", ylab = "BIC", 
      main = "BIC score by Feature Inclusion")

以下为前一个命令的输出：

通过绘制实际模型对象，可以进行更详细的分析，如下所示：

    > plot(subfit, scale = "bic", main = "Best Subset Features")

前一个命令的输出如下：

因此，前面的图表显示，包含在最低BIC值中的三个特征是lcavol、lweight和gleason。值得注意的是，lcavol包含在所有模型的组合中。这与我们之前对数据的探索一致。我们现在可以尝试在数据的test部分上尝试这个模型，但首先，我们将绘制拟合值与实际值之间的图表，以寻找解的线性关系，并检查方差的一致性。需要一个仅包含三个感兴趣特征的线性模型。让我们将其放入名为ols的对象中，然后比较ols的拟合值与训练集中的实际值，如下所示：

    > ols <- lm(lpsa ~ lcavol + lweight + gleason, data = train)
    > plot(ols$fitted.values, train$lpsa, xlab = "Predicted", ylab = 
      "Actual", main = "Predicted vs Actual")

以下为前一个命令的输出：

检查图表显示，线性拟合应该在这组数据上表现良好，并且非恒定方差不是问题。因此，我们可以通过使用predict()函数并指定newdata=test来查看测试集数据上的表现，如下所示：

    > pred.subfit <- predict(ols, newdata = test)
    > plot(pred.subfit, test$lpsa , xlab = "Predicted", ylab = 
      "Actual", main = "Predicted vs Actual")

然后，可以使用对象中的值来创建预测值 vs 实际值的图表，如下所示：

图表看起来并不太糟糕。大部分是线性拟合，除了看起来像是 PSA 分数高端的两个异常值。在结束本节之前，我们需要计算均方误差（MSE）以促进各种建模技术的比较。这很容易，我们只需创建残差，然后取其*方值的*均值，如下所示：

    > resid.subfit <- test$lpsa - pred.subfit
    > mean(resid.subfit²)
    [1] 0.5084126

因此，MSE 为0.508是我们的基准。

Ridge 回归

使用岭回归，我们将拥有模型中的所有八个特征，所以这将与最优子集模型进行比较，这是一个很有趣的比较。我们将使用的包是glmnet，实际上它已经加载了。该包要求输入特征以矩阵形式而不是数据框形式存在，对于岭回归，我们可以遵循glmnet(x = our input matrix, y = our response, family = the distribution, alpha=0)的命令序列。alpha的语法与岭回归的0相关，与 LASSO 的1相关。

要将train集准备好用于在glmnet中使用，实际上通过为输入使用as.matrix()并创建一个响应向量，是非常简单的，如下所示：

    > x <- as.matrix(train[, 1:8])
    > y <- train[, 9]

现在，通过将其放置在一个名为ridge的对象中运行岭回归。在这里需要注意的是，glmnet包将首先对输入进行标准化，然后计算Lambda值，然后将对系数进行反标准化。您需要指定响应变量的分布为gaussian，因为它连续，并且对于岭回归，alpha=0，如下所示：

    > ridge <- glmnet(x, y, family = "gaussian", alpha = 0)

该对象包含了我们评估技术所需的所有信息。首先尝试的是print()命令，它将显示非零系数的数量、解释的偏差百分比以及相应的Lambda值。包中算法步骤的默认数量是100。然而，如果从一个Lambda到另一个Lambda的百分比偏差没有显著改善，算法将在100步之前停止；也就是说，算法收敛到最优解。为了节省空间，我将只展示以下前五个和最后十个Lambda的结果：

    > print(ridge)
    Call:  glmnet(x = x, y = y, family = "gaussian", alpha = 0) 
           Df      %Dev    Lambda
      [1,]  8 3.801e-36 878.90000
      [2,]  8 5.591e-03 800.80000
      [3,]  8 6.132e-03 729.70000
      [4,]  8 6.725e-03 664.80000
      [5,]  8 7.374e-03 605.80000
      ...........................
     [91,]  8 6.859e-01   0.20300
     [92,]  8 6.877e-01   0.18500
     [93,]  8 6.894e-01   0.16860
     [94,]  8 6.909e-01   0.15360
     [95,]  8 6.923e-01   0.13990
     [96,]  8 6.935e-01   0.12750
     [97,]  8 6.946e-01   0.11620
     [98,]  8 6.955e-01   0.10590
     [99,]  8 6.964e-01   0.09646
    [100,]  8 6.971e-01   0.08789

以行100为例。它显示给我们，非零系数的数量，或者说换一种说法，包含的特征数量，是八个；请记住，对于岭回归来说，这始终是相同的。我们还看到，解释的偏差百分比是.6971，这一行的Lambda调整参数是0.08789。在这里，我们可以决定为test集选择哪个Lambda。可以使用0.08789的Lambda，但让我们让它更简单一些，对于test集，尝试0.10。几个图表可能会有所帮助，所以让我们从包的默认设置开始，通过在以下语法中添加label=TRUE来向曲线添加注释：

    > plot(ridge, label = TRUE)

下面的输出是上述命令的结果：

在默认图中，y轴是系数的值，x轴是 L1 范数。这个图告诉我们系数值与 L1 范数的关系。图的顶部包含第二个x轴，它等于模型中的特征数量。也许更好的方式是通过观察lambda变化时系数值的变化来查看。我们只需要调整以下plot()命令中的代码，添加xvar="lambda"。另一个选项是将lambda替换为dev来表示解释的偏差的百分比：

    > plot(ridge, xvar = "lambda", label = TRUE)

前一个命令的输出如下：

这是一个有价值的图示，因为它表明当lambda值减小时，收缩参数减小，系数的绝对值增加。要查看特定lambda值的系数，请使用coef()命令。在这里，我们将通过指定 s=0.1 来指定我们想要使用的lambda值。我们还将声明我们想要exact=TRUE，这将告诉glmnet使用该特定的lambda值来拟合模型，而不是从我们的lambda值两侧的值进行插值，如下所示：

    > ridge.coef <- coef(ridge, s = 0.1, exact = TRUE)
    > ridge.coef
    9 x 1 sparse Matrix of class "dgCMatrix"
                          1
    (Intercept)  0.13062197
    lcavol       0.45721270
    lweight      0.64579061
    age         -0.01735672
    lbph         0.12249920
    svi          0.63664815
    lcp         -0.10463486
    gleason      0.34612690
    pgg45        0.00428580

重要的是要注意age、lcp和pgg45接*于零，但并不完全为零。我们不要忘记同时绘制偏差与系数的关系图：

    > plot(ridge, xvar = "dev", label = TRUE)

前一个命令的输出如下：

比较前两个图，我们可以看到当lambda值减小时，系数增加，解释的偏差的百分比/分数也增加。如果我们把lambda设为零，我们将没有收缩惩罚，我们的模型将与OLS等价。

为了在test集上证明这一点，我们必须像对训练数据那样转换特征：

    > newx <- as.matrix(test[, 1:8])

然后，我们使用predict函数创建一个名为ridge.y的对象，类型为response，lambda值为0.10，并绘制预测值与实际值的关系图，如下所示：

    > ridge.y <- predict(ridge, newx = newx, type = "response", s = 
      0.1)
    > plot(ridge.y, test$lpsa, xlab = "Predicted", ylab = "Actual",main 
      = "Ridge Regression")

以下命令的输出如下：

岭回归的预测值与实际值的图似乎与最佳子集非常相似，包括两个在 PSA 测量值高端的有趣异常值。在现实世界中，建议进一步探索这些异常值，以了解它们是否确实不寻常，或者我们是否遗漏了某些东西。这正是领域专业知识非常有价值的地方。与基准的 MSE 比较可能会讲述不同的故事。我们首先计算残差，然后取这些残差的*方的*均值：

    > ridge.resid <- ridge.y - test$lpsa
    > mean(ridge.resid²)
    [1] 0.4789913

岭回归给了我们一个稍微更好的 MSE。现在是时候测试 LASSO，看看我们是否可以进一步减少错误。

LASSO

运行 LASSO 的下一步非常简单，我们只需要从岭回归模型中更改一个数字：即，在glmnet()语法中将alpha=0更改为alpha=1。让我们运行这段代码，并查看模型的输出，查看前五个和最后十个结果：

    > lasso <- glmnet(x, y, family = "gaussian", alpha = 1)
    > print(lasso)
    Call: glmnet(x = x, y = y, family = "gaussian", alpha = 1) 
    Df %Dev Lambda
    [1,] 0 0.00000 0.878900
    [2,] 1 0.09126 0.800800
    [3,] 1 0.16700 0.729700
    [4,] 1 0.22990 0.664800
    [5,] 1 0.28220 0.605800
    ........................
    [60,] 8 0.70170 0.003632
    [61,] 8 0.70170 0.003309
    [62,] 8 0.70170 0.003015
    [63,] 8 0.70170 0.002747
    [64,] 8 0.70180 0.002503
    [65,] 8 0.70180 0.002281
    [66,] 8 0.70180 0.002078
    [67,] 8 0.70180 0.001893
    [68,] 8 0.70180 0.001725
    [69,] 8 0.70180 0.001572

注意，模型构建过程在69步停止，因为随着lambda的减小，解释的偏差不再提高。此外，注意现在Df列会随着lambda的变化而变化。乍一看，这里似乎所有八个特征都应该包含在具有0.001572的lambda的模型中。然而，为了论证，让我们尝试找到一个具有大约七个特征的模型，并对其进行测试。查看行，我们看到在约0.045的lambda下，我们最终得到7个特征而不是8。因此，我们将这个lambda值用于我们的test集评估，如下所示：

    [31,] 7 0.67240 0.053930
    [32,] 7 0.67460 0.049140
    [33,] 7 0.67650 0.044770
    [34,] 8 0.67970 0.040790
    [35,] 8 0.68340 0.037170

正如与岭回归一样，我们可以绘制结果：

    > plot(lasso, xvar = "lambda", label = TRUE)

下面的输出是前面命令的输出：

这是一个有趣的图表，真正展示了 LASSO 是如何工作的。注意标签为8、3和6的线条是如何表现的，分别对应pgg45、age和lcp特征。看起来lcp在或接*零，直到它是最后一个添加的特征。我们可以像使用岭回归一样通过将其插入coef()来看到七个特征模型的系数值，如下所示：

    > lasso.coef <- coef(lasso, s = 0.045, exact = TRUE)
    > lasso.coef
    9 x 1 sparse Matrix of class "dgCMatrix"
                            1
    (Intercept) -0.1305852115
    lcavol       0.4479676523
    lweight      0.5910362316
    age         -0.0073156274
    lbph         0.0974129976
    svi          0.4746795823
    lcp          . 
    gleason      0.2968395802
    pgg45        0.0009790322

LASSO 算法在0.045的lambda下将lcp的系数置零。以下是它在test数据上的表现：

    > lasso.y <- predict(lasso, newx = newx, type = "response", s =  
      0.045)
    > plot(lasso.y, test$lpsa, xlab = "Predicted", ylab = "Actual", 
      main = "LASSO")

前面命令的输出如下：

我们像之前一样计算 MSE：

    > lasso.resid <- lasso.y - test$lpsa
    > mean(lasso.resid²)
    [1] 0.4437209

看起来我们有了与之前相似的图表，只是 MSE 略有提高。我们最后的希望是使用弹性网络来实现显著的改进。为此，我们仍然会使用glmnet包。转折点是，我们将求解lambda和弹性网络参数，称为alpha。回想一下，alpha = 0是岭回归惩罚，alpha = 1是 LASSO 惩罚。弹性网络参数将是0 ≤ alpha ≤ 1。同时求解两个不同的参数可能会很复杂和令人沮丧，但我们可以使用 R 的朋友，即caret包，来提供帮助。

弹性网络

caret包代表分类和回归训练。它有一个优秀的配套网站，可以帮助理解其所有功能：topepo.github.io/caret/index.html. 该包有许多不同的函数可供使用，我们将在后面的章节中回顾其中的一些。就我们在这里的目的而言，我们想要专注于找到 lambda 和我们的弹性网络混合参数alpha的最佳组合。这是通过以下简单的三步过程完成的：

使用基础 R 中的expand.grid()函数创建一个包含我们想要调查的所有可能的alpha和lambda组合的向量。
使用caret包中的trainControl()函数确定重采样方法；我们将使用与第二章中相同的方法，即线性回归——机器学习的阻力和技巧。
使用caret包的train()函数中的glmnet()函数训练一个模型来选择我们的alpha和lambda参数。

一旦我们选定了参数，我们将以与之前进行岭回归和 LASSO 相同的方式将它们应用于test数据。

我们的组合网格应该足够大，以捕捉最佳模型，但又不至于太大，以至于变得计算上不可行。对于这个大小的数据集来说，这不会是问题，但请记住这一点以备将来参考。

这里是我们可以尝试的超参数值：

Alpha从0到1以0.2的增量；记住这被限制在0和1之间
lambda从0.00到0.2以0.02的步长；0.2的lambda应该为我们从岭回归（lambda=0.1）和 LASSO（lambda=0.045）中找到的提供缓冲。

您可以使用expand.grid()函数和构建一个序列，为caret包将自动使用的alpha和lambda值创建这个向量。caret包将使用以下代码来获取alpha和lambda的值：

    > grid <- expand.grid(.alpha = seq(0, 1, by = .2), .lambda = 
      seq(0.00, 0.2,  by = 0.02))

table()函数将显示完整的 66 种组合集：

    > table(grid)
          .lambda
    .alpha 0 0.02 0.04 0.06 0.08 0.1 0.12 0.14 0.16 0.18 0.2
       0   1    1    1    1    1   1    1    1    1    1   1
       0.2 1    1    1    1    1   1    1    1    1    1   1
       0.4 1    1    1    1    1   1    1    1    1    1   1
       0.6 1    1    1    1    1   1    1    1    1    1   1
       0.8 1    1    1    1    1   1    1    1    1    1   1
       1   1    1    1    1    1   1    1    1    1    1   1

我们可以确认这正是我们想要的--alpha从0到1，lambda从0到0.2。

对于重采样方法，我们将为LOOCV方法输入代码。还有其他重采样替代方案，如自助法或 k 折交叉验证，以及您可以使用trainControl()的许多选项，但我们将在未来的章节中探讨这些选项。

您可以使用trainControl()中的selectionFunction()来告诉模型选择标准。对于定量响应，算法将根据其默认的均方根误差（RMSE）进行选择，这对于我们的目的来说非常合适：

    > control <- trainControl(method = "LOOCV")

现在是时候使用train()来确定最优的弹性网络参数了。该函数与lm()类似。我们只需添加语法：method="glmnet"，trControl=control和tuneGrid=grid。让我们将这个放入一个名为enet.train的对象中：

    > enet.train <- train(lpsa ~ ., data = train, method = "glmnet", 
      trControl = control, tuneGrid = grid)

调用对象将告诉我们导致最低RMSE的参数，如下所示：

    > enet.train
    glmnet 
    67 samples
     8 predictor
    No pre-processing
    Resampling: 
    Summary of sample sizes: 66, 66, 66, 66, 66, 66, ... 
    Resampling results across tuning parameters:
      alpha  lambda  RMSE   Rsquared
    0.0    0.00    0.750  0.609 
    0.0    0.02    0.750  0.609 
    0.0    0.04    0.750  0.609 
    0.0    0.06    0.750  0.609 
    0.0    0.08    0.750  0.609 
    0.0    0.10    0.751  0.608 
       .........................
    1.0    0.14    0.800  0.564 
    1.0    0.16    0.809  0.558 
    1.0    0.18    0.819  0.552 
    1.0    0.20    0.826  0.549

使用RMSE通过选择最小值来选择最佳模型。用于模型的最终值是alpha = 0和lambda = 0.08。

这种实验设计导致了最优的调整参数alpha = 0和lambda = 0.08，这在glmnet中对应于s = 0.08的岭回归，记住我们使用了0.10。R-squared为 61%，这并不值得大书特书。

test集验证的过程与之前相同：

    > enet <- glmnet(x, y, family = "gaussian", alpha = 0, lambda = 
      .08)
    > enet.coef <- coef(enet, s = .08, exact = TRUE)
    > enet.coef
    9 x 1 sparse Matrix of class "dgCMatrix"
                           1
    (Intercept)  0.137811097
    lcavol       0.470960525
    lweight      0.652088157
    age         -0.018257308
    lbph         0.123608113
    svi          0.648209192
    lcp         -0.118214386
    gleason      0.345480799
    pgg45        0.004478267
    > enet.y <- predict(enet, newx=newx, type="response", s=.08)
    > plot(enet.y, test$lpsa, xlab="Predicted", ylab="Actual", 
      main="Elastic Net")

上述命令的输出如下：

按照之前的方法计算 MSE：

    > enet.resid <- enet.y - test$lpsa
    > mean(enet.resid²)
    [1] 0.4795019

此模型误差类似于岭回归惩罚。在test集上，我们的 LASSO 模型在误差方面表现最佳。我们可能存在过拟合！我们具有三个特征的最好子集模型最容易解释，并且在误差方面，对其他技术来说是可接受的。我们可以使用glmnet包中的交叉验证来可能识别更好的解决方案。

使用 glmnet 进行交叉验证

我们已经使用LOOCV和caret包；现在我们将尝试 k 折交叉验证。glmnet包在cv.glmnet()中估计 lambda 时默认为十折。在 k 折 CV 中，数据被分成相等数量的子集（折），然后在每个 k-1 集上构建一个单独的模型，然后在相应的保留集上进行测试，将结果（*均）合并以确定最终参数。

在此方法中，每个折只作为test集使用一次。glmnet包使得尝试此方法非常容易，并将为您提供 lambda 值和相应的 MSE 的输出。默认值为alpha = 1，因此如果您想尝试岭回归或弹性网络混合，您需要指定它。由于我们将尝试尽可能少的输入特征，我们将坚持默认设置，但鉴于训练数据的大小，只使用三个折：

    > set.seed(317)  
    > lasso.cv = cv.glmnet(x, y, nfolds = 3)
    > plot(lasso.cv)

上述代码的输出如下：

CV 的图表与其他glmnet图表大不相同，显示了 log(Lambda)与均方误差的关系，以及特征的数量。两条虚线垂直线表示 MSE 的最小值（左侧线）和从最小值起的一个标准误差（右侧线）。如果存在过拟合问题，从最小值起的一个标准误差是一个好的起点。您还可以调用这两个 lambda 的确切值，如下所示：

    > lasso.cv$lambda.min #minimum
    [1] 0.0133582
    > lasso.cv$lambda.1se #one standard error away
    [1] 0.124579

使用lambda.1se，我们可以通过以下过程查看系数并在测试数据上验证模型：

    > coef(lasso.cv, s = "lambda.1se")
    9 x 1 sparse Matrix of class "dgCMatrix"
     1
    (Intercept) -0.13543760
    lcavol 0.43892533
    lweight 0.49550944
    age . 
    lbph 0.04343678
    svi 0.34985691
    lcp . 
    gleason 0.21225934
    pgg45 . 

    > lasso.y.cv = predict(lasso.cv, newx=newx, type = "response",
    s = "lambda.1se")

    > lasso.cv.resid = lasso.y.cv - test$lpsa

    > mean(lasso.cv.resid²)
    [1] 0.4465453

此模型仅使用五个特征就实现了0.45的误差，将age、lcp和pgg45归零。

模型选择

在检查此数据集时，我们考虑了五个不同的模型。以下点是这些模型的test集误差：

最佳子集的值为 0.51
Ridge 回归的值为 0.48
LASSO 的值为 0.44
弹性网络为 0.48
LASSO 与 CV 的值为 0.45

在纯误差方面，具有七个特征的 LASSO 表现最佳。然而，这最好地解决了我们试图回答的问题吗？也许我们使用 CV 和 lambda 值为~0.125找到的更简约的模型更合适。我的倾向是提出后者，因为它更易于解释。

说了这么多，很明显，我们需要来自肿瘤学家、泌尿科医生和病理学家的领域特定知识，以便理解什么最有意义。这是肯定的，但也有更多数据的需求。在这个样本大小下，结果可能会因为改变随机化种子或创建不同的train和test集而有很大差异（试试看你自己。）最终，这些结果可能提出的问题比提供的答案还多。但这不好吗？我会说不是，除非你在项目开始时犯了关键的错误，过度承诺了你将能提供什么。这是对谨慎应用第一章，成功流程中提出的工具的一个公*警告。

正则化和分类

上述应用的正则化技术也适用于分类问题，包括二项式和多项式。因此，在我们对前一章中的逻辑回归问题，特别是乳腺癌数据应用一些示例代码之前，不要结束本章。正如在具有定量响应的回归中，这可以是一个利用高维数据集的重要技术。

逻辑回归示例

记住，在我们分析的乳腺癌数据中，肿瘤恶性的概率可以用以下逻辑函数表示：

P(恶性) = 1 / (1 + e^(-(B0 + B1X1 + BnXn)))

由于函数中有线性成分，我们可以应用 L1 和 L2 正则化。为了演示这一点，让我们像上一章那样加载和准备乳腺癌数据：

 > library(MASS)
 > biopsy$ID = NULL
 > names(biopsy) = c("thick", "u.size", "u.shape", "adhsn",
 "s.size", "nucl", "chrom", "n.nuc", "mit", "class")
 > biopsy.v2 <- na.omit(biopsy) > set.seed(123) 
 > ind <- sample(2, nrow(biopsy.v2), replace = TRUE, prob = c(0.7, 
      0.3))
 > train <- biopsy.v2[ind==1, ] 
 > test <- biopsy.v2[ind==2, ]

将数据转换为输入矩阵和标签：

 > x <- as.matrix(train[, 1:9])
 > y <- train[, 10]

在cv.glmnet函数中，我们将家族改为二项式，度量改为曲线下面积，并使用五折：

 > set.seed(3)
 > fitCV <- cv.glmnet(x, y, family = "binomial",
 type.measure = "auc",
 nfolds = 5)

通过绘制fitCV，我们可以得到由 lambda 决定的AUC：

 > plot(fitCV)

绘图命令的输出如下所示：

有趣！注意仅添加一个特征就立即提高了AUC。让我们看看一个标准误差的系数：

 > fitCV$lambda.1se
    [1] 0.1876892
    > coef(fitCV, s = "lambda.1se")
    10 x 1 sparse Matrix of class "dgCMatrix"
     1
    (Intercept) -1.84478214
    thick 0.01892397
    u.size 0.10102690
    u.shape 0.08264828
    adhsn . 
    s.size . 
    nucl 0.13891750
    chrom . 
    n.nuc . 
    mit .

在这里，我们看到选出的四个特征是厚度、u.size、u.shape和nucl。像上一章一样，让我们看看它在测试集上的表现，从错误和auc的角度来看：

 > library(InformationValue)
    > predCV <- predict(fitCV, newx = as.matrix(test[, 1:9]),
        s = "lambda.1se",
        type = "response")
    actuals <- ifelse(test$class == "malignant", 1, 0)
    misClassError(actuals, predCV)
    [1] 0.0622
    > plotROC(actuals, predCV)

上一段代码的输出：

结果显示，它的表现与之前进行的逻辑回归相当。看起来使用lambda.1se并不最优，我们应该看看是否可以使用lambda.min来改善样本预测的输出：

 > predCV.min <- predict(fitCV, newx = as.matrix(test[, 1:9]),
 s = "lambda.min",
 type = "response") > misClassError(actuals, predCV.min)
 [1] 0.0239

这就是了！错误率与我们在第三章，逻辑回归和判别分析中所做的一样好。

摘要

在本章中，目标是使用一个小数据集来介绍如何在实际中应用高级特征选择方法于线性模型。我们数据的结果是定量的，但我们使用的glmnet包也支持定性结果（二项式和多项式分类）。我们提供了正则化的介绍以及包含它的三种技术，并利用这些技术来构建和比较模型。正则化是一种强大的技术，可以提高计算效率，并且与其他建模技术相比，可能提取出更有意义的特点。此外，我们开始使用caret包来优化模型训练时的多个参数。到目前为止，我们一直在纯粹地讨论线性模型。在接下来的几章中，我们将开始使用非线性模型来解决分类和回归问题。

第五章：更多分类技术 - K-最*邻和支持向量机

“统计思维终将像阅读和写作能力一样，对于有效公民是必要的。”

H.G.威尔斯

在第三章《逻辑回归与判别分析》中，我们讨论了使用逻辑回归来确定预测观察值属于分类响应的概率，我们称之为分类问题。逻辑回归只是分类方法的开端，我们有多种技术可以用来提高我们的预测。

在本章中，我们将深入研究两种非线性技术：K-最*邻（KNN）和支持向量机（SVM）。这些技术比我们之前讨论的更复杂，因为可以放宽对线性的假设，这意味着不需要特征线性组合来定义决策边界。但请提前警告，这并不总是等于更优越的预测能力。此外，这些模型对于商业伙伴来说可能有点难以解释，它们在计算上可能效率不高。当明智地使用时，它们为本书中讨论的其他工具和技术提供了强大的补充。除了分类问题外，它们还可以用于连续结果；然而，为了本章的目的，我们将仅关注后者。

在对技术进行高级背景介绍之后，我们将阐述商业案例，然后对这两种方法进行测试，以确定两种方法中最好的方法，从 KNN 开始。

K-最*邻

在我们之前的努力中，我们构建了具有系数或，换句话说，每个包含特征的参数估计值的模型。在 KNN 中，我们没有参数，因为学习方法被称为基于实例的学习。简而言之，标记的示例（输入和相应的输出标签）被存储起来，直到一个新的输入模式需要输出值时才采取行动。（Battiti 和 Brunato，2014，第 11 页）。这种方法通常被称为懒惰学习，因为它不产生特定的模型参数。train实例本身代表知识。对于任何新的实例（新的数据点）的预测，算法将搜索与所讨论的新实例最相似的实例。KNN 通过查看最*的点——最*的邻居来确定适当的类别。k的作用在于确定算法应该检查多少个邻居，所以如果k=5，它将检查五个最*的点。这种方法的一个弱点是，即使在学习上不那么相关，算法中仍然会给所有五个点相同的权重。我们将研究使用 R 的方法，并试图减轻这个问题。

理解这一过程最好的方式是使用一个简单的二元分类学习问题的视觉例子。在下面的图中，我们有一个基于两个预测特征的肿瘤是良性还是恶性的图。图中的X表示我们想要预测的新观察值。如果我们的算法考虑K=3，则圆圈包括与我们要评分的那个点最*的三个观察值。由于最常见的分类是恶性，所以X数据点被分类为恶性，如下面的图所示：

即使从这个简单的例子中，也可以清楚地看出，对于最*邻算法中 k 的选择至关重要。如果 k 太小，即使你具有很低的偏差，测试集上的观察值可能仍然会有很高的方差。另一方面，随着 k 的增加，你可能降低了方差，但偏差可能是不可以接受的。交叉验证是确定合适的 k 的必要手段。

还很重要的一点是要指出，在我们的特征空间中计算数据点的距离或邻*度。默认的距离是欧几里得距离。这简单地说就是从点 A 到点 B 的直线距离——就像飞鸟一样飞过去——或者你可以利用公式，它等同于对应点之间*方差的和的*方根。给定点 A 和 B 的坐标 p1，p2，... pn 和 q1，q2，... qn 的欧几里得距离公式如下：

这种距离高度依赖于特征所测量的尺度，因此标准化它们是至关重要的。根据距离，还可以使用其他距离计算以及权重。我们将在接下来的例子中探讨这一点。

支持向量机

我第一次听说支持向量机时，必须承认我感到困惑，认为这可能是某种学术上的混淆或内部玩笑。然而，我对 SVM 的开放性审查取代了这种自然的怀疑，对这项技术产生了健康的尊重。

*支持向量机（SVMs）已被证明在各种环境中表现良好，通常被认为是最好的“开箱即用”分类器之一（James, G., 2013）。为了对这一主题有一个实际的了解，让我们来看另一个简单的视觉例子。在下面的图中，你会看到分类任务是线性可分的。然而，虚线和实线只是无数可能的线性解中的两种。

在一个超过两个维度的问题上，你会有一个分离的超*面：

因此，许多解决方案都可能对泛化造成问题，因为无论你选择哪种解决方案，任何位于线右侧的新观测值都将被分类为良性，而位于线左侧的观测值将被分类为恶性。因此，任何一条线在train数据上都没有偏差，但在任何测试数据上可能存在广泛的误差。这就是支持向量发挥作用的地方。点落在线性分隔符错误一侧的概率对于虚线比实线更高，这意味着实线在分类上具有更高的安全边际。因此，正如 Battiti 和 Brunato 所说，支持向量机（SVMs）是具有可能最大间隔的线性分隔符，而支持向量是接触两侧安全边际区域的那些。

以下图示说明了这一概念。细实线是创建上述可能的最大间隔的最优线性分隔符，从而增加了新观测值落在分隔符正确一侧的概率。较粗的黑线对应于安全间隔，而阴影数据点构成了支持向量。如果支持向量移动，那么间隔以及随之而来的决策边界将发生变化。分隔符之间的距离被称为间隔：

这听起来都很不错，但现实世界的问题并不那么清晰。

在非线性可分的数据中，许多观测值将落在间隔的错误一侧（所谓的松弛变量），这是一种误分类。构建 SVM 算法的关键是通过交叉验证求解最优支持向量数量。任何位于其类别间隔错误一侧的观测值被称为支持向量。

如果错误数量的调整参数太大，这意味着你有许多支持向量，你将遭受高偏差和低方差。另一方面，如果调整参数太小，相反的情况可能发生。James 等人将调整参数称为C，随着C的减小，对观测值位于间隔错误一侧的容忍度降低，间隔变窄。这个C，或者更确切地说，成本函数，只是允许观测值位于间隔错误一侧。如果C设置为零，那么我们将禁止任何违反间隔的解决方案。

SVM 的另一个重要方面是能够使用输入特征的二次或更高阶多项式来建模非线性。在 SVM 中，这被称为核技巧。这些可以通过交叉验证进行估计和选择。在示例中，我们将查看替代方案。

就像任何模型一样，您可以使用多项式以各种程度扩展特征数量，交互项或其他推导。在大数据集中，可能性可能会迅速失控。SVM 中的核技巧允许我们有效地扩展特征空间，目标是实现*似的线性分离。

要了解这是如何实现的，首先看看 SVM 优化问题和其约束。我们试图实现以下目标：

创建最大化边界的权重
在约束条件下，没有（或尽可能少）数据点应该位于该边界内

现在，与线性回归不同，在 SVM 中，权重应用于仅仅是支持向量观察值的内积。

这意味着什么？嗯，两个向量的内积只是配对观察值的乘积之和。例如，如果向量一是 3，4 和 2，向量二是 1，2 和 3，那么你得到 (3x1) + (4x2) + (2x3) 或 17。在 SVM 中，如果我们假设每个观察值的内积与每个其他观察值的内积都有内积，这相当于有 n(n-1)/2 种组合，其中 n 是观察值的数量。仅用 10 个观察值，我们就会得到 45 个内积。然而，SVM 只关注支持向量观察值及其相应的权重。对于线性 SVM 分类器，公式如下：

在这里，(x, xi) 是支持向量的内积，因为只有当观察值是支持向量时，α 才是非零的。

这导致分类算法中的术语数量大大减少，并允许使用所谓的核函数，通常称为核技巧。

这里的技巧在于，核函数在数学上总结了特征在更高维度的转换，而不是显式地创建它们。从简单意义上讲，核函数计算两个向量之间的点积。这有利于创建更高维的非线性空间和决策边界，同时保持优化问题在计算上高效。核函数在更高维空间中计算内积，而不将它们转换到更高维空间。

对于流行的核函数的表示是特征的内积（点积），其中 x[i] 和 x[j] 代表向量，gamma 和 c 参数，如下所示：

至于非线性技术的选择，它们需要一些尝试和错误，但我们将介绍各种选择技术。

商业案例

在即将到来的案例研究中，我们将对同一数据集应用 KNN 和 SVM。这将使我们能够在同一问题上比较 R 代码和学习方法，从 KNN 开始。我们还将花时间深入研究混淆矩阵，比较多个统计数据以评估模型准确性。

商业理解

我们将要分析的数据最初是由美国糖尿病和消化系统及肾脏疾病研究所（NIDDK）收集的。它包括532个观测值和八个输入特征，以及一个二元结果（是/否）。本研究中的患者来自亚利桑那州南部的皮马印第安人。NIDDK 数据显示，在过去 30 年里，研究帮助科学家证明肥胖是糖尿病发展中的一个主要风险因素。皮马印第安人被选中进行研究，因为一半的成年皮马印第安人患有糖尿病，其中 95%的糖尿病患者体重超重。分析将仅关注成年女性。糖尿病是根据世界卫生组织（WHO）的标准进行诊断的，并且是被称为2 型的糖尿病。在这种类型的糖尿病中，胰腺仍然能够产生胰岛素并发挥作用，它过去被称为非胰岛素依赖型糖尿病。

我们的任务是检查和预测这个群体中患有糖尿病或可能导致糖尿病的风险因素的个人。鉴于相对久坐的生活方式和高热量饮食，糖尿病在美国已成为一种流行病。根据美国糖尿病协会（ADA）的数据，2010 年，尽管糖尿病的确诊率较低，但该疾病是美国第七大死因。糖尿病还与许多合并症的增加有关，如高血压、血脂异常、中风、眼科疾病和肾脏疾病。糖尿病及其并发症的成本是巨大的。ADA 估计，2012 年该疾病的总成本约为 4900 亿美元。有关该问题的更多背景信息，请参阅 ADA 网站www.diabetes.org/diabetes-basics/statistics/。

数据理解和准备

532名女性的数据集分为两个独立的数据框。感兴趣的变量如下：

npreg: 这代表怀孕次数
glu: 这代表口服葡萄糖耐量测试中的血浆葡萄糖浓度
bp: 这代表舒张压（毫米汞柱）
skin: 这代表三头肌皮肤褶皱厚度（毫米）
bmi: 这代表体质指数
ped: 这代表糖尿病家系函数
age: 这代表年龄（年）
type: 这代表糖尿病，是或否

数据集包含在 R 包MASS中。一个数据框命名为Pima.tr，另一个命名为Pima.te。我们不会将它们用作独立的训练和测试集，而是将它们合并，并创建我们自己的，以便发现如何在 R 中完成此类任务。

首先，让我们加载以下我们将需要用于练习的包：

    > library(class) #k-nearest neighbors
    > library(kknn) #weighted k-nearest neighbors
    > library(e1071) #SVM
    > library(caret) #select tuning parameters
    > library(MASS) # contains the data
    > library(reshape2) #assist in creating boxplots
    > library(ggplot2) #create boxplots
    > library(kernlab) #assist with SVM feature selection

现在，我们将加载数据集并检查它们的结构，确保它们相同，从Pima.tr开始，如下所示：

    > data(Pima.tr)
    > str(Pima.tr)
    'data.frame':200 obs. of  8 variables:
     $ npreg: int  5 7 5 0 0 5 3 1 3 2 ...
     $ glu  : int  86 195 77 165 107 97 83 193 142 128 ...
     $ bp   : int  68 70 82 76 60 76 58 50 80 78 ...
     $ skin : int  28 33 41 43 25 27 31 16 15 37 ...
     $ bmi  : num  30.2 25.1 35.8 47.9 26.4 35.6 34.3 25.9 32.4 43.3 
       ...
     $ ped  : num  0.364 0.163 0.156 0.259 0.133 ...
     $ age  : int  24 55 35 26 23 52 25 24 63 31 ...
     $ type : Factor w/ 2 levels "No","Yes": 1 2 1 1 1 2 1 1 1 2 ...
    > data(Pima.te)
    > str(Pima.te)
    'data.frame':332 obs. of  8 variables:
     $ npreg: int  6 1 1 3 2 5 0 1 3 9 ...
     $ glu  : int  148 85 89 78 197 166 118 103 126 119 ...
     $ bp   : int  72 66 66 50 70 72 84 30 88 80 ...
     $ skin : int  35 29 23 32 45 19 47 38 41 35 ...
     $ bmi  : num  33.6 26.6 28.1 31 30.5 25.8 45.8 43.3 39.3 29 ...
     $ ped  : num  0.627 0.351 0.167 0.248 0.158 0.587 0.551 0.183 
       0.704 0.263 ...
     $ age  : int  50 31 21 26 53 51 31 33 27 29 ...
     $ type : Factor w/ 2 levels "No","Yes": 2 1 1 2 2 2 2 1 1 2 ...

观察结构，我们可以确信我们可以将数据框合并为一个。这使用rbind()函数非常容易完成，该函数代表行绑定并附加数据。如果你在每个框架中都有相同的观测值并且想要附加特征，你会使用cbind()函数按列绑定它们。你只需命名你的新数据框并使用此语法：new data = rbind(data frame1, data frame2)。因此，我们的代码如下所示：

    > pima <- rbind(Pima.tr, Pima.te)

如同往常，请再次检查结构。我们可以看到没有问题：

    > str(pima)
    'data.frame':532 obs. of  8 variables:
     $ npreg: int  5 7 5 0 0 5 3 1 3 2 ...
     $ glu  : int  86 195 77 165 107 97 83 193 142 128 ...
     $ bp   : int  68 70 82 76 60 76 58 50 80 78 ...
     $ skin : int  28 33 41 43 25 27 31 16 15 37 ...
     $ bmi  : num  30.2 25.1 35.8 47.9 26.4 35.6 34.3 25.9 32.4 43.3 
      ...
     $ ped  : num  0.364 0.163 0.156 0.259 0.133 ...
     $ age  : int  24 55 35 26 23 52 25 24 63 31 ...
     $ type : Factor w/ 2 levels "No","Yes": 1 2 1 1 1 2 1 1 1 2 ...

让我们通过箱线图进行一些探索性分析。为此，我们希望使用结果变量"type"作为我们的 ID 变量。正如我们在逻辑回归中所做的那样，melt()函数将执行此操作并准备一个我们可以用于箱线图的数据框。我们将新数据框命名为pima.melt，如下所示：

    > pima.melt <- melt(pima, id.var = "type")

使用ggplot2包的箱线图布局非常有效，因此我们将使用它。在ggplot()函数中，我们将指定要使用的数据、x和y变量以及图表类型，并创建一系列两列的图表。在以下代码中，我们将响应变量作为x和其值作为y在aes()中。然后，geom_boxplot()创建箱线图。最后，我们将使用facet_wrap()在两列中构建箱线图：

    > ggplot(data = pima.melt, aes(x = type, y = value)) + 
        geom_boxplot() + facet_wrap(~ variable, ncol = 2)

以下为前一个命令的输出：

这是一个有趣的图表，因为很难在图表中看出任何明显的差异，可能除了葡萄糖（glu）之外。正如你可能所怀疑的，空腹血糖似乎在目前被诊断为糖尿病的患者中显著更高。这里的主要问题是所有图表都在相同的 y 轴刻度上。我们可以通过标准化值然后重新绘图来解决这个问题，从而生成一个更有意义的图表。R 有一个内置函数scale()，它将值转换为均值为零和标准差为一。让我们将其放入一个新的数据框pima.scale中，转换所有特征并排除type响应。此外，在进行 KNN 时，确保特征具有相同的尺度，均值为零和标准差为一非常重要。如果不是这样，那么最*邻计算中的距离计算将是错误的。如果某个东西是在 1 到 100 的尺度上测量的，它将比在 1 到 10 的尺度上测量的另一个特征有更大的影响。请注意，当你缩放数据框时，它自动变成一个矩阵。使用data.frame()函数，将其转换回数据框，如下所示：

    > pima.scale <- data.frame(scale(pima[, -8]))
    > str(pima.scale)
    'data.frame':532 obs. of  7 variables:
     $ npreg: num  0.448 1.052 0.448 -1.062 -1.062 ...
     $ glu  : num  -1.13 2.386 -1.42 1.418 -0.453 ...
     $ bp   : num  -0.285 -0.122 0.852 0.365 -0.935 ...
     $ skin : num  -0.112 0.363 1.123 1.313 -0.397 ...
     $ bmi  : num  -0.391 -1.132 0.423 2.181 -0.943 ...
     $ ped  : num  -0.403 -0.987 -1.007 -0.708 -1.074 ...
     $ age  : num  -0.708 2.173 0.315 -0.522 -0.801 ...

现在，我们需要在数据框中包含响应，如下所示：

    > pima.scale$type <- pima$type

让我们再次使用melt()和ggplot()重复箱线图的过程：

    > pima.scale.melt <- melt(pima.scale, id.var = "type")
    > ggplot(data = pima.scale.melt, aes(x = type, y = value)) +
         geom_boxplot() + facet_wrap(~ variable, ncol = 2)

以下是在先前的命令输出：

特征缩放后，图表更容易阅读。除了葡萄糖之外，其他特征似乎可能因type而异，特别是age。

在将数据分割成train和test集之前，让我们看看与 R 函数cor()的相关性。这将产生一个矩阵而不是皮尔逊相关性的图表：

    > cor(pima.scale[-8])
                npreg       glu          bp       skin
    npreg 1.000000000 0.1253296 0.204663421 0.09508511
    glu   0.125329647 1.0000000 0.219177950 0.22659042
    bp    0.204663421 0.2191779 1.000000000 0.22607244
    skin  0.095085114 0.2265904 0.226072440 1.00000000
    bmi   0.008576282 0.2470793 0.307356904 0.64742239
    ped   0.007435104 0.1658174 0.008047249 0.11863557
    age   0.640746866 0.2789071 0.346938723 0.16133614
                  bmi         ped        age
    npreg 0.008576282 0.007435104 0.64074687
    glu   0.247079294 0.165817411 0.27890711
    bp    0.307356904 0.008047249 0.34693872
    skin  0.647422386 0.118635569 0.16133614
    bmi   1.000000000 0.151107136 0.07343826
    ped   0.151107136 1.000000000 0.07165413
    age   0.073438257 0.071654133 1.00000000

有几个相关性需要指出：npreg/age和skin/bmi。在适当训练和调整超参数的情况下，多重共线性通常不是问题。

我认为我们现在已经准备好创建train和test集了，但在这样做之前，我建议您始终检查我们响应中Yes和No的比例。确保数据有*衡的分割很重要，如果其中一个结果稀疏，可能会成为问题。这可能导致分类器在多数和少数类别之间产生偏差。关于什么是不适当的*衡没有硬性规定。一个很好的经验法则是，您应努力实现至少 2:1 的可能结果比例（He 和 Wa，2013）：

    > table(pima.scale$type)
     No Yes
    355 177

比例是 2:1，因此我们可以使用我们常用的语法创建train和test集，以下是这样进行 70/30 分割的方式：

    > set.seed(502)
    > ind <- sample(2, nrow(pima.scale), replace = TRUE, prob = c(0.7, 
      0.3))
    > train <- pima.scale[ind == 1, ]
    > test <- pima.scale[ind == 2, ]
    > str(train)
    'data.frame':385 obs. of  8 variables:
     $ npreg: num  0.448 0.448 -0.156 -0.76 -0.156 ...
     $ glu  : num  -1.42 -0.775 -1.227 2.322 0.676 ...
     $ bp   : num  0.852 0.365 -1.097 -1.747 0.69 ...
     $ skin : num  1.123 -0.207 0.173 -1.253 -1.348 ...
     $ bmi  : num  0.4229 0.3938 0.2049 -1.0159 -0.0712 ...
     $ ped  : num  -1.007 -0.363 -0.485 0.441 -0.879 ...
     $ age  : num  0.315 1.894 -0.615 -0.708 2.916 ...
     $ type : Factor w/ 2 levels "No","Yes": 1 2 1 1 1 2 2 1 1 1 ...
    > str(test)
    'data.frame':147 obs. of  8 variables:
     $ npreg: num  0.448 1.052 -1.062 -1.062 -0.458 ...
     $ glu  : num  -1.13 2.386 1.418 -0.453 0.225 ...
     $ bp   : num  -0.285 -0.122 0.365 -0.935 0.528 ...
     $ skin : num  -0.112 0.363 1.313 -0.397 0.743 ...
     $ bmi  : num  -0.391 -1.132 2.181 -0.943 1.513 ...
     $ ped  : num  -0.403 -0.987 -0.708 -1.074 2.093 ...
     $ age  : num  -0.7076 2.173 -0.5217 -0.8005 -0.0571 ...
     $ type : Factor w/ 2 levels "No","Yes": 1 2 1 1 2 1 2 1 1 1 ...

一切似乎都井然有序，因此我们可以继续构建我们的预测模型并评估它们，从 KNN 开始。

建模和评估

现在我们将讨论与建模和评估相关的各个方面。

KNN 建模

如前所述，在使用此技术时，选择最合适的参数（k或K）至关重要。让我们再次充分利用caret包来识别k。我们将为实验创建一个输入网格，k的范围从2到20，增量是1。这可以通过expand.grid()和seq()函数轻松完成。与 KNN 函数一起工作的caret包参数是简单的.k：

    > grid1 <- expand.grid(.k = seq(2, 20, by = 1))

我们还将结合交叉验证来选择参数，创建一个名为control的对象，并使用caret包中的trainControl()函数，如下所示：

    > control <- trainControl(method = "cv")

现在，我们可以创建一个对象，该对象将显示如何使用train()函数计算最优的k值，这也是caret包的一部分。记住，在进行任何形式的随机抽样时，您需要设置seed值如下：

    > set.seed(502)

由train()函数创建的对象需要模型公式、train数据名称和适当的方法。模型公式与我们之前使用的一样-y~x。方法指定是简单的knn。考虑到这一点，以下代码将创建一个对象，该对象将显示最优的k值，如下所示：

    > knn.train <- train(type ~ ., data = train,
      method = "knn",
      trControl = control,
      tuneGrid = grid1)

调用对象为我们提供了我们正在寻找的k参数，即k=17：

    > knn.train
    k-Nearest Neighbors
    385 samples
      7 predictor
      2 classes: 'No', 'Yes'
    No pre-processing
    Resampling: Cross-Validated (10 fold)
    Summary of sample sizes: 347, 347, 345, 347, 347, 346, ...
    Resampling results across tuning parameters:
      k   Accuracy  Kappa  Accuracy SD  Kappa SD
    2  0.736     0.359  0.0506       0.1273 
    3  0.762     0.416  0.0526       0.1313 
    4  0.761     0.418  0.0521       0.1276 
    5  0.759     0.411  0.0566       0.1295 
    6  0.772     0.442  0.0559       0.1474 
    7  0.767     0.417  0.0455       0.1227 
    8  0.767     0.425  0.0436       0.1122 
    9  0.772     0.435  0.0496       0.1316 
    10  0.780     0.458  0.0485       0.1170 
    11  0.777     0.446  0.0437       0.1120 
    12  0.775     0.440  0.0547       0.1443 
    13  0.782     0.456  0.0397       0.1084 
    14  0.780     0.449  0.0557       0.1349 
    15  0.772     0.427  0.0449       0.1061 
    16  0.782     0.453  0.0403       0.0954 
    17  0.795     0.485  0.0382       0.0978 
    18  0.782     0.451  0.0461       0.1205 
    19  0.785     0.455  0.0452       0.1197 
    20  0.782     0.446  0.0451       0.1124 
    Accuracy was used to select the optimal model using the largest 
      value.
    The final value used for the model was k = 17\.

除了产生k=17的结果外，我们还以表格的形式获得了Accuracy和Kappa统计量及其标准差的信息，这些信息来自交叉验证。Accuracy告诉我们模型正确分类的观测值的百分比。Kappa指的是所谓的Cohen's Kappa 统计量。Kappa统计量通常用于衡量两个评估者正确分类观测值的能力。它通过调整准确率得分来提供对这一问题的洞察，这是通过考虑到评估者仅通过偶然完全正确来实现的。该统计量的公式为 Kappa = (一致百分比 - 偶然一致百分比) / (1 - 偶然一致百分比)。

一致百分比是评估者对类别的（准确率）达成一致的比例，偶然一致百分比是评估者随机达成一致的比例。该统计量越高，表现越好，最大一致度为 1。当我们将在test数据上应用我们的模型时，我们将通过一个示例来演示这一点。

为了做到这一点，我们将利用class包中的knn()函数。使用此函数，我们需要指定至少四个项目。这些将是train输入、test输入、来自train集的正确标签以及k。我们将通过创建knn.test对象并查看其表现来完成此操作：

    > knn.test <- knn(train[, -8], test[, -8], train[, 8], k = 17)

创建了对象后，让我们检查混淆矩阵并计算准确率和kappa：

    > table(knn.test, test$type)
    knn.test No Yes
         No  77  26
         Yes 16  28

准确率是通过简单地将正确分类的观测值除以总观测值来计算的：

    > (77 + 28) / 147
    [1] 0.7142857

71%的准确率低于我们在train数据集上实现的准确率，后者接* 80%。我们现在可以按照以下方式产生kappa统计量：

    > #calculate Kappa
    > prob.agree <- (77 + 28) / 147 #accuracy
    > prob.chance <- ((77 + 26) / 147) * ((77 + 16) / 147)
    > prob.chance
    [1] 0.4432875
    > kappa <- (prob.agree - prob.chance) / (1 - prob.chance)
    > kappa
    [1] 0.486783

使用train集，我们实现的kappa统计量为 0.49。Altman（1991）提供了一个启发式方法来帮助我们解释这个统计量，如下表所示：

*K的值**	一致性强度
<0.20	差
0.21-0.40	一般
0.41-0.60	中等
0.61-0.80	良好
0.81-1.00	非常好

在test集上，我们的kappa仅中等，准确率略超过 70%，我们应该看看是否可以通过利用加权邻居来表现得更好。加权方案增加了与观测值最*的邻居相对于较远邻居的影响力。观测值在空间中的位置越远，其影响力受到的惩罚就越大。对于这项技术，我们将使用kknn包及其train.kknn()函数来选择最佳加权方案。

train.kknn()函数使用我们在前几章中检查过的 LOOCV 来选择最佳参数，包括最优k邻居、两种距离度量之一以及kernel函数。

我们创建的无权重k邻居算法使用的是欧几里得距离，正如我们之前讨论的那样。在kknn包中，有选项可以比较绝对差异之和与欧几里得距离。该包将使用的距离计算称为Minkowski参数。

至于距离的加权，有许多不同的方法可供选择。为了我们的目的，我们将使用的包有十种不同的加权方案，包括无权重的方案。它们是矩形（无权重）、三角形、Epanechnikov、双权重、三权重、余弦、倒数、高斯、等级和最优。关于这些加权技术的全面讨论可以在Hechenbichler K.和Schliep K.P.（2004）中找到。

为了简单起见，让我们只关注两个：triangular和epanechnikov。在分配权重之前，算法将所有距离标准化，使它们介于零和一之间。三角形加权方法将观测距离乘以 1 减去距离。对于 Epanechnikov，距离乘以 3/4 倍（1 减去距离的*方）。对于我们的问题，我们将结合这些加权方法以及标准的无权重版本进行比较。

在指定随机种子后，我们将使用kknn()创建train集对象。此函数要求最大k值（kmax）、distance（一等于欧几里得距离，二等于绝对距离）和kernel。对于此模型，kmax将设置为25，distance将设置为2：

    > set.seed(123)
    > kknn.train <- train.kknn(type ~ ., data = train, kmax = 25, 
        distance = 2, 
        kernel = c("rectangular", "triangular", "epanechnikov"))

该包的一个不错特性是能够绘制并比较结果，如下所示：

    > plot(kknn.train)

下面的输出是前面命令的结果：

此图显示了 x 轴上的k值和由kernel错误分类的观测值的百分比。令我惊讶的是，在k: 19的无权重（矩形）版本表现最佳。您也可以调用该对象，以下列方式查看分类误差和最佳参数：

    > kknn.train 
    Call:
    train.kknn(formula = type ~ ., data = train, kmax = 25, distance = 
      2, kernel
     = c("rectangular", "triangular", "epanechnikov"))
 Type of response variable: nominal
 Minimal misclassification: 0.212987
 Best kernel: rectangular
 Best k: 19

因此，使用这些数据，对距离进行加权并没有提高模型在训练中的准确性，正如我们在这里所看到的，甚至在测试集上的表现也不尽如人意：

 > kknn.pred <- predict(kknn.train, newdata = test)
 > table(kknn.pred, test$type)
 kknn.pred No Yes
 No 76  27
 Yes 17  27

我们还可以尝试其他权重，但在我尝试了这些其他权重后，我所获得的结果并不比这些更准确。我们不需要进一步追求 KNN。我鼓励您自己尝试不同的参数，看看它们的性能如何。

SVM 建模

我们将使用e1071包来构建我们的 SVM 模型。我们将从一个线性支持向量分类器开始，然后转向非线性版本。e1071包有一个用于 SVM 的不错函数，名为tune.svm()，它有助于选择调整参数/核函数。该包中的tune.svm()函数使用交叉验证来优化调整参数。让我们创建一个名为linear.tune的对象，并使用summary()函数调用它，如下所示：

    > linear.tune <- tune.svm(type ~ ., data = train,
      kernel = "linear",
      cost = c(0.001, 0.01, 0.1, 1, 5, 10))
    > summary(linear.tune)
    Parameter tuning of 'svm':
    - sampling method: 10-fold cross validation
    - best parameters:
     cost
        1
    - best performance: 0.2051957
    - Detailed performance results:
       cost     error dispersion
    1 1e-03 0.3197031 0.06367203
    2 1e-02 0.2080297 0.07964313
    3 1e-01 0.2077598 0.07084088
    4 1e+00 0.2051957 0.06933229
    5 5e+00 0.2078273 0.07221619
    6 1e+01 0.2078273 0.07221619

对于这个数据集，最优的cost函数会导致大约 21%的错误分类率。我们可以使用predict()函数和newdata = test来对test数据进行预测并检查：

    > best.linear <- linear.tune$best.model
    > tune.test <- predict(best.linear, newdata = test)
    > table(tune.test, test$type)
    tune.test No Yes
          No  82  22
          Yes 13  30 
    > (82 + 30)/147
    [1] 0.7619048

线性支持向量机分类器在train和test集上都略优于 KNN。e1071包有一个用于 SVM 的不错函数tune.svm()，它有助于选择调整参数/核函数。现在我们将看看非线性方法是否会提高我们的性能，并使用交叉验证来选择调整参数。

我们将尝试的第一个核函数是polynomial，我们将调整两个参数：多项式的次数（degree）和核系数（coef0）。多项式的次数将是3、4和5，系数将从0.1增加到4，如下所示：

    > set.seed(123) 
    > poly.tune <- tune.svm(type ~ ., data = train,
      kernel = "polynomial",
      degree = c(3, 4, 5),
      coef0 = c(0.1, 0.5, 1, 2, 3, 4)) 
    > summary(poly.tune)
    Parameter tuning of 'svm': 
    - sampling method: 10-fold cross validation
    - best parameters:
     degree coef0
          3   0.1
    - best performance: 0.2310391

模型选择了多项式的degree为3和系数为0.1。正如线性 SVM 一样，我们可以使用这些参数在test集上创建预测，如下所示：

    > best.poly <- poly.tune$best.model
    > poly.test <- predict(best.poly, newdata = test)
    > table(poly.test, test$type)
    poly.test No Yes
          No  81  28
          Yes 12  26
    > (81 + 26) / 147
    [1] 0.7278912

这并没有表现得像线性模型那样好。现在我们将运行径向基函数。在这种情况下，我们将求解的参数是gamma，我们将以0.1到4的增量进行检查。如果gamma太小，模型将无法捕捉决策边界的复杂性；如果太大，模型将严重过拟合：

    > set.seed(123)
    > rbf.tune <- tune.svm(type ~ ., data = train, 
      kernel = "radial", 
      gamma = c(0.1, 0.5, 1, 2, 3, 4))
    > summary(rbf.tune)
    Parameter tuning of 'svm':
    - sampling method: 10-fold cross validation
    - best parameters:
     gamma
       0.5
    - best performance: 0.2284076

最佳的gamma值是 0.5，在这个设置下，性能似乎并没有比其他 SVM 模型有太多改进。我们将在以下方式中检查test集：

    > best.rbf <- rbf.tune$best.model
    > rbf.test <- predict(best.rbf, newdata = test)
    > table(rbf.test, test$type)
    rbf.test No Yes
         No  73  33
         Yes 20  21
    > (73+21)/147
    [1] 0.6394558

表现简直糟糕透顶。在这里再试一次来提高性能的方法是使用kernel = "sigmoid"。我们将求解两个参数——gamma和核系数（coef0）：

    > set.seed(123)
    > sigmoid.tune <- tune.svm(type ~ ., data = train,
      kernel = "sigmoid",
      gamma = c(0.1, 0.5, 1, 2, 3, 4),
      coef0 = c(0.1, 0.5, 1, 2, 3, 4)) 
    > summary(sigmoid.tune)
    Parameter tuning of 'svm':
    - sampling method: 10-fold cross validation
    - best parameters:
     gamma coef0
       0.1     2
    - best performance: 0.2080972

这个错误率与线性模型相匹配。现在只是看它是否在test集上表现更好：

    > best.sigmoid <- sigmoid.tune$best.model
    > sigmoid.test <- predict(best.sigmoid, newdata = test)
    > table(sigmoid.test, test$type)
    sigmoid.test No Yes
             No  82  19
             Yes 11  35
    > (82+35)/147
    [1] 0.7959184

看看！我们终于得到了与train数据性能相匹配的测试性能。看起来我们可以选择 sigmoid 核作为最佳预测器。

到目前为止，我们已经尝试了不同的模型。现在，让我们使用除了准确率之外的指标来评估它们的性能，并与线性模型进行比较。

模型选择

我们已经研究了两种不同的建模技术，从所有意义上讲，KNN 的表现都未能达到预期。KNN 在test集上的最佳准确率只有大约 71%。相反，使用 SVM，我们可以获得接* 80%的准确率。在简单地选择最准确的模式之前，在这种情况下，选择 sigmoid 核的 SVM，让我们看看我们如何可以通过对混淆矩阵的深入分析来比较它们。

对于这个练习，我们可以求助于我们老朋友caret包，并使用confusionMatrix()函数。记住，我们之前已经从InformationValue包中使用了相同的函数。caret包版本提供了更多细节，并且将产生我们评估和选择最佳模型所需的所有统计数据。让我们首先从我们构建的最后一个模型开始，使用与我们在基础table()函数中使用的相同语法，除了指定positive类别，如下所示：

    > confusionMatrix(sigmoid.test, test$type, positive = "Yes")
    Confusion Matrix and Statistics
              Reference
    Prediction No Yes
           No  82  19
           Yes 11  35
    Accuracy : 0.7959 
                     95% CI : (0.7217, 0.8579)
    No Information Rate : 0.6327 
    P-Value [Acc > NIR] : 1.393e-05 
    Kappa : 0.5469 
    Mcnemar's Test P-Value : 0.2012 
    Sensitivity : 0.6481 
    Specificity : 0.8817 
    Pos Pred Value : 0.7609 
    Neg Pred Value : 0.8119 
    Prevalence : 0.3673 
    Detection Rate : 0.2381 
    Detection Prevalence : 0.3129 
    Balanced Accuracy : 0.7649 
    'Positive' Class : Yes

该函数产生了一些我们已讨论过的项目，例如Accuracy和Kappa。以下是它产生的其他统计数据：

无信息率是最大类别的比例；63%的人没有糖尿病。
P-Value用于检验假设，即准确率实际上优于无信息率。
我们将不会关注McNemar's Test，这是一种用于匹配对分析的方法，主要应用于流行病学研究中。
灵敏度是真正率；在这种情况下，没有糖尿病的人被正确识别为这样的比率。
特异性是真正负率，或者在我们的情况下，正确识别为糖尿病的比率。
正性预测值（Pos Pred Value）是指被归类为糖尿病人群的概率，并且确实患有疾病。以下公式被使用：

阴性预测值（Neg Pred Value）是指被归类为非糖尿病人群的概率，并且确实没有疾病。该公式的计算如下：

患病率是疾病的估计人群患病率，在此计算为第二列（Yes列）的总和除以总观测值。
检测率是已识别的真正正例的比率，在我们的情况下，是 35 除以总观测值。
检测患病率是预测的患病率，或者在我们的情况下，底部行除以总观测值。
*衡准确率是从任一类别获得的*均准确率。这一指标考虑了分类器算法中可能存在的偏差，从而可能高估最频繁的类别。这简单来说是灵敏度 + 特异性除以 2。

我们模型的灵敏度不如我们希望的那样强大，这告诉我们我们在数据集中遗漏了一些特征，这些特征会提高找到真正糖尿病患者的比率。我们现在将比较这些结果与线性 SVM，如下所示：

    > confusionMatrix(tune.test, test$type, positive = "Yes")
             Reference
    Prediction No Yes
           No  82  24
           Yes 11  30
    Accuracy : 0.7619 
                     95% CI : (0.6847, 0.8282)
    No Information Rate : 0.6327 
    P-Value [Acc > NIR] : 0.0005615 
    Kappa : 0.4605 
    Mcnemar's Test P-Value : 0.0425225 
    Sensitivity : 0.5556 
    Specificity : 0.8817 
    Pos Pred Value : 0.7317 
    Neg Pred Value : 0.7736 
    Prevalence : 0.3673 
    Detection Rate : 0.2041 
    Detection Prevalence : 0.2789 
    Balanced Accuracy : 0.7186 
    'Positive' Class : Yes

通过比较两个模型，我们可以看到线性 SVM 在各个方面都劣于其他模型。我们的明显胜者是 sigmoid 核 SVM。然而，这里我们遗漏了一件事，那就是任何形式的特征选择。我们所做的是将所有变量一起作为特征输入空间，让黑盒 SVM 计算给出预测分类。SVM 的一个问题是其发现非常难以解释。有几种处理这个过程的方法，我认为这超出了本章的范围；这是您应该开始探索和自学的东西，随着您对之前概述的基本知识的熟悉。

SVM 的特征选择

然而，在特征选择方面并非一切都已失去，我想占用一些篇幅来向您展示一种快速探索这一问题的方法。这需要您进行一些尝试和错误。再次强调，caret包在这方面有所帮助，因为它将基于kernlab包的线性 SVM 进行交叉验证。

要做到这一点，我们需要设置随机种子，在caret的rfeControl()函数中指定交叉验证方法，使用rfe()函数执行递归特征选择，然后测试模型在test集上的表现。在rfeControl()中，您需要根据所使用的模型指定函数。您可以使用几种不同的函数。在这里，我们需要lrFuncs。要查看可用函数的列表，您最好的选择是使用?rfeControl和?caretFuncs探索文档。本例的代码如下：

    > set.seed(123)
    > rfeCNTL <- rfeControl(functions = lrFuncs, method = "cv", number 
      = 10)
    > svm.features <- rfe(train[, 1:7], train[, 8],
      sizes = c(7, 6, 5, 4), 
      rfeControl = rfeCNTL, 
      method = "svmLinear")

要创建svm.features对象，重要的是要指定输入和响应因子、通过sizes指定的输入特征数量以及来自kernlab的线性方法，即svmLinear语法。使用此方法还有其他选项，例如svmPoly。没有 sigmoid 核的方法。调用对象使我们能够看到各种特征大小如何表现，如下所示：

    > svm.features
    Recursive feature selection
    Outer resampling method: Cross-Validated (10 fold) 
    Resampling performance over subset size:
     Variables Accuracy  Kappa AccuracySD KappaSD Selected
    4   0.7797 0.4700    0.04969  0.1203 
             5   0.7875 0.4865    0.04267  0.1096        *
    6   0.7847 0.4820    0.04760  0.1141 
    7   0.7822 0.4768    0.05065  0.1232 
    The top 5 variables (out of 5):

尽管看似反直觉，但五个变量在自身以及包含skin和bp时表现都相当好。让我们在test集上尝试一下，记住完整模型的准确率为 76.2%：

    > svm.5 <- svm(type ~ glu + ped + npreg + bmi + age,
      data = train,
      kernel = "linear")
    > svm.5.predict <- predict(svm.5, newdata = test[c(1, 2, 5, 6, 7)])
    > table(svm.5.predict, test$type)
    svm.5.predict No Yes
              No  79  21
              Yes 14  33

这种方法表现不佳，我们可以坚持使用完整模型。您可以通过尝试和错误来了解这种技术如何发挥作用，以确定特征重要性的简单识别。如果您想探索这里可以应用的其他技术和方法，特别是对于黑盒技术，我建议您从阅读 Guyon 和 Elisseeff（2003）关于这一主题的工作开始。

摘要

在本章中，我们回顾了两种新的分类技术：KNN 和 SVM。目标是通过对一个共同数据集上的模型进行构建和比较，以了解这些技术的工作原理以及它们之间的差异，从而预测一个人是否患有糖尿病。KNN 涉及无权重和有权重的最*邻算法。这些算法在预测一个人是否患有糖尿病方面并不如 SVM 表现得好。

我们探讨了如何使用e1071包构建和调整线性和非线性支持向量机。我们使用了极其通用的caret包来比较线性和非线性支持向量机的预测能力，并发现具有 sigmoid 核的非线性支持向量机表现最佳。

最后，我们简要介绍了如何使用caret包进行粗略的特征选择，因为这对于像 SVM 这样的黑盒技术来说是一个具有挑战性的任务。当使用这些技术时，这可能会成为一个重大的挑战，你需要考虑它们在解决业务问题上的可行性。

第六章：分类和回归树

“最有可能成为最佳分类器的是随机森林（RF）版本，其中最好的（在 R 中实现并通过 caret 访问）达到了 94.1%的最大准确率，在 84.3%的数据集中超过了 90%。”

Fernández-Delgado 等人（2014 年）

这段来自Fernández-Delgado 等人在机器学习研究杂志中的引言，旨在表明本章中的技术非常强大，尤其是在用于分类问题时。当然，它们并不总是提供最佳解决方案，但它们确实提供了一个良好的起点。

在前几章中，我们探讨了用于预测数量或标签分类的技术。在这里，我们将将这些技术应用于这两种类型的问题。我们还将与之前章节不同的方式来处理商业问题。而不是定义一个新的问题，我们将应用这些技术到我们已经解决的问题上，目的是看看我们是否可以提高我们的预测能力。从所有目的和意图来看，本章的商业案例是看看我们是否可以改进之前选定的模型。

讨论的第一项是基本的决策树，它既容易构建也容易理解。然而，单个决策树方法的表现不如你学到的其他方法，例如支持向量机，或者我们将要学习的方法，例如神经网络。因此，我们将讨论创建多个、有时是数百个不同的树，并将它们的个别结果结合起来，以得出一个单一的总体预测。

这些方法，正如本章开头引用的论文所述，其表现与本书中的任何技术一样好，甚至更好。这些方法被称为随机森林和梯度提升树。此外，我们将从商业案例中暂时休息一下，展示如何在数据集上应用随机森林方法来帮助特征消除/选择。

技术概述

现在，我们将对技术进行概述，涵盖回归和分类树、随机森林和梯度提升。这将为实际商业案例奠定基础。

理解回归树

要建立对基于树的方法的了解，可能从定量结果开始，然后转向它在分类问题中的应用要容易一些。树的本质在于特征被分区，从第一个能最大程度提高 RSS 的分支开始。这些二进制分支一直持续到树的终止。每个后续的分支/分区不是在整个数据集上进行的，而是在先前的分支下它所属的部分上进行的。这种自上而下的过程被称为递归分区。它也是一个贪婪的过程，你可能在阅读有关机器学习方法的资料时遇到这个术语。贪婪意味着在过程中的每个分支中，算法寻找 RSS 的最大减少，而不考虑它对后续分区性能的影响。结果是，你可能会得到一个包含许多不必要的分支的完整树，导致低偏差但高方差。为了控制这种影响，在构建完整树之后，你需要适当地修剪树到最佳大小。

图 6.1 展示了该技术在实际应用中的视觉效果。数据是假设的，包含 30 个观测值，响应值从 1 到 10 不等，以及两个预测特征，这两个特征的价值范围均为 0 到 10，分别命名为X1和X2。该树有三个分支，导致四个终端节点。每个分支基本上是一个if...then语句或使用 R 语言的ifelse()语法。第一个分支是：如果X1小于3.5，则响应值被分为四个观测值，*均值为2.4，剩余的 26 个观测值。这个包含四个观测值的左分支是一个终端节点，因为任何进一步的分支都不会显著提高 RSS。该树中该分区中这四个观测值的预测值成为*均值。下一个分支是在X2 < 4，最后是X1 < 7.5。

这种方法的优点是它可以处理高度非线性关系；然而，你能看到几个潜在的问题吗？第一个问题是，一个观测值被赋予其所属终端节点的*均值。这可能会损害整体预测性能（高偏差）。相反，如果你继续进一步分区数据，以实现低偏差，那么高方差可能成为一个问题。与其他方法一样，你可以使用交叉验证来选择合适的树深度大小：

图 6.1：具有 3 个分支和 4 个终端节点的回归树以及相应的节点*均数和观测值数量

分类树

分类树遵循与回归树相同的原理，只是分割不是由 RSS 决定的，而是由错误率决定的。使用的错误率不是你所期望的，计算只是将误分类的观测值除以总观测值。实际上，当涉及到树分割时，一个误分类率本身可能会导致一种情况，即进一步的分割可以获取信息，但不会提高误分类率。让我们看一个例子。

假设我们有一个节点，让我们称它为 N0，其中你有七个标记为 No 的观测值和三个标记为 Yes 的观测值，我们可以说误分类率是 30%。考虑到这一点，让我们计算一个常见的替代错误度量，称为基尼指数。单个节点的基尼指数公式如下：

然后，对于 N0，基尼指数是 1 - (.7)² - (.3)²，等于 0.42，与 30% 的误分类率相比。

以此为例，我们现在将创建一个名为 N1 的节点，它有三个来自 Class 1 的观测值，没有来自 Class 2 的观测值，以及一个名为 N2 的节点，它有四个来自 Class 1 的观测值和三个来自 Class 2 的观测值。现在，这个树分支的整体误分类率仍然是 30%，但看看整体基尼指数是如何提高的：

Gini(N1) = 1 - (3/3)² - (0/3)² = 0
Gini(N2) = 1 - (4/7)² - (3/7)² = 0.49
新的基尼指数 = (N1 的比例 x Gini(N1)) + (N2 的比例 x Gini(N2))，等于 (0.3 x 0) + (0.7 x 0.49) 或 0.343

通过在代理错误率上进行分割，我们实际上提高了模型的不纯度，将其从 0.42 降低到 0.343，而误分类率没有变化。这是 rpart() 包所使用的方法，我们将在本章中使用。

随机森林

为了极大地提高我们模型的预测能力，我们可以生成许多树并合并结果。随机森林技术通过在模型开发中应用两种不同的技巧来实现这一点。第一种是使用自助聚合或袋装法，正如其名称所示。

在袋装法中，单个树是基于数据集的随机样本构建的，大约占总观测值的二分之一（注意，剩余的三分之一被称为袋外（oob））。这会重复数十次或数百次，然后取*均值。这些树中的每一棵都是基于任何错误度量进行生长而不进行剪枝的，这意味着这些单个树的方差很高。然而，通过*均结果，你可以降低方差而不增加偏差。

随机森林带来的下一件事是，在随机抽取数据的同时——即袋装——它还随机抽取每个分割点的输入特征。在randomForest包中，我们将使用默认的预测因子抽样随机数，对于分类问题，这是总预测因子的*方根，对于回归，则是总预测因子数除以三。算法在每个分割点随机选择的预测因子数量可以通过模型调优过程进行更改。

通过在每个分割点进行特征随机抽样并将其纳入方法论，你可以减轻高度相关预测因子成为所有你的自助树的主要驱动因素的影响，防止你降低你希望通过袋装实现的方差。随后对彼此相关性较低的树的*均化更具一般性和对异常值更稳健，如果你只执行袋装的话。

梯度提升

提升方法可能变得极其复杂，难以学习和理解，但你应该牢记幕后的基本发生情况。主要思想是构建某种类型的初始模型（线性、样条、树等）称为基学习器，检查残差，并在所谓的损失函数周围拟合模型。损失函数仅仅是衡量模型与期望预测之间差异的函数，例如，回归中的*方误差或分类中的逻辑函数。这个过程会持续进行，直到达到某个指定的停止标准。这有点像那个参加模拟考试并且答错 100 题中的 30 题的学生，因此只复习这些答错的 30 题。在下一场模拟考试中，他们又答错了那 30 题中的 10 题，因此只关注这 10 题，以此类推。如果你想进一步探索这一理论的背后，Frontiers in Neurorobotics 上的一个很好的资源是Natekin A., Knoll A. (2013)的梯度提升机，教程，可在www.ncbi.nlm.nih.gov/pmc/articles/PMC3885826/找到。

正如刚才提到的，提升可以应用于许多不同的基学习器，但在这里我们只会关注基于树的学习的具体细节。每个树迭代都很小，我们将通过一个称为交互深度的调优参数来确定它有多小。实际上，它可能小到只有一个分割，这被称为树桩。

树按损失函数的顺序拟合到残差，直到我们指定的树的数量（我们的停止标准）。

在使用Xgboost包进行模型构建过程中，有许多参数需要调整，该包代表极端梯度提升。由于其在在线数据竞赛中的获胜表现，这个包已经变得非常流行。以下网站上提供了关于提升树和 Xgboost 的优秀背景资料：

xgboost.readthedocs.io/en/latest/model.html

在商业案例中，我们将展示如何开始优化超参数并产生有意义的输出和预测。这些参数可以相互影响，如果你只调整一个而不考虑其他，你的模型可能会降低性能。caret包将帮助我们进行调优。

商业案例

在这种情况下，整体业务目标是看看我们是否可以提高之前章节中已经处理的一些案例的预测能力。对于回归，我们将重新审视来自第四章，线性模型中的高级特征选择的前列腺癌数据集。我们需要改进的基线均方误差是 0.444。

对于分类目的，我们将利用来自第三章，逻辑回归和判别分析的乳腺癌活检数据和来自第五章，更多分类技术 - K 最*邻和支持向量机的皮马印第安人糖尿病数据。在乳腺癌数据中，我们达到了 97.6%的预测准确率。对于糖尿病数据，我们希望提高 79.6%的准确率。

随机森林和提升将应用于所有三个数据集。简单树方法仅用于来自第四章，线性模型中的高级特征选择的乳腺癌和前列腺癌数据集。

建模和评估

为了执行建模过程，我们需要加载七个不同的 R 包。然后，我们将逐一介绍这些技术，并比较它们在之前章节中使用先前方法分析的数据上的表现。

回归树

我们将直接跳到prostate数据集，但首先让我们加载必要的 R 包。和往常一样，请在加载包之前确保你已经安装了这些库：

  > library(rpart) #classification and regression trees
  > library(partykit) #treeplots
  > library(MASS) #breast and pima indian data
  > library(ElemStatLearn) #prostate data
  > library(randomForest) #random forests
  > library(xgboost) #gradient boosting
  > library(caret) #tune hyper-parameters

我们将首先使用prostate数据进行回归，并像在第四章，线性模型中的高级特征选择中做的那样准备数据。这包括调用数据集，使用ifelse()函数将gleason评分编码为指示变量，并创建test和train集。train集将是pros.train，而test集将是pros.test，如下所示：

  > data(prostate)
  > prostate$gleason <- ifelse(prostate$gleason == 6, 0, 1)
  > pros.train <- subset(prostate, train == TRUE)[, 1:9]
  > pros.test <- subset(prostate, train == FALSE)[, 1:9]

要在train数据上构建回归树，我们将使用 R 的party包中的rpart()函数。语法与我们使用的其他建模技术非常相似：

  > tree.pros <- rpart(lpsa ~ ., data = pros.train)

我们可以调用这个对象并检查每个分割的误差，以确定树的最佳分割数：

  > print(tree.pros$cptable)
     CP nsplit rel error  xerror   xstd
  1 0.35852251   0 1.0000000 1.0364016 0.1822698
  2 0.12295687   1 0.6414775 0.8395071 0.1214181
  3 0.11639953   2 0.5185206 0.7255295 0.1015424
  4 0.05350873   3 0.4021211 0.7608289 0.1109777
  5 0.01032838   4 0.3486124 0.6911426 0.1061507
  6 0.01000000   5 0.3382840 0.7102030 0.1093327

这是一个非常重要的表格，需要分析。第一列标记为CP的是成本复杂度参数。第二列nsplit是树中的分割数。rel error列代表相对误差，是分割数的 RSS 除以无分割的 RSS（RSS(k)/RSS(0)）。xerror和xstd都是基于十折交叉验证的，其中xerror是*均误差，xstd是交叉验证过程的标准差。我们可以看到，虽然五个分割在full数据集上产生了最低的误差，但四个分割使用交叉验证产生了略低的误差。你可以使用plotcp()来检查这一点：

  > plotcp(tree.pros)

前一个命令的输出如下：

图表展示了树的大小与相应误差条对应的相对误差。图表上的水*线是最低标准误差的上限。选择一个树的大小，5，即四个分割，我们可以通过首先从表中创建一个与修剪后的树关联的cp对象来修剪我们的树，从而最小化xerror。然后prune()函数处理剩余的部分：

  > cp <- min(tree.pros$cptable[5, ])
  > prune.tree.pros <- prune(tree.pros, cp = cp)

完成这些后，你可以绘制并比较完整树和修剪后的树。partykit包生成的树图比party包生成的要好得多。你可以简单地使用as.party()函数作为plot()的包装器：

  > plot(as.party(tree.pros))

前一个命令的输出如下：

现在，我们将使用as.party()函数对修剪后的树进行处理：

  > plot(as.party(prune.tree.pros))

前一个命令的输出如下：

注意，两个树中的分割完全相同，除了最后一个分割，它包含了完整树的变量age。有趣的是，树中的第一个和第二个分割都与癌症体积的对数(lcavol)相关。这些图表非常有信息量，因为它们显示了分割、节点、每个节点的观测值以及我们试图预测的结果的箱线图。

让我们看看修剪后的树在test数据上的表现如何。我们将使用predict()函数创建预测值的对象，并包含test数据。然后，计算误差（预测值减去实际值），最后，计算*方误差的*均值：

  > party.pros.test <- predict(prune.tree.pros, newdata = pros.test)
  > rpart.resid <- party.pros.test - pros.test$lpsa 
  > mean(rpart.resid²) #caluclate MSE
  [1] 0.5267748

我们在第四章，线性模型中的高级特征选择中并没有提高预测值，那里的基线均方误差（MSE）是0.44。然而，这项技术并非没有价值。人们可以查看我们生成的树图，并轻松解释响应背后的主要驱动因素。正如引言中提到的，树很容易解释和说明，这在许多情况下可能比准确性更重要。

分类树

对于分类问题，我们将以与第三章，逻辑回归和判别分析中相同的方式准备乳腺癌数据。在加载数据后，您将删除患者 ID，重命名特征，消除少量缺失值，然后按照以下方式创建train/test数据集：

  > data(biopsy)
  > biopsy <- biopsy[, -1] #delete ID
  > names(biopsy) <- c("thick", "u.size", "u.shape", "adhsn", 
    "s.size", "nucl",
  "chrom", "n.nuc", "mit", "class") #change the feature names
  > biopsy.v2 <- na.omit(biopsy) #delete the observations with 
    missing values
  > set.seed(123) #random number generator
  > ind <- sample(2, nrow(biopsy.v2), replace = TRUE, prob = c(0.7, 
    0.3))
  > biop.train <- biopsy.v2[ind == 1, ] #the training data set
  > biop.test <- biopsy.v2[ind == 2, ] #the test data set

在数据设置适当的情况下，我们将使用与之前回归问题相同的语法风格来处理分类问题，但在创建分类树之前，我们需要确保结果是因子类型，这可以通过使用str()函数来完成：

  > str(biop.test[, 10])
   Factor w/ 2 levels "benign","malignant": 1 1 1 1 1 2 1 2 1 1 ...

首先，创建树，然后检查表以确定最佳分割数：

  > set.seed(123)
  > tree.biop <- rpart(class ~ ., data = biop.train)
  > tree.biop$cptable
    CP nsplit rel error  xerror    xstd
  1 0.79651163   0 1.0000000 1.0000000 0.06086254
  2 0.07558140   1 0.2034884 0.2674419 0.03746996
  3 0.01162791   2 0.1279070 0.1453488 0.02829278
  4 0.01000000   3 0.1162791 0.1744186 0.03082013

交叉验证误差在只有两个分割（行3）时达到最小。现在我们可以剪枝树，绘制剪枝后的树，并查看它在test集上的表现：

  > cp <- min(tree.biop$cptable[3, ])
  > prune.tree.biop <- prune(tree.biop, cp = cp)
  > plot(as.party(prune.tree.biop))

前一个命令的输出如下：

检查树图显示，细胞大小的均匀性是第一个分割，然后是核。完整的树在细胞厚度处还有一个额外的分割。我们可以使用predict()函数中的type="class"来预测test观测值，如下所示：

  > rparty.test <- predict(prune.tree.biop, newdata = biop.test, type 
   ="class")  
  > table(rparty.test, biop.test$class)
  rparty.test benign malignant
   benign    136     3
   malignant   6    64
  > (136+64)/209
  [1] 0.9569378

只有两个分割的基本树使我们几乎达到 96%的准确率。这仍然低于逻辑回归的 97.6%，但应该鼓励我们相信我们可以通过即将到来的方法来提高这一点，从随机森林开始。

随机森林回归

在本节中，我们将再次关注prostate数据。在继续到乳腺癌和皮马印第安人集之前。我们将使用randomForest包。创建random forest对象的一般语法是使用randomForest()函数，并指定公式和数据集作为两个主要参数。回想一下，对于回归，默认的每棵树迭代变量样本是 p/3，对于分类，它是 p 的*方根，其中 p 等于数据框中预测变量的数量。对于较大的数据集，在 p 的术语中，您可以调整mtry参数，这将确定每次迭代中采样的 p 的数量。如果这些示例中的 p 小于 10，我们将省略此过程。当您想要为较大的 p 数据集优化mtry时，您可以使用caret包或使用randomForest中的tuneRF()函数。有了这个，让我们构建我们的森林并检查结果，如下所示：

  > set.seed(123)
  > rf.pros <- randomForest(lpsa ~ ., data = pros.train)
  > rf.pros
  Call:
 randomForest(formula = lpsa ~ ., data = pros.train) 
 Type of random forest: regression
 Number of trees: 500
 No. of variables tried at each split: 2
 Mean of squared residuals: 0.6792314
 % Var explained: 52.73

rf.pros对象的调用显示随机森林生成了500棵不同的树（默认值）并在每次分割中采样两个变量。结果是 MSE 为0.68和几乎 53%的方差解释。让我们看看我们是否能改进默认的树的数量。过多的树可能导致过拟合；自然地，多少是过多的取决于数据。有两件事可以帮助，第一件事是rf.pros的图表，另一件事是要求最小 MSE：

  > plot(rf.pros)

前一个命令的输出如下：

这个图表显示了模型中树的数目与 MSE 的关系。您可以看到，随着树的增加，MSE 的显著改进发生在早期，然后在森林中构建了100棵树之前趋于*稳。

我们可以使用which.min()函数来识别特定的和最优的树，如下所示：

  > which.min(rf.pros$mse)
  [1] 75

我们可以通过在模型语法中指定ntree=75来尝试随机森林中的75棵树：

  > set.seed(123)
  > rf.pros.2 <- randomForest(lpsa ~ ., data = pros.train, ntree 
   =75)
  > rf.pros.2
  Call:
 randomForest(formula = lpsa ~ ., data = pros.train, ntree = 75) 
 Type of random forest: regression
 Number of trees: 75
 No. of variables tried at each split: 2
 Mean of squared residuals: 0.6632513
 % Var explained: 53.85

您可以看到均方误差（MSE）和解释的方差都略有提高。在测试模型之前，让我们看看另一个图表。如果我们正在结合使用自举样本构建的75棵不同树的结果，并且只有两个随机预测因子，我们需要一种方法来确定结果的原因。单独一棵树不能描绘这幅图，但您可以生成一个变量重要性图和相应的列表。y 轴是按重要性降序排列的变量列表，x 轴是 MSE 改进的百分比。注意，对于分类问题，这将是在基尼指数上的改进。该函数是varImpPlot()：

  > varImpPlot(rf.pros.2, scale = T, 
   main = "Variable Importance Plot - PSA Score")

前一个命令的输出如下：

与单棵树一致，lcavol是最重要的变量，lweight是第二重要的变量。如果您想检查原始数字，请使用importance()函数，如下所示：

  > importance(rf.pros.2)
      IncNodePurity
    lcavol  24.108641
 lweight  15.721079
 age  6.363778
 lbph  8.842343
 svi  9.501436
 lcp  9.900339
 gleason  0.000000
 pgg45  8.088635

现在，是时候看看它在test数据上的表现了：

  > rf.pros.test <- predict(rf.pros.2, newdata = pros.test)
  > rf.resid = rf.pros.test - pros.test$lpsa #calculate residual
  > mean(rf.resid²)
  [1] 0.5136894

均方误差（MSE）仍然高于我们在第四章中，使用 LASSO 的线性模型高级特征选择中实现的0.44，并且并不比单棵树更好。

随机森林分类

可能你对随机森林回归模型的性能感到失望，但这项技术的真正威力在于分类问题。让我们从乳腺癌诊断数据开始。这个过程几乎和我们在回归问题中做的一样：

  > set.seed(123) 
  > rf.biop <- randomForest(class ~. , data = biop.train)
  > rf.biop
  Call:
   randomForest(formula = class ~ ., data = biop.train)
          Type of random forest: classification
             Number of trees: 500
  No. of variables tried at each split: 3
      OOB estimate of error rate: 3.16%
  Confusion matrix:
       benign malignant class.error
  benign    294     8 0.02649007
  malignant   7    165 0.04069767

OOB误差率为3.16%。同样，这是将所有500棵树纳入分析的结果。让我们绘制误差与树的关系图：

  > plot(rf.biop)

上述命令的输出如下：

图表显示，在相当多的树中，最小误差和标准误差最低。现在我们再次使用which.min()来获取确切的数量。与前一次的不同之处在于，我们需要指定列1以获取误差率。这是整体误差率，并且将会有额外的列针对每个类别的误差率。在这个例子中我们不需要它们。此外，mse不再可用，而是使用err.rate代替，如下所示：

  > which.min(rf.biop$err.rate[, 1])
  [1] 19

只需要 19 棵树就可以优化模型准确率。让我们尝试一下，看看它的表现如何：

 > set.seed(123)
 > rf.biop.2 <- randomForest(class~ ., data = biop.train, ntree = 
   19)
  > print(rf.biop.2) 
  Call:
   randomForest(formula = class ~ ., data = biop.train, ntree = 19)
          Type of random forest: classification
             Number of trees: 19
  No. of variables tried at each split: 3
      OOB estimate of error rate: 2.95%
  Confusion matrix:
       benign malignant class.error
  benign    294     8 0.02649007
  malignant   6    166 0.03488372
  > rf.biop.test <- predict(rf.biop.2, newdata = biop.test, type = 
   "response")
  > table(rf.biop.test, biop.test$class)
  rf.biop.test benign malignant
    benign    139     0
    malignant   3    67
  > (139 + 67) / 209
  [1] 0.9856459

嗯，怎么样？训练集的误差率低于 3%，模型在测试集上的表现甚至更好，其中只有 3 个观测值被错误分类，共209个，没有一个是假阳性。回想一下，到目前为止最好的是逻辑回归，准确率为 97.6%。所以这似乎是我们迄今为止在乳腺癌数据上的最佳表现。在继续之前，让我们看一下变量重要性图：

  > varImpPlot(rf.biop.2)

上述命令的输出如下：

上述图表中重要性在于每个变量对 Gini 指数*均减少的贡献。这与单棵树的分裂有很大的不同。记住，完整的树在大小（与随机森林一致）处有分裂，然后是核，然后是厚度。这显示了构建随机森林的潜在力量，不仅在于预测能力，还在于特征选择。

接下来，我们将面对更困难的挑战——皮马印第安人糖尿病模型，我们首先需要以下方式准备数据：

  > data(Pima.tr)
  > data(Pima.te)
  > pima <- rbind(Pima.tr, Pima.te)
  > set.seed(502)
  > ind <- sample(2, nrow(pima), replace = TRUE, prob = c(0.7, 0.3))
  > pima.train <- pima[ind == 1, ]
  > pima.test <- pima[ind == 2, ]

现在，我们将继续构建模型，如下所示：

  > set.seed(321) 
  > rf.pima = randomForest(type~., data=pima.train)
  > rf.pima
  Call:
   randomForest(formula = type ~ ., data = pima.train)
          Type of random forest: classification
             Number of trees: 500
  No. of variables tried at each split: 2
      OOB estimate of error rate: 20%
  Confusion matrix:
     No Yes class.error
  No 233 29  0.1106870
  Yes 48 75  0.3902439

我们得到了20%的错误分类率误差，这并不比我们在训练集上之前做得更好。让我们看看优化树的大小是否能显著改善情况：

  > which.min(rf.pima$err.rate[, 1])
  [1] 80
  > set.seed(321)
  > rf.pima.2 = randomForest(type~., data=pima.train, ntree=80)
  > print(rf.pima.2)
  Call:
   randomForest(formula = type ~ ., data = pima.train, ntree = 80)
          Type of random forest: classification
             Number of trees: 80
  No. of variables tried at each split: 2
      OOB estimate of error rate: 19.48%
  Confusion matrix:
     No Yes class.error
  No 230 32  0.1221374
  Yes 43 80  0.3495935

在森林中有80棵树时，OOB误差率几乎没有改善。随机森林在测试数据上能否达到预期的效果？我们将在以下方式中看到：

  > rf.pima.test <- predict(rf.pima.2, newdata= pima.test, 
   type = "response")
  > table(rf.pima.test, pima.test$type)
  rf.pima.test No Yes
       No 75 21
       Yes 18 33
  > (75+33)/147
  [1] 0.7346939

嗯，我们在测试数据上只得到了 73%的准确率，这比我们使用 SVM 实现的准确率要低。

虽然随机森林在糖尿病数据上表现不佳，但它已被证明是目前乳腺癌诊断的最佳分类器。最后，我们将转向梯度提升。

极端梯度提升 - 分类

如前所述，我们将在本节中使用xgboost包，该包我们已经加载。鉴于该方法所获得的良好声誉，让我们在糖尿病数据上尝试它。

如提升概述中所述，我们将调整一些参数：

nrounds：最大迭代次数（最终模型中的树的数量）。
colsample_bytree：在构建树时采样的特征数量，以比率表示。默认为 1（100%的特征）。
min_child_weight：被提升的树中的最小权重。默认为 1。
eta：学习率，即每个树对解决方案的贡献。默认为 0.3。
gamma：在树中进行另一个叶分区所需的最小损失减少量。
subsample：数据观察值的比率。默认为 1（100%）。
max_depth：单个树的最大深度。

使用expand.grid()函数，我们将构建实验网格以运行caret包的训练过程。如果你没有指定所有前面的参数值，即使只是一个默认值，当你执行函数时，你将收到一个错误消息。以下值基于我之前所做的多次训练迭代。我鼓励你尝试你自己的调整值。

让我们按照以下方式构建网格：

 > grid = expand.grid(
 nrounds = c(75, 100),
 colsample_bytree = 1,
 min_child_weight = 1,
 eta = c(0.01, 0.1, 0.3), #0.3 is default,
 gamma = c(0.5, 0.25),
 subsample = 0.5,
 max_depth = c(2, 3)
 )

这创建了一个包含 24 个不同模型的网格，caret包将运行这些模型以确定最佳调整参数。需要注意的是，在我们将要处理的数据集大小上，这个过程只需要几秒钟。然而，在大数据集中，这可能需要数小时。因此，你必须运用你的判断，并通过对数据的小样本进行实验来识别调整参数，以防时间紧迫，或者你受限于硬盘驱动器的大小。

在使用caret包的train()函数之前，我想通过创建一个名为control的对象来指定trainControl参数。该对象将存储我们想要训练的调整参数的方法。我们将使用 5 折交叉验证，如下所示：

 > cntrl = trainControl(
   method = "cv",
   number = 5,
   verboseIter = TRUE,
   returnData = FALSE,
   returnResamp = "final" 
   )

要使用train.xgb()函数，只需指定公式，就像我们使用其他模型一样：train数据集输入、标签、方法、训练控制和实验网格。请记住设置随机种子：

 > set.seed(1)
 > train.xgb = train(
 x = pima.train[, 1:7],
 y = ,pima.train[, 8],
 trControl = cntrl,
 tuneGrid = grid,
 method = "xgbTree"
 )

由于我在trControl中设置了verboseIter为TRUE，你应该已经看到了每个 k 折中的每个训练迭代。

调用该对象将给我们最优参数和每个参数设置的每个结果，如下所示（为了简便起见已缩写）：

 > train.xgb
 eXtreme Gradient Boosting 
 No pre-processing
 Resampling: Cross-Validated (5 fold) 
 Summary of sample sizes: 308, 308, 309, 308, 307 
 Resampling results across tuning parameters:
 eta max_depth gamma nrounds Accuracy  Kappa 
 0.01 2     0.25  75    0.7924286 0.4857249
 0.01 2     0.25  100    0.7898321 0.4837457
 0.01 2     0.50  75    0.7976243 0.5005362
 ...................................................
 0.30 3     0.50  75    0.7870664 0.4949317
 0.30 3     0.50  100    0.7481703 0.3936924
 Tuning parameter 'colsample_bytree' was held constant at a 
  value of 1
 Tuning parameter 'min_child_weight' was held constant at a 
  value of 1
 Tuning parameter 'subsample' was held constant at a value of 0.5
 Accuracy was used to select the optimal model using the largest 
   value.
 The final values used for the model were nrounds = 75, max_depth = 
   2,
 eta = 0.1, gamma = 0.5, colsample_bytree = 1, min_child_weight = 1
 and subsample = 0.5.

这为我们提供了构建模型的最佳参数组合。在训练数据中的准确率为 81%，Kappa 值为 0.55。现在事情变得有点棘手，但这是我看到的最优实践。首先，创建一个参数列表，这些参数将由xgboost训练函数xgb.train()使用。然后，将数据框转换为输入特征矩阵和标签数值结果列表（0 和 1）。接下来，将特征和标签转换为所需的输入，即xgb.Dmatrix。尝试以下操作：

 > param <- list( objective = "binary:logistic", 
   booster = "gbtree",
   eval_metric = "error",
   eta = 0.1, 
   max_depth = 2, 
   subsample = 0.5,
   colsample_bytree = 1,
   gamma = 0.5
   )  
  > x <- as.matrix(pima.train[, 1:7])
 > y <- ifelse(pima.train$type == "Yes", 1, 0)
 > train.mat <- xgb.DMatrix(data = x, label = y)

准备好所有这些后，只需创建模型：

 > set.seed(1)
 > xgb.fit <- xgb.train(params = param, data = train.mat, nrounds = 
   75)

在查看测试集上的表现之前，让我们检查变量重要性并绘制出来。你可以检查三个项目：增益、覆盖率和频率。增益是特征对其所在分支的准确率提升。覆盖率是与该特征相关的总观察值的相对数量。频率是特征在所有树中出现的百分比。以下代码生成所需的输出：

 > impMatrix <- xgb.importance(feature_names = dimnames(x)[[2]], 
   model = xgb.fit) > impMatrix
 Feature    Gain   Cover Frequency
 1:   glu 0.40000548 0.31701688 0.24509804
 2:   age 0.16177609 0.15685050 0.17156863
 3:   bmi 0.12074049 0.14691325 0.14705882
 4:   ped 0.11717238 0.15400331 0.16666667
 5:  npreg 0.07642333 0.05920868 0.06862745
 6:  skin 0.06389969 0.08682105 0.10294118
 7:   bp 0.05998254 0.07918634 0.09803922 > xgb.plot.importance(impMatrix, main = "Gain by Feature")

上述命令的输出如下：

特征重要性与其他方法相比如何？

这是我们在测试集上的表现，测试数据必须是一个矩阵。让我们也引入来自InformationValue包的工具来帮助我们。此代码加载库并生成一些输出以分析模型性能：

 > library(InformationValue)
  > pred <- predict(xgb.fit, x)
  > optimalCutoff(y, pred)
  [1] 0.3899574
 > pima.testMat <- as.matrix(pima.test[, 1:7])
 > xgb.pima.test <- predict(xgb.fit, pima.testMat)
 > y.test <- ifelse(pima.test$type == "Yes", 1, 0) > confusionMatrix(y.test, xgb.pima.test, threshold = 0.39)
 0 1
 0 72 16
 1 20 39
 > 1 - misClassError(y.test, xgb.pima.test, threshold = 0.39)
 [1] 0.7551

你注意到我使用optimalCutoff()做了什么吗？嗯，这个来自InformationValue的功能提供了最小化错误的最佳概率阈值。顺便说一句，模型误差大约为 25%。它仍然不如我们的 SVM 模型。作为旁白，我们看到 ROC 曲线和 AUC 值超过 0.8 的成就。以下代码生成 ROC 曲线：

 > plotROC(y.test, xgb.pima.test)

代码的输出如下：

模型选择

记得我们本章的主要目标是使用基于树的算法来提高前几章中完成的工作的预测能力。我们学到了什么？首先，在具有定量响应的prostate数据上，我们没有能够改进我们在第四章，线性模型中的高级特征选择中产生的线性模型。其次，在第三章，逻辑回归和判别分析中的威斯康星州乳腺癌数据上，随机森林优于逻辑回归。最后，并且我必须说有点失望，我们没有能够通过提升树改进 Pima 印第安人糖尿病数据上的 SVM 模型。

因此，我们可以放心，我们对于前列腺癌和乳腺癌问题有很好的模型。我们将在第七章，“神经网络与深度学习”中再尝试一次，以改进糖尿病模型。在我们结束这一章之前，我想介绍使用随机森林技术进行特征消除的强大方法。

使用随机森林进行特征选择

到目前为止，我们已经探讨了几个特征选择技术，例如正则化、最佳子集和递归特征消除。我现在想介绍一个使用Boruta包对随机森林分类问题进行有效特征选择的方法。有一篇论文提供了关于它是如何提供所有相关特征的详细说明：

Kursa M., Rudnicki W. (2010), 使用 Boruta 包进行特征选择，《统计软件杂志》，36(11)，1 - 13

我在这里要做的是提供一个算法概述，并将其应用于大量数据集。这不会作为一个单独的业务案例，而是一个应用该方法的模板。我发现它非常有效，但请注意，它可能计算量很大。这似乎与目的相悖，但它有效地消除了不重要的特征，使你能够专注于构建一个更简单、更高效、更有洞察力的模型。这是值得的时间投资。

在高层次上，该算法通过复制所有输入并打乱它们观察的顺序来创建影子属性，以去相关化。然后，在所有输入上构建一个随机森林模型，并计算每个特征（包括影子属性）的*均准确度损失的 Z 分数。与影子属性相比，Z 分数显著更高或显著更低的特征被认为是重要的，而分别被认为是不重要的。移除影子属性和已知重要性的特征，然后重复此过程，直到所有特征都被分配一个重要性值。你也可以指定随机森林迭代的最大次数。算法完成后，每个原始特征将被标记为确认、暂定或拒绝。你必须决定是否将暂定特征包括在进一步的建模中。根据你的情况，你有一些选择：

改变随机种子并多次（k 次）重新运行该方法，只选择在所有 k 次运行中均得到确认的特征
将你的数据（训练数据）分为 k 个折，对每个折进行单独的迭代，并选择那些在所有 k 个折中均得到确认的特征

注意，所有这些都可以用几行代码完成。让我们看看代码，将其应用于 mlbench 包中的 Sonar 数据。它包含 208 个观测值，60 个数值输入特征，以及一个用于分类的标签向量。标签是因子，其中 R 表示 sonar 对象是岩石，M 表示是矿。首先要做的事情是加载数据并进行快速的数据探索：

 > data(Sonar, package="mlbench")
 > dim(Sonar)
 [1] 208 61
 > table(Sonar$Class)
 M R 
 111 97

要运行算法，你只需要加载 Boruta 包并在 boruta() 函数中创建一个公式。请注意，标签必须是因子，否则算法将无法工作。如果你想跟踪算法的进度，指定 doTrace = 1。另外，别忘了设置随机种子：

 > library(Boruta)
 > set.seed(1)
 > feature.selection <- Boruta(Class ~ ., data = Sonar, doTrace = 1)

如前所述，这可能会计算密集。以下是我那老式笔记本电脑上所需的时间：

 > feature.selection$timeTaken
 Time difference of 25.78468 secs

一个简单的表格将提供最终重要性决策的计数。我们看到我们可以安全地消除一半的特征：

 > table(feature.selection$finalDecision)
 Tentative Confirmed Rejected 
 12    31    17

使用这些结果，创建一个新的包含所选特征的 data frame 简单易行。我们开始使用 getSelectedAttributes() 函数来捕获特征名称。在这个例子中，我们只选择那些已确认的。如果我们想包括已确认的和暂定的，我们只需在函数中指定 withTentative = TRUE：

 > fNames <- getSelectedAttributes(feature.selection) # withTentative = TRUE
 > fNames
 [1] "V1" "V4" "V5" "V9" "V10" "V11" "V12" "V13" "V15" "V16"
 [11] "V17" "V18" "V19" "V20" "V21" "V22" "V23" "V27" "V28" "V31"
 [21] "V35" "V36" "V37" "V44" "V45" "V46" "V47" "V48" "V49" "V51"
 [31] "V52"

使用特征名称，我们创建 Sonar 数据的子集：

 > Sonar.features <- Sonar[, fNames]
 > dim(Sonar.features)
 [1] 208 31

就这样！Sonar.features 数据框包含了来自 boruta 算法的所有已确认的特征。现在它可以被用于进一步的有意义的数据探索和分析。只需几行代码和一些耐心，让算法完成其工作，就可以显著提高你的建模努力和洞察力生成。

摘要

在本章中，你学习了基于树的机器学习方法在分类和回归问题中的优势和局限性。单个树虽然易于构建和解释，但可能不具备解决我们试图解决的问题所需的预测能力。为了提高预测能力，我们有随机森林和梯度提升树等工具可供使用。在随机森林中，构建了数百甚至数千棵树，并将结果汇总以进行整体预测。随机森林中的每一棵树都是使用数据的一个样本（称为 bootstrapping）以及预测变量的一个样本构建的。至于梯度提升，首先生成一个初始的、相对较小的树。在此初始树构建之后，后续的树基于残差/误分类生成。这种技术的预期结果是构建一系列的树，可以在过程中改进先前树的弱点，从而降低偏差和方差。我们还看到，在 R 中，可以利用随机森林作为特征选择方法。

虽然这些方法非常强大，但在机器学习的世界里，它们并不是某种灵丹妙药。不同的数据集需要分析师的判断，以确定哪些技术适用。应用于分析和调整参数选择的技术同样重要。这种精细调整可能对良好预测模型和优秀预测模型之间的差异产生重大影响。

在下一章中，我们将注意力转向使用 R 语言构建神经网络和深度学习模型。

第七章：神经网络与深度学习

“忘记人工智能吧 - 在大数据的勇敢新世界中，我们应该警惕的是人工愚蠢。”

托马斯·查特菲尔德

我记得在 2012 年中期左右的一次会议上，我参与了一个小组讨论某些分析的结果，当时桌子旁的一位人士带着一丝恼怒和恐惧的语气说，“这”不是“那种”神经****网络，“是吗？”我知道他过去与神经网络有过冲突，并且对此有深深的焦虑，所以我用一些讽刺的话安慰他，说神经网络基本上已经走向了恐龙的道路。没有人反对！几个月后，当我参加一个当地会议时，我被震惊了，因为讨论的重点竟然是神经网络和神秘的深度学习。像 Ng、Hinton、Salakhutdinov 和 Bengio 这样的机器学习先驱们使神经网络复兴，并提高了它们的性能。

大量的媒体炒作围绕着这些方法，高科技公司如 Facebook、Google 和 Netflix 投入了数亿美元，甚至可能更多。这些方法在语音识别、图像识别和自动化方面取得了有希望的结果。如果自动驾驶汽车不再偏离道路相互碰撞，那肯定是因为这里讨论的方法。

在本章中，我们将讨论这些方法的工作原理、它们的优点和固有的缺点，以便你能够就它们进行交谈。我们将通过一个神经网络的实际商业应用来操作。最后，我们将在一个基于云的应用中应用深度学习方法。

神经网络简介

神经网络是一个相当宽泛的术语，涵盖了多种相关方法，但就我们而言，我们将专注于一种前馈网络，它通过反向传播进行训练。我不会浪费我们的时间讨论机器学习方法论与生物大脑工作方式的相似之处或不同之处。我们只需要从神经网络是什么的工作定义开始。我认为维基百科的条目是一个很好的起点。

在机器学习和认知科学中，人工神经网络（ANNs）是一系列受生物神经网络（特别是动物的中央神经系统，尤其是大脑）启发的统计学习模型，用于估计或*似依赖于大量输入且通常未知的功能。zh.wikipedia.org/wiki/人工神经网络

神经网络的动机或好处是，它们允许对输入/特征和响应变量之间的复杂关系进行建模，尤其是如果这些关系高度非线性。创建和评估模型不需要任何潜在假设，并且它可以用于定性和定量响应。如果这是阴，那么阳就是常见的批评，即结果是黑盒，这意味着没有方程式可以检查和与商业伙伴分享。事实上，结果几乎不可解释。其他批评围绕着结果如何仅通过改变初始随机输入而有所不同，以及训练神经网络计算量大且耗时。

神经网络的数学背景不是微不足道的。然而，至少要了解正在发生的事情是至关重要的。一种直观地发展这种理解的好方法是开始一个简单神经网络的图表。

在这个简单的网络中，输入或协变量由两个节点或神经元组成。标记为1的神经元代表常数，或者更合适地说，是截距。X1代表一个定量变量。W代表乘以输入节点值的权重。这些值成为输入节点到隐藏节点的输入。你可以有多个隐藏节点，但这里只发生的事情的基本原则是相同的。在隐藏节点H1中，权重值计算被求和。由于截距表示为1，那么这个输入值仅仅是权重，W1。现在发生魔法。求和的值随后通过激活函数进行转换，将输入信号转换为输出信号。在这个例子中，因为它只有一个隐藏节点，所以它乘以W3，成为Y的估计，我们的响应。这是算法的前馈部分：

但等等，还有更多！正如所知，为了完成循环或时代，会发生反向传播，并根据所学内容训练模型。为了启动反向传播，会根据损失函数（如均方误差或交叉熵等）确定一个错误。由于权重W1和W2被设置为[-1, 1]之间的某些初始随机值，初始错误可能很高。反向工作，权重被改变以最小化损失函数中的错误。以下图表描绘了反向传播部分：

这完成了一个时代。这个过程会继续进行，使用梯度下降（在第五章中讨论，更多分类技术 - K 最*邻和支持向量机），直到算法收敛到最小误差或预指定的时代数。如果我们假设我们的激活函数仅仅是线性的，在这个例子中，我们最终会得到Y = W3(W1(1) + W2(X1))。

如果添加了大量的输入神经元、隐藏节点中的多个神经元，甚至多个隐藏节点，网络可能会变得复杂。需要注意的是，从神经元输出的连接到所有后续神经元的连接都分配了权重。这大大增加了模型复杂性。增加隐藏节点和在隐藏节点中增加神经元数量并没有像我们希望的那样提高人工神经网络的性能。因此，深度学习的发展发生了，这在一定程度上放宽了所有这些神经元连接的要求。

有许多激活函数可以使用/尝试，包括一个简单的线性函数，或者对于分类问题，使用sigmoid函数，它是逻辑函数的特殊情况（第三章，逻辑回归和判别分析）。其他常见的激活函数包括Rectifier、Maxout和双曲正切（tanh）。

我们可以在 R 中绘制sigmoid函数，首先创建一个R函数来计算sigmoid函数的值：

    > sigmoid = function(x) {
     1 / ( 1 + exp(-x) )
     }

然后，在一系列值范围内绘制函数就变得简单了，比如从-5到5：

 > x <- seq(-5, 5, .1) > plot(sigmoid(x))

前一个命令的输出如下：

tanh函数（双曲正切）是对逻辑sigmoid的缩放，输出值在-1和1之间。tanh函数与sigmoid的关系如下，其中x是sigmoid函数：

tanh(x) = 2 *** sigmoid(2x) - 1

为了比较，让我们绘制tanh和sigmoid函数。同时，我们也使用ggplot：

 > library(ggplot2)
 > s <- sigmoid(x)
 > t <- tanh(x)
 > z <- data.frame(cbind(x, s, t))
 > ggplot(z, aes(x)) +
 geom_line(aes(y = s, color = "sigmoid")) +
 geom_line(aes(y = t, color = "tanh"))

前一个命令的输出如下：

那么为什么使用tanh函数而不是sigmoid函数呢？关于这个问题似乎有很多意见；tanh在神经网络中是否流行？简而言之，假设你有一个均值为 0，方差为 1 的缩放数据，tanh函数允许权重*均接*零（零中心化）。这有助于避免偏差并提高收敛性。想想在sigmoid函数激活中，从输出神经元到输入神经元始终有正权重的含义。在反向传播过程中，权重将在层之间变为全部为正或全部为负。这可能会导致性能问题。此外，由于sigmoid在尾部（0 和 1）的梯度几乎为零，在反向传播过程中，可能会发生几乎没有任何信号在不同层神经元之间流动的情况。关于这个问题的全面讨论，参见 LeCun（1998）。记住，tanh总是更好的结论并不是必然的。

所有这些都听起来非常吸引人，但人工神经网络（ANN）几乎步入了迪斯科的行列，因为它并没有像宣传的那样表现出色，尤其是在尝试使用具有许多隐藏层和神经元的深度网络时。似乎随着 Hinton 和 Salakhutdinov（2006 年）发表的开创性论文，神经网络经过重新定义，甚至可以说是重新命名，深度学习才逐渐复兴。

深度学习，一个不太深入的概述

那么，这种吸引我们注意力和头条的深度学习究竟是什么呢？让我们再次查阅维基百科，以获得一个工作定义：深度学习是机器学习的一个分支，它基于一系列算法，通过使用模型架构，以复杂结构或其它方式，由多个非线性变换组成，试图在数据中模拟高级抽象。这听起来就像是一位律师写的。深度学习的特点在于它基于人工神经网络（ANN），其中机器学习技术，主要是无监督学习，用于从输入变量中创建新特征。我们将在接下来的几章中深入探讨一些无监督学习技术，但可以将其视为在无响应变量存在的情况下寻找数据结构。简单来说，就是元素周期表，这是一个在未指定响应的情况下寻找结构的经典案例。在网上查找这张表，你会看到它是根据原子结构组织的，金属在一侧，非金属在另一侧。它是基于潜在分类/结构创建的。这种对潜在结构/层次结构的识别是深度学习与普通 ANN 的区别所在。深度学习某种程度上解决了是否有一个算法比仅仅使用原始输入更好地表示结果的问题。换句话说，我们的模型能否学会仅用原始像素作为唯一输入来对图片进行分类？这在只有少量标记响应但大量未标记输入数据的情况下非常有帮助。你可以使用无监督学习来训练你的深度学习模型，然后将这种监督方式应用于标记数据，来回迭代。

这些潜在结构的识别在数学上并不简单，但一个例子是我们在第四章，线性模型中的高级特征选择中探讨的正则化概念。在深度学习中，可以使用正则化方法（如L1（惩罚非零权重）、L2（惩罚大权重）和 dropout（随机忽略某些输入并将其权重置零））来惩罚权重。在标准 ANN 中，这些正则化方法都没有发生。

另一种方法是降低数据的维度。其中一种方法是自动编码器。这是一个神经网络，其中输入被转换为一组降低维度的权重。在下面的图中，请注意特征 A没有连接到隐藏节点之一：

这可以递归地应用，学习可以在多个隐藏层上发生。在这种情况下，你所看到的是网络在层层叠加时发展出特征的特征。深度学习首先按顺序学习两层之间的权重，然后仅使用反向传播来微调这些权重。其他特征选择方法包括受限玻尔兹曼机和稀疏编码模型。

这些细节超出了我们的范围，有很多资源可以学习具体细节。以下是一些起点：

www.cs.toronto.edu/~hinton/

deeplearning.net/

深度学习在许多分类问题上表现良好，包括赢得 Kaggle 竞赛或两次。它仍然受到人工神经网络的问题，特别是黑盒问题的困扰。试着向不知情的人解释神经网络内部正在发生什么。然而，对于解释“如何”不是问题，而重要问题是“什么”的问题，它是合适的。毕竟，我们真的关心自动驾驶汽车为什么避免撞到行人，还是我们关心它没有撞到的事实？此外，Python 社区在深度学习使用和包方面比 R 社区有先发优势。正如我们将在实际练习中看到的，差距正在缩小。

虽然深度学习是一项令人兴奋的任务，但请注意，为了充分发挥其功能，你需要高度的计算能力，并花时间通过微调超参数来训练最佳模型。以下是一些你需要考虑的因素：

激活函数
隐藏层的尺寸和数量
维度降低，即受限玻尔兹曼机与自动编码器
迭代次数
梯度下降学习率
损失函数
正则化

深度学习资源和高级方法

你可以用作学习和解释的更有趣的视觉工具之一是 TensorFlow^(TM)提供的交互式小部件：playground.tensorflow.org/。这个工具允许你探索，或者像网站所说的那样，摆弄各种参数以及它们如何影响响应，无论是分类问题还是回归问题。我可以花很多小时摆弄它。

这里有一个有趣的任务：创建你自己的实验设计，看看各种参数如何影响你的预测。

到目前为止，似乎增长最快的两个深度学习开源工具是 TensorFlow^(TM)和 MXNet。我仍然更喜欢使用我们将要看到的包h2o，但了解和学习最新技术是很重要的。你可以使用 R 访问 TensorFlow^(TM)，但需要先安装 Python。本系列教程将指导你如何启动和运行：

rstudio.github.io/tensorflow/.

MXNet 不需要安装 Python，相对容易安装和运行。它还提供了一些预训练模型，允许你快速开始预测。有几个 R 教程可用：

mxnet.io/.

我现在想花时间列举一些深度神经网络的变体以及它们在哪些学习任务中表现良好。

卷积神经网络（CNN）假设输入是图像，并从数据切片或小部分中创建特征，这些特征被组合起来创建特征图。将这些小切片想象成网络在训练过程中学习的过滤器或更恰当地说，是核。CNN 的激活函数是修正线性单元（ReLU）。它简单表示为 f(x) = max(0, x)，其中 x 是神经元的输入。CNN 在图像分类、目标检测甚至句子分类方面表现良好。

循环神经网络（RNN）是为了利用序列信息而创建的。在传统的神经网络中，输入和输出是相互独立的。在 RNN 中，输出依赖于先前层的计算，允许信息在层之间持续。所以，从一个神经元（y）的输出；它不仅基于其输入（t），还基于所有先前层（t-1, t-n...）。它在手写和语音检测方面非常有效。

长短期记忆（LSTM）是循环神经网络（RNN）的一个特例。RNN 的问题在于它对具有长信号的数据表现不佳。因此，LSTMs 被创建出来以捕捉数据中的复杂模式。RNN 在训练过程中以相同的方式结合信息，而不管信息在一个步骤中相对于其他步骤是更有价值还是更无价值。LSTMs 试图通过在训练的每个步骤中决定要记住什么来克服这一限制。这种权重矩阵与数据向量的乘积被称为门，它充当信息过滤器。LSTM 中的神经元将有两个输入和两个输出。来自先前输出的输入和从先前门传递的内存向量。然后，它产生输出值和输出内存作为下一层的输入。LSTMs 的局限性在于需要大量的训练数据，并且计算密集。LSTMs 在语音识别问题上表现良好。

我建议你使用 MXNet 的教程来帮助你理解如何开发这些模型以供自己使用。

就这样，让我们继续探讨一些实际应用。

商业理解

1998 年 4 月 20 日那天晚上，天气晴朗，天空清澈。我是一名学生飞行员，驾驶着一架休斯 500D 直升机，从明尼苏达州圣保罗市中心的机场进行了一次长途飞行，返回到古老的格兰 Forks，北达科他州。这次飞行是我获得直升机仪表等级测试前的最后要求。我的飞行日志显示，我们距离 VOR 在 Victor 2 航线上 35 英里或 35 海里。这使我们位于明尼苏达州圣克劳德市以南/东南方向，以我记忆中的 4,500 英尺的海拔高度，大约以 120 节的速度飞行。然后，发生了...BOOOOM！说这是一声震耳欲聋的爆炸声，随后是一阵飓风般的风吹到脸上，这并不夸张。

所有这一切都始于我的飞行教练问了一个关于我们计划进入明尼苏达州亚历山大的仪表进*的*凡问题。我们交换了飞机的控制权，我弯下腰查看膝上板上仪表进*图。当我戴上红色镜头手电筒时，爆炸发生了。由于我是脸朝下的姿势，声音和随之而来的风力，几个想法闪过我的脑海：直升机正在解体，我正在坠落死亡，我的脑海中浮现出像高清电影一样的挑战者号航天飞机爆炸场景。在 1.359 秒的尖叫停止后，我们意识到我面前的聚碳酸酯风挡几乎已经没有了，但其他一切正常。在减速飞机后，粗略检查发现驾驶舱覆盖着血、内脏和羽毛。我们在明尼苏达州中部击中了一只绿头鸭，在这个过程中，我们摧毁了风挡。如果我没有在看我的膝上板，我就会被羽毛覆盖。我们只是宣布紧急情况，取消了与明尼苏达中心机场的飞行计划，就像孟菲斯美女号一样，一瘸一拐地进入亚历山大便于等待来自北达科他大学（战斗苏族之家）的同胞们的救援。

那又如何呢？我想指出我是多么的喜欢 NASA 和宇航员。在一个令人恐惧的时刻，我短暂地以为我将要结束生命，我的思绪飘向了航天飞机。我们这个年龄的大部分男性都想和乔治·布雷特或韦恩·格雷茨基握手。我也想，事实上我也确实和巴兹·奥尔德林握了手。（毕竟，当时他在北达科他大学任教。）因此，当我发现shuttle数据集在MASS包中时，我不得不将其包含在这本书中。顺便说一句，如果你有机会去肯尼迪航天中心看看航天飞机亚特兰蒂斯号的展览，千万不要错过。

对于这个问题，我们将尝试开发一个神经网络来回答是否应该使用自动着陆系统。默认决策是让机组人员着陆飞船。然而，在机组人员受伤或长时间轨道操作后重新进入时重力产生不利影响的情况下，可能需要自动着陆能力。这些数据基于计算机模拟，而不是实际飞行。实际上，自动着陆系统经历了一些考验和磨难，大多数情况下，航天飞机宇航员在着陆过程中负责。以下是一些提供更多背景信息的链接：

www.spaceref.com/news/viewsr.html?pid=10518

waynehale.wordpress.com/2011/03/11/breaking-through/

数据理解和准备

首先，我们将加载这四个包。数据位于MASS包中：

 > library(caret)
 > library(MASS)
 > library(neuralnet)
 > library(vcd)

将使用neuralnet包来构建模型，使用caret进行数据准备。vcd包将帮助我们进行数据可视化。让我们加载数据并检查其结构：

    > data(shuttle)
    > str(shuttle)
    'data.frame':256 obs. of  7 variables:
     $ stability: Factor w/ 2 levepicels "stab","xstab": 2 2 2 2 2 2 2        
       2 2 2 ...
     $ error    : Factor w/ 4 levels "LX","MM","SS",..: 1 1 1 1 1 1 1 1        
       1 1 ...
     $ sign     : Factor w/ 2 levels "nn","pp": 2 2 2 2 2 2 1 1 1 1 ...
     $ wind     : Factor w/ 2 levels "head","tail": 1 1 1 2 2 2 1 1 1 2        
       ...
     $ magn     : Factor w/ 4 levels "Light","Medium",..: 1 2 4 1 2 4 1        
       2 4 1 ...
     $ vis      : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 1 1        
       ...
     $ use      : Factor w/ 2 levels "auto","noauto": 1 1 1 1 1 1 1 1 1        
       1 ...

数据由256个观测值和7个变量组成。请注意，所有变量都是分类变量，响应变量为use，有两个水*，即auto和noauto。协变量如下：

stability：这是稳定的定位或不是（stab/xstab）
error：这是错误的尺寸（MM / SS / LX）
sign：这是错误的符号，正或负（pp/nn）
wind：这是风力的符号（head / tail）
magn：这是风力强度（Light / Medium / Strong / Out of Range）
vis：这是可见性（yes / no）

我们将构建多个表格来探索数据，从响应/结果开始：

    > table(shuttle$use)
    auto noauto 
       145    111

几乎 57%的时间，决策是使用自动着陆器。对于分类数据，有许多构建表格的可能性。table()函数完全足够用于比较，但如果添加第三个，看起来可能会变得混乱。vcd包提供了一系列表格和绘图函数。其中一个是structable()。这个函数将接受一个公式（column1 + column2 ~ column3），其中column3将成为表格的行：

    > table1 <- structable(wind + magn ~ use, shuttle)
    > table1
    wind  head                    tail 
           magn Light Medium Out Strong Light Medium Out Strong
    use 
    auto           19     19  16     18    19     19  16     19
    noauto         13     13  16     14    13     13  16     13

在这里，我们可以看到在风力Light的情况下，auto出现了19次，而noauto出现了13次。vcd包提供了mosaic()函数来绘制由structable()创建的表格，并提供卡方检验的p 值：

    > mosaic(table1, shading = T)

前一个命令的输出如下：

图表标题对应于它们在表格中各自单元格的成比例大小，这是通过递归拆分创建的。您还可以看到，p 值并不显著，因此变量是独立的，这意味着了解风速和/或magn的水*并不能帮助我们预测自动着陆器的使用。您不需要包含一个 structable() 对象来创建图表，因为它同样可以接受公式：

    > mosaic(use ~ error + vis, shuttle)

前一个命令的输出如下：

注意，表格的阴影已经改变，反映了零假设被拒绝和变量之间的依赖性。图表首先获取并拆分可见性。结果是，如果可见性为无，则使用自动着陆器。下一个拆分是按错误水*进行的。如果错误为SS或MM且vis为无，则可能建议使用自动着陆器，否则则不。不需要 p 值，因为灰色阴影表示显著性。

您还可以使用 prop.table() 函数作为 table() 的包装来检查成比例的表格：

    > table(shuttle$use, shuttle$stability)
             stab xstab
      auto     81    64
      noauto   47    64
    > prop.table(table(shuttle$use, shuttle$stability))
                  stab     xstab
      auto   0.3164062 0.2500000
      noauto 0.1835938 0.2500000

如果我们忘记了，卡方检验相当简单：

    > chisq.test(shuttle$use, shuttle$stability)
    Pearson's Chi-squared test with Yates' continuity
    correction
    data:  shuttle$use and shuttle$stability
    X-squared = 4.0718, df = 1, p-value = 0.0436

准备神经网络的数据非常重要，因为所有协变量和响应都需要是数值的。在我们的案例中，所有输入特征都是分类的。然而，caret 包允许我们快速创建虚拟变量作为我们的输入特征：

    > dummies <- dummyVars(use ~ .,shuttle, fullRank = T)
    > dummies
    Dummy Variable Object
    Formula: use ~ .
    7 variables, 7 factors
    Variables and levels will be separated by '.'
    A full rank encoding is used

要将这些放入数据框中，我们需要将 dummies 对象预测到现有的数据中，无论是相同还是不同的，在 as.data.frame() 中。当然，这里也需要相同的数据：

    > shuttle.2 = as.data.frame(predict(dummies, newdata=shuttle))

    > names(shuttle.2)
    [1] "stability.xstab" "error.MM"        "error.SS" 
    [4] "error.XL"        "sign.pp"         "wind.tail" 
    [7] "magn.Medium"     "magn.Out"        "magn.Strong" 
    [10] "vis.yes" 

    > head(shuttle.2)
      stability.xstab error.MM error.SS error.XL sign.pp wind.tail
    1               1        0        0        0       1         0
    2               1        0        0        0       1         0
    3               1        0        0        0       1         0
    4               1        0        0        0       1         1
    5               1        0        0        0       1         1
    6               1        0        0        0       1         1
      magn.Medium magn.Out magn.Strong vis.yes
    1           0        0           0       0
    2           1        0           0       0
    3           0        0           1       0
    4           0        0           0       0
    5           1        0           0       0
    6           0        0           1       0

我们现在有一个包含十个变量的输入特征空间。稳定性现在是 stab 的 0 或 xstab 的 1。基本错误是 LX，其余三个变量代表其他类别。

可以使用 ifelse() 函数创建响应：

    > shuttle.2$use <- ifelse(shuttle$use == "auto", 1, 0)
    > table(shuttle.2$use)
    0   1 
    111 145

caret 包还提供了创建 train 和 test 集的功能。想法是将每个观察值索引为 train 或 test，然后相应地拆分数据。让我们以 70/30 的 train 到 test 比例进行拆分，如下所示：

    > set.seed(123)
    > trainIndex <- createDataPartition(shuttle.2$use, p = .7, list =       
       FALSE)

trainIndex 中的值为我们提供了行号；在我们的案例中，是 shuttle.2 中总行数的 70%。现在只需要创建 train/test 数据集：

    > shuttleTrain <- shuttle.2[trainIndex, ]
    > shuttleTest  <- shuttle.2[-trainIndex, ]

干得好！我们现在可以开始构建神经网络了。

建模和评估

如前所述，我们将使用的包是 neuralnet。neuralnet 中的函数将调用使用公式，就像我们在其他地方使用的那样，例如 y~x1+x2+x3+x4，data = df。在过去，我们使用 y~ 来指定数据中的所有其他变量作为输入。然而，neuralnet 在撰写本文时并不支持这一点。绕过这种限制的方法是使用 as.formula() 函数。首先创建一个变量名对象，然后我们将使用它作为输入，以便正确地将变量粘贴在等式的右侧：

    > n <- names(shuttleTrain)
    > form <- as.formula(paste("use ~", paste(n[!n %in% "use"], 
      collapse = " + ")))
    > form
    use ~ stability.xstab + error.MM + error.SS + error.XL + sign.pp +       
      wind.tail 
       + magn.Medium + magn.Out + magn.Strong + vis.yes

请记住这个函数供您自己使用，因为它可能非常有用。在 neuralnet 包中，我们将使用的函数名为 neuralnet()。除了公式外，还有四个其他关键参数我们需要检查：

hidden: 这是每层的隐藏神经元数量，最多可达三层；默认为 1
act.fct: 这是激活函数，默认为逻辑函数和 tanh 函数
err.fct: 这是计算误差的函数，默认为 sse；由于我们处理的是二元结果，我们将使用 ce 进行交叉熵
linear.output: 这是一个关于是否忽略默认为 TRUE 的 act.fct 的逻辑论证，因此对于我们的数据，这需要设置为 FALSE

您也可以指定算法。默认为具有反向传播的弹性算法，我们将使用它，并使用默认的一个隐藏神经元：

    > fit <- neuralnet(form, data = shuttleTrain, err.fct = "ce", 
      linear.output = FALSE)

这里是总体结果：

    > fit$result.matrix
      1
    error                         0.009928587504
    reached.threshold             0.009905188403
    steps                       660.000000000000
    Intercept.to.1layhid1        -4.392654985479
    stability.xstab.to.1layhid1   1.957595172393
    error.MM.to.1layhid1         -1.596634090134
    error.SS.to.1layhid1         -2.519372079568
    error.XL.to.1layhid1         -0.371734253789
    sign.pp.to.1layhid1          -0.863963659357
    wind.tail.to.1layhid1         0.102077456260
    magn.Medium.to.1layhid1      -0.018170137582
    magn.Out.to.1layhid1          1.886928834123
    magn.Strong.to.1layhid1       0.140129588700
    vis.yes.to.1layhid1           6.209014123244
    Intercept.to.use             30.721652703205
    1layhid.1.to.use            -65.084168998463

我们可以看到，错误率极低，为 0.0099。算法达到阈值所需的步数，即误差函数的绝对偏导数小于此误差（默认 = 0.1）时，第一个神经元的最高权重为 vis.yes.to.1layhid1，为 6.21。

您还可以查看所谓的广义权重。根据 neuralnet 包的作者，广义权重定义为第 i 个协变量对对数优势的贡献：

广义权重表示每个协变量 x[i] 的影响，因此在回归模型中与第 i 个回归参数有类似的解释。然而，广义权重依赖于所有其他协变量（Gunther 和 Fritsch，2010）。

可以调用并检查权重。我已经将输出简化为前四个变量和六个观测值。请注意，如果对每一行求和，您将得到相同的数字，这意味着权重对于每个协变量组合是相等的。请注意，由于随机权重初始化，您的结果可能会有所不同。

结果如下：

    > head(fit$generalized.weights[[1]])
          [,1]             [,2]         [,3]         [,4] 
 1 -4.374825405  3.568151106  5.630282059 0.8307501368 
 2 -4.301565756  3.508399808  5.535998871 0.8168386187 
 6 -5.466577583  4.458595039  7.035337605 1.0380665866 
 9 -10.595727733 8.641980909 13.636415225 2.0120579565 
 10 -10.270199330 8.376476707 13.217468969 1.9502422861 
 11 -10.117466745 8.251906491 13.020906259 1.9212393878

要可视化神经网络，只需使用 plot() 函数：

    > plot(fit)

下面的输出是前面命令的结果：

此图显示了变量权重和截距。您还可以在图中检查广义权重。让我们看看 vis.yes 与 wind.tail 的对比，后者具有较低的总体突触权重。注意 vis.yes 是偏斜的，而 wind.tail 权重的分布均匀，这意味着预测能力很小：

    > par(mfrow = c(1, 2))
    > gwplot(fit, selected.covariate = "vis.yes")
    > gwplot(fit, selected.covariate = "wind.tail")

下面的输出是前面命令的结果：

我们现在想看看模型的表现如何。这是通过 compute() 函数和指定拟合模型和协变量来完成的。此语法将用于对 test 和 train 集合的预测。一旦计算，就会创建一个包含 $net.result 的预测列表：

    > resultsTrain <- compute(fit, shuttleTrain[, 1:10])
    > predTrain <- resultsTrain$net.result

这些结果是以概率表示的，所以让我们将它们转换为0或1，并随后使用混淆矩阵：

    > predTrain <- ifelse(predTrain >= 0.5, 1, 0) 
    > table(predTrain, shuttleTrain$use)  
    predTrain  0  1
            0 81  0
            1  0 99

看看吧，神经网络模型已经达到了 100%的准确率。我们现在屏住呼吸，看看它在test集中的表现如何：

 > resultsTest <- compute(fit, shuttleTest[,1:10]) > predTest <- resultsTest$net.result > predTest <- ifelse(predTest >= 0.5, 1, 0) > table(predTest, shuttleTest$use)
 predTest  0  1
 0 29  0
 1  1 46

在test集中只有一个假阳性。如果您想识别这是哪一个，请使用which()函数将其单独列出，如下所示：

    > which(predTest == 1 & shuttleTest$use == 0)
    [1] 62

它是test集中的第62行，在完整数据集中是第203个观测值。

我将留给您去尝试构建一个达到 100%准确率的神经网络！

深度学习的一个示例

转移到航天飞机的话题，让我们通过使用h2o包来处理一个深度学习的实际示例。我们将使用我从 UCI 机器学习仓库修改过的数据来完成这项工作。原始数据和其描述可在archive.ics.uci.edu/ml/datasets/Bank+Marketing/找到。我所做的是，从较小的数据集bank.csv中提取数据，将数值变量缩放到均值为 0 和方差为 1，为字符变量/稀疏数值创建虚拟变量，并消除接*零方差变量。数据可在 github github.com/datameister66/data/上找到，也命名为bank_DL.csv。在本节中，我们将关注如何在 H20 *台上加载数据并运行深度学习代码来构建一个分类器，以预测客户是否会响应营销活动。

H2O 背景

H2O 是一个开源的预测分析*台，具有预构建的算法，例如 k *邻、梯度提升机和深度学习。您可以通过 Hadoop、AWS、Spark、SQL、noSQL 或您的硬盘驱动器将数据上传到该*台。它的好处是您可以在 R 中利用机器学习算法，并在本地机器上以更大的规模使用。如果您想了解更多信息，可以访问网站：h2o.ai/product/.

在 R 上安装 H2O 的过程略有不同。我在这里放上了给我最新更新（截至 2017 年 2 月 25 日）的代码。您可以使用它重新安装最新版本或从网站上获取：h2o-release.s3.amazonaws.com/h2o/rel-lambert/5/docs-website/Ruser/Rinstall.html/. 下面是安装最新版本的代码：

 # The following two commands remove any previously installed H2O      
      packages for 
     R.
 if ("package:h2o" %in% search()) { detach("package:h2o",     
      unload=TRUE) }
 if ("h2o" %in% rownames(installed.packages())) {     
      remove.packages("h2o") }

 # Next, we download packages that H2O depends on.
 if (! ("methods" %in% rownames(installed.packages()))) {     
    install.packages("methods") }
 if (! ("statmod" %in% rownames(installed.packages()))) {   
    install.packages("statmod") }
 if (! ("stats" %in% rownames(installed.packages()))) { 
    install.packages("stats") }
 if (! ("graphics" %in% rownames(installed.packages()))) { 
    install.packages("graphics") }
 if (! ("RCurl" %in% rownames(installed.packages()))) {  
    install.packages("RCurl") }
 if (! ("jsonlite" %in% rownames(installed.packages()))) { 
    install.packages("jsonlite") }
 if (! ("tools" %in% rownames(installed.packages()))) { 
    install.packages("tools") }
 if (! ("utils" %in% rownames(installed.packages()))) { 
    install.packages("utils") }

 # Now we download, install and initialize the H2O package for R.
 install.packages("h2o", type="source", repos=(c("http://h2o-   
    release.s3.amazonaws.com/h2o/rel-tverberg/5/R")))

将数据上传到 H2O

假设您已经将bank_DL.csv文件保存在工作目录中。记住，getwd()会为您提供路径。因此，让我们加载库并创建一个包含数据文件路径的对象：

 > library(h2o)
    > path <- "C:/.../bank_DL.csv"

我们现在可以连接到 H2O 并在集群上启动一个实例。指定nthreads = -1请求我们的实例使用集群上的所有 CPU：

    > localH2O = h2o.init(nthreads = -1)

H2O 函数h2o.uploadFile()允许你将文件上传/导入到 H2O 云。以下函数也适用于上传：

h2o.importFolder
h2o.importURL
h2o.importHDFS

上传文件非常简单，一个百分比指示器跟踪状态：

    > bank <- h2o.uploadFile(path = path)
      |=========================================================| 100%

数据现在在H2OFrame中，你可以通过class()来验证，如下所示：

 > class(bank)
 [1] "H2OFrame"

H2O 中的许多 R 命令可能产生的输出与您习惯看到的不同。例如，看看我们数据的结构（输出摘要）：

 > str(bank)
 Class 'H2OFrame' <environment: 0x0000000032d02e80> 
 - attr(*, "op")= chr "Parse"
 - attr(*, "id")= chr "bank_DL_sid_95ad_2"
 - attr(*, "eval")= logi FALSE
 - attr(*, "nrow")= int 4521
 - attr(*, "ncol")= int 64
 - attr(*, "types")=List of 64

我们看到它由 4,521 个观测值（nrow）和 64 列（ncol）组成。顺便说一句，head()和summary()函数在常规 R 中的工作方式完全相同。在分割数据集之前，让我们看看我们的响应分布。它是名为y的列：

 > h2o.table(bank$y)
 y Count
 1 no  4000
 2 yes  521
 [2 rows x 2 columns]

我们看到，银行中有 521 位客户对优惠表示了肯定，而 4,000 位没有。这种响应是不*衡的。在多类学习章节中讨论了可以用来处理不*衡响应标签的技术。在这个练习中，让我们看看深度学习在没有标签*衡的情况下会表现如何。

创建训练和测试数据集

你可以使用 H2O 的功能将数据分割成训练和测试集。首先要做的是为全部数据创建一个随机和均匀的数字向量：

    > rand <- h2o.runif(bank, seed = 123)

然后，你可以构建你的分区数据，并使用所需的key名称分配它，如下所示：

    > train <- bank[rand <= 0.7, ]
    > train <- h2o.assign(train, key = "train")
    > test <- bank[rand > 0.7, ]
    > test <- h2o.assign(test, key = "test")

创建了这些之后，我们可能需要确保train和test集之间有一个*衡的响应变量。为此，你可以使用h2o.table()函数，在我们的例子中，将是第 64 列：

 > h2o.table(train[, 64])
 y Count
 1  no  2783
 2 yes   396
 [2 rows x 2 columns] 
 > h2o.table(test[, 64])
 y Count
 1  no  1217
 2 yes   125
 [2 rows x 2 columns]

这看起来很好，所以让我们开始建模过程：

建模

正如我们将要看到的，深度学习函数有很多参数和选项可以调整。我喜欢这个包的地方在于它尽可能地保持简单，并让默认设置发挥作用。如果你想查看所有可能的选项以及默认设置，请查看帮助或运行以下命令：

    > args(h2o.deeplearning)

所有参数和调整参数的文档可在h2o.ai/docs/master/model/deep-learning/在线获取。

顺便提一下，你可以通过运行demo("method")来运行各种机器学习方法的演示。例如，你可以通过demo(h2o.deeplearning)来浏览深度学习演示。

我们下一个目标是使用随机搜索调整超参数。它比完整的网格搜索花费的时间少。我们将查看带有和不带有 dropout 的tanh，三种不同的隐藏层/神经元组合，两种不同的 dropout 比率，以及两种不同的学习率：

 > hyper_params <- list(
 activation = c("Tanh", "TanhWithDropout"),
 hidden = list(c(20,20),c(30, 30),c(30, 30, 30)),
 input_dropout_ratio = c(0, 0.05),
 rate = c(0.01, 0.25)
 )

你现在帮助指定一个列表中的随机搜索标准。由于我们想要随机搜索，我们将指定RandomDiscrete。完整的网格搜索将需要Cartesian。建议为随机搜索指定一个或多个早期停止标准，如max_runtime_secs、max_models。我们还指定在这里，当前五名模型的误差彼此相差 1%时停止：

 > search_criteria = list(
 strategy = "RandomDiscrete", max_runtime_secs = 420,
 max_models = 100, seed = 123, stopping_rounds = 5,
 stopping_tolerance = 0.01
 )

现在，这是使用h2o.grid()函数应该发生魔法的地方。我们告诉它，我们想使用深度学习算法，我们的测试数据，任何验证数据（我们将使用测试集），我们的输入特征，以及响应变量：

 > randomSearch <- h2o.grid(
 algorithm = "deeplearning",
 grid_id = "randomSearch",
 training_frame = train,
 validation_frame = test, 
 x = 1:63, 
 y = 64,
 epochs = 1,
 stopping_metric = "misclassification",
 hyper_params = hyper_params,
 search_criteria = search_criteria
 )
 |===================================================================| 100%

一个指示条跟踪进度，并且使用这个数据集，它应该只需要几秒钟。

我们现在检查前五名模型的结果：

 > grid <- h2o.getGrid("randomSearch",sort_by = "auc", decreasing = 
       FALSE)
 > grid
 H2O Grid Details
 ================

 Grid ID: randomSearch 
 Used hyper parameters: 
 - activation 
 - hidden 
 - input_dropout_ratio 
 - rate 
 Number of models: 71 
    Number of failed models: 0 

    Hyper-Parameter Search Summary: ordered by decreasing auc
           activation       hidden input_dropout_ratio rate
    1 TanhWithDropout [30, 30, 30]                0.05 0.25
    2 TanhWithDropout [20, 20]                    0.05 0.01
    3 TanhWithDropout [30, 30, 30]                0.05 0.25
    4 TanhWithDropout [40, 40]                    0.05 0.01
    5 TanhWithDropout [30, 30, 30]                0.0  0.25
                  model_ids                 auc
    1 randomSearch_model_57  0.8636778964667214
    2 randomSearch_model_8   0.8623894823336072
    3 randomSearch_model_10  0.856568611339359
    4 randomSearch_model_39  0.8565258833196385
    5 randomSearch_model_3   0.8544026294165982

因此，获胜模型是#57，激活函数为TanhWithDropout，三个隐藏层，每个层有 30 个神经元，dropout 比率为 0.05，学习率为 0.25，其 AUC 接* 0.864。

我们现在查看我们的验证/测试数据中的错误率，使用混淆矩阵：

 > best_model <- h2o.getModel(grid@model_ids[[1]])
 > h2o.confusionMatrix(best_model, valid = T)
 Confusion Matrix (vertical: actual; across: predicted) for max f1 @ 
      threshold = 0.0953170555399435:
 no yes    Error      Rate
 no     1128  89 0.073131 = 89/1217
 yes      60  65 0.480000 =  60/125
 Totals 1188 154 0.111028 = 149/1342

尽管我们只有 11%的错误率，但我们对于yes标签有较高的错误率，包括假阳性和假阴性率。这可能表明类别不*衡可能是一个问题。我们刚刚开始超参数调整过程，所以还有很多工作可以改进结果。我将把这个任务留给你！

现在让我们看看如何使用交叉验证构建模型。注意超参数包含在h2o.deeplearning()函数中，除了学习率，它被指定为自适应。我还包括了在训练期间通过上采样少数类以实现*衡标签的功能。另一方面，折是按照响应变量进行分层抽样的：

 > dlmodel <- h2o.deeplearning(
 x = 1:63,
 y = 64, 
 training_frame = train,
 hidden = c(30, 30, 30),
 epochs = 3,
 nfolds = 5,
 fold_assignment = "Stratified",
 balance_classes = T,
 activation = "TanhWithDropout",
 seed = 123,
 adaptive_rate = F, 
 input_dropout_ratio = 0.05,
 stopping_metric = "misclassification",
 variable_importances = T
 )

如果你调用对象dlmodel，你会收到相当长的输出。在这个例子中，让我们检查保留集的模型性能：

 > dlmodel
 Model Details:
 ==============
    AUC:  0.8571054599
    Gini: 0.7142109198

    Confusion Matrix (vertical: actual; across: predicted) for F1-optimal  
      threshold:
             no yes    Error       Rate
    no     2492 291 0.104563 = 291/2783
    yes     160 236 0.404040 =  160/396
    Totals 2652 527 0.141869 = 451/3179

给定这些结果，我认为需要对超参数进行更多调整，尤其是对隐藏层/神经元。检查样本外性能略有不同，但相当全面，使用了h2o.performance()函数：

 > perf <- h2o.performance(dlmodel, test)
 > perf
 H2OBinomialMetrics: deeplearning
 MSE:                  0.07237450145
 RMSE:                 0.2690250945
 LogLoss:              0.2399027004
 Mean Per-Class Error: 0.2326113394
 AUC:                  0.8319605588
 Gini:                 0.6639211175

 Confusion Matrix (vertical: actual; across: predicted) for F1-
      optimal 
    threshold:
 no yes    Error      Rate
 no 1050 167 0.137223 = 167/1217
 yes   41  84 0.328000 =  41/125
 Totals 1091 251 0.154993 = 208/1342

 Maximum Metrics: Maximum metrics at their respective thresholds
 metric                      threshold    value idx
 1 max f1                       0.323529 0.446809  62
 2 max f2                       0.297121 0.612245 166
 3 max f0point5                 0.323529 0.372011  62
 4 max accuracy                 0.342544 0.906110   0
 5 max precision                0.323529 0.334661  62
 6 max recall                   0.013764 1.000000 355
 7 max specificity              0.342544 0.999178   0
 8 max absolute_mcc             0.297121 0.411468 166
 9 max min_per_class_accuracy   0.313356 0.799507 131
 10 max mean_per_class_accuracy  0.285007 0.819730 176

总体错误率上升，但我们有更低的假阳性和假阴性率。和之前一样，需要额外的调整。

最后，可以生成变量重要性。这是基于所谓的Gedeon方法计算的。请注意，这些结果可能是误导性的。在表中，我们可以看到变量重要性的顺序，但这个重要性是受采样变异影响的，如果你改变种子值，变量重要性的顺序可能会发生很大变化。以下是按重要性排序的前五个变量：

 > dlmodel@model$variable_importances
 Variable Importances: 
 variable relative_importance scaled_importance percentage
 1 duration                    1.000000          1.000000   0.147006
 2 poutcome_success            0.806309          0.806309   0.118532
 3 month_oct                   0.329299          0.329299   0.048409
 4 month_mar                   0.223847          0.223847   0.032907
 5 poutcome_failure            0.199272          0.199272   0.029294

使用这个方法，我们已经完成了使用H2O包在 R 中介绍深度学习的内容。它使用简单，同时提供了大量的灵活性来调整超参数和创建深度神经网络。享受吧！

摘要

在本章中，目标是让您在神经网络和深度学习的激动人心的世界中开始运行。我们探讨了这些方法的工作原理、它们的优点以及它们固有的缺点，并应用到了两个不同的数据集上。这些技术在数据中存在复杂、非线性关系的地方效果很好。然而，它们非常复杂，可能需要大量的超参数调整，是典型的黑盒子，且难以解释。我们不知道自动驾驶汽车为什么在红灯时右转，我们只知道它转对了。希望您能单独应用这些方法，或者以集成建模的方式补充其他方法。祝您好运，祝您狩猎愉快！我们现在将转换到无监督学习，从聚类开始。

第八章：聚类分析

“快给我拿一杯酒来，让我润润嗓子，好说些聪明话。”

阿里斯托芬，雅典剧作家

在前面的章节中，我们专注于尝试学习最佳算法来解决结果或响应，例如，乳腺癌诊断或前列腺特异性抗原水*。在这些所有情况下，我们都有y，而y是x的函数，或者说y = f(x)。在我们的数据中，我们有实际的y值，我们可以相应地训练x。这被称为监督学习。然而，有许多情况下，我们试图从我们的数据中学习，要么我们没有y，要么我们实际上选择忽略它。如果是这样，我们就进入了无监督学习的世界。在这个世界里，我们根据算法如何解决我们的业务需求以及其准确性来构建和选择我们的算法。

为什么我们要尝试无监督学习呢？首先，无监督学习可以帮助你理解和识别数据中的模式，这可能很有价值。其次，你可以用它来转换你的数据，以改进你的监督学习技术。

本章将重点关注前者，下一章将关注后者。

因此，让我们从解决一种流行且强大的技术开始，这种技术被称为聚类分析。在聚类分析中，目标是把观测值分成若干组（k 组），其中组内成员尽可能相似，而组间成员尽可能不同。有许多例子说明这如何帮助一个组织；这里只列举几个：

创建客户类型或细分市场
在地理区域中检测高犯罪区域
图像和面部识别
基因测序和转录
石油和地质勘探

聚类分析有许多用途，但也有许多技术。我们将重点关注两种最常见的方法：层次聚类和k-means 聚类。它们都是有效的聚类方法，但可能并不总是适用于你可能需要分析的庞大且多样化的数据集。因此，我们还将使用基于Gower距离度量的PAM（基于中位数聚类）方法作为输入进行考察。最后，我们将考察一种我最*学习并应用的新方法，即使用随机森林来转换你的数据。转换后的数据可以随后用作无监督学习的输入。

在继续之前，我想说一句。你可能会被问及这些技术是否更像艺术而非科学，因为学习是无监督的。我认为明确的答案是，这取决于。在 2016 年初，我在印第安纳波利斯 R-用户组的会议上介绍了这些方法。我们一致认为，分析师和业务用户的判断使得无监督学习变得有意义，并决定了你最终算法中有三个还是四个聚类。这句话很好地总结了这一点：

“主要障碍在于难以在没有考虑上下文的情况下评估聚类算法：用户最初为什么要聚类他的数据，他打算用聚类做什么？我们认为聚类不应被视为一个独立于应用数学问题，而应始终在其最终使用的上下文中进行研究。”

Luxburg et al. (2012)

层次聚类

层次聚类算法基于观测值之间的相似性度量。一个常见的度量，也是我们将使用的，是欧几里得距离。还有其他距离度量可供选择。

层次聚类是一种聚合或自下而上的技术。这意味着所有观测值都是它们自己的聚类。从那里开始，算法通过迭代地搜索所有成对点并找到最相似的两组聚类来继续进行。因此，第一次迭代后，有 n-1 个聚类，第二次迭代后有 n-2 个聚类，依此类推。

随着迭代的进行，重要的是要理解，除了距离度量之外，我们还需要指定观测值组之间的链接。不同类型的数据将要求你使用不同的聚类链接。当你尝试不同的链接时，你可能会发现某些链接可能会在一个或多个聚类中创建高度不*衡的观测值数量。例如，如果你有 30 个观测值，一种技术可能会创建一个只有一个观测值的聚类，无论你指定多少个总聚类。在这种情况下，你可能会需要做出判断，选择与数据和业务案例最合适的链接。

下表列出了常见的链接类型，但请注意，还有其他类型：

链接	描述
瓦德（Ward）	这通过从聚类点到其重心的*方误差之和来最小化总聚类内方差
完全	两个聚类之间的距离是一个聚类中的观测值与另一个聚类中的观测值之间的最大距离
单个	两个聚类之间的距离是一个聚类中的观测值与另一个聚类中的观测值之间的最小距离
*均	两个聚类之间的距离是一个聚类中的观测值与另一个聚类中的观测值之间的*均距离
重心	两个聚类之间的距离是聚类重心的距离

层次聚类的输出将是一个树状图，它是一个类似树的图表，显示了各种聚类的排列。

正如我们将看到的，在确定聚类数量时，往往很难找到一个明确的断点。再次强调，你的决策应该是迭代的，并且要关注业务决策的背景。

距离计算

如前所述，欧几里得距离通常用于构建层次聚类的输入。让我们看看如何使用两个观察结果和两个变量/特征来计算它。

假设观察结果 A 的成本为 $5.00，重量为 3 磅。进一步，观察结果 B 的成本为 $3.00，重量为 5 磅。我们可以将这些值放入距离公式中：A 和 B 之间的距离等于*方差的和的*方根，在我们的例子中如下所示：

d(A, B) = *方根((5 - 3)² + (3 - 5)²)，等于 2.83

2.83 的值本身并没有意义，但在其他成对距离的上下文中很重要。这个计算是 R 中 dist() 函数的默认值。你可以在函数中指定其他距离计算（最大值、曼哈顿距离、坎 berra 距离、二元距离和 Minkowski 距离）。我们不会深入探讨为什么或在哪里选择这些而不是欧几里得距离。这可能会非常特定于领域，例如，在欧几里得距离可能不足够的情况下，例如在基因组研究中。这将需要领域知识以及/或试错来确定适当的距离度量。

最后一点是要将你的数据缩放，使其均值为零，标准差为之一，以便距离计算具有可比性。如果不是这样，任何规模较大的变量将对距离产生更大的影响。

K-means 聚类

在 k-means 中，我们需要指定我们想要的簇的确切数量。然后算法将迭代，直到每个观察结果只属于 k 个簇中的一个。算法的目标是最小化由*方欧几里得距离定义的簇内变异。因此，第 k 个簇的变异是所有成对观察结果的*方欧几里得距离之和除以簇中观察结果的数量。

由于涉及到的迭代过程，即使指定了相同的簇数量，一个 k-means 的结果也可能与另一个结果大相径庭。让我们看看这个算法是如何发挥作用的：

指定你想要的簇的确切数量（k）。
初始化 K 个观察值被随机选择作为初始的均值。
迭代：
- 通过将每个观察结果分配给最*的簇中心（最小化簇内*方和）来创建 K 个簇
- 每个簇的重心成为新的均值
- 这将重复进行，直到收敛，即簇重心不再改变

如您所见，最终结果会因步骤 1 中的初始分配而变化。因此，运行多次初始启动并让软件识别最佳解决方案非常重要。在 R 中，这可以是一个简单的过程，我们将看到。

Gower 和基于中位数划分

在你进行实际聚类分析时，可以迅速显现的一个事实是，层次聚类和 k-means 都不是专门设计来处理混合数据集的。混合数据，我指的是定量和定性数据，或者更具体地说，是名义、有序和区间/比率数据。

你将使用的多数数据集的现实情况是，它们可能包含混合数据。有几种处理方法，例如首先进行 主成分分析（PCA），以创建潜在变量，然后使用它们作为聚类的输入，或者使用不同的差异计算。我们将在下一章讨论 PCA。

利用 R 的强大和简洁性，你可以使用 Gower 距离系数将混合数据转换为适当的特征空间。在此方法中，你甚至可以将因素作为输入变量。此外，与其使用 k-means，我建议使用 PAM 聚类算法。

PAM 与 k-means 非常相似，但提供了一些优势。以下列出如下：

首先，PAM 接受一个距离矩阵，这允许包含混合数据
其次，它对异常值和偏斜数据更稳健，因为它最小化差异之和而不是欧几里得距离*方之和（Reynolds，1992）

这并不是说你必须同时使用 Gower 和 PAM。如果你选择，你可以使用 Gower 系数进行层次聚类，我也看到过关于在 k-means 上下文中使用它的支持与反对的论点。此外，PAM 可以接受其他链接。然而，当它们配对时，它们成为处理混合数据的有效方法。在继续之前，让我们快速看一下这两个概念。

Gower

Gower 系数比较案例成对，并计算它们之间的差异，这实际上是每个变量贡献的加权*均值。它被定义为两个称为 i 和 j 的案例，如下所示：

在这里，S[ijk] 是 k 个变量提供的贡献，而 W[ijk] 如果 k 个变量有效则为 1，否则为 0。

对于有序和连续变量，S[ijk] = 1 - (x[ij] - x[ik] 的绝对值 / r[k])，其中 r[k] 是 k 个变量的值域。

对于名义变量，如果 x[ij] = x[jk]，则 S[ijk] = 1，否则为 0。

对于二元变量，S[ijk] 根据属性是否存在（+）或不存在（-）来计算，如下表所示：

变量	属性 k 的值
案例 i	+
案例 j	+
Sijk	1
Wijk	1

PAM

对于 围绕中位数分区，让我们首先定义一个 中位数。

中位数是集群中其他观测值之间差异最小化的观测值（在我们的情况下，使用 Gower 度量计算）。因此，与 k-means 类似，如果你指定五个集群，你将拥有五个数据分区。

为了最小化所有观测值与最*聚类中心的差异，PAM 算法迭代以下步骤：

随机选择 k 个观测值作为初始聚类中心。
将每个观测值分配给最*的聚类中心。
交换每个聚类中心和非聚类中心观测值，计算差异成本。
选择使总差异度最小的配置。
重复步骤 2 至 4，直到聚类中心（medoids）没有变化。

Gower 和 PAM 都可以通过 R 中的cluster包调用。对于 Gower，我们将使用daisy()函数来计算差异矩阵，并使用pam()函数进行实际分区。有了这些，让我们开始对这些方法进行测试。

随机森林

就像我们在处理混合、实际上杂乱数据时使用 Gower 度量一样，我们也可以以无监督的方式应用随机森林。选择这种方法有一些优点：

对异常值和高度偏斜的变量具有鲁棒性
无需转换或缩放数据
处理混合数据（数值和因子）
可以容纳缺失数据
可以用于具有大量变量的数据，实际上，可以通过检查变量重要性来消除无用特征
生成的差异矩阵作为其他讨论过的技术（层次聚类、k 均值和 PAM）的输入。

有几点注意事项。调整随机森林以适应每个树分裂中采样的变量数量（函数中的mtry = ?）和生长的树的数量可能需要一些尝试和错误。研究表明，生长的树越多，在一定范围内，结果越好，一个好的起点是生长 2,000 棵树（Shi, T. & Horvath, S., 2006）。

这就是算法的工作原理，给定一个没有标签的数据集：

当前观察到的数据被标记为类别 1
创建一个与观察数据大小相同的第二（合成）观测值集；这是通过从观察数据的每个特征中随机采样创建的，所以如果你有 20 个观察特征，你将会有 20 个合成特征
数据的合成部分被标记为类别 2，这有助于将随机森林用作人工分类问题
创建一个随机森林模型来区分两个类别
将模型仅针对观察数据的临*度度量（合成数据现在被丢弃）转换为差异矩阵
利用差异矩阵作为聚类输入特征

那么这些临*度度量到底是什么呢？

临*度度量是所有观测值之间的成对度量。如果两个观测值最终落在树的同一个终端节点，它们的临*度得分等于一，否则为零。

在随机森林运行结束时，通过除以总树数来对观测数据的接*度得分进行归一化。得到的 NxN 矩阵包含介于零和一之间的得分，自然地，对角线值都是一。这就是全部内容。这是一个我认为被低估的有效技术，我希望我几年前就能学到。

商业理解

直到几周前，我才知道全世界不到 300 名认证的高级品酒师。由高级品酒师法庭管理的考试以其要求严格和高失败率而闻名。

几位追求认证的个人所经历的试验、磨难和回报在备受赞誉的纪录片《Somm》中有详细描述。因此，为了这次练习，我们将尝试帮助一个试图成为高级品酒师的人找到意大利葡萄酒中的潜在结构。

数据理解和准备

让我们从加载本章所需的 R 包开始。和往常一样，请确保您已经安装了它们：

    > library(cluster) #conduct cluster analysis
    > library(compareGroups) #build descriptive statistic tables
    > library(HDclassif) #contains the dataset
    > library(NbClust) #cluster validity measures
    > library(sparcl) #colored dendrogram

数据集在 HDclassif 包中，这是我们安装的。因此，我们可以使用 str() 函数加载数据并检查其结构：

    > data(wine)

    > str(wine)
    'data.frame':178 obs. of  14 variables:
     $ class: int  1 1 1 1 1 1 1 1 1 1 ...
     $ V1   : num  14.2 13.2 13.2 14.4 13.2 ...
     $ V2   : num  1.71 1.78 2.36 1.95 2.59 1.76 1.87 2.15 1.64 1.35 
       ...
     $ V3   : num  2.43 2.14 2.67 2.5 2.87 2.45 2.45 2.61 2.17 2.27 ...
     $ V4   : num  15.6 11.2 18.6 16.8 21 15.2 14.6 17.6 14 16 ...
     $ V5   : int  127 100 101 113 118 112 96 121 97 98 ...
     $ V6   : num  2.8 2.65 2.8 3.85 2.8 3.27 2.5 2.6 2.8 2.98 ...
     $ V7   : num  3.06 2.76 3.24 3.49 2.69 3.39 2.52 2.51 2.98 3.15 
       ...
     $ V8   : num  0.28 0.26 0.3 0.24 0.39 0.34 0.3 0.31 0.29 0.22 ...
     $ V9   : num  2.29 1.28 2.81 2.18 1.82 1.97 1.98 1.25 1.98 1.85 
       ...
     $ V10  : num  5.64 4.38 5.68 7.8 4.32 6.75 5.25 5.05 5.2 7.22 ...
     $ V11  : num  1.04 1.05 1.03 0.86 1.04 1.05 1.02 1.06 1.08 1.01 
       ...
     $ V12  : num  3.92 3.4 3.17 3.45 2.93 2.85 3.58 3.58 2.85 3.55 ...
     $ V13  : int  1065 1050 1185 1480 735 1450 1290 1295 1045 1045 ...

数据包括 178 种葡萄酒，其中包含 13 个化学成分变量和一个变量 Class，即品种或植物种类的标签。我们不会在聚类中使用这个变量，而是将其作为模型性能的测试。变量 V1 到 V13 是化学成分的测量值，如下所示：

V1: 酒精
V2: 苹果酸
V3: 灰分
V4: 灰分碱度
V5: 镁
V6: 总酚
V7: 黄酮类化合物
V8: 非黄酮酚
V9: 前花青素
V10: 颜色强度
V11: 色调
V12: OD280/OD315
V13: 精氨酸

变量都是定量变量。我们应该将它们重命名为对我们分析有意义的名称。这可以通过 names() 函数轻松完成：

    > names(wine) <- c("Class", "Alcohol", "MalicAcid", "Ash", 
      "Alk_ash", "magnesium", "T_phenols", "Flavanoids", "Non_flav", 
        "Proantho", "C_Intensity", "Hue", "OD280_315", "Proline")

    > names(wine)
    [1] "Class"       "Alcohol"     "MalicAcid"   "Ash" 
    [5] "Alk_ash"     "magnesium"   "T_phenols"   "Flavanoids" 
    [9] "Non_flav"    "Proantho"    "C_Intensity" "Hue" 
    [13] "OD280_315"   "Proline"

由于变量没有缩放，我们需要使用 scale() 函数进行缩放。这将首先将数据中心化，即从列中的每个个体中减去列的均值。然后，中心化值将除以相应列的标准差。我们还可以使用这种转换来确保我们只包括列 2 到 14，排除类别并将其放入数据框中。这都可以用一行代码完成：

    > df <- as.data.frame(scale(wine[, -1]))

现在，检查结构以确保一切按计划进行：

    > str(df)
    'data.frame':178 obs. of  13 variables:
     $ Alcohol    : num  1.514 0.246 0.196 1.687 0.295 ...
     $ MalicAcid  : num  -0.5607 -0.498 0.0212 -0.3458 0.2271 ...
     $ Ash        : num  0.231 -0.826 1.106 0.487 1.835 ...
     $ Alk_ash    : num  -1.166 -2.484 -0.268 -0.807 0.451 ...
     $ magnesium  : num  1.9085 0.0181 0.0881 0.9283 1.2784 ...
     $ T_phenols  : num  0.807 0.567 0.807 2.484 0.807 ...
     $ Flavanoids : num  1.032 0.732 1.212 1.462 0.661 ...
     $ Non_flav   : num  -0.658 -0.818 -0.497 -0.979 0.226 ...
     $ Proantho   : num  1.221 -0.543 2.13 1.029 0.4 ...
     $ C_Intensity: num  0.251 -0.292 0.268 1.183 -0.318 ...
     $ Hue        : num  0.361 0.405 0.317 -0.426 0.361 ...
     $ OD280_315  : num  1.843 1.11 0.786 1.181 0.448 ...
     $ Proline    : num  1.0102 0.9625 1.3912 2.328 -0.0378 ...

在继续之前，让我们快速制作一个表格，以查看品种或 Class 的分布情况：

    > table(wine$Class)

    1  2  3 
    59 71 48

我们现在可以继续到过程的建模步骤。

建模与评估

在创建我们的数据框 df 之后，我们可以开始开发聚类算法。我们将从层次聚类开始，然后尝试 k-means 聚类。之后，我们需要稍微调整我们的数据，以展示如何将混合数据与 Gower 和随机森林结合。

层次聚类

要在 R 中构建层次聚类模型，你可以利用基础stats包中的hclust()函数。该函数的两个主要输入是一个距离矩阵和聚类方法。距离矩阵可以通过dist()函数轻松完成。对于距离，我们将使用欧几里得距离。有几种聚类方法可供选择，hclust()的默认方法是完全链接。

我们将尝试这种方法，但我还推荐 Ward 的链接方法。Ward 的方法倾向于产生具有相似观察数量的聚类。

完全链接方法导致任意两个聚类之间的距离是聚类中任意一个观察值与其他聚类中任意一个观察值之间的最大距离。Ward 的链接方法试图聚类观察值，以最小化聚类内的*方和。

值得注意的是，R 中的ward.D2方法使用的是*方欧几里得距离，这确实是 Ward 的链接方法。在 R 中，ward.D是可用的，但需要你的距离矩阵是*方值。由于我们将构建一个非*方值的距离矩阵，我们需要使用ward.D2。

现在，最大的问题是我们应该创建多少个聚类？正如引言中所述，简短且可能并不令人满意的答案是这取决于。尽管有聚类有效性度量可以帮助解决这个困境——我们将会探讨——但这实际上需要深入了解业务背景、基础数据和，坦白说，试错。由于我们的品酒师伙伴是虚构的，我们不得不依赖有效性度量。然而，这并不是选择聚类数量的万能药，因为存在几十种有效性度量。

由于探索大量聚类有效性度量方法的正负方面远远超出了本章的范围，我们可以转向几篇论文，甚至直接使用 R 来简化这个问题。Miligan 和 Cooper 在 1985 年发表的一篇论文探讨了 30 种不同的度量/指标在模拟数据上的表现。表现最好的前五种分别是 CH 指数、Duda 指数、C 指数、Gamma 指数和 Beale 指数。确定聚类数量的另一种著名方法是gap 统计量（Tibshirani, Walther, and Hastie, 2001）。如果你对聚类有效性感到好奇，这两篇论文是很好的参考资料。

使用 R，你可以使用NbClust包中的NbClust()函数来获取 23 个指标的结果，包括 Miligan 和 Cooper 的前五种和 gap 统计量。你可以在包的帮助文件中查看所有可用的指标列表。有两种方法可以处理这个过程：一种是你选择你喜欢的指标或指标集，并用 R 调用它们；另一种方法是将所有这些指标都包含在分析中，并采用多数规则方法，该函数会为你很好地总结。该函数还会生成一些图表。

阶段设置完毕后，让我们通过使用完全连接方法来举例说明。当使用该函数时，你将需要指定最小和最大簇数、距离度量以及索引，除了连接方式。正如你可以在下面的代码中看到的那样，我们将创建一个名为numComplete的对象。函数规范是欧几里得距离，最小簇数为两个，最大簇数为六个，完全连接，以及所有索引。当你运行命令时，该函数将自动生成一个类似于你在这里看到的输出--对图形方法和多数规则结论的讨论：

    > numComplete <- NbClust(df, distance = "euclidean", min.nc = 2, 
       max.nc=6, method = "complete", index = "all")
    *** : The Hubert index is a graphical method of determining the 
       number of clusters.
    In the plot of Hubert index, we seek a significant knee that 
       corresponds to a significant increase of the value of the 
         measure that is the significant peak in Hubert index second 
           differences plot. 

    *** : The D index is a graphical method of determining the number 
       of clusters. 
    In the plot of D index, we seek a significant knee (the significant peak in Dindex second differences plot) that corresponds to a significant increase of the value of the measure. 

    ******************************************************************* 
    * Among all indices: 
    * 1 proposed 2 as the best number of clusters 
    * 11 proposed 3 as the best number of clusters 
    * 6 proposed 5 as the best number of clusters 
    * 5 proposed 6 as the best number of clusters 

    ***** Conclusion ***** 

    * According to the majority rule, the best number of clusters is 3

按照多数规则方法，我们会选择三个簇作为最佳解决方案，至少对于层次聚类来说是这样。产生的两个图表各包含两个图形。正如前面的输出所述，你正在寻找图（左侧的图形）中的显著拐点和右侧图形的峰值。这是Hubert 指数图：

你可以在左侧的图表中看到弯曲或膝盖出现在三个簇中。此外，右侧的图表在其峰值处也有三个簇。下面的Dindex 图提供了相同的信息：

你可以使用该函数调用多个值，其中有一个我想展示。这个输出是每个索引的最佳簇数以及对应簇数的索引值。这是通过$Best.nc完成的。我已经将输出简化为前九个索引：

    > numComplete$Best.nc
                         KL      CH Hartigan   CCC    Scott
    Number_clusters  5.0000  3.0000   3.0000 5.000   3.0000
    Value_Index     14.2227 48.9898  27.8971 1.148 340.9634
                         Marriot   TrCovW   TraceW Friedman
    Number_clusters 3.000000e+00     3.00   3.0000   3.0000
    Value_Index     6.872632e+25 22389.83 256.4861  10.6941

你可以看到，第一个索引（KL）的最佳簇数是五个，下一个索引（CH）是三个。

以三个簇作为推荐选择，我们现在将计算距离矩阵并构建我们的层次聚类对象。此代码将构建距离矩阵：

    > dis <- dist(df, method = "euclidean")

然后，我们将使用这个矩阵作为hclust()实际聚类的输入：

    > hc <- hclust(dis, method = "complete")

展示层次聚类的一种常见方式是绘制树状图。我们将使用绘图函数来完成这个任务。请注意，hang = -1将观测值放置在图的最底部：

    > plot(hc, hang = -1, labels = FALSE, main = "Complete-Linkage")

树状图是一种树形图，展示了单个观测值是如何聚在一起的。连接（分支，如果你愿意这样称呼）的排列告诉我们哪些观测值是相似的。分支的高度表示观测值之间的相似度或差异度。请注意，我指定了labels = FALSE。这样做是为了帮助解释，因为观测值的数量。在一个较小的数据集中，比如说不超过 40 个观测值，行名可以被显示。

为了帮助可视化聚类，你可以使用sparcl包生成彩色树状图。为了给适当数量的聚类着色，你需要使用cutree()函数将树状图切割到正确的聚类数量。这也会为每个观测值创建聚类标签：

    > comp3 <- cutree(hc, 3)

现在，comp3对象在函数中用于构建彩色树状图：

    > ColorDendrogram(hc, y = comp3, main = "Complete", branchlength = 50)

注意，我使用了branchlength = 50。这个值将根据你的数据而变化。既然我们有聚类标签，让我们构建一个显示每个聚类计数的表格：

    > table(comp3)
    comp3
    1  2  3 
     69 58 51

出于好奇，让我们继续比较这种聚类算法与品种标签的对比：

    > table(comp3,wine$Class)

    comp3  1  2  3
        1 51 18  0
        2  8 50  0
        3  0  3 48

在这个表格中，行是聚类，列是品种。这种方法在 84%的比率上匹配了品种标签。请注意，我们并不是试图使用聚类来预测品种，在这个例子中，我们没有先验理由将聚类与品种匹配。

我们现在将尝试 Ward 的连接。这与之前的代码相同；它首先尝试确定聚类数量，这意味着我们需要将方法更改为Ward.D2：

    > numWard <- NbClust(df, diss = NULL, distance = "euclidean", 
      min.nc = 2, max.nc = 6, method = "ward.D2", index = "all") 
    *** : The Hubert index is a graphical method of determining the number of clusters.
    In the plot of Hubert index, we seek a significant knee that corresponds to a significant increase of the value of the measure i.e the significant peak in Hubert index second differences plot. 

    *** : The D index is a graphical method of determining the number of clusters. 
    In the plot of D index, we seek a significant knee (the significant peak in Dindex second differences plot) that corresponds to a significant increase of the value of the measure. 

    ******************************************************************* 
    * Among all indices: 
    * 2 proposed 2 as the best number of clusters 
    * 18 proposed 3 as the best number of clusters 
    * 2 proposed 6 as the best number of clusters 

    ***** Conclusion ***** 

    * According to the majority rule, the best number of clusters is 3

这次，大多数规则也是针对三个聚类解决方案的。查看 Hubert 指数，最佳解决方案也是三个聚类：

Dindex 进一步支持三个聚类解决方案：

让我们继续进行实际的聚类和 Ward 连接的树状图生成：

    > hcWard <- hclust(dis, method = "ward.D2")

    > plot(hcWard, labels = FALSE, main = "Ward's-Linkage")

图表显示了三个大小大致相等的明显不同的聚类。让我们统计一下聚类的大小，并将其与品种标签相关联：

    > ward3 <- cutree(hcWard, 3)
    > table(ward3, wine$Class)

    ward3  1  2  3
        1 59  5  0
        2  0 58  0
        3  0  8 48

因此，第一个聚类有 64 个观测值，第二个聚类有58个，第三个聚类有 56 个。这种方法比使用完全连接法更接*品种分类。

通过另一个表格，我们可以比较两种方法如何匹配观测值：

    > table(comp3, ward3)
         ward3
    comp3  1  2  3
        1 53 11  5
        2 11 47  0
        3  0  0 51

虽然每种方法中的第三个聚类非常接*，但其他两个则不然。现在的问题是，我们如何识别这些差异以进行解释？在许多例子中，数据集非常小，你可以查看每个聚类的标签。在现实世界中，这通常是不可能的。一种好的比较方法是使用aggregate()函数，对统计量如mean或中位数进行汇总。此外，我们不是在缩放数据上操作，而是尝试在原始数据上操作。在函数中，你需要指定数据集、按什么进行聚合以及汇总统计量：

    > aggregate(wine[, -1], list(comp3), mean)
      Group.1  Alcohol MalicAcid      Ash  Alk_ash magnesium T_phenols
    1       1 13.40609  1.898986 2.305797 16.77246 105.00000  2.643913
    2       2 12.41517  1.989828 2.381379 21.11724  93.84483  2.424828
    3       3 13.11784  3.322157 2.431765 21.33333  99.33333  1.675686
      Flavanoids  Non_flav Proantho C_Intensity       Hue OD280_315  Proline
    1  2.6689855 0.2966667 1.832899    4.990725 1.0696522  2.970000 984.6957
    2  2.3398276 0.3668966 1.678103    3.280345 1.0579310  2.978448 573.3793
    3  0.8105882 0.4443137 1.164314    7.170980 0.6913725  1.709804 622.4902

这为我们提供了每个数据中的 13 个变量的聚类*均数。完成完全连接后，让我们尝试 Ward 的方法：

    > aggregate(wine[, -1], list(ward3), mean)
      Group.1  Alcohol MalicAcid      Ash  Alk_ash magnesium T_phenols
    1       1 13.66922  1.970000 2.463125 17.52812 106.15625  2.850000
    2       2 12.20397  1.938966 2.215172 20.20862  92.55172  2.262931
    3       3 13.06161  3.166607 2.412857 21.00357  99.85714  1.694286
      Flavanoids  Non_flav Proantho C_Intensity      Hue OD280_315   Proline
    1  3.0096875 0.2910937 1.908125    5.450000 1.071406  3.158437 1076.0469
    2  2.0881034 0.3553448 1.686552    2.895345 1.060000  2.862241  501.4310
    3  0.8478571 0.4494643 1.129286    6.850179 0.721000  1.727321  624.9464

数字非常接*。Ward 方法的第一聚类的所有变量值都略有偏高。对于 Ward 方法的第二个聚类，除了色调外，*均值都较小。这将是与具有领域专业知识的人分享以协助解释的内容。我们可以通过绘制两种方法的变量值按聚类来帮助这一努力。

一个用于比较分布的好图是 箱线图。箱线图将显示最小值、第一四分位数、中位数、第三四分位数、最大值和潜在的异常值。

让我们假设我们对每种聚类方法的 Proline 值感兴趣，构建一个包含两个箱线图的比较图。首先要做的事情是为显示并排的图形准备我们的绘图区域。这是通过 par() 函数完成的：

    > par(mfrow =c (1, 2))

这里，我们指定了想要一行两列，使用 mfrow = c(1, 2))。如果你想要两行一列，那么应该是 mfrow = c(2, 1))。在 boxplot() 函数中，我们需要指定 y 轴的值是 x 轴值的函数，使用波浪号 ~ 符号：

    > boxplot(wine$Proline ~ comp3, data = wine, 
              main="Proline by Complete Linkage")

    > boxplot(wine$Proline ~ ward3, data = wine, 
              main = "Proline by Ward's Linkage")

观察箱线图，粗箱代表第一四分位数、中位数（箱中的粗横线），以及第三四分位数，这是 四分位距。虚线线的两端，通常被称为胡须，代表最小值和最大值。你可以看到在完全连接的第二个聚类中，最大值上方有五个小圆圈。这些被称为 疑似异常值，计算结果大于或等于四分位距加减 1.5 倍。

任何大于或等于四分位距加减三倍的值都被认为是异常值，并以实心黑色圆圈表示。就其本身而言，Ward 连接的第一个和第二个聚类的四分位距更紧密，没有疑似异常值。

观察每个变量的箱线图可能有助于你，领域专家可以确定最佳层次聚类方法。考虑到这一点，让我们继续到 k-means 聚类。

K-means 聚类

正如我们在层次聚类中所做的那样，我们也可以使用 NbClust() 来确定 k-means 的最佳聚类数量。你只需要在函数中指定 kmeans 作为方法。让我们也将最大聚类数量放宽到 15。以下输出已被简化为仅包含多数规则部分：

    > numKMeans <- NbClust(df, min.nc = 2, max.nc = 15, method = 
      "kmeans")
    * Among all indices: 
    * 4 proposed 2 as the best number of clusters 
    * 15 proposed 3 as the best number of clusters 
    * 1 proposed 10 as the best number of clusters 
    * 1 proposed 12 as the best number of clusters 
    * 1 proposed 14 as the best number of clusters 
    * 1 proposed 15 as the best number of clusters 

    ***** Conclusion ***** 

    * According to the majority rule, the best number of clusters is 3

再次，三个聚类似乎是最优解。这是 Hubert 图，它证实了这一点：

在 R 中，我们可以使用 kmeans() 函数来进行这项分析。除了输入数据外，我们还需要指定我们正在解决的聚类数量以及随机分配的值，即 nstart 参数。我们还需要指定一个随机种子：

    > set.seed(1234)

    > km <- kmeans(df, 3, nstart = 25)

创建簇的表格让我们对观测值在它们之间的分布有一个概念：

    > table(km$cluster)

    1  2  3 
    62 65 51

每个簇的观测数是均衡的。我在许多情况下看到，在更大的数据集和更多的变量中，没有任何数量的 k-means 算法能产生有希望和令人信服的结果。分析聚类的另一种方法是查看每个簇中每个变量的簇中心矩阵：

    > km$centers
         Alcohol  MalicAcid        Ash    Alk_ash   magnesium   T_phenols
    1  0.8328826 -0.3029551  0.3636801 -0.6084749  0.57596208  0.88274724
    2 -0.9234669 -0.3929331 -0.4931257  0.1701220 -0.49032869 -0.07576891
    3  0.1644436  0.8690954  0.1863726  0.5228924 -0.07526047 -0.97657548
       Flavanoids    Non_flav    Proantho C_Intensity        Hue  OD280_315
    1  0.97506900 -0.56050853  0.57865427   0.1705823  0.4726504  0.7770551
    2  0.02075402 -0.03343924  0.05810161  -0.8993770  0.4605046  0.2700025
    3 -1.21182921  0.72402116 -0.77751312   0.9388902 -1.1615122 -1.2887761
         Proline
    1  1.1220202
    2 -0.7517257
    3 -0.4059428

注意，簇一的*均酒精含量较高。让我们制作一个箱线图，以查看酒精含量的分布情况，就像我们之前做的那样，并与之比较 Ward 的：


    > boxplot(wine$Alcohol ~ km$cluster, data = wine, 
              main = "Alcohol Content, K-Means")

    > boxplot(wine$Alcohol ~ ward3, data = wine, 
              main = "Alcohol Content, Ward's")

每个簇的酒精含量几乎完全相同。从表面上看，这告诉我三个簇是葡萄酒的适当潜在结构，使用 k-means 或层次聚类之间几乎没有差异。最后，让我们比较 k-means 簇与品种：

    > table(km$cluster, wine$Class)

         1  2  3
      1 59  3  0
      2  0 65  0
      3  0  3 48

这与 Ward 方法产生的分布非常相似，任何一个都可能被我们的假设品酒师接受。

然而，为了演示如何在具有数值和非数值值的数据上聚类，让我们再看一些例子。

Gower 和 PAM

开始这一步之前，我们需要稍微整理一下数据。由于这种方法可以接受因子变量，我们将酒精含量转换为高或低含量。这只需要一行代码，利用ifelse()函数将变量转换为因子。这将实现的是，如果酒精含量大于零，它将被标记为High，否则为Low：

    > wine$Alcohol <- as.factor(ifelse(df$Alcohol > 0, "High", "Low"))

现在，我们准备使用cluster包中的daisy()函数创建相似性矩阵，并指定方法为gower：

    > disMatrix <- daisy(wine[, -1], metric = "gower")

创建簇对象——让我们称它为pamFit——是通过cluster包中的pam()函数完成的。在这个例子中，我们将创建三个簇并创建一个簇大小的表格：

    > set.seed(123)

    > pamFit <- pam(disMatrix, k = 3)

    > table(pamFit$clustering)

    1  2  3 
    63 67 48

现在，让我们看看它与品种标签相比的表现如何：

    > table(pamFit$clustering, wine$Class)

         1  2  3
      1 57  6  0
      2  2 64  1
      3  0  1 47

让我们利用compareGroups包的力量，将这个解决方案构建成一个描述性统计表。在基础 R 中，创建令人印象深刻的表格可能相当困难，而这个包提供了一个出色的解决方案。第一步是使用包中的compareGroups()函数创建一个按簇的描述性统计对象。然后，使用createTable()，我们将统计信息转换为一个易于导出的表格，我们将以.csv 格式完成。如果您愿意，也可以将表格导出为 PDF、HTML 或 LaTeX 格式：

    > wine$cluster <- pamFit$clustering

    > group <- compareGroups(cluster ~ ., data = wine)

    > clustab <- createTable(group)

    > clustab

    --------Summary descriptives table by 'cluster'---------

 __________________________________________________________ 
 1           2            3      p.overall 
 N=63         N=67         N=48 
 ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ 
 Class         1.10 (0.30)  1.99 (0.21)  2.98 (0.14) <0.001 
 Alcohol:                                            <0.001 
 High     63 (100%)    1 (1.49%)   28 (58.3%) 
 Low     0 (0.00%)   66 (98.5%)   20 (41.7%) 
 MalicAcid     1.98 (0.83)   1.92 (0.90) 3.39 (1.05) <0.001 
 Ash           2.42 (0.27)   2.27 (0.31) 2.44 (0.18)  0.001 
 Alk_ash       17.2 (2.73)   20.2 (3.28) 21.5 (2.21) <0.001 
 magnesium     105  (11.6)   95.6 (17.2) 98.5 (10.6)  0.001 
 T_phenols     2.82 (0.36)   2.24 (0.55) 1.68 (0.36) <0.001 
 Flavanoids    2.94 (0.47)   2.07 (0.70) 0.79 (0.31) <0.001 
 Non_flav      0.29 (0.08)   0.36 (0.12) 0.46 (0.12) <0.001 
 Proantho      1.86 (0.47)   1.64 (0.59) 1.17 (0.41) <0.001 
 C_Intensity   5.41 (1.31)   3.05 (0.89) 7.41 (2.29) <0.001 
 Hue           1.07 (0.13)   1.05 (0.20) 0.68 (0.12) <0.001 
 OD280_315     3.10 (0.39)   2.80 (0.53) 1.70 (0.27) <0.001 
 Proline       1065 (280)     533 (171)   628 (116)  <0.001 
 comp_cluster  1.16 (0.37)   1.81 (0.50) 3.00 (0.00) <0.001 
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

此表显示了每个簇中因子水*的比例，对于数值变量，均值和标准差显示在括号中。要将表格导出为.csv文件，只需使用export2csv()函数：

    > export2csv(clustab,file = "wine_clusters.csv")

如果你打开这个文件，你会得到这个表格，它有利于进一步分析，并且可以很容易地用于演示目的：

最后，我们将使用随机森林创建一个相似性矩阵，并使用 PAM 创建三个聚类。

随机森林和 PAM

要在 R 中执行此方法，你可以使用randomForest()函数。在设置随机种子后，只需创建模型对象。在以下代码中，我指定了树的数量为2000并将邻*度度量设置为TRUE：

 > set.seed(1) 
 > rf <- randomForest(x = wine[, -1], ntree = 2000, proximity = T) 
 > rf

 Call:
 randomForest(x = wine[, -1], ntree = 2000, proximity = T) 
 Type of random forest: unsupervised
 Number of trees: 2000
 No. of variables tried at each split: 3

如你所见，调用rf并没有提供任何有意义的输出，除了在每个分割中采样的变量（mtry）。让我们检查矩阵的前五行和前五行：

> dim(rf$proximity)
[1] 178 178

> rf$proximity[1:5, 1:5]
 1         2         3          4          5
1 1.0000000 0.2593985 0.2953586 0.36013986 0.17054264
2 0.2593985 1.0000000 0.1307420 0.16438356 0.11029412
3 0.2953586 0.1307420 1.0000000 0.29692833 0.23735409
4 0.3601399 0.1643836 0.2969283 1.00000000 0.08076923
5 0.1705426 0.1102941 0.2373541 0.08076923 1.00000000

想象这些值的一种方式是，它们是这两个观察值出现在相同终端节点中的百分比！查看变量重要性，我们发现转换后的酒精输入可以删除。我们将为了简单起见保留它：

 > importance(rf)
 MeanDecreaseGini
 Alcohol      0.5614071
 MalicAcid    6.8422540
 Ash          6.4693717
 Alk_ash      5.9103567
 magnesium    5.9426505
 T_phenols    6.2928709
 Flavanoids   6.2902370
 Non_flav     5.7312940
 Proantho     6.2657613
 C_Intensity  6.5375605
 Hue          6.3297808
 OD280_315    6.4894731
 Proline      6.6105274

现在只是创建相似性矩阵的问题，它将邻*度值（*方根（1 - 邻*度））转换为以下形式：

 > dissMat <- sqrt(1 - rf$proximity)

 > dissMat[1:2, 1:2]
 1         2
 1 0.0000000 0.8605821
 2 0.8605821 0.0000000

现在我们有了输入特征，让我们像之前一样运行 PAM 聚类：

 > set.seed(123)

 > pamRF <- pam(dissMat, k = 3)

 > table(pamRF$clustering)

 1  2  3 
 62 68 48 

 > table(pamRF$clustering, wine$Class)

 1 2 3
 1 57  5  0
 2  2 64  2
 3  0  2 46

这些结果与其他应用的技术相当。你能通过调整随机森林来提高结果吗？

如果你有一个聚类问题的杂乱数据，考虑使用随机森林。

摘要

在本章中，我们开始探索无监督学习技术。我们专注于聚类分析，旨在提供数据降维和对观察值的数据理解。

介绍了四种方法：传统的层次聚类和 k-means 聚类算法，以及 PAM，结合了两种不同的输入（Gower 和随机森林）。我们将这四种方法应用于来自三个不同品种的意大利葡萄酒的结构，并检查了结果。

在下一章中，我们将继续探索无监督学习，但我们将专注于在变量之间寻找结构，而不是在观察值之间寻找结构，以便创建可用于监督学习问题的新特征。

第九章：主成分分析

“有些人滑向冰球，我滑向冰球将要到达的地方。”

沃伊恩·格雷茨基

本章是第二章，我们将重点关注无监督学习技术。在前一章中，我们介绍了聚类分析，它为我们提供了相似观察值的分组。在本章中，我们将看到如何通过将相关变量分组为主成分分析（PCA）来降低数据的维度并提高对数据的理解。然后，我们将使用主成分进行监督学习。

在许多数据集中，尤其是在社会科学领域，你会看到许多变量之间高度相关。它们还可能遭受高维度的困扰，或者如人们所熟知的，维度诅咒。这是一个问题，因为估计函数所需的样本数量会随着输入特征数量的指数增长。在这样的数据集中，可能存在一些变量是冗余的，因为它们最终测量的是相同的结构，例如，收入和贫困或抑郁和焦虑。因此，目标是使用 PCA 来创建一个较小的变量集，该集能够从原始变量集中捕获大部分信息，从而简化数据集，并经常导致隐藏的洞察。这些新变量（主成分）彼此之间高度不相关。除了监督学习之外，使用这些成分进行数据可视化也非常常见。

在使用 PCA 进行或支持分析超过十年的经验中，我发现它被广泛使用，但理解得却很差，尤其是在那些不进行分析但消费结果的人中。理解你正在从其他相关变量中创建一个新变量是直观的。然而，这项技术本身却笼罩在可能被误解的术语和数学概念中，这些概念往往会使外行人感到困惑。本意在于通过涵盖以下内容，提供一个关于其是什么以及如何使用的良好基础：

准备 PCA 数据集
执行 PCA
选择我们的主成分
使用主成分构建预测模型
使用预测模型进行样本外预测

主成分概述

PCA 是寻找主成分的过程。这些究竟是什么？

我们可以将一个成分视为特征的正则化线性组合（詹姆斯，2012）。数据集中的第一个主成分是捕获数据中最大方差线性组合。第二个成分是通过选择另一个最大化方差且其方向与第一个成分垂直的线性组合来创建的。后续的成分（等于变量的数量）将遵循相同的规则。

这里有几个要点。这个定义描述了线性组合，这是 PCA 中的一个关键假设。如果您尝试将 PCA 应用于变量相关性较低的数据集，您很可能会得到一个没有意义的分析。另一个关键假设是变量的均值和方差是足够的统计量。这告诉我们，数据应该符合正态分布，这样协方差矩阵就能完全描述我们的数据集，即多元正态性。PCA 对非正态分布的数据相当稳健，甚至可以与二元变量一起使用，因此结果仍然可解释。

现在，这里描述的这个方向是什么，线性组合是如何确定的？掌握这个主题的最好方式是通过可视化。让我们用一个包含两个变量的小型数据集进行绘图。PCA 对尺度敏感，因此数据已经被缩放到均值为零和标准差为一。您可以在下面的图中看到，这些数据恰好形成一个椭圆形，其中的钻石代表每个观测值：

观察图表，数据在x轴上具有最大的方差，因此我们可以画一条虚线来表示我们的第一个主成分，如下面的图像所示。这个成分是两个变量的线性组合，或PC1 = α[11]X[1] + α[12]X[2]，其中系数权重是变量在主成分上的载荷。它们构成了数据变化最大的方向的基础。这个方程受1的限制，以防止选择任意高的值。另一种看法是，虚线最小化了它自身与数据点之间的距离。这个距离在几个点上用箭头表示，如下所示：

然后，以相同的方式计算第二个主成分，但它与第一个主成分不相关，也就是说，它的方向与第一个主成分成直角或正交。以下图显示了添加为虚线的第二个主成分：

对于每个变量的主成分载荷计算完成后，算法将为我们提供主成分得分。这些得分是针对每个观测值和每个主成分计算的。对于PC1和第一个观测值，这相当于以下公式：Z[11] = α[11] * (X[11] - X[1]的*均值) + α[12] * (X[12] - X[2]的*均值)。对于PC2和第一个观测值，方程将是Z[12] = α[21] * (X[11] - X[2]的*均值) + α[22] * (X[12] - X[2]的*均值)。这些主成分得分现在是新特征空间，用于您将要进行的任何分析。

回想一下，该算法将创建与变量数量一样多的主成分，解释了 100%的可能方差。那么，我们如何缩小这些成分的范围，以实现最初的目标呢？有一些启发式方法可以使用，在即将到来的建模过程中，我们将探讨具体细节；但选择主成分的一个常见方法是如果其特征值大于一。虽然特征值和特征向量估计背后的代数超出了本书的范围，但讨论它们是什么以及如何在主成分分析（PCA）中使用它们是很重要的。

优化的线性权重是通过线性代数确定的，以便创建所谓的特征向量。它们是最优的，因为没有其他可能的权重组合能比它们更好地解释变化。因此，主成分的特征值就是它在整个数据集中解释的总变化量。

回想一下，第一个主成分的方程是 PC1 = α[11]X[1] + α[12]X[2]。

由于第一个主成分解释了最大的变化量，它将具有最大的特征值。第二个成分将具有第二高的特征值，依此类推。因此，一个大于一的特征值表明主成分解释的方差比任何原始变量单独解释的方差都要多。如果你将所有特征值的总和标准化为 1，你将得到每个成分解释的总方差的百分比。这将也有助于你确定一个合适的截止点。

特征值标准并不是一个铁的规则，必须与你对数据和业务问题的了解相*衡。一旦你选择了主成分的数量，你就可以旋转它们，以便简化它们的解释。

旋转

是否应该旋转？如前所述，旋转通过修改每个变量的负载来帮助解释主成分。旋转后的成分所解释的总方差不会改变，但每个成分对总方差贡献的变化会改变。通过旋转，你会发现负载值要么远离零，要么靠*零，从理论上讲，这有助于识别对每个主成分重要的变量。这是尝试将一个变量与一个主成分关联起来的尝试。记住，这是无监督学习，所以你试图理解你的数据，而不是测试某个假设。简而言之，旋转有助于你在这个努力中。

最常见的主成分旋转形式被称为方差最大化（varimax）。还有其他形式，如四分最大化（quartimax）和等最大化（equimax），但我们将专注于方差最大化旋转。根据我的经验，我从未见过其他方法提供更好的解决方案。你自己的试错可能是决定这个问题的最佳方式。

使用方差最大化（varimax），我们最大化了*方负载量的总和。方差最大化过程旋转了特征空间的轴及其坐标，而不改变数据点的位置。

也许，最好的演示方式是通过另一个简单的说明。假设我们有一个变量 A 到 G 的数据集，并且有两个主成分。绘制这些数据，我们将得到以下示意图：

为了辩论的目的，让我们假设变量 A 的负载量在 PC1 上为 -0.4，在 PC2 上为 0.1。现在，让我们假设变量 D 的负载量在 PC1 上为 0.4，在 PC2 上为 -0.3。对于点 E，负载量分别为 -0.05 和 -0.7。请注意，负载量将遵循主成分的方向。在运行方差最大化过程后，旋转的成分将如下所示：

以下是旋转后的 PC1 和 PC2 上的新负载量：

变量 A：-0.5 和 0.02
变量 D：0.5 和 -0.3
变量 E：0.15 和 -0.75

负载量已改变，但数据点没有。通过这个简单的说明，我们可以说我们没有简化解释，但这应该有助于你理解主成分旋转过程中发生的事情。

商业理解

在这个例子中，我们将深入体育界；特别是，国家曲棍球联盟（NHL）。在棒球（想想那本书和电影《点球成金》）和足球方面已经做了很多工作；两者都是美国人玩的用脚踢的球类运动。对我来说，没有比曲棍球更好的观赏性运动了。也许这只是一个在北达科他州的冰冻草原上长大的产物。无论如何，我们可以将这次分析视为我们开始 MoneyPuck 运动的努力。

在这次分析中，我们将查看我从 www.nhl.com 和 www.puckalytics.com 整理的数据集中 30 支 NHL 球队的统计数据。目标是构建一个模型，从使用 PCA 开发的输入特征空间预测球队的积分总和，以便为我们提供一些关于成为顶级职业球队所需条件的见解。我们将从 2015-16 赛季学习模型，该赛季匹兹堡企鹅队夺冠，然后测试其在截至 2017 年 2 月 15 日的本赛季结果上的性能。文件是 nhlTrain.csv 和 nhlTest.csv，位于 github.com/datameister66/data/。

NHL 排名基于积分系统，因此我们的结果将是每场比赛的球队积分。了解 NHL 如何向球队颁发积分很重要。与足球或棒球不同，只有胜负计算，职业曲棍球为每场比赛使用以下积分系统：

胜者无论是在常规时间、加时赛还是通过加时赛后的点球大战中获胜，都将获得两分
一位正规比赛的输家不会得分
加时赛或点球大战的输家获得一分；所谓的输家得分

纳什维尔曲棍球联盟在 2005 年开始实施这个得分系统，它并非没有争议，但它并没有损害比赛的优雅和优雅的暴力。

数据理解和准备

首先，我们将加载必要的包以便下载数据并进行分析。请在加载之前确保已安装这些包：

 > library(ggplot2) #support scatterplot

    > library(psych) #PCA package

假设你已经将两个.csv文件放入了你的工作目录，因此使用read.csv()函数读取训练数据：

 > train <- read.csv("NHLtrain.csv")

使用结构函数str()检查数据。为了简洁，我只包括了命令输出的前几行：

    > str(train)
    'data.frame': 30 obs. of 15 variables:
    $ Team : Factor w/ 30 levels "Anaheim","Arizona",..: 1 2 3 4 5 6 7 
      8 9 10 ...
    $ ppg : num 1.26 0.95 1.13 0.99 0.94 1.05 1.26 1 0.93 1.33 ...
    $ Goals_For : num 2.62 2.54 2.88 2.43 2.79 2.39 2.85 2.59 2.6 3.23 
      ...
    $ Goals_Against: num 2.29 2.98 2.78 2.62 3.13 2.7 2.52 2.93 3.02 
      2.78 ...

我们接下来需要做的是查看变量名。

    > names(train)
    [1] "Team" "ppg" "Goals_For" "Goals_Against" "Shots_For" 
 [6] "Shots_Against" "PP_perc" "PK_perc" "CF60_pp" "CA60_sh" 
 [11] "OZFOperc_pp" "Give" "Take" "hits" "blks"

让我们来看看它们代表什么：

Team: 这是球队的所在城市
ppg: 根据之前讨论的点数计算方法，每场比赛的*均得分
Goals_For: 每场比赛球队的*均进球数
Goals_Against: 每场比赛允许的进球数
Shots_For: 每场比赛的射门次数
Shots_Against: 每场比赛对手的射门次数
PP_perc: 球队得分的机会百分比
PK_perc: 当对手在加时赛中时，球队不允许进球的时间百分比
CF60_pp: 在加时赛中，球队每 60 分钟的*均 Corsi 得分；Corsi 得分是射门次数（Shots_For）、射门未命中和被对方挡住的射门次数之和
CA60_sh: 在对手加时赛中，对手每 60 分钟的 Corsi 得分，即球队处于少人状态
OZFOperc_pp: 当球队在加时赛中时，在进攻区发生的争球次数的百分比
Give: 每场比赛球队失去球权的*均次数
Take: 每场比赛球队获得球权的*均次数
hits: 每场比赛球队的*均身体冲撞次数
blks: 每场比赛球队挡住对方射门次数的*均值

我们需要将数据标准化，使其均值为 0，标准差为 1。一旦完成，我们就可以使用 psych 包中的cor.plot()函数创建和绘制输入特征的关联图：

    > train.scale <- scale(train[, -1:-2])

    > nhl.cor <- cor(train.scale)

    > cor.plot(nhl.cor)

下面的输出是前面命令的结果：

有几个有趣的事情。注意Shots_For与Goals_For相关，反之亦然，Shots_Against与Goals_Against相关。还有一些与PP_perc和PK_perc与Goals_Against的负相关。

因此，这应该是一个足够的数据集来提取几个主成分。

请注意，这些是我根据我的兴趣选择的特征/变量。你可以收集很多不同的统计数据，看看你是否能提高预测能力。

建模和评估

对于建模过程，我们将遵循以下步骤：

提取成分并确定要保留的数量。
旋转保留的成分。
解释旋转后的解。
创建因子得分。
将得分作为回归分析的输入变量，并在测试数据上评估性能。

在 R 中进行 PCA（主成分分析）有许多不同的方法和包，包括看起来在基础 R 中最常用的prcomp()和princomp()函数。然而，对我来说，psych包似乎是最灵活且选项最好的。

成分提取

要使用psych包提取成分，你将使用principal()函数。语法将包括数据和我们是否想要在此时刻旋转成分：

    > pca <- principal(train.scale, rotate="none")

你可以通过调用我们创建的pca对象来检查成分。然而，我的主要意图是确定应该保留多少个成分。为此，一个斜率图就足够了。斜率图可以帮助你评估解释数据中最大方差成分。它在x轴上显示成分编号，在y轴上显示它们相关的特征值：

    > plot(pca$values, type="b", ylab="Eigenvalues", xlab="Component")

以下是在先前的命令输出：

你要找的是斜率图中的一个点，其变化率降低。这通常被称为图中的“肘部”或“弯曲”。图中的这个肘部点捕捉到的事实是，一个成分额外解释的方差与下一个成分的方差差异不大。换句话说，它是图变*的断点。在这个图中，五个成分看起来相当有说服力。

这些年我学到的另一条规则是，你应该捕捉到大约 70%的总方差，这意味着每个选定的成分所解释的累积方差占所有成分解释的方差的 70%。

正交旋转和解释

正如我们之前讨论的，旋转的目的是最大化变量在特定成分上的负荷，这有助于通过减少/消除这些成分之间的相关性来简化解释。进行正交旋转的方法被称为“varimax”。还有其他非正交旋转方法允许因素/成分之间的相关性。你将在职业中使用的旋转方法的选择应基于相关文献，这超出了本章的范围。请随意尝试这个数据集。我认为，在不确定的情况下，任何 PCA 的起点应该是正交旋转。

对于这个过程，我们将简单地回到principal()函数，稍微改变语法以考虑 5 个成分和正交旋转，如下所示：

 > pca.rotate <- principal(train.scale, nfactors = 5, rotate = 
      "varimax")    

 > pca.rotate
    Principal Components Analysis
    Call: principal(r = train.scale, nfactors = 5, rotate = "varimax")
    Standardized loadings (pattern matrix) based upon correlation 
      matrix
                    RC1   RC2    RC5   RC3    RC4    h2    u2  com
    Goals_For     -0.21  0.82   0.21  0.05  -0.11  0.78  0.22  1.3
    Goals_Against  0.88 -0.02  -0.05  0.21   0.00  0.82  0.18  1.1
    Shots_For     -0.22  0.43   0.76 -0.02  -0.10  0.81  0.19  1.8
    Shots_Against  0.73 -0.02  -0.20 -0.29   0.20  0.70  0.30  1.7
    PP_perc       -0.73  0.46  -0.04 -0.15   0.04  0.77  0.23  1.8
    PK_perc       -0.73 -0.21   0.22 -0.03   0.10  0.64  0.36  1.4
    CF60_pp       -0.20  0.12   0.71  0.24   0.29  0.69  0.31  1.9
    CA60_sh        0.35  0.66  -0.25 -0.48  -0.03  0.85  0.15  2.8
    OZFOperc_pp   -0.02 -0.18   0.70 -0.01   0.11  0.53  0.47  1.2
    Give          -0.02  0.58   0.17  0.52   0.10  0.65  0.35  2.2
    Take           0.16  0.02   0.01  0.90  -0.05  0.83  0.17  1.1
    hits          -0.02 -0.01   0.27 -0.06   0.87  0.83  0.17  1.2
    blks           0.19  0.63  -0.18  0.14   0.47  0.70  0.30  2.4

                       RC1  RC2  RC5  RC3  RC4
SS loadings           2.69 2.33 1.89 1.55 1.16
Proportion Var        0.21 0.18 0.15 0.12 0.09
Cumulative Var        0.21 0.39 0.53 0.65 0.74
Proportion Explained  0.28 0.24 0.20 0.16 0.12
Cumulative Proportion 0.28 0.52 0.72 0.88 1.00

在输出中，有两个重要的事情需要消化。第一个是五个成分（标记为RC1至RC5）的变量载荷。我们看到成分一中的Goals_Against和Shots_Against具有高正载荷，而PP_perc和PK_perc具有高负载荷。成分二的较高载荷是Goals_For。成分五具有与Shots_For、ff和OZFOperc_pp的高载荷。成分三似乎只与变量 take 有关，而成分四与击球有关。接下来，我们将继续进行第二部分的检查：从*方和SS loadings开始的表格。在这里，数字是每个成分的特征值。当它们被归一化时，你将得到Proportion Explained行，正如你可能猜到的，这代表每个成分解释的方差比例。你可以看到，成分一解释了五个旋转成分解释的所有方差的 28%。记住，我上面提到的一个启发式规则是，你选择的成分应该解释至少 70%的总变异。如果你查看Cumulative Var行，你会发现这五个旋转成分解释了 74%的总变异，我们可以有信心我们有了正确数量的模型来继续前进。

从组成部分创建因子得分

现在，我们需要捕获旋转成分的载荷作为每个团队的因子得分。这些得分表明每个观测值（在我们的案例中，是 NHL 球队）如何与旋转成分相关。让我们这样做，并将得分捕获在数据框中，因为我们将需要它来进行回归分析：

 > pca.scores <- data.frame(pca.rotate$scores)

 > head(pca.scores)
 RC1          RC2        RC5         RC3        RC4
 1 -2.21526408  0.002821488  0.3161588  -0.1572320  1.5278033
 2  0.88147630 -0.569239044 -1.2361419  -0.2703150 -0.0113224
 3  0.10321189  0.481754024  1.8135052  -0.1606672  0.7346531
 4 -0.06630166 -0.630676083 -0.2121434  -1.3086231  0.1541255
 5  1.49662977  1.156905747 -0.3222194   0.9647145 -0.6564827
 6 -0.48902169 -2.119952370  1.0456190   2.7375097 -1.3735777

现在我们有了每个团队每个成分的得分。这些只是每个观测值（在我们的案例中，是 NHL 球队）的变量乘以每个成分的载荷，然后求和。现在我们可以将响应（ppg）作为一个列添加到数据中。

 > pca.scores$ppg <- train$ppg

完成这些后，我们现在将转向预测模型。

回归分析

要完成这个过程的一部分，我们将重复第二章中的步骤和代码，线性回归 - 机器学习的技巧和策略。如果你还没有这样做，请查看第二章中的线性回归 - 机器学习的技巧和策略，以了解如何解释以下输出。

我们将使用以下lm()函数创建我们的线性模型，将所有因子作为输入，然后总结结果：

 > nhl.lm <- lm(ppg ~ ., data = pca.scores)
 > summary(nhl.lm)

 Call:
 lm(formula = ppg ~ ., data = pca.scores)

 Residuals:
 Min        1Q   Median       3Q      Max 
 -0.163274 -0.048189 0.003718 0.038723 0.165905 

 Coefficients:
 Estimate       Std. Error t value Pr(>|t|) 
 (Intercept) 1.111333   0.015752  70.551  < 2e-16  ***
 RC1        -0.112201   0.016022  -7.003  3.06e-07 ***
 RC2         0.070991   0.016022   4.431  0.000177 ***
 RC5         0.022945   0.016022   1.432  0.164996 
 RC3        -0.017782   0.016022  -1.110  0.278044 
 RC4        -0.005314   0.016022  -0.332  0.743003 
 ---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.08628 on 24 degrees of freedom
Multiple R-squared: 0.7502, Adjusted R-squared: 0.6981 
F-statistic: 14.41 on 5 and 24 DF, p-value: 1.446e-06

好消息是，我们的整体模型在统计学上高度显著，p-value为1.446e-06，而Adjusted R-squared接* 70%。坏消息是，有三个组成部分并不显著。我们可以简单地选择将它们保留在我们的模型中，但让我们看看如果我们排除它们，只保留RC1和RC2会发生什么：

 > nhl.lm2 <- lm(ppg ~ RC1 + RC2, data = pca.scores)
 > summary(nhl.lm2)

 Call:
 lm(formula = ppg ~ RC1 + RC2, data = pca.scores)

 Residuals:
 Min       1Q  Median      3Q     Max 
 -0.18914 -0.04430 0.01438 0.05645 0.16469 

 Coefficients:
 Estimate Std. Error t value  Pr(>|t|) 
 (Intercept) 1.11133    0.01587  70.043   < 2e-16  ***
 RC1        -0.11220    0.01614  -6.953   1.8e-07  ***
 RC2         0.07099    0.01614   4.399   0.000153 ***
 ---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.0869 on 27 degrees of freedom
Multiple R-squared: 0.7149, Adjusted R-squared: 0.6937 
F-statistic: 33.85 on 2 and 27 DF, p-value: 4.397e-08

这个模型仍然实现了大致相同的调整后的 R *方值（93.07%），并且具有统计上显著的因子系数。我将省略运行诊断测试的细节。相反，让我们看看一些图表，以便更好地检验我们的分析。我们可以使用基本的 R 图形进行预测值和实际值的散点图，如下所示：

 > plot(nhl.lm2$fitted.values, train$ppg,
 main="Predicted versus Actual",
 xlab="Predicted",ylab="Actual")

下面的输出是前面命令的结果：

这证实了我们的模型在用两个成分预测团队成功方面做得很好，同时也突出了主成分和每场比赛团队得分之间的强线性关系。让我们通过使用ggplot2包进行散点图并包含团队名称来提高一个档次。唯一的问题是这是一个功能非常强大的函数，有很多选项。有大量的在线资源可以帮助你导航ggplot()迷宫，但这段代码应该能帮助你入门。让我们首先创建我们的基线图并将其分配给一个名为p的对象，然后添加各种绘图功能。

 > train$pred <- round(nhl.lm2$fitted.values, digits = 2)

 > p <- ggplot(train, aes(x = pred,
 y = ppg,
 label = Team))

 > p + geom_point() +
 geom_text(size = 3.5, hjust = 0.1, vjust = -0.5, angle = 0) +
 xlim(0.8, 1.4) + ylim(0.8, 1.5) +
 stat_smooth(method = "lm", se = FALSE)

下面的输出是前面命令的结果：

创建p的语法非常简单。我们只是指定了数据框，并在aes()中放入我们想要的x和y以及我们想要用作标签的变量。然后我们只是添加了数据点等整洁的层。通过在语法中包含+，你可以将任何你想要的内容添加到图表中，如下所示：

    > p + geom_point() +

我们指定了team标签的显示方式。要调整字体大小和位置，需要大量的尝试和错误：

    geom_text() +

现在，指定x轴和y轴的极限，否则图表将裁剪掉任何超出这些极限的观测值，如下所示：

    xlim() + ylim() +

最后，我们添加了一条没有标准误差阴影的最佳拟合线：

    stat_smooth(method = "lm", se = FALSE)

我想一种思考这个图表的方法是，位于线下方的团队表现不佳，而位于上方的团队表现超出预期。

另一项分析是将团队与他们的因子分数进行关系绘图，这被称为双图。再次，ggplot()简化了这项分析。以之前的代码为指南，让我们更新它并看看结果如何：

 > pca.scores$Team <- train$Team

 > p2 <- ggplot(pca.scores, aes(x = RC1, y = RC2, label = Team))

 > p2 + geom_point() +
 geom_text(size = 2.75, hjust = .2, vjust = -0.75, angle = 0) +
 xlim(-2.5, 2.5) + ylim(-3.0, 2.5)

前面命令的输出如下：

如您所见，x 轴是 RC1 的团队得分，而 y 轴是 RC2 的得分。看看 Anaheim ducks，RC1 的得分最低，而 RC2 的*均得分。现在考虑一下这种影响。由于 RC1 的加时赛和罚球防守的负负荷以及 Goals_Against 的正负荷，这表明该队在防守方面表现良好，并且有效利用了少人作战。顺便说一句，匹兹堡队是最终的 Stanley Cup 赢家。他们的得分很稳定，但没有什么值得注意的。记住，该队在赛季初表现糟糕，解雇了他们赛季初的教练。比较他们在赛季上半场和下半场在这项分析中的表现将很有趣。

您可以像我们之前做的那样评估模型误差。让我们看看均方根误差（RMSE）：

 > sqrt(mean(nhl.lm2$residuals²))
 [1] 0.08244449

在完成这些之后，我们需要看看它在样本外的表现。我们将加载测试数据，预测组件上的团队得分，然后基于线性模型做出预测。来自 psych 包的 predict 函数将自动缩放测试数据：

 > test <- read.csv("NHLtest.csv")
 > test.scores <- data.frame(predict(pca.rotate, test[, c(-1:-2)]))
 > test.scores$pred <- predict(nhl.lm2, test.scores)

我认为我们应该像上面那样绘制结果，显示团队名称。让我们把这些都放入一个数据框中：

 > test.scores$ppg <- test$ppg

 > test.scores$Team <- test$Team

然后，利用 ggplot() 的力量：

 > p <- ggplot(test.scores, aes(x = pred,
 y = ppg,
 label = Team)) 

 > p + geom_point() + 
 geom_text(size=3.5, hjust=0.4, vjust = -0.9, angle = 35) + 
 xlim(0.75, 1.5) + ylim(0.5, 1.6) +
 stat_smooth(method="lm", se=FALSE)

前一个命令的输出如下：

我在测试数据中简化了团队名称，以便更容易理解。我们的每场比赛得分领先者是华盛顿首都队，而最差的球队是科罗拉多雪崩队。事实上，当我提取这些数据时，科罗拉多已经连续输了五场比赛。他们最终在加时赛中击败了卡罗来纳队，打破了连败。

最后，让我们检查一下均方根误差（RMSE）。

 > resid <- test.scores$ppg - test.scores$pred

 > sqrt(mean(resid²))
 [1] 0.1011561

样本误差为 0.1，而样本内误差为 0.08，这并不坏。我认为我们可以宣布这是一个有效的模型。然而，我们还可以添加大量的团队统计数据来提高预测能力和减少误差。我会继续努力，也希望你们也是如此。

摘要

在本章中，我们通过探索主成分分析（PCA），检查其是什么，并以实际方式应用它，再次尝试无监督学习技术。我们探讨了它如何用于在面临众多高度相关的变量时降低数据集的维度并提高对其的理解。然后，我们将它应用于来自国家曲棍球联盟的真实数据，使用得到的特征成分在回归分析中预测总团队得分。此外，我们还探讨了可视化数据和特征成分的方法。

作为一种无监督学习技术，它需要一些判断以及试错，以达到一个业务伙伴可以接受的优化解决方案。尽管如此，它是一个强大的工具，可以提取潜在见解并支持监督学习。

我们接下来将探讨如何使用无监督学习来开发市场篮子分析和推荐引擎，其中主成分分析（PCA）可以发挥重要作用。

第十章：购物篮分析、推荐引擎和序列分析

通过加倍转换率来加倍你的业务，比通过加倍流量要容易得多。

BuyerLegends.com 首席执行官杰夫·艾森伯格

我没在 Whole Foods 的人脸上看到笑容。

沃伦·巴菲特

要不观察我们即将在本章讨论的每种技术每天的结果，人们就得住在月亮的阴暗面。如果你访问 www.amazon.com，在 www.netflix.com 观看电影，或者访问任何零售网站，你都会在每个角落遇到诸如“相关产品”、“因为你观看了...”、“购买 x 的顾客也购买了 y”或“为您推荐”等术语。有了大量历史实时或接*实时信息，零售商利用这里讨论的算法试图增加买家的购买数量和价值。

实现这些技巧的方法可以分为两类：关联规则和推荐引擎。关联规则分析通常被称为购物篮分析，因为人们试图了解哪些商品是共同购买的。在推荐引擎中，目标是根据客户之前评分的观看或购买的商品提供他们可能会喜欢的其他商品。

另一种企业可以使用的技巧是了解你购买或使用他们产品和服务的时间顺序。这被称为序列分析。这种方法的非常常见的实现方式是了解客户如何点击各种网页和/或链接。

在接下来的例子中，我们将努力探索如何使用 R 开发这样的算法。我们不会涵盖它们的实现，因为这超出了本书的范围。我们将从一个杂货店的购买习惯的购物篮分析开始，然后深入构建基于网站评论的推荐引擎，最后分析网页的顺序。

购物篮分析概述

购物篮分析是一种数据挖掘技术，其目的是找到产品或服务的最佳组合，并允许营销人员利用这种知识提供推荐、优化产品摆放或开发利用交叉销售的营销计划。简而言之，想法是识别哪些商品搭配得好，并从中获利。

你可以把分析的结果看作一个 if...then 语句。如果一个顾客购买了飞机票，那么他们购买酒店房间的概率是 46%，如果他们继续购买酒店房间，那么他们租车的概率是 33%。

然而，它不仅用于销售和营销。它还被用于欺诈检测和医疗保健；例如，如果一个患者接受了治疗 A，那么他们可能会表现出症状 X 的概率为 26%。在进入细节之前，我们应该看看一些术语，因为它们将在示例中使用：

项集：这是数据集中一个或多个项目的集合。
支持度：这是数据中包含感兴趣项集的交易比例。
置信度：这是如果一个人购买了或做了 x，他们将会购买或做 y 的条件概率；做 x 的行为被称为前提或左侧（LHS），而 y 是结果或右侧（RHS）。
提升度：这是 x 和 y 同时发生的支持度与它们独立发生的概率之比。它是置信度除以 x 的概率乘以 y 的概率；例如，如果我们有 x 和 y 同时发生的概率为 10%，x 的概率为 20%，y 的概率为 30%，那么提升度将是 10%（20%乘以 30%）或 16.67%。

你可以在 R 中使用的用于执行市场篮子分析的包是arules: Mining Association Rules and Frequent Itemsets。该包提供两种不同的查找规则的方法。为什么会有不同的方法？简单地说，如果你有大量数据集，检查所有可能的产品组合可能会变得计算成本高昂。该包支持的算法是apriori和ECLAT。还有其他算法可以进行市场篮子分析，但 apriori 使用得最频繁，因此，我们将重点关注它。

在 apriori 中，原则是，如果一个项集是频繁的，那么它的所有子集也必须是频繁的。最小频率（支持度）是在执行算法之前由分析师确定的，一旦确定，算法将按以下方式运行：

令 k=1（项目数量）
生成等于或大于指定支持度的项集长度
迭代 k + (1...n)，剪枝那些不频繁的（小于支持度）
当没有新的频繁项集被识别时停止迭代

一旦你有了最频繁项集的有序摘要，你可以通过检查置信度和提升度来继续分析过程，以识别感兴趣的关联。

商业理解

对于我们的业务案例，我们将专注于识别杂货店的关联规则。数据集将来自arules包，称为Groceries。这个数据集包含了一个现实世界杂货店 30 天内的实际交易，包括 9,835 种不同的购买。所有购买的物品都被放入 169 个类别中的一个，例如，面包、酒、肉类等等。

假设我们是一家初创精酿啤酒厂，试图在这家杂货店取得突破，并希望了解潜在顾客会与啤酒一起购买什么。这种知识可能正好帮助我们确定店内正确的产品摆放位置，或者支持交叉销售活动。

数据理解和准备

对于这次分析，我们只需要加载两个包，以及Groceries数据集：

    > library(arules)

    > library(arulesViz)

    > data(Groceries) 
    > head(Groceries) 
    transactions in sparse format with
     9835 transactions (rows) and
     169 items (columns)

    > str(Groceries)
    Formal class 'transactions' [package "arules"] with 3 slots
      ..@ data :Formal class 'ngCMatrix' [package "Matrix"] with 5 
        slots
      .. .. ..@ i : int [1:43367] 13 60 69 78 14 29 98 24 15 29 ...
      .. .. ..@ p : int [1:9836] 0 4 7 8 12 16 21 22 27 28 ...
      .. .. ..@ Dim : int [1:2] 169 9835
      .. .. ..@ Dimnames:List of 2
      .. .. .. ..$ : NULL
      .. .. .. ..$ : NULL
      .. .. ..@ factors : list()
      ..@ itemInfo :'data.frame': 169 obs. of 3 variables:
      .. ..$ labels: chr [1:169] "frankfurter" "sausage" "liver loaf" 
        "ham" ...
      .. ..$ level2: Factor w/ 55 levels "baby food","bags",..: 44 44 
      44 44 44 44
      44 42 42 41 ...
      .. ..$ level1: Factor w/ 10 levels "canned food",..: 6 6 6 6 6 6 
      6 6 6 6 
      ...
      ..@ itemsetInfo:'data.frame': 0 obs. of 0 variables

这个数据集的结构是一个稀疏矩阵对象，称为transaction类。

因此，一旦结构变成交易类，我们的标准探索技术将不再适用，但arules包为我们提供了其他探索数据的技术。顺便提一下，如果你有一个数据框或矩阵，并想将其转换为transaction类，你可以使用简单的语法，通过as()函数实现。

以下代码仅用于说明，请勿运行：

> # transaction.class.name <- as(current.data.frame,"transactions")。

探索这些数据最好的方式是使用arules包中的itemFrequencyPlot()函数制作项目频率图。你需要指定交易数据集、要绘制频率最高的项目数量，以及是否需要绘制项目的相对或绝对频率。让我们首先查看绝对频率和前10个商品：

    > itemFrequencyPlot(Groceries, topN = 10, type = "absolute")

前一个命令的输出如下：

购买最多的商品是全脂牛奶，在 9,836 笔交易中有大约2,500笔。为了显示前 15 个商品的相对分布，让我们运行以下代码：

    > itemFrequencyPlot(Groceries, topN = 15)

前一个命令的输出如下：

殊不知，在这里我们看到啤酒作为第 13 和第 15 大购买商品出现在这家商店。大约 10%的交易包含了瓶装啤酒和/或罐装啤酒的购买。

对于这个练习的目的，我们实际上需要做的就这么多，因此，我们可以直接进入建模和评估阶段。

建模和评估

我们将首先挖掘数据以获取整体关联规则，然后再转向针对啤酒的具体规则。在整个建模过程中，我们将使用 apriori 算法，这是arules包中名为apriori()的适当命名的函数。在函数中，我们需要指定的主要两件事是数据集和参数。至于参数，在指定最小支持度、置信度以及项目集的最小和/或最大长度时，你需要运用判断力。使用项目频率图，结合试错法，我们将最小支持度设置为 1000 笔交易中的 1，最小置信度设置为 90%。此外，我们将关联的项目数量上限设置为四个。以下是我们将创建的名为rules的对象的代码：

    > rules <- apriori(Groceries, parameter = list(supp = 0.001, conf = 
      0.9, maxlen=4))

调用对象显示了算法产生的规则数量：

    > rules
    set of 67 rules

有许多方法可以检查规则。我首先推荐的是，使用基础 R 中的options()函数将显示的数字位数设置为仅两位。然后，根据它们提供的提升度对前五条规则进行排序和检查，如下所示：

    > options(digits = 2)

    > rules <- sort(rules, by = "lift", decreasing = TRUE)

    > inspect(rules[1:5])
      lhs                 rhs                support confidence lift
    1 {liquor, red/blush wine}     => {bottled beer}      0.0019       
       0.90 11.2
    2 {root vegetables, butter, cream cheese }      => {yogurt}            
       0.0010       0.91  6.5
    3 {citrus fruit, root vegetables, soft cheese}=> {other vegetables}  
       0.0010       1.00  5.2
    4 {pip fruit, whipped/sour cream, brown bread}=> {other vegetables}  
       0.0011       1.00  5.2
    5 {butter,whipped/sour cream, soda}    => {other vegetables}  
       0.0013       0.93  4.8

看看，提供最佳整体提升度的规则是购买酒和红酒的概率，基于购买瓶装啤酒。我必须承认，这完全是巧合，并不是我故意为之。正如我经常说的，幸运比好更重要。尽管如此，这仍然不是一个非常常见的交易，支持率仅为每 1,000 次交易中有 1.9 次。

你也可以按支持和置信度排序，所以让我们看看按confidence降序排列的前5条规则，如下所示：

    > rules <- sort(rules, by = "confidence", decreasing = TRUE) 
    > inspect(rules[1:5])
      lhs             rhs                support confidence lift
    1 {citrus fruit, root vegetables, soft cheese}=> {other vegetables}  
      0.0010          1  5.2
    2 {pip fruit, whipped/sour cream, brown bread}=> {other vegetables}  
      0.0011          1  5.2
    3 {rice, sugar}  => {whole milk}        0.0012          1  3.9
    4 {canned fish, hygiene articles} => {whole milk} 0.0011   1  3.9
    5 {root vegetables, butter, rice} => {whole milk} 0.0010   1  3.9

你可以在表中看到，这些交易的confidence为 100%。继续到我们具体的啤酒研究，我们可以利用arules中的函数来开发交叉表——crossTable()函数——然后检查任何适合我们需求的内容。第一步是创建一个包含我们的数据集的表：

    > tab <- crossTable(Groceries)

使用 tab 创建后，我们现在可以检查项目之间的联合出现情况。在这里，我们将只查看前三个行和列：

    > tab[1:3, 1:3]
                frankfurter sausage liver loaf
    frankfurter         580      99          7
    sausage              99     924         10
    liver loaf            7      10         50

如你所想，购物者在 9,835 次交易中只选择了 50 次肝肉饼。此外，在924次中，人们倾向于选择香肠，10次他们感到不得不抓取肝肉饼。（在绝望的时刻需要采取绝望的措施！）如果你想查看一个具体的例子，你可以指定行和列号，或者只拼写那个项目：

    > table["bottled beer","bottled beer"]
    [1] 792

这告诉我们有792次交易是瓶装啤酒。让我们看看瓶装啤酒和罐装啤酒之间的联合出现情况：

    > table["bottled beer","canned beer"]
    [1] 26

我预计这会很低，因为它支持我的观点，即人们倾向于从瓶装或罐装中喝酒。我强烈偏好瓶装。这也使得它成为一件方便的武器，可以用来保护自己免受所有这些流氓抗议者，如占领华尔街和类似的人。

我们现在可以继续前进，并推导出针对瓶装啤酒的具体规则。我们再次使用apriori()函数，但这次，我们将在appearance周围添加语法。这意味着我们将在语法中指定，我们想要左侧是增加购买瓶装啤酒概率的项目，这些项目将位于右侧。在下面的代码中，请注意我已经调整了support和confidence数字。请随意尝试你自己的设置：

 > beer.rules <- apriori(data = Groceries, parameter = list(support 
      = 0.0015, confidence = 0.3), appearance = list(default = "lhs",
        rhs = "bottled beer"))

    > beer.rules
    set of 4 rules

我们发现自己只有4条关联规则。我们已经看到了其中之一；现在让我们按提升度降序引入其他三条规则：

    > beer.rules <- sort(beer.rules, decreasing = TRUE, by = "lift")

    > inspect(beer.rules)
      lhs                   rhs            support confidence lift
    1 {liquor, red/blush wine} => {bottled beer}  0.0019  0.90 11.2
    2 {liquor}               => {bottled beer}    0.0047  0.42  5.2
    3 {soda, red/blush wine} => {bottled beer}    0.0016  0.36  4.4
    4 {other vegetables, red/blush wine} => {bottled beer}0.0015 0.31  
      3.8

在所有这些实例中，购买 瓶装啤酒 与酒精饮料相关联，无论是 烈酒 和/或 红酒，这对任何人来说都不足为奇。有趣的是，这里没有 白葡萄酒。让我们更仔细地看看这一点，并比较 瓶装啤酒 和葡萄酒类型的联合出现：

    > tab["bottled beer", "red/blush wine"]
    [1] 48

    > tab["red/blush wine", "red/blush wine"]
    [1] 189

    > 48/189
    [1] 0.25

    > tab["white wine", "white wine"]
    [1] 187

    > tab["bottled beer", "white wine"]
    [1] 22

    > 22/187
    [1] 0.12

有趣的是，25% 的时间，当有人购买 红酒 时，他们也购买了 瓶装啤酒；但与 白葡萄酒 相比，联合购买只发生在 12% 的情况下。我们当然不知道在这个分析中为什么，但这可能有助于我们确定如何在这个杂货店定位我们的产品。在我们继续之前，还有一个事情要看看规则的图。这是通过 arulesViz 包中的 plot() 函数完成的。

有许多图形选项可用。对于这个例子，让我们指定我们想要一个 图形，显示 提升 和由 信心 提供和阴影的规则。以下语法将相应地提供：

    > plot(beer.rules, method = "graph", measure = "lift", shading = 
    "confidence")

下面的输出是前面命令的结果：

此图显示，烈酒/红酒在圆圈的大小及其阴影方面提供了最佳的提升和最高的信心水*。

我们在这个简单的练习中所做的是展示使用 R 进行市场篮子分析是多么容易。想象一下，使用这种技术可以包括哪些分析可能性，例如，在企业客户细分、纵向购买历史等方面，以及如何将其用于广告展示、联合促销等。现在让我们转向一个客户对商品进行评分的情况，并学习如何构建和测试推荐引擎。

基于用户的协同过滤

在 UBCF 中，算法首先找到与目标用户最相似的用户邻域，然后汇总这些用户的评分以形成预测（Hahsler, 2011）。邻域是通过选择与目标用户最相似的 KNN 或通过某种最小阈值的相似度度量来确定的。recommenderlab中可用的两种相似度度量是皮尔逊相关系数和余弦相似度。我将跳过这些度量的公式，因为它们在包的文档中很容易找到。

一旦决定了邻域方法，算法通过仅计算感兴趣个体与其邻居在共同评分的项目上的相似度来识别邻居。通过评分方案，例如简单的*均，汇总评分以对感兴趣的个人和项目做出预测评分。

让我们来看一个简单的例子。在以下矩阵中，有六个人对四部电影进行了评分，除了我对 Mad Max 的评分。使用 k=1，最*的邻居是 Homer，其次是 Bart；尽管 弗兰德斯和我一样讨厌 复仇者联盟。因此，使用 Homer 对 Mad Max 的评分，即 4，对我的预测评分也将是 4：

有多种方法可以衡量数据并/或控制偏差。例如，弗兰德斯的用户评分很可能比其他用户低，因此，在数据标准化时，将新的评分分数设置为用户对某项物品的评分减去该用户对所有物品的*均评分，可能会提高评分的准确性。

UBCF 的弱点在于，为了计算所有可能用户的相似度度量，必须将整个数据库保留在内存中，这可能会非常计算量大且耗时。

基于物品的协同过滤

如你所猜，IBCF 使用物品之间的相似性而不是用户之间的相似性来做出推荐。这种方法的假设是，用户将更喜欢与他们喜欢的其他物品相似的物品（Hahsler，2011）。模型是通过计算所有物品的双边相似度矩阵来构建的。流行的相似度度量包括皮尔逊相关性和余弦相似性。为了减少相似度矩阵的大小，可以指定仅保留 k 个最相似的物品。然而，限制邻域的大小可能会显著降低准确性，导致性能不如 UCBF。

继续我们的简化示例，如果我们检查以下矩阵，当 k=1 时，与 Mad Max 最相似的项目是 美国狙击手，因此我们可以将那个评分作为 Mad Max 的预测，如下所示：

单值分解和主成分分析

在数据集中，用户和物品的数量数以百万计的情况相当常见。即使评分矩阵不是那么大，通过创建一个较小的（低秩）矩阵来捕捉高维矩阵中的大部分信息，可能也有利于降低维度。这可能会潜在地允许你捕捉数据中的重要潜在因素及其对应的权重。这些因素可能导致重要的见解，例如评分矩阵中的电影类型或书籍主题。即使你无法识别有意义的因素，这些技术也可能过滤掉数据中的噪声。

大数据集的一个问题是，你可能会得到一个稀疏矩阵，其中包含许多缺失的评分。这些方法的弱点是它们不能在包含缺失值的矩阵上工作，这些缺失值必须被估计。与任何数据估计任务一样，有几种技术可以尝试和实验，例如使用*均值、中位数或用零编码。recommenderlab的默认值是使用中位数。

那么，SVD 是什么？它是一种矩阵分解的方法，可以帮助将一组相关特征转换为不相关特征的一组。比如说，你有一个名为A的矩阵。这个矩阵将分解为三个矩阵：U、D和V^T。U 是一个正交矩阵，D 是一个非负的对角矩阵，V^T 是一个正交矩阵的转置。现在，让我们看看我们的评分矩阵，并使用 R 来通过一个例子进行说明。

我们首先要做的是重新创建评分矩阵（可以将其视为矩阵A，如下面的代码所示）：

    > ratings <- c(3, 5, 5, 5, 1, 1, 5, 2, 5, 1, 1, 5, 3, 5, 1, 5, 4 
      ,2, 4, 3, 4, 2, 1, 4)

    > ratingMat <- matrix(ratings, nrow = 6)

    > rownames(ratingMat) <- c("Homer", "Marge", "Bart", "Lisa", 
      "Flanders", "Me")

    > colnames(ratingMat) <- c("Avengers", "American Sniper", "Les 
      Miserable", "Mad Max")

    > ratingMat
    Avengers  American Sniper  Les Miserable   Mad    Max
    Homer        3               5             3       4
    Marge        5               2             5       3
    Bart         5               5             1       4
    Lisa         5               1             5       2
    Flanders     1               1             4       1
    Me           1               5             2       4

现在，我们将使用基础 R 中的svd()函数来创建上述三个矩阵，R 将其称为$d、$u和$v。你可以将$u值视为个体在该因子上的载荷，而$v值则视为电影在该维度上的载荷。例如，Mad Max在第一个维度上的载荷为-0.116（第 1 行，第 4 列）：

    > svd <- svd(ratingMat)

    > svd
    $d
    [1] 16.1204848  6.1300650  3.3664409  0.4683445

    $u
               [,1]       [,2]       [,3]        [,4]
    [1,] -0.4630576  0.2731330  0.2010738 -0.27437700
    [2,] -0.4678975 -0.3986762 -0.0789907  0.53908884
    [3,] -0.4697552  0.3760415 -0.6172940 -0.31895450
    [4,] -0.4075589 -0.5547074 -0.1547602 -0.04159102
    [5,] -0.2142482 -0.3017006  0.5619506 -0.57340176
    [6,] -0.3660235  0.4757362  0.4822227  0.44927622

    $v
               [,1]       [,2]        [,3]       [,4]
    [1,] -0.5394070 -0.3088509 -0.77465479 -0.1164526
    [2,] -0.4994752  0.6477571  0.17205756 -0.5489367
    [3,] -0.4854227 -0.6242687  0.60283871 -0.1060138
    [4,] -0.4732118  0.3087241  0.08301592  0.8208949

探索通过降低维度可以解释多少变化是很容易的。让我们先求出$d的对角线数字之和，然后看看我们只用两个因子就能解释多少变化，如下所示：

    > sum(svd$d)
    [1] 26.08534

    > var <- sum(svd$d[1:2])

    > var
    [1] 22.25055

    > var/sum(svd$d)
    [1] 0.8529908

通过使用四个因子中的两个，我们能够捕捉到整个矩阵中超过 85%的总变化。你可以看到减少维度将产生的分数。为此，我们将创建一个函数。（非常感谢www.stackoverflow.com上的响应者，他们帮助我把这个函数组合起来。）这个函数将允许我们指定要包含在预测中的因子数量。它通过将$u矩阵乘以$v矩阵再乘以$d矩阵来计算评分值：

    > f1 <- function(x) {
    score = 0
    for(i in 1:n )
       score <- score + svd$u[,i] %*% t(svd$v[,i]) * svd$d[i]
    return(score)}

通过指定n=4并调用该函数，我们可以重新创建原始的评分矩阵：

    > n = 4

    > f1(svd)
         [,1] [,2] [,3] [,4]
    [1,]    3    5    3    4
    [2,]    5    2    5    3
    [3,]    5    5    1    4
    [4,]    5    1    5    2
    [5,]    1    1    4    1
    [6,]    1    5    2    4

或者，我们可以指定n=2并检查得到的矩阵：

    > n = 2

    > f1(svd)
                [,1]      [,2]     [,3]     [,4]
    [1,] 3.509402 4.8129937 2.578313 4.049294
    [2,] 4.823408 2.1843483 5.187072 2.814816
    [3,] 3.372807 5.2755495 2.236913 4.295140
    [4,] 4.594143 1.0789477 5.312009 2.059241
    [5,] 2.434198 0.5270894 2.831096 1.063404
    [6,] 2.282058 4.8361913 1.043674 3.692505

因此，使用 SVD，你可以降低维度，并可能识别出有意义的潜在因子。

如果你已经阅读了前一章，你会看到与 PCA 的相似之处。事实上，这两个方法是密切相关的，并且经常可以互换使用，因为它们都利用矩阵分解。你可能想知道它们之间的区别？简而言之，PCA 基于协方差矩阵，它是对称的。这意味着你从数据开始，计算中心化数据的协方差矩阵，对其进行对角化，并创建成分。

让我们将前一章中的一部分 PCA 代码应用到我们的数据中，以查看差异如何体现出来：

    > library(psych)

    > pca <- principal(ratingMat, nfactors = 2, rotate = "none")

    > pca
    Principal Components Analysis
    Call: principal(r = ratingMat, nfactors = 2, rotate =
    "none")
    Standardized loadings (pattern matrix) based upon correlation 
      matrix
                      PC1   PC2   h2    u2
    Avengers        -0.09  0.98 0.98 0.022
    American Sniper  0.99 -0.01 0.99 0.015
    Les Miserable   -0.90  0.18 0.85 0.150
    Mad Max          0.92  0.29 0.93 0.071

                                PC1  PC2
    SS loadings           2.65 1.09
    Proportion Var        0.66 0.27
    Cumulative Var        0.66 0.94
    Proportion Explained  0.71 0.29
    Cumulative Proportion 0.71 1.00

你可以看到主成分分析（PCA）更容易解释。注意《美国狙击手》和《疯狂的麦克斯》在第一个成分上有很高的载荷，而只有《复仇者联盟》在第二个成分上有很高的载荷。此外，这两个成分解释了数据中 94%的总方差。值得注意的是，在这本书的第一版和第二版之间，主成分分析（PCA）已经不可用。

在将简单的评分矩阵应用于协同过滤技术之后，让我们通过使用真实世界数据的一个更复杂的例子继续前进。

商业理解和建议

这个案例实际上是一个笑话。也许更恰当的说法是一系列笑话，因为我们将从recommenderlab包中使用Jester5k数据。这些数据包括从 Jester 在线笑话推荐系统抽取的 100 个笑话的 5,000 个评分。这些数据收集于 1999 年 4 月至 2003 年 5 月之间，所有用户至少评分了 36 个笑话（Goldberg, Roeder, Gupta, and Perkins, 2001）。我们的目标是比较推荐算法并选择最佳算法。

因此，我认为以一个统计笑话开头是很重要的，以使人们处于正确的思维框架。我不确定如何正确地提供这个笑话的归属，但它在互联网上很受欢迎。

一个统计学家妻子生了双胞胎。他很高兴。他给牧师打电话，牧师也很高兴。“周日把他们带到教堂，我们将为他们施洗”，牧师说。“不”，统计学家回答说。“施洗一个。我们将保留另一个作为对照组。”

数据理解、准备和推荐

我们将在这个练习中需要的唯一库是recommenderlab。这个包是由南卫理公会大学的 Lyle 工程实验室开发的，他们有一个支持文档优秀的网站，网址为lyle.smu.edu/IDA/recommenderlab/：

    > library(recommenderlab)

    > data(Jester5k)

    > Jester5k
    5000 x 100 rating matrix of class 'realRatingMatrix' with
    362106 ratings.

评分矩阵包含362106个总评分。获取用户评分列表相当容易。让我们看看用户编号10。以下输出仅包含前五个笑话的摘要：

    > as(Jester5k[10,], "list")
    $u12843
       j1    j2    j3    j4    j5 ...
    -1.99 -6.89  2.09 -4.42 -4.90 ...

你还可以查看用户（用户10）的*均评分或特定笑话（笑话1）的*均评分，如下所示：

    > rowMeans(Jester5k[10,])
    u12843 
      -1.6

    > colMeans(Jester5k[,1])
    j1 
    0.92

了解数据的一种方法是绘制评分直方图，包括原始数据和归一化后的数据。我们将使用recommenderlab中的getRating()函数来完成这项工作：

    > hist(getRatings(Jester5k), breaks=100)

前一个命令的输出如下：

包中的normalize()函数通过从笑话的评分中减去评分的*均值来对数据进行中心化。由于前面的分布略微偏向正面评分，因此对数据进行归一化可以解决这个问题，从而产生一个更正常的分布，但仍然略微偏向正面评分，如下所示：

    > hist(getRatings(normalize(Jester5k)), breaks = 100)

以下是为前一个命令的输出：

在建模和评估之前，使用recommenderlab包的evaluationScheme()函数创建train和test数据集非常容易。让我们将数据分成 80/20 的train和test集。你也可以选择 k 折交叉验证和自助重采样，如果你希望的话。我们还将指定对于test集，算法将给出 15 个评分。这意味着其他评分项将用于计算误差。此外，我们将指定良好评分的阈值；在我们的情况下，大于或等于5：

    > set.seed(123)

    > e <- evaluationScheme(Jester5k, method="split", 
    train=0.8, given=15, goodRating=5)

    >  e
    Evaluation scheme with 15 items given
    Method: 'split' with 1 run(s).
    Training set proportion: 0.800
    Good ratings: >=5.000000
    Data set: 5000 x 100 rating matrix of class
    'realRatingMatrix' with 362106
     ratings.

在建立了train和test数据后，我们现在将开始建模和评估不同的推荐器：基于用户的、基于项目的、流行的、SVD、PCA 和随机的。

建模、评估和推荐

为了构建和测试我们的推荐引擎，我们可以使用相同的函数Recommender()，只需更改每个技术的指定即可。为了了解这个包能做什么以及探索所有六种技术可用的参数，你可以检查注册表。查看以下 IBCF，我们可以看到默认情况下是使用余弦方法找到 30 个邻居，数据是中心化的，而缺失数据没有编码为零：

    > recommenderRegistry$get_entries(dataType =
    "realRatingMatrix")

    $ALS_realRatingMatrix
 Recommender method: ALS for realRatingMatrix
 Description: Recommender for explicit ratings based on latent 
      factors, calculated by alternating least squares algorithm.
 Reference: Yunhong Zhou, Dennis Wilkinson, Robert Schreiber, Rong 
      Pan (2008).
    Large-Scale Parallel Collaborative Filtering for the Netflix Prize, 
      4th Int'l   
    Conf. Algorithmic Aspects in Information and Management, LNCS 5034.
 Parameters:
 normalize lambda n_factors n_iterations min_item_nr seed
 1 NULL 0.1 10 10 1 NULL

 $ALS_implicit_realRatingMatrix
 Recommender method: ALS_implicit for realRatingMatrix
 Description: Recommender for implicit data based on latent factors, 
    calculated by alternating least squares algorithm.
 Reference: Yifan Hu, Yehuda Koren, Chris Volinsky (2008). 
      Collaborative
    Filtering for Implicit Feedback Datasets, ICDM '08 Proceedings of 
      the 2008 
    Eighth IEEE International Conference on Data Mining, pages 263-272.
 Parameters:
 lambda alpha n_factors n_iterations min_item_nr seed
 1 0.1 10 10 10 1 NULL

 $IBCF_realRatingMatrix
 Recommender method: IBCF for realRatingMatrix
 Description: Recommender based on item-based collaborative 
      filtering.
 Reference: NA
 Parameters:
 k method normalize normalize_sim_matrix alpha na_as_zero
 1 30 "Cosine" "center" FALSE 0.5 FALSE

 $POPULAR_realRatingMatrix
 Recommender method: POPULAR for realRatingMatrix
 Description: Recommender based on item popularity.
 Reference: NA
 Parameters:
 normalize aggregationRatings aggregationPopularity
 1 "center" new("standardGeneric" new("standardGeneric"

 $RANDOM_realRatingMatrix
 Recommender method: RANDOM for realRatingMatrix
 Description: Produce random recommendations (real ratings).
 Reference: NA
 Parameters: None

 $RERECOMMEND_realRatingMatrix
 Recommender method: RERECOMMEND for realRatingMatrix
 Description: Re-recommends highly rated items (real ratings).
 Reference: NA
 Parameters:
 randomize minRating
 1 1 NA

 $SVD_realRatingMatrix
 Recommender method: SVD for realRatingMatrix
 Description: Recommender based on SVD approximation with column-mean 
   imputation.
 Reference: NA
 Parameters:
 k maxiter normalize
 1 10 100 "center"

 $SVDF_realRatingMatrix
 Recommender method: SVDF for realRatingMatrix
 Description: Recommender based on Funk SVD with gradient descend.
 Reference: NA
 Parameters:
 k gamma lambda min_epochs max_epochs min_improvement normalize
 1 10 0.015 0.001 50 200 1e-06 "center"
 verbose
 1 FALSE

 $UBCF_realRatingMatrix
 Recommender method: UBCF for realRatingMatrix
 Description: Recommender based on user-based collaborative 
     filtering.
 Reference: NA
 Parameters:
 method nn sample normalize
 1 "cosine" 25 FALSE "center"

这是如何根据train数据组合算法的。为了简单起见，让我们使用默认的算法设置。你可以通过在函数中简单地包含一个包含你的更改的列表来调整参数设置：

    > ubcf <- Recommender(getData(e,"train"), "UBCF")

    > ibcf <- Recommender(getData(e,"train"), "IBCF")

    > svd <- Recommender(getData(e, "train"), "SVD")

    > popular <- Recommender(getData(e, "train"), "POPULAR")

    > pca <- Recommender(getData(e, "train"), "PCA")

    > random <- Recommender(getData(e, "train"), "RANDOM")

现在，使用predict()和getData()函数，我们将为每个算法获取test数据中 15 个项目的预测评分，如下所示：

    > user_pred <- predict(ubcf, getData(e, "known"), type = "ratings")

    > item_pred <- predict(ibcf, getData(e, "known"), type = "ratings")

    > svd_pred <- predict(svd, getData(e, "known"), type = "ratings")

    > pop_pred <- predict(popular, getData(e, "known"), type = 
       "ratings")

    > rand_pred <- predict(random, getData(e, "known"), type = 
       "ratings")

我们将使用calcPredictionAccuracy()函数检查预测与test数据未知部分之间的误差。输出将包括所有方法的RMSE、MSE和MAE。我们将单独检查UBCF。在为所有五种方法创建对象后，我们可以通过创建一个带有rbind()函数的对象并使用rownames()函数给行命名来构建一个表格：

    > P1 <- calcPredictionAccuracy(user_pred, getData(e,
    "unknown"))

    > P1
    RMSE  MSE  MAE 
    4.5 19.9  3.5

    > P2 <- calcPredictionAccuracy(item_pred, getData(e, "unknown"))

    > P3 <- calcPredictionAccuracy(svd_pred, getData(e, "unknown")) 
    > P4 <- calcPredictionAccuracy(pop_pred, getData(e, "unknown"))

    > P5 <- calcPredictionAccuracy(rand_pred, getData(e, "unknown"))

    > error <- rbind(P1, P2, P3, P4, P5)

    > rownames(error) <- c("UBCF", "IBCF", "SVD", "Popular", "Random")

    > error
            RMSE MSE  MAE
 UBCF     4.5  20  3.5
 IBCF     4.6  22  3.5
 SVD      4.6  21  3.7
 Popular  4.5  20  3.5
 Random   6.3  40  4.9

我们可以在输出中看到，基于用户和流行的算法略优于 IBCF 和 SVD，并且所有算法都优于随机预测。

使用evaluate()函数还有另一种比较方法。使用evaluate()进行比较允许一个人检查额外的性能指标以及性能图表。由于 UBCF 和 Popular 算法表现最好，我们将与 IBCF 一起查看。

这个过程中的第一个任务是创建一个我们想要比较的算法列表，如下所示：

    > algorithms <- list(POPULAR = list(name = "POPULAR"),
    UBCF =list(name = "UBCF"), IBCF = list(name = "IBCF"))

    > algorithms
    $POPULAR
    $POPULAR$name
    [1] "POPULAR"

    $UBCF
    $UBCF$name
    [1] "UBCF"

    $IBCF
    $IBCF$name
    [1] "IBCF"

对于这个例子，让我们比较前5、10和15个笑话推荐：

    > evlist <- evaluate(e, algorithms, n = c(5, 10, 15))
    POPULAR run 
    1  [0.07sec/4.7sec] 
    UBCF run 
    1  [0.04sec/8.9sec] 
    IBCF run 
     1  [0.45sec/0.32sec]3

注意，通过执行命令，你将收到关于算法运行时间的输出。现在我们可以使用avg()函数来检查性能：

 > set.seed(1)    

 > avg(evlist)
    $POPULAR
 TP    FP    FN    TN   precision  recall   TPR    FPR
 5  2.07  2.93  12.9  67.1       0.414   0.182 0.182 0.0398
 10 3.92  6.08  11.1  63.9       0.393   0.331 0.331 0.0828
 15 5.40  9.60   9.6  60.4       0.360   0.433 0.433 0.1314

 $UBCF
 TP    FP    FN    TN   precision   recall   TPR    FPR
 5   2.07  2.93  12.93  67.1      0.414    0.179 0.179 0.0398
 10  3.88  6.12  11.11  63.9      0.389    0.326 0.326 0.0835
 15  5.41  9.59   9.59  60.4      0.360    0.427 0.427 0.1312

 $IBCF
 TP    FP    FN    TN    precision   recall    TPR   FPR
 5   1.02  3.98  14.0  66.0        0.205   0.0674 0.0674 0.0558
 10  2.35  7.65  12.6  62.4        0.235   0.1606 0.1606 0.1069
 15  3.72 11.28  11.3  58.7        0.248   0.2617 0.2617 0.1575

注意，POPULAR和UBCF的性能指标几乎相同。可以说，更易于实现的基于流行的算法可能是模型选择的更好选择。我们可以绘制并比较结果作为接收者操作特征曲线（ROC），比较TPR和FPR或精度/召回率，如下所示：

    > plot(evlist, legend = "topleft", annotate = TRUE)

以下为前一个命令的输出结果：

要获取精度/召回率曲线图，你只需在plot函数中指定"prec"：

    > plot(evlist, "prec", legend = "bottomright", annotate = TRUE)

前一个命令的输出如下：

你可以从图中清楚地看到，基于流行和基于用户的算法几乎相同，并且优于基于项目的算法。annotate=TRUE参数在对应于我们评估中要求的推荐数量的点上提供了数字。

这很简单，但模型对特定个体的实际推荐是什么？这也很容易编写代码。首先，让我们在完整数据集上构建一个"popular"推荐引擎。然后，我们将找到前两个评分者的前五个推荐。我们将使用Recommend()函数并将其应用于整个数据集，如下所示：

    > R1 <- Recommender(Jester5k, method = "POPULAR")

    > R1
    Recommender of type 'POPULAR' for 'realRatingMatrix' 
    learned using 5000 users.

现在，我们只需要为前两个评分者获取前五个推荐并将它们作为列表生成：

    > recommend <- predict(R1, Jester5k[1:2], n = 5)

    > as(recommend, "list")
    $u2841
 [1] "j89" "j72" "j76" "j88" "j83"

 $u15547
 [1] "j89" "j93" "j76" "j88" "j91"

还可以通过在predict()语法中指定并放入一个矩阵进行审查来查看每个笑话的评分者的具体评分。让我们为十个人（评分者300至309）和三个笑话（71至73）做这个：

    > rating <- predict(R1, Jester5k[300:309], type = "ratings")

    > rating
    10 x 100 rating matrix of class 'realRatingMatrix' with 322
    ratings.

    > as(rating, "matrix")[, 71:73]
              j71  j72     j73
 u7628  -2.042 1.50 -0.2911
 u8714      NA   NA      NA
 u24213 -2.935   NA -1.1837
 u13301  2.391 5.93  4.1419
 u10959     NA   NA      NA
 u23430 -0.432 3.11      NA
 u11167 -1.718 1.82  0.0333
 u4705  -1.199 2.34  0.5519
 u24469 -1.583 1.96  0.1686
 u13534 -1.545 2.00      NA

矩阵中的数字表示个人评分的笑话的预测评分，而 NA 表示用户未评分的笑话。

我们在这组数据上的最终努力将展示如何为评分是二元的那些情况构建推荐，也就是说，好或坏或 1 或 0。我们需要将评分转换为这种二进制格式，5 或以上为 1，低于 5 为 0。使用Recommenderlab的binarize()函数并指定minRating=5来做这件事非常简单：

    > Jester.bin <- binarize(Jester5k, minRating = 5)

现在，我们需要让我们的数据反映等于一的评分数量，以便与算法用于训练的需求相匹配。为了方便起见，让我们选择大于 10。创建必要数据子集的代码如下所示：

    > Jester.bin <- Jester.bin[rowCounts(Jester.bin) > 10]

    > Jester.bin
    3054 x 100 rating matrix of class 'binaryRatingMatrix' with 84722 
      ratings.

你需要创建evaluationScheme。在这个例子中，我们将选择cross-validation。函数中的默认 k 折是10，但我们也可以安全地选择k=5，这将减少我们的计算时间：

    > set.seed(456)

    > e.bin <- evaluationScheme(Jester.bin, method = "cross-
      validation", k = 5, given = 10)

为了比较目的，评估的算法将包括random、popular和UBCF：

    > algorithms.bin <- list("random" = list(name = "RANDOM", param = 
      NULL), "popular" = list(name = "POPULAR", param = NULL), "UBCF" = 
        list(name = "UBCF"))

现在是时候构建我们的模型了，如下所示：

    > results.bin <- evaluate(e.bin, algorithms.bin, n = c(5, 10, 15))
    RANDOM run 
    1  [0sec/0.41sec] 
    2  [0.01sec/0.39sec] 
    3  [0sec/0.39sec] 
    4  [0sec/0.41sec] 
    5  [0sec/0.4sec] 
    POPULAR run 
    1  [0.01sec/3.79sec] 
    2  [0sec/3.81sec] 
    3  [0sec/3.82sec] 
    4  [0sec/3.92sec] 
    5  [0.02sec/3.78sec] 
    UBCF run 
    1  [0sec/5.94sec] 
    2  [0sec/5.92sec] 
    3  [0sec/6.05sec] 
    4  [0sec/5.86sec] 
     5  [0sec/6.09sec]

忽略性能指标表，让我们看看图表：

    > plot(results.bin, legend = "topleft")

前一个命令的输出如下：

    > plot(results.bin, "prec", legend = "bottomright")

上述命令的输出如下：

基于用户的算法略优于基于流行度的算法，但您可以清楚地看到，它们都优于任何随机推荐。在我们的业务案例中，这取决于决策团队的判断，决定实施哪种算法。

序列数据分析

有已知的已知。这是我们已知我们知道的事情。有已知的未知。也就是说，有我们知道我们不知道的事情。但也有未知的未知。有我们不知道我们不知道的事情。

唐纳德·拉姆斯菲尔德，前国防部长

第一版发布后，我遇到的第一个商业问题是关于产品序列分析。团队使用复杂的 Excel 电子表格和交叉表，以及一大堆 SAS 代码，来产生洞察。在遇到这个问题后，我探索了使用 R 能做什么，并很高兴地偶然发现了专门为此类任务设计的TraMineR包。我相信将 R 应用于这个问题将大大简化分析。

该包是为社会科学设计的，但它可以用于几乎任何您想要挖掘和学习观察状态在离散时间段或事件（纵向数据）中如何演变的情况。一个经典的使用案例就是上述提到的案例，您想了解客户购买产品的顺序。这将有助于创建某种推荐引擎，您可以创建下一次购买的几率，正如我听说它被称为下一个逻辑产品推荐。另一个例子可能是医疗保健领域，检查患者接受治疗和/或药物或甚至医生的处方习惯。我从事过这样的任务，创建简单和复杂的马尔可夫链来构建模型和创建预测。确实，TraMineR允许创建马尔可夫链转换矩阵来支持此类模型。

我们将要检查的代码负责创建、计数和绘制随时间变化的转换的各种组合，同时也包含了协变量。这将是我们的重点，但请记住，也可以构建一个用于聚类的相似度矩阵。实际练习中涵盖的核心特征将包括以下内容：

转换率
每个状态内的持续时间
序列频率

让我们开始吧。

序列分析应用

对于这个练习，我创建了一个人工数据集；为了跟随，您可以从中下载它：github.com/datameister66/data/blob/master/sequential.csv

github.com/datameister66/data/blob/master/sequential.csv

该包还提供了数据集和教程。我的意图是创建一些反映我所遇到的情况的新内容。我完全是从随机（在某种程度上有监督）中开发出来的，所以它不匹配任何真实世界的数据。它由 5,000 个观测值组成，每个观测值包含一个客户的购买历史和九个变量：

Cust_segment--一个表示客户分配细分市场的因子变量（见第八章，聚类分析）
有八个离散的购买事件，命名为Purchase1至Purchase8；记住，这些是事件而不是基于时间的，也就是说，一个客户可以在同一时间购买所有八个产品，但顺序是特定的

在每个购买变量中都有产品的通用名称，确切地说有七个可能的产品。它们被命名为Product_A至Product_G。这些产品是什么？没关系！发挥你的想象力或者将其应用于你自己的情况。如果客户只购买了一个产品，那么Purchase1将包含该产品的名称，其他变量将为 NULL。

在这里，我们将文件加载为数据框。为了清晰起见，输出结构被缩写：

 > df <- read.csv("sequential.csv") 
 > str(df)
 'data.frame': 5000 obs. of 9 variables:
 $ Cust_Segment: Factor w/ 4 levels "Segment1","Segment2",..: 1 1 1 
    1 1 1 1 1 1 1 ...
 $ Purchase1 : Factor w/ 7 levels "Product_A","Product_B",..: 1 2 7 
    3 1 4 1 4 4 4 ...

是时候探索数据了，从客户细分市场计数表和首次购买产品计数开始：

 > table(df$Cust_Segment)

 Segment1 Segment2 Segment3 Segment4 
 2900      572      554      974 

 > table(df$Purchase1)

 Product_A Product_B Product_C Product_D Product_E Product_F 
    Product_G 
 1451       765       659      1060       364       372       
    329

Segment1是最大的细分市场，最常购买的初始产品是Product A。然而，它是整体上最常购买的产品吗？这段代码将提供答案：

 > table(unlist(df[, -1]))

 Product_A Product_B Product_C Product_D Product_E Product_F 
    Product_G 
 3855      3193      3564      3122      1688      1273   915   
    22390

是的，ProductA是最常购买的产品。NULL 值的计数为 22,390。

现在你可能想知道我们是否可以轻松地构建一些总结，这当然是可以的。在这里，我充分利用了dplyr包中的count()和arrange()函数来检查第一次和第二次购买之间的序列频率：

 > dfCount <- count(df, Purchase1, Purchase2)

 > dfCount <- arrange(dfCount, desc(n))

 > dim(dfCount)
 [1] 56 3
 > head(dfCount)
 Source: local data frame [6 x 3]
 Groups: Purchase1 [4]

 Purchase1 Purchase2     n
 <fctr>    <fctr> <int>
 1 Product_A Product_A   548
 2 Product_D             548
 3 Product_B             346
 4 Product_C Product_C   345
 5 Product_B Product_B   291
 6 Product_D Product_D   281

我们可以看到，最频繁的序列是购买ProductA后再次购买ProductA，以及购买ProductD后没有其他购买。有趣的是类似产品购买的频率。

我们现在可以使用TraMineR包开始进一步的检查。首先，需要使用seqdef()函数将数据放入序列类对象中。这应该只包含序列，不包含任何协变量。此外，您可以使用xstep = n在绘图函数中指定刻度的距离。在我们的情况下，我们将为每个事件有一个刻度：

 > seq <- seqdef(df[, -1], xtstep = 1)

 > head(seq)
 Sequence 
 1 Product_A-Product_A------ 
 2 Product_B------- 
 3 Product_G-Product_B-Product_B-Product_C-Product_B-Product_B-
    Product_B- 
      Product_G
 4 Product_C------- 
 5 Product_A------- 
 6 Product_D-------

我们现在可以进一步探索数据。让我们看一下索引图，它产生了前 10 个观测值的序列。您可以使用索引与数据一起检查您想要的任何观测值和事件周期：

 > seqiplot(seq)

前一个命令的输出如下：

可以使用seqIplot()绘制所有观察结果，但鉴于数据量的大小，它不会产生任何有意义的结果。按状态分布的分布图更有意义：

 > seqdplot(seq)

前一个命令的输出如下：

通过这个图，很容易看到按州划分的产品购买分布。我们还可以按段分组此图，以确定是否存在差异：

 > seqdplot(seq, group = df$Cust_Segment)

前一个命令的输出如下：

在这里，我们可以清楚地看到Segment2的ProductA购买比例高于其他段。另一种看到这个见解的方法是使用模式图：

 > seqmsplot(seq, group = df$Cust_Segment)

前一个命令的输出如下：

这很有趣。大约 50%的Segment2首先购买了ProductA，而段 4 最频繁的初始购买是ProductD。另一个可能感兴趣的图，但我认为在这个案例中不是，是*均时间图。它绘制了每个状态的“*均时间”。由于我们不是基于时间的，这没有意义，但我包括供您考虑：

 > seqmtplot(seq, group = df$Cust_Segment)

让我们补充前面的代码，进一步观察序列的转换。此代码创建了一个序列对象，然后将其缩小到至少出现 5%的序列，然后绘制前 10 个序列：

 > seqE <- seqecreate(seq)

 > subSeq <- seqefsub(seqE, pMinSupport = 0.05)

 > plot(subSeq[1:10], col = "dodgerblue")

前一个命令的输出如下：

注意，该图显示了通过八个转换状态的序列百分比频率。如果您想将其缩小到，比如说，前两个转换，您可以在seqecreate()函数中使用索引来完成：

最后，让我们看看如何使用数据创建转换矩阵。这个矩阵显示了从一个状态转换到下一个状态的概率。在我们的案例中，它提供了购买下一个产品的概率。正如我之前提到的，这也可以用于马尔可夫链模拟来制定预测。但这超出了本章的范围，但如果您对此感兴趣，我建议您查看 R 中的markovchain包及其关于如何实现该过程的教程。有两个可能的转换矩阵可用。一个包含通过所有状态的整体概率，另一个从状态到下一个状态发展转换矩阵，即时间变化的矩阵。此代码显示了如何开发前者。要生成后者，只需在函数中指定"time.varying = TRUE"：

 > seqMat <- seqtrate(seq)
 [>] computing transition rates for states

     /Product_A/Product_B/Product_C/Product_D/
       Product_E/Product_F/Product_G ...

 > options(digits = 2) # make output easier to read

 > seqMat[2:4, 1:3]
 [-> ] [-> Product_A] [-> Product_B]
 [Product_A ->]  0.19          0.417          0.166
 [Product_B ->]  0.26          0.113          0.475
 [Product_C ->]  0.19          0.058          0.041

输出显示了第 2 行至第 4 行和第 1 列至第 3 列。矩阵显示，拥有产品 A 并且下一次购买也是ProductA的概率几乎是 42%，而不购买其他产品的概率是 19%，购买ProductB的概率是 17%。我们将要检查的最后一个输出是每个先前购买不购买其他产品的概率：

 > seqMat[, 1] [ ->] [Product_A ->] [Product_B ->] [Product_C ->] 
      [Product_D ->] 
 1.00           0.19           0.26           0.19           0.33 
 [Product_E ->] [Product_F ->] [Product_G ->] 
 0.18           0.25           0.41

当然，矩阵显示，在未购买产品后不购买产品的概率是 100%。请注意，在获得产品 D 后不购买的概率是 33%。对 Segment4 有何影响？或许有。

令人着迷的是，这项分析仅用了几行代码，并且不需要使用 Excel 或一些昂贵的可视化软件。你有纵向数据吗？尝试进行序列分析吧！

摘要

在本章中，目标是介绍如何使用 R 来构建和测试关联规则挖掘（篮子分析）和推荐引擎。篮子分析试图了解哪些商品是共同购买的。在推荐引擎中，目标是根据客户之前评价的查看或购买的商品，向客户提供他们可能会喜欢的其他商品。了解我们使用的 R 包（recommenderlab）对于推荐来说，它不是为实施而设计的，而是用于开发和测试算法。这里还考察了纵向数据，并从中学习有价值的见解，在我们的案例中，是客户购买我们产品的顺序。这种分析有众多应用，从市场营销活动到医疗保健。

我们现在将转换到监督学习。在下一章中，我们将介绍一些实际机器学习中最激动人心且重要的方法，即多类分类和创建集成模型，这在 R 语言中通过最*的包发布变得非常容易操作。

第十一章：创建集成和多元分类

“这就是你赢得机器学习竞赛的方法：你将其他人的工作集成在一起。”

维塔利·库兹涅佐夫，NIPS2014

你可能已经意识到我们已经讨论了集成学习方法。它在www.scholarpedia.org上被定义为“通过战略性地生成和组合多个模型，如分类器或专家，来解决特定计算智能问题的过程”。在随机森林和梯度提升中，我们结合了数百或数千棵树的“投票”来进行预测。因此，根据定义，这些模型是集成模型。这种方法可以扩展到任何学习器以创建集成，有些人称之为元集成或元学习器。我们将探讨其中一种被称为“堆叠”的方法。在这种方法中，我们将生成多个分类器，并使用它们的预测类别概率作为另一个分类器的输入特征。这种方法可以提高预测准确性。在前几章中，我们专注于关注二元结果的分类问题。现在，我们将探讨预测数据由两个以上结果组成的情况的方法，这在现实世界的数据集中是非常常见的。我必须承认，这些方法在 R 中的应用是我遇到的最有趣和最令人愉快的应用之一。

集成

本章开头引用的引言提到了使用集成来赢得机器学习竞赛。然而，它们确实有实际应用。我已经提供了集成建模的定义，但它为什么有效呢？为了证明这一点，我从以下博客中借用了一个例子，该博客深入探讨了多种集成方法：

mlwave.com/kaggle-ensembling-guide/

当我写这一章时，我们离超级碗 51 只有几天的时间了，亚特兰大猎鹰队对阵新英格兰爱国者队。假设我们想回顾一下我们赢得一场友好赌注的概率，我们希望选择爱国者队减去分数（截至本文写作时为 3 分）。假设我们已经跟踪了三位专家预测者，他们预测爱国者队能否覆盖赔率的概率相同（60%）。现在，如果我们偏爱任何一位所谓的专家，那么我们显然有 60%的胜率。然而，让我们看看创建他们预测的集成能如何提高我们盈利和羞辱朋友和家人的机会。

首先计算专家选择新英格兰的每种可能结果的概率。如果三位专家都选择新英格兰，那么我们就有 0.6 x 0.6 x 0.6，即 21.6%的概率，三位都是正确的。如果其中两位选择新英格兰，那么我们有(0.6 x 0.6 x 0.3) x 3，总共 43.2%。通过使用多数投票，如果至少有两位选择新英格兰，那么我们赢得比赛的概率几乎达到 65%。

这是一个相当简单的例子，但仍然具有代表性。在机器学习中，它可以通过结合几个*均或甚至弱学习者的预测来提高整体准确性。下面的图表显示了如何实现这一点：

在这个图表中，我们构建了三个不同的分类器，并使用它们的预测概率作为输入到第四个不同分类器，以便对测试数据进行预测。让我们看看如何用 R 来实现这一点。

商业和数据理解

我们将再次访问我们老对手皮马糖尿病数据。它已经证明对大多数分类器来说是一个相当大的挑战，大多数分类器的准确率在 70 年代中期。我们已经在第五章，更多分类技术 - K 最*邻和支持向量机和第六章，分类和回归树中查看过这些数据，因此我们可以跳过细节。有许多 R 包可以构建集成，自己编写代码也不是那么困难。在这个迭代中，我们将使用caret和caretEnsemble包来解决这个问题。让我们加载这些包并准备数据，包括使用 caret 中的createDataPartition()函数创建训练集和测试集：

 > library(MASS)

> library(caretEnsemble)

 > library(caTools)

 > pima <- rbind(Pima.tr, Pima.te)

 > set.seed(502)

 > split <- createDataPartition(y = pima$type, p = 0.75, list = F)

 > train <- pima[split, ]

 > test <- pima[-split, ]

模型评估和选择

正如我们在前面的章节中所做的那样，在利用 caret 函数时，第一个推荐的任务是构建一个对象，该对象指定了模型训练将如何进行。这是通过trainControl()函数完成的。我们将创建一个五折交叉验证并保存最终的预测（概率）。建议您也索引重采样，以便每个基础模型在相同的折上训练。注意，在函数中，我指定了上采样。为什么？好吧，注意“是”与“否”的比例是 2 比 1：

 > table(train$type)

 No Yes 
 267 133

这个比率不一定是不*衡的，但我想在这里展示一些东西。在许多数据集中，感兴趣的结果是一个罕见事件。因此，你可能会得到一个高度准确的分类器，但在预测感兴趣的结果方面做得非常糟糕，也就是说，它没有预测任何真正的阳性。为了*衡响应，你可以增加少数类的样本，减少多数类的样本，或者创建“合成数据”。在下一项练习中，我们将专注于合成数据，但在这里，让我们尝试增加样本。在增加样本时，对于每个交叉验证折，少数类会随机有放回地采样以匹配多数类的观察数。以下是我们的函数：

> control <- trainControl(method = "cv",
 number = 5,
 savePredictions = "final",
 classProbs = T,
 index=createResample(train$type, 5),
 sampling = "up",
 summaryFunction = twoClassSummary)

我们现在可以使用caretList()函数来训练我们的模型。你可以使用任何由 caret 包支持的模型。这里有一个模型列表，以及它们对应的超参数：

rdrr.io/cran/caret/man/models.html

在这个例子中，我们将训练三个模型：

分类树 - "rpart"
多变量自适应回归样条 - "earth"
K-最*邻 - "knn"

让我们把所有这些都放在一起：

 > set.seed(2) 
 > models <- caretList(
 type ~ ., data = train,
 trControl = control,
 metric = "ROC",
 methodList = c("rpart", "earth", "knn") )

不仅模型已经建立，而且每个模型的参数都根据 caret 的规则进行了调整。你可以通过结合caretModelSpec()函数为每个模型创建自己的调整网格，但为了演示目的，我们将让函数为我们做这件事。你可以通过调用模型对象来检查结果。这是简化的输出：

 > models
 ...
 Resampling results across tuning parameters:

 cp       ROC      Sens      Spec 
 0.03007519 0.7882347 0.8190343 0.6781714
 0.04010025 0.7814718 0.7935024 0.6888857
 0.36090226 0.7360166 0.8646440 0.6073893

有效集成的一个技巧是基础模型之间不高度相关。这是一个主观的陈述，没有关于相关预测的硬性规则。应该通过实验结果来决定是否替换模型。让我们看看我们的结果：

 > modelCor(resamples(models))
 rpart     earth       knn
 rpart 1.0000000 0.9589931 0.7191618
 earth 0.9589931 1.0000000 0.8834022
 knn   0.7191618 0.8834022 1.0000000

分类树和 earth 模型高度相关。这可能会成为一个问题，但让我们通过创建第四个分类器，即堆叠模型，并检查结果来继续前进。为此，我们将捕获测试集中“是”的预测概率到一个数据框中：

 > model_preds <- lapply(models, predict, newdata=test, type="prob") 
 > model_preds <- lapply(model_preds, function(x) x[,"Yes"]) 
 > model_preds <- data.frame(model_preds)

我们现在使用caretStack()将这些模型堆叠起来进行最终预测。这将基于五个自助样本的简单逻辑回归：

 > stack <- caretStack(models, method = "glm",
 metric = "ROC",
 trControl = trainControl(
 method = "boot",
 number = 5,
 savePredictions = "final",
 classProbs = TRUE,
 summaryFunction = twoClassSummary
 ))

你可以这样检查最终模型：

 > summary(stack)

 Call:
 NULL

 Deviance Residuals: 
 Min      1Q  Median     3Q    Max 
 -2.1029 -0.6268 -0.3584 0.5926 2.3714 

 Coefficients:
 Estimate  Std. Error  z value   Pr(>|z|) 
 (Intercept)  2.2212      0.2120   10.476   < 2e-16 ***
 rpart       -0.8529      0.3947   -2.161   0.03071 * 
 earth       -3.0984      0.4250   -7.290   3.1e-13 ***
 knn         -1.2626      0.3524   -3.583   0.00034 ***

尽管rpart和 earth 模型高度相关，但它们的系数都是显著的，我们可能可以保留这两个模型在分析中。现在我们可以用ensembled学习器比较单个模型的结果：

 > prob <- 1-predict(stack, newdata = test, type = "prob")

 > model_preds$ensemble <- prob

 > colAUC(model_preds, test$type)
 rpart     earth       knn  ensemble
 No vs. Yes 0.7413481 0.7892562 0.7652376 0.8001033

我们通过colAUC()函数看到的是单个模型的 AUC 和堆叠/集成的 AUC。集成在仅使用 earth 包中的 MARS 的情况下带来了一点点改进。所以在这个例子中，我们看到通过模型堆叠创建集成确实可以增加预测能力。你能根据这些数据构建一个更好的集成吗？你会尝试哪些其他采样或分类器？有了这些，让我们继续探讨多类问题。

多类分类

在多类问题中，有许多学习方法。例如，随机森林和判别分析等技术将处理多类问题，而一些技术和/或包则不会，例如，基础 R 中的广义线性模型glm()。截至本文写作时，不幸的是，caretEnsemble包将无法与多类一起使用。然而，机器学习在 R（mlr）包支持多类和集成方法。如果你熟悉 Python 的 sci-kit Learn，可以说mlr旨在为 R 提供相同的功能。mlr 和基于 caret 的包正在迅速成为我解决几乎所有商业问题的首选。我打算展示这个包在多类问题上的强大功能，然后通过展示如何在Pima数据上执行集成来结束。

对于多类问题，我们将探讨如何调整随机森林，然后检查如何使用“一对余”技术将 GLM 转换为多类学习器。这就是我们为每个类别与所有其他类别构建二元概率预测，然后将它们组合在一起来预测观察结果的最终类别的地方。这项技术允许你将任何分类器方法扩展到多类问题，并且它通常可以优于多类学习器。

一个简短的提醒：不要混淆多类和多标签术语。在前者中，一个观察结果只能被分配给一个且仅一个类别，而在后者中，它可以被分配给多个类别。一个例子是既可以被标记为政治又可以被标记为幽默的文本。在本章中，我们不会涵盖多标签问题。

商业和数据理解

我们将再次访问我们在第八章“聚类分析”中使用过的葡萄酒数据集。如果你还记得，它由 13 个数值特征和三种可能的葡萄酒类别响应组成。我们的任务是预测这些类别。我将包括一个有趣的转折，那就是人为地增加观察结果的数量。原因有两个。首先，我想充分展示mlr包的重采样能力，其次，我希望涵盖一种合成采样技术。在前一节中，我们已经使用了上采样，所以现在是合成采样的时候了。

我们的首要任务是加载包库并导入数据：

 > library(mlr) 
 > library(ggplot2) 
 > library(HDclassif) 
 > library(DMwR) 
 > library(reshape2)

    > library(corrplot) 
 > data(wine) 
 > table(wine$class)

 1  2  3 
 59 71 48

我们有 178 个观测值，加上响应标签是数值的（1，2 和 3）。让我们将我们的数据量增加一倍以上。本例中使用的算法是合成少数类过采样技术（SMOTE）。在前一个例子中，我们使用了上采样，其中少数类通过替换采样直到类别大小与多数类匹配。使用SMOTE，对少数类进行随机采样，并为每个观测值计算/识别 k 个最*邻，然后基于这些邻居随机生成数据。DMwR包中的SMOTE()函数默认最*邻是 5（k = 5）。你还需要考虑少数类过采样的百分比。例如，如果我们想将少数类的大小加倍，我们会在函数中指定"percent.over = 100"。每个案例添加到当前少数类的新样本数是百分比过采样/100，或者每个观测值一个新样本。对于百分比过采样还有一个参数，它控制随机选择用于新数据集的多数类数量。

这是该技术的应用，首先将类别结构化为因子，否则函数将无法工作：

 > wine$class <- as.factor(wine$class)

 > set.seed(11)

 > df <- SMOTE(class ~ ., wine, perc.over = 300, perc.under = 300)

 > table(df$class)

 1   2   3 
 195 237 192

哇！我们已经创建了一个包含 624 个观测值的数据库。我们的下一个任务将涉及按类别可视化特征数量。我非常喜欢箱线图，所以让我们按类别创建前四个输入的箱线图。它们的尺度不同，所以将它们放入一个具有*均值为 0 和标准差为 1 的数据框中将有助于比较：

 > wine.scale <- data.frame(scale(wine[, 2:5])) 
 > wine.scale$class <- wine$class 
 > wine.melt <- melt(wine.scale, id.var="class") 
 > ggplot(data = wine.melt, aes( x = class, y = value)) +
 geom_boxplot() +
 facet_wrap( ~ variable, ncol = 2)

前一个命令的输出如下：

回想一下第三章，逻辑回归和判别分析，箱线图上的点被认为是异常值。那么，我们应该怎么办？有许多事情要做：

什么也不做——什么都不做始终是一个选择
删除异常观测值
在当前特征内截断观测值或创建一个截断值的新特征
为每个特征创建一个指标变量，以捕捉观测值是否为异常值

我一直觉得异常值很有趣，通常会仔细观察它们以确定它们为什么会发生以及如何处理它们。我们没有那么多时间，所以让我提出一个简单的解决方案和截断异常值的代码。让我们创建一个函数来识别每个异常值，并将高值（> 99 百分位数）重新分配给 75 百分位数，将低值（< 1 百分位数）重新分配给 25 百分位数。你可以做中位数或其他，但我发现这种方法很有效。

你可以将这些代码片段放入同一个函数中，但我这样做是为了简化和理解。

这些是我们的异常值函数：

 > outHigh <- function(x) {
 x[x > quantile(x, 0.99)] <- quantile(x, 0.75)
 x
 }

 > outLow <- function(x) {
 x[x < quantile(x, 0.01)] <- quantile(x, 0.25)
 x
 }

现在，我们在原始数据上执行该函数并创建一个新的数据框：

    > wine.trunc <- data.frame(lapply(wine[, -1], outHigh))

 > wine.trunc <- data.frame(lapply(wine.trunc, outLow))

 > wine.trunc$class <- wine$class

对截断特征与原始特征进行简单比较是必要的。让我们用V3试试：

 > boxplot(wine.trunc$V3 ~ wine.trunc$class)

上述命令的输出如下：

所以这很顺利。现在是我们查看相关性的时候了：

 > c <- cor(wine.trunc[, -14])

 > corrplot.mixed(c, upper = "ellipse")

上述命令的输出如下：

我们看到 V6 和 V7 是最相关的特征，并且我们看到一个大于 0.5 的数字。一般来说，这不是基于非线性学习方法的常见问题，但我们将通过在我们的 GLM 中包含 L2 惩罚（岭回归）来考虑这一点。

模型评估和选择

我们将首先创建我们的训练集和测试集，然后创建一个随机森林分类器作为我们的基础模型。在评估其性能后，我们将继续尝试一对多分类方法并查看其表现。我们将数据分成 70/30。此外，mlr包的一个独特之处在于它要求将你的训练数据放入一个“任务”结构中，具体来说是一个分类任务。可选地，你也可以将测试集放入一个任务中。

模型列表的完整列表在此处可用，同时你也可以使用你自己的模型：

mlr-org.github.io/mlr-tutorial/release/html/integrated_learners/index.html

 > library(caret) #if not already loaded 
 > set.seed(502) 
 > split <- createDataPartition(y = df$class, p = 0.7, list = F) 
 > train <- df[split, ] 
 > test <- df[-split, ]

    > wine.task <- makeClassifTask(id = "wine", data = train, target = 
      "class")

随机森林

在创建我们的训练数据任务后，你可以探索许多函数。以下是其结构的简略输出：

 > str(getTaskData(wine.task))
 'data.frame': 438 obs. of 14 variables:
 $ class: Factor w/ 3 levels "1","2","3": 1 2 1 2 2 1 2 1 1 2 ...
 $ V1 : num 13.6 11.8 14.4 11.8 13.1 ...

在你的分析中使用mlr有许多方法，但我建议创建你的重采样对象。在这里，我们创建一个重采样对象来帮助我们调整随机森林的树的数量，包括三个子样本：

 > rdesc <- makeResampleDesc("Subsample", iters = 3)

下一个对象建立了用于调整的树网格，最小树的数量为 750，最大为 2000。你还可以建立多个参数，就像我们使用caret包所做的那样。你可以通过调用makeParamSet函数的帮助来探索你的选项：

 > param <- makeParamSet(
        makeDiscreteParam("ntree", values = c(750, 1000, 1250, 1500, 
         1750, 2000))
    )

接下来，创建一个控制对象，建立数值网格：

 > ctrl <- makeTuneControlGrid()

现在，继续调整超参数以获得最佳树的数量。然后，调用最佳树的数量和相关的样本外误差：

 > tuning <- tuneParams("classif.randomForest", task = wine.task,
 resampling = rdesc, par.set = param,
 control = ctrl)

    > tuning$x
    $ntree
    [1] 1250

    > tuning$y
    mmce.test.mean 
    0.01141553

最佳树的数量是 1,250，*均误分类误差为 0.01%，几乎完美分类。现在只需将此参数设置为训练时的makeLearner()函数的包装即可。注意，我将预测类型设置为概率，因为默认是预测类别：

 > rf <- setHyperPars(makeLearner("classif.randomForest",
 predict.type = "prob"), par.vals = tuning$x)

现在我们训练模型：

 > fitRF <- train(rf, wine.task)

你可以在训练数据上看到混淆矩阵：

 > fitRF$learner.model
              OOB estimate of error rate: 0%
    Confusion matrix:
       1   2  3  class.error
    1 72   0   0           0
    2  0  97   0           0
    3  0   0 101           0

然后，在测试集上评估其性能，包括错误和准确度（1 - 错误）。如果没有测试任务，你指定newdata = test，否则如果你创建了测试任务，只需使用test.task：

 > predRF <- predict(fitRF, newdata = test)

 > getConfMatrix(predRF)
 predicted
 true     1  2  3  -SUM-
 1     58  0  0      0
 2      0 71  0      0
 3      0  0 57      0
 -SUM-  0  0  0      0

 > performance(predRF, measures = list(mmce, acc))
 mmce acc 
 0   1

嗯，这真是太简单了，因为我们能够无误差地预测每个类别。

岭回归

为了演示目的，我们仍然尝试使用单对余方法进行岭回归。为此，为二元分类方法创建一个 MulticlassWrapper。classif.penalized.ridge 方法来自 penalized 包，所以请确保你已经安装了它：

 > ovr <- makeMulticlassWrapper("classif.penalized.ridge", 
      mcw.method = "onevsrest")

现在，让我们继续创建一个用于我们的分类器的包装器，该包装器创建一个包含 10 次迭代（默认值）的袋装重采样，采样 70% 的观测值和所有输入特征：

 > bag.ovr = makeBaggingWrapper(ovr, bw.iters = 10, #default of 10
 bw.replace = TRUE, #default
 bw.size = 0.7,
 bw.feats = 1)

现在我们可以用这个来训练我们的算法。注意在代码中我在 train() 前面加了 mlr::。原因是 caret 也有一个 train() 函数，所以我们指定我们想要 mlr 的 train() 函数，而不是 caret 的。有时，如果两个包都加载了但没有这样做，你最终会得到一个严重的错误：

 > set.seed(317)
 > fitOVR <- mlr::train(bag.ovr, wine.task)
    > predOVR <- predict(fitOVR, newdata = test)

让我们看看效果如何：

 > head(data.frame(predOVR))
 truth response
 60     2        2
 78     2        2
 79     2        2
 49     1        1
 19     1        1
 69     2        2

 > getConfMatrix(predOVR)
 predicted
 true     1  2  3  -SUM-
 1     58  0  0      0
 2      0 71  0      0
 3      0  0 57      0
 -SUM-  0  0  0      0

再次强调，这太容易了。然而，不要过分关注准确性，而应该关注创建你的分类器的方法、调整任何参数以及实施重采样策略的方法。

MLR 的集成

这里有一些我们觉得不太容易的事情：Pima 糖尿病分类。和 caret 一样，你可以构建集成模型，所以让我们试一试。我还会展示如何将 SMOTE 集成到学习过程中，而不是创建一个单独的数据集。

首先，确保你从本章的开头运行代码来创建训练和测试集。我会在这里暂停，让你去处理。

太好了，现在让我们像以前一样创建训练任务：

 > pima.task <- makeClassifTask(id = "pima", data = train, target = 
      "type")

这里的 smote() 函数与我们之前做的不太一样。你只需要指定少数类过采样率和 k-最*邻。我们将基于三个最*邻将少数类（是）的数量加倍：

 > pima.smote <- smote(pima.task, rate = 2, nn = 3)

    > str(getTaskData(pima.smote))
    'data.frame': 533 obs. of 8 variables:

现在，我们有 533 个观测值，而不是训练中的原始 400 个。为了完成我们的集成堆叠，我们将创建三个基础模型（随机森林、二次判别分析和 L1 惩罚 GLM）。这段代码将它们组合成基础模型，即学习者，并确保我们创建了用于输入特征的概率：

 > base <- c("classif.randomForest", "classif.qda", classif.glmnet") 
 > learns <- lapply(base, makeLearner) 
 > learns <- lapply(learns, setPredictType, "prob")

堆叠模型将简单地是一个 GLM，系数通过交叉验证调整。包的默认值是五折：

 > sl <- makeStackedLearner(base.learners = learns,
 super.learner = "classif.logreg",
 predict.type = "prob",
 method = "stack.cv")

我们现在可以训练基础和堆叠模型。你可以选择根据需要合并重采样和调整包装器，就像我们在前面的章节中所做的那样。在这种情况下，我们将坚持默认设置。在测试集上的训练和预测也是同样的方式：

 > slFit <- mlr::train(sl, pima.smote)

 > predFit <- predict(slFit, newdata = test)

 > getConfMatrix(predFit)
 predicted
 true        No Yes -SUM-
 No        70  18    18
 Yes       15  29    15
 -SUM-     15  18    33

 > performance(predFit, measures = list(mmce, acc, auc))
 mmce    acc         auc
 0.25   0.75   0.7874483

经过所有这些努力，我们只达到了 75% 的准确率，以及略低于使用 caretEnsemble 构建的集成模型的 AUC，尽管我们使用了不同的基础学习器。所以，就像以前一样，你能提高这些结果吗？请告诉我你的结果。

摘要

在本章中，我们探讨了通过堆叠和随后进行多类分类创建集成模型的重要机器学习方法。在堆叠中，我们使用了基础模型（学习器）来创建预测概率，这些概率被用于输入特征到另一个模型（超级学习器）以做出我们的最终预测。实际上，堆叠方法在个别基础模型之上显示出了轻微的改进。至于多类方法，我们研究了使用多类分类器，以及将二元分类方法应用于多类问题，使用一对一技术。作为一个辅助任务，我们还结合了两种采样技术（上采样和合成少数类过采样技术）来*衡类别。同样重要的是，我们利用了两个非常强大的 R 包，caretEnsemble和mlr。这些方法和包是 R 机器学习实践者的强大补充。

接下来，我们将深入探讨时间序列和因果关系的领域。在我看来，时间序列分析是机器学习中最被误解和忽视的领域之一。下一章应该能帮助你开始帮助我们的行业缩小这一差距。

第十二章：时间序列与因果关系

“一个经济学家是一个专家，他将知道明天为什么他昨天预测的事情今天没有发生。”

拉乌尔·J·彼得

单变量时间序列是测量在标准时间度量上收集的，这可能是以分钟、小时、天、周或月为单位。使时间序列相对于其他数据成为问题的是观测的顺序可能很重要。这种顺序的依赖性可能导致标准分析方法的偏差或方差过高。

似乎关于机器学习和时间序列数据的文献很少。这是不幸的，因为现实世界中的大量数据都涉及时间成分。此外，时间序列分析可能相当复杂且棘手。我可以说，如果你没有看到时间序列分析被错误地执行，那么你可能没有足够仔细地观察。

另一个常被忽视的与时间序列相关的问题是因果关系。是的，我们不希望混淆相关性与因果关系，但在时间序列分析中，可以通过应用格兰杰因果关系的技巧来确定是否存在因果关系（从统计学的角度来说）。

在本章中，我们将应用时间序列/计量经济学技术来识别单变量预测模型、向量自回归模型，最后是格兰杰因果关系。完成本章后，你可能不会成为时间序列分析的完全大师，但你将知道足够多的知识来进行有效的分析，并了解在构建时间序列模型和创建预测模型（预测）时需要考虑的基本问题。

单变量时间序列分析

我们将关注两种分析和预测单一时间序列的方法：指数*滑和自回归积分移动*均（ARIMA）模型。我们将首先查看指数*滑模型。

与移动*均模型一样，指数*滑模型使用过去观测的权重。但与移动*均模型不同，越*期的观测得到的权重相对于较晚的观测越大。有三个可能的*滑参数可以估计：整体*滑参数、趋势参数和季节性*滑参数。如果没有趋势或季节性，那么这些参数将变为零。

*滑参数产生以下方程的预测：

Yt+1 = α(Yt) + (1 – α)Yt-1 + (1-α)2Yt-2 +…，其中 0 < α ≤ 1

在这个方程中，Y[t] 是时间 T 的值，而 alpha (α) 是*滑参数。算法通过最小化误差来优化 alpha（以及其他参数），例如，*方误差和（SSE）或均方误差（MSE）。

预测方程以及趋势和季节性方程（如果适用），将如下所示：

预测，其中 A 是前一个*滑方程，h 是预测期数，Y[t+h] = A + hB[t] + S[t]
趋势方程，B[t] = β(A[t] – A[t-1]) + (1 – β)B[t-1]
季节性，其中 m 是季节性周期的数量， S[t] = Ω(Y[t] – A[t-1] – B[t-1]) + (1 - Ω)S[t-m]

这个方程被称为 Holt-Winters 方法。预测方程本质上是加性的，趋势是线性的。该方法还允许包含一个衰减趋势和乘性季节性，其中季节性随时间成比例增加或减少。根据我的经验，Holt-Winters 方法提供了最佳的预测，甚至比 ARIMA 模型更好。我得出这个结论是因为我不得不基于月度数据更新数百个时间序列的长期预测，并且在大约 90% 的情况下，Holt-Winters 产生了最小的预测误差。此外，你不必担心像 ARIMA 模型中的*稳性假设。*稳性是指时间序列在所有时间段内具有恒定的均值、方差和相关性。话虽如此，了解 ARIMA 模型仍然很重要，因为会有一些情况下它们的性能最佳。

从自回归模型开始，时间 T 的 Y 值是 Y 的先前值的线性函数。自回归滞后-1 模型 AR(1) 的公式是 Yt = constant + ΦYt-1 + Et。该模型的关键假设如下：

Et 表示具有零均值和恒定方差的同分布且相互独立的误差
误差与 Yt 无关
Yt, Yt-1, Yt-n... 是*稳的，这意味着 Φ 的绝对值小于一

对于*稳时间序列，你可以检查 自相关函数 (ACF)。*稳序列的 ACF 给出了 Yt 和 Yt-h 之间的相关性，其中 h = 1, 2...n。让我们使用 R 来创建一个 AR(1) 序列并绘制它。在这个过程中，我们还将查看 ggfortify 包的功能，它作为 ggplot2 函数的包装器：

 > library(ggfortify) 

 > set.seed(123)

    > ar1 <- arima.sim(list(order = c(1, 0, 0), ar = 0.5), n = 200)

    > autoplot(ar1, main = "AR1")

下面的输出是前一个命令的结果：

现在，让我们来检查 ACF：

    > autoplot(acf(ar1, plot = F), main = "AR1 - ACF")

前一个命令的输出如下：

ACF 图像显示了随着滞后的增加，相关性指数级下降。虚线蓝色线表示显著相关性的置信区间。任何延伸到高置信区间以上或低置信区间以下的线都被认为是显著的。除了 ACF 之外，还应该检查 偏自相关函数 (PACF)。PACF 是条件相关性，这意味着 Yt 和 Yt-h 之间的相关性是在两个观察值之间的观察值条件下确定的。理解这一点的直觉方法之一是考虑一个线性回归模型及其系数。假设你有 Y = B0 + B1X1 与 Y = B0 + B1X1 + B2X2。在第一个模型中，X 与 Y 的关系是线性的，有一个系数，但在第二个模型中，系数将不同，因为现在还要考虑 Y 与 X2 之间的关系。注意，在以下的 PACF 图像中，滞后 1 处的偏自相关值与滞后 1 处的自相关值相同，因为这不是条件相关性：

    > autoplot(pacf(ar1, plot = F), main = "AR1 - PACF")

以下是在先前的命令输出：

我们可以安全地假设，从先前的时序图像来看，序列是*稳的。在实践练习中，我们将查看一些统计测试以确保数据是*稳的，但大多数情况下，目测就足够了。如果数据不是*稳的，那么可以通过取其差分来去趋势。这是 ARIMA 中的积分 (I)。差分后，新的序列变为 ΔYt = Yt - Yt-1。应该期望一阶差分来实现*稳性，但在某些情况下，可能需要二阶差分。具有 AR(1) 和 I(1) 的 ARIMA 模型将被标注为 (1,1,0)。

MA 代表移动*均。这并不是像股票价格 50 日移动*均那样的简单移动*均，而是一个应用于误差的系数。误差当然是同质独立分布的，均值为零，方差恒定。MA(1) 模型的公式是 Yt = 常数 + Et + ΘEt-1。正如我们在 AR(1) 模型中所做的那样，我们可以在 R 中构建一个 MA(1)，如下所示：

    > set.seed(123)

    > ma1 <- arima.sim(list(order = c(0, 0, 1), ma = -0.5), n = 200)

    > autoplot(ma1, main = "MA1")

以下是在先前的命令输出：

ACF 和 PACF 图像与 AR(1) 模型略有不同。注意，在查看图像以确定模型是否具有 AR 和/或 MA 项时，有一些经验法则。它们可能有点主观；所以我会把这些启发式方法留给你去学习，但请相信 R 可以识别正确的模型。在以下图像中，我们将看到滞后 1 处存在显著的相关性，以及滞后 1 和滞后 2 处存在两个显著的偏相关性：

    > autoplot(acf(ma1, plot = F), main = "MA1 - ACF")

以下是在先前的命令输出：

上述图像是 ACF 图像，现在，我们将看到 PACF 图像：

    > autoplot(pacf(ma1, plot = F), main = "MA1 - PACF")

使用 ARIMA 模型，可以纳入季节性，包括自回归、积分和移动*均项。非季节性 ARIMA 模型的表示通常为 (p,d,q)。对于季节性 ARIMA，假设数据是按月度，那么表示将是 (p,d,q) x (P,D,Q)12，其中表示中的 '12' 考虑了月度季节性。在我们将使用的包中，R 将自动识别是否应该包含季节性；如果是，将包括最优项。

理解格兰杰因果性

假设你被问到一个问题，例如，“新处方数量和药物 X 的总处方数量之间有什么关系？”。你知道这些是按月度测量的，所以你该如何理解这种关系，鉴于人们认为新处方将推高总处方数量。或者，测试商品价格（特别是铜价）是否是美国股市价格领先指标的这个假设如何？好吧，使用两套时间序列数据，x 和 y，格兰杰因果性是一种试图确定一个序列是否可能影响另一个序列变化的方法。这是通过取一个序列的不同滞后并使用它来建模第二个序列的变化来完成的。为了实现这一点，我们将创建两个模型来预测 y，一个只包含 y 的过去值 (Ω)，另一个包含 y 和 x 的过去值 (π)。模型如下，其中 k 是时间序列中的滞后数：

然后将 RSS 进行比较，并使用 F-test 来确定嵌套模型 (Ω) 是否足够充分地解释 y 的未来值，或者是否完整模型 (π) 更好。F-test 用于检验以下零假设和备择假设：

H0: 对于每个 i ∊[1,k]，αi = 0，不存在格兰杰因果性
H1: 至少存在一个 i ∊[1,k] 使得 αi ≠ 0，格兰杰因果性

实质上，我们试图确定我们是否可以说，从统计上讲，x比y的过去值提供更多关于y未来值的信息。在这个定义中，很明显，我们并不是试图证明实际的因果关系；只是说这两个值通过某种现象相关联。沿着这个思路，我们还必须以相反的方向运行这个模型，以验证y不会提供关于x未来值的信息。如果我们发现这种情况成立，那么很可能存在一些外生变量，比如Z，需要控制，或者可能是格兰杰因果关系的更好候选者。为了避免虚假结果，该方法应应用于*稳时间序列。请注意，有一些研究论文讨论了非线性模型使用的技巧，但这超出了本书的范围；然而，我们将从非*稳的角度来考察它。有一篇出色的介绍性论文围绕着古老的“先有鸡还是先有蛋”的难题（Thurman，1988）。

有几种不同的方法可以识别适当的滞后结构。自然地，一个人可以使用蛮力和无知来测试所有合理的滞后，一次一个。一个人可能基于领域专业知识或可能存在的先前研究而有一个合理的直觉来指导滞后选择。如果没有，那么向量自回归（VAR）可以用来识别具有最低信息准则的滞后结构，例如赤池信息准则（AIC）或最终预测误差（FPE）。为了简单起见，这里给出两个变量的 VAR 模型的符号，并且每个变量只包含一个滞后。这个符号可以扩展到适当数量的变量和滞后。

Y = constant[1] + B[11]Y[t-1] + B[12]Y[t-1] + e[1]
X = constant[1] + B2[1]Y[t-1] + B2[2]Y[t-1] + e2

在 R 中，这个过程实施起来相当简单，我们将在下面的实际问题中看到。

商业理解

地球不会走开。是我们自己要走。

哲学家和喜剧演员，乔治·卡尔林

气候变化正在发生。它始终如此，并将继续如此，但至少从政治和经济角度来看，最大的问题是气候变化是否是人为造成的？我将利用本章内容对计量经济学时间序列模型进行测试，以尝试了解碳排放是否在统计上导致气候变化，特别是气温上升。就我个人而言，我愿意对这个问题保持中立立场，始终牢记卡尔林先生在其关于该主题的教诲中留给我们的原则。

第一件事是找到并收集数据。对于温度，我选择了HadCRUT4年际*均温度时间序列，这可能是金标准。这些数据是由东安格利亚大学的气候研究单位和英国气象办公室的哈德尔中心合作编制的。关于数据编制和建模的完整讨论可在www.metoffice.gov.uk/hadobs/index.html找到。

我们将使用的数据是以年异常值的形式提供的，它是通过给定时间段的*均年地表温度的中位数与参考年（1961-1990 年）的*均值之差来计算的。年地表温度是全球收集的温度数据集，由CRUTEM4地表空气温度和HadSST3海表数据集混合而成。这些数据因存在偏差和不准确而被质疑：www.telegraph.co.uk/comment/11561629/Top-scientists-start-to-examine-fiddled-global-warming-figures.html。这超出了我们努力的范围，因此我们必须接受并利用这些数据，就像它们现在这样。我从 1919 年 3 月到 2013 年之间提取了数据，以匹配我们的二氧化碳数据。

全球二氧化碳排放估计可以在美国能源部二氧化碳信息分析中心（CDIAC）的以下网站找到：cdiac.ornl.gov/

我已经将数据放在了一个.csv文件（climate.csv）中，供您下载并存储在您的当前工作目录：github.com/datameister66/data/

让我们加载它并检查其结构：

    > climate <- read.csv("climate.csv", stringsAsFactors = F)

    > str(climate)
     'data.frame': 95 obs. of 3 variables:
     $ Year: int 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 ...
     $ CO2 : int 806 932 803 845 970 963 975 983 1062 1065 ...
     $ Temp: num -0.272 -0.241 -0.187 -0.301 -0.272 -0.292 -0.214 
       -0.105 -0.208  -0.206 ...

最后，我们将将其放入时间序列结构中，指定起始和结束年份：

    > climate <- ts(climate[, 2:3], frequency = 12,
       start = 1919, end = 2013)  

    > head(climate)
         CO2   Temp
    [1,] 806 -0.272
    [2,] 932 -0.241
    [3,] 803 -0.187
    [4,] 845 -0.301
    [5,] 970 -0.272
    [6,] 963 -0.292

在数据加载并放入时间序列结构后，我们现在可以开始理解和进一步准备它以进行分析。

数据理解和准备

需要两个包来完成这项工作，所以请确保它们已安装在你的系统上：

    > library(forecast)

    > library(tseries)

让我们从两个时间序列的图中开始：

    > autoplot(climate)

前一个命令的输出如下：

看起来，二氧化碳水*确实是在二战后开始增加的，并且在 20 世纪 70 年代中期温度异常值急剧上升。似乎没有明显的异常值，并且随时间的变化似乎是恒定的。使用标准程序，我们可以看到两个序列高度相关，如下所示：

    > cor(climate)
               CO2      Temp
    CO2  1.0000000 0.8404215
    Temp 0.8404215 1.0000000

如前所述，这没有什么值得高兴的，因为它绝对证明不了任何东西。我们将通过绘制两个序列的ACF和PACF来寻找结构：

    > autoplot(acf(climate[, 2], plot = F), main="Temp ACF")

前一段代码片段的输出如下：

此代码为我们提供了温度的PACF图：

 > autoplot(pacf(climate[, 2], plot = F), main = "Temp PACF")

前一段代码片段的输出如下：

以下代码为我们提供了CO2的ACF图：

 > autoplot(acf(climate[, 1], plot = F), main = "CO2 ACF")

上述代码片段的输出如下：

以下代码为我们提供了CO2的PACF图：

 > autoplot(pacf(climate[, 1], plot = F), main = "CO2 PACF")

上述代码片段的输出如下：

由于 ACF 模式缓慢衰减和 PACF 模式迅速衰减，我们可以假设这些序列都是自回归的，尽管温度似乎有一些显著的 MA 项。接下来，让我们看看交叉相关函数（CCF）。请注意，我们在函数中将我们的x放在y之前：

    > ccf(climate[, 1], climate[, 2], main = "CCF")

CCF显示了温度和二氧化碳滞后之间的相关性。如果x变量的负滞后具有高相关性，我们可以说x领先y。如果x的正滞后具有高相关性，我们说x滞后y。在这里，我们可以看到 CO2 既是领先变量也是滞后变量。对于我们的分析，看到前者是令人鼓舞的，但看到后者是奇怪的。我们将在 VAR 和格兰杰因果分析中看到这是否会成为问题。

此外，我们还需要测试数据是否是*稳的。我们可以使用tseries包中可用的增强迪基-富勒（ADF）测试来证明这一点，使用adf.test()函数，如下所示：

    > adf.test(climate[, 1])

           Augmented Dickey-Fuller Test

    data: climate[, 1]
    Dickey-Fuller = -1.1519, Lag order = 4, p-value =
    0.9101
    alternative hypothesis: stationary

    > adf.test(climate[, 2])

           Augmented Dickey-Fuller Test

    data: climate[, 2]
    Dickey-Fuller = -1.8106, Lag order = 4, p-value =
    0.6546
    alternative hypothesis: stationary

对于这两个序列，我们都有不显著的p 值，因此我们不能拒绝零假设，并得出它们不是*稳的结论。

在探索了数据之后，让我们开始建模过程，从将单变量技术应用于温度异常开始。

建模和评估

在建模和评估步骤中，我们将关注三个任务。第一个任务是仅针对地表温度产生一个单变量预测模型。第二个任务是开发一个基于地表温度和二氧化碳水*的回归模型，利用该输出结果来告知我们关于二氧化碳水*是否是地表温度异常的格兰杰原因的研究工作。

单变量时间序列预测

在这个任务中，目标是产生一个针对地表温度的单变量预测，重点是选择霍尔特线性趋势模型或 ARIMA 模型。我们将训练模型，并在一个时间外的测试集上确定它们的预测准确性，就像我们在其他学习尝试中所做的那样。以下代码创建了温度子集，然后是训练集和测试集，从二战后开始：

    > temp <- climate[, 2]

    > temp <- climate[, 2]

    > train <- window(temp, start = 1946, end = 2003)

    > test <- window(temp, start = 2004)

要构建我们的*滑模型，我们将使用forecast包中的holt()函数。我们将构建两个模型，一个带有，一个不带阻尼趋势。在这个函数中，我们需要指定时间序列，预测期数作为h = ...，选择初始状态值的方法，即"optimal"或"simple"，以及我们是否想要阻尼趋势。指定"optimal"，算法将找到最优的初始起始值以及*滑参数，而"simple"使用前几个观测值来计算起始值。现在，在forecast包中，你可以使用ets()函数，它将找到所有最优参数。然而，在我们的情况下，让我们继续使用holt()，这样我们可以比较方法。让我们尝试不带阻尼趋势的holt模型，如下所示：

 > fit.holt <- holt(train, h = 10, initial = "optimal")

使用以下代码绘制forecast并查看其在样本外表现如何：

    > plot(forecast(fit.holt))

    > lines(test, type = "o")

前面代码的输出如下：

观察图表，似乎这个预测显示了一个轻微的线性上升趋势。让我们尝试加入damped趋势，如下所示：

    > fit.holtd <- holt(train, h = 10, initial = "optimal", damped = 
      TRUE)

    > plot(forecast(fit.holtd),main = "Holt Damped")

 > lines(test, type = "o")

前面代码的输出如下：

最后，在单变量分析中，我们使用auto.arima()构建了一个ARIMA模型，它也来自forecast包。你可以在函数中指定许多选项，或者你只需包括你的时间序列数据，它将找到最佳的ARIMA拟合：

    > fit.arima <- auto.arima(train)
    > summary(fit.arima)
    Series: train 
    ARIMA(0,1,1) with drift 

    Coefficients:
            ma1  drift
        -0.6949 0.0094
    s.e. 0.1041 0.0047

简化的输出显示，选定的模型是一个 MA = 1，I = 1，或者ARIMA(0,1,1)带有漂移（相当于截距项）。我们可以以前面的方式检查其在test数据上的性能图：

 > plot(forecast(fit.arima, h = 10))

 > lines(test, type="o")

前面代码的输出如下：

这与不带阻尼趋势的holt方法非常相似。我们可以对每个模型进行评分，以找到提供最低误差、*均绝对百分比误差（MAPE）的模型，以下代码所示：

 > mapeHOLT <- sum(abs((test - fit.holt$mean)/test))/10
 > mapeHOLT
 [1] 0.105813
 > mapeHOLTD <- sum(abs((test - fit.holtd$mean)/test))/10
 > mapeHOLTD
 [1] 0.2220256
 > mapeARIMA <- sum(abs((test - forecast(fit.arima, h = 
      10)$mean)/test))/10
 > mapeARIMA
 [1] 0.1034813

与holt方法相比，ARIMA 0,1,1 的预测误差略低，并且很明显，阻尼趋势模型表现最差。

通过统计和视觉证据，似乎对于单变量预测模型的最佳选择是 ARIMA 模型。有趣的是，在第一版使用年度数据时，带有阻尼趋势的 Holt 方法具有最佳的准确性。

通过这样，我们已经完成了构建表面温度异常的单变量预测模型，现在我们将继续进行下一个任务，看看 CO2 水*是否导致这些异常。

检查因果关系

对于本章内容，我认为这是理论与实践相结合的关键点，我们将从纯粹的关联中区分出因果关系，好吧，至少从统计学的角度来说是这样。这不是第一次将这种技术应用于这个问题。Triacca（2005）没有找到任何证据表明大气中的二氧化碳是导致地表温度异常的格兰杰原因。另一方面，Kodra（2010）得出结论，存在因果关系，但指出他们的数据即使在二阶差分后也不是*稳的。虽然这项工作不能解决争议，但希望它能激发你在个人努力中应用这种方法。当前的主题确实提供了一个有效的训练场，以展示格兰杰因果关系。

我们的计划是首先展示虚假的线性回归，其中残差受到自相关性的影响，也称为序列相关性。然后，我们将检查两种不同的格兰杰因果关系的处理方法。第一种将是传统方法，其中两个序列都是*稳的。然后，我们将查看 Toda 和 Yamamoto（1995）展示的方法，该方法将该方法应用于原始数据，有时也称为“水*”。

线性回归

让我们开始虚假回归，我在现实世界中看到这种回归被实施得太频繁了。在这里，我们只是构建一个线性模型并检查结果：

 > fit.lm <- lm(Temp ~ CO2, data = climate)

    > summary(fit.lm)

    Call:
    lm(formula = Temp ~ CO2, data = climate)

    Residuals:
         Min       1Q  Median      3Q     Max 
    -0.36411 -0.08986 0.00011 0.09475 0.28763 

    Coefficients:
                  Estimate  Std. Error  t value     Pr(>|t|) 
    (Intercept) -2.430e-01   2.357e-02   -10.31   <2e-16 ***
    CO2          7.548e-05   5.047e-06    14.96   <2e-16 ***
    ---
    Signif. codes: 
    0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

    Residual standard error: 0.1299 on 93 degrees of freedom
    Multiple R-squared: 0.7063, Adjusted R-squared: 0.7032 
    F-statistic: 223.7 on 1 and 93 DF, p-value: < 2.2e-16

注意到一切都是显著的，我们的调整 R *方为 0.7。好吧，它们高度相关，但正如 Granger 和 Newbold（1974）所讨论的，这都没有意义。再次强调，我曾在许多拥有高级学位的人的会议上看到过类似的结果，我不得不扮演“坏人”的角色，挑战这些结果。

我们可以绘制序列相关性图，从残差的时间序列图开始，这将产生一个清晰的模式：

 > plot.ts(fit.lm$residuals)

上述代码的输出如下：

然后，我们创建一个 ACF 图，显示到滞后 10 的显著自相关：

 > acf(fit.lm$residuals)

你可以通过执行Durbin-Watson 测试来测试自相关性。测试中的零假设是没有自相关性存在：

 > dwtest(fit.lm)

 Durbin-Watson test

 data: fit.lm
 DW = 0.77425, p-value = 4.468e-12
    alternative hypothesis: true autocorrelation is greater than 0

从观察图表来看，我们安全地拒绝无自相关性的零假设并不令人惊讶。处理自相关性的简单方法是将依赖时间序列的滞后变量纳入考虑，或者使所有数据*稳。我们将在下一步使用向量自回归来识别在因果关系努力中应包含的适当滞后结构。

向量自回归

在前一节中，我们已经看到温度是*稳的，而 CO2 需要一阶差分。另一种简单的方法是使用forecast包的ndiffs()函数。它提供了一个输出，说明了使数据*稳所需的最小差分数。在函数中，你可以指定你想使用三个可用测试中的哪一个：Kwiatkowski, Philips, Schmidt & Shin（KPSS），Augmented Dickey Fuller（ADF），或Philips-Peron（PP）。我将使用 ADF，其零假设是数据不是*稳的：

 > ndiffs(climate[, 1], test = "adf")
 [1] 1

 > ndiffs(climate[, 2], test = "adf")
 [1] 1

我们可以看到，两者都需要一阶差分才能达到*稳。为了开始，我们将创建差分。然后，我们将完成传统方法，其中两个序列都是*稳的。让我们也加载用于此练习的包：

 > library(vars)

 > library(aod)

 > climateDiff <- diff(climate)

    > climateDiff <- window(climateDiff, start = 1946)

    > head(climateDiff)
         CO2     Temp
    [1,]  78   -0.099
    [2,] 154    0.034
    [3,]  77    0.001
    [4,] -50   -0.035
    [5,] 211   -0.100
    [6,] 137    0.121

现在的问题是根据信息准则确定最优滞后结构，这可以通过向量自回归来完成。这是使用vars包中的VARselect函数完成的。你只需要在函数中使用lag.max = x指定模型中的数据和滞后数。让我们使用最多 12 个滞后：

    > lag.select <- VARselect(climateDiff, lag.max = 12)

    > lag.select$selection
    AIC(n) HQ(n) SC(n) FPE(n) 
         5     1     1      5

我们使用lag$selection调用了信息准则。提供了四种不同的标准，包括AIC，Hannan-Quinn 准则（HQ），Schwarz-Bayes 准则（SC），和FPE。请注意，AIC 和 SC 在第二章中有所介绍，线性回归 - 机器学习的技巧和策略，所以这里不会介绍准则公式或差异。如果你想看到每个滞后实际的输出结果，可以使用lag$criteria。我们可以看到，AIC和FPE选择了滞后 5，而 HQ 和 SC 选择了滞后 1 作为 VAR 模型的最优结构。似乎使用 5 年滞后是有意义的。我们将使用var()函数创建该模型。我会让你尝试使用滞后 1：

    > fit1 <- VAR(climateDiff, p = 5)

摘要结果相当长，因为它构建了两个单独的模型，可能需要占用两整页。我提供的是简化的输出，显示了以温度为预测变量的结果：

 > summary(fit1)
 Residual standard error: 0.1006 on 52 degrees of freedom
    Multiple R-Squared: 0.4509, Adjusted R-squared: 0.3453 
    F-statistic: 4.27 on 10 and 52 DF, p-value: 0.0002326

该模型具有显著性，其调整后的 R *方为 0.35。

正如我们在前一节中所做的那样，我们应该检查序列相关性。在这里，VAR包提供了serial.test()函数用于多元自相关。它提供了几种不同的测试，但让我们专注于Portmanteau Test，并且请注意，DW 测试仅适用于单变量序列。零假设是自相关为零，备择假设是它们不为零：

    > serial.test(fit1, type = "PT.asymptotic")

        Portmanteau Test (asymptotic)

    data: Residuals of VAR object fit1
    Chi-squared = 35.912, df = 44, p-value = 0.8021

在p-value为0.3481的情况下，我们没有证据拒绝零假设，可以说残差不是自相关的。这个测试在 1 滞后下说了什么呢？

在 R 中进行格兰杰因果检验，你可以使用lmtest包中的Grangertest()函数或vars包中的causality()函数。我将使用causality()函数来演示这个技术。这非常简单，你只需要创建两个对象，一个用于x导致y，另一个用于y导致x，利用之前创建的fit1对象：

    > x2y <- causality(fit1, cause = "CO2")

    > y2x <- causality(fit1, cause = "Temp")

现在调用格兰杰检验结果只是一个简单的问题：

    > x2y$Granger

         Granger causality H0: CO2_diff do not Granger-cause
 climate2.temp

 data: VAR object fit1
 F-Test = 2.2069, df1 = 5, df2 = 104, p-value = 0.05908

 > y2x$Granger

 Granger causality H0: climate2.temp do not Granger-cause
 CO2_diff

 data: VAR object fit1
 F-Test = 0.66783, df1 = 5, df2 = 104, p-value = 0.6487

格兰杰导致温度差异的 CO2 的p-value值为0.05908，在其他方向上并不显著。那么这一切意味着什么呢？我们可以说的第一件事是 Y 不会导致 X。至于 X 导致 Y，我们不能在 0.05 的显著性水*上拒绝零假设，因此我们得出结论，X 不会格兰杰导致 Y。然而，这是这里相关的结论吗？记住，p-value 评估的是如果零假设为真，效果发生的可能性。还要记住，这个测试从未被设计成一些二元的是或不是。如果这是一个受控实验，我们不太可能犹豫地说我们没有足够的证据来拒绝零假设，就像食品药品监督管理局（FDS）在 3 期临床试验中会做的那样。由于这项研究是基于观察数据的，我相信我们可以这样说，“CO2 排放格兰杰导致地表温度异常”是非常可能的。但是，对这个结论有很多批评的空间。我一开始就提到了关于数据质量的争议。仍然让我担忧的是分析从哪一年开始。我选择了 1945 年，因为它看起来大约是正确的；你可以说我应用了 SAS 术语中的proc eyeball。选择哪一年对分析有巨大的影响，改变滞后结构，也导致不显著的p-values。

然而，我们仍然需要使用替代的格兰杰因果技术来模拟原始的 CO2 水*。找到正确滞后数目的过程与之前相同，只是我们不需要使数据*稳：

 > climateLevels <- window(climate, start = 1946)

    > level.select <- VARselect(climateLevels, lag.max = 12)

    > level.select$selection
    AIC(n) HQ(n) SC(n) FPE(n) 
        10     1     1     6

让我们尝试滞后 6 的结构，看看我们是否可以达到显著性，记住要额外添加一个滞后项来考虑积分序列。关于这个技术和为什么需要这样做，可以在davegiles.blogspot.de/2011/04/testing-for-granger-causality.html找到讨论：

 fit2 <- VAR(climateLevels, p = 7)   
    > serial.test(fit2, type = "PT.asymptotic")

           Portmanteau Test (asymptotic)

    data: Residuals of VAR object fit2
    Chi-squared = 35.161, df = 36, p-value = 0.5083

现在，为了确定 X 导致 Y 的格兰杰因果性，你进行一个 Wald 测试，其中 X 和仅 X 的系数在预测 Y 的方程中为 0，记住不要在测试中包含解释积分的额外系数。

R 中的 Wald 测试在已经加载的aod包中可用。我们需要指定完整模型的系数、其方差-协方差矩阵以及因果变量的系数。

在 VAR 对象中我们需要测试的 Temp 系数包括从 2 到 12 的偶数范围，而 CO2 的系数则是从 1 到 11 的奇数。在我们的函数中，我们不用 c(2, 4, 6，等等)，而是用 base R 的seq()函数创建一个对象。

首先，让我们看看 CO2 是如何导致温度的格兰杰因果关系的：

 > CO2terms <- seq(1, 11, 2)

    > Tempterms <- seq(2, 12, 2)

我们现在可以运行以下代码中描述的wald测试：

 > wald.test(b = coef(fit2$varresult$Temp),
    Sigma = vcov(fit2$varresult$Temp),
    Terms = c(CO2terms))
       Wald test:
       ----------

    Chi-squared test:
    X2 = 11.5, df = 6, P(> X2) = 0.074

怎么样？我们接*了神奇的 0.05 p-value。让我们用以下代码测试其他方向的因果关系：

 > wald.test(b = coef(fit2$varresult$CO2),
    Sigma = vcov(fit2$varresult$CO2),
    Terms = c(Tempterms))
       Wald test:
       ----------

    Chi-squared test:
    X2 = 3.9, df = 6, P(> X2) = 0.69

最后要展示的是如何使用向量自回归来生成预测。predict函数可用，所以让我们用autoplot()函数对其 25 年期的预测进行可视化，看看会发生什么：

    > autoplot(predict(fit2, n.ahead = 25, ci = 0.95))

看起来，黑暗的日子即将来临，或许可以说，就像流行电视剧《权力的游戏》中的“冬天就要来了”。对我来说这没什么，因为我的长期投资和储蓄计划一直包括罐头食品和弹药。我还能做什么呢，骑马去上班？只有当戈尔来做的时候，我才会这么做。与此同时，我将致力于我的晒黑工作。

如果没有别的，我希望这能激发你对如何将这项技术应用到自己的实际问题中，或者甚至更深入地检查气候变化数据的思考。在证明因果关系时，应该有一个很高的标准，而格兰杰因果关系是辅助这一努力的一个伟大工具。

摘要

在本章中，目标是讨论时间元素在机器学习和分析领域的重要性，识别分析时间序列时的常见陷阱，并展示绕过这些陷阱的技术和方法。我们探讨了全球温度异常和人类二氧化碳排放的单变量和双变量时间序列分析。此外，我们还研究了格兰杰因果关系，以确定我们是否可以说，从统计学的角度来看，大气 CO2 水*导致地表温度异常。我们发现，从 CO2 到温度的格兰杰因果关系的 p 值高于 0.05 但低于 0.10。这确实表明，格兰杰因果关系是研究机器学习问题中因果关系的有效工具。在下一章中，我们将转换方向，探讨如何将学习方法应用于文本数据。

此外，请记住，在时间序列分析中，我们只是触及了表面。我鼓励你探索关于变化点检测、时间序列分解、非线性预测等许多其他技术。尽管通常不被认为是机器学习工具箱的一部分，但我相信你会发现它对你的工具箱来说是一个无价的补充。

第十三章：文本挖掘

"我认为活在未知中比拥有可能错误的答案更有趣。"

理查德·费曼

世界充满了文本数据。如果你在 Google、Bing 或 Yahoo 上搜索有多少数据是无结构的，也就是说，以文本格式存在，估计会从 80%到 90%。实际数字并不重要。重要的是，大量数据是以文本格式存在的。这意味着任何寻求从这些数据中寻找洞察的人都必须发展出处理和分析文本的能力。

当我最初作为一名市场研究员开始工作时，我过去常常手动翻阅一页又一页的由主持人引导的焦点小组和访谈，希望能捕捉到一些定性洞察，或者说是一个 Aha！时刻——然后与团队成员争论他们是否也有同样的洞察。然后，你总会遇到一个在项目中突然出现并听取两场访谈——30 或 40 场预定访谈中的两场——的人，唉，他们已经对世界上真正发生的事情有了自己的看法。与现在使用的技巧相比，分析师可以快速将数据提炼成有意义的定量结果，支持定性理解，甚至可能影响那些突然出现的人。

在过去的几年里，我已经将这里讨论的技术应用于挖掘医患互动，理解 FDA 对处方药广告的担忧，以及捕捉患者对罕见癌症的关注，仅举几个例子。使用 R 和本章中的方法，你也可以从文本数据中提取强大的信息。

文本挖掘框架和方法

文本挖掘有许多不同的方法可以使用。这里的目的是提供一个基本的框架，可以应用于这样的任务。这个框架并不包括所有可能的方法，但会涵盖那些在大多数你将要工作的项目中可能最重要的方法。此外，我将尽可能简洁、清晰地讨论建模方法，因为它们可能会变得相当复杂。收集和整理文本数据是一个可能占用几章内容的话题。因此，让我们假设我们的数据来自 Twitter、客户呼叫中心、从网络上抓取的，或者 whatever，并且包含在某些形式的文本文件或文件中。

第一项任务是把这些文本文件放入一个结构化的文件中，称为语料库。文档的数量可能只有一个，几十个，几百个，甚至几千个。R 可以处理包括 RSS 源、PDF 文件和 MS Word 文档在内的多种原始文本文件。语料库创建后，就可以开始数据准备，包括文本转换。

以下列表包含了一些文本文件中最常见和有用的转换：

将大写字母转换为小写
删除数字
删除标点符号
删除停用词
删除多余的空白
词干提取
单词替换

在转换语料库的过程中，你不仅创建了一个更紧凑的数据集，而且还简化了结构，以便于促进单词之间的关系，从而提高理解。然而，请注意，并非所有这些转换在所有时候都是必要的，必须应用判断，或者你可以迭代以找到最有意义的转换。

通过将单词转换为小写，你可以防止单词的不当计数。比如说，你有 hockey 这个词出现了三次，而 Hockey 只出现了一次，它是句子中的第一个单词。R 不会给你 hockey=4 的计数，而是 hockey=3 和 Hockey=1。

删除标点符号也能达到相同的目的，但正如我们将在业务案例中看到的，如果你想要根据句子分割文档，标点是重要的。

在删除停用词时，你正在去除那些没有价值的常见单词；实际上，它们对分析有害，因为它们的频率掩盖了重要的单词。停用词的例子包括是，和，是，的，不和到。删除空白字符通过去除诸如制表符、段落分隔、双倍间距等东西，使语料库更加紧凑。

单词的词干提取可能会有些棘手，并可能增加你的困惑，因为它删除了单词的后缀，创建了基词，或称为词根。我个人并不是特别喜欢词干提取，而且与我合作的分析师们也同意这种观点。然而，你可以使用 R 包tm中包含的词干提取算法，该函数调用SnowballC包中的Porter 词干提取算法。一个词干提取的例子是，如果你的语料库中有 family 和 families。回想一下，R 会将它们计为两个不同的单词。通过运行词干提取算法，这两个实例的词干单词将变为famili。这将防止错误的计数，但在某些情况下，它可能难以解释，并且在用于展示目的的词云中不太吸引人。在某些情况下，可能有必要同时使用词干提取和未提取的单词进行分析，以查看哪一个更有意义。

可能最可选的转换之一是替换单词。替换的目标是将具有相似意义的单词组合在一起，例如管理和管理。你还可以用它来代替词干提取。我曾经检查过词干提取和未提取的单词的结果，并得出结论，通过替换大约十二个单词而不是词干提取，我可以得到更有意义的结果。

当语料库的转换完成时，下一步是创建一个文档-词矩阵（DTM）或词-文档矩阵（TDM）。这两个矩阵中的任何一个都会为矩阵中的每个单独文档创建一个单词计数的矩阵。在 DTM 中，文档作为行，单词作为列，而在 TDM 中，情况正好相反。可以在任何一个矩阵上执行文本挖掘。

使用矩阵，您可以通过检查单词计数和生成如 wordclouds 这样的可视化来开始分析文本。还可以通过为特定单词生成相关性列表来找到单词关联。它还作为构建主题模型所必需的数据结构。

主题模型

主题模型是一种强大的方法，可以根据文档的主要主题对文档进行分组。主题模型允许对文档中术语频率出现的概率建模。拟合的模型可以用来估计文档之间的相似性，以及通过一个额外的潜在变量层（称为主题）来估计一组指定关键词之间的相似性（Grun 和 Hornik，2011）。本质上，一个文档是根据该文档中单词的分布分配给一个主题的，并且该主题中的其他文档将具有大致相同的单词频率。

我们将关注的算法是潜在狄利克雷分配（LDA）与吉布斯采样，这可能是最常用的采样算法。在构建主题模型之前，必须确定主题的数量（k 维度）。如果不存在主题数量的先验原因，则可以构建几个并应用判断和知识来最终选择。LDA 与吉布斯采样在数学上相当复杂，但我的目的是提供一个介绍，以便您至少能够用通俗易懂的语言描述算法如何学习将文档分配给一个主题。如果您对掌握数学感兴趣，请在您的日历上预留几个小时，尝试一下。有关背景材料，请参阅www.cs.columbia.edu/~blei/papers/Blei2012.pdf。

LDA 是一个生成过程，因此以下将迭代到一个稳定状态：

对于每个文档 (j)，有 1 到 j 个文档。我们将随机地将它分配给主题 (k) 的多项式分布（dirichlet 分布），主题 (k) 有 1 到 k 个主题，例如，文档 A 是 25% 主题一，25% 主题二，50% 主题三。
概率上，对于每个单词 (i)，有 1 到 i 个单词属于主题 (k)；例如，单词 mean 在主题统计中的概率为 0.25。
对于文档 (j) 中每个单词(i)和主题(k)，计算分配给该主题的单词比例；将其记为文档(j)的主题(k)的概率，p(k|j)，以及单词(i)在包含该单词的所有文档中属于主题(k)的比例。将其记为单词(i)的主题(k)的概率，p(i|k)。
重新采样，即根据 t 包含 w 的概率来给 w 分配一个新的 t，这个概率是基于 p(k|j) 乘以 p(i|k)。
重复上述步骤；经过多次迭代，算法最终收敛，并根据文档中分配给主题的单词比例将文档分配给一个主题。

我们将要进行的 LDA 假设单词和文档的顺序不重要。为了构建语言生成和序列模型（称为动态主题建模），已经有人对这些假设进行了放松。

其他定量分析

我们现在将转换方向，根据句子和基于词性的单词标记来分析文本的语义，例如名词、动词、代词、形容词、副词、介词、单数、复数等等。通常，仅仅检查文本中的频率和潜在主题就足以进行分析。然而，你可能会发现需要更深入地理解风格的情况，以便比较说话者或作者。

完成这项任务有许多方法，但我们将关注以下五种：

极性（情感分析）
自动可读性指数（复杂性）
正式性
多样性
散布度

极性通常被称为情感分析，它告诉你文本是积极的还是消极的。通过使用 R 中的qdap包分析极性，每个句子都会被分配一个分数，你可以通过不同作者、文本或主题等群体分析极性的*均值和标准差。有多个极性词典可用，qdap默认使用的是胡和刘于 2004 年创建的词典。你可以根据你的需求修改或更改这个词典。

该算法首先根据词典将单词标记为积极、消极或中性情感。然后，根据标记词前后的四个单词和两个单词将标记词进行聚类，这些聚类被标记为所谓的极性转换词（中性、否定者、放大器和去放大器）。根据它们的数量和位置应用一系列权重到单词和聚类上。然后，将这个总和除以该句子中单词数量的*方根。

自动可读性指数是文本复杂性和读者理解能力的度量。使用特定的公式来计算这个指数：4.71（字符数/单词数）+ 0.5（单词数/句子数）- 21.43。

索引产生一个数字，这个数字是对学生达到完全理解水*所需年级的粗略估计。如果这个数字是 9，那么一个 13 到 15 岁的高中生应该能够理解文本的含义。

正式性度量提供了对文本如何与读者或演讲如何与听众相关联的理解。我喜欢把它想成是理解文本生产者对受众的舒适度或理解这种沟通发生的背景的一种方式。如果你想体验正式文本，可以参加医学会议或阅读法律文件。非正式文本被认为具有情境性。

正式性度量被称为F-Measure。这个度量是这样计算的：

正式词汇 (f) 是名词、形容词、介词和冠词
上下文词汇 (c) 是代词、动词、副词和感叹词
N = (f + c + 并列词)
正式度指数 = 50((f 的总和 - c 的总和 / N) + 1)

这完全无关紧要，但当我还在伊拉克时，一位军队将军——我将不透露他的名字。我必须简要汇报并撰写情况报告，他坚决反对使用副词，否则就会大发雷霆。这种想法是，你不能量化像“非常”或“大部分”这样的词，因为它们对不同的人意味着不同的东西。五年后，我仍然在我的商业电子邮件和 PowerPoint 演示文稿中寻找不必要的副词。形式主义到了极致！

在文本挖掘方面，多样性指的是与总词汇量相比使用的不同词汇的数量。这也可能意味着文本生产者的词汇量或词汇丰富度。qdap 包提供了五种——没错，五种——不同的多样性度量：辛普森、香农、碰撞、伯根·帕克和布里渊。我不会详细讲解这五种，但只想说这些算法不仅用于通信和信息科学检索，还用于自然界的生物多样性。

最后，分散度，或词汇分散度，是理解词汇如何在文档中分布的有用工具，并且是探索文本和识别模式的一种极好方式。分析是通过调用特定的单词或单词组来进行的，这些单词或单词组随后在显示单词或单词组在文本中随时间出现的时间序列图中生成。正如我们将看到的，qdap 包内置了一个用于分析文本分散度的绘图功能。

我们介绍了一个关于文本挖掘的框架，介绍了如何准备文本、计数单词、创建主题模型，最后深入探讨了其他词汇度量。现在，让我们应用所有这些，做一些真正的文本挖掘。

业务理解

对于这个案例研究，我们将查看奥巴马总统的国情咨文。我这里没有议程；只是好奇能否发现某些特别之处，以及他的信息是否以及如何随时间变化。也许这可以作为分析任何政治家演讲的蓝图，以便为辩论或他们自己的演讲准备反对候选人。如果不行，那就这样吧。

两个主要的分析目标是基于六篇国情咨文建立主题模型，然后比较 2010 年的第一篇和 2016 年 1 月的最后一篇基于句子的文本度量，如情感和分散度。

数据理解和准备

我们将使用的首要包是 tm，文本挖掘包。我们还需要 SnowballC 用于词干提取，RColorBrewer 用于 wordclouds 中的调色板，以及 wordcloud 包。请在尝试加载它们之前确保已安装这些包：

    > library(tm)

    > library(wordcloud)

    > library(RColorBrewer)

数据文件可在github.com/datameister66/data下载。请确保将文本文件放入单独的目录中，因为它们都将进入我们的语料库进行分析。

将七个.txt文件，例如sou2012.txt，下载到你的工作 R 目录中。你可以使用这些函数识别你的当前工作目录并设置它：

 > getwd()

    > setwd(".../data")

我们现在可以开始创建语料库，首先创建一个包含演讲路径的对象，然后查看这个目录中有多少文件以及它们的名称：

    > name <- file.path(".../text")

    > length(dir(name))
    [1] 7

    > dir(name)
    [1] "sou2010.txt" "sou2011.txt" "sou2012.txt" "sou2013.txt"
    [5] "sou2014.txt" "sou2015.txt" "sou2016.txt"

我们将命名我们的语料库为docs，并使用Corpus()函数创建它，该函数围绕目录源函数DirSource()，这也是tm包的一部分：

    > docs <- Corpus(DirSource(name))

 > docs
    <<VCorpus>>
    Metadata:  corpus specific: 0, document level (indexed): 0
    Content:  documents: 7

注意，没有corpus或document level元数据。tm包中有函数可以应用作者姓名和时间戳信息等，在document level和corpus级别。我们不会为此目的使用这些功能。

我们现在可以使用tm包中的tm_map()函数开始文本转换。这些是我们之前讨论过的转换——小写字母、去除数字、去除标点符号、去除停用词、去除空白字符，以及词干提取：


    > docs <- tm_map(docs, tolower)

    > docs <- tm_map(docs, removeNumbers)

    > docs <- tm_map(docs, removePunctuation)

    > docs <- tm_map(docs, removeWords, stopwords("english"))

    > docs <- tm_map(docs, stripWhitespace)

在这一点上，消除不必要的单词是个好主意。例如，在演讲中，当Congress对一项声明表示赞同时，你会在文本中找到(Applause)。这必须被移除：

    > docs <- tm_map(docs, removeWords, c("applause", "can", "cant", 
      "will",
    "that", "weve", "dont", "wont", "youll", "youre"))

在完成转换和去除其他单词后，确保您的文档是纯文本，将其放入文档-词矩阵中，并检查维度：

    > docs = tm_map(docs, PlainTextDocument)

    > dtm = DocumentTermMatrix(docs)

    > dim(dtm)
    [1]    7 4738

六篇演讲包含4738个单词。使用removeSparseTerms()函数去除稀疏项是可选的。你需要指定一个介于零和一之间的数字，数值越高，矩阵中的sparsity百分比越高。稀疏性是术语在文档中的相对频率。所以，如果你的稀疏性阈值是 0.75，只有稀疏性大于 0.75 的术语会被移除。对我们来说，这将是(1 - 0.75) * 7，等于 1.75。因此，任何在不到两个文档中出现的术语都会被移除：

    > dtm <- removeSparseTerms(dtm, 0.75)

    > dim(dtm)
    [1]    7 2254

由于我们没有文档的元数据，因此给矩阵的行命名很重要，这样我们才能知道哪个文档是哪个：

    > rownames(dtm) <- c("2010", "2011", "2012", "2013", "2014", 
       "2015", "2016")

使用inspect()函数，你可以检查矩阵。在这里，我们将查看七个行和前五列：

 > inspect(dtm[1:7, 1:5])
 Terms
 Docs abandon ability able abroad absolutely
 2010       0       1    1      2          2
 2011       1       0    4      3          0
 2012       0       0    3      1          1
 2013       0       3    3      2          1
 2014       0       0    1      4          0
 2015       1       0    1      1          0
 2016       0       0    1      0          0

看起来我们的数据已经准备好进行分析了，首先从查看单词频率计数开始。让我指出，输出展示了为什么我被训练成不倾向于全面词干提取。你可能认为ability和able可以合并。如果你对文档进行了词干提取，你最终会得到abl。这如何有助于分析？我认为你失去了上下文，至少在初始分析中是这样。再次，我建议谨慎和明智地应用词干提取。

建模和评估

建模将被分为两个不同的部分。第一部分将专注于单词频率和相关性，并以构建主题模型结束。在下一部分，我们将利用qdap包的强大功能来检查许多不同的定量技术，以便比较两个不同的演讲。

单词频率和主题模型

由于我们在文档-词矩阵中已经设置好了一切，我们可以继续通过创建一个按降序排列的列总和的对象来探索单词频率。在代码中，使用as.matrix()来求列的和是必要的。默认顺序是升序，所以在freq前面加上-将使其变为降序：

    > freq <- colSums(as.matrix(dtm))

    > ord <- order(-freq)

我们将使用以下代码检查对象的前head和tail：

    > freq[head(ord)]
        new  america  people   jobs    now  years 
 193      174     168    163    157    148 

    > freq[tail(ord)]
        wright written yearold youngest youngstown zero 
 2       2       2        2          2    2

最常出现的单词是new，正如你所预期的，总统经常提到america。同时，注意jobs的频率如何显示就业的重要性。我发现他提到 Youngstown 很有趣，因为 Youngstown，OH，他提到了几次。

要查看单词频率的频率，你可以创建如下表格：

    > head(table(freq))
    freq
 2   3   4   5   6  7 
 596 354 230 141 137 89

    > tail(table(freq))
    freq
 148 157 163 168 174 193 
 1   1   1   1   1   1

这些表格显示的是具有该特定频率的单词数量。所以有 354 个单词出现了三次；在我们的例子中，一个单词new出现了 193 次。

使用findFreqTerms()，我们可以看到哪些单词至少出现了125次：

    > findFreqTerms(dtm, 125)
    [1] "america" "american" "americans" "jobs" "make" "new" 
     [7] "now"     "people"   "work"      "year" "years"

你可以通过使用findAssocs()函数来通过相关性找到与单词的关联。让我们以jobs为例，使用0.85作为相关性截止值：

 > findAssocs(dtm, "jobs", corlimit = 0.85)
 $jobs
 colleges serve market shouldnt defense  put  tax came 
 0.97  0.91   0.89     0.88    0.87 0.87 0.87 0.86

为了视觉表现，我们可以生成wordclouds和条形图。我们将做两个wordclouds来展示不同的生成方式：一个指定最小频率，另一个指定包含单词的最大数量。第一个使用最小频率的，还包括指定颜色的代码。缩放语法通过频率确定最小和最大单词大小；在这种情况下，最小频率是70：

    > wordcloud(names(freq), freq, min.freq = 70, scale = c(3, .5),  
      colors = brewer.pal(6, "Dark2"))

前一个命令的输出如下：

可以省略所有花哨的图形，就像我们在下面的图像中所做的那样，捕捉到最常出现的25个单词：

    > wordcloud(names(freq), freq, max.words = 25)

前一个命令的输出如下：

要生成条形图，代码可能会变得有些复杂，无论你使用的是基础 R、ggplot2还是lattice。以下代码将展示如何在基础 R 中生成最常出现10个单词的条形图：

 > freq <- sort(colSums(as.matrix(dtm)), decreasing = TRUE) 
 > wf <- data.frame(word = names(freq), freq = freq) 
 > wf <- wf[1:10, ] 
 > barplot(wf$freq, names = wf$word, main = "Word Frequency",
 xlab = "Words", ylab = "Counts", ylim = c(0, 250))

前一个命令的输出如下：

现在我们将转向使用topicmodels包构建主题模型，该包提供了LDA()函数。现在的问题是创建多少个主题。似乎解决三个主题（k=3）是合理的。当然，我鼓励你尝试其他数量的主题：

    > library(topicmodels)

    > set.seed(123)

    > lda3 <- LDA(dtm, k = 3, method = "Gibbs")

    > topics(lda3)
    2010 2011 2012 2013 2014 2015 2016 
       2    1    1    1    3    3    2

我们可以看到一个有趣的时间过渡。第一个和最后一个地址有相同的主题分组，几乎就像他带着相同的主题开始了他的任期并结束了它。

使用terms()函数可以生成每个主题的有序词频列表。函数中指定了单词列表，因此让我们看看每个主题的前20个：

 > terms(lda3, 25)
 Topic 1      Topic 2       Topic 3 
 [1,] "jobs"       "people"      "america" 
 [2,] "now"        "one"         "new" 
 [3,] "get"        "work"        "every" 
 [4,] "tonight"    "just"        "years" 
 [5,] "last"       "year"        "like" 
 [6,] "energy"     "know"        "make" 
 [7,] "tax"        "economy"     "time" 
 [8,] "right"      "americans"   "need" 
 [9,] "also"       "businesses"  "american" 
 [10,] "government" "even"        "world" 
 [11,] "home"       "give"        "help" 
 [12,] "well"       "many"        "lets" 
 [13,] "american"   "security"    "want" 
 [14,] "two"        "better"      "states" 
 [15,] "congress"   "come"        "first" 
 [16,] "country"    "still"       "country" 
 [17,] "reform"     "workers"     "together" 
 [18,] "must"       "change"      "keep" 
 [19,] "deficit"    "take"        "back" 
 [20,] "support"    "health"      "americans"
 [21,] "business"   "care"        "way" 
 [22,] "education"  "families"    "hard" 
 [23,] "companies"  "made"        "today" 
 [24,] "million"    "future"      "working" 
 [25,] "nation"     "small"       "good"

Topic 2 涵盖了第一次和最后一次演讲。在那个主题中并没有像其他主题那样真正引人注目的内容。将很有趣地看到下一次分析如何揭示这些演讲的见解。

Topic 1 涵盖了接下来的三次演讲。在这里，信息过渡到 "jobs"、"energy"、"reform" 和 "deficit"，更不用说关于 "education" 的评论以及我们上面看到的 "jobs" 和 "colleges" 之间的相关性。

Topic 3 带我们进入接下来的两次演讲。重点似乎真正转向了经济和商业，提到了 "security" 和医疗保健。

在下一节中，我们可以进一步挖掘具体的演讲内容，同时对比和对照第一次和最后一次国情咨文演讲。

额外的定量分析

这部分分析将专注于qdap包的力量。它允许你通过广泛的指标比较多个文档。我们的努力将集中在比较 2010 年和 2016 年的演讲。首先，我们需要将文本转换为数据框，执行句子分割，然后将它们合并到一个数据框中，创建一个变量来指定演讲的年份。我们将使用这个变量作为分析中的分组变量。在 R 中处理文本数据可能会很棘手。下面的代码似乎在这种情况下工作得最好，以加载数据并准备好分析。我们首先加载qdap包。然后，为了从文本文件中引入数据，我们将使用 R 的基础函数readLines()，将结果压缩以消除不必要的空白。我还建议将你的文本编码设置为 ASCII，否则你可能会遇到一些奇怪的文本，这会搞乱你的分析。这是通过iconv()函数完成的：

    > library(qdap)
    > speech16 <- paste(readLines("sou2016.txt"), collapse=" ")
    Warning message:
    In readLines("sou2016.txt") : incomplete final line found on 
      'sou2016.txt'

    > speech16 <- iconv(speech16, "latin1", "ASCII", "")

警告信息并不是问题，因为它只是告诉我们文本的最后一行长度与其他.txt文件中的行不同。我们现在应用来自qdap的qprep()函数。

这个函数是多个其他替换函数的包装器，使用它将加快预处理速度，但如果需要更详细的分析，则应谨慎使用。它传递的函数如下：

bracketX(): 应用括号去除
replace_abbreviation(): 替换缩写
replace_number(): 数字转换为文字，例如 '100' 变为 'one hundred'
replace_symbol(): 符号变为文字，例如 @ 变为 'at'

 > prep16 <- qprep(speech16)

我们应该做的其他预处理工作是将缩写（can't to cannot）替换掉，移除停用词，在我们的例子中是前 100 个，以及移除不需要的字符，除了句号和问号。它们很快就会派上用场：

 > prep16 <- replace_contraction(prep16)

 > prep16 <- rm_stopwords(prep16, Top100Words, separate = F)

 > prep16 <- strip(prep16, char.keep = c("?", "."))

对于这次分析来说，现在将其拆分为句子，并添加将成为分组变量的演讲年份非常重要。这也创建了tot变量，代表谈话转换，作为句子顺序的指标。这在分析对话时特别有用，比如在辩论或问答环节：

 > sent16 <- data.frame(speech = prep16)

 > sent16 <- sentSplit(sent16, "speech")

 > sent16$year <- "2016"

重复 2010 年演讲的步骤：

 > speech10 <- paste(readLines("sou2010.txt"), collapse=" ")
 > speech10 <- iconv(speech10, "latin1", "ASCII", "")
 > speech10 <- gsub("(Applause.)", "", speech10)
 > prep10 <- qprep(speech10)
 > prep10 <- replace_contraction(prep10)
 > prep10 <- rm_stopwords(prep10, Top100Words, separate = F)
 > prep10 <- strip(prep10, char.keep = c("?", "."))
 > sent10 <- data.frame(speech = prep10)
 > sent10 <- sentSplit(sent10, "speech")

 > sent10$year <- "2010"

将单独的年份合并到一个数据框中：

 > sentences <- data.frame(rbind(sent10, sent16))

qdap 包的一个优点是它促进了基本的文本探索，就像我们之前做的那样。让我们看看频繁词的图表：

 > plot(freq_terms(sentences$speech))

前一个命令的输出如下：

您可以创建一个通过语音提供的每个单词计数的词频矩阵：

 > wordMat <- wfm(sentences$speech, sentences$year)

 > head(wordMat[order(wordMat[, 1], wordMat[, 2],decreasing = 
      TRUE),])
 2010 2016
 our        120   85
 us          33   33
 year        29   17
 americans   28   15
 why         27   10
 jobs        23    8

如果您愿意，这也可以通过as.dtm()函数转换为文档-词矩阵。接下来，我们将使用qdap功能按年份构建wordclouds：

 > trans_cloud(sentences$speech, sentences$year, min.freq = 10)

前一个命令生成了以下两个图像：

提供了全面的单词统计信息。以下是该包中可用统计信息的图表。仅用两个演讲，这个图表的视觉吸引力有所下降，但仍然很有启发性。关于统计的完整解释可以在?word_stats下找到：

 > ws <- word_stats(sentences$speech, sentences$year, rm.incomplete = T)

 > plot(ws, label = T, lab.digits = 2)

前一个命令的输出如下：

注意到 2016 年的演讲要短得多，有超过一百个句子和*一千个单词。此外，似乎在 2016 年比 2010 年更多地使用了提问作为修辞手段（n.quest 10 比 n.quest 4）。

要比较极性（情感分数），请使用polarity()函数，指定文本和分组变量：

    > pol = polarity(sentences$speech, sentences$year)

    > pol
     year total.sentences total.words ave.polarity sd.polarity 
       stan.mean.polarity
   1 2010             435        3900        0.052       0.432              
      0.121
   2 2016             299        2982        0.105       0.395              
      0.267

stan.mean.polarity值表示标准化的*均极性，即*均极性除以标准差。我们看到2015年略高（0.267），而2010年较低（0.121）。这与我们的预期相符，希望以更积极的语气结束。您也可以绘制数据。这个图表产生了两个图表。第一个显示了随时间变化的句子极性，第二个显示了极性的分布：

    > plot(pol)

前一个命令的输出如下：

这个图表在这个文本中可能难以阅读，但我会尽力解释它。2010年的演讲一开始就带有强烈的负面情绪，并且比2016年稍微负面一些。我们可以通过创建pol对象的 dataframe 来识别最负面的句子，找到句子编号，并生成它：

    > pol.df <- pol$all

    > which.min(pol.df$polarity)
    [1] 12

    > pol.df$text.var[12]

    [1] "One year ago, I took office amid two wars, an economy rocked 
       by a severe recession, a financial system on the verge of 
          collapse, and a government deeply in debt.

现在是负面情绪！具有讽刺意味的是，政府现在的债务甚至更多。接下来，我们将查看可读性指数：

    > ari <- automated_readability_index(sentences$speech, 
      sentences$year) 

    > ari$Readability
      year word.count sentence.count character.count
    1 2010       3900            435           23859
    2 2016       2982            299           17957
      Automated_Readability_Index
    1                    11.86709
    2                    11.91929

我认为这并不令人惊讶，它们基本上是相同的。接下来是正式性分析。在 R 中运行这个分析需要几分钟时间：

    > form <- formality(sentences$speech, sentences$year)

    > form
      year word.count formality
    1 2016       2983     65.61
    2 2010       3900     63.88

这看起来非常相似。我们可以检查演讲各部分的占比。虽然有一个图表可用，但在这个例子中它并没有为分析增加任何东西：

    > form$form.prop.by
      year word.count  noun   adj  prep articles pronoun
    1 2010       3900 44.18 15.95  3.67     0        4.51
    2 2016       2982 43.46 17.37  4.49     0        4.96
       verb adverb interj other
    1 23.49   7.77   0.05  0.38
    2 21.73   7.41   0.00  0.57

现在，多样性度量已经生成。再次强调，它们几乎完全相同。还有一个可用的图表（plot(div)），但由于它们如此相似，它再次没有增加任何价值。重要的是要注意，2010 年奥巴马的演讲稿作者是乔恩·法夫罗，而 2016 年则是科迪·基南：

    > div <- diversity(sentences$speech, sentences$year)

    > div
      year   wc simpson shannon collision berger_parker brillouin
    1 2010 3900   0.998   6.825     5.970         0.031     6.326
    2 2015 2982   0.998   6.824     6.008         0.029     6.248

我最喜欢的图表之一是散点图。这个图表显示了单词在整个文本中的分布。让我们来考察"jobs"、“families”和"economy"的分布：

 > dispersion_plot(sentences$speech,
     rm.vars = sentences$year,
     c("security", "jobs", "economy"),
     color = "black", bg.color = "white")

上述命令的输出如下：

这非常有趣，因为你可以直观地看到 2010 年的演讲有多长。在 2010 年，他演讲的前半部分主要关注就业问题，而在 2016 年，似乎更多地关注整体经济状况；毫无疑问，他在避免灾难边缘发挥了多大的作用。在 2010 年，安全议题直到演讲的后期才被提及，而在最后的演讲中则贯穿始终。你可以看到并理解文本分析如何提供对某人思考方式、优先事项以及他们如何进行沟通的洞察。

这完成了我们对两篇演讲的分析。我必须承认，我没有听过这些演讲中的任何一篇。事实上，自从里根总统以来，我就没有看过国情咨文演讲，可能只有 2002 年的那次例外。这为我提供了关于随着时间的推移，为了适应政治需求，主题和演讲格式如何变化的见解，而整体风格和句子结构则保持一致。记住，这段代码可以适应数十篇，甚至数百篇文档，以及多个演讲者，例如剧本、法律程序、访谈、社交媒体等等。确实，文本挖掘可以为定性混沌带来定量秩序。

摘要

在本章中，我们探讨了如何通过文本挖掘方法来处理大量存在的文本数据。我们研究了一个有用的文本挖掘框架，包括准备、词频统计和可视化，以及使用tm包的 LDA 主题模型。该框架还包括其他定量技术，如极性和正式程度，以便通过qdap包提供更深入的词汇理解，或者说是一种风格。然后，我们将该框架应用于奥巴马总统的七次国情咨文演讲，结果显示，尽管演讲风格相似，但随着政治格局的变化，核心信息随着时间的推移而发生了变化。尽管全面覆盖所有可能的文本挖掘技术并不实用，但本章中讨论的技术应该足以应对大多数人可能遇到的大部分问题。在下一章中，我们将转变方向，不再专注于构建模型，而是关注一种将 R 语言部署到云上的技术，这样你就可以将你的机器学习扩展到任何你试图解决的问题。

第十四章：云上的 R

“如果有人问我云计算是什么，我尽量不陷入定义的泥潭。我告诉他们，简单来说，云计算是运行业务的一种更好的方式。”

马克·贝尼奥夫，Salesforce.com 首席执行官

由于我不是一个试图从云中获利的公司首席执行官，让我们陷入定义的泥潭。我喜欢微软（TM）提出的这个定义——azure.microsoft.com/en-us/overview/what-is-cloud-computing/。

简而言之，云计算是通过互联网（“云”）提供计算服务——服务器、存储、数据库、网络、软件、分析等。提供这些计算服务的公司被称为云服务提供商，通常根据使用情况收费，类似于你在家里为水或电付费的方式。

如果你现在还没有使用云进行机器学习，那么我保证在不久的将来，你一定会用到。我仍然认识一些人对失去数据控制权、安全问题等感到恐惧。然而，正如一位初创公司首席执行官对我说的，我倾向于问他们是否通过 WiFi 在笔记本电脑上访问他们所谓的安全数据，当他们回答是的时候，他们实际上是在告诉我他们已经在云上了，这只是一个硬件存储位置的问题。

就这样。你想要你的办公室地下室排满服务器，还是想让别人用他们安全、冗余和独立的全球基础设施来处理这个问题？

使用基于云的计算与 R 可以促进跨多个地点的无缝工作，同时也为你提供巨大的计算能力，可以根据需要快速扩展或缩减。这可以显著节省成本。

获取云上 R 的途径有很多，但我会使用亚马逊网络服务（AWS）和他们的弹性计算云（EC2）进行这次演示，因为这是我首先学习的，也是我熟悉使用的。这并不意味着我推荐它超过其他产品。我不会，除非杰夫·贝索斯选择我参加载人太空任务，那时我的态度才会改变。

无论如何，这里的目的是让你快速在云上启动并运行 R 和 RStudio，而不需要编写任何 Linux 代码。现在，为了最大限度地发挥 AWS 及其令人眼花缭乱的工具的力量，你可以学习如何通过安全外壳（SSH）应用 Linux 代码。为此，我们将创建并启动一个名为实例的虚拟计算机。然后，我们将通过网页浏览器登录到 RStudio，并介绍一些功能。网上有很多关于如何做到这一点的教程，但我的目标是尽可能简单、快速地让你开始，并让你今天就开始在云上使用 R。

创建亚马逊网络服务账户

首件事是注册一个 AWS 账户：

aws.amazon.com/

这是本练习的唯一先决条件。该流程需要一张信用卡，但我们在这里所做的一切都不会花费一分钱，因为它是在一个免费实例上完成的。向前推进，当你需要更大的计算能力时，可以快速启动一个新的实例，完成后停止或终止实例。当你创建账户并登录时，你可以选择是否创建安全组。我将通过在实例创建过程中创建一个新的安全组来演示。安全组允许你控制谁可以以及如何访问实例。此外，除非你真的想创建，否则在这个阶段不要担心创建配对密钥。我们也会创建它。

完成后，登录到你的 AWS 控制台，应该会看到一个网页，如下所示：

如果你在这里，现在就是时候通过简单地点击名为“启动虚拟机”的巧妙超链接来创建和启动虚拟机了。

启动虚拟机

启动虚拟机的超链接会带你到这个页面：

避免点击“入门”按钮，点击“高级 EC2 启动实例向导”，这将带你到这个页面：

随着你经验的积累，你可以使用各种 Amazon Machine Images (AMI) 并自定义你在 AWS 上使用 R 的方式。然而，我们的目标在这里是快速且简单。考虑到这一点，AWS 用户已经创建了几个包含 R 和 RStudio 的社区 AMI。因此，在“快速入门”下点击“社区 AMI”。会出现一个搜索框，我建议从 Louis Aslett 维护的 AMI 开始使用，www.louisaslett.com/RStudio_AMI/。通过搜索 rstudio aslett，这个 AMI 将会显示出来。因此，点击“选择”按钮，如图所示：

这将带你到第 2 步，在那里你选择实例类型。我选择了免费的 t2.micro：

一旦你选择了你想要的实例类型，点击“审查并启动”。由于这是一个现有的 AMI，你可以跳到第 7 步，即“审查”标签。你可以从这里启动，但让我们点击第 6 步，“配置安全组”：

这将带你到流程中的步骤，你可以创建一个新的安全组或使用现有的一个。以下是一个创建新安全组的示例：

一旦你对流程中的这一步满意（你不需要做任何改变），点击“审查并启动”。这将带你回到第 7 步，在那里你可以简单地点击“启动”。这会带你到选择新或现有密钥对的地方：

完成后，点击“启动实例”并返回到你的 AWS 控制台。

启动 RStudio

当你的实例正在运行时，当你返回到 AWS 控制台并选择该实例，你会看到如下内容：

注意所选实例的公共 DNS。这将是你启动你选择的浏览器上的 RStudio 所需的所有内容。当你在这个浏览器中启动它时，你会来到 RStudio 登录页面。用户名和密码都是rstudio：

就这样！你现在正在虚拟机上运行 RStudio。它应该看起来像这样：

在左上角的面板中，源面板，有如何更改密码的说明以及链接到 Dropbox 的功能。

为了展示如何从网络上加载数据，我将加载我们在前几章中使用过的 github 上的一个.csv文件。让我们试试climate.csv，好吗？首先，需要安装并加载RCurl包：

 > install.packages("RCurl")

   > library(RCurl)

我们现在需要获取 github 上数据的链接：

 > url <-  
     "https://raw.githubusercontent.com/datameister66/data/master/climate.csv"

然后，将文件拖入 RStudio 中：

 > climate <-read.csv(text = getURL(url))

并且，确保它已经工作：

 > head(climate)
      Year CO2   Temp
    1 1919 806 -0.272
    2 1920 932 -0.241
    3 1921 803 -0.187
    4 1922 845 -0.301
    5 1923 970 -0.272
    6 1924 963 -0.292

就这样。你现在已经成为了一名基于云的机器学习战士，几乎可以在虚拟机上像在自己的机器上一样操作。

请记住，一旦你完成并退出 RStudio，一定要回到你的控制台并停止实例。

摘要

在本章的最后，我们快速简单地介绍了如何在云上运行 R 和 RStudio。利用 AWS 进行这项练习，我们一步一步地介绍了如何在云上创建虚拟机（实例），配置它，启动它，并在网页浏览器上启动 RStudio。最后，我们介绍了如何轻松加载数据，通过从 GitHub 引入气候.csv文件。通过这个云计算的介绍，你现在可以在任何有互联网连接的地方进行工作，并且可以快速调整实例的功率以满足你的需求。这标志着本书主要章节的结束。我希望你喜欢它，并且能够实施这里的方法以及其他你随着时间的推移所学习的方法。谢谢！

第十五章：R 基础知识

“我最有生产力的一天就是扔掉了 1,000 行代码。”

Ken Thompson

本章涵盖了 R 的基本编程语法函数和功能。其目的是向您介绍 R 并加速您的学习。目标如下：

安装 R 和 RStudio
创建和探索向量
创建数据框和矩阵
探索数学和统计函数
构建简单的图表
介绍dplyr数据操作
安装和加载包

附录中的所有示例都在前面的章节中以某种方式进行了覆盖。然而，如果您是 R 的完全新手，这是一个很好的起点。它可能会加速您对章节内容的理解。

让 R 运行起来

我们在这里想要完成两件事：首先，安装 R 的最新版本，其次，安装 RStudio，它是 R 的集成开发环境（IDE）。

让我们从访问 R 的主页www.r-project.org/开始。这个页面看起来与以下截图相似：

您可以看到有一个链接，下载 R，在新闻部分，最新的 R 版本是 3.3.2（真诚的南瓜地），发布于 2016-10-31。版本 3.3.3 计划于 3 月发布。现在，点击其中一个链接，无论是下载部分下的 CRAN 还是入门部分下的下载 R，您将来到以下屏幕，其中包含 CRAN 镜像：

这些是根据国家和字母顺序排序的链接，它们将带您到下载页面。作为美国人，我会向下滚动并找到许多可用的链接：

一旦您找到一个接*您位置的类似链接，点击它，您将看到以下页面的一部分，该页面将被加载：

现在，点击您适当的操作系统：

我们现在想要安装基础 R，因此点击首次安装 R，我们将来到以下页面，其中包含启动下载的链接：

现在，您只需像安装其他程序一样下载并安装 R。安装完成后，运行 R，您将看到基本的图形用户界面（GUI）：

这就是您运行本书中所有代码所需的所有内容。然而，如果您在 RStudio 的 IDE 环境中使用 R，这将非常有帮助，RStudio 是免费提供的。此链接将带您到可以下载免费版本的页面：

www.rstudio.com/products/RStudio/

在页面上，你可以找到免费和商业版本的下载。不用说，让我们坚持使用免费版本，下载并安装它。安装并首次打开后，你会看到如下内容。请注意，你的屏幕将与我这里看到的不同，这取决于我加载的包和操作系统：

注意，在左边是相同的控制台，你可以看到先前的图中的命令提示符。IDE 改进了体验，让你可以管理环境和历史记录（右上角）以及文件、绘图、包和帮助（右下角）。

让我们不要在这里被 RStudio 能做什么的完整教程所分散注意力；相反，我们将专注于几个重要项目。R 的一个巨大好处是，它为各种分析提供了大量高质量的包。让我们看看 IDE 是如何通过加载一个名为abc的包来将这些全部联系起来的，它代表*似贝叶斯计算。转到命令提示符并输入以下内容：

    > install.packages("abc")

运行此代码后，注意在右下角的面板（确保已点击“包”标签）中，abc包以及依赖的abc.data包现在都已安装。

现在，转到右上角并点击历史记录标签。你应该能看到你执行以加载包的命令：

现在，如果你点击“发送到控制台”按钮，将会在命令提示符前放置什么。如果你点击“发送到源”，将打开一个新区域，允许你将你的项目脚本组合起来。

install.packages()命令现在已从历史记录转移到源文件。当你对你的代码进行实验并使其按你的意愿工作后，将其放入源文件。你可以保存它、发送电子邮件等等。本书每一章的所有代码都保存为源文件。

使用 R

在所有系统都准备就绪后，让我们开始我们的第一个命令。R 将接受带引号的字符串或简单的数字。这里，我们将一个命令作为字符串，一个命令作为数字。输出与输入相同：

    > "Let's Go Sioux!"
    [1] "Let's Go Sioux!"

    > 15
    [1] 15

R 也可以作为计算器使用：

    > ((22+5)/9)*2
    [1] 6

R 开始发光的地方是在向量的创建。这里，我们将使用c()函数，它代表将值组合到向量或列表（连接），将斐波那契数列的前 10 个数字放入一个向量中：

    > c(0, 1, 1, 2, 3, 5, 8, 13, 21, 34) #Fibonacci sequence
     [1]  0  1  1  2  3  5  8 13 21 34

注意，在这个语法中，我包含了一个注释，“斐波那契数列”。在 R 中，命令行上的#键之后的内容不会被执行。

现在，让我们创建一个包含序列这些数字的对象。你可以将任何向量或列表分配给一个对象。在大多数 R 代码中，你会看到分配符号<-，它读作 gets。这里，我们将创建一个名为x的对象，用于斐波那契数列：

    > x <- c(0, 1, 1, 2, 3, 5, 8, 13, 21, 34)

要查看x对象的内容，只需在命令提示符中输入即可：

    > x
     [1]  0  1  1  2  3  5  8 13 21 34

你可以使用括号在对象后面选择向量的子集。这将得到序列的前三个观测值：

    > x[1:3]
    [1] 0 1 1

你可以在括号中的数字前使用负号来排除观测值：

    > x[-5:-6]
    [1]  0  1  1  2  8 13 21 34

为了可视化这个序列，我们将使用 plot() 函数：

    > plot(x)

前一个命令的输出如下：

使用 main=...，xlab=... 和 ylab=... 添加标题和坐标轴标签很容易：

    > plot(x, main = "Fibonacci Sequence", xlab = "Order", ylab = "Value")

前一个命令的输出如下：

我们可以用大量的函数在 R 中转换一个向量。在这里，我们将创建一个新的对象 y，它是 x 的*方根：

    > y <- sqrt(x)

    > y
    [1] 0.000000 1.000000 1.000000 1.414214 1.732051 2.236068  2.828427
    [8] 3.605551 4.582576 5.830952

在这里，重要的是要指出，如果你不确定函数中可以使用什么语法，那么在它前面使用 ? 将会弹出该主题的帮助。试试看！

    > ?sqrt

这将打开函数的帮助。通过创建 x 和 y，可以生成一个散点图：

    > plot(x, y)

以下为前一个命令的输出：

现在，让我们看看创建另一个常量对象。然后，我们将使用这个对象作为标量并将其乘以 x 向量，创建一个新的向量 x2：

    > z <- 3

    > x2 <- x * z

    > x2
     [1]   0   3   3   6   9  15  24  39  63 102

R 允许你执行逻辑测试。例如，让我们测试一个值是否小于另一个值：

    > 5 < 6
    [1] TRUE

    > 6 < 5
    [1] FALSE

在第一种情况下，R 返回 TRUE，在第二种情况下，FALSE。如果你想找出一个值是否等于另一个值，那么你会使用两个等号（一个相等测试）。记住，等号赋值而不测试相等。这里有一个例子，我们想看看我们创建的斐波那契数列中的任何值是否等于零：

    > x == 0
     [1]  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE

输出提供了一个列表，我们可以清楚地看到 x 向量的第一个值确实是零。简而言之，R 的关系运算符 <=, <, ==, >, >=, 和 != 分别代表小于等于，小于，等于，大于，大于等于，和不等。

我们应该讨论几个函数，即 rep() 和 seq()，它们在创建自己的向量时很有用。例如，rep(5, 3) 会将值 5 复制三次。它也适用于字符串：

    > rep("North Dakota Hockey, 2016 NCAA Division 1 Champions", times=3)
    [1] "North Dakota Hockey, 2016 NCAA Division 1 Champions"
    [2] "North Dakota Hockey, 2016 NCAA Division 1 Champions"
    [3] "North Dakota Hockey, 2016 NCAA Division 1 Champions"

为了演示 seq()，假设我们想创建一个从 0 到 10，by = 2 的数字序列。那么代码如下：

    > seq(0, 10, by = 2)
    [1]  0  2  4  6  8 10

数据框和矩阵

现在，我们将创建一个数据框，它是一组变量（向量）。我们将创建一个包含 1，2 和 3 的向量，以及另一个包含 1，1.5 和 2.0 的向量。一旦完成，rbind() 函数将允许我们合并行：

    > p <- seq(1:3)

    > p
    [1] 1 2 3

    > q = seq(1, 2, by = 0.5)

    > q
    [1] 1.0 1.5 2.0

    > r <- rbind(p, q)

    > r
      [,1] [,2] [,3]
    p    1  2.0    3
    q    1  1.5    2

结果是一个包含两行，每行三个值的列表。你可以始终使用 str() 函数确定你的数据结构，在这个例子中，它显示我们有两个列表，一个名为 p，另一个名为 q：

    > str(r)
     num [1:2, 1:3] 1 1 2 1.5 3 2
     - attr(*, "dimnames")=List of 2
      ..$ : chr [1:2] "p" "q"
      ..$ : NULL

现在，让我们使用 cbind() 将它们作为列组合起来：

    > s <- cbind(p, q)

    > s
         p   q
    [1,] 1 1.0
    [2,] 2 1.5
    [3,] 3 2.0

要将它们放入数据框中，请使用 data.frame() 函数。之后，检查结构：

    > s <- data.frame(s)

    > str(s)
    'data.frame':3 obs. of  2 variables:
     $ p: num  1 2 3
     $ q: num  1 1.5 2

现在我们有一个数据框(s)，它有两个变量，每个变量有三个观测值。我们可以使用names()更改变量的名称：

    > names(s) <- c("column 1", "column 2")

    > s
      column 1 column 2
    1        1      1.0
    2        2      1.5
    3        3      2.0

让我们尝试使用as.matrix()将这个内容放入矩阵格式。在某些包中，R 要求在数据框上进行分析，但在其他包中则要求使用矩阵。你可以根据需要在这两者之间切换：

    > t <- as.matrix(s)

    > t
         column 1 column 2
    [1,]        1      1.0
    [2,]        2      1.5
    [3,]        3      2.0

你可以做的事情之一是检查一个特定值是否在矩阵或数据框中。例如，我们想知道第一个观测值和第一个变量的值。在这种情况下，我们需要在括号中指定第一行和第一列，如下所示：

    > t[1,1]
    column 1 
           1

假设你想查看第二个变量（列）中的所有值。那么，只需留空行，但记得在你想查看的列（s）之前使用逗号：

    > t[,2]
    [1] 1.0 1.5 2.0

相反，假设我们只想查看前两行。在这种情况下，只需使用冒号符号：

    > t[1:2,]
         column 1 column 2
    [1,]        1      1.0
    [2,]        2      1.5

假设你有一个包含 100 个观测值和 10 个变量的数据框或矩阵，并且你想要创建一个包含前70个观测值和变量1、3、7、8、9和10的子集。这会是什么样子？

好吧，使用冒号、逗号、连接函数和括号，你可以简单地做以下操作：

    > new <- old[1:70, c(1,3,7:10)]

注意你可以轻松地操作你想要的观测值和变量。你也可以轻松地排除变量。比如说，我们只想排除第一个变量；那么你可以使用负号对第一个变量进行以下操作：

    > new <- old[, -1]

在 R 中，这种语法对于基本的数据操作非常强大。在主要章节中，我们还将介绍更多高级的数据操作技术。

创建汇总统计量

现在，我们将介绍一些关于集中趋势、离散度和简单图表的基本度量。我们将首先解决的问题是如何处理 R 在计算中的缺失值？为了查看会发生什么，创建一个包含缺失值（R 语言中的NA）的向量，然后使用sum()计算向量的值：

    > a <- c(1, 2, 3, NA)

    > sum(a)
    [1] NA

与 SAS 不同，SAS 会求和所有非缺失值，而 R 不会求和所有非缺失值，而是简单地返回NA，表示至少有一个值是缺失的。现在，我们可以创建一个新的向量，删除缺失值，但你也可以包含用于排除任何缺失值的语法na.rm = TRUE：

    > sum(a, na.rm = TRUE)
    [1] 6

存在函数可以识别向量的集中趋势和离散度的度量：

    > data <- c(4, 3, 2, 5.5, 7.8, 9, 14, 20)

    > mean(data)
    [1] 8.1625

    > median(data)
    [1] 6.65

    > sd(data)
    [1] 6.142112

    > max(data)
    [1] 20

    > min(data)
    [1] 2

    > range(data)
    [1]  2 20

    > quantile(data)
    0%   25%   50%   75%  100% 
    2.00  3.75  6.65 10.25 20.00

summary()函数可用，包括mean、median和quartile值：

    > summary(data)
    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
      2.000   3.750   6.650   8.162  10.250  20.000

我们可以使用图表来可视化数据。这里的基线图表将是barplot，然后我们将使用abline()来包含mean和median。由于默认线条是实线，我们将使用lty = 2创建一个虚线来区分median和mean：

    > barplot(data)

    > abline(h = mean(data))

    > abline(h = median(data), lty = 2)

上述命令的输出如下：

有许多函数可用于生成不同的数据分布。在这里，我们可以查看一个用于均值为零、标准差为 1 的正态分布的函数，使用 rnorm() 创建 100 个数据点。然后我们将绘制这些值，并绘制直方图。此外，为了重复结果，请确保使用 set.seed() 使用相同的随机种子：

    > set.seed(1)

    > norm = rnorm(100)

这是 100 个数据点的分布图：

    > plot(norm)

以下是指令的输出：

最后，使用 hist(norm) 生成直方图：

    > hist(norm)

以下是指令的输出：

安装和加载 R 包

我们之前讨论了如何使用 install() 函数安装 R 包。为了使用已安装的包，你还需要将其加载到 R 环境中才能使用。让我们再次进行操作，首先是 RStudio 中的安装，然后是加载包。查找并点击包标签。你应该会看到类似以下内容：

现在，让我们安装 R 包 xgboost。点击安装图标，在弹出窗口的包部分输入包名：

点击安装按钮。一旦包完全安装，命令提示符将返回。为了加载包以便使用，只需要 library() 函数：

    > library(xgboost)

通过这种方式，你现在可以使用包中内置的函数了。

使用 dplyr 进行数据操作

在过去几年里，我越来越多地使用 dplyr 来操作和总结数据。它比使用基础函数更快，允许你串联函数，并且一旦熟悉它，就有更用户友好的语法。根据我的经验，只需要几个函数就能完成大部分数据操作需求。按照上述说明安装包，然后将其加载到 R 环境中。

 > library(dplyr)

让我们探索 R 基础包中可用的 iris 数据集。其中两个最有用的函数是 summarize() 和 group_by()。在下面的代码中，我们看到如何生成按 Species 分组的 Sepal.Length 均值的表格。我们将均值放入的变量将被命名为 average。

 > summarize(group_by(iris, Species), average = mean(Sepal.Length))
 # A tibble: 3 X 2
 Species average
 <fctr>   <dbl>
 1     setosa   5.006
 2 versicolor   5.936
 3  virginica   6.588

有许多汇总函数：n（数量）、n_distinct（唯一数量）、IQR（分位数范围）、min（最小值）、max（最大值）、mean（均值）和median（中位数）。

另一个帮助你和其他人阅读代码的工具是管道操作符 %>%。使用管道操作符，你可以将函数串联起来，而不是将它们包裹在彼此内部。你从想要使用的 dataframe 开始，然后将函数串联起来，第一个函数的值/参数传递给下一个函数，依此类推。这就是我们之前如何使用管道操作符来产生相同结果的方法。

 > iris %>% group_by(Species) %>% summarize(average = 
      mean(Sepal.Length))
 # A tibble: 3 X 2
 Species average
 <fctr>   <dbl>
 1     setosa   5.006
 2 versicolor   5.936
 3  virginica   6.588

distinct() 函数允许我们查看变量中的唯一值。让我们看看在 Species 中存在哪些不同的值。

 > distinct(iris, Species)
 Species
 1     setosa
 2 versicolor
 3  virginica

使用 count() 函数将自动对变量的每个级别进行计数。

 > count(iris, Species)
 # A tibble: 3 X 2
 Species     n
 <fctr> <int>
 1     setosa    50
 2 versicolor    50
 3  virginica    50

基于匹配条件选择特定行怎么办？为此我们有 filter(). 让我们选择所有 Sepal.Width 大于 3.5 的行并将它们放入一个新的数据框中：

 > df <- filter(iris, Sepal.Width > 3.5)

让我们看看这个数据框，但首先我们想要按 Petal.Length 的降序排列值：

 > df <- arrange(iris, desc(Petal.Length))
 > head(df)
 Sepal.Length Sepal.Width Petal.Length Petal.Width   Species
 1          7.7         2.6          6.9         2.3 virginica
 2          7.7         3.8          6.7         2.2 virginica
 3          7.7         2.8          6.7         2.0 virginica
 4          7.6         3.0          6.6         2.1 virginica
 5          7.9         3.8          6.4         2.0 virginica
 6          7.3         2.9          6.3         1.8 virginica

好的，我们现在想要选择感兴趣的变量。这是通过 select() 函数完成的。接下来，我们将创建两个数据框，一个包含以 Sepal 开头的列，另一个包含 Petal 列和 Species 列--换句话说，列名不是以 Se 开头的。这可以通过在函数中使用这些特定名称来完成；或者，如下所示，使用 starts_with 语法：

 > iris2 <- select(iris, starts_with("Se"))

    > iris3 <- select(iris, -starts_with("Se"))

好的，让我们把它们放在一起。还记得之前的 cbind() 吗？使用 dplyr 你可以使用 bind_cols() 函数，它将它们放入一个数据框中。请注意，就像 cbind() 一样，它将通过位置匹配行。如果你有行名或某些其他键，例如客户 ID 等，你可以使用 left_join() 和 inner_join() 等函数来合并数据。由于我们的行匹配，这个命令将正常工作。

 > theIris <- bind_cols(iris2, iris3)
      head(theIris)
      head(iris)

亲自使用 head() 函数比较 iris 和 iris 的前六行，你会看到它们是完全匹配的。如果你想像我们上面使用 rbind() 那样连接数据，可以使用 bind_rows() 函数。那么，如果我们想看看有多少独特的 Sepal.Width 测量值呢？回想一下，数据集中总共有 150 个观测值。我们已经使用了 distinct() 和 count()。此代码将只给出唯一值的数量，即 23:

 > summarize(iris, n_distinct(Sepal.Width))
 n_distinct(Sepal.Width)
 1                     23

在几乎任何大量数据中，都存在重复观测值，或者它们是通过复杂的连接创建的。使用 dplyr 的 dedupe() 非常简单。例如，假设我们只想创建一个包含 Sepal.Width 唯一值的 dataframe，并希望保留所有列。这将有效：

 > dedupe <- iris %>% distinct(Sepal.Width, .keep_all = T)
 > str(dedupe)
 'data.frame': 23 obs. of 5 variables:
 $ Sepal.Length: num 5.1 4.9 4.7 4.6 5 5.4 4.6 4.4 5.4 5.8 ...
 $ Sepal.Width : num 3.5 3 3.2 3.1 3.6 3.9 3.4 2.9 3.7 4 ...
 $ Petal.Length: num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.4 1.5 1.2 ...
 $ Petal.Width : num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.2 ...
 $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 
     1 1 1 1 1

注意，我使用了管道操作符将 iris 连接到函数，并在 distinct() 中指定 .keep_all = T，这样所有列都会出现在新的数据框中；否则只有 Sepal.Width 会进入。

这就是了。如果你想提高在 R 中数据整理的效率，不妨试试 dplyr。

摘要

本附录的目的是让 R 语言的新手学习编程语言的基础知识，并为书中代码的编写做好准备。这包括学习如何安装 R 和 RStudio 以及创建对象、向量和矩阵。然后，我们探讨了数学和统计函数的一些应用。我们介绍了如何在 RStudio 中使用 R 安装和加载包。最后，我们探讨了dplyr在高效操作和总结数据方面的强大功能。在整个附录中，包括了基础和示例的绘图语法。虽然这个附录不会让你成为 R 语言的专家，但它会帮助你跟上书中的示例。

第十六章：来源

Granger, G.W.J., Newbold, P., (1974), 经济计量学中的伪回归, 计量经济学杂志, 1974 (2), 111-120

Hechenbichler, K., Schliep, K.P., (2004), 加权 k-最*邻和有序分类, 统计学研究所, Sonderforschungsbereich 386, 论文 399. epub.ub.uni-muenchen.de/

Hinton, G.E., Salakhutdinov, R.R., (2006), 使用神经网络降低数据维度, 科学, 2006 年 8 月, 313(5786):504-7

James, G., Witten, D., Hastie, T., Tisbshirani, R. (2013), 统计学习导论, 1st ed. 纽约: Springer

Kodra, E., (2011), 探索二氧化碳全球*均观测时间序列与温度之间的格兰杰因果性, 理论与应用气候学, Vol. 104 (3), 325-335

Natekin, A., Knoll, A., (2013), 梯度提升机教程, 神经机器人学前沿, 2013; 7-21. www.ncbi.nlm.nih.gov/pmc/articles/PMC3885826/

Tibshirani, R., (1996), 通过 LASSO 进行回归收缩和选择, 皇家统计学会 B 系列杂志, 58(1), 267-288

Triacca, U., (2005), 格兰杰因果分析是否适合研究二氧化碳大气浓度与全球地表空气温度之间的关系*?, 理论与应用气候学, 81 (3), 133-135

Toda, H., Yamamoto, T., (1995), 具有可能是积分过程的向量自回归中的统计推断, 计量经济学杂志, 1995, (66), issue 1-2, 225-250

posted @ 2025-09-04 14:13 绝不原创的飞龙阅读(1) 评论(0) 收藏举报

刷新页面返回顶部

龙哥盟

掠夺·扩张·投机·博弈

精通-R-机器学习第二版-全-

精通 R 机器学习第二版（全）

前言

本书涵盖的内容

您需要为这本书准备的东西

这本书面向的对象

习惯用法

读者反馈

客户支持

下载示例代码

下载本书的彩色图像

错误清单

海盗行为

问题

第一章：成功的过程

流程

商业理解

确定商业目标

评估情况

确定分析目标

制定项目计划

数据理解

数据准备

建模

评估

部署

算法流程图

摘要

第二章：线性回归——机器学习的阻挡和冲撞

单变量线性回归

商业理解

多元线性回归

业务理解

数据理解和准备

建模与评估

其他线性模型考虑因素

定性特征

交互项

摘要

第三章：逻辑回归和判别分析

分类方法和线性回归

逻辑回归

业务理解

数据理解和准备

建模和评估

逻辑回归模型

带有交叉验证的逻辑回归

判别分析概述

判别分析应用

多变量自适应回归样条（MARS）

模型选择

摘要

第四章：线性模型中的高级特征选择

正则化概述

岭回归

LASSO

弹性网络

商业案例

商业理解

数据理解和准备

建模与评估

最佳子集

Ridge 回归

LASSO

弹性网络

使用 glmnet 进行交叉验证

模型选择

正则化和分类

逻辑回归示例

摘要

第五章：更多分类技术 - K-最*邻和支持向量机

K-最*邻

支持向量机

商业案例

商业理解

数据理解和准备

建模和评估

KNN 建模