R-编程示例-全-

R 编程示例（全）

原文：zh.annas-archive.org/md5/720c3079084c51fa0922dbc1f6de2cfc

译者：飞龙

协议：CC BY-NC-SA 4.0

前言

在数据日益重要的世界中，数据分析师、科学家和商业人士需要工具来高效地分析和处理大量数据。本书是我迄今为止所学知识的尝试性传授，以便您能迅速成为一个高效且有效的 R 程序员。阅读本书将帮助您了解如何使用 R 解决复杂问题，避免我犯过的某些错误，并教授您在各种情境下都有用的实用技术。在这个过程中，我希望向您展示，尽管 R 有一些不寻常的方面，但它是一种优雅且强大的语言，非常适合数据分析、统计学以及复杂系统。

阅读本书后，您将熟悉 R 的基础知识以及一些高级特性。您将了解数据结构，并知道如何高效地处理它们。您还将了解如何设计高效运行的复杂系统，以及如何通过 Web 应用程序使这些系统对他人可用。在较低层面，您将了解如何使用面向对象编程、函数式编程和响应式编程，以及在这些范式下哪些代码可能写得更好。您将学习如何使用 R 提供的各种前沿工具来开发软件，如何识别性能瓶颈，以及如何修复它们，可能还会使用其他编程语言如 Fortran 和 C++。最后，您将能够阅读和理解大多数 R 代码，并为他人代码提供反馈。

本书涵盖内容

第一章，R 简介，涵盖了您理解其余示例所需的 R 基础知识。它并不是要提供一个详尽的 R 介绍。相反，它的目的是为您提供快速开始书中包含的三个示例以及我接下来要介绍的基本概念和技术。

本书通过三个示例展示了 R 的广泛功能。第一个示例展示了如何使用描述性统计和线性模型分析投票，并在第二章，使用描述性统计理解投票和第三章，使用线性模型预测投票中呈现。

第二章, 使用描述性统计理解投票，展示了如何通过编程创建数百个图表来直观地识别数据中的关系。它展示了如何创建直方图、散点图、相关矩阵，以及如何执行主成分分析（PCA）。

第三章，使用线性模型预测投票，展示了如何编程地找到一组数据最佳预测线性模型，以及根据不同的成功指标。它还展示了如何检查模型假设，以及如何使用交叉验证来提高结果的可信度。

第二个示例展示了如何模拟数据，可视化它，分析其文本组件，并使用它创建自动演示文稿。

第四章，模拟销售数据和数据库操作，展示了如何设计数据架构和模拟各种类型的数据。它还展示了如何将真实文本数据与模拟数据集成，以及如何使用 SQL 数据库更有效地访问它。

第五章，使用可视化进行销售沟通，展示了如何制作从基础到高级的图表，以及高度定制的图表。它还展示了如何创建动态 3D 图表和交互式地图。

第六章，通过文本分析理解评论，展示了如何逐步使用自然语言处理（NLP）技术以及情感分析进行文本分析。

第七章，开发自动演示文稿，展示了如何将前几章的结果组合起来，使用 knitr 和 R Markdown 等工具创建可以自动更新最新数据的演示文稿。

最后，第三个示例展示了如何设计和开发从加密货币市场检索实时数据的高级面向对象系统，以及如何优化实现和围绕这些系统构建网络应用。

第八章，面向对象系统跟踪加密货币，介绍了当结合使用时产生复杂系统的基本面向对象技术。此外，它还展示了如何与 R 中最常用的三个对象模型 S3、S4 和 R6 一起工作，以及如何使它们协同工作。

第九章，实现高效的简单移动平均，展示了如何迭代改进简单移动平均（SMA）的实现，从被认为是糟糕的代码开始，一直到使用并行化和将任务委托给 Fortran 和 C++语言的先进优化技术。

第十章，使用仪表板添加交互性，展示了如何将前两章构建的内容包装起来，通过 Shiny 包使用响应式编程来制作现代网络应用。

附录，所需软件包，展示了如何安装复制书中示例所需的内部和外部软件。具体来说，它将指导你完成 Linux 和 macOS 的安装过程，但 Windows 遵循类似的原则，不应引起任何问题。

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

这本书是在 Linux 环境下编写的（具体为 Ubuntu 17.10），并且也在 macOS High Sierra 上进行了测试。尽管它没有在 Windows 计算机上测试，但书中展示的所有 R 代码都应该在 Windows 上运行良好。唯一的实质性区别是，当我向你展示如何使用终端执行任务时，将使用 bash 终端，这是 Linux 和 macOS 默认可用的。在 Windows 的情况下，你需要使用 cmd.exe 终端，你可以在网上找到很多相关信息。请记住，如果你使用的是 Windows 计算机，你应该准备好进行一些额外的研究来复制相同的功能，但你应该不会遇到太多麻烦。

在附录中，我会向你展示如何安装复制本书中示例所需的软件。我会指导你如何在 Linux 和 macOS（特别是 Ubuntu 17.10 和 High Sierra）上这样做。如果你使用的是 Windows，同样的原则适用，但具体细节可能略有不同。然而，我相信在任何情况下都不会太难。

为了能够执行这本书中的所有代码，你需要满足两种类型的要求：外部和内部。R 语言之外的应用软件，我称之为外部要求。R 语言内部的应用软件，即 R 包，我称之为内部要求。我在附录中会指导你如何安装这两类软件。

这本书面向的对象

这本书是为那些希望使用 R 语言开发软件的人而写的。你不需要成为专家或专业程序员就能跟随这本书学习，但你确实需要对学习 R 语言的工作原理感兴趣。我的希望是，这本书通过提供一些实用的例子，可以帮助从初学者到高级用户更好地理解 R 语言，这些例子可能以你之前未曾想到的方式帮助你。

我假设读者具备基本的编程、数学和统计知识，因为书中会有多个部分使用到这些学科的概念，而这些概念不会进行详细的解释。如果你在任何编程语言中自己编写过程序，了解基本的线性代数和统计学，并且知道线性回归是什么，你就拥有了理解这本书所需的一切。

这本书是为处于各种环境和具有不同背景的人编写的。例如，如果你是受雇于需要你定期进行数据处理以生成报告的组织分析师，并且你需要开发程序来自动化此类任务，这本书适合你。如果你是一位希望使用当前技术、将它们结合起来并开发测试它们的工具的学术研究人员，这本书适合你。如果你是一位寻找利用高级 R 语言特性的方法的职业程序员，这本书适合你。最后，如果你正在为数据在未来变得极其重要的未来做准备（它已经如此），这本书适合你。

惯例

在这本书中，你会发现许多文本样式，用于区分不同类型的信息。以下是一些这些样式的示例及其含义的解释。文本中的代码单词、数据库表名、文件夹名、文件名、文件扩展名、路径名、虚拟 URL、用户输入和 Twitter 用户名如下所示：“我们可以通过使用read.csv()函数将data.csv文件的 内容加载到数据框中（这是使用 CSV 格式数据的直观结构）。”

代码块设置如下：

data <- read.csv("./data_brexit_referendum.csv") 
data[data$Leave == -1, "Leave"] <- NA 

当我们希望引起你对代码块中特定部分的注意时，相关的行或项目将以粗体显示：

sum(is.na(data$Leave))
#> [1] 267

任何命令行输入或输出都如下所示：

$ sudo service mysql start

新术语和重要词汇以粗体显示。屏幕上显示的单词，例如在菜单或对话框中，在文本中如下所示：“现在我们的代码已经准备好了，我们应该在“数据概览”选项卡中看到一个表格。”

警告或重要注意事项如下所示。

技巧和窍门如下所示。

读者反馈

我们始终欢迎读者的反馈。告诉我们你对这本书的看法——你喜欢什么或不喜欢什么。读者反馈对我们来说很重要，因为它帮助我们开发出你真正能从中获得最大收益的标题。要发送一般反馈，请简单地发送电子邮件至feedback@packtpub.com，并在邮件主题中提及书籍的标题。如果你在某个主题领域有专业知识，并且你对撰写或为书籍做出贡献感兴趣，请参阅我们的作者指南www.packtpub.com/authors。

客户支持

现在你已经是 Packt 图书的骄傲拥有者，我们有一些东西可以帮助你从你的购买中获得最大收益。

下载示例代码

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

1. 使用您的电子邮件地址和密码登录或注册我们的网站。

2. 将鼠标指针悬停在顶部的“支持”选项卡上。

3. 点击“代码下载与勘误”。

4. 在搜索框中输入书籍名称。

5. 选择您想要下载代码文件的书籍。

6. 从下拉菜单中选择您购买此书的来源。

7. 点击“代码下载”。

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

• Windows 上的 WinRAR / 7-Zip

• Mac 上的 Zipeg / iZip / UnRarX

• Linux 上的 7-Zip / PeaZip

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

下载本书的颜色图像

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

勘误

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

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

侵权

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

请通过copyright@packtpub.com与我们联系，并提供涉嫌侵权材料的链接。我们感谢您在保护我们作者和我们为您提供有价值内容的能力方面的帮助。

咨询

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

第一章：R 简介

在数据变得越来越重要的世界里，商人和科学家需要工具来高效地分析和处理大量数据。R 是近年来在数据处理、统计分析和数据科学中越来越受欢迎的工具之一，尽管 R 的根源在学术界，但现在它被广泛应用于各个行业和地理区域的组织中。

本章涵盖的一些重要主题如下：

• R 的历史以及为什么它被设计成这样

• 解释器和控制台是什么以及如何使用它们

• 如何处理 R 的基本数据类型和数据结构

• 如何通过不同的方式使用函数来划分工作

• 如何使用控制结构引入复杂的逻辑

R 是什么以及它不是什么

当涉及到选择统计计算软件时，很难反对 R。谁会不喜欢一个高质量、跨平台、开源的统计软件产品呢？它有一个交互式控制台用于探索性工作。它可以作为脚本语言运行以复制过程。它内置了许多统计模型，因此你不必重新发明轮子，但当基础工具集不足时，你可以访问丰富的外部包生态系统。而且，它是免费的！难怪 R 在数据时代成为了宠儿。

R 的灵感来源 – S 语言

R 是由约翰·查普曼在 AT&T 开发的 S 统计语言的灵感来源。S 这个名字是对在 AT&T 同样开发的一个字母命名的编程语言的暗示，那就是著名的 C 语言。R 是由罗斯·伊哈卡和罗伯特·詹宁斯在 1991 年奥克兰大学统计学系创建的。

S 的一般哲学为 R 语言的本身设计奠定了基础，许多来自其他编程语言的程序员可能会觉得它有些奇怪和令人困惑。特别是，重要的是要认识到 S 是为了使数据分析尽可能容易而开发的。

“我们希望用户能够从一个交互式环境中开始，在那里他们不会自觉地考虑编程。然后随着他们的需求变得更加明确，他们的复杂性增加，他们应该能够逐渐过渡到编程，当语言和系统方面变得更加重要时。”

– 约翰·查普曼

这里关键的部分是从分析师到开发者的转变。他们希望构建一种能够轻松服务于这两种类型用户的语言。他们希望构建一种既适合通过命令行进行交互式数据分析，又可用于编程复杂系统（如传统编程语言）的语言。

这本书的结构如此安排并非巧合。我们将首先进行数据分析，然后我们将逐步过渡到开发一个完整且复杂的系统，该系统在顶部有一个网络应用程序用于信息检索。

R 是一个高质量的统计计算系统

当涉及到编程能力、复杂系统开发、图形制作和社区生态系统时，R 与商业产品相比，往往更具有可比性，甚至更优越。统计学家和机器学习研究人员，以及许多其他与数据相关的学科研究人员，通常会发布 R 包来伴随他们的出版物。这转化为公众可以立即访问最新的统计技术和实现。无论您试图开发什么模型或图形，都有可能有人已经尝试过，如果没有，至少您可以从他们的努力中学习。

R 是一种灵活的编程语言

正如我们所看到的，除了提供统计工具外，R 还是一种通用编程语言。您可以使用 R 来扩展其自身功能，自动化使用复杂系统的流程，以及许多其他事情。它融合了其他面向对象编程语言的特点，并为函数式编程提供了坚实的基础，这对于解决数据分析中的许多挑战非常合适。R 允许用户编写强大、简洁和描述性的代码。

R 是自由的，如同自由和如同免费啤酒

在许多方面，一种语言之所以成功，是因为它创建了一个平台，许多人可以通过这个平台创造新事物，而 R 在这方面已经证明是非常成功的。S 语言的一个关键限制是它仅限于商业软件包中，但 R 是自由软件。自由如同自由，也如同免费啤酒。

R 的主要源代码的版权由 R 基金会持有，并发布在 通用公共许可证（GPL）下。根据自由软件基金会（www.fsf.org/），使用自由软件（自由如同自由）您被授予以下四个自由：

• 自由 0：为任何目的运行程序

• 自由 1：研究程序的工作方式并将其适应您的需求

• 自由 2：重新分发副本，以便您可以帮助您的邻居

• 自由 3：改进程序并将您的改进发布给公众

这些自由使得 R 能够发展出强大的多产社区，其中包括世界级的统计学家和程序员以及许多志愿者，他们帮助改进和扩展了该语言。它们还允许 R 在所有流行的操作系统上开发和维护，并使个人和组织能够轻松使用，可能以其他人可以复制其结果的方式分享他们的发现。这就是自由软件的力量。

R 不擅长的地方

没有编程语言或系统是完美的。R 当然有一些缺点，最常见的是它可能非常慢（如果不正确使用）。记住，R 实质上基于 40 年前的技术，追溯到贝尔实验室开发的原始 S 系统。因此，它的许多不完美之处源于它没有为我们现在所处的数据时代做出预期。当 R 诞生时，磁盘和 RAM 非常昂贵，互联网才刚刚起步。大规模数据分析和高性能计算的概念是罕见的。

快进到现代，硬件成本只是过去的一小部分，计算能力在网上只需几分钱，每个人都对收集和分析大规模数据感兴趣。这种数据分析的激增将 R 的两个基本限制推到了前台，即它是单线程和内存受限的。这两个特性极大地减慢了它的速度。此外，R 是一种解释型动态类型语言，这可能会使其变得更慢。最后，R 有对象不可变性和多种实现面向对象编程的方式，这两者都可能使人们，尤其是那些来自其他语言的人，在不知道如何处理它们的情况下难以编写高质量的代码。你应该知道，本段中提到的所有特性都在第九章，“实现高效的简单移动平均”中得到了解决。

在 R 中，一把双刃剑是，大多数用户并不将自己视为程序员，他们更关心结果而不是过程（这并不一定是个坏事）。这意味着你可以在网上找到的大部分 R 代码都是没有考虑到优雅、速度或可读性的，因为大多数 R 用户不会修订他们的代码来解决这些缺点。这种情况渗透到那些零散且未经严格测试的代码中，进而产生了许多在使用低质量包时必须考虑的边缘情况。你应该牢记这一点。

比较 R 与其他软件

我写这一节的目的并不是要全面比较 R 与其他软件，而是简单地指出 R 的一些最显著特性。如果你能的话，我鼓励你自己测试其他软件，以便你能够亲身体验到可能最适合当前工作的最佳工具。

与 SAS、Stata、SPSS 以及甚至 Python 等其他统计软件相比，R 最显著的特点是它拥有大量的可用包。在撰写本文时，综合 R 档案网络（CRAN）(cran.r-project.org/)中已发布近 12,000 个包，而且这还不包括在其他地方发布的包，例如 Git 仓库。这使得 R 拥有一个非常庞大的社区和大量用于数据分析的工具，这些工具涵盖了金融、数学、机器学习、高性能计算等多个领域。

除了 Python 之外，R 在编程能力上比 SAS、Stata、SPSS 都要强，在某些方面甚至比 Python 更强（例如，在 R 中，你可以使用不同的对象模型）。然而，高效且有效地使用 R 需要使用代码，这对一些人来说意味着有一个陡峭的学习曲线，而 Stata 和 SPSS 具有图形用户界面，通过点选向导引导用户完成许多任务。在我看来，这种手把手的教学虽然对初学者很有帮助，但很快就会成为那些想要成为中级或高级用户的人的一个重要限制，这正是编程的优势所在。

R 在所有现有软件中拥有最好的图形系统之一。在 R 中生成图形最流行的包是ggplot2包，我们将在本书中广泛使用它，但还有许多其他优秀的绘图包。这个包允许通过其图形语法修改图形的几乎每个方面，并且远远优于我在 SPSS、Stata、SAS 甚至 Python 中看到过的任何东西。

R 是一个伟大的工具，但它并不是适合所有事情的合适工具。如果你想要进行数据分析，但又不想投入时间去学习编程，那么 SAS、Stata 或 SPSS 等软件可能更适合你。如果你想要开发易于集成到更大系统中的分析软件，并且需要连接到各种接口，那么 Python 可能更适合这项工作。然而，如果你想要进行大量的复杂数据分析绘图，并且你将大部分时间都花在这些领域，那么 R 是一个很好的选择。

解释器和控制台

正如我之前提到的，R 是一种解释型语言。当你将表达式输入 R 控制台或在操作系统的终端中执行 R 脚本时，一个名为解释器的程序会解析并执行代码。其他解释型语言的例子包括 Lisp、Python 和 JavaScript。与 C、C++和 Java 不同，R 不需要你在执行之前显式地编译你的程序。

所有 R 程序都是由一系列表达式组成的。解释器首先解析每个表达式，在适当的地方用对象替换符号，然后评估它们，最后返回结果对象。我们将在接下来的章节中定义这些概念，但你应该明白，这是所有 R 程序通过的基本过程。

R 控制台是使用 R 的最重要的工具，可以将其视为解释器的一个包装器。控制台是一个允许你直接将表达式输入到 R 中并查看其响应的工具。解释器将读取表达式，如果有错误，则返回结果或错误消息。当你通过控制台执行表达式时，解释器会自动将对象传递给 print() 函数，这就是为什么你可以在你的表达式下方看到结果打印出来的原因（我们将在后面更多地介绍函数）。

如果你之前使用过命令行（例如，Linux 或 macOS 中的 bash 或 Windows 中的 cmd.exe）或具有交互式解释器的语言，如 Lisp、Python 或 JavaScript，那么控制台应该看起来很熟悉，因为它只是一个命令行界面。如果不熟悉，不要担心。命令行界面是易于使用的工具。它们是接收代码并返回对象的程序，这些对象的打印表示形式是你执行代码下方看到的。

当你启动 R 时，你会看到一个带有 R 控制台的窗口。在控制台中，你会看到如下所示的消息。此消息显示一些基本信息，包括你正在运行的 R 版本、许可信息、有关如何获取帮助的提示以及命令提示符。

注意，在这种情况下，R 的版本是 3.4.2。本书中开发的代码将假设这个版本。如果你有不同的版本，但如果你遇到一些问题，这可能是一个你可能想要调查的原因。

你应该注意，默认情况下，R 将在控制台最后一行的开头显示一个大于号（>），这表示它已准备好接收命令。由于 R 正在提示你输入内容，这被称为命令提示符。当你看到大于符号时，R 能够接收更多的表达式作为输入。当你看不到时，可能是因为 R 正在处理你发送的内容，你应该等待它完成后再发送其他内容。

Enter key. When you do, you will see a [1] 3 which is the output you received back from R. Go ahead and execute various arithmetic expressions to get a feel for the console:

> 1 + 2
[1] 3

注意每个返回值旁边伴随的 [1]。它在那里是因为结果实际上是一个向量（一个有序集合）。[1] 表示显示在该行中的第一个项目的索引是 1（在这种情况下，我们的结果向量中只有一个值）。

最后，您应该知道控制台提供了查看先前命令的工具。您可能会发现上箭头键和下箭头键是最有用的。通过按这些键，您可以滚动查看以前的命令。上箭头键让您查看较早的命令，而下箭头键让您查看较晚的命令。如果您想要对以前的命令进行轻微的修改，或者需要纠正错误，您可以使用这些键轻松地做到这一点。

与 R 高效工作的工具

在本节中，我们讨论了在用 R 工作时将帮助我们的工具。

选择一个集成开发环境（IDE）或强大的编辑器

为了高效地进行代码开发，您可能想要尝试一个更强大的编辑器或一个集成开发环境（IDE）。R 最流行的 IDE 是 RStudio（www.rstudio.com/）。它提供了一套令人印象深刻的特性，使得与 R 的交互变得更加容易。如果您是 R 的新手，并且对编程也较陌生，这可能是您应该采取的方法。如图所示，它将控制台（右侧）包裹在一个更大的应用程序中，该应用程序提供了许多功能，在这种情况下，它显示的是帮助系统（左侧）。此外，RStudio 还提供了标签来导航文件、浏览已安装的包、可视化绘图等功能，以及在上拉菜单下拉选项中提供的大量配置选项。

在本书的整个过程中，我们不会使用 RStudio 提供的任何功能。我将向您展示的是纯 R 功能。我决定这样进行是为了确保本书对任何 R 程序员都有用，包括那些不使用 RStudio 的人。对于 RStudio 用户来说，这意味着可能有一些更简单的方法来完成我将展示的一些任务，而不是编写几行代码，您只需点击一些按钮即可。如果您喜欢这样做，我鼓励您查看 RStudio 网站上提供的优秀 RStudio Essential 网络研讨会，网址为www.rstudio.com/resources/webinars/?wvideo=lxel3j2kos，以及斯坦福大学的 R 入门，RStudio 版（web.stanford.edu/class/stats101/intro/intro-lab01.html）。

您应该小心避免将 R 称为 RStudio 的常见错误。由于许多人通过 RStudio 接触到了 R，他们认为 RStudio 实际上是 R，但这并不是事实。RStudio 是围绕 R 的一个包装器，用于扩展其功能，在技术上被称为 IDE。

经验丰富的程序员可能更喜欢使用他们已经熟悉并热爱多年且一直在使用的其他工具。例如，在我的情况下，我更喜欢使用 Emacs (www.gnu.org/software/emacs/) 进行任何编程工作。Emacs 是一个非常强大的文本编辑器，你可以通过使用名为Elisp的编程语言来编程扩展它，使其以你想要的方式工作，Elisp是一种 Lisp 扩展。如果你也使用 Emacs，那么ess包就是你真正需要的所有东西。

如果你打算使用 Emacs，我鼓励你查阅ess包的文档 (ess.r-project.org/Manual/ess.html) 和 Johnson 的题为《Emacs Has No Learning Curve, University of Kansas, 2015》的演示 (pj.freefaculty.org/guides/Rcourse/emacs-ess/emacs-ess.pdf)。如果你使用 Vim、Sublime Text、Atom 或其他类似工具，我确信你也能找到有用的包。

发送到控制台的功能

基础 R 安装提供了我们在上一节中提到的控制台环境。这个控制台实际上是你与 R 一起工作的全部所需，但它很快就会变得繁琐，需要直接将其中的所有内容都输入进去，它可能不是你的最佳选择。为了高效地使用 R，你需要能够尽可能快地进行实验和迭代。这样做将加速你的学习曲线和生产力。

无论你使用什么工具，你需要的关键功能是能够轻松地将代码片段发送到控制台，而无需自己输入，或者从你的编辑器中复制并粘贴到控制台。在 RStudio 中，你可以通过点击代码编辑面板右上角的运行或源按钮来完成此操作。在 Emacs 中，你可以使用 ess-eval-region 命令。

高效的写-执行循环

使用 R 最富有成效的方法之一，尤其是在学习它的时候，是使用写-执行循环，该循环利用了上一节中提到的发送到控制台功能。这将允许你完成两个非常重要的事情：通过小而快速的迭代来开发你的代码，这样你可以看到逐步的进度，直到你达到你寻求的行为，并将你达到的行为保存为你的最终结果，该结果可以使用你用于迭代的源代码文件轻松地重现。R 源代码文件使用.R扩展名。

假设你有一个准备将表达式发送到控制台的源代码文件，通过写-执行循环的基本步骤如下：

1. 使用代码定义你想要实现的行为。

2. 编写实现你所需行为的最少代码。

3. 使用发送到控制台的功能来验证控制台中的结果是否符合你的预期，如果不符，则识别可能的原因。

4. 如果它不是你所期望的，就回到第二步，目的是修复代码，直到它具有预期的行为。

5. 如果它是你所期望的，就回到第二步，目的是通过添加另一部分行为来扩展代码，直到收敛。

当你开始使用它时，这个编写-执行循环将变得像第二本能一样自然，一旦它做到了，你将成为一个更高效的 R 程序员。它将允许你更快地诊断问题，快速尝试几种实现相同行为的方法，以找到最适合你上下文的方法，一旦你有可工作的代码，它也将允许你清理实现，以保持相同的行为但拥有更好的或更易读的代码。

对于经验丰富的程序员来说，这应该是一个熟悉的过程，并且它与 测试驱动开发 (TDD) 非常相似，但不同的是，你不会使用单元测试来自动测试代码，而是在每个迭代中验证控制台中的输出，并且你没有一组测试来重新测试每个迭代。尽管本书中不会使用 TDD，但你绝对可以在 R 中使用它。

我鼓励你使用这个编写-执行循环来处理本书中提供的示例。有时，我们会逐步展示进度，以便你更好地理解代码，但实际上很难展示我开发过程中所经历的所有的编写-执行循环迭代，而你能够获得的大部分知识都来自于这种方式的重现。

在非交互式会话中执行 R 代码

一旦你的代码具有你想要实现的功能，通过交互式会话使用控制台来执行它可能不是最好的方式。在这种情况下，你还有另一个选择，就是告诉你的计算机直接为你执行代码，在一个非交互式会话中。这意味着你将无法在控制台中输入命令，但你将能够配置你的计算机来自动为你执行代码，或者将其集成到更大的系统中，其中 R 只是许多组件之一。这被称为批处理模式。

要在批处理模式下执行代码，你有两种选择：旧的 R CMD BATCH 命令，我们不会探讨它，以及较新的 Rscript 命令，我们将探讨这个。Rscript 是一个可以在你的计算机终端中执行的命令。它接收源代码文件的名称并执行其内容。

在下面的示例中，我们将使用我们在后续章节中将要解释的各种概念，所以如果你现在感觉还没有准备好理解它，请现在随意跳过，稍后再回来。

假设你有一个名为 greeting.R 的文件中的以下代码。它通过使用 commandArgs() 函数创建的 args 对象从命令行获取传递给 Rscript 的参数，将相应的值分配给 greeting 和 name 变量，并最终打印包含这些值的向量。

args     <- commandArgs(TRUE)
greeting <- args[1]
name     <- args[2]

print(c(greeting, name))

一旦准备就绪，你可以使用 Rscript 命令从你的终端（而不是 R 控制台）执行它，如下所示。结果显示了传递给它的问候和名称变量值的向量。

当你看到以$符号而不是>符号开始的命令提示符时，这意味着你应该在你的计算机终端中执行该行，而不是在 R 控制台中。

$ Rscript greeting.R Hi John
[1] "Hi" "John"

注意，如果你简单地执行文件而不带任何参数，它们将被作为 NA 值传递，这允许你自定义代码以处理这种情况：

$ Rscript greeting.R
[1] NA NA

这是一个非常简单的例子，但同样的机制可以用来执行更复杂的系统，就像我们在本书的最后一章将要构建的那样，从远程服务器持续检索实时价格数据。

最后，如果你想要提供一个更接近 Python 中的机制，你可能需要查看 optparse 包来创建命令行帮助页面以及解析参数。

如何使用这本书

为了充分利用这本书，你应该自己重新创建书中展示的示例，并确保你详细理解了每个示例的具体作用。如果在某个时候你感到困惑，在网上进行一些搜索以澄清问题并不太难。然而，我强烈建议你查看以下书籍，这些书籍更详细地介绍了本书中的一些概念和想法，并且被认为是 R 程序员的非常好的参考书籍：

• 《R 编程艺术》，阿德勒，奥莱利，2010

• 《R 编程艺术》，马托夫，No Starch Press，2011

• 《高级 R》，威克汉姆，CRC 出版社，2015

• 《数据科学中的 R 编程》，彭，LeanPub，2016

有时，为了澄清某事，你只需要使用 R 的帮助系统。要获取函数的帮助，你可以使用问号符号，如?function_name，但如果你想要搜索某个主题的帮助，你可以使用help.search()函数，如help.search (回归)。如果你知道你感兴趣的主题，但记不起你想要使用的实际函数名，这可能会很有帮助。调用此类功能的一种另一种方式是使用双问号符号，如??回归。

请记住，本书中的主题是相互关联的，而不是线性排列的，这意味着有时会感觉我们在跳跃。当这种情况发生时，是因为可以从不同的角度看待一个主题。这就是为什么，为了充分利用这本书，你应该尽可能在控制台中实验，并使用前面提到的写-执行循环逐步构建代码。如果你只是完全复制显示的代码，你可能会错过一些通过逐步构建系统可以获得的学到的知识。

最后，你应该知道这本书的目的是通过一些相对真实的例子来展示如何使用 R，因此它不会提供太多关于所讨论主题的技术深度或讨论。此外，由于我的目标是让你快速开始使用真实例子，所以在第一章中，我非常简要地解释了 R 的基础知识，只是为了介绍你接下来几章中需要了解的最少知识。因此，你不应该认为本章中提供的解释就足够你理解 R 的基本结构。如果你在寻找对 R 基础的更深入介绍，你可能想看看我们之前提到的参考资料。

使用符号和变量跟踪状态

与大多数编程语言一样，R 允许你给变量赋值并通过名称引用这些对象。在 R 中，你用来引用变量的名称被称为符号。这允许你在需要时保留一些信息。这些变量可以包含 R 中可用的任何类型的对象，甚至在列表中使用时，可以包含它们的组合，正如我们在本章后面的部分将看到的。此外，这些对象是不可变的，但这将是第九章实现高效的简单移动平均的主题。

在 R 中，赋值运算符是 <-，它是一个小于符号（<）后面跟着一个连字符（-）。如果你之前曾与算法伪代码一起工作过，你可能会觉得它很熟悉。你也可以使用单个等号（=）进行赋值，类似于许多其他语言，但我更喜欢坚持使用 <- 运算符。

表达式 x <- 1 的意思是将值 1 赋给 x 符号，这可以被视为一个变量。你也可以反过来赋值，这意味着使用表达式 1 -> x 我们会得到与之前相同的效果。然而，从左到右的赋值很少使用，更多是一种方便的特性，以防你在控制台的一行开头忘记了赋值运算符。

注意，值替换是在将值赋给 z 的时候进行的，而不是在 z 被评估的时候。如果你将以下代码输入到控制台，你可以看到，当 z 第二次被打印时，它仍然具有当它被用来赋值时的 y 的值，而不是之后赋给 y 的值：

x <- 1
y <- 2
z <- c(x, y)
z
#> [1] 1 2

y <- 3
z
#> [1] 1 2

使用像 x、y 和 z 这样的变量名很容易，但它们在真实程序中的使用成本很高。当你使用这样的名字时，你可能非常清楚它们将包含什么值以及如何使用。换句话说，它们对你来说意图是清晰的。然而，当你将代码交给别人或长时间后再次回到它时，这些意图可能不再清晰，这就是隐晦名称可能有害的地方。在真实程序中，你的名称应该是自我描述性的，并能立即传达意图。

若想深入了解关于高质量代码的讨论以及许多其他相关话题，请参阅马丁的杰出著作《Clean Code: A Handbook of Agile Software Craftsmanship, Prentice Hall, 2008》。

R 中的标准对象名称应仅包含字母数字字符（数字和 ASCII 字母）、下划线（_），以及根据上下文，甚至可以包含点（.）。然而，如果你愿意，R 允许你使用非常隐晦的字符串。例如，在下面的代码中，我们展示了如何使用变量 !A @B #C $D %E ^F 的名称来包含一个包含三个整数的向量。正如你所见，你甚至可以使用空格。只要你在字符串周围加上反引号（`），就可以使用这种非标准名称：

`!A @B #C $D %E ^F` <- c(1, 2, 3)
`!A @B #C $D %E ^F`
#> [1] 1 2 3

不言而喻，你应该避免这些名称，但你应该意识到它们的存在，因为在使用 R 的某些更高级功能时，它们可能会派上用场。这类变量名在大多数语言中是不允许的，但 R 在这方面非常灵活。此外，这个例子也展示了 R 编程的一个常见主题：它非常灵活，如果你不小心，你可能会自己给自己挖坑。有人对某些代码感到非常困惑，因为他们假设 R 会以某种方式（例如，在特定条件下引发错误）行为，但没有明确测试这种行为，后来发现它的行为不同。

处理数据类型和数据结构

本节总结了 R 中最重要的数据类型和数据结构。在这个简要概述中，我们不会深入讨论它们。我们只会展示几个示例，这将帮助你理解本书中展示的代码。如果你想深入了解它们，你可以查看它们的文档或本章引言中提到的参考文献。

R 中的基本数据类型是数字、文本和布尔值（TRUE 或 FALSE），R 分别称之为数值、字符和逻辑。严格来说，还有整数、复数和原始数据（字节）的类型，但在这本书中我们不会明确使用它们。R 中的六个基本数据结构是向量、因子、矩阵、数据框和列表，我们将在以下章节中总结。

数值计算

R 中的数字的行为几乎与您在数学上期望的相同。例如，操作2 / 3执行实数除法，在 R 中结果为0.6666667。这种自然的数字行为对于数据分析非常方便，因为您在使用不同类型的数字时不需要过多关注，在其他语言中可能需要特殊处理。此外，运算符的数学优先级同样适用，以及括号的使用。

以下示例展示了如何在操作中使用变量，以及如何处理运算符优先级。如您所见，您可以在执行操作时混合使用变量和值：

x <- 2
y <- 3
z <- 4
(x * y + z) / 5
#> [1] 2

模运算可以使用%%符号执行，而整数除法可以使用%/%符号执行：

7 %% 3
#> [1] 1
7 %/% 3
#> [1] 2

特殊值

R 中有几个特殊值。NA 值用于表示缺失值，代表不可用。如果一个计算结果为一个太大的数，R 将返回正无穷大 Inf 和负无穷大 -Inf，分别表示正无穷和负无穷。当数字除以 0 时，这些值也会返回。有时计算会产生一个不太合理的结果。在这些情况下，我们将得到一个 NaN，代表不是一个数字。最后，还有一个空对象，表示为 NULL。符号 NULL 始终指向同一个对象（它本身就是一个数据类型）并且常用于函数中的默认参数，表示没有传递任何值。您应该知道NA，Inf，-Inf，NaN 和 NULL 不能互相替代。

对于数值、字符和逻辑，存在特定的 NA 值，但我们将坚持使用简单的 NA，它内部被处理为逻辑值。

在以下示例中，您可以看到这些特殊值在 R 中相互使用时的行为。请注意，1 / 0 结果为 Inf，0 / 0，Inf - Inf 和 Inf / Inf 结果为未定义，表示为 NaN，但 Inf + Inf，0 / Inf 和 Inf / 0 分别结果为 Inf，0 和 Inf。这些结果与数学定义相似并非巧合。此外，请注意，任何包括 NaN 或 NA 的操作也将分别结果为 NaN 和 NA：

1 / 0
#> [1] Inf
-1 / 0
#> [1] -Inf
0 / 0
#> [1] NaN
Inf + Inf
#> [1] Inf
Inf - Inf
#> [1] NaN
Inf / Inf
#> [1] NaN
Inf / 0
#> [1] Inf
0 / Inf
#> [1] 0
Inf / NaN
#> [1] NaN
Inf + NA
#> [1] NA

字符

文本也可以像这样使用，只需记住在它周围使用引号(" ")。以下示例展示了如何将文本“Hi, there!”和“10”保存到两个变量中。请注意，由于“10.5”被引号包围，它被视为文本而不是数值。要找到您实际处理的对象的类型，可以使用class()，typeof()和str()（简称结构）函数来获取有关该对象的元数据。

在这种情况下，由于 y 变量包含文本，我们不能像错误信息中看到的那样将其乘以 2。此外，如果您想了解字符串中的字符数，可以使用nchar()函数，如下所示：

x <- "Hi, there!"
y <- "10"
class(y)
#> [1] "character"
typeof(y)
#> [1] "character"
str(y)
#> chr "10"
y * 2
#> Error in y * 2: non-numeric argument to binary operator
nchar(x)
#> [1] 10
nchar(y)
#> [1] 2

有时候，你可能既有文本信息，也有你想要合并到单个字符串中的数值信息。在这种情况下，你应该使用paste()函数。这个函数接收任意数量的未命名参数，我们将在本章后面的部分中更精确地定义这一点。然后它将每个参数转换为字符，并返回一个包含所有这些参数的单个字符串。以下代码展示了这样的一个例子。注意，y 中的数值 10 被自动转换为字符类型，以便可以将其粘贴到字符串的其余部分中：

x <- "the x variable"
y <- 10
paste("The result for", x, "is", y)
#> [1] "The result for the x variable is 10"

有时候，你可能想要替换文本中的某些字符。在这种情况下，你应该使用gsub()函数，它代表全局替换。这个函数接受要替换的字符串作为其第一个参数，替换字符串作为其第二个参数，并将返回带有相应替换的文本作为第三个参数：

x <- "The ball is blue"
gsub("blue", "red", x)
#> [1] "The ball is red"

另一些时候，你可能想知道一个字符串是否包含子字符串，在这种情况下你应该使用gprel()函数。这个函数的名字来源于一个终端命令 grep，它是全局正则表达式打印的缩写（是的，你也可以使用正则表达式来查找匹配）。grepl()函数名末尾的 l 来自于结果是一个逻辑值：

x <- "The sky is blue"
grepl("blue", x)
#> [1] TRUE
grepl("red", x)
#> [1] FALSE

逻辑运算符

逻辑向量包含布尔值，只能为TRUE或FALSE。当你想要创建具有这些值的逻辑变量时，你必须避免在它们周围使用引号，并记住它们都是大写字母，如下所示。在 R 语言编程中，逻辑值通常用于测试条件，这些条件反过来又用于决定我们应该从复杂的程序中采取哪个分支。我们将在本章后面的部分中查看此类行为的示例：

x <- TRUE

在 R 中，你可以使用as.*()函数轻松地在不同类型之间转换值，其中*用作通配符，可以替换为字符、数值或逻辑，以在这些类型之间进行转换。这些函数通过接收与函数名称指定的类型不同的对象，并在可能的情况下将其解析为指定类型，如果不可能，则返回NA。以下示例显示了如何将TRUE字符串转换为逻辑值，在这种情况下，不出所料，它变成了逻辑TRUE：

as.logical("TRUE")
#> [1] TRUE

在 R 中将字符和数值转换为逻辑值不是一件很直观的事情。下表显示了一些这种行为。请注意，尽管true字符串（全部小写字母）在去除引号时不是一个有效的逻辑值，但在应用 as.logical() 函数时，它会被转换为 TRUE 值，这是为了兼容性。还请注意，由于 T 是一个有效的逻辑值，它是 TRUE 的快捷方式，所以相应的文本也被接受为表示这样的值。同样的逻辑也适用于 false 和 F。任何其他字符串都将返回 NA 值，这意味着该字符串不能解析为逻辑值。还请注意，0 将被解析为 FALSE，但任何其他数值，包括 Inf，都将转换为 TRUE 值。最后，请注意，NA 和 NaN 都将被解析，在两种情况下都返回 NA。

as.character() 和 as.numeric() 函数的行为不太直观，我将留给你自己探索。当你这样做的时候，尽量测试尽可能多的边缘情况。这样做将帮助你预见在开发自己的程序时可能遇到的问题。

在我们继续之前，你应该知道这些数据结构可以根据它们的维数和是否同质（所有内容必须是同一类型）或异质（内容可以是不同类型）来组织。向量、矩阵和数组是同质数据结构，而列表和数据框是异质。向量和列表具有单一维度，矩阵和数据框具有两个维度，而数组可以具有我们想要的任意多个维度。

当谈到维度时，R 中的数组与许多其他语言中的数组不同，在其他语言中，你需要创建一个数组的数组来产生二维结构，而在 R 中这是不必要的。

向量

R 中的基本数据类型是向量，它是有序值集合。你应该知道的第一件事是，与其它语言不同，数字、字符串和逻辑值的单个值是向量的特殊情况（长度为 1 的向量），这意味着在 R 中没有标量的概念。向量是一维数据结构，其所有元素都是相同的数据类型。

创建向量的最简单方法是使用 c() 函数，它代表组合，并将所有参数强制转换为单一类型。强制转换将从更简单的类型转换为更复杂的类型。也就是说，如果我们创建一个包含逻辑值、数值和字符的向量，如下例所示，我们的结果向量将只包含字符，因为它们是三种类型中最复杂的。如果我们创建一个包含逻辑值和数值的向量，我们的结果向量将是数值的，因为它是三种类型中最复杂的类型。

向量可以是命名的或未命名的。未命名的向量元素只能通过位置引用来访问，而命名的向量可以通过位置引用以及名称引用来访问。在下面的例子中，y 向量是一个命名的向量，其中每个元素都用字母 A 到 I 命名。这意味着在 x 的情况下，我们只能使用位置（第一个位置被视为 1 而不是其他语言中使用的 0）来访问元素，但在 y 的情况下，我们也可以使用我们分配的名称。

还要注意，我们之前提到的特殊值，即 NA、NULL、NaN 和 Inf，如果它们是更复杂的类型，将会被强制转换为字符，除了 NA，它保持不变。如果强制转换是向数值类型进行，它们都保持不变，因为它们是有效的数值。最后，如果我们想知道向量的长度，只需在它上面调用 length() 函数即可：

x <- c(TRUE, FALSE, -1, 0, 1, "A", "B", NA, NULL, NaN, Inf)
x
#> [1] "TRUE" "FALSE" "-1" "0" "1" "A" "B" NA
#> [9] "NaN" "Inf"
x[1]
#> [1] "TRUE"
x[5]
#> [1] "1"
y <- c(A=TRUE, B=FALSE, C=-1, D=0, E=1, F=NA, G=NULL, H=NaN, I=Inf)
y
#> A B  C D E F  H   I
#> 1 0 -1 0 1 NA NaN Inf
y[1]
#> A
#> 1
y["A"]
#> A
#> 1
y[5]
#> E
#> 1
y["E"]
#> E
#> 1
length(x)
#> [1] 10
length(y)
#> [1] 8

此外，我们可以使用索引数字的向量来选择或选择元素集合或范围。例如，使用选择器 c(1, 2) 会检索向量的前两个元素，而使用 c(1, 3, 5) 会返回第一个、第三个和第五个元素。: 函数（是的，它是一个函数，尽管我们通常不会使用我们在其他示例中看到的类似函数的语法来调用它），通常用作创建范围选择器的快捷方式。例如，1:5 语法意味着我们想要一个包含元素 1 到 5 的向量，这相当于明确使用 c(1, 2, 3, 4, 5)。此外，如果我们发送一个逻辑向量，它必须与我们要从中检索值的向量的长度相同，每个逻辑值将与我们要从中检索的向量的相应位置相关联，如果相应的逻辑是 TRUE，则检索值，但如果它是 FALSE，则不会检索。所有这些选择方法都在以下示例中展示：

x[c(1, 2, 3, 4, 5)]
#> [1] "TRUE" "FALSE" "-1" "0" "1"
x[1:5]
#> [1] "TRUE" "FALSE" "-1" "0" "1"
x[c(1, 3, 5)]
#> [1] "TRUE" "-1" "1"
x[c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, 
    FALSE, TRUE, FALSE, TRUE)]
#> [1] "TRUE" "-1" "1" "B" "NaN" NA

接下来我们将讨论向量之间的运算。在数值向量的情况下，我们可以通过简单地使用运算符来逐元素应用操作。在这种情况下，R 将成对匹配两个向量的元素并返回一个向量。以下示例展示了两个向量如何以逐元素的方式相加、相减、相乘和相除。此外，由于我们正在处理长度相同的向量，我们可能想要获取它们的点积（如果你不知道什么是点积，你可以查看en.wikipedia.org/wiki/Dot_product），我们可以使用 %*% 运算符来完成，它执行类似矩阵的乘法，在这种情况下是向量到向量的乘法：

x <- c(1, 2, 3, 4)
y <- c(5, 6, 7, 8)
x + y
#> [1] 6 8 10 12
x - y
#> [1] -4 -4 -4 -4
x * y
#> [1] 5 12 21 32
x / y
#> [1] 0.2000 0.3333 0.4286 0.5000
x %*% y
#> [,1]
#> [1,] 70

如果你想要将多个向量合并成一个，你可以简单地递归地使用 c() 函数对它们进行操作，它将自动将它们展平。假设我们想要将 x 和 y 合并成 z，使得 y 的元素先出现。此外，假设我们在合并之后想要对它们进行排序，那么我们对 z 应用 sort() 函数：

z <- c(y, x)
z
#> [1] 5 6 7 8 1 2 3 4
sort(z)
#> [1] 1 2 3 4 5 6 7 8

混淆的一个常见来源是 R 如何处理不同长度的向量。如果我们应用元素到元素的运算，就像我们之前提到的，但使用不同长度的向量，我们可能会期望 R 抛出一个错误，就像在其他语言中那样。然而，它并没有这样做。相反，它会按顺序重复向量元素，直到它们的长度都相同。以下示例显示了三个不同长度的向量，以及将它们相加的结果。

默认情况下，R 的配置方式实际上会显示一个警告消息，告诉你你操作的向量长度不同，但由于 R 可以配置为避免显示警告，因此你不应该依赖它们：

c(1, 2) + c(3, 4, 5) + c(6, 7, 8, 9)
#> Warning in c(1, 2) + c(3, 4, 5): 
       longer object length is not a multiple of
#> shorter object length
#> Warning in c(1, 2) + c(3, 4, 5) + c(6, 7, 8, 9): 
       longer object length is
#> not a multiple of shorter object length
#> [1] 10 13 14 13

第一个可能出现在脑海中的想法是，第一个向量被展开为 c(1, 2, 1, 2)，第二个向量被展开为 c(3, 4, 5, 3)，而第三个向量保持不变，因为它是最长的。然后如果我们把这些向量加在一起，结果将是 c(10, 13, 14, 14)。然而，正如你在示例中看到的，实际的结果实际上是 c(10, 13, 14, 13)。那么，我们遗漏了什么呢？混淆的来源是 R 是逐步进行这一步骤的，这意味着它首先执行 c(1, 2) + c(3, 4, 5) 的加法，展开后是 c(1, 2, 1) + c(3, 4, 5)，结果是 c(4, 6, 6)，然后基于这个结果，R 执行的下一步是 c(4, 6, 6) + c(6, 7, 8, 9)，展开后是 c(4, 6, 6, 4) + c(6, 7, 8, 9)，这就是我们得到的结果来源。一开始可能会感到困惑，但只要记住要想象这些操作是逐步进行的。

最后，我们将简要介绍 R 中一个非常强大的功能，称为向量化。向量化意味着你一次性对一个向量应用一个操作，而不是独立地对它的每个元素进行操作。这是一个你应该相当熟悉的特性。没有它的编程被认为是糟糕的 R 代码，这不仅是因为语法原因，也因为向量化代码利用了 R 中的许多内部优化，这导致了代码运行得更快。我们将在第九章 实现一个有效的简单移动平均中展示不同的向量化代码方法，本章中，我们将看到一个示例，随后在接下来的几节中还将看到更多示例。

尽管短语“向量化代码”一开始可能看起来令人畏惧或神奇，但实际上，R 在某些情况下使其实施变得相当简单。例如，我们可以通过将 x 符号用作单个数字来对 x 向量中的每个元素进行平方。R 足够智能，能够理解我们想要将操作应用于向量中的每个元素。R 中的许多函数都可以使用这种技术进行应用：

x²
#> [1] 1 4 9 16

在下一节关于函数的部分，我们将看到更多真正展示向量化如何大放异彩的例子，我们将看到即使在操作依赖于其他参数的情况下，如何应用向量化操作。

因子

在分析数据时，遇到分类值是非常常见的。R 提供了一个很好的方法来使用因子表示分类值，这些因子是通过factor()函数创建的，是具有每个整数相关标签的整数向量。因子可以取的不同值称为级别。levels()函数显示因子的所有级别，factor()函数的级别参数可以用来显式定义它们的顺序，如果未显式定义，则按字母顺序排列。

注意，在线性建模中定义显式顺序可能很重要，因为第一个级别被用作lm()（线性模型）等函数的基线级别，这些函数我们将在第三章，“使用线性模型预测投票”中使用。

此外，打印因子显示的信息与打印字符向量略有不同。特别是请注意，引号没有显示，并且级别随后按顺序显式打印：

x <- c("Blue", "Red", "Black", "Blue")
y <- factor(c("Blue", "Red", "Black", "Blue"))
z <- factor(c("Blue", "Red", "Black", "Blue"), 
            levels=c("Red", "Black", "Blue"))

x
#> [1] "Blue" "Red" "Black" "Blue"
y
#> [1] Blue Red Black Blue
#> Levels: Black Blue Red
z
#> [1] Blue Red Black Blue
#> Levels: Red Black Blue
levels(y)
#> [1] "Black" "Blue" "Red"
levels(z)
#> [1] "Red" "Black" "Blue"

有时因子可能难以处理，因为它们的类型取决于使用什么函数来操作它们。还记得我们之前使用的class()和typeof()函数吗？当用于因子时，它们可能会产生意外的结果。正如你所看到的，class()函数将 x 和 y 分别识别为字符和因子。然而，typeof()函数会让我们知道它们分别是字符和整数。这不是很令人困惑吗？这种情况发生是因为，正如我们之前提到的，因子在内部以整数形式存储，并使用类似于查找表的机制来检索与每个整数关联的实际字符串。

从技术上讲，因子存储与它们的整数值关联的字符串的方式是通过属性，这是我们在第八章，“面向对象的系统跟踪加密货币”中将要涉及的一个主题。

class(x)
#> [1] "character"
class(y)
#> [1] "factor"
typeof(x)
#> [1] "character"
typeof(y)
#> [1] "integer"

虽然因子看起来和通常的行为像字符向量，正如我们之前提到的，它们实际上是整数向量，所以在将它们当作字符串处理时要小心。一些字符串方法，如gsub()和grepl()，会将因子强制转换为字符，而其他方法，如nchar()，会抛出错误，还有一些方法，如c()，会使用其底层的整数值。因此，通常最好显式地将因子转换为所需的 数据类型：

gsub("Black", "White", x)
#> [1] "Blue" "Red" "White" "Blue"
gsub("Black", "White", y)
#> [1] "Blue" "Red" "White" "Blue"
nchar(x)
#> [1] 4 3 5 4
nchar(y)
#> Error in nchar(y): 'nchar()' requires a character vector
c(x)
#> [1] "Blue" "Red" "Black" "Blue"
c(y)
#> [1] 2 3 1 2

如果你没有注意到，nchar()方法本身应用于 x 因子中的每个元素。字符串"Blue"、"Red"和"Black"分别有 4、3 和 5 个字符。这是我们在向量部分之前提到的向量运算的另一个例子。

矩阵

矩阵在数学和统计学中常用，R 的许多功能都来自于你可以对它们执行的各种操作。在 R 中，矩阵是一个具有两个额外属性的向量，即行数和列数。而且，由于矩阵是向量，它们被限制为单一数据类型。

你可以使用matrix()函数来创建矩阵。你可以传递一个值向量，以及矩阵应具有的行数和列数。如果你指定了值向量和其中一个维度，另一个维度将自动为你计算，以使向量传递的最低数字有意义。然而，如果你更喜欢同时指定两者，这可能会根据你传递的向量产生不同的行为，如下一个示例所示。

默认情况下，矩阵是按列构建的，这意味着条目可以被认为是从左上角开始并向下运行到列。然而，如果你更喜欢按行构建，你可以发送byrow = TRUE参数。此外，请注意，你可以通过指定行数和列数而不传递任何实际数据来创建一个空矩阵或未初始化的矩阵，如果你什么都不指定，将返回一个未初始化的 1x1 矩阵。最后，请注意，在创建矩阵时，我们看到的与向量相同的元素重复机制也适用，所以在以这种方式创建时要小心：

matrix()
#> [,1]
#> [1,] NA

matrix(nrow = 2, ncol = 3)
#> [,1] [,2] [,3]
#> [1,] NA NA NA
#> [2,] NA NA NA

matrix(c(1, 2, 3), nrow = 2)
#> Warning in matrix(c(1, 2, 3), nrow = 2): 
 data length [3] is not a sub-
#> multiple or multiple of the number of rows [2]
#> [,1] [,2]
#> [1,] 1 3
#> [2,] 2 1

matrix(c(1, 2, 3), nrow = 2, ncol = 3)
#> [,1] [,2] [,3]
#> [1,] 1 3 2
#> [2,] 2 1 3

matrix(c(1, 2, 3, 4, 5, 6), nrow = 2, byrow = TRUE)
#> [,1] [,2] [,3]
#> [1,] 1 2 3
#> [2,] 4 5 6

矩阵子集可以用各种方式指定。使用类似矩阵的表示法，你可以使用我们之前为向量显示的相同机制来指定行和列的选择，其中你可以使用带有索引的向量或带有逻辑的向量，如果你决定使用带有逻辑的向量，用于子集的向量必须与你要使用的矩阵维度相同长度。由于在这种情况下，我们有两个维度要处理，我们必须通过在它们之间使用逗号（,）来分隔行和列的选择（行选择先进行），R 将返回它们的交集。

例如，x[1, 2]告诉 R 获取第一行第二列的元素，x[1:2, 1]告诉 R 获取第三行的第一到第二个元素，这相当于使用x[c(1, 2), 3]。你也可以使用逻辑向量进行选择。例如，x[c(TRUE, FALSE), c(TRUE, FALSE, TRUE)]告诉 R 获取第一行同时避免第二行，并从该行中获取第一和第三列。一个等效的选择是x[1, c(1, 3)]。请注意，当你想指定单个行或列时，你可以单独使用一个整数，但如果你想指定两个或更多，则必须使用向量表示法。最后，如果你省略了一个维度规格，R 将解释为获取该维度的所有可能性：

x <- matrix(c(1, 2, 3, 4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE)
x[1, 2]
#> [1] 2
x[1:2, 2]
#> [1] 2 5
x[c(1, 2), 3]
#> [1] 3 6
x[c(TRUE, FALSE), c(TRUE, FALSE, TRUE)]
#> [1] 1 3
x[1, c(1, 3)]
#> [1] 1 3
x[, 1]
#> [1] 1 4
x[1, ]
#> [1] 1 2 3

如前所述，矩阵是基本的数学工具，R 在处理矩阵时提供了很多灵活性。最常见的矩阵操作是转置，使用t()函数执行，还有矩阵-向量乘法、向量-矩阵乘法和矩阵-矩阵乘法，这些操作使用我们之前用来计算两个向量点积的%*%运算符。

注意，与数学符号相同的维度限制同样适用，这意味着如果你尝试执行这些操作之一，而维度在数学上没有意义，R 将抛出错误，如示例的最后部分所示：

A <- matrix(c(1, 2, 3, 4, 5, 6), nrow = 2, byrow = TRUE)
x <- c(7, 8)
y <- c(9, 10, 11)
A
#> [,1] [,2] [,3]
#> [1,] 1 2 3
#> [2,] 4 5 6
x
#> [1] 7 8
y
#> [1] 9 10 11
t(A)
#> [,1] [,2]
#> [1,] 1 4
#> [2,] 2 5
#> [3,] 3 6
t(x)
#> [,1] [,2]
#> [1,] 7 8
t(y)
#> [,1] [,2] [,3]
#> [1,] 9 10 11
x %*% A
#> [,1] [,2] [,3]
#> [1,] 39 54 69
A %*% t(x)
#> Error in A %*% t(x): non-conformable arguments
A %*% y
#> [,1]
#> [1,] 62
#> [2,] 152
t(y) %*% A
#> Error in t(y) %*% A: non-conformable arguments
A %*% t(A)
#> [,1] [,2]
#> [1,] 14 32
#> [2,] 32 77
t(A) %*% A
#> [,1] [,2] [,3]
#> [1,] 17 22 27
#> [2,] 22 29 36
#> [3,] 27 36 45
A %*% x
#> Error in A %*% x: non-conformable arguments

列表

列表是一个有序的对象集合，类似于向量，但实际上列表可以组合不同类型的对象。列表元素可以包含 R 中存在的任何类型的对象，包括数据框和函数（在以下章节中解释）。由于它们的灵活性和作为数据框、面向对象编程和其他结构的基础，列表在 R 中扮演着核心角色。学会正确使用列表是 R 程序员的基本技能，在这里，我们只是触及了表面，但你绝对应该进一步研究它们。

对于熟悉 Python 的人来说，R 列表类似于 Python 字典。

列表可以使用list()函数显式创建，该函数接受任意数量的参数，并且我们可以通过位置和，如果指定了，也可以通过名称来引用这些元素。如果你想通过名称引用列表元素，可以使用$符号。

以下示例展示了列表的灵活性。它显示了一个包含数值、字符、逻辑、矩阵甚至其他列表（这些被称为嵌套列表）的列表，正如你所见，我们可以独立提取这些元素来工作。

这是我们第一次展示多行表达式。如您所见，您可以通过这种方式保持可读性并避免在代码中拥有非常长的行。以这种方式排列代码被认为是良好的实践。如果您直接在控制台中输入，每行都会出现加号（+），只要您有一个未完成的表达式，就可以引导您继续。

x <- list(
    A = 1,
    B = "A",
    C = TRUE,
    D = matrix(c(1, 2, 3, 4), nrow = 2),
    E = list(F = 2, G = "B", H = FALSE)
)

x 
#> $A
#> [1] 1
#>
#> $B
#> [1] "A"
#>
#> $C
#> [1] TRUE
#>
#> $D
#> [,1] [,2]
#> [1,] 1 3
#> [2,] 2 4
#>
#> $E
#> $E$F
#> [1] 2
#>
#> $E$G
#> [1] "B"
#>
#> $E$H
#> [1] FALSE 
x[1]
#> $A
#> [1] 1 
x$A
#> [1] 1 
x[2]
#> $B
#> [1] "A" 
x$B
#> [1] "A"

当处理列表时，我们可以使用lapply()函数将函数应用于列表中的每个元素。在这种情况下，我们想知道我们刚刚创建的列表中每个元素的类和类型：

lapply(x, class)
#> $A
#> [1] "numeric"
#>
#> $B
#> [1] "character"
#>
#> $C
#> [1] "logical"
#>
#> $D
#> [1] "matrix"
#>
#> $E
#> [1] "list" 
lapply(x, typeof)
#> $A
#> [1] "double"
#>
#> $B
#> [1] "character"
#>
#> $C
#> [1] "logical"
#>
#> $D
#> [1] "double"
#>
#> $E
#> [1] "list"

数据框

现在我们转向数据框，它们与电子表格或数据库表非常相似。在科学环境中，实验由单个观察值（行）组成，每个观察值涉及几个不同的变量（列）。通常，这些变量包含不同的数据类型，由于矩阵必须包含单一数据类型，因此无法在矩阵中存储这些数据。数据框是表示这种异构表格数据的一种自然方式。列中的每个元素必须是同一类型，但行中的不同元素可以是不同类型，这就是为什么我们说数据框是一种异构数据结构。

技术上，数据框是一个元素长度相等的向量列表，这就是为什么它允许异构性。

数据框通常是通过使用read.table()、read.csv()或其他类似的数据加载函数来创建的。然而，它们也可以通过data.frame()函数显式创建，或者可以从列表等其他类型的对象强制转换。要使用data.frame()函数创建数据框，请注意，我们将一个向量（我们知道，它必须包含单一类型的元素）发送到我们想要数据框拥有的每个列名，在这种情况下是 A、B 和 C。我们创建的数据框下面有四行（观察值）和三个变量，分别具有数值、字符和逻辑类型。最后，使用我们之前看到的矩阵技术提取数据子集，但您也可以使用$运算符引用列，然后从中提取元素：

x <- data.frame(
    A = c(1, 2, 3, 4),
    B = c("D", "E", "F", "G"),
    C = c(TRUE, FALSE, NA, FALSE)
)
x[1, ]
#> A B C
#> 1 1 D TRUE
x[, 1]
#> [1] 1 2 3 4
x[1:2, 1:2]
#> A B
#> 1 1 D
#> 2 2 E
x$B
#> [1] D E F G
#> Levels: D E F G
x$B[2]
#> [1] E
#> Levels: D E F G

根据数据组织方式，数据框可以是宽格式或窄格式（en.wikipedia.org/wiki/Wide_and_narrow_data）。最后，如果您只想保留具有完整案例的观察值，这意味着只包含任何变量中没有任何NA值的行，那么您应该使用complete.cases()函数，它返回一个长度等于行数的逻辑向量，其中包含没有NA值的行的TRUE值，以及至少有一个此类值的行的FALSE值。

注意，当我们创建 x 数据框时，C 列在其第三个值中包含一个NA。如果我们对 x 使用complete.cases()函数，那么我们将得到该行的FALSE值，而对于所有其他行则是TRUE值。然后我们可以使用这个逻辑向量来对数据框进行子集化，就像我们之前用矩阵做的那样。这在分析可能不干净的数据时非常有用，并且你只想保留那些具有完整信息的观测值：

x
#> A B C
#> 1 1 D TRUE
#> 2 2 E FALSE
#> 3 3 F NA
#> 4 4 G FALSE

complete.cases(x)
#> [1] TRUE TRUE FALSE TRUE
x[complete.cases(x), ]
#> A B C
#> 1 1 D TRUE
#> 2 2 E FALSE
#> 4 4 G FALSE

使用函数进行分而治之

函数是 R 的基本构建块。要掌握本书中许多更高级的技术，你需要对它们的工作原理有一个坚实的基础。我们已经在上面使用了一些函数，因为你在 R 中不做这些事情就无法做任何有趣的事情。它们只是你从数学课上学到的，将输入转换为输出的方式。具体来说，在 R 中，一个函数是一个对象，它接受其他对象作为输入，称为参数，并返回一个输出对象。大多数函数具有以下形式f(argument_1, argument_2, ...)。其中 f 是函数的名称，而argument_1、argument_2等是函数的参数。

在我们继续之前，我们应该简要提及大括号({})在 R 中的作用。它们通常用于在函数体中分组一组操作，但它们也可以在其他上下文中使用（正如我们在第十章中将要构建的 Web 应用程序的例子中将会看到，使用仪表板添加交互性）。大括号用于评估一系列表达式，这些表达式由换行符或分号分隔，并仅返回最后一个表达式作为结果。例如，以下行仅将 x + y 操作打印到屏幕上，隐藏了 x * y 操作的输出，如果我们将表达式逐个输入，将会打印出来。从这个意义上讲，大括号用于封装一组行为，并且仅从最后一个表达式中提供结果：

{ x <- 1; y <- 2; x * y; x + y }
#> [1] 3

我们可以通过使用function()构造函数并将其分配给一个符号来创建自己的函数。function()构造函数接受任意数量的命名参数，这些参数可以在函数体中使用。未命名的参数也可以使用"..."参数符号传递，但这是一种高级技术，我们在这本书中不会探讨。请随意阅读有关函数的文档以了解更多信息。

在调用函数时，参数可以通过位置或名称传递。位置顺序必须与函数签名中提供的顺序相对应（即带有相应参数的function()规范），但当我们使用命名参数时，我们可以按我们喜欢的任何顺序发送它们。以下示例将展示这一点。

在以下示例中，我们创建了一个函数，用于计算两个数值向量之间的欧几里得距离(en.wikipedia.org/wiki/Euclidean_distance)，并展示了如果我们使用命名参数，参数的顺序可以如何改变。为了实现这种效果，我们使用print()函数确保我们可以在控制台中看到 R 接收到的 x 和 y 向量。在你开发自己的程序时，以类似的方式使用print()函数非常有用，可以帮助你理解正在发生的事情。

我们不会使用像euclidian_distance这样的函数名，而是使用l2_norm，因为它是处理任意数量维度空间时此类操作的通用名称，并且它将使后续示例更容易理解。请注意，尽管在函数调用之外我们的向量被称为 a 和 b，但由于它们被传递到 x 和 y 参数中，我们需要在函数中使用这些名称。如果我们在两个地方都使用了 x 和 y 名称，初学者很容易将这些对象混淆为相同的对象：

l2_norm <- function(x, y) {
    print("x")
    print(x)
    print("y")
    print(y)
    element_to_element_difference <- x - y
    result <- sum(element_to_element_difference²)
    return(result)
}

a <- c(1, 2, 3)
b <- c(4, 5, 6)

l2_norm(a, b)
#> [1] "x"
#> [1] 1 2 3
#> [1] "y"
#> [1] 4 5 6
#> [1] 27

l2_norm(b, a)
#> [1] "x"
#> [1] 4 5 6
#> [1] "y"
#> [1] 1 2 3
#> [1] 27

l2_norm(x = a, y = b)
#> [1] "x"
#> [1] 1 2 3
#> [1] "y"
#> [1] 4 5 6
#> [1] 27

l2_norm(y = b, x = a)
#> [1] "x"
#> [1] 1 2 3
#> [1] "y"
#> [1] 4 5 6
#> [1] 27

函数可以使用return()函数来指定函数返回的值。然而，R 会简单地返回最后一个评估的表达式作为函数的结果，因此你可能看到没有显式使用return()函数的代码。

我们之前的l2_norm()函数实现似乎有些杂乱。如果一个函数只有一个表达式，那么我们可以避免使用大括号，这可以通过移除print()函数调用和避免创建中间对象来实现，并且由于我们知道它运行良好，我们可以毫不犹豫地这样做。此外，我们避免显式调用return()函数，以进一步简化我们的代码。如果我们这样做，我们的函数看起来更接近其数学定义，也更易于理解，不是吗？

l2_norm <- function(x, y) sum((x - y)²)

此外，如果你没有注意到，由于我们使用了向量运算，我们可以发送不同长度的向量（维度），只要这两个向量具有相同的长度，函数将像我们预期的那样工作，而不考虑我们正在处理的空间维度。正如我之前提到的，向量运算可以非常强大。在以下示例中，我们使用维度为 1 的向量（在数学上称为标量）以及使用“:”快捷语法创建的维度为 5 的向量来展示这种行为：

l2_norm(1, 2)
#> [1] 1
l2_norm(1:5, 6:10)
#> [1] 125

在我们继续之前，我想提到的是，你应该始终努力遵循单一职责原则，该原则指出每个对象（在这个例子中是函数）应该专注于做一件事情，并且做得很好。每次你描述你创建的函数时，如果它被描述为做“某件事”和“另一件事,”，你很可能是做错了，因为“和”应该让你知道该函数正在做不止一件事情，你应该将其拆分成两个或更多可能相互调用的函数。要了解更多关于良好的软件工程原则的信息，请参阅马丁的杰出著作《敏捷软件开发：原则、模式和实践，Pearson，2002》。

可选参数

在创建函数时，你可以为参数指定一个默认值，如果你这样做，那么这个参数就被认为是可选的。如果你没有为参数指定默认值，并且在调用函数时没有指定值，那么如果函数尝试使用该参数，你会得到一个错误。

在下面的例子中，我们展示了如果将单个数值向量作为它目前的样子传递给我们的l2_norm()函数，它将引发一个错误，但如果我们重新定义它使其第二个向量成为可选的，那么我们只需简单地返回第一个向量的范数，而不是两个不同向量之间的距离。为了完成这个任务，我们将提供一个长度为 1 的零向量，但由于 R 会重复向量元素，直到所有参与操作的向量都具有相同的长度，正如我们在本章前面看到的，它将自动将我们的零向量扩展到适当的维度：

l2_norm(a)     # Should throw an error because `y` is missing
#> Error in l2_norm(a): argument "y" is missing, with no default

l2_norm <- function(x, y = 0) sum((x - y)²)

l2_norm(a)     # Should work fine, since `y` is optional now
#> [1] 14
l2_norm(a, b)  # Should work just as before
#> [1] 27

如你所见，现在我们的函数可以可选地接收y向量，但如果没有它也会按预期工作。此外，请注意我们在代码中添加了一些注释。任何在行尾#符号之后的内容，R 都会忽略，这允许我们在需要的地方解释我们的代码。我倾向于避免使用注释，因为我倾向于认为代码应该是表达性的，并且能够在不需要注释的情况下传达其意图，但它们实际上时不时地很有用。

函数作为参数

有时候当你想要泛化函数时，你可能想要将某种功能插入到一个函数中。你可以用各种方式做到这一点。例如，你可能会使用条件语句，正如我们在本章下一节中将要看到的，根据上下文为它们提供不同的功能。然而，当可能的时候应该避免使用条件语句，因为它们可能会在我们的代码中引入不必要的复杂性。一个更好的解决方案是将一个函数作为参数传递，当需要时会被调用，如果我们想要改变函数的行为，我们可以为特定任务更改传递的函数。

这可能听起来很复杂，但实际上非常简单。让我们先创建一个l1_norm()函数，该函数计算两个向量之间的距离，但使用对应坐标的绝对差之和，而不是像我们的l2_norm()函数那样使用平方差之和。更多信息，请参阅维基百科上的Taxicab geometry文章（en.wikipedia.org/wiki/Taxicab_geometry）。

注意，我们为我们的两个函数使用了相同的签名，这意味着它们接收相同的必需以及可选参数，在这种情况下是x和y。这很重要，因为如果我们想通过切换函数来改变行为，我们必须确保它们能够处理相同的输入，否则我们可能会得到意外的结果或甚至错误：

l1_norm <- function(x, y = 0) sum(abs(x - y))

l1_norm(a)
#> [1] 6
l1_norm(a, b)
#> [1] 9

现在我们已经构建了l2_norm()和l1_norm()函数，以便它们可以相互切换以提供不同的行为，我们将创建一个第三个distance()函数，该函数将接受两个向量作为参数，但也将接收一个范数参数，该参数将包含我们想要用来计算距离的函数。

注意，我们指定默认使用l2_norm()函数，以防在调用函数时没有进行明确选择，为此我们只需指定包含函数对象的符号，而不需要括号。最后请注意，如果我们想避免发送y向量，但想指定应使用哪种范数，那么我们必须通过命名参数传递它，否则 R 会将第二个参数解释为y向量，而不是范数函数：

distance <- function(x, y = 0, norm = l2_norm) norm(x, y)

distance(a)
#> [1] 14
distance(a, b)
#> [1] 27
distance(a, b, l2_norm)
#> [1] 27
distance(a, b, l1_norm)
#> [1] 9
distance(a, norm = l1_norm)
#> [1] 6

运算符是函数

现在你已经对函数的工作原理有了实际的理解。你应该知道，并非所有函数调用都像我们之前展示的那样，即使用函数名后跟包含函数参数的括号。实际上，R 中的所有语句，包括设置变量和算术运算，在后台都是函数，即使我们通常用不同的语法来调用它们。

记住，在本章之前我们提到 R 对象几乎可以用任何字符串来引用，但你应该避免这样做。在这里，我们展示了在特定情况下使用晦涩难懂的名字可能是有用的。以下示例展示了如何通常使用糖语法（一个用来描述为了方便使用而存在的语法的术语）来使用赋值、选择和加法运算符，但在后台它们使用的是名为[<-、[和+的函数。

[<-() 函数接收三个参数：我们想要修改的向量、在向量中想要修改的位置，以及我们想要在该位置拥有的值。[() 函数接收两个参数，即我们想要从中检索值的向量以及我们想要检索的值的位置。最后，+() 函数接收我们想要相加的两个值。以下示例展示了语法糖，随后是 R 为我们执行的背景函数调用：

x <- c(1, 2, 3, 4, 5)
x
#> [1] 1 2 3 4 5
x[1] <- 10
x
#> [1] 10 2 3 4 5
`[<-`(x, 1, 20)
#> [1] 20 2 3 4 5
x
#> [1] 10 2 3 4 5
x[1]
#> [1] 10
`[`(x, 1)
#> [1] 10
x[1] + x[2]
#> [1] 12
`+`(x[1], x[2])
#> [1] 12
`+`(`[`(x, 1), `[`(x, 1))
#> [1] 20

在实践中，你可能永远不会将这些语句作为显式函数调用编写。语法糖更加直观，更容易阅读。然而，为了使用本书中展示的一些高级技术，了解 R 中的每个操作都是一个函数是有帮助的。

强制转换

最后，我们将简要介绍 R 中的强制转换是什么，因为它是新手的困惑主题。当你用一个与预期类型不同的参数调用函数时，R 将尝试强制转换值，以便函数可以工作，如果处理不当，这可能会引入错误。R 将遵循与创建向量时使用的类似机制。

强类型语言（如 Java）会在传递给函数的对象类型错误时引发异常，并尝试不将对象转换为兼容类型。然而，正如我们之前提到的，R 被设计为可以与许多未预见的上下文一起工作，因此引入了强制转换。

在以下示例中，我们展示了如果我们调用我们的 distance() 函数并传递逻辑向量而不是数值向量，R 将将逻辑向量强制转换为数值向量，使用 TRUE 作为 1 和 FALSE 作为 0，然后继续计算。为了避免在你的程序中出现此类问题，你应该使用我们之前提到的 as.*() 函数显式地转换数据类型：

x <- c(1, 2, 3)
y <- c(TRUE, FALSE, TRUE)
distance(x, y)
#> [1] 8

使用控制结构的复杂逻辑

我们应该讨论的最后一个主题是使用控制结构引入复杂逻辑的方法。当我提到引入复杂逻辑时，并不意味着这样做很复杂。复杂逻辑指的是具有多个可能的执行路径的代码，但在现实中，实现它相当简单。

几乎 R 中的每个操作都可以写成函数的形式，并且这些函数可以被传递给其他函数以创建非常复杂的行为。然而，以这种方式实现逻辑并不总是方便，有时使用简单的控制结构可能是一个更好的选择。

我们将要查看的控制结构是 if... else 条件语句、for 循环和 while 循环。还有 switch 条件语句，它们与 if... else 条件语句非常相似，但我们将不会查看它们，因为我们不会在本书的示例中使用它们。

If… else 条件语句

如其名称所示，if...else 条件将检查一个条件，如果它评估为 TRUE 值，则将采取一条执行路径，但如果条件评估为 FALSE 值，则将采取不同的执行路径，并且它们是互斥的。

为了展示 if... else 条件的工作方式，我们将编写之前使用的相同的 distance() 函数，但不是以函数的形式传递第三个参数，而是传递一个字符串，该字符串将被检查以决定应该使用哪个函数。这样，你可以比较实现相同功能的不同方式。如果我们把 l2 字符串传递给 norm 参数，那么将使用 l2_norm() 函数，但如果传递任何其他字符串，则将使用 l1_norm() 函数。注意，我们使用双等号运算符 (==) 来检查相等性。不要将其与单等号混淆，它表示赋值：

distance <- function(x, y = 0, norm = "l2") {
    if (norm == "l2") {
        return(l2_norm(x, y))
    } else {
        return(l1_norm(x, y))
    }
}

a <- c(1, 2, 3)
b <- c(4, 5, 6)

distance(a, b)
#> 27
distance(a, b, "l2")
#> 27
distance(a, b, "l1")
#> 9
distance(a, b, "l1 will also be used in this case")
#> 9

如前一个示例的最后一行所示，以非严谨的方式使用条件可以引入潜在的错误，就像在这个例子中，我们使用了 l1_norm() 函数，即使最后一个函数调用中的 norm 参数完全没有任何意义。为了避免这种情况，我们可能需要引入更多的条件来穷尽所有有效可能性，并在 else 分支执行时使用 stop() 函数抛出错误，这意味着没有提供有效的选项：

distance <- function(x, y = 0, norm = "l2") {
    if (norm == "l2") {
        return(l2_norm(x, y))
    } else if (norm == "l1") {
        return(l1_norm(x, y))
    } else {
        stop("Invalid norm option")
    }
}

distance(a, b, "l1")
#> [1] 9
distance(a, b, "this will produce an error")
#> Error in distance(a, b, "this will produce an error") :
#>   Invalid norm option

有时，不需要 if... else 条件的 else 部分。在这种情况下，你可以简单地避免放入它，如果条件满足，R 将执行 if 分支，如果不满足，则忽略它。

有许多不同的方式可以生成可以在 if() 检查中使用的逻辑值。例如，你可以指定一个具有 NULL 默认值的可选参数，并通过检查相应的变量在检查时是否仍然包含 NULL 对象来检查它是否未在函数调用中发送，使用 is.null() 函数。实际的条件可能看起来像 if(is.null(optional_argument))。有时你可能得到一个逻辑向量，如果其中任何一个值是 TRUE，那么你想要执行一段代码，在这种情况下，你可以使用类似 if(any(logical_vector)) 作为条件，或者如果你需要逻辑向量中的所有值都是 TRUE 才执行一段代码，那么你可以使用类似 if(all(logical_vector)) 的方式。相同的逻辑可以应用于名为 is.na() 和 is.nan() 的自描述函数。

生成这些逻辑值的另一种方式是使用比较运算符。这些包括小于(<)，小于等于(<=)，大于(>)，大于等于(>=)，精确等于（我们之前见过的，==），以及不等于(!=)。所有这些都可以用来测试数字以及字符，在这种情况下使用字母数字顺序。此外，逻辑值可以相互组合以提供更复杂的条件。例如，!运算符将否定一个逻辑值，这意味着如果!TRUE等于FALSE，而!FALSE等于TRUE。这些类型运算符的其他例子包括 OR 运算符，其中如果任何逻辑值为TRUE，则整个表达式评估为TRUE，以及 AND 运算符，其中所有逻辑值都必须为TRUE才能评估为TRUE。尽管我们没有展示最后两段中提到的具体信息示例，但您将在本书其余部分开发的示例中看到它的使用。

最后，请注意，if... else条件语句的向量形式可以在ifelse()函数下使用。在以下代码中，我们在条件中使用模运算符，这是函数的第一个参数，以识别哪些值是偶数，在这种情况下，我们使用TRUE分支（即第二个参数）来指示整数是偶数，哪些不是，在这种情况下，我们使用FALSE分支（即第三个参数）来指示整数是奇数：

ifelse(c(1, 2, 3, 4, 5, 6) %% 2 == 0, "even", "odd")
#> [1] "odd" "even" "odd" "even" "odd" "even"

对于for循环

for循环有两个重要属性。首先，除非你明确调用print()函数，否则结果不会在循环内部打印。其次，在for循环中使用的索引变量将在每次迭代后按顺序更改。此外，要停止迭代，可以使用关键字break，要跳到下一个迭代，可以使用next命令。

在这个第一个例子中，我们创建了一个名为words的字符向量，并使用 for (word in words)语法按顺序遍历其每个元素。这样做会将words中的第一个元素赋值给word，并通过花括号定义的块中的表达式传递它，在这种情况下是将单词打印到控制台，以及单词中的字符数。当迭代完成时，word将更新为下一个单词，循环以此方式重复，直到所有单词都被使用：

words <- c("Hello", "there", "dear", "reader")
for (word in words) {
    print(word)
    print(nchar(word))
}
#> [1] "Hello"
#> [1] 5
#> [1] "there"
#> [1] 5
#> [1] "dear"
#> [1] 4
#> [1] "reader"
#> [1] 6

通过使用嵌套循环可以实现有趣的行为，这些是嵌套在其他for循环中的for循环。在这种情况下，当遇到for循环时，我们会执行它直到完成。与解释相比，看到这种行为的成果更容易，所以请看看以下代码的行为：

for (i in 1:5) {
    print(i)
    for (j in 1:3) {
        print(paste("   ", j))
    }
}
#> [1] 1
#> [1] " 1"
#> [1] " 2"
#> [1] " 3"
#> [1] 2
#> [1] " 1"
#> [1] " 2"
#> [1] " 3"
#> [1] 3
#> [1] " 1"
#> [1] " 2"
#> [1] " 3"
#> [1] 4
#> [1] " 1"
#> [1] " 2"
#> [1] " 3"
#> [1] 5
#> [1] " 1"
#> [1] " 2"
#> [1] " 3"

使用这种嵌套的 for 循环是人们在使用不提供向量化操作的语言时执行类似矩阵操作的方式。幸运的是，我们可以使用之前章节中显示的语法来执行这些操作，而无需自己使用嵌套的 for 循环，这在某些时候可能会很棘手。

现在，我们将看到如何使用 sapply() 和 lapply() 函数将一个函数应用于向量的每个元素。在这种情况下，我们将对之前创建的单词向量中的每个元素使用 nchar() 函数。sapply() 和 lapply() 函数之间的区别在于，前者返回一个向量，而后者返回一个列表。最后，请注意，显式使用这些函数之一是不必要的，因为我们之前在本章中看到，nchar() 函数已经为我们进行了向量化：

sapply(words, nchar)
#> Hello there dear reader
#> 5     5     4    6
lapply(words, nchar)
#> [[1]]
#> [1] 5
#>
#> [[2]]
#> [1] 5
#>
#> [[3]]
#> [1] 4
#>
#> [[4]]
#> [1] 6
nchar(words)
#> [1] 5 5 4 6

当你有一个尚未向量化的函数，比如我们的 distance() 函数。你仍然可以通过使用我们刚才提到的函数以向量化的方式使用它。在这种情况下，我们将将其应用于包含三个不同数值向量的 x 列表。我们将通过传递列表给 lapply() 函数，然后是我们要应用于其每个元素的函数（在这种情况下是 distance()）。请注意，如果你使用的函数除了从 x 中获取的参数外还接收其他参数，你可以将它们在函数名称之后传递，就像我们在这里使用 c(1, 1, 1) 和 l1_norm 参数一样，这些参数将被 distance() 函数作为 y 和 norm 参数接收，并且对于 x 列表的所有元素都是固定的：

x <- list(c(1, 2, 3), c(4, 5, 6), c(7, 8, 9))
lapply(x, distance, c(1, 1, 1), l1_norm)
#> [[1]]
#> [1] 3
#>
#> [[2]]
#> [1] 12
#>
#> [[3]]
#> [1] 21

while 循环

最后，我们将探讨使用与 for 循环不同的方式循环的 while 循环。在 for 循环的情况下，我们知道我们用于迭代的对象中的元素数量，因此我们事先知道将要执行多少次迭代。然而，有时在我们开始迭代之前并不知道这个数字，而是基于每次迭代后某个条件为真来迭代。这就是 while 循环有用的时候。

while 循环的工作方式是，我们指定一个条件，就像 if…else 条件一样，如果条件满足，我们就继续迭代。当迭代完成后，我们再次检查条件，如果它继续为真，我们就再次迭代，依此类推。请注意，在这种情况下，如果我们想在某个点停止，我们必须修改用于条件的元素，使得它在某个点评估为 FALSE。你还可以在 while 循环中使用 break 和 next。

以下示例展示了如何打印从 1 开始的整数，直到 10。请注意，如果我们从 1 开始，就像我们这样做，但每次迭代后不是加 1，而是减 1 或根本不改变x，那么我们永远不会停止迭代。这就是为什么在使用while循环时需要非常小心，因为迭代的次数可能是无限的：

x <- 1
while (x <= 10) {
    print(x)
    x <- x + 1
}
#> [1] 1
#> [1] 2
#> [1] 3
#> [1] 4
#> [1] 5
#> [1] 6
#> [1] 7
#> [1] 8
#> [1] 9
#> [1] 10

如果你想执行一个无限循环，你可以使用带有TRUE值的while循环来代替条件。如果你没有包含break命令，代码将实际上提供一个无限循环，并且会一直重复，直到使用CTRL + C键盘命令或你使用的 IDE 中的任何其他停止机制来停止。然而，在这种情况下，使用下面所示的方式使用repeat构造会更干净。这看起来可能有些反直觉，但有时使用无限循环是有用的。我们将在第八章，面向对象系统追踪加密货币中看到这样一个案例，但在这种情况下，你有一个外部机制，基于 R 之外的条件来停止程序。

执行以下示例将使你的 R 会话崩溃：

# DO NOTE EXCEUTE THIS, IT's AN INFINITE LOOP

x <- 1
repeat {
    print(x)
    x <- x + 1
}

#> [1] 1
#> [1] 2
#> [1] 3
#> [1] 4
#> [1] 5
#> [1] 5
...

本书中的示例

为了结束这一章的介绍，我想向你介绍我们将在本书的其余部分开发的三个示例。第一个是《英国脱欧投票》案例，我们将使用真实的英国脱欧投票数据，并通过描述性统计和线性模型，尝试理解结果背后的群体动态。如果你不熟悉英国脱欧，它是指 2016 年 6 月 23 日举行公投后，英国可能从欧盟撤出的流行术语（en.wikipedia.org/wiki/Brexit）。本例将通过第二章，使用描述性统计理解投票和第三章，使用线性模型预测投票来开发。

第二个示例是《食品工厂》案例，在这个案例中，你将学习如何为名为《食品工厂》的假设公司模拟各种类型的数据，以及如何整合来自其他来源的真实数据（在这种情况下是客户评价）来补充我们的模拟。这些数据将被用于开发各种自动更新的可视化、文本分析和演示。本例将通过以下章节开发：第四章，模拟销售数据和数据库操作；第五章，通过可视化沟通销售；第六章，通过文本分析理解评价；以及第七章，开发自动演示。

第三个也是最后一个例子是 加密货币跟踪系统，在这个例子中，我们将开发一个面向对象的系统，用于从加密货币市场检索实时价格数据以及我们所持有的加密货币资产数量。然后我们将展示如何使用性能优化技术高效地计算简单移动平均，最后我们将展示如何仅使用 R 构建交互式网络应用程序。这个例子将在第八章，面向对象的加密货币跟踪系统；第九章，实现高效的简单移动平均；以及第十章，使用仪表板添加交互性中开发。

摘要

在本章中，我们通过提及目标受众以及我们的意图来介绍这本书，我们的意图是提供一些例子，您可以使用这些例子来理解如何使用高质量的代码构建实际的 R 应用程序，以及构建您自己的应用程序时应该做什么和不应该做什么的有用指南。

我们还介绍了 R 的基本结构，并为我们通过本书其余部分开发的例子准备了基础。具体来说，我们探讨了如何与控制台交互，如何创建和使用变量，如何处理 R 的基本数据类型，如数值、字符和逻辑，以及如何处理特殊值，以及如何基本使用数据结构，如向量、因子、矩阵、数据框和列表。最后，我们展示了如何创建我们自己的函数以及如何使用控制结构提供多个执行路径。

我希望这本书对您有用，并且您会喜欢阅读它。

第二章：使用描述性统计理解投票

本章展示了如何进行描述性统计分析，以获得我们处理的数据的一般概念，这通常是数据分析项目的第一步，也是数据分析师的基本能力。我们将学习如何清洗和转换数据，以有用的方式总结数据，找到特定的观察结果，创建各种类型的图表，以提供对数据的直观理解，使用相关性来理解数值变量之间的关系，使用主成分来找到最优变量组合，并将所有这些整合到可重用、可理解和易于修改的代码中。

由于这本书是关于使用 R 进行编程的，而不是使用 R 进行统计分析，因此我们的重点将放在编程方面，而不是统计方面。阅读时请记住这一点。

本章涵盖的一些重要主题如下：

• 清洗、转换和操作数据

• 以编程方式创建各种类型的图表

• 使用 R 中的各种工具进行定性分析

• 使用主成分分析构建新变量

• 开发模块化和灵活的代码，易于使用

本章所需软件包

在本章中，我们将使用以下 R 软件包。如果您还没有安装它们，可以查阅附录，所需软件包部分，了解如何安装。

软件包	用途
ggplot2	高质量图表
viridis	图表颜色调色板
corrplot	相关性图
ggbiplot	主成分图
progress	显示迭代的进度

Brexit 投票示例

2016 年 6 月，英国举行了一次公投，以决定是否继续留在欧盟。72% 的注册选民参与了投票，其中 51.2% 的人投票离开欧盟。2017 年 2 月，BBC 新闻的自由信息专家马丁·罗森鲍姆发表了文章《地方投票数据为欧盟公投提供了新的见解》（www.bbc.co.uk/news/uk-politics-38762034）。他从 1,070 个选区（英国用于选举的最小行政区域）获得了数据，包括每个选区的离开和留下投票数。

马丁·罗森鲍姆通过利用 2011 年进行的最新英国人口普查，计算了选区中Leave投票比例与其一些社会、经济和人口特征之间的统计关联。他使用这些数据为大学课程授课，这就是我们将在本例中使用的数据，其中一些变量已被删除。数据以 CSV 文件（data_brexit_referendum.csv）的形式提供，可以在本书的配套代码库中找到（github.com/PacktPublishing/R-Programming-By-Example）。表格显示了数据中包含的变量：

数据变量描述

清理和设置数据

设置本例的数据非常直接。我们将加载数据，正确标记缺失值，并为我们的分析创建一些新变量。在我们开始之前，请确保data.csv文件与你的代码在同一目录下，并且你的工作目录已正确设置。如果你不知道如何操作，设置工作目录相当简单，你只需调用setwd()函数，并传入你想要使用的目录即可。例如，setwd(/home/user/examples/)将会使用/home/user/examples目录来查找文件，并将文件保存到该目录。

如果你不知道如何操作，设置工作目录相当简单，你只需调用setwd()函数，并传入你想要使用的目录即可。例如，setwd(/home/user/examples/)将会使用/home/user/examples 目录来查找文件，并将文件保存到该目录。

我们可以通过使用read.csv()函数将data.csv文件的内容加载到数据框中（这是与 CSV 格式数据最直观的结构）。请注意，数据中的Leave变量有一些缺失值。这些值具有-1的值来标识它们。然而，在 R 中标识缺失值的正确方式是使用NA，这是我们用来替换-1值的。

data <- read.csv("./data_brexit_referendum.csv") 
data[data$Leave == -1, "Leave"] <- NA 

要计算数据中缺失值的数量，我们可以使用is.na()函数来获取一个包含TRUE值以标识缺失值和FALSE值以标识非缺失值的逻辑（布尔）向量。这样一个向量的长度将与用作输入的向量的长度相等，在我们的例子中是Leave变量。然后，我们可以使用这个逻辑向量作为sum()函数的输入，同时利用 R 处理这样的TRUE/FALSE值的方式来获取缺失值的数量。TRUE被视为1，而FALSE被视为0。我们发现Leave变量中的缺失值数量为 267。

sum(is.na(data$Leave))
#> [1] 267

如果我们想，我们可以使用一种机制来填充缺失值。一种常见且简单的方法是估计变量的平均值。在我们的案例中，在第三章，使用线性模型预测投票中，我们将使用线性回归来估计这些缺失值。然而，我们现在将保持简单，只将它们作为缺失值留下。

现在我们继续定义一个新变量，名为Proportion，它将包含支持离开欧盟的投票百分比。为此，我们将Leave变量（支持离开的投票数）除以NVotes变量（总投票数），对于每个选区。鉴于 R 的向量化特性，这很简单：

data$Proportion <- data$Leave / data$NVotes

我们通过简单地赋值来在数据框中创建一个新变量。创建新变量和修改现有变量之间没有区别，这意味着我们在这样做时需要小心，以确保我们没有意外地覆盖了旧变量。

现在，创建一个新变量，该变量包含对每个选区是否大多数投票支持离开或留在欧盟的分类。如果一个选区的投票超过 50%支持离开，那么我们将标记该选区为投票支持离开，反之亦然。同样，R 使用ifelse()函数使这个过程变得非常简单。如果提到的条件（第一个参数）为真，则分配的值将是"Leave"（第二个参数）；否则，它将是"Remain"（第三个参数）。这是一个向量化操作，因此它将对数据框中的每个观测值执行：

data$Vote <- ifelse(data$Proportion > 0.5, "Leave", "Remain")

有时，人们喜欢为这些类型的操作使用不同的语法；他们会使用子集赋值方法，这与我们使用的方法略有不同。我们不会深入探讨这些方法之间的差异，但请记住，在我们的情况下，后一种方法可能会产生错误：

data[data$Proportion >  0.5, "Vote"] <- "Leave"
data[data$Proportion <= 0.5, "Vote"] <- "Remain"

#> Error in `<-.data.frame`(`*tmp*`, data$Proportion 0.5, "Vote", value = "Leave"): 
#>   missing values are not allowed in subscripted assignments of data frames

这是因为Proportion变量包含一些缺失值，这些缺失值是Leave变量最初有一些NA值的结果。由于我们无法为Leave中具有NA值的观测值计算Proportion值，当我们创建它时，相应的值也会被分配一个NA值。

如果我们坚持使用子集赋值方法，我们可以通过使用which()函数使其工作。它将忽略（返回FALSE）那些比较中包含NA的值。这样它就不会产生错误，我们将会得到与使用ifelse()函数相同的结果。当可能时，我们应该使用ifelse()函数，因为它更简单，更容易阅读，并且更高效（更多关于这一点在第九章[第九章，实现高效的简单移动平均)。

data[which(data$Proportion >  0.5), "Vote"] <- "Leave"
data[which(data$Proportion <= 0.5), "Vote"] <- "Remain"

在未来，我们希望创建包含 RegionName 信息的图表，而长名称可能会使它们难以阅读。为了解决这个问题，我们可以在清理数据的过程中缩短这些名称。

data$RegionName <- as.character(data$RegionName)
data[data$RegionName == "London", "RegionName"]                   <- "L"
data[data$RegionName == "North West", "RegionName"]               <- "NW"
data[data$RegionName == "North East", "RegionName"]               <- "NE"
data[data$RegionName == "South West", "RegionName"]               <- "SW"
data[data$RegionName == "South East", "RegionName"]               <- "SE"
data[data$RegionName == "East Midlands", "RegionName"]            <- "EM"
data[data$RegionName == "West Midlands", "RegionName"]            <- "WM"
data[data$RegionName == "East of England", "RegionName"]          <- "EE"
data[data$RegionName == "Yorkshire and The Humber", "RegionName"] <- "Y"

注意到上一个代码块中的第一行是将 RegionName 转换为字符类型的赋值。在我们这样做之前，变量的类型是因子（这是使用 read.csv() 读取数据的默认方式产生的），它阻止我们从变量中分配不同的值。在这种情况下，我们会得到一个错误，Invalid factor level, NA generated。为了避免这个问题，我们需要执行类型转换。

现在我们有了干净的数据，准备进行分析。我们创建了一个新的感兴趣变量（Proportion），这将是本章和下一章的焦点，因为在这个例子中，我们感兴趣的是找出其他变量之间的关系以及人们在公投中的投票情况。

将数据汇总到数据框中

为了获取数据的概要，我们可以执行 summary(data) 并查看每种类型变量的相关概要。概要针对每一列的数据类型进行了定制。正如您所看到的，数值变量，如 ID 和 NVotes，会得到分位数概要，而因子（分类）变量会为每个不同的类别提供计数，例如 AreaType 和 RegionName。如果有许多类别，概要将显示出现次数最多的类别，并将其余的类别归入一个（其他）组，正如我们在 RegionName 的底部所看到的。

summary(data)
#>       ID        RegionName              NVotes          Leave
#> Min.   :  1    Length: 1070        Min.   : 1039    Min.   : 287
#> 1st Qu.: 268   Class : character   1st Qu.: 4252    1st Qu.: 1698
#> Median : 536   Mode  : character   Median : 5746    Median : 2874
#> Mean   : 536                       Mean   : 5703    Mean   : 2971
#> 3rd Qu.: 803                       3rd Qu.: 7020    3rd Qu.: 3936
#> Max.   : 1070                      Max.   : 15148   Max.   : 8316
(Truncated output)

从这里，我们可以看到伦敦是拥有更多选区的地区，其次是西北部和西米德兰兹。我们还可以看到，所有数据中投票最少的选区只有 1,039 票，投票最多的是 15,148 票，每个选区的平均投票数是 5,703。我们将在本章的后面部分更深入地探讨这类分析。现在，我们将专注于使这些汇总数据对进一步分析有用。如您所注意到的，我们无法使用 summary() 的结果进行计算。我们可以尝试将概要保存到变量中，找出变量类型，并以适当的方式遍历它。然而，如果我们这样做，我们会发现它是文本数据，这意味着我们不能直接用它进行计算：

summary <- summary(data) 
class(summary) 
#> [1] "table"
summary[1]
#> [1] "Min.   : 1  "
class(summary[1])
#> [1] "character"

当然，肯定有办法将 summary 数据放入数据框中进行进一步分析。这是 R，所以你可以确信有！我们应该注意的第一件事是，由于非数值变量，我们无法直接将 summary() 函数的输出转换为数据框。这些非数值变量包含不同的摘要结构，该结构不是由最小值、第一四分位数、中位数、平均值、第三四分位数和最大值组成的。这意味着我们首先需要子集数据，以仅获取数值变量。毕竟，数据框是一个具有良好定义的行和列的矩形结构。如果我们试图混合类型（通过包括数值和非数值摘要），那么在数据框中这样做将会很困难。

要检查一列是否为数值，我们可以使用 is.numeric() 函数。例如，我们可以看到 Proportion 列是数值的，而 RegionName 则不是：

is.numeric(data$Proportion) 
#> [1] TRUE
is.numeric(data$RegionName)
#> [1] FALSE

然后，我们可以通过使用 sapply() 函数将 is.numeric() 应用于每个列。这将给我们一个逻辑（布尔）向量，其中每个列都有一个 TRUE 或 FALSE 值，指示该列是否为数值。然后我们可以使用这个逻辑向量来子集我们的数据，并仅获取具有 data[, numerical_variables] 的数值列。正如你所见，data_numerical 对象中没有非数值列：

numerical_variables <- sapply(data, is.numeric) 
numerical_variables 
#>            ID   RegionName         NVotes       Leave   Residents
#>          TRUE        FALSE           TRUE        TRUE        TRUE
#>    Households      MeanAge   AdultMeanAge   Aget_0to4   Age_5to7
#>          TRUE         TRUE           TRUE        TRUE        TRUE
(Truncated output)

data_numerical <- data[, numerical_variables] 
colnames(data_numerical)
#>  [1] "ID"           "Nvotes"       "Leave"          "Residents"
#>  [5] "Households"   "MeanAge"      "AdultMeanAge"   "Age_0to4"
#>  [9] "Age_5to7"     "Age_8to9"     "Age_10to14"     "Age_15"
#> [13] "Age_16to17    "Age_18to19"   "Age_20to24"     "Age_25to29"
(Truncated output)

由于获取 ID 变量的 summary 值没有太多意义，我们可以将其从逻辑向量中移除，实际上将其视为非数值变量。如果我们这样做，我们必须记住重新创建 data_numeric 对象，以确保它不包含 ID 变量：

numerical_variables[["ID"]] <- FALSE 
data_numerical <- data[, numerical_variables]

要创建我们的数值变量摘要，我们首先将使用之前使用的 summary() 函数，通过 lapply() 函数将其应用于每个数值列。lapply() 函数返回一个命名列表，其中每个列表成员都有相应的列名：

lapply(data[, numerical_variables], summary)
#> $NVotes
#>    Min. 1st Qu. Median  Mean 3rd Qu.  Max.
#>    1039    4252   5746  5703   7020  15148
#>
#> $Leave
#>    Min. 1st Qu. Median  Mean 3rd Qu.  Max.
#>     287    1698   2874  2971    3936  8316
#>
#> $Residents
#>    Min. 1st Qu. Median   Mean 3rd Qu.   Max.
#>    1932    8288  11876  11646   14144  34098
#>
(Truncated output)

现在，我们需要将这个列表的每个成员组合成一个数据框。为此，我们将使用 cbind() 和 do.call() 函数。do.call() 将依次将 cbind() 应用于由 lapply() 生成的列表的每个成员，并将它们全部返回。要了解这些向量化操作是如何工作的，请参阅第一章，R 语言简介：

numerical_summary <- do.call(cbind, lapply(data_numerical, summary))
#> Warning in (function (..., deparse.level = 1) : number of rows of result is
#> not a multiple of vector length (arg 1)

numerical_summary
#>          NVotes Leave Residents Households MeanAge AdultMeanAge Age_0to4
#> Min.       1039   287      1932       779    27.80        29.20    2.200
#> 1st Qu.    4252  1698      8288      3466    35.60        44.10    5.400
#> Median     5746  2874     11876      4938    38.70        47.40    6.300
#> Mean       5703  2971     11646      4767    38.45        46.85    6.481
#> 3rd Qu.    7020  3936     14144      5832    41.40        49.90  7.50058
#> Max.      15148  8316     34098     15726    51.60        58.10   12.300
#> NA's       1039   267      1932       779    27.80        29.20    2.200

我们得到了我们的结果，但别急着走！我们得到了一个警告，看起来很可疑。这个“结果行数不是向量长度的倍数”信息是什么意思？啊哈！如果我们更详细地查看我们之前从 lapply() 函数得到的列表，我们可以看到在 Leave（和 Proportion）的情况下，我们得到了一个额外的 NAs 列，而其他任何列都没有。这意味着当我们尝试对这些列使用 cbind() 时，额外的 NAs 列将创建一个需要填充的额外空间。这是我们之前在 第一章，R 语言入门 中探讨过的问题。

正如我们所见，R 通过重复向量直到所有空间都被填满来处理这个问题。在我们的情况下，这意味着第一个元素，即对应最小值的元素，将重复用于每个没有 NAs 空间的列的 NAs 空间。你可以通过比较除了 Leave 或 Proportion 之外变量的 Min 和 NAs 列的数字来验证这一点（对于这两个变量，值实际上应该是不同的）。

为了解决这个问题，我们只需从结果数据框中移除额外的 NA 值的行，但这只会处理警告的症状，而不是根源。要处理根源，我们需要在应用 cbind() 之前为每个变量有相同数量的列。由于我们已经知道 Leave 变量有 267 个缺失值，这随后影响了 Proportion 变量，我们可以很容易地通过忽略这些信息来解决这个问题。为此，我们只需使用 完整案例，这意味着我们保留那些在任何变量中都没有 NA 值的观测值；或者，换句话说，我们删除包含至少一个 NA 的任何观测值。一旦我们这样做，我们就会得到我们的结果，并且不会得到任何警告：

data <- data[complete.cases(data), ] 
data_numerical <- data[, numerical_variables] 
numerical_summary <- do.call(cbind, lapply(data_numerical, summary))
numerical_summary
#>         NVotes Leave Residents Households MeanAge AdultMeanAge Age_0to4
#> Min.      1039   287      1932        779   28.40        30.50    2.200
#> 1st Qu.   4242  1698      8405       3486   35.70        44.10    5.400
#> Median    5739  2874     11911       4935   38.60        47.40    6.300
#> Mean      5725  2971     11739       4793   38.43        46.83    6.479
#> 3rd Qu.   7030  3936     14200       5850   41.40        49.90    7.500
#> Max.     15148 8316      34098      15726   47.30        56.10   12.300
(Truncated output)

如果我们想将汇总值作为列，变量作为行，我们可以使用 rbind() 函数而不是 cbind()。我们最终使用的结构将取决于我们想用它做什么。然而，如果我们需要，我们可以很容易地在它们之间进行转换：

do.call(rbind, lapply(data_numerical, summary))
#>                  Min.    1st Qu.    Median       Mean     3rd Qu.      Max.
#> NVotes     1039.0000  4241.5000  5.739e+03  5.725e+03  7.030e+03  1.515e+04
#> Leave       287.0000  1697.5000  2.874e+03  2.971e+03  3.936e+03  8.316e+03
#> Residents  1932.0000  8405.0000  1.191e+04  1.174e+04  1.420e+04  3.410e+04
#> Households  779.0000  3486.0000  4.935e+03  4.793e+03  5.850e+03  1.573e+04
#> MeanAge      28.4000    35.7000  3.860e+01  3.843e+01  4.140e+01  4.730e+01

现在我们有了这个 numerical_summary 对象，我们可以用它来进行计算，例如找出赞成离开（0.6681）比例最少和最多的区域之间的范围，这可能有助于解释我们在英国可能发现的区域类型之间的巨大差异。如果我们想知道哪些区域被用来得到这个结果，我们可以搜索赞成比例最少和最多的区域：

numerical_summary["Max.", "Proportion"] - numerical_summary["Min.", "Proportion"] 
desired_variables <- c( 
    "ID", 
    "NoQuals", 
    "Proportion", 
    "AdultMeanAge", 
    "L4Quals_plus", 
    "RegionName" 
) 

>data[which.max(data$Proportion), desired_variables]
#>        ID NoQuals Proportion AdultMeanAge L4Quals_plus RegionName
#> 754   754    35.8     0.7897         48.7         13.7          L

data[which.min(data$Proportion), desired_variables]
#>      ID NoQuals Proportion AdultMeanAge L4Quals_plus RegionName
#> 732 732     2.8     0.1216         31.2         44.3         EE

如您所见，这项分析已经显示了一些有趣的结果。投票离开欧盟最多的英国区域特点是老年人（MeanAge）和低教育水平（NoQuals，L4Quals_plus）。另一方面，投票留在欧盟最多的英国区域特点是年轻人，教育水平很高。当然，这并不是全部情况，但它提示我们需要进一步了解正在发生的事情的方向。到目前为止，我们发现教育和年龄似乎是分析的相关变量。

通过图表和相关性获得直观感受

现在我们有一些干净的数据可以处理，我们将创建许多图表来建立对数据的直观理解。在本章中，我们将处理易于创建且用于探索目的的图表。在第四章“模拟销售数据和数据库操作”中，我们将探讨创建起来稍微复杂一些的、可用于发表的图表。

可视化变量分布

我们的第一张图表非常简单，显示了每个RegionName的投票比例。如图下所示，伦敦、西北部和西米德兰兹地区的观测值占数据中的约 55%。

按区域投票比例

要创建图表，我们需要使用table()函数为RegionName中的每个区域的频率创建一个表格，然后将这个表格输入到prop.table()函数中，该函数计算相应的比例，这些比例随后被用作每个条形的高度。

我们使用barplot()函数来生成图表，并且可以指定一些选项，例如标题（main）、y 轴标签（ylab）和条形的颜色（col）。和往常一样，你可以通过? barplot来了解该函数的更多参数：

table(data$RegionName) 
#> EE EM   L NE  NW SE SW  WM  Y
#> 94 20 210 32 134 79 23 133 78

prop.table(table(data$RegionName))
#>      EE      EM       L      NE      NW      SE      SW      WM       Y
#> 0.11706 0.02491 0.26152 0.03985 0.16687 0.09838 0.02864 0.16563 0.09714

barplot( 
    height = prop.table(table(data$RegionName)), 
    main = "Vote Proportion by Region", 
    ylab = "Frequency", 
    col = "white"
)

我们接下来的图表，如图下所示，更具吸引力。每个点代表一个区域观测值，它显示了每个区域的Leave投票比例，这些比例按照RegionName对应的垂直线排列，并按每个区域的白色人口比例着色。如图所示，我们还有另一个有趣的发现；似乎一个区域的居民人口越多元化（在较暗的点中可见），该区域投票支持留在欧盟的可能性就越大（Proportion值较低）。

按区域名称和白色人口百分比的比例

要创建图表，我们需要加载ggplot2和viridis包；第一个包将用于创建实际的图表，而第二个包将用于使用名为Viridis的科学色彩调色板（它来自 Nathaniel Smith 和 Stéfan van der Walt 进行的颜色感知研究，bids.github.io/colormap/）来着色点。ggplot2语法的细节将在第四章，模拟销售数据和数据库操作中解释，但就现在而言，你需要知道的是，该函数将数据框作为第一个参数接收，该数据框包含用于图表的数据，并将aes对象作为第二个参数接收，该对象通过aes()函数创建，它可以接收用于x轴、y轴和颜色的参数。之后，我们使用geom_points()函数添加一个点层，并使用scale_color_viridis()函数添加 Viridis 色彩调色板。注意我们在使用ggplot2时添加图表对象的方式。这是一个非常方便的功能，提供了很多功能和灵活性。最后，我们使用print()函数（在 R 中，一些用于绘图的函数会立即显示图表（例如，barplot），而其他函数返回一个图表对象（例如，ggplot2）并需要显式打印）来显示图表：

library(ggplot2)
library(viridis)

plot <- ggplot(data, aes(x = RegionName, y = Proportion, color = White))
plot <- plot + geom_point() + scale_color_viridis()
print(plot)

下面的图表集显示了NoQuals、L4Quals_plus和AdultMeanAge变量的直方图。正如你所见，NoQuals变量似乎呈正态分布，但L4Quals_plus和AdultMeanAge变量似乎分别向左和向右偏斜。这告诉我们，样本中的大多数人教育水平不高，年龄超过 45 岁。

NoQuals、L4Quals_plus 和 AdultMeanAge 的直方图

创建这些图表很简单；你只需将用于直方图的变量传递给hist()函数，并且可以可选地指定图表的标题和x轴标签（我们将其留空，因为信息已经在图表的标题中了）。

对于这本书，我们以这种方式排列图表，使其间距和理解效率更高，但当你使用显示的代码创建图表时，你会逐个看到它们。有方法可以将各种图表组合在一起，但我们将它们放在第四章，模拟销售数据和数据库操作中讨论。

让我们看一下以下代码：

hist(data$NoQuals, main = "Histogram for NoQuals", xlab = "")
hist(data$L4Quals_plus, main = "Histogram for L4Quals_plus", xlab = "")
hist(data$AdultMeanAge, main = "Histogram for AdultMeanAge", xlab ="")

现在我们对NoQuals、L4Quals_plus和AdultMeanAge变量的分布有了更多了解，我们将看到它们在下面显示的散点图中的联合分布。我们可以通过比较散点图中的x轴和y轴与直方图中的相应x轴，以及比较直方图中的频率（高度）与散点图中的点密度，来看到这些散点图如何类似于直方图。

NoQuals 与 L4Quals_plus 对成人平均年龄的散点图

我们发现了一个轻微的关系，表明人们越老，他们的教育水平就越低。这可以有多种解释，但我们将其留作练习，以保持对编程的关注，而不是对统计学的关注。创建这些散点图也非常简单。只需将x和y变量发送到plot()函数，并可选地指定轴标签。

plot(x = data$NoQuals, y = data$AdultMeanAge, ylab = "AdultMeanAge", xlab = "NoQuals")
plot(x = data$L4Quals_plus, y = data$AdultMeanAge, ylab = "AdultMeanAge", xlab = "L4Quals_plus")

使用矩阵散点图进行快速概述

如果我们想在单个图中可视化许多散点图以快速了解数据，会发生什么？在这种情况下，我们需要矩阵散点图。我们有各种包选项来创建此类矩阵散点图（例如car包）。然而，为了保持简单，我们将使用内置函数而不是外部包。

通过查看下面的图表，我们可以获得变量之间相互作用的整体视图。此类可视化的目的不是提供细节，而是提供一个一般性的概述。要阅读此图，我们需要查看矩阵中的任何有趣的散点图，并水平垂直移动，直到找到与其轴相关联的名称。

例如，如果你看NoQuals右侧的图，同时立即在L4Quals_plus上方，你所看到的是这两个变量之间的关系（NoQuals在y轴上，L4Quals_plus在x轴上），我们发现这是一种反向关系；一个区域中受过高等教育的人的百分比越高，受过低教育的人的百分比就越低。另一个明显的关联是，教育水平（L4Quals_plus）越高，职业（HigherOccup）就越高。

矩阵散点图

由于空间限制，我们无法显示所有变量关系，因为散点图会太小而无法理解。然而，我们鼓励读者将更多变量添加到矩阵中。有一些不明显的关系。找到它们留给读者作为练习：

desired_variables <- c(
    "AdultMeanAge",
    "White",
    "Owned",
    "NoQuals",
    "L4Quals_plus",
    "Unemp",
    "HigherOccup",
    "Deprived",
    "Proportion"
)
pairs(data[, desired_variables])

通过详细的散点图获得更好的视角

现在我们已经知道了如何从散点图中获得整体视图，以获得变量之间关系的总体感觉，那么我们如何能够更详细地查看每个散点图呢？嗯，很高兴你提出了这个问题！为了实现这一点，我们将分两步进行。首先，我们将努力制作一个单一、详细的散点图，让我们感到满意。其次，我们将开发一个简单的算法，该算法将遍历所有变量组合，并为每个组合创建相应的图表：

散点图：NoQuals 对 AdultMeanAge 对 Proportion 与回归线

上图所示的是我们的原型散点图。它在x和y轴上组合了变量，在我们的例子中是NoQuals和AdultMeanAge，根据相应的Proportion分配颜色，并在顶部放置一条对应线性回归的线，以获得轴上变量之间关系的总体感觉。将此图与之前一对散点图中的左侧散点图进行比较。它们是同一个图，但这个图更详细，传达了更多信息。这个图现在看起来已经足够好了。

plot <- ggplot(data, aes(x = NoQuals, y = AdultMeanAge, color = Proportion))
plot <- plot + stat_smooth(method = "lm", col = "darkgrey", se = FALSE)
plot <- plot + scale_color_viridis()
plot <- plot + geom_point()
print(plot)

现在我们需要开发一个算法，该算法将接受所有变量组合并创建相应的图表。我们展示了完整的算法，并逐部分进行解释。正如你所看到的，我们开始定义create_graphs_iteratively函数，它接受两个参数：data和plot_function。该算法将获取数据的变量名称并将它们存储在vars变量中。然后它将从这些变量中移除Proportion，因为它们将被用来创建轴的组合，而Proportion将永远不会用于轴；它将仅用于颜色。

现在，如果我们想象所有变量组合在一个矩阵中，就像之前显示的矩阵散点图那样，那么我们需要遍历上三角形或下三角形以获得所有可能的组合（实际上，散点图的矩阵的上三角形和下三角形是对称的，因为它们传达相同的信息）。为了遍历这些三角形，我们可以使用一个已知模式，它使用两个 for 循环，每个循环对应一个轴，内循环只需要从外循环的位置开始（这就是形成三角形的原因）。-1和+1的存在是为了确保我们在每个循环中开始和结束在适当的位置，而不会因为数组边界错误而出现错误。

在内循环内部，我们将创建图表的名称，它是变量名称的组合，并使用paste()函数将它们连接起来，同时使用我们将作为参数发送的plot_function创建图表（关于这一点后面会详细介绍）。png()和dev.off()函数用于将图表保存到计算机的硬盘上。将png()函数视为 R 开始寻找图形的地方，将dev.off()视为停止保存过程的地方。您可以自由查看它们的文档或阅读更多关于 R 中的设备的信息。

create_plots_iteratively <- function(data, plot_function) {
    vars <- colnames(data)
    vars <- vars(!which(vars == "Proportion"))
    for (i in 1:(length(vars) - 1)) {
        for (j in (i + 1):length(vars)) {
            save_to <- paste(vars[i], "_", vars[j], ".png", sep = "")
            plot_function(data, vars[i], vars[j], save_to)
        }
    }
}

我们几乎完成了；我们只需将我们用来将绘图原型转换为函数的代码包装起来，我们就可以一切就绪。正如你所见，我们提取了x、y和color参数作为变量，并将它们作为参数发送给函数（这被称为参数化参数），并且我们将aes()函数替换为aes_string()函数，后者能够接收带有字符串参数的变量。我们还添加了将var_color作为FALSE发送的选项，以避免使用带有颜色的图表版本。其他一切保持不变：

prototype_scatter_plot <- function(data, var_x, var_y, var_color = "Proportion", save_to = "") {
    if (is.na(as.logical(var_color))) {
        plot <- ggplot(data, aes_string(x = var_x, y = var_y, color = var_color))
    } else {
        plot <- ggplot(data, aes_string(x = var_x, y = var_y))
    }
    plot <- plot + stat_smooth(method = "lm", col = "darkgrey", se = FALSE)
    plot <- plot + scale_color_viridis()
    plot <- plot + geom_point()
    if (not_empty(save_to)) png(save_to)
    print(plot)
    if (not_empty(save_to)) dev.off()
}

由于我们将在多个地方检查save_to字符串是否为空，因此我们给检查命名，并将其包装在not_empty()函数中。现在阅读我们的代码稍微容易一些。

not_empty <- function(file) {
    return(file != "")
}

使用这个prototype_scatter_plot()函数，我们可以轻松地重新创建之前显示的正确散点图，以及任何其他变量组合。这似乎非常强大，不是吗？

L4Quals_plus 与 AdultMeanAge 与 Proportion 的散点图，带有回归线

让我们看看以下代码：

prototype_scatter_plot(data, "L4Quals_plus", "AdultMeanAge")

现在我们已经完成了艰苦的工作，我们可以非常容易地创建所有可能的组合。我们只需调用create_plots_iteratively()函数并传入我们的数据和prototype_scatter_plot()函数。将函数作为其他函数的参数使用称为策略模式。这个名字来源于我们可以轻松地更改我们的绘图策略，以适应任何其他我们想要的接收相同参数（data、var_x和var_y）以创建图表的策略，而无需更改我们的遍历变量组合的算法。这种灵活性非常强大：

create_plots_iteratively(data, prototype_scatter_plot)

这将为我们创建所有图表并将它们保存到我们的硬盘上。很酷，不是吗？现在我们可以独立查看每一个，并使用它们做我们需要的任何事情，因为我们已经将它们作为 PNG 文件拥有了。

理解相关性中的交互作用

相关系数是衡量两个变量之间线性关系的一个度量。其值范围从-1（表示完美的反比关系）到1（表示完美的正比关系）。正如我们创建了散点图的矩阵，我们现在将创建相关性的矩阵，下面是得到的图形。大圆圈表示高绝对相关性。蓝色圆圈表示正相关，而红色圆圈表示负相关。

为了创建这个图，我们将使用corrplot()函数从corrplot包中，并传递由 R 中的cor()函数计算的相关性数据，以及可选的文本标签参数（如颜色color和大小cex）。

变量相关性

现在，让我们看一下以下代码：

library(corrplot)
corrplot(corr = cor(data_numerical), tl.col = "black", tl.cex = 0.6)

如果我们查看Proportion变量与其他变量之间的关系，大蓝色圆圈中的变量与它呈正相关，这意味着该变量增加得越多，Proportion变量也增加的可能性就越大。例如，查看AdultMeanAge和NoQuals与Proportion之间的关系。如果我们发现Proportion与其他变量之间存在大红色圆圈，这意味着该变量增加得越多，Proportion减少的可能性就越大。例如，查看Age_25to29、Age_30to44和L4Quals_plus与Proportion之间的关系：

使用我们所学到的知识创建新的数据集

在本章中，我们所学到的知识是，年龄、教育和种族是理解人们在脱欧公投中投票方式的重要因素。受教育程度较高的年轻人与支持留在欧盟的投票相关。年长的白人与支持离开欧盟的投票相关。现在我们可以利用这些知识来创建一个更简洁的数据集，该数据集包含这些知识。首先，我们添加相关变量，然后移除非相关变量。

我们的新相关变量包括两组年龄（45 岁以下的成年人及以上 45 岁的成年人）、两组种族（白人和非白人）和两组教育水平（高教育水平和低教育水平）：

data$Age_18to44 <- (
    data$Age_18to19 +
    data$Age_20to24 +
    data$Age_25to29 +
    data$Age_30to44
)
data$Age_45plus <- (
    data$Age_45to59 +
    data$Age_60to64 +
    data$Age_65to74 +
    data$Age_75to84 +
    data$Age_85to89 +
    data$Age_90plus
)
data$NonWhite <- (
    data$Black +
    data$Asian +
    data$Indian +
    data$Pakistani
)
data$HighEducationLevel <- data$L4Quals_plus
data$LowEducationLevel  <- data$NoQuals

现在，我们移除用于创建新变量的旧变量。为了做到这一点，而无需手动指定完整的列表，我们可以利用所有这些变量都包含单词"Age"的事实，我们创建了一个包含单词"Age"的变量逻辑向量，其中包含TRUE值（如果变量内部包含该单词，否则为FALSE），并确保我们保留新创建的Age_18to44和Age_45plus变量。我们手动移除其他种族和教育水平：

column_names <- colnames(data)
new_variables <- !logical(length(column_names))
new_variables <- setNames(new_variables, column_names)
age_variables <- sapply(column_names, function(x) grepl("Age", x))
new_variables[age_variables]     <- FALSE
new_variables[["AdultMeanAge"]]  <- TRUE
new_variables[["Age_18to44"]]    <- TRUE
new_variables[["Age_45plus"]]    <- TRUE
new_variables[["Black"]]         <- FALSE
new_variables[["Asian"]]         <- FALSE
new_variables[["Indian"]]        <- FALSE
new_variables[["Pakistani"]]     <- FALSE
new_variables[["NoQuals"]]       <- FALSE
new_variables[["L4Quals_plus"]]  <- FALSE
new_variables[["OwnedOutright"]] <- FALSE
new_variables[["MultiDeprived"]] <- FALSE

我们通过选择新列来保存创建的data_adjusted对象，为新的数据结构创建新的数值变量，并将其保存为 CSV 文件：

data_adjusted <- data[, new_variables]
numerical_variables_adjusted <- sapply(data_adjusted, is.numeric)
write.csv(data_adjusted, file = "data_brexit_referendum_adjusted.csv")

使用主成分构建新变量

主成分分析（PCA）是一种降维技术，在数据分析中当存在许多数值变量，其中一些可能相关联，并且我们希望减少理解数据所需的维度时，被广泛使用。

它可能有助于我们理解数据，因为思考超过三个维度可能会出现问题，并且可以加速计算密集型的算法，特别是当变量数量很多时。通过 PCA，我们可以将大部分信息提取到仅由一个或两个以非常特定方式构建的变量中，这样它们可以捕捉到最大的方差，同时由于构造上的原因，它们之间是不相关的。

第一主成分是原始变量的线性组合，它捕捉了数据集中最大的方差（信息）。没有其他成分的方差可以比第一主成分更高。然后，第二主成分与第一个主成分正交，并且以这种方式计算，以捕捉数据中剩余的最大方差。依此类推。所有变量都是彼此正交的线性组合，这是它们彼此之间不相关的关键。足够多的统计学讨论；让我们继续编程吧！

在 R 中进行 PCA 时，我们有各种函数可以完成这项任务。提及其中一些，我们有来自stats包（内置）的prcomp()和princomp()，来自FactoMineR包的PCA()，来自ade4包的dudi.pca()，以及来自amap包的acp()。在我们的案例中，我们将使用 R 内置的prcomp()函数。

为了执行我们的 PCA，我们将使用上一节调整后的数据。首先，我们移除与比例相关的数值变量。然后，我们将数值数据发送到prcomp()函数，以及一些归一化参数。center = TRUE将从每个变量中减去其均值，而scale. = TRUE将使每个变量的方差为单位方差，从而有效地归一化数据。在执行 PCA 时归一化数据非常重要，因为它是一种对尺度敏感的方法：

numerical_variables_adjusted[["NVotes"]] <- FALSE
numerical_variables_adjusted[["Leave"]]  <- FALSE
data_numerical_adjusted <- data_adjusted[, numerical_variables_adjusted]
pca <- prcomp(data_numerical_adjusted, center = TRUE, scale. = TRUE)
pca
#> Standard deviations (1, .., p=21):
#> [1] 2.93919 2.42551 1.25860 1.13300 1.00800 0.94112 0.71392 0.57613
#> [9] 0.54047 0.44767 0.37701 0.30166 0.21211 0.17316 0.13759 0.11474
#> [17] 0.10843 0.09797 0.08275 0.07258 0.02717
#>
#> Rotation (n x k) = (21 x 21):
#>                     PC1       PC2      PC3       PC4      PC5
#> ID             0.008492 -0.007276  0.14499  0.174484 -0.82840
#> Residents      0.205721  0.004321  0.54743  0.303663  0.06659
#> Households     0.181071  0.008752  0.49902  0.470793  0.13119
#> AdultMeanAge  -0.275210  0.192311  0.14601 -0.011834  0.12951
#> White         -0.239842  0.112711 -0.25766  0.471189 -0.02500
#> Owned         -0.289544  0.085502  0.26954 -0.179515 -0.11673
(Truncated output)

当我们打印pca对象时，我们可以看到每个变量的标准差，但更重要的是，我们可以看到用于创建每个主成分的每个变量的权重。正如我们所见，当我们查看计算机上的完整输出时，在最重要的权重（绝对值最大的）中，我们有年龄和种族变量，以及其他一些变量，如房屋所有权。

如果您想获取新坐标系统中每个观测值的轴值，该坐标系统由主成分组成，您只需将数据中的每个观测值（每行）与pca对象中的旋转矩阵（pca$rotation）对应的权重相乘即可。例如，要知道数据中的第一个观测值相对于第二个主成分的位置，您可以使用以下方法：

as.matrix(data_numerical_adjusted[1, ]) %*% pca$rotation[, 1]

通常情况下，您可以通过以下行将矩阵运算应用于您的数据中所有观测值相对于pca对象中所有主成分的坐标，这将执行矩阵乘法。请注意，您不需要亲自进行此操作，因为 R 在分析结果时会自动为您完成。

as.matrix(data_numerical_adjusted) %*% pca$rotation

当我们查看pca的摘要时，我们可以看到每个主成分的标准差，以及它所捕获的方差比例和累积值。当决定在剩余分析中保留多少主成分时，这些信息很有用。在我们的案例中，我们发现仅用前两个主成分，我们就已经捕捉到了数据中大约 70%的信息，对于我们的情况可能已经足够了。

70%这个数字可以通过将我们要考虑的主成分的Proportion of variance值相加得到（按顺序，从PC1开始）。在这种情况下，如果我们把PC1和PC2的Proportion of variance相加，我们得到\(0.411 + 0.280 = 0.691\)，这几乎就是 70%。请注意，您可以直接查看Cumulative proportion来找到这个数字，而无需亲自进行求和，因为它会递增地累积Proportion of variance，从PC1开始。

主成分的方差

请花一点时间思考一下这项技术的强大之处：仅用两个变量，我们就能捕捉到原始 40 个变量中包含的 70%信息：

summary(pca)
#> Importance of components:
#>                          PC1   PC2    PC3    PC4    PC5    PC6    PC7
#> Standard deviation     2.939 2.426 1.2586 1.1330 1.0080 0.9411 0.7139
#> Proportion of Variance 0.411 0.280 0.0754 0.0611 0.0484 0.0422 0.0243
#> Cumulative Proportion  0.411 0.692 0.7670 0.8281 0.8765 0.9186 0.9429
#>                           PC8    PC9    PC10    PC11    PC12    PC13
#> Standard deviation     0.5761 0.5405 0.44767 0.37701 0.30166 0.21211
#> Proportion of Variance 0.0158 0.0139 0.00954 0.00677 0.00433 0.00214
#> Cumulative Proportion  0.9587 0.9726 0.98217 0.98894 0.99327 0.99541
#>                           PC14   PC15    PC16    PC17    PC18    PC19
#> Standard deviation     0.17316 0.1376 0.11474 0.10843 0.09797 0.08275
#> Proportion of Variance 0.00143 0.0009 0.00063 0.00056 0.00046 0.00033
#> Cumulative Proportion  0.99684 0.9977 0.99837 0.99893 0.99939 0.99971
(Truncated output)

在上面的图中，我们可以看到summary(pca)结果中的方差（以平方标准差的形式）。我们可以看到每个后续主成分如何捕捉到更少的总方差：

plot(pca, type = "l", main = "Principal Components' Variances" )

最后，下面的图显示了 ward 观测值（点）在由我们的分析中两个主成分创建的平面上的散点图；它被称为双变量图。由于这两个主成分是原始变量的线性组合，因此在解释它们时我们需要一些指导。为了简化，箭头指向变量与主成分轴关联的方向。箭头离中心越远，对主成分的影响就越强。

PCA 双变量图

通过这个双图，我们可以看到比例与投票离开欧盟的选区有很强的相关性，这是显而易见的，因为这是构造出来的。然而，我们还可以看到一些其他有趣的关系。例如，除了我们迄今为止发现的效果（年龄、教育和种族）之外，拥有自己的房子的人也与投票离开欧盟的更高倾向略有关联。另一方面，一个以前未知的关系是，一个选区的居民越密集（想想高度人口密集的城市），他们投票留在欧盟的可能性就越大：

library(ggbiplot)
biplot <- ggbiplot(pca, groups = data$Vote)
biplot <- biplot + scale_color_discrete(name = "")
biplot <- biplot + theme(legend.position = "top", legend.direction = "horizontal")
print(biplot)

将所有内容整合成高质量的代码

现在我们已经了解了使用描述性统计来分析数据的基础知识，我们将通过将其分解成函数来改进代码的结构和灵活性。尽管这在高效程序员中是常识，但在数据分析师中却不是常见的做法。许多数据分析师会直接将我们开发的代码整体粘贴到一个文件中，每次他们想要进行数据分析时都运行它。我们不会向分析中添加新功能。我们唯一要做的就是将代码重新排序到函数中，以封装其内部工作原理并通过函数名传达意图（这大大减少了注释的需求）。

我们将专注于编写高质量的代码，这种代码易于阅读、重用、修改和修复（以防出现错误）。我们实际的做法是一个风格问题，不同的代码排列方式适合不同的上下文。我们将采用的方法是一种在各种情况下都对我很有帮助的方法，但它可能并不适合你。如果你觉得它不适合你的需求，请随意更改它。无论你更喜欢哪种风格，投资于培养不断生产高质量代码的习惯，将使你在长期内成为一个更高效的程序员，并且最终你会不想再以低效的方式进行编程。

编程前的规划

通常，人们在还没有一个关于他们想要完成什么的一般想法之前就开始编程。如果你是一个经验丰富的程序员，这可能是一个了解问题的好方法，因为你已经发展出了直觉，而且你很可能会扔掉前几次尝试。然而，如果你是一个新手程序员，我建议你在编写任何代码之前明确你的目标（将它们写下来可以帮助）。通过问自己某种做事方式将如何影响你的目标，这将帮助你做出更好的决定。因此，在我们设置任何东西之前，我们需要理解和明确我们的总体目标：

1. 快速理解分析的大致情况。

2. 通过执行单个文件自动重现我们的分析。

3. 保存分析产生的所有对象、文本和图像。

4. 测量执行完整分析所需的时间量。

5. 在进行迭代过程工作时，要知道完成百分比。

6. 能够轻松找到并更改分析的每一部分。

为了实现这些一般目标，我们需要开发模块化代码，具有良好管理的依赖关系，这些代码是灵活的（易于更改）并且对副作用友好（保存对象、文本和图像）。即使你的明确目标不需要这样做，你也应该养成这样编程的习惯，即使只是在进行数据分析时也是如此。

理解高质量代码的基本原理

模块化、灵活且依赖关系管理良好的代码被称为高度内聚和松散耦合。这些术语主要在面向对象环境中使用（更多内容请参阅第八章，《面向对象的加密货币跟踪系统》），但它们适用于任何系统。高度内聚意味着应该在一起的事物确实在一起。松散耦合意味着不应该在一起的事物确实没有在一起。以下图像展示了这些特征，其中每个圆圈都可以是一个函数或对象。这些都是依赖关系管理的基本原则。许多专注于这些主题的书籍已经出版，并且仍在出版。对于感兴趣的读者，Steve McConnell 的《代码大全》（Microsoft Press，2004）和 Robert Martin 的《代码整洁之道》（Prentice Hall，2009）是极好的参考。在这本书中，你将看到一些这些技术的应用。

高内聚和低耦合（左）与低内聚和高耦合（右）

高质量代码最重要的原则是：

1. 将事物分解成小而专注于单一职责的部分。

2. 具体依赖于抽象（而不是相反）。

3. 使事物具有高度内聚性和松散耦合性。

当我说“事物”时，指的是函数、方法、类和对象等。我们将在第八章中更多地讨论这些内容，《面向对象的加密货币跟踪系统》。

我们首先创建两个文件：functions.R 和 main.R。functions.R 文件包含高级函数（主要从 main.R 文件中调用）以及低级函数（在其他函数中使用）。通过阅读 main.R 文件，我们应该对分析的内容有一个清晰的认识（这是高级函数的目的），执行它应该能够为符合我们基本假设的任何数据重新创建我们的分析（对于这个例子，这些主要是数据结构）。

我们应该始终将相关代码保持在相同的抽象级别。这意味着我们不想在大图层面编程，然后用混合的细节来实现它，将代码分离到main.R和functions.R是朝这个方向迈出的第一步。此外，main.R文件中的任何代码都不应依赖于实现的细节。这使得代码模块化，从某种意义上说，如果我们想改变某个实现的方式，我们可以这样做，而无需更改高级代码。然而，我们实现事物的方式取决于我们想要分析最终要做什么，这意味着具体的实现应该依赖于抽象的实现，而抽象的实现又依赖于我们分析的目的（在main.R文件中以代码的形式表述）。

当我们将知识从一个代码集带到另一个代码集时，我们正在生成一个依赖关系，因为了解其他代码的代码依赖于它才能正常工作。我们尽可能地避免这些依赖关系，最重要的是，我们想要管理它们的方向。正如之前所述，抽象不应依赖于具体，或者换句话说，具体应依赖于抽象。由于分析（main.R）在抽象方面，它不应依赖于具体函数的实现细节。但是，我们的分析如何在没有了解实现它的函数的知识的情况下进行呢？嗯，它不能。这就是为什么我们需要一个中介，即抽象函数。这些函数的存在是为了向main.R提供稳定的知识，并保证所寻找的分析将被执行，并且通过管理这些知识来消除main.R对实现细节的依赖。这可能看起来是一种复杂的工作方式，也是一个难以理解的概念，但当你理解它时，你会发现它非常简单，你将能够创建可插入的代码，这将大大提高效率。你可能想看看之前提到的书籍，以更深入地了解这些概念。

通用代码结构

之前的图表显示，我们的分析依赖于抽象函数（接口），以及实现这些接口的具体代码。这些抽象函数让我们逆转了具体函数和分析之间的依赖关系。我们将在第八章面向对象系统跟踪加密货币中更深入地探讨这些概念。

通过可视化大图进行编程

现在，我们将采用自顶向下的方法，这意味着我们将首先从抽象代码开始，然后逐渐过渡到实现细节。通常我发现这种方法在你对想要做什么有清晰的想法时更有效。在我们的情况下，我们将从处理main.R文件开始。

需要注意的第一点是，我们将使用 proc.time() 函数两次，一次在开始时，一次在结束时，我们将使用这两个值之间的差异来衡量整个代码执行所需的时间。

需要注意的第二点是，empty_directories() 函数确保指定的每个目录都存在，并删除它们包含的任何文件。我们在每次执行开始时使用它来清理目录，以确保我们拥有最新的文件，并且只有上一次运行中创建的文件。实际的代码如下所示，它简单地遍历传递给每个目录，使用 unlink() 函数递归地删除任何文件，并使用 dir.create() 函数确保目录存在。通过使用 showWarnings = FALSE 参数，它避免了由于目录已存在而显示任何警告，这在我们的情况下不是问题。

empty_directories <- function(directories) {
    for (directory in directories) {
        unlink(directory, recursive = TRUE)
        dir.create(directory, showWarnings = FALSE)
    }
}

从 第一章，《R 语言入门》，我们使用 print_section() 和 empty_directories() 函数分别打印标题和删除目录内容（每次我们使用空目录运行函数时重新创建结果），并且我们将使用 proc.time() 显示的机制来测量执行时间。

现在前面两点已经解决，我们继续展示 main.R 文件的全部内容。

start_time <- proc.time()

source("./functions.R")

empty_directories(c(
    "./results/original/",
    "./results/adjusted/",
    "./results/original/scatter_plots/"
))

data <- prepare_data("./data_brexit_referendum.csv", complete_cases = TRUE)

data_adjusted           <- adjust_data(data)
numerical_variables     <- get_numerical_variable_names(data)
numerical_variables_adj <- get_numerical_variable_names(data_adjusted)

print("Working on summaries...")

full_summary(data, save_to = "./results/original/summary_text.txt")
numerical_summary(
    data,
    numerical_variables = numerical_variables,
    save_to = "./results/original/summary_numerical.csv"
)

print("Working on histograms...")

plot_percentage(
    data,
    variable = "RegionName",
    save_to = "./results/original/vote_percentage_by_region.png"
)

print("Working on matrix scatter plots...")

matrix_scatter_plots(
    data_adjusted,
    numerical_variables = numerical_variables_adj,
    save_to = "./results/adjusted/matrix_scatter_plots.png"
)

print("Working on scatter plots...")

plot_scatter_plot(
    data,
    var_x = "RegionName",
    var_y = "Proportion",
    var_color = "White",
    regression = TRUE,
    save_to = "./results/original/regionname_vs_proportion_vs_white.png"
)
all_scatter_plots(
    data,
    numerical_variables = numerical_variables,
    save_to = "./results/original/scatter_plots/"
)

print("Working on correlations...")

correlations_plot(
    data,
    numerical_variables = numerical_variables,
    save_to = "./results/original/correlations.png"
)

print("Working on principal components...")

principal_components(
    data_adjusted,
    numerical_variables = numerical_variables_adj,
    save_to = "./results/adjusted/principal_components"
)

end_time <- proc.time()
time_taken <- end_time - start_time
print(paste("Time taken:", taken[1]))

print("Done.")

正如你所见，仅凭这个文件，你就能获得分析的大致轮廓，并且能够通过运行单个文件来重现你的分析，将结果保存到磁盘（注意 save_to 参数），并测量执行完整分析所需的时间。从我们的总体目标列表中，目标一至四通过此代码实现。实现目标五和六将通过在 functions.R 文件上工作来完成，该文件包含许多小函数。拥有这个 main.R 文件为我们提供了需要编程的地图，尽管现在它可能无法工作，因为其中使用的函数尚未存在，但当我们完成编程时，此文件将不需要任何更改并产生预期的结果。

由于空间限制，我们不会查看 main.R 文件中所有函数的实现，只看代表性的：prepare_data()、plot_scatter_plot() 和 all_scatter_plots()。其他函数使用类似的技术来封装相应的代码。你始终可以访问这本书的代码仓库 (github.com/PacktPublishing/R-Programming-By-Example) 来查看其余的实现细节。阅读完这本书后，你应该能够确切地了解该仓库中每个文件中发生的事情。

我们从prepare_data()函数开始。这个函数是抽象的，并使用四个不同的具体函数来完成其工作，分别是read.csv()、clean_data()、transform_data()，以及在需要时使用complete.cases()。第一个函数，即read.csv()，接收要读取数据的 CSV 文件路径，并将数据加载到名为data的数据框对象中。第四个函数你在第一章，R 语言简介中已经见过，所以这里我们不再解释。第二个和第三个函数是我们自己创建的，我们将对它们进行解释。请注意，main.R并不了解数据是如何准备的，它只要求准备数据，并将任务委托给抽象函数prepare_data()。

prepare_data <- function(path, complete_cases = TRUE) {
    data <- read.csv(path)
    data <- clean_data(data)
    data <- transform_data(data)
    if (complete_cases) {
        data <- data[complete.cases(data), ]
    }
    return(data)
}

clean_data()函数目前只是简单地封装了将NA的-1 重新编码的过程。如果我们的清理过程突然变得更加复杂（例如，需要更多清理的新数据源或意识到我们遗漏了某些内容，需要将其添加到清理过程中），我们将把这些更改添加到这个函数中，而无需修改代码的其他部分。这些都是将代码封装到函数中，以传达意图并隔离需要执行的小步骤的一些优点：

clean_data <- function(data) {
    data[data$Leave == -1, "Leave"] <- NA
    return(data)
}

为了通过添加额外的Proportion和Vote变量以及重新标记区域名称来转换我们的数据，我们使用了以下函数：

transform_data <- function(data) {
    data$Proportion <- data$Leave / data$NVotes
    data$Vote <- ifelse(data$Proportion > 0.5, "Leave", "Remain")
    data$RegionName <- as.character(data$RegionName)
    data[data$RegionName == "London", "RegionName"]                   <- "L"
    data[data$RegionName == "North West", "RegionName"]               <- "NW"
    data[data$RegionName == "North East", "RegionName"]               <- "NE"
    data[data$RegionName == "South West", "RegionName"]               <- "SW"
    data[data$RegionName == "South East", "RegionName"]               <- "SE"
    data[data$RegionName == "East Midlands", "RegionName"]            <- "EM"
    data[data$RegionName == "West Midlands", "RegionName"]            <- "WM"
    data[data$RegionName == "East of England", "RegionName"]          <- "EE"
    data[data$RegionName == "Yorkshire and The Humber", "RegionName"] <- "Y"
    return(data)
}

你之前已经看到过所有这些代码行。我们所做的只是将它们封装到函数中，以传达意图，并允许我们找到某些过程发生的位置，这样我们就可以在需要时轻松地找到并更改它们。

现在我们来看看plot_scatter_plot()函数。这个函数介于抽象和具体函数之间。我们将在main.R文件中直接使用它，但也会在functions.R文件中的其他函数中使用它。我们知道大多数时候我们会使用Proportion作为颜色变量，所以我们将其作为默认值添加，但允许用户通过检查参数是否被发送为FALSE来完全移除颜色，并且由于我们将使用这个相同的函数来创建类似于我们迄今为止创建的所有散点图的图形，我们将回归线设置为可选。

注意，在前面的图形中，x轴是一个连续变量，但在后面的图形中，它是一个分类的（因子）变量。这种灵活性非常强大，并且由于ggplot2能够适应这些变化，我们才能拥有它。正式上，这被称为多态性，我们将在第八章，面向对象系统追踪加密货币中对其进行解释。

最后，我们不再假设用户总是希望将生成的图表保存到磁盘上，因此我们将save_to参数设置为可选，为其提供一个空字符串。当合适的时候，我们使用not_empty()函数检查这个字符串是否为空，如果不为空，我们设置 PNG 保存机制。

plot_scatter_plot <- function(data,
                             var_x,
                             var_y,
                             var_color = "Proportion",
                             regression = FALSE,
                             save_to = "") {
    if (var_color) {
        plot <- ggplot(data, aes_string(x = var_x, y = var_y, color = var_color))
    } else {
        plot <- ggplot(data, aes_string(x = var_x, y = var_y))
    }
    plot <- plot + scale_color_viridis()
    plot <- plot + geom_point()
    if (regression) {
        plot <- plot + stat_smooth(method = "lm", col = "grey", se = FALSE)
    }
    if (not_empty(save_to)) png(save_to)
    print(plot)
    if (not_empty(save_to)) dev.off()
}

现在我们来看一下all_scatter_plots()函数。这个函数是一个抽象函数，它隐藏了用户所不知道的函数名称，即用于迭代创建图表的函数，这个函数被方便地命名为create_graphs_iteratively()，以及之前看到的绘图函数plot_scatter_plot()。如果我们想改进迭代机制或绘图函数，我们可以在不要求使用我们代码的人做出任何更改的情况下做到这一点，因为这种知识被封装在这里。

封装那些经常变化或预期会变化的元素。

create_graphs_iteratively()函数与之前我们看到的一样，只是进度条代码有所不同。progress包提供了progress_bar$new()函数，在迭代过程执行时在终端创建进度条，这样我们可以看到完成过程的百分比，并知道剩余多少时间（有关更多信息，请参阅附录，必需的包）。

注意plot_scatter_plot()和all_scatter_plots()函数中save_to参数的变化。在前者中，它是一个文件名；在后者中，是一个目录名。这种差异虽小，但很重要。粗心大意的读者可能不会注意到这一点，这可能会导致混淆。plot_scatter_plot()函数生成单个图表，因此接收一个文件名。然而，all_scatter_plots()函数将通过使用plot_scatter_plot()生成大量的图表，因此它必须知道所有这些图表需要保存的位置，动态创建最终的图像名称，并将它们逐个发送到plot_scatter_plot()。最后，由于我们希望回归分析包含在这些图表中，我们只需发送regression = TRUE参数：

all_scatter_plots <- function(data, numerical_variables, save_to = "") {
    create_graphs_iteratively(data, numerical_variables, plot_scatter_plot, save_to)
}

create_graphs_iteratively <- function(data,
                                      numerical_variables,
                                      plot_function,
                                      save_to = "") {

    numerical_variables[["Proportion"]] <- FALSE
    variables <- names(numerical_variables[numerical_variables == TRUE])

    n_variables <- (length(variables) - 1)
    progress_bar <- progress_bar$new(
        format = "Progress [:bar] :percent ETA: :eta",
        total = n_variables
    )
    for (i in 1:n_variables) {
        progress_bar$tick()
        for (j in (i + 1):length(variables)) {
            image_name <- paste(
                save_to,
                variables[i], "_",
                variables[j], ".png",
                sep = ""
            )
            plot_function(
                data,
                var_x = variables[i],
                var_y = variables[j],
                save_to = image_name,
                regression = TRUE
            )
        }
    }
}

我们尚未详细查看的其他函数，其技术方法与我们展示的方法类似，完整的实现可以在本书的代码仓库中找到（github.com/PacktPublishing/R-Programming-By-Example）。

摘要

本章展示了如何进行定性分析，这在数据分析的第一步中非常有用。我们展示了描述性统计技术及其编程实现。凭借这些技能，我们能够执行简单而强大的分析，并将结果保存以供以后使用。具体来说，我们展示了如何进行基本数据清洗，如何编程创建图表，如何创建矩阵散点图和矩阵相关性，如何进行主成分分析，以及如何将这些工具结合起来理解手头的数据。最后，我们简要介绍了高质量代码的基础知识，并展示了如何将你的初始数据分析代码转换为模块化、灵活且易于工作的程序。

在第三章，“使用线性模型预测选票”，我们将展示如何使用定性工具扩展当前的分析。具体来说，我们将展示如何使用线性模型来理解变量对英国离开和留在欧盟的投票比例的定量影响，如何对没有投票数据的选区进行预测，以及如何使用我们拥有的数据来衡量这些预测的准确性。这些是任何数据分析师必备的技能，正如我们在本章中所做的那样，我们将看到如何通过编程实现这些技能。

第三章：使用线性模型预测投票

本章展示了如何使用 R 进行统计模型的工作。它展示了如何检查数据假设、指定线性模型、进行预测和测量预测准确性。它还展示了如何程序化地找到好的模型，以避免手动分析，这可能会节省大量时间。到本章结束时，我们将使用许多商业和研究领域现在使用的各种定量工具。本章使用的包与上一章相同。

就像在前一章中一样，这里的重点将放在程序化地自动化分析程序上，而不是深入理解章节中使用的统计技术。此外，由于我们在第二章，使用描述性统计理解投票中已经看到如何高效地使用函数，我们将在本章直接采用那种方法，这意味着当可能的时候，我们将直接使用用于自动化分析的函数。我们将涵盖以下内容：

• 将数据分为训练集和测试集

• 创建用于预测的线性回归模型

• 使用各种技术检查模型假设

• 测量数值和分类数据的预测准确性

• 程序化地寻找最佳模型

必需的包

在本章中，我们将使用以下 R 包，这些包已经在上一章中使用过，所以你应该可以开始了。

包	原因
ggplot2	高质量图表
corrplot	相关性图
progress	显示迭代进度

设置数据

就像数据分析通常那样，第一步是理解我们将要处理的数据。在这种情况下，数据与第二章，使用描述性统计理解投票中相同，并且我们已经理解了它的一些主要特征。主要的是，我们已经理解了年龄、教育和种族对投票倾向有相当大的影响，即对英国离开或留在欧盟的投票倾向。

本章的重点将放在使用线性模型来预测比例和投票变量上，这两个变量包含支持离开欧盟的投票百分比以及是否该地区有更多的“离开”或“留下”投票。这两个变量具有类似的信息，区别在于一个是介于 0 和 1 之间的数值连续变量（比例），另一个是具有两个类别（投票类别为“离开”和“留下”）的分类变量。

我们将在data对象中保留包含完整案例的观察结果，以及在data_incomplete对象中对于比例和投票变量有缺失值的观察结果（我们将在本章的后面部分对这些进行预测）。函数prepare_data()、adjust_data()和get_numerical_variables()来自第二章，《使用描述性统计理解投票》，如果您不清楚它们的功能，可能需要查看。基本上，它们加载了通过压缩与年龄、教育和种族等变量相关的数据分布而创建的调整版本的数据：

data <- adjust_data(prepare_data("./data_brexit_referendum.csv"))

data_incomplete     <- data[!complete.cases(data), ]
data                <- data[ complete.cases(data), ]
numerical_variables <- get_numerical_variable_names(data)

训练和测试数据集

为了能够衡量我们模型的预测准确性，我们需要使用一些观察结果来验证我们的结果。这意味着我们的数据将被分为三个不同的组：

• 训练数据

• 测试数据

• 预测数据

预测数据是我们没有完整案例的数据，具体来说，是那些投票和比例变量有NA值的地区。我们的最终目标是使用我们从其他地区学到的知识来预测这些地区的比例和投票变量，这是我们将在本章的末尾完成的事情。

完整案例的数据将被分为两部分，即训练数据和测试数据。训练数据用于提取知识和学习变量之间的关系。测试数据被视为对于“比例”和“投票”变量有NA值，我们对这些变量进行预测。然后，将这些预测值与对应观察中的实际值进行比较，这有助于我们以客观的方式了解我们的预测有多好，因为这些观察从未被训练模型看到。

我们在上一节创建了预测数据，并将其命名为data_incomplete。为了创建训练和测试数据，我们使用sample()函数。它将接受一个数字列表作为输入，从中选择一定数量的值（size）。数字列表将从 1 到具有完整案例的数据中的总观察数。我们指定用于训练数据的观察数约为总观察数的 70%，并使用replace = FALSE参数指定选中的观察结果可能不会重复（通过避免使用替换的样本）。

测试数据由剩余的 30%的观测值组成。由于sample是一个布尔向量，它包含每个观测值的TRUE或FALSE值，分别指定是否应该包含，我们可以通过在二进制向量前加上负号（-）来取数据的另一部分，有效地将每个TRUE值变为FALSE值，反之亦然。为了理解这一点，让我们看看以下代码：

set.seed(12345)

n          <- nrow(data)
sample     <- sample(1:n, size = round(0.7 * n), replace = FALSE)
data_train <- data[ sample, ]
data_test  <- data[-sample, ]

如果我们多次进行这个过程，我们会发现每次我们都会得到不同的训练和测试集样本，这可能会让我们对我们的结果感到困惑。这是因为sample()函数是随机的，这意味着它将使用伪随机数生成器为我们做出选择（计算机不能生成真正的随机数，它们模拟看起来是随机的数字，尽管它们不是，这就是为什么它被称为伪随机）。如果我们希望我们的过程是可重复的，也就是说，每次运行它时都会选择完全相同的样本，那么我们必须在应用此过程之前指定一个初始种子来预置伪随机数生成器。为此，我们需要将一个整数传递给set.seed()函数，就像我们在代码片段的开头所做的那样。种子参数必须保持固定，以便重现相同的样本，并且有了它，每次我们生成随机样本时，我们都会得到相同的样本，这样我们的结果就是可重复的。

使用线性模型预测选票

在我们能够做出任何预测之前，我们需要指定一个模型，并使用我们的训练数据（data_train）对其进行训练，以便它学会如何提供我们想要的预测。这意味着我们将解决一个优化问题，输出某些数字，这些数字将被用作模型预测的参数。R 使我们能够非常容易地完成这样的任务。

在 R 中指定线性回归模型的标准方式是使用lm()函数，我们将要构建的模型以公式形式表达，并使用应该使用的数据，将其保存到对象（在这种情况下为fit）中，我们可以使用它来详细探索结果。例如，我们可以构建的最简单模型是只有一个回归变量（自变量）的模型，如下所示：

fit <- lm(Proportion ~ Students, data_train)

在这个简单的模型中，我们将让 R 知道我们想要运行一个回归，我们试图仅使用数据中的Students变量来解释Proportion变量。这个模型太简单了，如果我们想要包含第二个变量会怎样呢？嗯，我们可以在其他回归变量后面使用加号（+）来添加它。例如（请注意，这将覆盖之前的fit对象，并使用新结果，所以如果你想保留它们两个，确保给结果对象不同的名字）：

fit <- lm(Proportion ~ Students + Age_18to44, data_train)

由于我们正在处理更多信息，这可能是一种更好地解释Proportion变量的方法。然而，请记住共线性问题；学生百分比在街区（Students）中越高，相对较年轻的人的百分比（Age_18to44）也越高，这意味着我们可能没有向回归中添加独立信息。当然，在大多数情况下，这不是一个二元问题，而是一个程度问题，分析师必须能够处理这种情况。我们将在下一节检查模型假设时进一步讨论这个问题。现在，让我们回到编程，好吗？如果我们想包含数据中的所有变量怎么办？嗯，我们有两个选择，手动包含所有变量或使用 R 的快捷方式来做到这一点：

# Manually
fit <- lm(Proportion ~ ID + RegionName + NVotes + Leave + Residents + Households + White + 
          Owned + OwnedOutright + SocialRent + PrivateRent + Students + Unemp + UnempRate_EA + 
          HigherOccup + Density + Deprived + MultiDepriv + Age_18to44 + Age_45plus + NonWhite + 
          HighEducationLevel + LowEducationLevel, data_train)

# R's shortcut
fit <- lm(Proportion ~ ., data_train)

这两个模型完全相同。然而，有几个细微之处我们需要提及。首先，当手动指定模型时，我们必须明确地将Proportion变量排除在回归变量（~符号之后的变量）之外，这样在运行回归时就不会出现错误（对于 R 允许我们尝试使用相同的Proportion变量和其他事物来解释Proportion变量来说是没有意义的）。其次，如果我们输入变量名时出现任何拼写错误，我们会得到错误，因为这些名称将不会出现在变量名中（如果巧合下你的错误实际上指的是数据中另一个现有的变量，那么可能是一个难以诊断的错误）。第三，在这两种情况下，回归变量的列表中包含了不应该存在的变量，如ID、RegionName、NVotes、Leave和Vote。在of的情况下

ID这个变量包含在分析中是没有意义的，因为它没有任何关于Proportion的信息，它只是一个标识符。在RegionName的情况下，它是一个分类变量，所以回归将不再是标准多元线性回归，R 会自动为我们处理，但如果我们不理解我们在做什么，它可能会产生令人困惑的结果。在这种情况下，我们只想处理数值变量，因此我们可以轻松地从手动情况中将其删除，但在快捷方式的情况下我们无法这样做。最后，在NVotes、Leave和Vote的情况下，这些变量以略微相同的方式表达相同的信息，因此它们不应该被包含，因为我们会有多重共线性问题。

假设我们想要使用的最终模型包括所有有效的数值变量：

fit <- lm(Proportion ~ Residents + Households + White + Owned + OwnedOutright + SocialRent + PrivateRent + Students + Unemp + UnempRate_EA + HigherOccup + Density + Deprived + MultiDepriv + Age_18to44 + Age_45plus + NonWhite + HighEducationLevel + LowEducationLevel, data_train)

如果我们想使用快捷方式，我们可以确保数据中不包含有问题的变量（使用我们在第一章，R 语言简介）中查看的筛选技术，然后使用快捷方式。

要详细查看结果，我们使用fit对象上的summary()函数：

summary(fit)
#>
#> Call:
#> lm(formula = Proportion ~ Residents + Households + White + Owned +
#>    OwnedOutright + SocialRent + PrivateRent + Students + Unemp +
#>    UnempRate_EA + HigherOccup + Density + Deprived + MultiDepriv +
#>    Age_18to44 + Age_45plus + NonWhite + HighEducationLevel +
#>    LowEducationLevel, data = data_train)
#>
#> Residuals:
#>      Min       1Q  Median      3Q     Max
#> -0.21606 -0.03189 0.00155 0.03393 0.26753
#>
#> Coefficients:
#>                     Estimate Std. Error  t value  Pr(>|t|)
#> (Intercept)         3.30e-02   3.38e-01  0.10      0.92222
#> Residents           7.17e-07   2.81e-06  0.26      0.79842
#> Households         -4.93e-06   6.75e-06 -0.73      0.46570
#> White               4.27e-03   7.23e-04  5.91      6.1e-09 ***
#> Owned              -2.24e-03   3.40e-03 -0.66      0.51071
#> OwnedOutright      -3.24e-03   1.08e-03 -2.99      0.00293 **
#> SocialRent         -4.08e-03   3.60e-03 -1.13      0.25847
#> PrivateRent        -3.17e-03   3.59e-03 -0.89      0.37629
#> Students           -8.34e-04   8.67e-04 -0.96      0.33673
#> Unemp               5.29e-02   1.06e-02  5.01      7.3e-07 ***
#> UnempRate_EA       -3.13e-02   6.74e-03 -4.65      4.1e-06 ***
#> HigherOccup         5.21e-03   1.24e-03  4.21      2.9e-05 ***
#> Density            -4.84e-04   1.18e-04 -4.11      4.6e-05 ***
#> Deprived            5.10e-03   1.52e-03  3.35      0.00087 ***
#> MultiDepriv        -6.26e-03   1.67e-03 -3.75      0.00019 ***
#> Age_18to44          3.46e-03   1.36e-03  2.55      0.01117 *
#> Age_45plus          4.78e-03   1.27e-03  3.75      0.00019 ***
#> NonWhite            2.59e-03   4.47e-04  5.80      1.1e-08 ***
#> HighEducationLevel -1.14e-02   1.14e-03 -9.93      < 2e-16 ***
#> LowEducationLevel   4.92e-03   1.28e-03  3.85      0.00013 ***
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> Residual standard error: 0.0523 on 542 degrees of freedom
#> Multiple R-squared: 0.868, Adjusted R-squared: 0.863
#> F-statistic: 187 on 19 and 542 DF, p-value: <2e-16

这些结果告诉我们用于创建我们模型的命令，这在创建各种模型并希望快速了解所查看结果的模型时很有用。它还显示了一些关于残差分布的信息。接下来，它显示了模型中使用的每个变量的回归结果。我们得到变量的名称（（Intercept）是模型规范中使用的标准线性回归截距），变量的系数估计，标准误差，t 统计量，p 值，以及使用星号表示显著性代码的p 值的视觉表示。在结果末尾，我们看到与模型相关的其他结果，包括 R 平方 和 F 统计量。如前所述，我们不会深入探讨这些含义的细节，我们将继续关注编程技术。如果您感兴趣，可以查看 Casella 和 Berger 的 Statistical Inference, 2002 或 Rice 的 Mathematical Statistics and Data Analysis, 1995。

现在我们已经准备好了fit对象中的拟合模型，我们可以用它来进行预测。为此，我们使用predict()函数和fit对象以及我们想要对其产生预测的数据，在我们的例子中是data_test。这会返回一个预测值的向量，我们将其存储在predictions对象中。对于data_test对象中的每个观测值，我们都会得到一个预测：

predictions <- predict(fit, data_test)

我们可以在本章后面的某个部分测量这些预测的准确性。现在，我们知道如何用 R 轻松地生成预测。

检查模型假设

与任何类型的模型一样，线性模型要求我们检查其假设以证明其应用的合理性。结果的准确性和可解释性来自于遵守模型的假设。有时这些假设将是严格的，如果它们没有得到严格满足，那么模型就不被认为有效。其他时候，我们将与更灵活的假设一起工作，其中分析师的标准程度将发挥作用。

对于有兴趣的人来说，一篇关于模型假设的精彩文章是 David Robinson 的 K-means clustering is not free lunch, 2015 (varianceexplained.org/r/kmeans-free-lunch/)。

对于线性模型，以下是一些核心假设：

• 线性关系：变量之间存在线性关系

• 正态性：残差呈正态分布

• 同方差性：残差具有恒定的方差

• 无多重共线性：变量之间不是彼此的线性组合

• 独立性：残差是独立的，或者至少不相关

我们将展示如何简要检查其中的四个：线性、正态性、同方差性和无多重共线性。我们应该提到，独立性假设可能是最难测试的假设，您通常可以用常识和对数据收集方式的理解来处理它。我们在这里不会深入探讨这一点，因为它更多地属于统计学的范畴，而我们希望这本书专注于编程技术。对于对统计学感兴趣的读者，我们推荐阅读 Jeffrey M. Wooldridge 的《2013 年入门计量经济学》和 Joshua D. Angrist 以及 Jorn-Steffen Pischke 的《2008 年无害计量经济学》。

使用散点图检查线性

检查线性假设的基本方法是在Y轴上绘制因变量，在x轴上绘制自变量，制作一个散点图。如果关系看起来是线性的，那么假设就得到了验证。在任何有趣的问题中，找到一个非常清晰的线性关系的散点图都是非常困难的，如果确实发生了这种情况，我们应该稍微怀疑并小心对待数据。为了避免重复造轮子，我们将使用我们在第二章，“使用描述性统计理解投票”中创建的plot_scatterlot()函数：

plot_scatterplot(
    data = data,
    var_x = "Age_18to44",
    var_y = "Proportion",
    var_color = FALSE,
    regression = TRUE
)
plot_scatterplot(
    data = data,
    var_x = "Students",
    var_y = "Proportion",
    var_color = FALSE,
    regression = TRUE
)

如我们所见，左边的散点图显示了明显的线性关系，因为 18 至 44 岁之间的人口比例（Age_18to44）增加，支持离开欧盟的人口比例（Proportion）减少。在右边，我们看到在初始区域（Students在 0 到 20 之间）中，学生比例（Students）和Proportion之间的关系是明显线性的，之后这种关系似乎也是线性的，但受到了具有非常高学生比例的观察值的污染。然而，我们仍然可以假设Students和Proportion之间存在线性关系。

当我们在这里进行多重线性回归时，应该检查除了我们这里省略的其余变量之外的所有假设，但我们鼓励您这样做。请记住，在所有这些变量中找到一个线性关系是非常困难的，而这个假设主要是变量在回归中的预测能力的指示。只要关系看起来稍微线性，我们就应该没问题。

使用直方图和分位数-分位数图检查正态性

我们将使用两种不同的技术来检查正态性，这样我们就可以举例说明一种称为策略模式的技术，它是面向对象编程中一系列模式的一部分。我们将在第八章，“面向对象系统追踪加密货币”中更深入地探讨这些模式。

目前，你可以将策略模式视为一种技术，它将重用那些否则会被重复的代码，并简单地改变一种称为策略的操作方式。在下面的代码中，你可以看到我们创建了一个名为save_png()的函数，它包含了将被重复的代码（保存 PNG 文件）且不需要重复。我们将有两种策略，以函数的形式呈现，用于检查数据正态性——直方图和分位数-分位数图。这些将通过名为functions_to_create_images的参数方便地传递。正如你所见，这段代码接收一些数据，一个用于图形的变量，图像的文件名，以及一个用于创建图形的函数。这个最后一个参数，即函数，对读者来说应该不会陌生，因为我们已经在第一章，R 语言入门中看到过，我们可以将函数作为参数传递，并像在这段代码中一样使用它们，通过在函数内部调用它们的新名称，在这个例子中是function_to_create_image()：

save_png <- function(data, variable, save_to, function_to_create_image) {
    if (not_empty(save_to)) png(save_to)
    function_to_create_image(data, variable)
    if (not_empty(save_to)) dev.off()
}

现在我们展示将利用这个save_png()函数并封装每个情况所使用的函数知识的代码。在直方图的例子中，下面代码中显示的histogram()函数简单地封装了用于创建图形的hist()函数，并使用了一个通用的接口，这个接口也将被其他策略使用（在这个例子中是下面代码中显示的quantile_quantile()函数）。这个通用接口允许我们将这些策略用作插件，可以像在相应的variable_histogram()和variable_qqplot()函数（它们都执行相同的调用，但在每种情况下使用不同的策略）中做的那样轻松替换。正如你所见，不属于通用接口的其他细节（例如，main和xlab）在每个策略的代码中处理。如果我们想，我们可以将它们作为可选参数添加，但在这个例子中不是必要的：

variable_histogram <- function(data, variable, save_to = "") {
    save_png(data, variable, save_to, histogram)
}

histogram <- function(data, variable) {
    hist(data[, variable], main = "Histogram", xlab = "Proportion")
}

variable_qqplot <- function(data, variable, save_to = "") {
    save_png(data, variable, save_to, quantile_quantile)
}

quantile_quantile <- function(data, variable) {
    qqnorm(data[, variable], main = "Normal QQ-Plot for Proportion")
    qqline(data[, variable])
}

下面的代码展示了用于检查比例正态性的图形：

quantile_quantile <- function(data, variable) {
    qqnorm(data[, variable], main = "Normal QQ-Plot for Proportion")
    qqline(data[, variable])
}

如果我们想与第三个（或更多）策略共享创建 PNG 图像的代码，那么我们可以简单地为每个新情况添加一个策略包装器，而不用担心重复创建 PNG 图像的代码。这看起来可能不是什么大问题，但想象一下，用于创建 PNG 文件的代码很复杂，你突然发现了一个错误。你需要修复什么错误？嗯，你将不得不去每个重复代码的地方进行修复。这看起来并不高效。现在，如果你不再想保存 PNG 文件，而想保存 JPG 文件会发生什么？嗯，同样，你将不得不去每个重复代码的地方进行更改。这同样效率不高。如您所见，这种编程方式需要前期进行一点投资（创建通用接口和提供包装器），但这样做的好处将通过节省的时间得到回报，即使你只需要更改一次代码，以及更易于理解和更简单的代码。这是一种依赖管理的形式，这是你应该学会如何做以成为一个更高效的程序员。

您可能已经注意到，在前面的代码中，我们可以通过让用户直接调用 save_png() 函数来避免一个函数调用。然而，这样做要求用户了解两件事，即 save_png() 函数用于保存图像，以及 quantile_quantile() 或 histogram() 函数用于生成图表，具体取决于她试图绘制什么。这种额外的负担虽然看似不问题，但对于不习惯将函数作为参数传递的用户来说，可能会非常混乱，因为他们需要知道两个函数签名，而不是一个。

提供一个签名易于使用的包装器，就像我们使用 variable_histogram() 和 variable_qqplot() 一样，这使用户更方便，并允许我们根据需要扩展显示图表的方式，如果我们以后想改变它而不需要用户学习新的函数签名。

要实际生成我们想要的图表，我们使用以下代码：

variable_histogram(data = data, variable = "Proportion")
variable_qqplot(data = data, variable = "Proportion")

如您所见，直方图显示了一个略微向右偏斜的近似正态分布，但我们很容易接受它为正态分布。相应的分位数-分位数图以略不同的方式显示了相同的信息。它显示的线对应于正态分布的分位数，而点显示了数据中的实际分布。这些点越接近线，变量的分布就越接近正态分布。如您所见，大部分情况下，“比例”是正态分布的，而在极端情况下我们可以看到轻微的偏差，这可能是由于我们的“比例”变量实际上在 0 和 1 处有硬限制。然而，我们也可以接受它为正态分布，并可以安全地继续到下一个假设。

使用残差图检查同方差性

同方差性简单来说就是我们需要数据中的残差具有恒定的方差。为了检查它，我们可以使用plot(fit)函数调用。然而，这将一次显示一个图表，并要求你按键盘上的Enter键来显示下一个图表。这种机制对我们正在创建的自动化过程来说并不友好。因此，我们需要做一些调整。我们将使用par(mfrow = c(2, 2))调用告诉plot()函数同时绘制所有四个图表，并在一个图像中显示。我们将命令包裹在fit_plot()函数周围的我们已熟悉的机制中，以便在fit_plot()函数周围保存 PNG 图像，这样我们就设置好了：

fit_plot <- function(fit, save_to = "") {
    if (not_empty(save_to)) png(save_to)
    par(mfrow = c(2, 2))
    plot(fit)
    if (not_empty(save_to)) dev.off()
}

在fit_plot()函数就位的情况下，我们可以使用以下方式展示回归的图形结果：

fit_plot(fit)

我们需要的信息在左侧的图表中，其中 x 轴上显示拟合值，y 轴上显示残差。在这些图表中，我们寻找的是残差以随机分布的管状模式，由虚线所示。我们不希望残差呈现出类似扇形或漏斗形或任何形式的曲线模式。正如我们所见，我们看到的模式确实类似于管状模式，因此我们可以说同方差性的假设对于数据是成立的。作为额外信息，你还可以在右上角的分位数-分位数图中看到，残差遵循正态分布，这也是好的。右下角的图表展示了一个统计学概念，我们不会深入探讨，称为库克距离，它用于在回归中找到有影响力的观测值。要了解更多关于它的信息，你可以查看 John Fox 的回归诊断，1991。

检查无共线性与相关系数

要检查无共线性，我们可以使用多种不同的技术。例如，对于那些熟悉线性代数的人来说，条件数是衡量矩阵如何奇异的一个度量，其中奇异性意味着协变量之间有完美的共线性。这个数字可以提供这种共线性的度量。另一种技术是使用方差膨胀因子，这是一种更正式的技术，它提供了由于共线性而增加回归方差的程度。另一种，也是更常见的方法，是使用简单的相关系数。是否有任何变量在彼此之间有很强的相关性，以至于它们之间可能存在直接关系？如果是这样，那么我们可能有一个多重共线性问题。为了了解我们的变量之间是如何相关的，我们将使用第二章中展示的相关系数矩阵技术，使用描述性统计来理解投票。

以下代码展示了在 R 中相关系数是如何工作的：

library(corrplot)
corrplot(corr = cor(data[, numerical_variables]), tl.col = "black", tl.cex = 0.6)

如您所见，强烈的关联（无论是正的还是负的）是在组内而不是组间发生的，这意味着以不同方式衡量同一事物的变量似乎高度相关，而衡量不同事物的变量则似乎不相关。

例如，Age_18to44 和 Age_45plus 是衡量年龄的变量，我们预计它们之间会有负相关关系，因为一个区域中年轻人的百分比越高，必然导致老年人的百分比越低。同样的关系也可以在住房群体（Owned、OwnedOutright、SocialRent 和 PrivateRent）、就业群体（Unemp、UnempRate_EA 和 HigherOccup）、贫困群体（Deprived 和 MultiDepriv）、种族群体（White 和 NonWhite）、居住群体（Residents 和 Households）和教育群体（LowEducationLevel 和 HighEducationLevel）中看到。如果你选择属于不同群体的变量，强烈的关联数量会显著降低，但仍然存在。例如，HigherOccup 与 HighEducationLevel 和 LowEducationLevel 强烈相关，分别呈正相关和负相关。此外，住房群体中的变量似乎与年龄群体中的变量相关。这些关系是预期和自然的，因为受过高等教育的人很可能有更好的工作，而年轻人可能还买不起房子，所以他们会租房。作为分析师，我们可以假设这些变量实际上是在衡量社会的不同方面，并继续我们的分析。然而，在解释结果时，你仍然可能想要记住这些事情，我们可能还只想在每个群体中包含一个变量，以避免组间共线性，但现在我们将避免这些复杂性，继续我们的分析。

线性回归是那些需要分析师提供接受或拒绝标准的模型类型之一。在我们的具体案例中，似乎我们的模型假设是有效的，我们可以安全地使用它来提供可信的预测，正如我们将在以下章节中所做的那样。

使用分数函数测量准确性

现在我们已经检查了模型的假设，我们将转向测量其预测能力。为了测量我们的预测精度，我们将使用两种方法，一种用于数值数据（Proportion），另一种用于分类数据（Vote）。我们知道 Vote 变量是 Proportion 变量的转换，这意味着我们以两种不同的方式测量相同的信息。然而，数值数据和分类数据在数据分析中经常遇到，因此我们想在这里展示两种方法。这两个函数，score_proportions()（数值）和 score_votes()（分类），接收我们用于测试的数据以及测试数据中每个观测的预测，这些预测来自我们在前几节中构建的模型。

在数值情况下，score_proportions() 函数使用以下表达式来计算分数：

在这里，Y_i 是测试数据中第 i 个观测的 真实响应 变量值，Y'_i 是我们对该相同观测的预测，SE 是我们预测的标准误差，n 是测试数据中的观测数。这个方程式建立了我们想要最小化的分数是 学生化残差 的平均值。你可能知道，学生化残差是将残差除以标准误差的度量。这个公式给我们提供了一个平均度量，即我们相对于观察到的数据范围方差预测观测值正确性的接近程度。如果我们有一个很高的方差（导致高标准误差），我们不想对预测过于严格，但如果我们处于低方差区域，我们想确保我们的预测非常准确：

score_proportions <- function(data_test, predictions) {
    # se := standard errors
    se <- predictions$se.fit
    real <- data_test$Proportion
    predicted <- predictions$fit
    return(sum((real - predicted)² / se²) / nrow(data))
}

在分类情况下，score_votes() 函数通过简单地计算我们的预测指向正确类别的次数来计算一个分数，这是我们想要最大化的。我们通过首先使用相同的分类机制（如果预测的 Proportion 大于 0.5，则将其分类为 "Leave" 投票，反之亦然），并比较分类值来实现这一点。我们知道布尔向量的和将等于 TRUE 值的数量，这正是我们在 sum(real == predicted) 表达式中使用的：

score_votes <- function(data_test, predictions) {
    real <- data_test$Vote
    predicted <- ifelse(predictions$fit > 0.5, "Leave", "Remain")
    return(sum(real == predicted))
}

为了测试我们的模型分数，我们执行以下操作：

predictions <- predict(fit, data_test, se.fit = TRUE)

score_proportions(data_test, predictions)
#> [1] 10.66
score_votes(data_test, predictions)
#> [1] 216
nrow(data_test)
#> [1] 241

在 score_votes() 函数的情况下，这个度量本身告诉我们我们的预测做得如何，因为我们可以将正确预测的数量（函数调用的输出，即 216）除以 data_test 对象中的观测数（行数，即 241）。这给我们带来了 89% 的精确度。这意味着如果我们得到了回归者的数据，但我们不知道沃德实际上是如何投票的，那么 89% 的时间，我们会提供一个预测，即他们是否想要离开或留在欧盟，这个预测将是正确的。如果你问我，这相当不错。

在score_proportions()函数的情况下，由于我们使用更抽象的度量来了解我们做得如何，我们希望将其与其他模型的分数进行比较，并得到模型预测能力的相对感觉，这正是我们将在以下章节中做的。

编程寻找最佳模型

现在我们已经看到了如何产生代表模型预测能力好坏的分数，你可以继续手动指定很多模型，通过改变发送给lm()函数的变量组合来改变，计算每个模型的分数，然后选择那些预测能力最高的模型。这可能会花费大量时间，你可能希望将其委托给其他人，因为这是一项繁琐的工作。然而，不用担心。有更好的方法！计算机擅长重复和繁琐的任务，现在我们将看到如何通过一点编程告诉计算机为我们找到最佳模型。

以下章节将提高编程水平，但不用担心，我们会详细解释代码，确保一切都能理解。如果你在任何时候感到困惑，你总是可以将代码的小片段复制粘贴到你的 R 终端中，看看它们各自在做什么，从而逐渐对整个过程有一个整体的感觉。

生成模型组合

我们首先需要做的是开发一种获取我们想要测试的回归组合的方法。由于这是一个组合问题，组合的数量与可用选项的数量呈指数级增长。在我们的案例中，有 19 个可用变量，可能的模型数量是我们可以用一个回归器创建的模型数量加上我们可以用两个回归器创建的模型数量，以此类推，直到我们将我们可以用所有 19 个回归器创建的模型数量相加。这就是总和：

当然，计算这么多模型，虽然对计算机来说很容易，但可能需要一段时间，所以我们希望限制组合中允许的最小和最大回归器数量。为此，我们指定了将包含在min_percentage和max_percentage参数中的回归器的最小和最大百分比。在我们的案例中，如果我们指定min_percentage = 0.9和max_percentage = 1.0，我们要求包含 17 到 19 个回归器的所有组合，这总共是 191 个模型。想象一下手动生成 191 个模型规范需要多长时间！希望考虑这一点会让你意识到这种技术的强大。

首先，我们创建generate_combinations_unvectorized()函数，该函数将输出一个列表，包含所有可能的组合，这些组合由前面提到的variables、min_percentage和max_percentage参数给出。我们首先做的是通过在variables向量中将Proportion指定为FALSE来删除Proportion变量（这里的variables对象对应于numerical_variables对象，但我们已经在这个函数中调整了其名称，使其更易于阅读）。其他不想要的变量（NVotes、Leave、Vote和RegionName）在章节开头的get_numerical_variable_names()函数中被删除。接下来，我们通过使用TRUE值来获取变量的实际名称，这样我们就可以使用字符串而不是布尔值进行操作。然后，我们计算变量的总数n，以及我们将包括在组合中的实际变量数量，通过取百分比参数，将它们乘以变量数量，并获取该数字的floor或ceiling，以确保包括极端值。之后，我们初始化all_combinations对象，该对象将包含我们想要的组合列表。接下来是进度条对象，我们不会对其进行解释，因为我们之前已经使用过它。

实际工作是在for循环内部完成的。请注意，它从我们想要的组合中的最小变量数到最大变量数。在每次迭代中，我们计算组合的数量，它返回给我们一个矩阵，其中每一列代表一个不同的组合，每一行包含该特定组合的变量索引。这意味着我们需要将每一列添加到我们的总组合列表（all_combinations）中，这就是我们在嵌套for循环内部所做的事情。最后，由于我们有嵌套列表，我们想要使用unlist()函数将它们带到同一级别，但我们不想递归地这样做，因为我们最终只会得到一个长的列表，我们无法区分一个组合与另一个组合。

我鼓励您将返回语句更改为避免使用recursive = FALSE参数，以及完全避免使用unlist()函数。这样做将迅速显示它们对函数输出的影响，以及为什么我们需要它们。

library(progress)

generate_combinations_unvectorized <- function(variables, min_percentage, max_percentage) {
    variables[["Proportion"]] <- FALSE
    variables                 <- names(variables[variables == TRUE])
    n                         <- length(variables)
    n_min                     <- floor(n * min_percentage)
    n_max                     <- ceiling(n * max_percentage)
    all_combinations          <- NULL

    progress_bar <- progress_bar$new(
        format = "Progress [:bar] :percent ETA: :eta",
        total = length(n_min:n_max)
    )

    for (k in n_min:n_max) {
        progress_bar$tick()
        combinations <- combn(variables, k)
        for (column in 1:ncol(combinations)) {
            new_list <- list(combinations[, column])
            all_combinations <- c(all_combinations, list(new_list))
        }
    }
    return(unlist(all_combinations, recursive = FALSE))
}

下一个示例显示了generate_combinations_unvectorized()函数生成的对象。如您所见，它是一个列表，其中每个元素都是一个向量或类型character。创建的第一个组合只包含 17 个变量，这是当变量总数为 19 且请求的最小百分比为 90%时使用的最小变量数。最后一个组合（组合编号 191）包含所有 19 个变量，对应于我们在本章前面手动构建的模型：

combinations <- generate_combinations_unvectorized(
    numerical_variables, 0.9, 1.0
)

combinations
[[1]]
 [1] "Residents"     "Households"    "White"         "Owned"
 [5] "OwnedOutright" "SocialRent"    "PrivateRent"   "Students"
 [9] "Unemp"         "UnempRate_EA"  "HigherOccup"   "Density"
[13] "Deprived"      "MultiDepriv"   "Age_18to44"    "Age_45plus"
[17] "NonWhite"

...

[[191]]
 [1] "Residents"          "Households"         "White"
 [4] "Owned"              "OwnedOutright"      "SocialRent"
 [7] "PrivateRent"        "Students"           "Unemp"
[10] "UnempRate_EA"       "HigherOccup"        "Density"
[13] "Deprived"           "MultiDepriv"        "Age_18to44"
[16] "Age_45plus"         "NonWhite"           "HighEducationLevel"
[19] "LowEducationLevel"

只获取包含 90%至 100%变量的组合可能显得有些限制。如果我们想生成所有可能的组合呢？在这种情况下，我们需要将第一个参数更改为 0，但可能不会在合理的时间内完成。原因是我们的generate_combinations_unvectorized()函数，正如其名称所暗示的，并没有进行向量化，而且更糟糕的是，它包含了嵌套的for循环。这在特定情况下是一个巨大的瓶颈，这也是你在自己的代码中需要留意的地方。一个可能的解决方案是制作函数的向量化版本。对于那些感兴趣的人，我们在本书的代码仓库中包含了一个名为vectorized_vs_unvectorized.R的文件（github.com/PacktPublishing/R-Programming-By-Example），展示了上述实现。我们还包含了一些测试，将展示向量化实现有多快。仅提前透露一下，它可能快数百倍！对于那些向量化和仅依赖于 R 本身的其他方法不够好的情况，你可以尝试将任务委托给一个更快的（编译）语言。我们将在第九章中看到如何做到这一点，实现高效的简单移动平均。

回到我们的例子，接下来要做的事情是创建find_best_fit()函数，它将遍历生成的每个组合，使用data_train数据训练一个具有相应组合的模型，使用measure选择（无论是数值的Proportion还是分类的Vote）来测试其准确性，并将相应的分数保存到scores向量中。然后，它将根据我们使用的measure选择（Proportion要求我们最小化，而Vote要求我们最大化）找到最优分数的索引，最后它将重新创建最优模型，打印其信息，并将模型返回给用户。compute_model_and_fit()、compute_score()和print_best_model_info()函数将在我们采用自顶向下的方法时开发：

find_best_fit <- function(measure, data_train, data_test, combinations) {
    n_cases <- length(combinations)
    progress_bar <- progress_bar$new(
        format = "Progress [:bar] :percent ETA: :eta",
        total = n_cases
    )
    scores <- lapply(1:n_cases, function(i) {
        progress_bar$tick()
        results <- compute_model_and_fit(combinations[[i]], data_train)
        score <- compute_score(measure, results[["fit"]], data_test)
        return(score)
    })
    i <- ifelse(measure == "Proportion", which.min(scores), which.max(scores))
    best_results <- compute_model_and_fit(combinations[[i]], data_train)
    best_score <- compute_score(measure, best_results[["fit"]], data_test)
    print_best_model_info(i, best_results[["model"]], best_score, measure)
    return(best_results[["fit"]])
}

接下来，我们创建 compute_model_and_fit() 函数，该函数简单地生成所选组合的公式，并在 lm() 函数中使用它。正如您在 combinations 对象中看到的，我们之前从 generate_combinations_unvectorized() 函数返回的它是一个包含字符向量的列表，它不是一个可以传递给 lm() 函数的公式；这就是为什么我们需要 generate_model() 函数，它将接受这些向量之一，并使用 paste() 函数和 collapse = " + " 参数将它们连接成一个由加号（+）分隔的单个字符串，并在其前面添加 Proportion ~ 字符串。这给我们返回一个由字符串指定的公式对象，如 Proportion ~ Residents + ... + NonWhite，其中包含的不是省略号，而是前面代码中显示的第一个组合中的所有变量。然后，我们使用这个字符串在 lm() 函数中执行回归，并将 model 和 fit 都返回在一个列表中，以便在后续步骤中使用：

compute_model_and_fit <- function(combination, data_train) {
    model <- generate_model(combination)
    return(list(model = model, fit = lm(model, data_train)))
}

generate_model <- function(combination) {
    sum <- paste(combination, collapse = " + ")
    return(formula(paste("Proportion", "~", sum)))
}

如 score <- compute_score(measure, results[["fit"]], data_test) 行所示，compute_score() 函数接收一个 measure 对象、一个 fit 对象（来自 results 列表），以及用于测试的数据。它使用之前提到的 策略模式 来计算用于检查正态性假设的图表的得分。基本上，根据 measure 字符串（选择的策略）的值，它将选择两个具有相同签名的函数之一，并使用该函数来计算最终的预测。我们向之前看到的 predict() 函数发送 se.fit = TRUE 参数，因为我们希望标准误差也一起发送，以防我们使用需要它们的数值得分。score_proportions() 和 score_votes() 函数在本章中之前已定义：

compute_score <- function(measure, fit, data_test) {
    if (measure == "Proportion") {
        score <- score_proportions
    } else {
        score <- score_votes
    }
    predictions <- predict(fit, data_test, se.fit = TRUE)
    return(score(data_test, predictions))
}

最后，我们创建了一个名为 print_best_model_info() 的小型便利函数，该函数将打印找到的最佳模型的结果。它简单地接受最佳模型的索引、模型公式、其得分和度量类型，并将所有这些信息打印给用户。正如您所看到的，由于 model 对象不是一个简单的字符串，而是一个 公式 对象，我们需要稍微处理一下它，通过将其转换为字符串并使用我们知道的包含加号（+）来分割它，以获取我们想要的结果；否则，它将是一个非常长的字符串：

print_best_model_info <- function(i, model, best_score, measure){
    print("*************************************")
    print(paste("Best model number:", i))
    print(paste("Best score:       ", best_score))
    print(paste("Score measure:    ", measure))
    print("Best model:")
    print(strsplit(toString(model), "\\+"))
    print("*************************************")
}

我们可以通过调用以下命令来根据 Proportion 度量找到最佳模型：

best_lm_fit_by_proportions <- find_best_fit(
    measure = "Proportion",
    data_train = data_train,
    data_test = data_test,
    combinations = combinations
)
#> [1] "*************************************"
#> [1] "Best model number: 3"
#> [1] "Best score:        10.2362983528259"
#> [1] "Score measure:     Proportion"
#> [1] "Best model:"
#> [[1]]
#>  [1] "~, Proportion, Residents " " Households "
#>  [3] " White "                   " Owned "
#>  [5] " OwnedOutright "           " SocialRent "
#>  [7] " PrivateRent "             " Students "
#>  [9] " Unemp "                   " UnempRate_EA "
#> [11] " HigherOccup "             " Density "
#> [13] " Deprived "                " MultiDepriv "
#> [15] " Age_18to44 "              " Age_45plus "
#> [17] " LowEducationLevel"
#> [1] "*************************************"

如我们所见，最佳模型是 191 个模型中的第三个，得分为 10.23。我们还可以看到模型中使用的回归变量。如您所见，NonWhite和HighEducationLevel被优化方法排除在外，这可能是由于它们的对应变量包含了它们各自组所需的所有信息。这不是巧合，这些是数据中最具代表性的变量之一。

要根据Vote度量找到最佳模型，我们使用以下代码。请注意，鉴于我们创建此函数时使用的良好技术，我们只需更改measure参数的值，就可以使用不同的方法来优化我们的搜索：

best_lm_fit_by_votes <- find_best_fit(
    measure = "Vote",
    data_train = data_train,
    data_test = data_test,
    combinations = combinations
)
#> [1] "*************************************"
#> [1] "Best model number: 7"
#> [1] "Best score:        220"
#> [1] "Score measure:     Vote"
#> [1] "Best model:"
#> [[1]]
#>  [1] "~, Proportion, Residents " " Households "
#>  [3] " White "                   " Owned "
#>  [5] " OwnedOutright "           " SocialRent "
#>  [7] " PrivateRent "             " Students "
#>  [9] " Unemp "                   " UnempRate_EA "
#> [11] " HigherOccup "             " Density "
#> [13] " Deprived "                " MultiDepriv "
#> [15] " Age_45plus "              " NonWhite "104
#> [17] " HighEducationLevel"
#> [1] "*************************************"

在这种情况下，最佳模型是 191 个模型中的第七个，有 241 个正确预测中的 220 个，这给我们带来了 91%的准确性，这是一个相对于我们在本章早期计算的准确性的改进。在这种情况下，LowEducationLevel和Age_18to44被排除在外。再次强调，这不是巧合，这些是数据中最重要变量的一部分。

从未知数据的选区预测投票

现在我们知道了如何训练我们的模型并找到最佳的可能模型，我们将使用使用Vote度量找到的最佳模型来预测那些我们没有投票数据的选区的预测。为此，我们只需执行以下行：

predictions <- predict(best_lm_fit_by_votes, data_incomplete)

predictions
#>    804    805    806    807    808    809    810    811    812    813
#> 0.6845 0.6238 0.5286 0.4092 0.5236 0.6727 0.6322 0.6723 0.6891 0.6004
#>    814    815    816    817    818    819    820    821    822    823
#> 0.6426 0.5854 0.6966 0.6073 0.4869 0.5974 0.5611 0.4784 0.5534 0.6151
(Truncated output)

这将使用我们之前使用Votes度量找到的最佳模型，并利用它来生成对data_incomplete数据中Proportion变量的预测，这些数据包含我们没有任何投票数据的观测值。这是我们目前所能提供的最佳预测，并且我们预计当用于将Proportion变量分类到Vote变量时，它们将有 91%的准确性。

摘要

本章展示了如何使用多重线性回归模型，这是最常用的模型家族之一，来预测数值和分类数据。我们的重点是展示编程技术，这些技术允许分析师在保持代码质量高的同时提高项目效率。我们通过展示如何程序化地创建不同的模型组合、测量预测准确性和选择最佳模型来实现这一点。所使用的技巧可以很容易地用于其他更高级的模型类型，我们鼓励您尝试使用其他模型家族来提高预测准确性。在本书附带的代码（github.com/PacktPublishing/R-Programming-By-Example）中，您可以找到一个实现，它还使用了广义线性模型来生成预测。

在下一章中，我们将开始使用一个不同且技术性略低的示例，该示例使用一家假设公司的产品数据来展示如何以多种方式处理操纵性数据，并将其用于多种可视化，包括 3D、交互式和地理空间图。

第四章：模拟销售数据和与数据库一起工作

食品工厂的例子是关于一家虚构的公司，名为食品工厂。他们为寻找健康食品的人提供定制餐食。他们允许客户选择他们想要的宏量营养素组合，以及他们的蛋白质来源。宏量营养素是任何饮食的基础，它们由碳水化合物、蛋白质和脂肪组成。客户可以选择每种宏量营养素的百分比，以及他们的蛋白质来源（鱼、鸡肉、牛肉或素食）；然后，食品工厂将提供一份美味的餐食，满足他们的饮食要求。他们通过这种方式找到了一些很好的组合，如果他们继续做得像现在这样好，他们将根据客户最喜欢的添加更多餐食选项以及固定食谱。

食品工厂到目前为止做得很好，他们已经建立了一套系统，可以让他们在其五个门店收集大量数据，同时跟踪客户信息。在这个例子中，我们的工作将是分析数据，以诊断业务的当前状态，并提出改进的方法。为此，我们将使用大量的可视化，在第五章，用可视化传达销售；在第六章，通过文本分析理解评论；以及在第七章，开发自动演示中提供对业务当前状态的自动诊断。听起来不错，对吧？然而，在我们能够做所有这些之前，我们需要掌握数据，但我们还没有。我们将模拟它！本章将向您展示如何设计一个非平凡的数据模拟来生成示例所需的数据。此外，食品工厂以及许多组织并不总是让我们的工作变得容易，他们经常提供 CSV 文件，并且他们通常有我们需要与之合作的数据库。本章还将向您展示如何处理这样的数据库。

本章涵盖的一些重要主题包括：

• 设计和实施非平凡模拟

• 模拟数字、类别、字符串和日期

• 带有参数对象的函数签名

• 在不同上下文中重用函数

• 混合内部和外部数据

• 与关系数据库一起工作

所需软件包

仅需本章所需的软件包是RMySQL。然而，为了能够完全复制本章末尾所示代码，您需要一个可工作的 MySQL 数据库安装(www.mysql.com/)。有关 Linux 和 Mac 的具体说明，请参阅附录，所需软件包。

软件包	原因
RMySQL	MySQL 数据库接口

设计我们的数据表

在开始编程之前用纸和铅笔设计总是一个好习惯。如果你这样做，你会发现你的代码会更好，因为你会考虑那些如果你直接开始编程可能看不到的场景，而且，你将能够事先设计解决方案，而不是在已经编写的代码中打补丁。这是一个很容易的投资，而且往往能带来回报，所以这就是我们在这个部分要做的，我们将设计我们的数据。

基本变量

让我们从最简单的场景开始想象，并尝试找出我们可能遇到的问题。对于每一笔销售，我们希望有以下变量：销售日期，生产该类型食品的成本，购买的数量，该类型食品的价格，是否应用了折扣，碳水化合物（CARBS）、蛋白质和脂肪的宏量营养素百分比，食品的蛋白质来源（如果是素食者，则为FISH、CHICKEN、BEEF或VEGETARIAN），销售所在的商店，配送方式（要么是发送到地点，要么是在商店内配送），销售的状态，可以是待处理、已配送、已退货或已取消（销售不能同时具有两种状态），是否已支付，客户的出生日期和性别，他们给公司评了多少星，客户的注册日期，以及他们与订单相关的消息数量，以及每个消息的日期、星数和实际消息。

简化假设

我们可以随意复杂化这个例子，但为了保持模拟简单（尽管不是微不足道的），我们事先假设一些事情。首先，我们假设每条销售记录只包含一种类型的食品。如果一个人购买两种或更多不同类型的食品，那么每种类型将产生不同的销售记录。然而，只要食品类型相同（宏量营养素和蛋白质来源的组合），每笔销售可以包含我们想要的任何数量的食品。这是最重要的简化，因为公司的销售订单通常每笔销售包含多种商品，但这将使我们能够专注于编程方面的事情。

其次，我们不会担心食物类型和成本（或价格）在数学意义上的连续性关系。这意味着我们可能会找到一个食物类型，其宏量营养素和蛋白质来源的组合与另一种食物的组合非常相似，但它们的制造成本以及价格却非常不同。同样，我们假设每种食物类型都有其独特的成本和价格，并且这些成本和价格可能因不同的销售而异（同一种食物类型在不同销售中可能有不同的成本和价格）。这个假设并不现实，因为大多数公司都有标准化的产品（包括成本和价格），但我们可以将食品工厂视为一个手工艺品店，每种食物都是独一无二的，这可以产生成本和价格上的差异。如果有什么的话，这只是在分析中增加了复杂性（乐趣）。

第三，我们不会担心销售日期和销售状态之间的关系，或者销售日期和销售是否已付款之间的关系。这意味着我们实际上可能会发现已经交付但尚未付款的旧销售。这在现实生活中确实会发生，因此假设这一点没有问题。

第四，客户与特定销售相关的消息的评分高低，不会影响他们对食品工厂的整体评分。有两个“星级”列，一个用于食品工厂的整体评分，另一个将随每条与订单相关的消息发送。这意味着一个通常喜欢食品工厂的客户可能会有一次不好的体验，但这不会影响他们继续喜欢这家店的程度。相反，一个通常不喜欢食品工厂的客户，不会因为某一天的好体验而开始喜欢它。这个假设对于有固定偏好的个人是成立的，但并不普遍。如果我们愿意，我们可以在模拟中包含考虑这些动态的机制。实际上，我鼓励你尝试自己实现一些这些机制。这将是一个很好的实践。

第五，我们不会担心宏量营养素是否合理，包括与蛋白质来源的组合。常见的饮食中大约包括 50%的蛋白质、35%的碳水化合物和 15%的脂肪，但我们不会担心我们的数字在营养学上是否合理。这意味着，请不要认为这些模拟食品订单是现实的，或者实际上是健康的。

潜在的陷阱

现在我们已经了解了数据结构的一般形式，我们需要找到应该避免的潜在陷阱。我们可以将这个数据结构视为一个标准的表格结构（一个数据框或电子表格），其中每一列代表一个变量，每一行代表一个观察值（在我们的案例中是销售记录）。

过多的空格问题

假设我们有一个销售记录；如果我们收到客户关于该订单的消息，会发生什么？嗯，我们只需将数据添加到相应的列 DATE、STARS 和 MESSAGE。如果我们收到另一条与同一订单相关的消息，会发生什么？嗯，一个可能的解决方案是为新消息添加一个新的 DATE、STARS 和 MESSAGE 组合，但名称会重叠。

我们如何区分它们？嗯，我们可以在后面附加一个表示实际消息编号的数字。然后，我们就会有第一条消息的 DATE_1、STARS_1 和 MESSAGE_1，以及第二条消息的 DATE_2、STARS_2 和 MESSAGE_2。这样就能解决问题，不是吗？如果我们收到第三条或更多的与订单相关的消息，会发生什么？嗯，我们最终会在数据框中有很多变量。具体来说，我们会根据发送给单个订单的消息的最大数量来组合变量。对于没有这么多消息的订单，单元格的内容会是什么？它们将是空的。这将浪费很多空间！此外，数据的一般结构会感觉很不舒服。一定有更好的方法。

如果你这样想，感觉消息和销售是两回事，它们应该分开保存，不是吗？如果你这样想，你就对了。那么，让我们想象一下，让我们保留一个数据框用于销售订单，另一个用于消息。还有一个问题。你能看到吗？我们如何区分哪些消息属于哪个销售订单？标识符来帮忙！我们可以在销售数据框中添加 SALE_ID，它应该是唯一的，我们可以在消息数据框中添加相同的 SALE_ID，它将不是唯一的，因为可能有多个消息与同一销售订单相关。这意味着我们有一个一对一的关系。考虑到这一点，销售数据框将包含我们之前提到的所有变量，但不包括消息的 DATE、STARS 和 MESSAGE 变量（不要将销售订单的 DATE 与每条消息的 DATE 混淆），这三个变量将符合单独的消息数据框。两个数据框都将有一个 SALE_ID 变量。太好了；我们解决了这个问题。

过多重复数据的问题

在销售数据框中我们还有哪些变量？嗯，为了使问题非常明显，我们仍然有销售变量和客户的变量。那么，问题可能是什么？嗯，每次客户进行新的购买时，我们都会再次保存她的BIRTH_DATE、CLIENT_SINCE、GENDER和STARS信息。如果一个常客在食品工厂有 100 次不同的购买呢？嗯，她的信息将会重复 100 次！我们需要解决这个问题。我们该如何做呢？我们做和之前一样的事情，分离不同的事物。没错。我们为客户数据创建一个单独的数据框，并且我们已经知道如何将客户与销售联系起来，因为我们之前在处理前一个问题时就使用了同样的技术，我们在两个数据框中创建标识符。这是一个多对一的关系（从销售数据的角度来看客户的资料）。我相信你能想出哪些变量属于哪个数据框。

通过消除重复数据，我们也消除了意外更改这些重复值并对此感到困惑的可能性。

为了回顾，我们所做的是将一个包含所有信息的巨大初始表分解成三个不同的表，这些表通过标识符相互链接，这样我们可以在每个表中表示不同的事物（销售、客户和客户消息），同时消除很多浪费的空间和重复的值。为了更好地理解这些调整后的组织结构，我们可以查看以下图像，它显示了哪些数据属性属于哪些实体，以及它们之间是如何相互关联的：

模拟的数据实体和属性

这些技术与许多其他技术一起被称为数据库规范化，在某些场景中可能很有用。然而，有时我们可能不希望我们的数据完全规范化，因为性能问题，但这些是本书不会涉及的高级案例。对于感兴趣的读者，我建议查阅 Silberschatz、Korth 和 Sudarshan 的《数据库系统概念，2010》以获取高级概念和示例。

最后，请记住，尽管我们在本章中创建了独特的标识符，但在现实世界的应用中，你最好使用一个经过良好建立的工具来完成这样的任务。uuid包专门设计用来生成和处理全球唯一标识符（UUIDs）。你可以在其 CRAN 页面找到更多信息（cran.r-project.org/web/packages/uuid/index.html)。

模拟销售数据

足够的概念了；让我们开始编程。为了清楚地了解我们将要走向何方，我们首先初始化我们将要使用的sales数据框，目前为零观察值。我们通过定义每个因子变量的可用类别，并定义每个变量所需的数据类型来空值。如您所见，它有SALE_ID和CLIENT_ID标识符，这将允许我们将这些数据与clients和client_messages中的数据联系起来。为了理解这一点，让我们看一下以下代码：

status_levels <- c("PENDING", "DELIVERED", "RETURNED", "CANCELLED")
protein_source_levels <- c("BEEF", "FISH", "CHICKEN", "VEGETARIAN")
continent_levels <- c("AMERICA", "EUROPE", "ASIA")
delivery_levels <- c("IN STORE", "TO LOCATION")
paid_levels <- c("YES", "NO")

sales <- data.frame(
    SALE_ID = character(),
    CLIENT_ID = character(),
    DATE = as.Date(character()),
    QUANTITY = integer(),
    COST = numeric(),
    PRICE = numeric(),
    DISCOUNT = numeric(),
    PROTEIN = numeric(),
    CARBS = numeric(),
    FAT = numeric(),
    PROTEIN_SOURCE = factor(levels = protein_source_levels),
    CONTINENT = factor(levels = continent_levels),
    DELIVERY = factor(levels = delivery_levels),
    STATUS = factor(levels = status_levels),
    PAID = factor(levels = paid_levels)
)

与你可能在其他地方找到的许多其他方法相比，这种初始化空数据框的方式更安全，因为你从一开始就会拥有正确的列类型。如果你的代码依赖于某些列类型检查（正如我们将要做的那样），它甚至会在零行数据的数据框中工作（正如这里的情况）。

根据分布假设模拟数值数据

我们将分别生成每一列的数据，然后用这些数据重新创建数据框。我们想先从简单的部分开始，所以我们将查看QUANTITY、COST、PRICE和DISCOUNT的模拟。简单的方法就是随机生成一些数字，并通过相应的乘除确保它们在某个范围内。我们也可以使用round()函数确保QUANTITY不是分数。然而，如果我们想正确地做这件事，那么我们必须考虑这些数字背后的假设。下面段落中提到的分布的图像如下所示。

COST、PRICE、QUANTITY 和 DISCOUNT 的分布

COST和PRICE的值遵循正态分布，因为它们是实数。平均而言，COST应该低于PRICE，因此我们将相应地设置它们的均值参数。请注意，这允许某些食品以低于其生产成本的价格出售，这在公司试图最小化损失时有时会发生。DISCOUNT遵循指数分布，因为我们希望大多数折扣为零或低（与价格相比）。这意味着我们不会经常提供折扣，而且当提供时，折扣会很小。QUANTITY遵循泊松分布，因为它需要是一个整数。一个很好的资源是 Sean Owen 的《常见概率分布：数据科学家的便签，2015》（blog.cloudera.com/blog/2015/12/common-probability-distributions-the-data-scientists-crib-sheet/)。

在这些假设的基础上，我们将创建三个函数。COST 和 PRICE 通过 random_values() 函数进行模拟，而 QUANTITY 和 DISCOUNT 则有它们自己的函数。random_values() 函数使用 rnorm() 函数通过正态分布模拟 n 个值（其中 n 是我们希望在数据框中拥有的行数），具有特定的 mean 和标准差（sqrt(variance)）。然后我们使用 round() 函数将这些值四舍五入到两位小数，如下所示：

random_values <- function(n, mean, variance) {
    return(round(rnorm(n, mean, sqrt(variance)), 2))
}

random_discounts() 函数使用 rexp() 函数通过指数分布模拟 n 个值，使用 lambda 参数，并且像之前一样，我们使用 round() 函数将值四舍五入到两位小数。当我们使用这个函数时，我们会使用一个非常高的 lambda 参数（100）来严重偏斜分布到右侧，以便在模拟中获得很多零。然而，这将使我们的值变得非常小（例如，0.021）。如果我们直接使用这些值，我们的折扣将只有几美分，这是不现实的。因此，我们将这些值乘以 100 以获得几美元的折扣。请注意，如果我们先四舍五入然后乘以 100，我们得到的是整美元折扣（例如，$2），但如果我们先乘以 100 再四舍五入，我们得到的折扣将包括分（例如，$2.1），这是我们希望避免的，但它也会同样有效。让我们看一下以下代码来理解这一点：

random_discounts <- function(n, lambda) {
    return(round(rexp(n, lambda), 2) * 100)
}

random_quantities() 函数使用 rpois() 函数通过泊松分布模拟 n 个值，使用 lambda 参数。在这种情况下，我们不需要四舍五入，因为值将已经是整数。然而，我们给每个值加 1，因为我们可能会得到零作为数量，而拥有零食品的销售订单是没有意义的。加 1 保证每个销售订单中至少有一件食品：

random_quantities <- function(n, lambda) {
    return(rpois(n, lambda) + 1)
}

使用因子模拟分类值

random_levels() 函数通过有放回地抽样提供的 levels 来模拟 n 个分类值（由第三个参数控制，发送为 TRUE）。你可以把 levels 视为一个字符串数组，每个字符串都是模拟的可能值。这些 levels 将来自数据框中因子变量定义的类别（PROTEIN_SOURCE、STORE、DELIVERY、STATUS 和 PAID）。有放回的抽样意味着每次我们从 levels 对象中选择一个值时，我们都会返回它，以便我们稍后可以再次选择它。不进行放回的抽样只有在你想得到比可用的总值数量少的样本数量时才有意义，而这在这里不是情况，因为我们想模拟成千上万的行，我们不会有那么多 levels。

我们还有一个未提及的第三个参数，即probabilities参数。如您所见，默认情况下它设置为NULL，但我们确实发送了一个对象到那里；它必须是一个介于 0 和 1 之间的数字向量，它们的和为 1，并且代表选择特定类别的概率。这个probabilities对象的顺序必须与levels对象中的顺序相同。例如，如果我们有三个可能的级别，并且将probabilities对象发送为c(0.2, 0.3, 0.5)，则第一个级别将有 20%的概率被选中，而第二个和第三个级别将分别有 30%和 50%的概率。请注意，概率的总和为 1。让我们看看代码：

random_levels <- function(n, levels, probabilities = NULL) {
    return(sample(levels, n, TRUE, probabilities))
}

注意，在我们将probabilities对象传递给sample()函数之前，我们没有检查该对象是否为NULL。这是因为sample()函数中对应的参数也默认使用NULL，并将其解释为对所有值使用相等的概率。您可以在函数的文档中查看这一点。

为了测试概率是否被正确实现，我们可以模拟 100 个值，然后创建一个包含结果的表格，以查看每个类别的生成值的数量。如您所见，如果我们模拟类别A、B和C的100个值，其概率分别为 20%、30%和 50%，我们得到的比例分别为 18%、37%和 45%。这些结果与我们的规格足够接近，因此是正确的。请注意，每次重新执行代码时，您都会得到不同的值，并且它们几乎永远不会是您指定的确切值，这在模拟中是自然的。然而，它们应该几乎总是接近规格：

results <- random_levels(100, c("A", "B", "C"), c(0.2, 0.3, 0.5))
table(results)
#> results
#>  A  B  C
#> 18 37 45

在范围内模拟日期

random_dates_in_range()函数使用了我们之前使用的相同的sample()函数，但它不会从因子变量接收字符串列表作为类别，而是会接收日期列表。为了生成模拟的有效日期的全集，我们使用seq()函数。此函数将根据特定的间隔生成从start到end的所有值。如果我们想生成 1 到 10 之间的所有奇数，我们将使用seq(1, 10, 2)，这意味着它将按顺序将1加上2，直到达到10。在我们的情况下，我们希望增量为一个完整的天，并且方便的是，seq()函数在发送日期对象时通过发送增量字符串"day"提供了这种能力：

random_dates_in_range <- function(n, start, end, increasing_prob = FALSE) {
    sequence <- seq(start, end, "day")
    if (increasing_prob) {
        probabilities <- seq(1, length(sequence))²
        probabilities <- probabilities / sum(probabilities)
        return(sample(sequence, n, TRUE, probabilities))
    } else {
        return(sample(sequence, n, TRUE))
    }
}

注意，这仅在发送日期对象时才会起作用。如果您尝试用字符串测试此函数，您将得到一个错误，表明'from'不能是 NA、NaN 或无穷大。相反，您应该使用as.Date()函数将这些字符串转换为日期：

seq("2017-01-01", "2017-02-01", "day")                    # Error
seq(as.Date("2017-01-01"), as.Date("2017-02-01"), "day")  # Valid

在共享限制下模拟数字

如您所记得，食品工厂通过接收宏量营养素规格来创建他们的食品。客户可以指定他们想要的每个食品的百分比组合，只要它们的总和为 1。现在我们将模拟这些宏量营养素百分比。这比之前的案例需要更多的工作。

首先，我们创建一个函数，该函数将返回数值三元组，其中每个数字介于 0 和 1 之间，并且它们加起来等于 1。为了实现这一点，我们将使用两个随机数，并将第三个数依赖于前两个数。我们将使用以下数学事实：

这告诉我们取一个数字为1 - max(a, b)，另一个为min(a, b)，最后一个为abs(a, b)；这正是我们在random_triple()函数中所做的。从数学上保证我们将得到三个介于 0 和 1 之间的随机数，它们加起来等于 1。请注意，random_triple()是我们创建的少数几个不需要任何参数的函数之一，这是有意义的，因为我们不需要外部信息来模拟三元组：

random_triple <- function() {
    a <- runif(1, 0, 1)
    b <- runif(1, 0, 1)
    PROTEIN <- 1 - max(a, b)
    CARBS <- abs(a - b)
    FAT <- min(a, b)
    return(c(PROTEIN, CARBS, FAT))
}

我们可以通过对结果使用sum()来简单地测试它是否工作：

triple <- random_triple()
triple
#> [1] 0.05796599 0.76628032 0.17575370

sum(triple)
#> 1

现在，我们想要生成n个这样的三元组。为此，我们使用replicate()函数来生成n个三元组。TRUE参数对应于函数的simplify参数，它将三元组列表简化为矩阵形式，这在特定情况下更容易处理。当我们测试代码并查看replicate(n, random_triple(), TRUE)的结果时，我们会发现结果结构是我们想要的转置，这意味着它有三行和n列，其中每一行代表宏量营养素百分比，每一列代表一个观察值。我们想要转置这个结构，以得到宏量营养素百分比作为列，观察值作为行；为此，我们只需使用t()函数。之后，我们只需创建一个包含每个宏量营养素对应值的 data frame：

random_composition <- function(n) {
    matrix <- t(replicate(n, random_triple(), TRUE))
    return(data.frame(PROTEIN = matrix[, 1], 
                      CARBS = matrix[, 2], 
                      FAT = matrix[, 3]))
}

模拟复杂标识符的字符串

是时候模拟最复杂的一部分了，即标识符。我们想要生成n个标识符，并且根据我们模拟的标识符类型，我们可能希望它们是唯一的。客户数据中的客户标识符必须是唯一的，因为我们不希望有两个具有相同标识符的不同客户，并且根据设计，我们的客户数据将不会有重复的记录。另一方面，我们不想在销售数据中有唯一的客户标识符，因为我们希望重复的客户出现在那里。

我们可以创建两个不同的函数来独立处理这些情况，但通过使用一个指定唯一标识符百分比的reduction参数，我们可以很容易地将它们合并成一个函数。如果reduction参数设置为 0（默认值），我们假设需要完整的唯一标识符。我们将假设标识符由一组字母后跟一组数字组成，并且每组长度应单独指定。这就是n_letters和n_digits的作用。我们的实现将通过分别创建字母和数字组，然后组合它们来实现。

首先，我们将通过从LETTERS组（一个包含所有大写 ASCII 字母的内部 R 对象）中抽取大小为n的样本（我们可能在每个标识符中都有重复的字母）来创建字母组合。然后，我们将对这个样本进行n_letters次复制，这是每个标识符中所需的字母数量，我们不会简化结构，这就是为什么我们发送FALSE参数。这将返回一个包含n_letters个元素的列表，其中每个元素是一个包含n个字母的向量。现在我们想要将这些对象粘合在一起。为了做到这一点，我们使用paste0()函数（它是paste()函数的一个快捷方式，如果只使用paste()，你将在字母之间得到空格）。然而，我们不能将我们的构建发送到paste0()，因为我们将会得到一些垃圾输出。我们需要使用do.call()函数来正确地做到这一点。为了理解正在发生的事情，让我们假设n_letters是 5，看看代码是如何表现的。

n_letters <- 5
letters <- do.call(paste0, replicate(
           n_letters, sample(LETTERS, n, TRUE), FALSE))
letters
#> [1] "KXSVT" "HQASE" "DDEOG" "ERIMD" "CQBOY"

现在我们将关注数字组合。我们的目标是得到一个介于零和由n_digits个九组成的数字之间的数字。例如，如果n_digits是 5，我们希望得到 0 到 99,999 之间的数字。这将被分为两个步骤。首先，创建一个由九组成的动态右极端数字。然后，确保它恰好有n_digit位数字，即使自然表示数字的方式不是这样。这意味着如果n_digits是 5，而我们最终抽取的数字是 123，我们需要使用 00123 作为结果，因为我们需要确保有n_digit位数字。

为了完成第一部分，我们使用replicate()函数重复字符串9n_digits次。然后我们使用paste()函数，并设置collapse = ""来将所有字符串组合在一起，得到一个如99999的字符串。然后我们使用as.numeric()函数将这个字符串转换为数字。最终我们在max_number对象中得到了所需的九位数。

然后我们使用 sprintf() 函数来确保在使用数字时具有 n_digits 位。为此，我们指定一个带有前导零的 format（使用 "%0" 语法），这样我们就有 n_digits 位（使用 n_digits 后跟 d 字母表示数字）。我们将这个格式放在 paste() 函数中，因为格式字符串将会动态创建。按照之前的例子，如果是 5 位数字，将会是 "%05d"。有关如何使用 sprintf() 函数的更多信息，请参阅 第一章，R 语言简介。这些行结合起来给我们：

max_number <- as.numeric(paste(replicate(n_digits, 9), collapse = ""))
format <- paste("%0", n_digits, "d", sep = "")
digits <- sprintf(format, sample(max_number, n, TRUE))
digits
#> [1] "84150" "88603" "88640" "24548" "06355"

现在我们需要再次使用 paste0() 函数将 letters 和 digits 对象粘贴在一起。由于这是一个向量操作，我们最终将得到一个包含 n 个标识符的单个数组。请注意，尽管我们没有强制唯一性，但采样程序产生重复标识符的概率极低，所以我们在这里不会担心。

现实世界的问题具有产生这些极低概率情况的惊人能力，使得粗心的代码会失败。如果你正在开发关键应用，请务必明确检查这些情况。

最后，如果 reduction 大于零，意味着我们只想使用到目前为止创建的标识符的 reduction 百分比来生成总共 n 个标识符，我们将使用 sample() 函数从第一个 reduction 百分比标识符中获取 n 个标识符，这被计算为一个从 1 到 ids 百分比下限的数组（必须是整数），并且我们将进行有放回的抽样（因此有 TRUE 参数）。如果 reduction 为零，我们只需发送到目前为止创建的 ids 而不进行任何修改：

random_strings <- function(n, n_letters, n_digits, reduction = 0) {
    letters <- do.call(paste0, replicate(
                       n_letters, sample(LETTERS, n, TRUE), FALSE))
    max_number <- as.numeric(paste(replicate(n_digits, 9), 
                                   collapse = ""))
    format <- paste("%0", n_digits, "d", sep = "")
    digits <- sprintf(format, sample(max_number, n, TRUE))
    ids <- paste0(letters, digits)
    if (reduction > 0) {
        ids <- sample(ids[1:floor(reduction * length(ids))], n, TRUE)
    }
    return(ids)
}

将一切组合起来

现在我们已经完成了创建所有模拟函数的艰苦工作，我们只需将它们组装在一个通用函数中，该函数将使用它们来轻松地为我们模拟数据。我们首先注意到有很多参数需要我们控制，如果我们创建一个包含所有这些参数的显式函数签名，我们将通过具有刚性签名来约束自己，这使得工作变得困难。我们不希望手动处理这些参数，因为这会使代码变得繁琐。如果我们能传递一个会根据我们的需求进行变化的单个参数会怎样？嗯，我们可以做到！参数对象就是为了这个原因而存在的。这是一个简单易懂的概念，提供了很多灵活性。它们是在发送到函数之前打包的列表，并在函数内部解包以供嵌套函数内部按需使用。这是一种 封装 的形式。我们将在 第八章，面向对象系统跟踪加密货币 中深入了解封装。

接下来，我们注意到，由于这些模拟是随机过程，这意味着每次执行时我们可能会得到不同的结果，我们可能会失去结果的可重复性。为了避免这种情况，我们只需在模拟开始时设置种子，以确保每次都能得到相同的结果，就像我们在第三章“使用线性模型预测选票”中所做的那样。

其余的代码只是调用我们已创建的函数，并使用来自我们开始解包的参数对象的适当参数。有三点值得注意。首先，我们不能直接将random_composition()函数用于我们创建的数据框中的变量之一，因为结果对象包含数据框中三个不同变量的数据。因此，我们需要存储一个包含结果的中间对象composition，然后使用它来提取每个宏量营养素的信息。其次，我们使用data.frame()函数的stringsAsFactors参数设置为FALSE，以确保SALE_ID和CLIENT_ID不被视为因子（因为它们是字符串）。当因子内部有多个类别时，处理数据框会变慢，我们可以通过将它们视为简单的字符串来避免这种情况，因为我们会有很多唯一的标识符。第三，由于我们将所有字符串视为非因子，并且在使用random_levels()时可能不会在我们的样本中获得所有可能的类别，因子变量可能没有我们之前指定的某些因子被定义。为了确保这种情况不会发生，我们明确地在factor()函数内部定义级别，使其与原始销售数据框中的级别相同，该数据框包含我们从初始定义中发送给函数的数据：

random_sales_data <- function(sales, parameters) {
    n <- parameters[["n"]]
    n_letters <- parameters[["n_letters"]]
    n_digits <- parameters[["n_digits"]]
    reduction <- parameters[["reduction"]]
    date_start <- parameters[["date_start"]]
    date_end <- parameters[["date_end"]]
    quantity_lambda <- parameters[["quantity_lambda"]]
    price_mean <- parameters[["price_mean"]]
    price_variance <- parameters[["price_variance"]]
    cost_mean <- parameters[["cost_mean"]]
    cost_variance <- parameters[["cost_variance"]]
    discount_lambda <- parameters[["discount_lambda"]]
    protein_source_pbs <- parameters[["protein_source_probabilities"]]
    continent_pbs <- parameters[["continent_probabilities"]]
    delivery_pbs <- parameters[["deliver_probabilities"]]
    status_pbs <- parameters[["status_probabilities"]]
    paid_pbs <- parameters[["paid_probabilities"]]

    set.seed(12345)

    composition = random_composition(n)

    sales <- data.frame(
        SALE_ID = random_strings(n, n_letters, n_digits),
        CLIENT_ID = random_strings(n, n_letters, n_digits, reduction),
        DATE = random_dates_in_range(n, date_start, date_end),
        QUANTITY = random_quantities(n, quantity_lambda),
        COST = random_values(n, cost_mean, cost_variance),
        PRICE = random_values(n, price_mean, price_variance),
        DISCOUNT = random_discounts(n, discount_lambda),
        PROTEIN = composition$PROTEIN,
        CARBS = composition$CARBS,
        FAT = composition$FAT,
        PROTEIN_SOURCE = factor(
            random_levels(n, 
                          levels(sales$PROTEIN_SOURCE), 
                          protein_source_pbs),
            levels = levels(sales$PROTEIN_SOURCE)
        ),
        CONTINENT = factor(
            random_levels(n, levels(sales$CONTINENT), continent_pbs),
            levels = levels(sales$CONTINENT)
        ),
        DELIVERY = factor(
            random_levels(n, levels(sales$DELIVERY), delivery_pbs),
            levels = levels(sales$DELIVERY)
        ),
        STATUS = factor(
            random_levels(n, levels(sales$STATUS), status_pbs),
            levels = levels(sales$STATUS)
        ),
        PAID = factor(
            random_levels(n, levels(sales$PAID), paid_pbs),
            levels = levels(sales$PAID)
        ),
        stringsAsFactors = FALSE
    )
    sales <- skew_sales_data(sales)
    return(sales)
}

最后，为了创建我们的模拟，我们使用必要的parameters对象创建sales对象，并使用random_sales_data()函数更新我们的sales对象。在这种情况下，我们将模拟 2015 年 1 月（date_start）和今天日期（date_end，使用Sys.Date()函数生成今天的日期）之间的 10,000 个销售订单。我们需要我们的标识符由五个字母（n_letters）后跟五个数字（n_digits）组成，并且我们希望CLIENT_ID只使用生成的标识符的前 25%以允许重复的客户（reduction）。

我们希望每个销售订单平均有五种食品（quantity_lambda），生产成本的平均值为 30（cost_mean）和方差为 10（cost_variance），价格的平均值为 50（price_mean）和方差为 10（price_variance）。我们还希望折扣在 1 或 2 美元左右（discount_lambda；记得我们在相应函数内部所做的转换）。最后，我们希望PENDING、DELIVERED、RETURNED和CANCELLED状态的概率分别为 20%、60%、10%和 10%。类似地，我们希望订单付款的概率为 90%：

parameters <- list(
    n = 10000,
    n_letters = 5,
    n_digits = 5,
    reduction = 0.25,
    date_start = as.Date("2015-01-01"),
    date_end = Sys.Date(),
    quantity_lambda = 2,
    cost_mean = 12,
    cost_variance = 1,
    price_mean = 15,
    price_variance = 2,
    discount_lambda = 100,
    protein_source_probabilities = c(0.6, 0.2, 0.1, 0.1),
    continent_probabilities = c(0.5, 0.3, 0.2),
    delivery_probabilities = c(0.7, 0.3),
    status_probabilities = c(0.2, 0.6, 0.1, 0.1),
    paid_probabilities = c(0.9, 0.1)
)
sales <- random_sales_data(sales, parameters)

你可以玩转这些参数，并模拟许多不同类型的场景。例如，如果你想模拟一家经营状况不佳、利润微薄甚至亏损的公司，你可以将成本和价格手段结合起来，甚至可能增加它们各自的方差，以确保有很多交叉点，即每笔销售订单的损失。

恭喜！你现在知道如何产生非平凡的数据模拟。有了这些知识，你可以模拟许多种类的数据，享受其中的乐趣。我们鼓励你扩展这个例子，并使用以下章节中的知识来分析它。

模拟客户数据

现在我们已经完成了销售数据模拟，并且拥有了必要的基本数据，接下来的数据模拟将会容易得多。此外，我们将使用之前创建的许多函数来模拟客户和客户消息数据，这真是太好了！像这样重用函数非常高效，随着时间的推移，你将养成这样的习惯。你将建立自己的可重用代码库，这将使你在编程时越来越高效。

我们首先定义我们将使用的数据框，就像之前做的那样。在这种情况下，我们将有CLIENT_ID、BIRTH_DATE、CLIENT_SINCE、GENDER和STARS变量。STARS代表一个介于1（差）和5（优秀）之间的评分：

gender_levels <- c("FEMALE", "MALE")
star_levels <- c("1", "2", "3", "4", "5")

clients <- data.frame(
    CLIENT_ID = character(),
    BIRTH_DATE = as.Date(character()),
    CLIENT_SINCE = as.Date(character()),
    GENDER = factor(levels = gender_levels),
    STARS = factor(levels = star_levels)
)

我们首先需要注意的是，不应再次模拟CLIENT_ID信息，因为我们将从销售数据中获取与现有不同的客户端标识符。我们希望在销售数据中拥有唯一的客户端标识符，以对应客户端数据中的一个记录，我们通过将它们作为client_ids参数发送，并将它们直接分配到clients数据框中的CLIENT_ID变量来实现这一点。在这种情况下，n将对应于我们获得的唯一客户端标识符的数量，我们通过使用length()函数来获取这个数量。我们像往常一样使用参数对象提取其他参数。具体来说，我们需要有效日期范围，这些日期对于我们的客户出生日期来说是有效的（他们必须至少 18 岁），以及自他们成为客户以来的有效日期范围（他们不可能在 2015 年 1 月公司开始运营之前成为客户；请参阅销售数据模拟的参数）。代码的其余部分与我们在销售数据模拟中看到的基本相同，因此我们不再解释。为了理解这一点，让我们看一下以下代码：

random_clients_data <- function(clients, client_ids, parameters) {
    n <- length(client_ids)
    bd_start <- parameters[["birth_date_start"]]
    bd_end <- parameters[["birth_date_end"]]
    cs_start <- parameters[["client_since_start"]]
    cs_end <- parameters[["client_since_end"]]
    stars_pbs <- parameters[["stars_probabilities"]]

    set.seed(12345)

    clients <- data.frame(
        CLIENT_ID = client_ids,
        BIRTH_DATE = random_dates_in_range(n, bd_start, bd_end, TRUE),
        CLIENT_SINCE = random_dates_in_range(n, cs_start, cs_end, TRUE),
        GENDER = factor(
            random_levels(n, levels(clients$GENDER)),
            levels = levels(clients$GENDER)
        ),
        STARS = factor(
            random_levels(n, levels(clients$STARS), stars_pbs),
            levels = levels(clients$STARS)
        ),
        stringsAsFactors = FALSE
    )
    return(clients)
}

为了模拟客户数据，我们只需在参数对象内部创建相应的参数，并将其发送到random_clients_data()函数以更新clients数据框：

parameters <- list(
    birth_date_start = as.Date("1950-01-01"),
    birth_date_end = as.Date("1997-01-01"),
    client_since_start = as.Date("2015-01-01"),
    client_since_end = Sys.Date(),
    stars_probabilities = c(0.05, 0.1, 0.15, 0.2, 0.5)
)

clients <- random_clients_data(clients, 
                               unique(sales$CLIENT_ID), 
                               parameters)

你注意到这有多简单吗？这是因为我们在上一节中创建了我们的基础，这极大地简化了后续对相同概念的运用。随着你编程技能的提高，这种情况会越来越常见。

模拟客户消息数据

模拟有意义的文本消息非常困难，我们在这里不会尝试。相反，我们将利用一个关于亚马逊食品评论的数据集。该数据集作为 McAuley 和 Leskovec 发表的论文的一部分发布，该论文题为《从业余爱好者到鉴赏家：通过在线评论建模用户专业知识的演变，2013 年》。您可以在 Kaggle 上找到该数据集（www.kaggle.com/snap/amazon-fine-food-reviews）。我们不会展示准备此示例数据的代码，但基本上，它所做的就是重命名我们想要的变量STARS、SUMMARY和MESSAGE，删除其余部分，并将数据框保存到reviews.csv文件中。对于感兴趣的读者，完成此任务的代码、原始数据和处理后的数据都包含在此书的代码仓库中（github.com/PacktPublishing/R-Programming-By-Example）。

想法是，由于模拟这些数据很困难，我们将利用一个已经存在的包含真实评论的数据集，并从中抽样以获取我们想要的示例中的消息。和之前一样，我们首先定义我们将使用的 client_messages 数据框，其中包含 SALE_ID、DATE、STARS、SUMMARY 和 MESSAGE 变量，如下面的代码所示：

client_messages <- data.frame(
    SALE_ID = character(),
    DATE = as.Date(character()),
    STARS = factor(levels = star_levels),
    SUMMARY = character(),
    MESSAGE = character(),
    LAT = numeric(),
    LNG = numeric()
)

如我们之前所做的那样，在我们的 random_client_messages_data() 函数中，我们首先解包参数对象并设置种子。下一步是实际检索我们想要的评论样本，我们将使用我们接下来要创建的 random_reviews() 函数。假设我们已经准备好了评论数据，我们通过从销售数据中的 sale_ids 中随机抽样来创建 client_messages 数据框，这样我们就可以在消息和销售订单之间生成联系，并且我们以这种方式做，以便我们可以为单个销售订单生成各种消息，因为我们使用了 replace 参数作为 TRUE。代码的其他部分与之前我们看到的是相似的。让我们看看下面的代码：

random_client_messages_data <- function(client_messages, sales, parameters) {
    n <- parameters[["n"]]
    date_start <- parameters[["date_start"]]
    date_end <- parameters[["date_end"]]
    reviews_file <- parameters[["reviews_file"]]
    locations <- parameters[["locations"]]

    set.seed(12345)

    reviews <- random_reviews(n, reviews_file)

    client_messages <- data.frame(
        SALE_ID = sample(unique(sales$SALE_ID), n, TRUE),
        DATE = random_dates_in_range(n, date_start, date_end),
        STARS = factor(reviews$STARS, 
                       levels = levels(client_messages$STARS)),
        SUMMARY = reviews$SUMMARY,
        MESSAGE = reviews$MESSAGE,
        LAT = numeric(n),
        LNG = numeric(n),
        stringsAsFactors = FALSE
    )
    client_messages <- add_coordinates(client_messages, 
                                       sales, 
                                       locations)
    return(client_messages)
}

random_reviews() 函数将 CSV 文件路径作为 reviews_file 参数，并使用它将数据加载到 reviews 对象中。然后它抽取行索引的样本，但不进行替换，因为我们不希望重复使用相同的评论，而且我们有足够的评论来确保这种情况不会发生（数据中有超过 500,000 条评论）。我们只需简单地将这个数据框的子集返回，以便在最终的 client_messages 数据框中使用：

random_reviews <- function(n, reviews_file) {
    reviews <- readRDS(reviews_file)
    return(reviews[sample(1:nrow(reviews), n, FALSE), ])
}

最后，我们创建包含必要信息的参数对象，并将其传递给 random_client_messages_data()，以使用模拟数据更新 client_messages 数据框。确保你将 reviews_file 路径更改为适合你设置的路径（./ 表示它在同一目录中）。让我们看看下面的代码：

parameters <- list(
    n = 1000,
    date_start = as.Date("2015-01-01"),
    date_end = Sys.Date(),
    reviews_file = "./reviews/data/reviews.rds",
    locations = list(
        "AMERICA" = list(
            list(LAT = 35.982915, LNG = -119.028006),
            list(LAT = 29.023053, LNG = -81.762383),
            list(LAT = 41.726658, LNG = -74.731133),
            list(LAT = 19.256493, LNG = -99.292577),
            list(LAT = -22.472499, LNG = -43.348329)
        ),
        "EUROPE" = list(
            list(LAT = 40.436888, LNG = -3.863850),
            list(LAT = 48.716026, LNG = 2.350955),
            list(LAT = 52.348010, LNG = 13.351161),
            list(LAT = 42.025875, LNG = 12.418940),
            list(LAT = 51.504122, LNG = -0.364277)
        ),
        "ASIA" = list(
            list(LAT = 31.074426, LNG = 121.125328),
            list(LAT = 22.535733, LNG = 113.830406),
            list(LAT = 37.618251, LNG = 127.135865),
            list(LAT = 35.713791, LNG = 139.489820),
            list(LAT = 19.134907, LNG = 73.000993)
        )
    )
)
client_messages <- random_client_messages_data(client_messages, sales, parameters)

我们完成了！现在我们应该有一个完整的销售数据模拟，以及客户及其对应销售订单的消息数据。并非每个销售订单都会有消息，其中一些可能有多个，这是有意为之。记住，我们用于示例的评论不一定与食物相关，但我们的想法是展示如何使用这些技术来模拟使用现有数据集生成的新数据。

看看我们模拟的三个数据集应该会让我们的脸上露出笑容。请注意，我们省略了 client_messages 数据，因为它太大，无法在这里显示，但你应该能在你的电脑上看到它：

head(sales)
#>      SALE_ID  CLIENT_ID       DATE QUANTITY  COST PRICE DISCOUNT    PROTEIN
#> 1 OKRLL75596 EAWPJ80001 2015-01-27        3 27.58 50.79        1 0.12422681
#> 2 ZVTFG64065 WQGVB74605 2015-05-26        7 30.78 51.09        3 0.11387543
#> 3 SPRZD12587 XVRAM64230 2017-01-07        8 33.66 54.46        1 0.54351904
#> 4 YGOLB67346 PDVDC58438 2015-01-12        5 34.85 53.06        1 0.49077566
#> 5 CDQRA43926 VJCXI94728 2017-06-21        9 27.35 50.57        0 0.01026306
#>
#>       CARBS        FAT PROTEIN_SOURCE   STORE    DELIVERY    STATUS PAID
#> 1 0.1548693 0.72090390        CHICKEN STORE 4    IN STORE DELIVERED  YES
#> 2 0.1251422 0.76098233        CHICKEN STORE 3 TO LOCATION DELIVERED  YES
#> 3 0.2901092 0.16637179     VEGETARIAN STORE 1 TO LOCATION   PENDING  YES
#> 4 0.1841289 0.32509539        CHICKEN STORE 2 TO LOCATION DELIVERED  YES
#> 5 0.2620317 0.72770525     VEGETARIAN STORE 1 TO LOCATION DELIVERED  YES
(Truncated output) head(clients) #>    CLIENT_ID BIRTH_DATE CLIENT_SINCE GENDER STARS
#> 1 EAWPJ80001 1974-09-04   2015-05-21   MALE     4
#> 2 WQGVB74605 1987-01-24   2015-12-05 FEMALE     2
#> 3 XVRAM64230 1977-11-18   2017-06-26 FEMALE     2
#> 4 PDVDC58438 1987-11-23   2015-12-20   MALE     2
#> 5 VJCXI94728 1953-07-09   2016-05-03 FEMALE     3
(Truncated output)

与关系型数据库一起工作

现在我们已经拥有了后续示例所需的数据，我们将学习如何使用数据库来处理这些数据。在本节中，我们将学习如何将我们的数据保存到关系型数据库中，以及如何读取它。我们不会深入探讨高级操作或工作流程。我们只会关注基础知识，如果你对这个主题不感兴趣，可以跳过这一节。了解这些内容对于在后续章节中重现示例不是必需的。

我们必须做的第一件事是安装RMySQL包。有各种用于处理数据库的包，它们的工作方式几乎相同。我们选择RMySQL包，因为它是为 MySQL 数据库设计的，MySQL 数据库在几乎所有操作系统中都非常流行且易于使用。为了能够重现此代码，你需要在你的电脑上正确设置 MySQL 数据库，我们在这里不会详细介绍如何操作。你可以在网上找到许多优质资源。从现在开始，我们假设你已经准备好了你的数据库：

install.packages("RMySQL")

要与数据库一起工作，我们首先需要连接和断开连接。为此，我们使用dbConnect()和dbDisconnect()函数。dbConnect()函数返回一个包含数据库连接的对象，该对象必须在所有后续的数据库操作中使用。我们将称此对象为db，以提醒我们它代表我们正在处理的数据库：

db <- dbConnect(MySQL(), user = <YOUR_USER>, password = <YOUR_PASSWORD>, host = "localhost")
dbDisconnect(db)
#> [1] TRUE

如果你使用的是不在你使用 R 的同一台计算机上运行的数据库，那么你可以像使用任何 SQL 远程连接一样，在host参数中使用相应的 IP 地址。当我们知道我们要连接的数据库的名称时（单个 MySQL 服务器可以包含多个数据库），我们需要使用第五个参数。当你尝试从数据库断开连接后看到TRUE值，这意味着一切执行正确。

要将查询发送到数据库服务器，我们再次连接到它后使用dbSendQuery()函数。我们通过执行以下命令在我们的 MySQL 服务器上创建新的sales数据库（该数据库将包含我们的sales、clients和client_messages表）：

dbSendQuery(db, "DROP DATABASE IF EXISTS sales;")
dbSendQuery(db, "CREATE DATABSE sales;")

由于 MySQL 语法要求每个查询的末尾都要有;，根据你的设置，如果你没有放入它们，可能会得到一个错误。现在我们将断开并重新连接到服务器，但这次，我们将指定我们想要与之工作的特定数据库（我们刚刚创建的sales数据库）：

dbDisconnect(db)
db <- dbConnect(
    MySQL(),
    user = <YOUR_USER>,
    password = <YOUR_PASSWORD>,
    host = "localhost",
    dbname = "sales"
)

现在我们将模拟的数据写入 MySQL 服务器。为此，我们使用dbWriteTable()函数。第一个参数是数据库连接对象，第二个参数是我们想要存储数据的表名，第三个参数是包含我们想要存储的数据的数据框，第四个参数，正如其名称所暗示的，将覆盖（而不是追加）数据库中已存在的任何数据。

要将整个表从 MySQL 服务器读取到 R 中，我们使用dbReadTable()函数。然而，请注意，当我们这样做时，任何关于因子的信息都会丢失，数据框只知道它包含字符串，这是数据在 MySQL 服务器内部存储的方式。为了验证这一点，你可以使用str()函数查看从 MySQL 服务器读取的数据的结构。我们不会在这里显示输出以节省空间，但你将发现sales确实有因子信息，而sales_from_db则没有：

sales_from_db <- dbReadTable(db, "sales")
str(sales)
str(sales_from_db)

如果不解决关于因子变量的元数据问题，在下一章创建可视化时会有影响。我们现在可以处理它，或者稍后处理，但既然本章是关于处理数据，我们将在这里展示如何做到这一点。首先，我们将创建一个read_table()函数，该函数将包装dbReadTable()函数。这个read_table()函数将检查正在读取哪个表，并通过调用add_sales_metadata()、add_clients_metadata()或add_client_messages_metadata()来应用适当的元数据。请注意，如果正在读取的表不是这三个之一，我们现在不知道要添加什么元数据，所以我们只需直接返回表即可：

read_table <- function(db, table) {
    data <- dbReadTable(db, table)
    if (table == "sales") {
        return(add_sales_metadata(data))
    } else if (table == "clients") {
        return(add_clients_metadata(data))
    } else if (table == "client_messages") {
        return(add_client_messages_metadata(data))
    } else {
        return(data)
    }
}

我们向每个案例添加元数据的方式是重新定义因子变量，就像我们之前做的那样，以及转换日期对象，这些对象也是作为字符串接收的。我们不需要在数据中做任何其他改变：

add_sales_metadata <- function(data) {
    status_levels <- c("PENDING", "DELIVERED", "RETURNED", "CANCELLED")
    protein_source_levels <- c("BEEF", "FISH", "CHICKEN", "VEGETARIAN")
    continent_levels <- c("AMERICA", "EUROPE", "ASIA")
    delivery_levels <- c("IN STORE", "TO LOCATION")
    paid_levels <- c("YES", "NO")
    data$DATE <- as.Date(data$DATE)
    data$PROTEIN_SOURCE <- 
    factor(data$PROTEIN_SOURCE, levels = protein_source_levels)

    data$CONTINENT <- factor(data$CONTINENT, levels = continent_levels)
    data$DELIVERY <- factor(data$DELIVERY, levels = delivery_levels)
    data$STATUS <- factor(data$STATUS, levels = status_levels)
    data$PAID <- factor(data$PAID, levels = paid_levels)
    return(data)
}

add_clients_metadata <- function(data) {
    gender_levels <- c("FEMALE", "MALE")
    star_levels <- c("1", "2", "3", "4", "5")
    data$BIRTH_DATE <- as.Date(data$BIRTH_DATE)
    data$CLIENT_SINCE <- as.Date(data$CLIENT_SINCE)
    data$GENDER <- factor(data$GENDER, levels = gender_levels)
    data$STARS <- factor(data$STARS, levels = star_levels)
    return(data)
}

add_client_messages_metadata <- function(data) {
    star_levels <- c("1", "2", "3", "4", "5")
    data$DATE <- as.Date(data$DATE)
    data$STARS <- factor(data$STARS, levels = star_levels)
    return(data)
}

现在我们可以看到sales和sales_from_db都包含相同的元数据。再次强调，我们不显示输出以节省空间，但你将看到，当从 MySQL 服务器读取时，因子元数据现在被保留：

sales_from_db <- read_table(db, "sales")
str(sales)
str(sales_from_db)

由于它们具有相同的数据和元数据，现在在需要处理这些数据时，我们可以安全地从 MySQL 服务器完全读取数据。只需记住，使用read_table()函数而不是dbReadTable()函数。

使用dbReadTable()从 MySQL 服务器读取整个表只有在表不是太大时才是实用的。如果你在一个实际的问题中处理数据库，这通常不是情况。如果你试图读取的数据太大，请使用dbSendQuery()和fetch()函数的组合。

如果你想知道 MySQL 服务器将使用什么数据类型来存储你发送的数据，你可以使用带有MySQL()参数的dbDataType()函数，以及你想要找出服务器类型的那个数据类型：

dbDataType(MySQL(), "a")
#> [1] "text"
dbDataType(MySQL(), 1.5)
#> [1] "double"

最后，你可以使用dbListTables()和dbListFields()函数来找出数据库中可用的表和特定表可用的字段。如果你一直跟随这个例子，你应该会看到以下内容：

dbListTables(db)
#> [1] "client_messages" "clients" "sales"

dbListFields(db, "sales")
#>  [1] "row_names"      "SALE_ID"        "CLIENT_ID"      "DATE"
#>  [5] "QUANTITY"       "COST"           "PRICE"          "DISCOUNT"
#>  [9] "PROTEIN"        "CARBS"          "FAT"            "PROTEIN_SOURCE"
#> [13] "STORE"          "DELIVERY"       "STATUS"         "PAID"

dbListFields(db, "clients")
#> [1] "row_names"    "CLIENT_ID"    "BIRTH_DATE"    "CLIENT_SINCE" "GENDER"
#> [6] "STARS"

dbListFields(db, "client_messages")
#> [1] "row_names" "SALE_ID"   "DATE"      "STARS"     "SUMMARY"   "MESSAGE"

注意，你看到row.names字段是因为它是 MySQL 功能所必需的，但当你实际上从数据库读取数据时，你不会得到这个字段。你将得到所有其他显示的字段（大写字母中的那些）。

这些是使用 R 与 MySQL 服务器协同工作的基础知识。对于感兴趣的读者，一个展示了许多其他RMySQL功能的良好、简洁的资源是 Squared Academy 的*《RMySQL 入门教程，2016》幻灯片》（www.slideshare.net/RsquaredIn/rmysql-tutorial-for-beginners）。

摘要

在本章中，我们通过展示食品工厂的一般场景，建立了食品销售示例的基本原理：他们做什么，他们想要实现什么，最重要的是，如何模拟我们将在示例的其余部分所需的数据。我们探讨了模拟不同类型数据（如数字、类别、字符串和日期）的各种技术。我们展示的方法足够灵活，允许您以模块化和逐步的方式模拟许多不同类型的数据。我们还展示了如何通过使用参数对象来允许对模拟的不同假设的灵活性，以便轻松实现。我们学习了如何创建适用于不同场景的函数，以及如何将我们的模拟数据与来自外部来源的数据混合。最后，我们学习了如何与外部 MySQL 数据库协同工作。

我们已经准备好承担示例的分析部分。在下一章第五章，通过可视化沟通销售中，我们将使用我们刚刚模拟的数据来创建许多可视化，这将使我们能够了解食品工厂的当前状况以及其改进领域。

第五章：使用可视化进行销售沟通

在本章中，我们将探讨数据分析的一个重要且实用的方面，即数据可视化。我们将展示如何创建图函数，这些函数封装了创建图形的过程，并输出一个可以查看或保存到磁盘的图形对象。以这种方式处理图形可以提高效率，增加灵活性，并提供可重复的过程。

本章我们将创建的图形类型包括条形图、箱线图、带有边缘分布的散点图、雷达图、3D 交互式散点图、时间序列图、静态和交互式地图，以及一个酷炫的地球可视化。本章将展示您需要创建各种高质量图形的基础知识。

本章涵盖的一些重要主题如下：

• 高效使用图函数和图对象

• 使用重要的绘图包，如 ggplot2 和 leaflet

• 数据转换以适应不同的可视化

• 通过变量参数化进行图形泛化

• 使用颜色和形状增加显示的维度

• 使用自定义图形类型扩展 ggplot2

• 使用交互式图形进行数值数据探索

• 使用交互式地图进行地理数据探索

必需包

在本章中，我们将使用以下 R 包。如果您尚未安装它们，可以查阅附录，必需包，了解如何安装。这些包将分为两类：用于创建图形的包和用于处理数据的包。一些用于交互式图形（非静态图形，意味着您可以在屏幕上移动它们以查看数据的不同角度）的包将需要系统依赖项才能工作（例如，rgl 和 rgdal），而其他包将通过您的网络浏览器工作（例如，threejs、leaflet 和 plotly）。它们已使用 Google Chrome 作为网络浏览器进行测试。如果您遇到特定网络浏览器的任何问题，请尝试使用 Google Chrome。静态*图形将使用 ggplot2 和一些扩展它的包（例如，viridis 和 ggExtra）创建。

包	原因
ggplot2	高质量图形
viridis	图形颜色调色板
ggExtra	带边缘分布的图形
threejs	交互式地球仪
leaflet	交互式高质量地图
plotly	交互式高质量图形
rgl	交互式 3D 图形
rgdal	地理数据操作
tidyr	数据操作

使用盈利指标扩展我们的数据

如前所述，我们本章的目标是诊断当前的商业状况并寻找新的机会。首先，我们将从不同的角度查看三个业务指标。这些指标是销售数量、利润和利润率。它们告诉我们食品工厂在数量上卖出了多少，它赚了多少钱（利润），以及它的增长机会在哪里（利润率）。请记住，这并不是一个专业的财务评估，而且，一如既往，重点是编程技术而不是分析的实际结果。

我们需要做的第一件事是为每一笔销售添加其相应的利润和利润率。我们假设我们唯一能够计算利润的方式是如果销售订单已经交付并且已经付款。否则，我们将利润和利润率设为零。如果销售符合利润条件，那么利润的计算公式是利润 = 价格 - 成本 - 折扣。请注意，这允许销售不盈利（食品工厂亏损）的情况发生，如果成本 + 折扣 > 价格。如果有利润，那么利润率是利润 / 成本。我们刚才描述的内容是在add_profits()函数中编程实现的：

add_profits <- function(data) {
    unprofitable <- c("RETURNED", "CANCELLED", "PENDING")
    data$PROFIT <- data$PRICE - data$COST - data$DISCOUNT
    data$PROFIT[data$STATUS %in% unprofitable] <- 0
    data$PROFIT[data$PAID == "NO"] <- 0
    data$PROFIT_RATIO <- data$PROFIT / data$COST
    return(data)
}

在定义了add_profit()函数之后，我们只需将其应用到我们的销售数据上，如下所示：

sales <- add_profits(sales)

可重用高质量图表的构建块

为了诊断商业状况和寻找新的机会，在本章中，我们将使用各种类型的图表。当涉及到开发静态高质量图表时，使用ggplot2包是不会出错的。R 中的标准（内置）图表对于探索性目的来说很好，但与ggplot2图表相比，它们不够灵活或美观。由于我们想展示如何创建高质量图表，我们将专注于使用这个包（以及扩展它的其他包）来创建静态图表。然而，由于纯ggplot2包仅适用于静态图表，我们将使用其他包来创建高质量交互式图表。

当使用ggplot2时，拥有如此多的灵活性有一个缺点，那就是它非常冗长，因此需要大量的代码来创建图表（尤其是与标准 R 内置的绘图函数相比）。如果我们打算创建类似的图表，我们希望避免复制粘贴代码，因此我们将开发可重用的函数，我们可以使用这些函数轻松地创建类似的图表。例如，我们可以做如下操作，而不是重复超过 10 行的ggplot2代码来仅进行一些小的修改：

graph_1 <- a_function_that_returns_a_graph_object(
    data_1, other_parameters_1)
print(graph_1)

graph_2 <- a_function_that_returns_a_graph_object(
    data_2, other_parameters_2)
print(graph_2)

有时候，人们可能不习惯以这种方式工作，但这些绘图函数与其他任何类型的函数一样。唯一的区别是，只要可能，我们将返回一个图表对象而不是其他数据类型。这些图表对象在处理ggplot2时是一个很好的特性，因为它们不能传递给其他函数（并非所有绘图包都是这样设计的）。例如，在编写这本书时，我们使用了以下save_png()函数，它接受一个图表对象并将其保存到磁盘。我们只需要在保存时可选地更改图表的尺寸，以确保它是正确的尺寸：

save_png <- function(graph, save_to, width = 480, height = 480) {
    png(save_to, width = width, height = height)
    print(graph)
    dev.off()
}

如果您正在处理大量图表，如果在创建其中一个图表时遇到错误并打印它，您可能会看到您之前正在工作的一个图表而感到困惑。为了避免这种困惑，您可以在每次打印或保存函数调用后执行graph <- NULL，以确保可以明显地看到错误发生的位置。

现在如果您想创建一个图表并将其保存为 1024x768 像素的图像，您可以使用以下save_png()函数：

graph < a_function_that_returns_a_graph_object(data, parameters)
save_png(graph, 1024, 768)

开发分析数据的标准方式是一个与科学方法密切相关的迭代过程。然而，在本章中，我们只会关注生成图表的代码。我们将在第七章“开发自动演示”中解释结果。我们认为这有助于在相应的章节中充分关注每个主题。

从简单的条形图应用开始

我们将从简单的图表开始，逐步构建到高级图表。我们将创建的第一个图表是条形图。我们将绘制一个频率表，显示我们销售中每个QUANTITY数字的销售订单数量。为此，我们使用ggplot()函数，将sales作为数据，并使用aes()函数设置美学，其中QUANTITY位于x轴（第一个参数）。

在使用ggplot()函数创建图基础之后，我们为想要在图中显示的不同对象添加层（例如，条形、线条和点）。在这种情况下，我们使用geom_bar()函数添加条形。注意这个层是如何通过在图基础中使用+（加号）符号来添加的。之后，我们使用ggtitle()函数添加另一个标题层。最后，我们使用scale_x_continuous()函数添加一个x轴指定，这将允许我们看到图中每个条形的数字。如果你不添加这个层，你的图表可能不会显示每个条形的数字，这可能会有些令人困惑。我们指定它的方式是通过发送一个数字序列，这些数字应作为断点（显示刻度数据的位置）。由于数据中的数字可能因不同的模拟而变化，我们通过使用seq()函数从QUANTITY变量的最小值到最大值创建一个序列来确保我们使用正确的数字。这将自动显示正确的数字，即使QUANTITY变量的范围差异很大。

这些代码看起来可能很多，但构建一个简单的图表。然而，这正是允许我们非常具体地了解我们想要在图中看到的内容的代码量，正如你将在下面的示例中看到的那样。此外，请注意，实际上产生图表所需的只有ggplot()（及其相应的aes()函数）和geom_bar()函数。ggtitle()和scale_x_continuous()函数只是为了改进图表：

graph <- ggplot(sales, aes(QUANTITY)) +
    geom_bar() +
    ggtitle("QUANTITY Frequency") +
    scale_x_continuous(
        breaks = seq(min(sales[, "QUANTITY"]), 
        max(sales[, "QUANTITY"]))
    )

下面的图表显示了前面代码的QUANTITY 频率：

QUANTITY 频率

由于我们将创建大量的条形图，我们希望避免复制粘贴我们刚刚编写的代码，不仅如此，我们还希望使其更加灵活。为了实现这一点，我们将通过参数化我们的代码并考虑我们应该覆盖的不同场景来泛化我们的代码。

那么，我们可能希望我们的自定义graph_bars()函数允许我们做什么呢？首先，我们可能希望为我们的x轴和y轴指定不同的变量。为此，我们需要了解geom_bar()函数的内部工作方式。如果你回顾一下代码，我们从未指定y轴的变量，ggplot()自动使用了QUANTITY数字在数据中出现的次数（频率）。

如果我们想使用每次销售的PROFIT值作为y轴的变量呢？在这种情况下，我们需要意识到，当QUANTITY为二或三时，我们可能有超过 2,000 个不同的PROFIT值，而在其他情况下则较少。在我们能够在y轴中使用PROFIT之前，我们需要以某种方式对这些PROFIT值进行聚合。

任何可以将PROFIT值减少为所有交易的单个值的函数，对于每个QUANTITY值，都可以用来聚合数据。然而，最常见的选择是使用平均值或总和。平均值将显示一个图表，我们可以看到每个QUANTITY值的平均PROFIT。总和将显示每个QUANTITY值的总PROFIT。如果我们想在y轴上使用PROFIT_RATIO（或任何其他数值变量），这也适用。最直观的选择是对于PROFIT（总利润）使用总和，对于PROFIT_RATIO（平均利润比率）使用平均值，因此我们将使用这些。

对于x轴，我们可能拥有分类、数值或日期变量。对于这个特定的情况，默认的x轴选项对于分类和日期变量来说是合适的，但当我们处理数值变量时，我们仍然希望看到所有数字在刻度上。这意味着我们需要在x轴上提供对变量类型的检查，如果它是数值型，那么我们需要进行适当的调整（与之前代码中看到的相同调整）。

我们之前所解释的内容就是我们在graph_bars()函数中编程的内容。该函数接收数据和x轴以及y轴变量作为参数。首先，它会检查我们是否指定了特定的y轴变量。我们使用第一章中提到的“NULL 检查”技术，即《R 语言入门》。如果我们没有接收到y轴变量，那么我们将创建一个条形图，就像我们之前做的那样（默认使用x轴变量的频率），并且使用paste()函数创建相应的标题。如果我们确实得到了y轴的变量（意味着我们处于else块中），那么我们需要找出我们需要进行哪种类型的聚合，我们通过使用我们的get_aggregation()函数来完成，如果要求我们在y轴上绘制PROFIT变量，该函数将返回求和作为聚合方法，而在任何其他情况下返回平均值。然后我们使用这个函数名作为fun.y参数的值（它被读作y的函数），并指定我们正在使用一个汇总函数（当你不需要对变量进行聚合时，你应该将stat = 'identity'参数发送到geom_bar()函数，并避免将其发送到fun.y参数）。然后我们根据需要指定图表的标题。在if else块之后，我们检查x轴的变量类型是否为数值型，如果是，我们应用区间名称转换：

graph_bars <- function(data, x, y = NULL) {
    if (is.null(y)) {
        graph <- ggplot(data, aes_string(x)) +
            geom_bar() +
            ggtitle(paste(x, "Frequency")) +
            ylab("Frequency")
    } else {
        aggregation <- get_aggregation(y)
            graph <- ggplot(data, aes_string(x, y)) +
            geom_bar(fun.y = aggregation, stat = "summary") + 
            ggtitle(paste(y, "by", x))
   }
   if (class(data[, x]) == "numeric") {
        graph <- graph +
            scale_x_continuous(
                breaks = seq(min(data[, x]), max(data[, x])))
   }
   return(graph)
}

当使用这个特殊情况的函数时，我们建议你将特殊情况放在检查的if部分，以确保你只捕获我们正在寻找的特殊情况，否则返回通用情况。如果你反过来这样做（首先检查通用情况），你无疑会遇到一些棘手的错误：

get_aggregation <- function(y) {
    if (y == "PROFIT") {
        return("sum")
    }
    return("mean")
}

现在我们可以使用我们的自定义graph_bars()函数创建更多的条形图：

graph_bars(sales, "CONTINENT")
graph_bars(sales, "CONTINENT", "PROFIT")
graph_bars(sales, "CONTINENT", "PROFIT_RATIO")

graph_bars(sales, "PROTEIN_SOURCE")
graph_bars(sales, "PROTEIN_SOURCE", "PROFIT")
graph_bars(sales, "PROTEIN_SOURCE", "PROFIT_RATIO")

所有的以下图表都一起显示，以便更容易可视化并节省空间，但您在执行代码时将逐个获得它们。

条形图

使用颜色添加第三个维度

如常发生的情况，我们想要在已经创建的代码上添加更多功能。在这种情况下，我们想要使用颜色为图表添加第三个维度。我们希望能够指定一个 color 变量，该变量将用于进一步划分图表中的数据。

为了实现这一点，我们使用“空值检查”模式在函数签名中添加一个 color 参数，并在每个情况中添加相应的参数。在 aes_string() 函数中直接添加参数在 NULL 的情况下没有问题，因为 NULL 值表示我们不想为图表使用填充颜色。

然而，请注意，我们无法使用相同的技巧与 y 一起使用。相反，我们检查是否应该发送 y 或不发送，并且只有当有非 NULL 值时才将其发送到 ggplot() 函数。我们还向 geom_bar() 函数添加了 position = "dodge" 参数，以便得到非堆叠条形图。如果我们不发送此参数，我们会得到堆叠条形图，对于这些特定的图表，我们认为非堆叠版本看起来更好。您可以自由尝试堆叠版本。让我们看看以下代码：

graph_bars <- function(data, x, y = NULL, color = NULL) {
    if (is.null(y)) {
        graph <- ggplot(data, aes_string(x, fill = color)) +
            geom_bar(position = "dodge") +
            ggtitle(paste(x, "Frequency")) +
            ylab("Frequency")
    } else {
        aggregation <- get_aggregation(y)
        graph <- ggplot(data, aes_string(x, y, fill = color)) +
                 geom_bar(
                     fun.y = aggregation, 
                     stat = "summary", position = "dodge") +
                     ggtitle(paste(y, "by", x)
                 )
    }
    if (class(data[, x]) == "numeric") {
        graph <- graph +
            scale_x_continuous(
                breaks = seq(min(data[, x]), 
                max(data[, x]))
            )
    }
    return(graph)
}

注意，现在我们有四种可能想要绘制的不同情况，首先，当只指定 x 值时，其次，当我们指定 x 和 y 值时，第三，当我们指定 x 和 color 值时，第四，当我们指定所有三个值时。由于每个情况的 ggplot() 规范都是唯一的，我们不能将它们合并成更少的案例。您还应该注意，我们只在条件块中保留特定检查的特定代码，并将不特定于检查且每次应应用于两个情况的代码移出条件块。这就是我们在外层 if 块中使用 ylab() 和 geom_bar() 函数，在外层 else 块中使用 get_aggregation() 和 geom_bar() 函数所做的事情。否则，我们会不必要地重复代码，这是一种非常不好的做法。

带颜色的条形图

现在我们可以生成可选接收第三个参数 color（如上图所示）的条形图，如果发送了该参数，它将用于使用颜色划分数据。请注意，在以下代码的第一行中，我们需要显式发送 color 参数。这是因为我们在函数调用中省略了 y 参数，如果我们对 color 参数不明确，它将被解释为 x 参数。您可以在 第一章，R 语言入门 中复习函数调用：

graph_bars(sales, "QUANTITY", color = "PROTEIN_SOURCE")
graph_bars(sales, "CONTINENT", "PROFIT", "PROTEIN_SOURCE")
graph_bars(sales, "CONTINENT", "PROFIT_RATIO", "PROTEIN_SOURCE")

使用条形图绘制顶尖表现者

条形图是世界上使用最广泛的绘图工具之一，本章也不例外。在我们最后的条形图示例中，我们将展示如何按降序排列给定变量的表现最好的几个。我们的目标是绘制y轴上的PROFIT或Frequency，以及x轴上的参数化变量。我们希望从左到右按降序显示x变量的前n个表现最好的，如下面的图表所示。

前n个条形图

为了实现这一点，我们接收数据（在这种情况下是sales）、用于x轴的变量x、我们想要显示的表现最好的数量n，以及我们是否想在y轴上使用PROFIT（在这种情况下我们将使用Frequency），通过使用布尔值by_profit。

我们首先检查by_profit参数；如果它是TRUE，那么我们使用aggregate()函数和sum运算符对每个CLIENT_ID的PROFIT数据进行聚合（我们想要的是按客户计算的总利润，而不是按客户计算的平均利润）。然后我们使用order()函数对结果进行排序。在profit_by_client$x值之前的一横线（-）表示我们想要降序排列，而跟在profit_by_client之后的x是因为aggregate()函数的结果是一个包含Group.1和x列的数据框，分别存储CLIENT_ID和PROFIT的总和。

由于我们希望在返回我们想要的图时避免代码的不必要重复，我们需要确保if else块中的两种情况都使用我们在ggplot()函数中将使用的相同变量名。这就是为什么我们明确地将x和y_bar名称分配给top_df数据框。如果你在执行过程中查看top_df对象，你会发现在不同的列名下有重复的数据。我们可以通过删除我们不想要的列来解决这个问题，但在这个点上这是不必要的，因为这个对象无论如何都是一次性使用的。然而，在某些情况下，这可能会成为一个我们需要处理的性能问题，但在这个例子中不是。

在else块的情况下，从概念上讲，我们做的是同样的事情。然而，在技术上我们实现的方式不同。在这种情况下，我们创建一个表，其中表中的每个条目都是一个唯一的CLIENT_ID值，每个条目的值是该CLIENT_ID在数据中出现的次数（Frequency），我们使用table()函数来完成这个操作。然后我们使用sort()函数按降序对这些结果进行排序，并取前n个结果。然后我们使用这些结果创建一个包含相应列的top_df数据框。请注意，我们需要一个辅助名称aux_name来为x变量命名，因为我们不能通过指定变量名来创建数据框。我们接下来要做的是将aux_name列中的数据复制到我们实际需要的名称中（包含在x变量中）。

最后，我们创建一个图表并立即返回，而不进行中间存储。到这一点，你应该已经清楚代码中每一行在该部分的作用，所以我们不会再次解释。

现在你可以使用以下代码轻松创建top n图表。我们建议你尝试为其他分类变量（例如，CONTINENT或PROTEIN_SOURCE）创建类似的图表。请注意，每种情况下的CLIENT_ID值都不同，这意味着从食品工厂购买最多产品的客户不一定是为其创造最多利润的客户：

graph_top_n_bars(sales, "CLIENT_ID", 10)
graph_top_n_bars(sales, "CLIENT_ID", 10, TRUE)

我们希望在接下来的章节中使事情复杂化之前，先从简单开始，展示使用图形函数的基本概念。

使用箱线图绘制分解数据

创建条形图在向不熟悉统计学的观众展示结果时很有用，但条形图汇总信息的事实（就像我们在表现最佳者条形图中做的那样）意味着实际上，由于汇总，我们失去了信息。如果你与理解四分位数是什么的人一起工作，那么箱线图可能是一种有用的可视化方式。它们是查看不同变量水平上个体分布的简单方法。

每个箱子代表底部的第一四分位数，顶部的第三四分位数，以及中间线上的中位数。垂直延伸的线延伸到任何在1.5 * IQR范围内的观测值，其中四分位距（IQR）是第一四分位数和第三四分位数之间的距离。任何超过1.5 * IQR的观测值被视为异常值，并单独显示。

我们的目的是以分解的方式展示我们根据PROFIT创建的针对表现最佳者的条形图。当使用条形图时，困难在于正确汇总数据，但由于我们不需要为箱线图汇总数据，它们的创建非常简单。

我们的graph_top_n_boxplots()函数接受data值、x 轴和 y 轴的变量、要显示的顶级表现者的数量n作为参数，以及可选的线条和填充颜色，分别用c和f表示。如果没有指定颜色，则使用一系列蓝色。颜色指定必须使用十六进制表示法（en.wikipedia.org/wiki/Web_colors#Hex_triplet）或 R 颜色名称（sape.inf.usi.ch/quick-reference/ggplot2/colour）。我们简单地使用我们的filter_n_top()函数过滤数据，并使用boxplot()层以适当的颜色生成箱线图。我们还指定标题为函数接收到的参数的组合：

graph_top_n_boxplots <- 
    function(data, x, y, n, f = "#2196F3", c = "#0D47A1") {
    data <- filter_n_top(sales, n, x)
    return(
        ggplot(data, aes_string(x, y)) +
        geom_boxplot(fill = f, color = c) +
        ggtitle(paste(y, "by", x, "( Top", n, ")"))
    )
}

filter_n_top()函数接收参数为data值，我们想要保留的顶级表现者的数量为n，以及表现者的标识符为by。首先，我们使用aggregate()函数根据选择的标识符（作为列表发送，这是函数所要求的）对PROFIT变量进行聚合，并使用sum运算符进行聚合以获取每个客户的总PROFIT。如果我们使用了mean运算符，我们会看到一个每个客户的平均PROFIT的图形。然后我们按降序对结果进行排序，这些结果包含在aggr对象的第二列中，并从第一列中取出顶部n个值，这些值包含标识符（下面的例子中的CLIENT_ID值）。最后，我们只保留与top对象中顶级标识符对应的数据观测值。

filter_n_top <- function(data, n, by) {
    aggr <- aggregate(data$PROFIT, list(data[, by]), sum)
    top <- aggr[order(-aggr[, 2])[1:n], 1]
    data <- data[data[, by] %in% top, ]
    return(data)
}

现在我们可以轻松地复制上一节中创建的条形图，使用箱线图。

顶部 m 个箱线图

如您所见，我们在图中显示了更多信息，但失去了轻松找到每个CLIENT_ID的总PROFIT值的可能性。选择图形类型取决于您试图传达的信息：

graph_top_n_boxplots(sales, "CLIENT_ID", "PROFIT", 10)

带有联合和边缘分布的散点图

我们在前面章节中已经看到了如何使用ggplot()创建散点图。因此，在本节中，我们将只关注我们之前没有看到的部分。我们的目标是创建不仅显示散点图，而且还通过在两个轴上显示边缘分布来扩展它。这些被称为边缘图，对于理解数据如何联合（两个变量）以及边缘（一个变量）分布非常有用。

按蛋白质来源和大陆定价和盈利能力

如同往常，我们开始开发我们的绘图函数。我们接收参数为data，以及用于x轴（x）和y轴（y）的变量，以及在这种情况下，我们预计四种情况，对应于包括或不包括color和shape变量组合的图形。我们进行标准的检查并创建相应的图形基础。接下来是不同的部分，我们调用ggExtra包中的ggMarginal()函数，使用我们想要的图形对象（在这种情况下，基础图形加上点层），并指定用于边缘分布的图形类型。您可以选择density、histogram和boxplot。我们选择histogram：

graph_marginal_distributions <- 
function(data, x, y, color = NULL, shape = NULL) {
    if (is.null(color)) {
        if (is.null(shape)) {
            graph <- ggplot(data, aes_string(x, y))
        } else {
            graph <- ggplot(data, aes_string(x, y, shape = shape))
        }
    } else {
        if (is.null(shape)) {
            graph <- ggplot(data, aes_string(x, y, color = color))
        } else {
            graph <- ggplot(data, aes_string(x, y, 
                            color = color, 
                            shape = shape))
        }
    }
    return(ggMarginal(graph + geom_point(), type = "histogram"))
}

现在我们能够轻松地创建带有边缘分布的散点图。在第一个图形（左侧），我们展示了PRICE、COST、PROTEIN_SOURCE和CONTINENT之间的关系。

边缘分布

注意，有一些非常明显的群体。在第二个图表（右侧）中，我们展示了PRICE、PROFIT_RATIO、PROTEIN_SOURCE和CONTINENT之间的关系。注意，我们发现与我们在 3D 交互散点图中发现的关系相同，即PRICE值越高，PROFIT_RATIO值越高。然而，这里有两个有趣的发现，我们将在第七章“开发自动演示”中提及。你能说出它们是什么吗？

graph_marginal_distributions(sales, 
       "COST", "PRICE", "PROTEIN_SOURCE", "CONTINENT")

如果你使用graph_marginal_distributions()函数来绘制COST、PRICE、STATUS和PAID的组合图，你应该看不到任何模式出现，因为这些分布是在第四章“模拟销售数据和与数据库协同工作”中随机模拟成正态分布的，并且没有对这些分布应用任何偏斜过程。

客户的出生日期、性别和评分

在编程过程中，你可能会遇到的一个问题是，有时你认为足够通用的函数需要以某种方式做出改变。有时，正确的决定是修改现有的函数，但其他时候，正确的决定是创建一个新的函数（可能基于原始函数），这样可以根据需要修改，而不会破坏使用它的旧代码。这种情况发生在函数的假设没有得到满足，并且无法轻易适应时。

在我们的案例中，如果我们想使用clients数据来绘制客户的出生日期图，使用x轴上的年份、y轴上的月份、按性别着色，并通过调整点的尺寸来显示评分，会发生什么？好吧，x轴和y轴的数据假设可能通过轻微的数据转换就能满足，颜色假设已经满足，但大小假设似乎不符合我们之前的模型。

在我们的graph_marginal_distributions()函数中，我们假设我们会使用shape作为第四个变量来表示分类变量，但似乎尽管STARS变量在技术上是一个因素，但使用大小而不是不同的形状来表示会更好。我们需要在clients数据的特殊情况中处理x轴、y轴和大小假设的事实，这足以决定基于原始函数创建它自己的函数。如果我们想在某个时候将这两个函数合并成一个，我们可以这样做，但在这个阶段没有必要让自己过于复杂化。

在我们的 graph_marginal_distributions_client_birth_dates() 函数中，我们只需要接收我们将要处理的数据（在这种情况下是 clients）。在这种情况下不需要其他参数，因为所有假设都将硬编码在函数内部，因为我们不打算使代码通用化。为了使代码更易于阅读，我们将使用短变量名来包含我们将用于创建图表规范的字符串。这就是那些 x、y、x_noise 和 y_noise 变量的作用。

如前所述，在我们能够生成图表之前，我们需要稍微转换一下数据。首先，我们需要将 BIRTH_DATE 分解为 BD_YEAR 和 BD_MONTH（BD 是出生日期的缩写）。然后我们向日期添加噪声，因为如果我们只是保持日期不变，我们会得到一个值网格，而不是一个分布，这是因为年份和月份都是整数值，所以会有很多点堆叠在一起，它们之间会有很多空隙。我们可以看到数据的混合版本，这就是为什么我们需要向其中添加噪声。下面我们可以看到这两个函数是如何在内部工作的。

在我们有了简短的名字并转换了数据之后，我们就准备好创建散点图了，就像我们之前做的那样。这里就是有噪声和无噪声日期之间的区别开始发挥作用的地方。如果我们使用带噪声的日期来显示轴的刻度值，我们会看到像 1953.51、1973.85、1993.23 等年份标签。显然，用这样的值显示年份轴并不直观。同样，对于 y 轴，我们会看到像 1.24、4.09、8.53 等月份值。同样的问题。这就是为什么我们需要两种数据版本的原因，一种是有噪声的（实值），用于在图中放置点，另一种是无噪声的（整数值），用于在轴上显示值。最后，我们添加轴标签，并将图表通过 ggMarginal() 函数发送出去，就像我们之前做的那样：

graph_marginal_distributions_client_birth_dates <- function(data) {
    x <- "BD_YEAR"
    y <- "BD_MONTH"
    x_noise <- "BD_YEAR_NOISE"
    y_noise <- "BD_MONTH_NOISE"
    data <- disaggregate_dates(data)
    data <- add_dates_noise(data)
    graph <- ggplot(data, aes_string(x_noise, 
                                     y_noise,
                                     size = "STARS",
                                     color = "GENDER")) +
        scale_x_continuous(breaks = seq(min(data[, x]),
                                    max(data[, x]), by = 5)) +
        scale_y_continuous(breaks = seq(min(data[, y]),  
                                    max(data[, y]))) +
                                    geom_point() +
                                    ylab("MONTH") +
                                    xlab("YEAR")
    return(ggMarginal(graph, type = "histogram"))
}
disaggregate_dates <- function(data) {
    data$BD_YEAR <- as.numeric(format(data$BIRTH_DATE, "%Y"))
    data$BD_MONTH <- as.numeric(format(data$BIRTH_DATE, "%m"))
    return(data)
}

向数据中添加噪声很简单，我们只需创建新的变量（BD_YEAR_NOISE 和 BD_MONTH_NOISE），它们具有原始的（整数）值，然后我们添加一个均值为 0、标准差为 0.5 的正态分布的随机数。我们需要一个小的标准差来确保我们的数据不会改变太多：

add_dates_noise <- function(data) {
    year_noise <- rnorm(nrow(data), sd = 0.5)
    month_noise <- rnorm(nrow(data), sd = 0.5)
    data$BD_YEAR_NOISE <- data$BD_YEAR + year_noise
    data$BD_MONTH_NOISE <- data$BD_MONTH + month_noise
    return(data)
}

为了分解日期，我们只需创建新的变量（BD_YEAR 和 BD_MONTH），它们包含使用 R 中的日期格式说明符提取的相应日期值（%Y 用于年份和 %m 用于数字月份），并将其转换为数字（这样我们就可以向它们添加噪声并绘制它们）。有关日期格式说明符的更多信息，请参阅加州大学伯克利分校的 R 中的日期和时间 页面 (www.stat.berkeley.edu/~s133/dates.html)。

让我们借助图表来看看客户的出生日期：

客户出生日期与边缘分布

现在，我们可以轻松地随时创建此图表，而无需担心如何创建它的细节，以下代码即可：

graph_marginal_distributions_client_birth_dates(clients)

开发我们自己的图表类型——雷达图

本节将把我们的图形函数提升到新的水平，因为我们将在本节中开发自己的自定义图表类型。ggplot2包默认没有提供生成雷达图的方法，所以我们将在这个部分中自己开发它。有一些包通过雷达图功能扩展了ggplot2（例如，ggradar），但我们将展示如何从头开始创建它。阅读本节后，你将能够自己开发复杂的图表。

雷达图是在圆形画布上绘制的，可以同时显示许多变量的值。它们形成一种雷达状的形状，如果你想要比较不同实体之间的变量值，它们非常有用。有时，它们被用来直观地了解实体之间相似或不同的程度。如果你不熟悉这种图表类型，以下图片中有一个示例。在我们的例子中，我们将测量食品工厂前五名客户的三个不同宏量营养素，而不是像这个例子那样测量速度、耐用性、舒适性、动力和空间。

graph_radar()函数接收data数据框作为参数，以及我们想要显示雷达图的变量（在我们的例子中是CLIENT_ID）。首先，它使用gather()函数将我们需要的数据从宽格式转换为长格式。然后，它创建将在每个雷达图顶部使用的标签，显示每个CLIENT_ID产生的利润。最后，它返回一个图形对象，该对象通过指定宏量营养素和百分比，添加一个按CLIENT_ID分组的折线图层、颜色和填充，并调整alpha(透明度)和线宽来使其看起来更好。

facet_wrap()函数用于对数据中每个by变量（在我们的例子中是CLIENT_ID）的实例重复相同的绘图。由于它需要一个公式，并且我们希望将其用法通用化，所以我们使用as.formula()和paste()函数的组合。要回忆这些函数是如何工作的，请参阅第三章，“使用线性模型预测投票”。我们还传递了nrow = 1参数，以确保我们得到一个单独的图表行。我们使用guides()函数通过发送"none"字符串到相应的图例来移除任何图例信息，应用我们的coord_radar()函数（下面会详细介绍），并移除轴标签：

graph_radar <- function(data, by) {
    data <- tidyr::gather(
                   data, MACRO, PERCENTAGE, 
                   PROTEIN:FAT, factor_key = TRUE)
    data$CLIENT_ID <- paste(
        data$CLIENT_ID, " ($", data$PROFIT, ")", sep = ""
    )
    return(
        ggplot(data, aes(MACRO, PERCENTAGE)) +
        geom_polygon(
            aes_string(group = by, color = by, fill = by),
            alpha = 0.4,
            size = 2
        ) +
       facet_wrap(as.formula(paste("~", by)), nrow = 1) +
       guides(color = "none", fill = "none") +
       coord_radar() +
       xlab("") +
       ylab("")
   )
}

coord_radar()函数不是ggplot2包中的内置函数，我们需要自己编程实现它。我们将使用的是在互联网上找到的coord_radar()的一个略微修改过的版本，最初归功于 Hadley Wickham。它利用ggproto()函数继承并修改ggplot2中的极坐标层，该层接收参数theta（角度）、r（半径）、start（起始点）、direction（是否使用正或负单位）以及一个用于返回由is_linear参数所需的函数的 hack，这样其值总是TRUE。如果我们没有发送这个最后的 hack，我们就会得到圆形形状，就像我们在尝试绘制直线时使用极坐标所做的那样。前面的代码只是简单地选择适当的轴来表示角度，以便我们得到雷达形状：

coord_radar <- function(theta = "x", start = 0, direction = 1) {
    if (theta == "x") {
        r <- "y"
    } else {
        r <- "x"
    }
    return(ggproto(
        "CordRadar", 
        CoordPolar, 
        theta = theta, 
        r = r, 
        start = start, 
        direction = sign(direction),
        is_linear = function(coord) { return(TRUE) }
    ))
}

ggproto()函数在ggplot2包内用作一个内部对象系统，并且是为了在实现分层对象时避免对代码库进行太多修改而开发的。除非绝对必要，否则不建议您使用它。有关对象系统的更多信息，请参阅第八章，面向对象系统用于跟踪加密货币。

现在我们已经准备好了我们的图形函数，我们需要确保我们的数据格式正确。为此，我们创建了一个filter_data()函数来过滤数据并生成预期的结构。该函数接收我们将使用的data、从当前日期回溯要保留的天数作为n_days、我们将显示的顶尖表现者的数量作为n_top以及我们将聚合的变量作为aggregate_by。

首先，我们将数据过滤回n天前，然后仅保留根据aggregate_by变量排序的n_top表现者的观察结果。在这样做的同时，我们相应地更新data。然后，我们两次聚合数据，一次按PROFIT，另一次按宏量营养素（PROTEIN、CARBS和FAT），并将CLIENT_ID名称返回到数据框中。这样做会产生两个数据框，aggr_profit和aggr_macros，其中每个数据框分别对其各自的变量进行聚合，针对每个唯一的CLIENT_ID。请注意，我们将此过程分为两个独立的部分，因为我们想用mean来聚合PROTEIN、CARBS和FAT，以得到每个CLIENT_ID的平均偏好，但与此同时，我们还想用sum来聚合PROFIT，以得到每个CLIENT_ID的总利润（而不是平均利润）。

最后，我们使用merge()函数将数据与我们的aggregate_by变量合并，使其成为数据框中数据连接的索引，删除数据框中的残留列，并按PROFIT排序：

filter_data <- function(data, n_days, n_top, aggregate_by, static = TRUE) {
    data <- filter_n_days_back(data, n_days)
    data <- filter_n_top(data, n_top, aggregate_by)
    if (static) {
        aggr_profit <- aggregate(
            data[, c("PROFIT", "PROFIT_RATIO")],
            list(data[, aggregate_by]),
            sum
        )
        aggr_profit$CLIENT_ID <- aggr_profit$Group.1
        aggr_macros <- aggregate(
            data[, c("PROTEIN", "CARBS", "FAT")],
            list(data[, aggregate_by]),
            mean
        )
        aggr_macros$CLIENT_ID <- aggr_macros$Group.1
        data <- merge(aggr_profit, aggr_macros, by = aggregate_by)
        drop_columns <- c("Group.1.x", "Group.1.y", "PROFIT_RATIO")
        data <- data[, !(names(data) %in% drop_columns)]
        data <- data[order(-data$PROFIT), ]
    }
    return(data)
}

如果你仔细阅读代码，你可能已经注意到了我们没有提到的细节，那就是即使在函数后面没有使用它，我们也使用了 PROFIT_RATIO 变量进行聚合。将 PROFIT_RATIO 包含在 aggregate() 计算中的原因是它产生的副作用。当在 aggregate() 函数的数据中指定两个或更多变量时，结果会返回带有实际数据帧列名的结果数据帧 aggr_profit。如果我们只指定 PROFIT 本身，结果将有一个名为 x 的列而不是 PROFIT，正如我们在本章前面的代码中看到和使用的。这是一个避免处理变量名更改的简单方法。在我看来，aggregate() 函数应该始终返回原始数据帧名称，但它并不这样做，因此我们必须找到解决方案。记住在为他人编程时要考虑这种可用性。

要了解我们实际上是如何过滤日期的，我们可以查看 filter_n_days_back() 函数内部。正如你所看到的，我们接收作为参数的 data 我们想要过滤的数据和我们要保留的向后天数 n。如果 n 是 NULL，意味着用户不想向后过滤数据，那么我们就简单地返回我们得到相同的 data。如果你在 n 中收到一个数字，那么我们就用 Sys.Date() - n 从当前日期中减去 n 天。这个简单的减法操作自动以天为单位完成，这要归功于一种称为 操作符重载 的技术。我们将在 第八章 中查看它是如何工作的，面向对象的系统用于跟踪加密货币。最后，我们只保留至少是 n_days_back 日期的日期（这是另一种使用 操作符重载 技术的用法，它允许我们比较日期）。filter_n_top() 函数是我们之前为箱线图代码创建的：

filter_n_days_back <- function(data, n) {
    if (is.null(n)) {
        return(data)
    }
    n_days_back <- Sys.Date() - n
    return(data[data[, "DATE"] >= n_days_back, ])
}

我们的 filter_data() 函数本身非常有用。例如，我们可以通过执行以下命令轻松地显示过去 30 天内前 5 个客户的平均宏量营养素：

filter_data(sales, 30, 5, "CLIENT_ID")
#>    CLIENT_ID PROFIT   PROTEIN     CARBS       FAT
#> 2 BAWHQ69720 74.298 0.3855850 0.3050690 0.3093460
#> 3 CFWSY56410 73.378 0.4732115 0.3460788 0.1807097
#> 4 CQNQB52245 61.468 0.1544217 0.3274938 0.5180846
#> 1 AHTSR81362 58.252 0.3301151 0.3326516 0.3372332
#> 5 VJAQG30905 53.104 0.2056474 0.5909554 0.2033972

在创建了相应的图形函数的投资之后，我们现在能够轻松地生成我们自己的雷达图。例如，我们可以通过以下方式轻松地生成我们之前展示的数据的相应雷达图：

graph_radar(filter_data(sales, 30, 5, "CLIENT_ID"), "CLIENT_ID")

下面的图像展示了前面的命令：

客户的宏量营养素平均雷达图

使用交互式 3D 散点图进行探索

在探索数据时，有时查看 3D 散点图很有用。然而，如果散点图是固定的（意味着你不能移动它），可能不容易解释。在这些情况下，有一个交互式图表（你可以移动它）来查看数据的不同角度非常有用。这些图表通常不会进入静态报告，因为它们固定时很难正确解释，但它们在数据探索中非常有用。幸运的是，它们也用rgl包中的plot3d()函数非常容易创建：

library(rgl)
plot3d(sales$PROTEIN, sales$CARBS, sales$FAT)
plot3d(sales$PROFIT_RATIO, sales$PRICE, sales$QUANTITY)

一旦你在电脑上创建了这些图表，记得用鼠标移动它们！第一次这样做时，感觉非常神奇。在这种情况下，你可以看到在sales数据中发生的两个现象。首先，宏量营养素百分比必须加起来等于一，由于有三个，所以在左边的图表中你会看到一个三角形形状，这样每个点在其中的坐标之和等于一。其次，右边的图表显示了PRICE、QUANTITY和PROFIT_RATIO之间的关系。它显示我们的销售数据中没有分数量（正如我们设计的那样），有很多订单的PROFIT_RATIO为零，因为它们没有完成或付款，而且PRICE越高，PROFIT_RATIO也越高。

关于这些图表没有太多要解释的。它们创建简单，目的简单，有时非常有用，但你通常不会在书面报告中看到它们。

通过时间序列查看动态数据

现在我们将关注另一种非常常见的图表类型：时间序列图。我们的目标是了解过去n天内我们的数据是如何表现的，并且，就像我们之前所做的那样，我们希望通过颜色进一步细分，如下面的图表所示：

如果你已经阅读了到目前为止的整章内容，你应该能够理解函数的大部分功能。唯一的新函数是scale_x_date()。它允许我们指定除了默认之外的其他轴刻度日期格式。在这种情况下，我们想要使用按天划分的间隔（就像我们在之前的某些示例中所做的那样），但我们希望标签的格式类似于2017 年 7 月 30 日，例如。为此，我们利用本章前面提到的日期格式，并将所需的字符串结构发送到date_labels参数：

graph_last_n_days <- function(data, n, y = NULL, color = NULL) {
    subset <- filter_n_days_back(data, n)
    days_range <- paste("(last ", n, " days)", sep = "")
    date_sequence <- seq(min(subset[, "DATE"]), 
                         max(subset[, "DATE"]), by = "day")
    if (is.null(y)) {
        graph <- 
            ggplot(subset, aes_string(x = "DATE", color = color)) +
            ggtitle(paste("Frequency", days_range))+
            geom_point(stat = "count", size = 3) +
            geom_line(stat = "count", size = 1)
    } else {
        aggregation <- get_aggregation(y)
        graph <- ggplot(subset, aes_string(
                            x = "DATE", 
                            y = y, 
                            color = color)) +
            ggtitle(paste(y, days_range)) +
            geom_point(
                fun.y = aggregation, 
                stat = "summary", size = 3) +
            geom_line(
                fun.y = aggregation, 
                 stat = "summary", size = 1)
    }
    graph <- graph +
        ylab(y) +
        scale_x_date(
        breaks = date_sequence,
        date_labels = "%B %d, %Y"
    )
    return(graph)
}

如果你想查看显示过去 30 天频率、PROFIT或PROFIT_RATIO的简单折线图，你可以使用以下代码。我们不展示这些图像以节省空间：

graph_last_n_days(sales, 30)
graph_last_n_days(sales, 30, "PROFIT")
graph_last_n_days(sales, 30, "PROFIT_RATIO")

要查看区分PROTEIN_SOURCE的频率、PROFIT和PROFIT_RATIO的折线图，你可以使用以下代码：

graph_last_n_days(sales, 30, color = "PROTEIN_SOURCE")
graph_last_n_days(sales, 30, "PROFIT", "PROTEIN_SOURCE")
graph_last_n_days(sales, 30, "PROFIT_RATIO", "PROTEIN_SOURCE")

你可以使用 graph_last_n_days() 函数与其他数据框一起使用。例如，绘制来自 client_messages 的过去 30 天的 STARS 评分，你需要简单地使用 as.numeric() 函数将分类变量 STARS 转换为数值变量，以避免类型不匹配的错误，然后调用该函数。

如果你没有指定使用颜色分解的变量，它将默认用黑色绘图：

aux <- client_messages
aux$STARS <- as.numeric(aux$STARS)
graph_last_n_days(aux, 30, "STARS")

使用静态地图查看地理数据

地图可以是获取地理数据背后直觉的非常有用的工具。在本节中，我们将使用 ggplot2 包生成地图。目标是展示我们客户的消息位置，他们购买相关的 PRICE，以及相应的 PROFIT_RATIO。这个例子将展示我们如何将 sales 和 client_messages 数据框中的数据连接起来。

我们的 graph_client_messages_static() 函数接收 client_messages 和 sales 数据框作为参数，并且这就是它所需要的，因为我们正在展示未过滤（完整）的数据集。首先，我们需要使用它们共有的标识符 SALE_ID 来合并我们的两个数据框。为此，我们使用 merge() 函数，并指定我们想要保留 x 数据框上的所有观测值，这是第一个数据框（client_messages），我们不想保留 y 数据框（sales）上的观测值，如果它们在第一个数据框中没有相应的标识符。这使我们能够仅保留与客户消息相关联的数据。然后我们使用 map_data() 函数（来自 ggplot2 包）生成地图地理数据，并过滤掉任何标记为 "Antarctica" 的区域。

要实际创建我们想要的图形，我们将使用两个主要图层。第一个是地理数据，它通过 geom_polygon() 函数添加，使用 world_map 数据，指定坐标和组（组定义国家），并使用一些深色来与我们的点形成对比。第二个图层是消息数据，它通过 geom_point() 函数添加，使用合并的 data 数据框，相应的坐标，并分别使用 PRICE 和 PROFIT_RATIO 添加颜色和大小。由于在这个例子中我们使用数值变量来指定颜色，我们将得到一个颜色渐变，而不是像之前例子中的离散颜色。最后，我们使用 scale_color_viridis() 函数指定实际的调色板，设置适当的轴标签，并使用 coord_fixed() 函数使坐标具有相等的单位。如果我们不使用这个最后一个函数，我们可能会得到变形的地图：

graph_client_messages_static <- function(client_messages, sales) {
    data <- merge(
                  client_messages, sales, 
                  "SALE_ID", all.x = TRUE, 
                  all.y = FALSE
                 )
    world_map <- filter(map_data("world"), region != "Antarctica")
    return(
        ggplot() +
        geom_polygon(
            data = world_map,
            aes(long, lat, group = group),
            color = "grey60",
            fill = "grey50"
        ) +
        geom_point(
            data = data,
            aes(LNG, LAT, color = PRICE, size = PROFIT_RATIO)
        ) +
        scale_color_viridis(option = "inferno") +
        ylab("Latitude") +
        xlab("Longitude") +
        coord_fixed()
    )
}

现在，我们可以使用以下函数调用创建我们的地图：

graph_client_messages_static(client_messages, sales)

这样做，结果如下图形：

当然，如果你想泛化这个函数，你可以将用于图形指定的某些变量参数化，就像我们在前面的例子中所做的那样。

使用交互式地图导航地理数据

我们可以通过交互式地图来导航地理数据，这些交互式地图将在以下章节中解释。

可以导航和放大查看的地图

在本节的最后，我们将创建可以导航的交互式地图。这是一个非常强大的工具，可以嵌入到你的 R 项目中，大大增加其价值和对你受众的影响。我们将使用 leaflet 包来开发这个地图。我们的目标是显示一个地图，上面有我们从客户那里收到的消息的位置，图标代表我们使用消息的 STARS 变量获得的评级类型，以及显示与每个消息对应的购买相关的 PROFIT 的工具提示。

我们的 graph_client_messages_interactive() 函数接收 client_messages 和 sales 数据框。与之前的地图一样，我们将显示所有数据而不加任何过滤器，所以这就是我们需要的参数。我们首先做的事情，就像我们之前做的那样，是将数据合并，以便我们只保留与消息相关联的观测值。然后我们向 data 数据框添加一个新变量，该变量包含 leaflet 将使用的图标规范。为此，我们使用 awesomeIcons() 函数（它是 leaflet 包的一部分），并指定用于指定图标、标记颜色和函数，我们希望我们的图标是白色的，并且它们应该来自 ion 图标库（ionicons.com/）。其他可用的图标库有 glyphicon（glyphicons.com/）和 fa（fontawesome，fontawesome.io/icons/）。你可以在参考网站上找到你需要的图标。最后，我们通过使用 addAwesomeMarkers() 函数创建标记来返回 leaflet 图表，该函数接收一个由 leaflet() 函数包装的 leaflet 对象，该对象围绕我们的 data，经度和纬度的公式，图标的公式以及标签的公式。可选地，我们用 addProviderTiles() 包装 leaflet 图表，以确保我们在网页浏览器中获取 瓦片（地理背景图像）。我们需要这样做，因为在撰写本文时，存在一个错误，在特定情况下不会显示地理数据（只有标记），我们希望避免这个问题，我们可以通过提到的技术轻松做到这一点：

graph_client_messages_interactive <- function(client_messages, sales) {
    data <- merge(
                  client_messages, 
                  sales, 
                  "SALE_ID", 
                  all.x = TRUE, 
                  all.y = FALSE)
    data$ICON <- awesomeIcons(
        markerColor = get_icon_color(data),
        icon = get_icon(data),
        iconColor = 'white',
        library = 'ion'
    )
    return(
        addProviderTiles(addAwesomeMarkers(
            leaflet(data),
           ~LNG, ~LAT,
           icon = ~ICON,
           label = ~paste("Profit:", PROFIT)
        ), providers$OpenStreetMap)
    )
}

现在，我们将解释指定图标和标记颜色的函数。get_icon_color() 函数将接收我们的 data 数据框，并返回一个包含字符串的向量，这些字符串是 "green" 或 "red"，这取决于相关的 STARS 是否高于或等于 4，或者不是。我们使用 sapply() 函数这样做。如果您需要这些向量化的函数的复习，请查看第一章，R 语言入门：

get_icon_color <- function(data) {
    return(sapply(
        as.numeric(data$STARS),
        function(stars) {
            if (stars >= 4) {
                return("green")
            } else {
                return("red")
            }
        }
    ))
}

get_icon() 函数非常相似，但它将返回我们想要的图标名称。我们从 ion 图标库网站（之前已引用）获取了这些名称：

get_icon <- function(data) {
    return(sapply(
        as.numeric(data$STARS),
        function(stars) {
            if (stars >= 4) {
                return("ion-android-happy")
            } else {
                return("ion-android-sad")
            }
        }
    ))
}

现在，我们可以轻松地使用以下代码生成我们客户消息的交互式地图。它将打开一个网络浏览器并显示您可以移动的地图。

graph <- graph_client_messages_interactive(client_messages, sales)
print(graph)

地图的初始位置将显示完整的地理数据，如以下图像所示。如您所见，标记包含快乐或悲伤的脸，具体取决于每条消息的评分。此外，标记的颜色是绿色或红色，同样取决于评分。

放大后的互动地图可以在以下图像中看到。根据您在 addProviderTiles() 函数中选择的提供者，您将获得不同类型的地理图像（您可以在htt://leaflet-extras.github.io/leaflet-providers/preview/中看到一些实际操作）。

高科技地球仪

为了完成这一章，我们将构建一个可以移动并展示给朋友的互动式高科技地球仪。这类可视化通常对分析不是非常有用，但它们很酷！

我们的目标是显示一个地球仪，它将显示来自客户消息的地理数据，以及表示每个销售相关联的 PROFIT 的高度条形图和 PROTEIN_SOURCE 的颜色。为了实现这一点，我们将使用 threejs 包。

如我们之前所做的那样，我们的 graph_client_message_in_globe() 函数接收 client_messages 和 sales 数据，并使用 setup_globe_data() 函数进行设置。然后它将使用 get_world_map_data() 函数获取世界数据，并使用 plyr 包中的 rbind.fill() 函数将其附加到 data 数据框上。此函数类似于 R 的 rbind() 函数，但如果列不匹配，它不会抱怨。相反，它将使用缺失数据指示符填充空值。最后，我们使用 globejs() 函数返回一个地球仪对象，该函数接收 lat 和 long 坐标，val 参数下的条形图高度，该参数来自 PROFIT 变量，来自在数据设置期间创建的 COLOR 变量的 color，以及 atmosphere = TRUE 参数以显示地球周围的发光效果：

graph_client_messages_in_globe <- function(client_messages, sales) {
    data <- setup_globe_data(client_messages, sales)
    world_map <- get_world_map_data()
    data <- rbind.fill(data, world_map)
    return(globejs(
        lat = data$LAT,
        long = data$LNG,
        val = data$PROFIT¹.2,
        color = data$COLOR,
        pointsize = 1,
        atmosphere = TRUE
    ))
}

setup_globe_data() 函数执行了我们与所有地图所进行的标准合并，并添加了一个名为 COLOR 的新变量，该变量包含用于每个观测值应使用的颜色。在 ggplot2 包的情况下，这种颜色分配已经自动为我们完成，但在 threejs 包中，我们需要自己完成。它将为 PROTEIN_SOURCE 变量中的每个值简单地使用不同的颜色：

setup_globe_data <- function(client_messages, sales) {
    data <- merge(
        client_messages,
        sales,
        "SALE_ID",
        all.x = TRUE,
        all.y = FALSE
    )
    data$COLOR <- NA
    data[data$PROTEIN_SOURCE == "BEEF", "COLOR"] <- "#aaff00"
    data[data$PROTEIN_SOURCE == "FISH", "COLOR"] <- "#00ffaa"
    data[data$PROTEIN_SOURCE == "CHICKEN", "COLOR"] <- "#00aaff"
    data[data$PROTEIN_SOURCE == "VEGETARIAN", "COLOR"] <- "#0055ff"
    return(data)
}

get_world_map_data() 函数有些复杂。如果您不理解它是如何工作的，不必过于担心，因为您可能不需要自己这样做。我们不能仅仅使用之前用于创建地图的数据来创建我们用 map_data() 函数创建的地图，因为所需的数据结构不同。在这种情况下，我们将使用 tempfile() 函数创建一个名为 cache 的临时文件。然后我们将使用 url() 和 readBin() 函数读取来自 URL 的二进制文件。该文件是一个 TIFF 文件，我们以 "raw" 格式打开它，以保持所有数据原样不变，并避免在 R 中进行任何数据解释。n 参数是从数据中读取的最大记录数，在这个例子中是 1 百万。然后我们通过 writeBin() 函数发送这些数据，以便将其写入我们之前创建的 cache 文件。这种机制是下载一些临时数据的一种方式，以便我们可以将其读入不支持从在线资源读取的功能函数中。

一旦我们准备好了临时文件，我们使用 rgdal 包中的 readGDAL() 函数读取它，该函数将其作为地理数据读取。这些数据的特定格式包括经度、纬度和一个高度指标。高度指标用于识别没有陆地（海洋）的区域，在这个数据中，其值高于或等于 255。我们继续删除数据中的任何 NA 值，并分配默认的 PROFIT 和 COLOR 值。请注意，我们创建这些 PROFIT 和 COLOR 值是为了便于稍后合并数据。我们仅为了方便起见使用 PROFIT 列名作为高度指标，因为我们希望显示低条形的地理区域，并且我们知道我们将使用 PROFIT 生成每个条形的高度：

get_world_map_data <- function() {
    cache <- tempfile()
    writeBin(readBin(url(
"http://illposed.net/nycr2015/MOD13A2_E_NDVI_2014-05-25_rgb_360x180.TIFF",
        open = "rb"), 
        what = "raw", n = 1e6), con = cache)

    world_map <- readGDAL(cache)
    world_map <- as.data.frame(cbind(
                     coordinates(world_map), 
                     world_map@data[,1]))
    names(world_map) <- c("LNG", "LAT", "PROFIT")

    world_map <- world_map[world_map$PROFIT < 255,]
    world_map <- na.exclude(world_map)

    world_map$PROFIT <- 1
    world_map$COLOR <- "#0055ff"

    return(world_map)
}

一旦我们投资创建了我们的图形函数，我们就可以创建看起来高科技的地图，显示我们从客户那里收到的消息的位置，以及表示每个消息相关 PROFIT 和 PROTEIN_SOURCE 的条形和颜色。请随意在您的网络浏览器中移动地球仪：

graph_client_messages_in_globe(client_messages, sales)

这效果相当酷，不是吗？

摘要

在本章中，你学习了如何创建各种类型的数据可视化以及如何高效地使用图形函数和图形对象。除了基本的图形类型外，你还学习了如何创建交互式图表和地图，以及如何创建我们自己的自定义图形类型。本章展示的基本原理允许你使用如ggplot2和leaflet等重要且流行的包来创建高质量的视觉呈现。

在下一章，第六章，通过文本分析理解评论，我们将分析来自客户消息以及我们从 Twitter 实时获取的文本数据。我们将展示如何根据文本数据生成情感分析，并为我们准备将本章中的图表与下一章中的文本分析一起放入第七章，开发自动演示中的自动报告中。

第六章：通过文本分析理解评论

众所周知，很大一部分相关信息以非结构化的形式存在，其中重要的参与者是文本数据。文本分析、自然语言处理（NLP）、信息检索（IR）和统计学习（SL）是一些专注于开发处理这些数据的技术和流程的领域。这些技术和流程发现并呈现知识、事实、业务规则、关系等，否则这些内容以文本形式锁定，对自动化处理来说是不可渗透的。

鉴于如今文本数据的爆炸式增长，对于统计学家和数据科学家等分析师来说，一项重要的技能是能够高效地处理这些数据并找到他们所寻找的见解。在本章中，我们将尝试根据发送给蛋糕工厂的评论来预测客户是否会进行重复购买。

由于文本分析是一个非常广泛的研究领域，我们需要将本章中将要探讨的技术缩小到最重要的几个。我们将采用帕累托方法，专注于在文本分析中使用 80%的时间的 20%的技术。本章涵盖的一些重要主题如下：

• 文档特征矩阵作为基本的数据结构

• 使用文本数据预测建模的随机森林

• 词语频率-逆文档频率用于衡量重要性

• N-gram 建模将顺序带回分析

• 用于降维的奇异向量分解

• 使用余弦相似度查找相似的特征向量

• 将情感分析作为附加的向量特征

本章所需的包

由于一些包依赖于操作系统库，这些库可能因计算机而异，因此设置本章所需的包可能有些繁琐。请参阅附录，所需包，获取有关如何在您的操作系统上安装它们的特定说明。

包名	原因
lsa	余弦相似度计算
rilba	高效的 SVD 分解
caret	机器学习框架
twitteR	Twitter API 接口
quanteda	文本数据处理
sentimentr	文本数据情感分析
randomForest	随机森林模型

我们将使用rilba包（它依赖于 C 代码）通过 Baglama 和 Reichel 在 2005 年提出的增强隐式重启兰索斯双带对角化方法，有效地计算奇异值分解（SVD）的一部分。www.math.uri.edu/~jbaglama/papers/paper14.pdf)。

我们将使用parallel包来进行并行处理，因为一些文本分析可能需要大量的计算。目前parallel包是 R 中最通用的并行化包，但据报道在某些系统中它可能无法正确工作。其他选项包括doParallel、doMC和doSNOW。如果你在使用其中一个parallel时遇到问题，尝试切换到其他包之一。使它们工作的代码非常相似。

关于文本数据，在 R 中你可以使用一些包。最常见的是tm包和quanteda包。两者都非常优秀，主要区别在于风格。本章中我们将看到的所有功能都可以使用其中任何一个包来实现，但我们选择使用quanteda包。它是用stringi包来处理文本，data.table包来处理大量文档，以及Matrix包来处理稀疏对象构建的。因此，你可以期待它非常快速，并且很好地处理 Unicode 和 UTF-8。

如果你不知道 Unicode 和 UTF-8 是什么，我建议你了解一下。非常粗略地，你可以将 Unicode 视为字符的 ID 标准，而 UTF-8 则是将这些 ID 转换为计算机可以理解的字节。在本章中，我们不会担心编码（所有数据都在 UTF-8 中），但这是在处理文本数据时经常出现的问题，并且正确处理它非常重要。

什么是文本分析以及它是如何工作的？

文本分析是从文本中提取信息的过程。信息通常通过诸如信息检索（IR）、自然语言处理（NLP）和句法分析（SL）等技术来提取，它包括对文本进行结构化、从结构化数据中推导模式，以及最终评估和解释输出。用于文本分析的基本模型包括词袋模型、向量空间模型和语义解析模型。

词袋模型是一种简化的文本表示，其中文本（在我们的例子中是评论）被表示为其术语（单词）的集合，不考虑语法和单词顺序，但保持多重性（因此得名“词袋”）。在将文本转换为词袋并将其结构化为语料库（结构化文本数据集合）之后，我们可以计算各种度量来将文本特征化为向量空间。词袋模型在句法分析方法中常用，我们将在本章中使用随机森林来使用它。在实践中，它被用作特征生成工具。以下图像解释了词袋模型：

词袋模型与语义解析的比较

向量空间模型使用从文档中提取的词袋来为每个文本创建一个特征向量，其中每个特征是一个术语，特征值是术语权重。术语权重可能是一个二进制值（1 表示术语在文档中出现过，0 表示没有），一个术语频率（TF）值（表示术语在文档中出现的次数），或者一个术语频率-逆文档频率（TF-IDF）值（表示术语对于一个文本给定其语料库的重要性）。存在更多复杂的加权机制，它们专注于特定问题，但这些都是最常见的，也是我们将要关注的。

根据我们之前提到的，一个文本最终会变成一个特征向量，每个特征向量对应于向量空间中的一个点。这个向量空间模型的构建方式是，对于词汇表中的每个术语都有一个轴，因此这个向量空间是n-维的，其中n是所有被分析数据中词汇表的大小（这可以非常大）。有时，从几何角度思考这些概念会有所帮助。词袋模型和向量空间模型分别指代了表征文本的不同方面，并且它们相互补充。以下图像解释了向量空间模型：

词袋到向量空间

词袋模型的一个重要弱点是它忽略了术语的语义上下文。存在更复杂的模型试图纠正这些不足。语义解析就是其中之一，它是将自然语言句子映射到其意义的形式表示的过程。它主要使用归纳逻辑编程和统计学习的组合。这些类型的技术在处理复杂文本时更有用。尽管我们在这本书中不会进一步探讨它们，但它们是强大的工具，并且是一个非常有意思的研究领域。

例如，如果你尝试用词袋模型和语义解析模型来思考以下引语的表示，你可能直觉上会认为第一个可能会给出无意义的结果，而第二个至少可以提供一些理解，你的判断是正确的。

“鱼网的存在是因为鱼。一旦你得到了鱼，你就可以忘记网。兔子的陷阱存在是因为兔子。一旦你得到了兔子，你就可以忘记陷阱。文字的存在是因为意义。一旦你得到了意义，你就可以忘记文字。我在哪里能找到一个已经忘记了文字的人，我可以和他交谈？”

– 《庄子》著作，公元前 4 世纪（原文为中文）

准备、训练和测试数据

和往常一样，我们将从设置数据开始。在这种情况下，数据是我们幻想公司蛋糕工厂收到的消息。这些消息在第四章中创建的client_messages.RDS文件中，模拟销售数据和数据库操作。数据包含 300 个观测值和 8 个变量：SALE_ID、DATE、STARS、SUMMARY、MESSAGE、LAT、LNG和MULT_PURCHASES。在本章中，我们将处理MESSAGE和MULT_PURCHASES变量。

我们将设置种子以获得可重复的结果。请注意，这应该在涉及随机化的每个函数调用之前完成。我们在这里只展示一次以节省空间并避免重复，但当你尝试生成可重复结果时要记住这一点：

set.seed(12345)

接下来，我们需要确保相关变量中没有缺失数据。为此，我们使用complete.cases()函数以及否定(!)和sum()函数来获取每个变量中NA值的总数。正如你所看到的，我们没有缺失数据：

sum(!complete.cases(client_messages$MESSAGE))
#> 0

sum(!complete.cases(client_messages$MULT_PURCHASES))
#> 0

如果你存在缺失数据，而不是使用通常在数据分析场景中进行的某些插补机制，你希望从这些数据中删除这些观测值，因为由于文本数据的非连续特性，这更容易出错：

当你在预测分析中处理有趣的现实世界问题时，你经常会发现需要处理不均衡的数据。在这种情况下，正如所示代码所示，我们有大约 63%的多次购买。这并不非常不均衡，但我们仍然必须保持训练和测试数据具有相似的比例，以确保安全：

prop.table(table(client_messages$MULT_PURCHASES))
#>     FALSE      TRUE
#> 0.3621262 0.6378738

对于存在不均衡问题的数据，保持测试和训练集中相同的比例对于获得准确的结果非常重要。因此，我们需要确保我们的采样方法保持这些比例。为此，我们将使用caret包中的createDataPartition()函数来提取每个训练和测试集的索引。它将创建平衡的数据分割，在这种情况下，它将使用 70%的数据进行训练，并使用单个分区：

indexes <- createDataPartition(
    client_messages$MULT_PURCHASES,
    list = FALSE,
    times = 1,
    p = 0.7
)
train <- client_messages[ indexes, ]
test <- client_messages[-indexes, ]

为了确保我们的比例保持不变，我们可以像之前对完整数据那样逐个检查它们：

prop.table(table(train$MULT_PURCHASES))
#>     FALSE      TRUE
#> 0.3632075 0.6367925

prop.table(table(test$MULT_PURCHASES))
#>     FALSE      TRUE
#> 0.3595506 0.6404494

现在我们已经准备好了训练和测试集，我们可以开始清理和设置我们的文本数据，就像我们在下一节将要做的那样。

使用分词和数据清洗构建语料库

当我们处理文本数据时，需要创建的第一件事是从中提取将要用于创建语料库的标记。简单来说，这些标记是我们数据中每个文本中找到的所有术语的总和，去除了顺序或语法上下文。为了创建它们，我们使用 tokens() 函数和来自 quanteda 包的相关函数。如您所想象，我们的数据不仅包含单词，还包括标点符号、数字、符号和其他字符，如连字符。根据您处理的问题的上下文，您可能会发现像我们这里这样做，移除所有这些特殊字符非常有用。然而，请记住，在某些上下文中，这些特殊字符可能是有意义的（例如，分析推特数据时，井号符号（#）可能是相关的）：

tokens <- tokens(
    train$MESSAGE,
    remove_punct = TRUE,
    remove_numbers = TRUE,
    remove_symbols = TRUE,
    remove_hyphens = TRUE
)

如您所想象，数据中将有大量的标记，因为我们必须为数据中的每个唯一单词都有一个标记。如果我们不应用一些过滤，这些原始标记可能毫无用处（信号/噪声比低），因此，我们将首先忽略大小写。在我们的语境中，something 和 something 应该是等效的。因此，我们使用 tokens_tolower() 函数将所有标记转换为小写：

tokens <- tokens_tolower(tokens)

此外，请记住，像 the、a 和 to 这样的常用词几乎总是文本中频率最高的术语，并且对于得出见解并不特别重要。因此，我们应该使用 tokens_select() 函数将它们移除，就像我们做的那样：

tokens <- tokens_select(tokens, stopwords(), selection = "remove")

词根允许我们减少具有相同意义的标记数量。例如，单词 probability、probably 和 probable 很可能具有相同的意义，它们之间的差异主要是句法的。因此，我们可以用单个标记 probab 来表示它们，从而大大减少我们的特征空间。请注意，所有这些过滤器都基于我们处理的问题的假设，您应该确保这些假设是有效的。在我们的情况下，它们如下：

tokens <- tokens_wordstem(tokens, language = "english")

而不是每次都要手动重复这个过程来创建标记，我们希望创建标记；我们可以将这些过滤器包装在一个单独的函数中，使我们的工作稍微轻松一些。仔细的读者会注意到 token_ngrams() 函数和相应的 n_grams = 1 默认参数。我们将在稍后的部分中对此进行专门介绍，但就目前而言，只需知道 n_grams = 1 意味着我们希望在标记中包含单个单词：

build_tokens <- function(data, n_grams = 1) {
    tokens <- tokens(
        data,
        remove_punct = TRUE,
        remove_numbers = TRUE,
        remove_symbols = TRUE,
       remove_hyphens = TRUE
    )
    tokens <- tokens_tolower(tokens)
    tokens <- tokens_select(tokens, stopwords(), selection = "remove")
    tokens <- tokens_wordstem(tokens, language = "english")
    tokens <- tokens_ngrams(tokens, n = 1:n_grams)
    return(tokens)
}

现在，尽管我们已经展示了用于本章示例的代码，但我们将使用一个更小的示例（一句话），以便您可以直观地了解每个步骤中发生的情况。您绝对应该养成自己这样做以探索问题的习惯，以确保一切按预期工作。我们将所有步骤的代码都放在这里，在阅读前面的段落之后，您应该能够识别出每个步骤中的差异：

sentence <- "If it looks like a duck, swims like a duck,
             and quacks like a duck, then it probably is a duck."

tokens <- tokens(sentence)
tokens
#> tokens from 1 document.
#> text1 :
#>  [1] "If"       "it"       "looks"    "like"     "a"        "duck"
#>  [7] ","        "swims"    "like"     "a"        "duck"     ","
#> [13] "and"      "quacks"   "like"     "a"        "duck"     ","
#> [19] "then"     "it"       "probably" "is"       "a"        "duck"
#> [25] "."

tokens <- tokens(sentence, remove_punct = TRUE)
tokens
#> tokens from 1 document.
#> text1 :
#>  [1] "If"       "it"       "looks"    "like"     "a"        "duck"
#>  [7] "swims"    "like"     "a"        "duck"     "and"      "quacks"
#> [13] "like"     "a"        "duck"     "then"     "it"       "probably"
#> [19] "is"       "a"        "duck"

tokens <- tokens_tolower(tokens)
tokens
#> tokens from 1 document.
#> text1 :
#>  [1] "if"       "it"       "looks"    "like"     "a"        "duck"
#>  [7] "swims"    "like"     "a"        "duck"     "and"      "quacks"
#> [13] "like"     "a"        "duck"     "then"     "it"       "probably"
#> [19] "is"       "a"        "duck"

tokens <- tokens_select(tokens, stopwords(), selection = "remove")
tokens
#> tokens from 1 document.
#> text1 :
#>  [1] "looks"    "like"     "duck"     "swims"    "like"     "duck"
#>  [7] "quacks"   "like"     "duck"     "probably" "duck"

tokens <- tokens_wordstem(tokens, language = "english")
tokens
#> tokens from 1 document.
#> text1 :
#>  [1] "look"    "like"    "duck"    "swim"    "like"    "duck"    "quack"
#>  [8] "like"    "duck"    "probabl" "duck"

文档特征矩阵

一旦我们准备好了标记，我们需要创建我们的语料库。在最基本层面上，一个 语料库 是一个包含每个文本特定文档级变量的文本集合。最基本的 语料库 使用词袋和向量空间模型创建一个矩阵，其中每一行代表我们集合中的一个文本（在我们的例子中是一个客户消息），每一列代表一个术语。矩阵中的每个值将是一个 1 或 0，表示一个特定的术语是否包含在特定的文本中。这是一个非常基本的表示，我们不会使用。我们将使用 文档-特征矩阵 （DFM），它具有相同的结构，但不是使用指示变量（1s 和 0s），而是包含一个术语在文本中出现的次数，使用词袋模型的多重特性。为了创建它，我们使用 quanteda 包中的 dfm() 函数：

train.dfm <- dfm(tokens)

为了获得一个直观的例子，这里展示了上一节中所示示例的 DFM。我们可以看到一些东西。首先，这是一个具有一些元数据的特殊对象，包括文档数量（在我们的例子中是一个句子），特征数量（即标记的数量），维度以及我们数据中每个文本的实际值。这是我们语料库。如果我们有多个句子，我们会在其中看到多行：

dfm(tokens)
#> Document-feature matrix of: 1 document, 6 features (0% sparse).
#> 1 x 6 sparse Matrix of class "dfmSparse"
#>        features
#>  docs  look like duck swim quack probabl
#> text1  1    3    4    1    1     1

现在，忘记那个单句示例，让我们回到我们的客户消息示例。在这种情况下，tokens 对象将会更大。通常，我们以相同的方式分词并创建我们的 DFM。因此，我们创建了一个使这个过程对我们来说更容易一些的函数：

build_dfm <- function(data, n_grams = 1) {
    tokens <- build_tokens(data, n_grams)
    return(dfm(tokens))
}

现在，我们可以使用以下方法轻松创建我们的 DFM：

train.dfm <- build_dfm(train$MESSAGE)

要了解我们 DFM 的特征，你可以简单地打印它。正如你所见，我们的训练 DFM 有 212 个文档（客户消息）和 2,007 个特征（标记）。显然，大多数文档不会包含大多数特征。因此，我们有一个稀疏结构，这意味着 DFM 中的 98.4%的条目实际上是零。有经验的读者会将其识别为机器学习中常见的维度诅咒问题，在文本分析中尤其有害。正如我们稍后将会看到的，这可能会成为一个计算瓶颈，我们需要处理：

train.dfm
#> Document-feature matrix of: 212 documents, 2,007 features (98.4% sparse)

通常，分词需要一些额外的预处理。正如你所知，我们在分词过程中找到的标记最终会成为我们的 DFM 中的列（特征）名称。如果这些名称包含符号或以数字开头（例如，something&odd 或 45pieces），那么我们的某些分析算法会通过抛出错误来抱怨。我们希望在将我们的 DFM 转换为数据框时防止这种情况发生。我们可以使用方便的 make.names() 函数做到这一点。在此处，我们还将添加 MULT_PURCHASES 值（我们的因变量）到我们新创建的数据框中：

dfm.df <- cbind(MULT_PURCHASES = train$MULT_PURCHASES, data.frame(dfm))
names(dfm.df) <- make.names(names(dfm.df))

再次，为了避免重复这段样板代码，我们可以创建自己的函数来封装这个功能，并轻松地创建用于分析的数据框：

build_dfm_df <- function(data, dfm) {
    df <- cbind(MULT_PURCHASES = data$MULT_PURCHASES, data.frame(dfm))
    names(df) <- make.names(names(df))
    return(df)
}
train.dfm.df <- build_dfm_df(train, train.dfm)

到目前为止，我们的训练数据已经准备好以数据框的形式进行分析，这些数据框可以被我们的预测模型使用。为了完成本节，如果你想了解数据中最频繁出现的术语，可以使用topfeatures()函数。在这种情况下，大多数特征可以根据其上下文直观地猜测。唯一可能需要一些解释的是br特征。它来自我们的数据来自包含<br>字符串的 HTML 页面，这些字符串表示文本中的新行（一个中断，因此称为br）。如果我们想的话，我们可以移除这个特征，但现在我们将保留它：

topfeatures(train.dfm)
#>     br    like    tast  flavor     one    just   coffe    good     tri product
#>    220     107     101      87      82      75      72      71      70      67

使用交叉验证训练模型

在本节中，我们将高效地训练本例的第一个预测模型，并构建相应的混淆矩阵。大部分功能都来自优秀的caret包。你可以在其文档中找到更多关于这个包内丰富功能的信息，我们将在本书中不进行探索（topepo.github.io/caret/index.html）。

训练我们的第一个预测模型

按照最佳实践，我们将使用交叉验证（CV）作为建模过程的基础。使用 CV，我们可以创建模型在未见数据上的表现估计。CV 功能强大，但缺点是它需要更多的处理，因此需要更多的时间。如果你能够承受计算复杂性，你绝对应该在项目中利用它。

探讨 CV 背后的数学原理超出了本书的范围。如果你感兴趣，你可以在维基百科上找到更多信息（en.wikipedia.org/wiki/Cross-validation_(statistics)). 基本思想是将训练数据分成各个部分，然后逐个将这些部分从其余训练数据中取出，同时保留所有剩余的部分。保留在一起的部分将用于训练模型，而被取出的部分将用于测试，并且通过旋转部分来重复这个过程，使得每个部分都被取出一次。这允许你在使用测试数据进行最终测试之前，更彻底地测试训练过程。

我们使用trainControl()函数来设置我们的重复交叉验证机制，包含五个分割和两次重复。这个对象将被传递给我们的预测模型，这些模型是用caret包创建的，以便在它们内部自动应用这个控制机制：

cv.control <- trainControl(method = "repeatedcv", number = 5, repeats = 2)

我们为这个例子选择的预测模型是 Random Forests（RF）。我们将非常简要地解释 RF 是什么，但感兴趣的读者被鼓励去查阅 James, Witten, Hastie 和 Tibshirani 的优秀的"统计学习"（Springer，2013）。RF 是一种非线性模型，用于生成预测。树是一种结构，通过分支模型提供从输入到特定输出的清晰路径。在预测建模中，它们用于找到在提供预测时表现良好的有限输入空间区域。RF 创建了许多这样的树，并使用一种机制将此树提供的预测聚合为单个预测。它们是一个非常强大且流行的机器学习模型。

让我们看看随机森林的例子：

随机森林聚合树

为了训练我们的模型，我们使用train()函数，传递一个公式，指示 R 使用MULT_PURCHASES作为因变量，并将所有其他内容（~ .）作为自变量，即标记频率。它还指定了数据、方法（"rf"代表随机森林）、我们刚刚创建的控制机制以及要使用的调整场景数量：

model.1 <- train(
    MULT_PURCHASES ~ .,
    data = train.dfm.df,
    method = "rf",
    trControl = cv.control,
    tuneLength = 5
)

使用并行化提高速度

如果您在阅读此内容之前已经在您的计算机上实际执行了前面的代码，您可能会发现它花费了很长时间才完成（在我们的例子中是 8.41 分钟）。正如我们之前提到的，文本分析受到非常高的维数结构的影响，这需要很长时间来处理。此外，使用交叉验证运行将需要很长时间。为了减少总执行时间，使用doParallel包允许多核计算机并行进行训练，从而显著减少时间。

我们继续创建train_model()函数，该函数接受数据和控制机制作为参数。然后，它使用makeCluster()函数创建一个集群对象，其可用核心（处理器）数量等于通过detectCores()函数检测到的计算机中的核心数量。请注意，如果您计划在训练模型的同时使用计算机进行其他任务，您应该留出一到两个核心以避免系统过载（您可以使用makeCluster(detectCores() - 2)来完成此操作）。之后，我们开始时间测量机制，训练我们的模型，打印总时间，停止集群，并返回结果模型。

train_model <- function(data, cv.control) {
    cluster <- makeCluster(detectCores())
    registerDoParallel(cluster)
    start.time <- Sys.time()
    model <- train(
        MULT_PURCHASES ~ .,
        data = data,
        method = "rf",
        trControl = cv.control,
        tuneLength = 5
    )
    print(Sys.time() - start.time)
    stopCluster(cluster)
    return(model)
}

现在我们可以更快地重新训练相同的模型。时间减少将取决于你的计算机可用资源。在一个具有 8 个核心和 32GB 内存的系统上，总时间是 3.34 分钟，而不是之前的 8.41 分钟，这意味着通过并行化，它只用了原始时间的 39%。不是很好吗？我们将更深入地研究并行化的机制及其优缺点，更多内容请参见第九章，实现高效的简单移动平均。让我们看看模型是如何训练的：

model.1 <- train_model(train.dfm.df, cv.control)

计算预测准确度和混淆矩阵

现在我们已经训练好了我们的模型，我们可以查看其结果并要求它计算一些预测准确度指标。我们首先简单地打印出从train()函数返回的对象。如所见，我们有一些有用的元数据，但我们现在关心的是预测准确度，这显示在Accuracy列中。从我们告诉函数使用的五个测试场景中，当使用了 2,007 个可用特征（标记）中的 356 个时，我们达到了最佳模型。在这种情况下，我们的预测准确度为 65.36%。

如果考虑到我们的数据中案例的比例大约是 63%的多笔购买，我们已经取得了进步。这可以通过以下事实看出：如果我们只是猜测所有观察值中观察值最多的类别（MULT_PURCHASES为真），我们只有 63%的准确率，但使用我们的模型，我们能够将准确率提高到 65%。这是一个 3%的提高。我们将尝试在阅读本章时进一步提高这个提高。

请记住，这是一个随机过程，每次训练这些模型时结果都会不同。这就是为什么我们想要重复的交叉验证以及各种测试场景，以确保我们的结果是稳健的：

model.1
#> Random Forest
#>
#>  212 samples
#> 2007 predictors
#>    2 classes: 'FALSE', 'TRUE'
#>
#> No pre-processing
#> Resampling: Cross-Validated (5 fold, repeated 2 times)
#> Summary of sample sizes: 170, 169, 170, 169, 170, 169, ...
#> Resampling results across tuning parameters:
#>
#>   mtry  Accuracy   Kappa
#>      2  0.6368771  0.00000000
#>     11  0.6439092  0.03436849
#>     63  0.6462901  0.07827322
#>    356  0.6536545  0.16160573
#>   2006  0.6512735  0.16892126
#>
#> Accuracy was used to select the optimal model using  the largest value.
#> The final value used for the model was mtry = 356.

要创建一个混淆矩阵，我们可以使用confusionMatrix()函数，首先发送模型的预测，然后是真实值。这不仅会为我们创建混淆矩阵，还会计算一些有用的指标，如敏感性和特异性。我们不会深入探讨这些指标的含义或如何解释它们，因为那超出了本书的范围，但我们强烈鼓励读者使用本章中引用的资源来学习它们：

confusionMatrix(model.1$finalModel$predicted, train$MULT_PURCHASES)
#> Confusion Matrix and Statistics
#>
#>           Reference
#> Prediction FALSE TRUE
#>      FALSE    18   19
#>      TRUE     59  116
#>
#>                Accuracy : 0.6321
#>                  95% CI : (0.5633, 0.6971)
#>     No Information Rate : 0.6368
#>     P-Value [Acc > NIR] : 0.5872
#>
#>                   Kappa : 0.1047
#>  Mcnemar's Test P-Value : 1.006e-05
#>
#>             Sensitivity : 0.23377
#>             Specificity : 0.85926
#>          Pos Pred Value : 0.48649
#>          Neg Pred Value : 0.66286
#>              Prevalence : 0.36321
#>          Detection Rate : 0.08491
#>    Detection Prevalence : 0.17453
#>       Balanced Accuracy : 0.54651
#>
#>        'Positive' Class : FALSE

使用 TF-IDF 改进我们的结果

在文本分析的一般情况下，一个术语在文本中的原始计数高并不一定意味着该术语对文本更重要。将术语频率归一化最重要的方法之一是按术语在文本中出现的频率以及在整个语料库中出现的频率来权衡术语。

一个词在给定文本中出现的次数越多，在整个语料库中出现的次数越少，这意味着它可能对该特定文本很重要。然而，如果一个术语在文本中出现的次数很多，但在语料库中的其他文本中也出现很多，那么它可能对该特定文本不重要，而是对整个语料库很重要，这会稀释它的预测能力。

在信息检索（IR）中，TF-IDF 是最受欢迎的术语加权方案之一，它是前一段中表达的想法的数学实现。TF-IDF 值与一个词在给定文本中出现的次数成正比，但被整个语料库（不仅仅是给定文本）中该词的频率所稀释，这有助于调整一些词在一般情况下出现频率较高的实际情况。它是一种增强 DFM 中包含的信息的强大技术。

TF 将语料库中的所有文档归一化到长度无关。逆文档频率（IDF）考虑了语料库中所有文档中术语出现的频率。TF 与 IDF 的乘积通过相乘考虑了这两个概念。数学定义如下：

n(DFM):= DFM 中的文本数量

Freq(term, text):= 文本中术语的计数

Freq(term, DFM):= DFM 中术语的计数

现在我们将展示如何使用 R 函数来编程 TF-IDF 统计。请记住，我们正在处理一个 dfm，因此我们可以使用向量操作来使我们的函数更高效且易于编程。前三个函数 term_frequency()、inverse_document_frequency() 和 tf_idf() 应该很容易理解。

build_tf_idf() 函数利用这些函数来实际构建 TF-IDF 加权后的 DFM。其想法是我们需要使用 apply() 函数将我们创建的函数应用于行或列。我们需要将得到的结构转置，以便将文本放在行中，将特征放在列中，这就是为什么我们在中途使用 t() 函数的原因。最后，我们需要意识到有时我们会得到某些数据组合的 NA 值（尝试自己找出这些情况以确保你理解）并且我们需要用零来替换它们：

build_tf_idf <- function(dfm, idf = NULL) {
    tf <- apply(as.matrix(dfm), 1, term_frequency)
    if (is.null(idf)) {
        idf <- apply(as.matrix(dfm), 2, inverse_document_frequency)
    }
    tfidf <- t(apply(tf, 2, tf_idf, idf = idf))
    incomplete_cases <- which(!complete.cases(tfidf))
    tfidf[incomplete_cases, ] <- rep(0.0, ncol(tfidf))
    return(tfidf)
}

现在我们可以轻松地使用我们的 build_tf_df() 函数构建 TF-IDF 加权后的 DFM，并创建相应的数据框，就像我们之前做的那样：

train.tfidf <- build_tf_idf(train.dfm)
train.tfidf.df <- build_dfm_df(train, train.tfidf)

现在我们 TF-IDF 加权后的 DFM 中的值不仅将是整数，它们对应于频率计数，而且将是浮点值，对应于 TF-IDF 权重。我们可以使用之前使用的相同 train_model() 函数来训练我们的下一个模型：

model.2 <- train_model(train.tfidf.df, cv.control)

这次，我们的训练过程耗时 2.97 分钟。要查看结果，只需打印模型对象。记住，我们之前的预测准确率为 65.36%。现在我们使用了 TF-IDF 加权的 DFM，它增加到了 66.48%。这不是一个显著的改进，这归因于我们正在处理的具体数据。当处理其他数据或领域时，你可以预期这种增加会更大：

model.2
#> Random Forest
#>
#>  212 samples
#> 2007 predictors
#>    2 classes: 'FALSE', 'TRUE'
#>
#> No pre-processing
#> Resampling: Cross-Validated (5 fold, repeated 2 times)
#> Summary of sample sizes: 170, 170, 170, 169, 169, 169, ...
#> Resampling results across tuning parameters:
#>
#>   mtry  Accuracy   Kappa
#>      2  0.6368771  0.00000000
#>     11  0.6368771  0.00000000
#>     63  0.6392580  0.01588785
#>    356  0.6603544  0.13818300
#>   2006  0.6648948  0.18269878
#>
#> Accuracy was used to select the optimal model using  the largest value.
#> The final value used for the model was mtry = 2006.

通过 N-gram 增加灵活性

词袋模型考虑了被称为unigrams的孤立术语。这丢失了单词的顺序，在某些情况下这可能很重要。这种技术的推广称为 n-grams，其中我们使用单个单词以及单词对或单词三元组，在二元组和三元组的情况下分别。n-gram 指的是保持数据中最多n个单词的一般情况。自然地，这种表示具有不利的组合复杂性特征，并使数据呈指数增长。当处理大型语料库时，这可能会消耗大量的计算能力。

使用我们之前创建的sentence对象来举例说明标记化过程是如何工作的（它包含句子：“如果它看起来像鸭子，游泳像鸭子，嘎嘎叫像鸭子，那么它可能就是一只鸭子。”）和带有n_grams参数的build_dfm()函数，你可以比较n_grams = 2的结果 DFM 与n_grams = 1的结果。在分析这个 DFM 中的特征后，你应该对标记化过程如何过滤一些数据以及二元组是如何创建的有一个清晰的认识。正如你所见，n-gram 有可能恢复一些丢失的单词顺序，这在某些情况下可能非常有用：

build_dfm(sentence, n_grams = 2)
#> Document-feature matrix of: 1 document, 14 features (0% sparse).
#> 1 x 14 sparse Matrix of class "dfmSparse"
#>          features
#>  docs    look like duck swim quack probabl look_like like_duck duck_swim
#> text1    1    3    4    1    1     1       1         3         1
#>          features
#>  docs    swim_like duck_quack quack_like duck_probabl probabl_duck
#> text1    1         1          1          1            1

为了重新训练我们的完整模型，我们将这次重新创建带有二元组的 TF-IDF 加权的 DFM 及其对应的数据框。使用我们之前创建的函数，可以通过以下代码轻松完成：

train.bigrams.dfm <- build_dfm(train$MESSAGE, n_grams = 2)
train.bigrams.tfidf <- build_tf_idf(train.bigrams.dfm)
train.bigrams.tfidf.df <- build_dfm_df(train, train.bigrams.tfidf)

现在我们将重新训练模型并分析其结果。这可能会根据你用于训练的计算机而花费大量时间。在我们的 8 核计算机和 32GB 内存上，当并行执行时，耗时 21.62 分钟。这是因为预测因子数量的显著增加。正如你所见，我们现在有 9,366 个预测因子，而不是之前的 2,007 个。这种巨大的 4 倍增加归因于二元组。

在这个特定的情况下，添加的二元组复杂性并没有增加我们的预测准确率。事实上，它降低了。这可能有几个原因，其中之一是稀疏度的增加，这意味着信号/噪声比降低。在下一节中，我们将尝试提高这个比率，同时保持二元组：

model.3 <- train_model(train.bigrams.tfidf.df, cv.control)
model.3
#> Random Forest
#>
#>  212 samples
#> 9366 predictors
#>    2 classes: 'FALSE', 'TRUE'
#>
#> No pre-processing
#> Resampling: Cross-Validated (5 fold, repeated 2 times)
#> Summary of sample sizes: 170, 170, 169, 170, 169, 170, ...
#> Resampling results across tuning parameters:
#>
#>   mtry  Accuracy   Kappa
#>      2  0.6368771   0.000000000
#>     16  0.6368771   0.000000000
#>    136  0.6344961  -0.004672897
#>   1132  0.6133998  -0.007950251
#>   9365  0.6109081   0.051144597
#>
#> Accuracy was used to select the optimal model using  the largest value.
#> The final value used for the model was mtry = 2.

通过 SVD 降低维度

如前文所述，由于 n-gram 技术，我们的数据维度发生了放大。我们希望能够使用 n-gram 将单词顺序带回到我们的 DFM 中，同时我们希望减少特征空间。为了实现这一点，我们可以使用多种不同的降维技术。在本例中，我们将展示如何使用 SVD。

SVD 通过使用其奇异向量而不是原始特征来压缩数据。该技术背后的数学超出了本书的范围，但我们鼓励你查阅 Meyer 的《矩阵分析与应用线性代数》（2000 年）。基本上，你可以将奇异向量视为数据中的重要方向，因此我们可以在具有最大信号/噪声比的可能变换空间中使用这些奇异向量，而不是使用我们的正常轴。计算完整的 SVD 可能需要非常多的时间，而我们实际上并不需要所有的奇异向量。因此，我们将使用irlba包来利用隐式重启兰索斯双向对角化算法（IRLBA）进行快速的部分 SVD，这要快得多。

当我们将部分奇异值分解（SVD）作为我们的降维方法（DFM）时，我们实际上是在一个不同的向量空间中工作，其中每个特征不再是单个标记，而是一系列标记的组合。这些新的特征不易理解，你不应该试图去理解它们。将其视为一个黑盒模型，知道你在比开始时更高的信号/噪声比空间中操作，同时大幅减少了其维度。在我们的案例中，我们将新空间缩小到原始空间的 1/4。为此，我们将创建一个包装函数来测量实际计算部分 SVD 所需的时间。实际的计算将通过irlba()函数完成，将 TF-IDF 加权的二元组 DFM 和我们要的奇异向量数（可能的 1/4）作为nv参数发送：

build_svd <- function(dfm) {
    dfm <- t(dfm)
    start.time <- Sys.time()
    svd <- irlba(dfm, nv = min(nrow(dfm), ncol(dfm)) / 4)
    print(Sys.time() - start.time)
    return(svd)
}

现在我们可以轻松地创建部分 SVD 和相应的数据框。我们还继续重新训练我们的模型。请注意，尽管它是概念性的，但train.bigrams.svd是我们的新 DFM，在实践中，在 R 中，它是一个包含我们的 DFM 以及其他数据的对象。我们的 DFM 位于train.bigrams.svd对象中的v对象内，这是我们发送给buildf_dfm_df()函数的内容。train.bigrams.svd中的另一个重要对象是d，它包含分解的奇异值。

如你所见，我们的特征空间被大幅减少到只有 53 个特征（这大约是 212 个样本的 1/4）。然而，我们的预测准确度也没有比之前的结果更高。这意味着对于这个问题，二元组可能并没有增加太多信息：

train.bigrams.svd <- build_svd(train.bigrams.tfidf)
train.bigrams.svd.df <- build_dfm_df(train, train.bigrams.svd$v)
model.4 <- train_model(train.bigrams.svd.df, cv.control)
model.4
#> Random Forest
#>
#> 212 samples
#>  53 predictors
#>   2 classes: 'FALSE', 'TRUE'
#>
#> No pre-processing
#> Resampling: Cross-Validated (5 fold, repeated 2 times)
#> Summary of sample sizes: 169, 170, 170, 170, 169, 170, ...
#> Resampling results across tuning parameters:
#>
#>   mtry  Accuracy   Kappa
#>    2    0.6344408  0.05602509
#>   14    0.6225360  0.06239153
#>   27    0.6272979  0.09265294
#>   40    0.6485604  0.13698858
#>   53    0.6366002  0.12574827
#>
#> Accuracy was used to select the optimal model using  the largest value.
#> The final value used for the model was mtry = 40.

使用余弦相似度扩展我们的分析

现在我们继续探讨线性代数中的一种熟悉技术，该技术作用于向量空间。这种技术被称为余弦相似度（CS），其目的是找到彼此相似（或不同）的向量。想法是测量客户消息之间的方向相似度（而不是大小），并尝试在涉及多次购买时预测相似的结果。当向量正交时，余弦相似度为 0；当向量垂直时，余弦相似度为 1。然而，这种相似度不应被解释为百分比，因为余弦函数的移动速率不是线性的。这意味着从 0.2 到 0.3 的移动并不代表从 0.8 到 0.9 的相似移动幅度。

给定两个向量（在我们的 DFM 中的行），它们之间的余弦相似度是通过计算它们的点积并将其除以欧几里得范数的乘积来计算的。为了回顾这些概念的含义，请参阅 Meyer 的《矩阵分析与应用线性代数，2000》。

我们创建cosine_similarties()函数，它将使用lsa包中的cosine()函数。我们发送一个数据框，并移除第一列，这对应于因变量MULT_PURCHASES，并使用转置来确保我们使用的是正确的方向：

cosine_similarities <- function(df) {
    return(cosine(t(as.matrix(df[, -c(1)]))))
}

现在我们创建mean_cosine_similarities()函数，它将计算对应于执行过多次购买的客户的文本之间的余弦相似度，并将这些相似度的平均值取出来。我们需要取平均值，因为我们正在计算许多向量之间的许多相似度，并且我们希望为每个向量聚合它们。我们可以使用其他聚合机制，但现在平均值就足够了：

mean_cosine_similarities <- function(df) {
    similarities <- cosine_similarities(df)
    indexes <- which(df$MULT_PURCHASES == TRUE)
    df$MULT_PURCHASES_SIMILARITY <- rep(0.0, nrow(df))
    for (i in 1:nrow(df)) {
        df$MULT_PURCHASES_SIMILARITY[i] <- mean(similarities[i, indexes])
    }
    return(df)
}

现在我们可以使用这个函数生成一个新的 DFM 数据框，该数据框将用于训练一个新的模型，该模型将考虑文本之间的余弦相似度。正如我们之前看到的，对于这种特定的数据，使用双词组并没有太大的帮助。在下一节中，我们将尝试一种不同且非常有趣的技术，即情感分析。让我们看看下面的代码：

train.bigrams.svd.sim.df <- mean_cosine_similarities(train.bigrams.svd.df)
model.5 <- train_model(train.bigrams.svd.sim.df, cv.control)
model.5
#> Random Forest
#>
#> 212 samples
#>  54 predictors
#>   2 classes: 'FALSE', 'TRUE'
#>
#> No pre-processing
#> Resampling: Cross-Validated (5 fold, repeated 2 times)
#> Summary of sample sizes: 169, 170, 170, 170, 169, 170, ...
#> Resampling results across tuning parameters:
#>
#>   mtry  Accuracy   Kappa
#>    2    0.6460687  0.08590598
#>   15    0.6227021  0.05793928
#>   28    0.6437431  0.12111778
#>   41    0.6296788  0.09535957
#>   54    0.6227021  0.07662715
#>
#> Accuracy was used to select the optimal model using  the largest value.
#> The final value used for the model was mtry = 2.

情感分析的深入挖掘

我们已经看到，在预测模型的准确性方面，向量空间操作并没有很好地工作。在本节中，我们将尝试一种非常不同的技术，它更接近于我们在本章开头提到的语义解析模型。我们将尝试情感分析。

我们不仅会考虑文本中的单词，还会考虑位移词（即否定词、放大器、去放大器和对抗性连词）。一个否定词会翻转极化词的符号（例如，我不喜欢它）。一个放大器会增加极化词的影响（例如，我真的很喜欢它）。一个去放大器会减少极化词的影响（例如，我几乎不喜欢它）。一个对抗性连词会覆盖包含极化词的前一个子句（例如，我喜欢它，但它不值得）。这在某些类型的数据中可能非常有力量。

我们的情感分析将产生一个数字，该数字将指示从文本中测量的情感。这些数字是无界的，可以是正数或负数，对应于积极或消极的情感。数字越大，推断出的情感越强烈。为了实现这项技术，我们将使用sentimentr包，该包包含一个巧妙的算法来计算这些情感。对于爱好者来说，方程式的详细信息可以在其文档中找到（cran.r-project.org/web/packages/sentimentr/sentimentr.pdf）。

要应用这项技术，我们向sentiment_by()函数发送消息。这将返回一个包含多个值的对象，其中包括word_count值和ave_sentiment，后者是在给定文本中的所有句子中测量的平均情感（sentinmentr内部将每个文本分割成其组成部分（句子）并为每个部分测量情感）。然后我们将此对象添加到我们的 DFM 中并继续训练我们的模型。

如您所见，这次我们的模型预测准确性大幅提高，达到 71.73%。这意味着与我们在前几节中构建的其他特征相比，情感特征具有高度的预测性。尽管我们可以继续混合模型并探索，看看是否可以获得更高的预测准确性，但我们将在这一点上停止，因为您现在可能已经理解了如何自己进行这些操作：

train.sentiment <- sentiment_by(train$MESSAGE)
train.sentiments.df <- cbind(
    train.tfidf.df,
    WORD_COUNT = train.sentiment$word_count,
    SENTIMENT = train.sentiment$ave_sentiment
)
model.6 <- train_model(train.sentiments.df, cv.control)
model.6
#> Random Forest
#>
#>  212 samples
#> 2009 predictors
#>    2 classes: 'FALSE', 'TRUE'
#>
#> No pre-processing
#> Resampling: Cross-Validated (5 fold, repeated 2 times)
#> Summary of sample sizes: 170, 170, 169, 170, 169, 170, ...
#> Resampling results across tuning parameters:
#>
#>   mtry  Accuracy   Kappa
#>      2  0.6368771  0.00000000
#>     11  0.6440753  0.04219596
#>     63  0.6863787  0.22495962
#>    356  0.6935770  0.28332726
#>   2008  0.7173198  0.31705425
#>
#> Accuracy was used to select the optimal model using  the largest value.
#> The final value used for the model was mtry = 2008.

尽管由于sentimentr包的存在，情感分析看起来非常简单，因为它不需要很多代码，但实际上这是一个非常困难的领域，背后有活跃的研究。对于公司来说，了解他们的客户如何看待他们非常重要，并且需要准确地进行。这现在并将继续成为一个非常有趣的研究领域。

使用未见数据测试我们的预测模型

现在我们有了最终模型，我们需要通过使用未见数据对其进行测试来验证其结果。这将使我们确信我们的模型训练良好，并且在新数据提供给我们时可能会产生类似的结果。

一个细心的读者应该已经注意到，我们在创建情感分析数据时使用了 TF-IDF 数据框，而不是我们后来创建的任何结合了二元组、SVD 和余弦相似度的数据框，因为它们在原始 DFM 的变换中处于不同的语义空间。因此，在我们实际上可以使用训练好的模型对测试数据进行预测之前，我们需要将其转换成与训练数据等效的空间。否则，我们就会比较苹果和橘子，这会给出荒谬的结果。

为了确保我们在相同的语义空间中工作，我们将 TF-IDF 权重应用于我们的测试数据。然而，如果你仔细想想，我们的测试数据中可能有很多术语在训练数据中并不存在。因此，我们的训练集和测试集的 DFM 将具有不同的维度。这是一个问题，我们需要确保它们是相同的。为了实现这一点，我们为测试数据构建 DFM 并对其应用一个过滤器，只保留在训练 DFM 中存在的术语：

test.dfm <- build_dfm(test)
test.dfm <- dfm_select(test.dfm, pattern = train.dfm, selection = "keep")

此外，如果你仔细想想，TF-IDF 的语料库加权部分，即 IDF，也会因为语料库术语空间的变化而与这两个数据集不同。因此，我们需要确保我们忽略那些新的术语（即在训练数据中未见过）并使用训练过程中的 IDF 来确保我们的测试是有效的。为了实现这一点，我们将首先只计算训练数据的 TF-IDF 的 IDF 部分，并在计算测试数据的 TF-IDF 时使用它：

train.idf <- apply(as.matrix(train.dfm), 2, inverse_document_frequency)
test.tfidf <- build_tf_idf(test.dfm, idf = train.idf)
test.tfidf.df <- build_dfm_df(test, test.tfidf)

现在我们已经将测试数据映射到训练数据的向量空间中，我们可以对新的测试 DFM 进行情感分析并计算我们的预测结果：

test.sentiment <- sentiment_by(test$MESSAGE)
test.sentiments.df <- cbind(
    test.tfidf.df,
    WORD_COUNT = test.sentiment$word_count,
    SENTIMENT = test.sentiment$ave_sentiment
)

注意，在这种情况下，我们并没有训练一个新的模型，我们只是使用我们创建的最后一个模型，并使用它来为测试 DFM 提供预测：

predictions <- predict(model.6, test.sentiments.df)

要知道我们的预测效果如何，我们只需像之前一样打印一个模型即可，因为我们只是查看训练过程中的结果，这些结果不包括测试数据的预测。我们需要做的是创建一个混淆矩阵并计算预测准确度指标，就像我们之前使用confusionMatrix()函数所做的那样。

如你所见，我们的结果似乎有效，因为我们用 71.91%的预测准确度对未见过的数据进行预测，这非常接近训练数据的预测准确度，并且比仅仅猜测实际多次购买比例高出 12%。对于文本数据和我们所处理的问题，这些结果相当不错。

如果你知道如何解释其他指标，请确保将它们与我们第一个模型中的指标进行比较，以了解我们在本章中结果是如何演变的。

如果您不熟悉这些内容，我们建议您查阅 James, Witten, Hastie 和 Tibshirani 的《统计学习，2013》：

confusionMatrix(predictions, test$MULT_PURCHASES)
#> Confusion Matrix and Statistics
#>
#>           Reference
#> Prediction FALSE TRUE
#>      FALSE    11    4
#>      TRUE     21   53
#>
#>                Accuracy : 0.7191
#>                  95% CI : (0.6138, 0.8093)
#>     No Information Rate : 0.6404
#>     P-Value [Acc > NIR] : 0.073666
#>
#>                   Kappa : 0.3096
#>  Mcnemar's Test P-Value : 0.001374
#>
#>             Sensitivity : 0.3438

#>             Specificity : 0.9298
#>          Pos Pred Value : 0.7333
#>          Neg Pred Value : 0.7162
#>              Prevalence : 0.3596
#>          Detection Rate : 0.1236
#>    Detection Prevalence : 0.1685
#>       Balanced Accuracy : 0.6368
#>
#>        'Positive' Class : FALSE

如果您打算使用通过 SVD 创建的 DFM 进行测试，您需要在生成任何预测之前进行相应的转换，以确保您在正确的语义空间中工作。如果您使用了本章中展示的程序，您需要将测试 DFM（与您的训练 DFM 具有类似的转换）左乘以由 sigma 调整的奇异值向量，并相应地转置结构。确切的转换将取决于您使用的数据结构和您对其应用的过程，但请始终确保您的训练数据和测试数据在相同的语义空间中操作：

sigma.inverse <- 1 / train.bigrams.svd$d
u.transpose <- t(train.bigrams.svd$u)
test.bigrams.svd <- t(sigma.inverse * u.transpose %*% t(test.bigrams.tfidf))
test.bigrams.svd.df <- build_dfm_df(test, test.bigrams.svd)

从 Twitter 检索文本数据

在我们结束本章之前，我们将非常简要地触及一个完全不同但非常受欢迎的主题，即从 Twitter 获取数据。如果您想应用预测模型，您需要将 Twitter 数据链接到您想要预测的变量，这通常来自其他数据。然而，您可以轻松做到的是，使用我们在前一部分展示的技术来衡量一个主题周围的情感。

twitteR包实际上使我们能够非常容易地检索 Twitter 数据。为此，我们将在 Twitter 内部创建一个Twitter 应用，这将使我们能够访问数据源。为了完成此操作，我们需要在您的 Twitter 账户中生成四个字符串，这些字符串将是使用 API 的密钥。这些密钥用于验证您的权限并监控您的总体使用情况。具体来说，您需要四个字符串，即consumer_key值、consumer_secret、access_token和access_secret。要检索它们，请访问 Twitter Apps 网站(apps.twitter.com/)，点击创建新应用，并输入所需的信息。您的 Twitter 应用名称必须在所有 Twitter 应用中是唯一的。不用担心选择一个复杂的名称，您永远不会再次使用那个字符串。此外，请确保您阅读了 Twitter 开发者协议，并且您同意它。

一旦进入您应用的仪表板，请转到“密钥和访问令牌”选项卡，并生成一个密钥和访问令牌及其相应的密钥。确保您准确无误地复制这些字符串，因为它们将授予您访问数据源的权利。用它们替换这里显示的（由于本书编写后已删除，因此不再有效），并执行setup_twitter_oauth()函数。如果一切如预期进行，现在您应该已经将您的 R 会话连接到了数据源：

consumer_key <- "b9SGfRpz4b1rnHFtN2HtiQ9xl"
consumer_secret <- "YMifSUmCJ4dlgB8RVxKRNcTLQw7Y4IBwDwBRkdz2Va1vcQjOP0"
access_token <- "171370802-RTl4RBpMDaSFdVf5q9xrSWQKxtae4Wi3y76Ka4Lz"
access_secret <- "dHfbMtmpeA2QdOH5cYPXO5b4hF8Nj6LjxELfOMSwHoUB8"
setup_twitter_oauth(consumer_key, consumer_secret, access_token, access_secret)

为了检索数据，我们将创建一个包装函数，这样我们就不必每次需要新数据时都重复编写样板代码。get_twitter_data() 函数接受我们在 Twitter 中搜索的关键词以及我们想要检索的消息数量。然后，它继续使用 searchTwitter() 函数（英文）从 Twitter 获取数据，使用 twListToDF() 函数将结果转换成数据框，并将数据发送回用户：

get_twitter_data <- function(keyword, n) {
    return(twListToDF(searchTwitter(keyword, n, lang = "en")))
}

现在，我们可以通过执行以下代码轻松搜索包含单词 "cake" 的消息。如您所见，我们不仅获得了消息，还获得了大量元数据，例如推文是否已被收藏；如果是，收藏了多少次；是否为回复；创建时间；如果可用，推文发送的坐标，以及其他事项：

cake_data <- get_twitter_data("cake", 250)

names(cake_data)
#>  [1] "text"          "favorited"     "favoriteCount" "replyToSN"
#>  [5] "created"       "truncated"     "replyToSID"    "id"
#>  [9] "replyToUID"    "statusSource"  "screenName"    "retweetCount"
#> [13] "isRetweet"     "retweeted"     "longitude"     "latitude"

作为一项练习，使用前面展示的机制从 Twitter 获取数据，并使用它创建一个世界地图，显示推文的来源，并使用从推文中推断出的情感来着色推文的位置。拥有这样的代码片段可以很有趣，可以和朋友一起玩耍和开玩笑，也可以用于做出真正的商业决策。

摘要

在本章中，我们展示了如何使用文本数据进行预测分析。为此，我们展示了如何对文本进行分词以提取相关单词，如何构建和使用文档-特征矩阵（DFMs），如何对 DFMs 应用转换以使用词频-逆文档频率权重、n-gram、部分奇异值分解和余弦相似度探索不同的预测模型，以及如何在随机森林中使用这些数据结构来生成预测。您学习了为什么这些技术对于某些问题可能很重要，以及如何将它们结合起来。我们还展示了如何将文本中推断出的情感分析包括进来，以增强我们模型的预测能力。最后，我们展示了如何从 Twitter 获取实时数据，这些数据可以用来分析人们在说出他们的观点后不久在社交网络中说些什么。

我们鼓励您将本章的知识与之前章节的知识结合起来，以尝试获得更深入的见解。例如，如果我们使用四元组的三角元会发生什么？如果我们将其他特征（例如，坐标或客户端 ID）包含在数据中会发生什么？以及，如果我们使用支持向量机等而不是随机森林作为预测模型会发生什么？

在下一章中，我们将探讨如何使用前三个章节中我们所做的工作来生成当从蛋糕工厂收到新数据时可以自动生成的报告。我们将介绍如何自动生成 PDF，如何创建可以自动更新的演示文稿，以及其他有趣的报告技术。

第七章：开发自动演示文稿

你是否发现自己反复进行同样的机械任务？令人惊讶的是，许多程序员、统计学家和科学家通常不花时间自动化许多活动，尤其是报告结果。这样做将使他们能够更深入地专注于他们的核心能力。此外，这不仅仅是个人的问题；大型组织仍然没有自动化许多流程，尤其是分析流程。还记得我们在第二章，使用描述性统计理解投票中执行的图形创建自动化，或者我们在第三章，使用线性模型预测投票中执行的回归自动化吗？在本章中，我们将向您展示如何自动化另一项活动——开发演示文稿。通过这种方式，我们并不是指自动化结果背后的解释，而是自动化展示流程当前状态的表格和图形的幻灯片创建。这是一个非常高的效益/成本区域，通常被忽视，很多时间都浪费在制作这样的演示文稿以供同行讨论上。

这是《食品工厂》示例的最后一章，在这里，我们将自动化许多组织中的许多人反复进行的活动——为每周更新开发演示文稿。我们将展示 R 中的内容自动化流程是什么样的，并构建一个可以自动使用最新数据更新的演示文稿。为此，我们将使用我们在本示例前几章中开发的结果。

本章涵盖的一些重要主题如下：

• 自动化的重要性和好处

• 设置和运行自动化流程

• 使用文献编程交流想法

• 使用 Markdown 编写静态内容

• 使用 R Markdown 开发动态内容

• 使用 knitr 制作演示文稿和网页

• 高效集成 R 资源

必需的软件包

本章只需要两个必需的软件包，你应该能够在你的系统中无问题地安装它们。更多信息请参阅附录，必需的软件包。

软件包	原因
ggrepel	避免在图形中重叠标签
rmarkdown	带有可执行 R 代码的 Markdown 文档

为什么要投资自动化？

自动化是一种投资。它通常涉及将不同的应用程序集成在一起，以便重复执行流程，希望无缝且轻松。流程自动化可以通过减少执行重复性任务所需的时间来提高生产力，同时减少缺陷，这也可以节省时间并增强价值创造过程。

此外，自动化系统不会感到无聊。很可能任何必须反复执行重复性任务的人都会感到无聊。这会减慢他们的表现并增加缺陷的风险。自动化流程不会感到无聊，无论运行多少次，因此性能不太可能减慢。

科学家可以通过科学方法利用自动化来缩短周期时间，这反过来又提高了学习率，通常是指数级的。在我看来，这是自动化最强大的后果之一：通过让我们（人类）从那些我们无法增加价值的活动中解脱出来，从而加速学习过程，并让我们专注于那些（到目前为止）无法自动化的活动，例如创造性地解决问题或开发创新解决方案。

最后，人们常常抱怨没有足够的时间。一种有效的方法是自动化流程，这就是自动化的最终好处——让你的时间更加充实。

文献编程作为一种内容创作方法

自动化要求我们将不同的部分组合在一起，使得流程对人类和机器都清晰可见。流程必须是可重复的，并且能够随着新想法的产生或需求的变化而发展。通过文献编程可以实现内容创作自动化，这源于唐纳德·克努特在 1992 年的《文献编程》一书（www-cs-faculty.stanford.edu/~knuth/lp.html）。基本思想是将文档视为文本和代码的结合。代码被分成块，周围的文本解释代码块的内容。文本根据需要调整，以保持代码背后的思想更新、清晰和准确。

在本章中，我们使用“展示”和“文档”这两个词可以互换使用，因为你可以使用我们将展示的工具创建它们。

文献编程不是自动化内容创作的必要条件，但它确实是一个很好的工具。文献编程的优点是易于阅读，就像手册或指令集一样。此外，它允许代码和自然语言结合在一起。结果可以在我们浏览文档时自动显示。文档本身是简单的文本，这使得它灵活且易于更改。一般来说，文献程序被“编织”成人类可读的文档，并被“纠缠”成机器可读的文档。为了使这一切工作，我们只需要一种文档语言和一种编程语言，在我们的例子中是英语和 R 语言。

文献编程似乎有潜力使许多目前用于生成内容的工具变得过时。然而，如果你需要生成具有非常精确格式或需要高度技术优化的文档，仍然有更好的工具可用。这并不是因为文献编程概念本身有任何固有的弱点，而是因为可用的工具在这些方面并不像专业工具那样高效。

当谈到文献编程时，R 在技术复杂性和简单展示之间找到了一个很好的平衡，这使得可以开发出广泛的内容自动化，这可以产生非常适合研究和数据分析的文档。如果你在某个时候发现你需要进行更改，你可以轻松地做到这一点，重新编译，你将在几秒钟内看到最新版本。这就是为什么我们将在本章中向您展示如何以这种方式开发自动化演示文稿非常方便。

文献编程作为可重复性的好处

在科学中，可重复性是验证和验证分析发现最重要的元素。我们运行的分析和模型、算法比以往任何时候都要复杂。即使对于复杂的人来说，对这些算法有基本理解也很困难，而且几乎不可能仅用文字来描述。现在理解某人做了什么需要直接查看数据和代码，而不仅仅是结果。

科学家们写了很多报告，描述数据分析的结果。使这些报告可重复是让同行审阅你的工作的关键，而且这是使用文献编程实现这一目标的非常好的方法。有了它，最终报告依赖于在创建时执行的代码，因此可重复性被嵌入到过程中。从数据和代码到最终报告有一个清晰且自动的路径。

由于提供了开发和通信效率，文献编程在数据分析中已经变得相当流行。在接下来的章节中，我们将展示如何使用 R、R Markdown 和 knitr 来实现它。

自动化流程的基本工具

流程是一个从文本、代码和原始数据开始，以我们想要展示或分发的最终文档或演示文稿结束的过程。幸运的是，在 R 中，许多艰苦的工作已经为你自动化了，所以你除了安装这些工具和设置编译文件之外，不需要做太多。

我们的设计流程应该足够通用，以便能够适应各种用例，而无需进行实质性的修改。如果是这样，我们就可以掌握一套工具，并可以在不同的项目中重复使用，而不是每次都学习一套新的工具集。在输入端，使用文本、代码和数据已经足够通用。在输出端，能够生成 HTML、PDF、LaTeX 甚至 Word 文档似乎也足够通用，因此我们可以继续前进。

Markdown 是一种低开销的标记语言（spec.commonmark.org/0.28/)。对于作者来说，它的主要好处是它允许我们专注于写作而不是格式化。它具有简单、最小化但直观的格式化元素，并且有许多程序可以将 Markdown 转换为 HTML 和 PDF 文件等。R Markdown 是 Markdown 的扩展，用于结合 R 代码（rmarkdown.rstudio.com/)。在 R Markdown 中编写的文档包含嵌套的 R 代码，这使得我们可以创建动态演示。它们不能使用标准的 Markdown 工具进行评估。相反，R 代码在调用传统的 Markdown 工具之前作为 R Markdown 处理的一部分进行评估。

R 中第一个文学编程系统之一是Sweave，它用于使用LaTeX（www.latex-project.org/）创建动态报告和可重复的研究。Sweave 允许在 LaTeX 文档中嵌入 R 代码，以生成包含文本、分析、图形、代码和计算结果的 PDF 文件。knitr（首字母小写）是一个 R 包，它为 Sweave 添加了许多新功能（yihui.name/knitr/)）。

R Markdown 可以使用 R 中的 knitr 包转换为标准 Markdown，该包将 R 结果插入到 Markdown 文档中。Markdown 随后可以使用 Pandoc（一个非常强大的文档转换器，pandoc.org/)转换为 HTML。使用 R Markdown 创建可重复的报告已经迅速成为许多科学家的核心工具。

我们不会深入探讨 Sweave、LaTeX 或 Pandoc 如何在不同格式之间转换文件，因为您不需要直接操作它们。我们将专注于使用 R Markdown 和 knitr。然而，在我们继续之前，我们仍然需要确保我们已经在系统中安装了所有这些工具。Sweave 包含在任何 R 发行版中。R Markdown 和 knitr 可以在 R 中安装。Pandoc 和 LaTeX 应直接安装到您的计算机上。有关 Windows、macOS 和 Linux 的具体说明，请参阅附录，“所需软件包”。

最后，您应该注意，这些并不是制作自动化内容的唯一工具。随着 R 的文献编程成为热点话题，自然地，许多工具已经开发出来，并且仍在继续开发。尽管本章重点介绍 R Markdown 和 knitr，但还有其他工具，如R Studio 的演示者（RPres）和Slidify。我们没有在本书中展示这些工具，因为它们要么在应用上更加受限，要么在用法上更加复杂。我们相信，R Markdown-knitr 组合在功能性和易用性之间取得了非常好的平衡，这是我们首选的组合。然而，我们鼓励读者研究其他工具，找到最适合的工具。

Markdown 的温和介绍

Markdown 有各种语法版本，这些版本由不同的系统和平台支持。我们在这里展示的是一种通用的版本，它在许多系统中都很有用，包括 R Markdown。

我们在以下示例中展示的是使用 Markdown 结构化内容的基本元素。实际的美观取决于应用于您的文件的风格。以下示例没有应用任何美学。我们将在本章后面向您展示如何调整它们以适应我们的演示。

文本

如果您想使用简单的文本，您可以像平时一样写。如果您想格式化文本，可以使用一对星号（*）或下划线（_）。以下表格显示了如何使用一对星号。下划线的作用相同。

如果我们使用以下输入：

Text with *italic* text inside.
Text with **bold** text inside.
Text with **bold and *italic* text**.

我们会得到以下输出：

包含斜体文本的文本。

包含粗体文本的文本。

包含粗体和斜体文本的文本。

标题

如果您想，您可以有相当于部分（一级标题）、子部分（二级标题）、次子部分（三级标题）等等。组织结构使用数字符号标记，重复次数与您希望在文档中产生的深度相同。例如，# 标题会产生一个一级标题，而### 标题会创建一个三级标题。

如果我们使用以下输入：

# Header Level 1

## Header Level 2

### Header Level 3

#### Header Level 4

我们会得到以下输出：

标题级别 1

标题级别 2

标题级别 3

标题级别 4

列表

列表可以是有序的、无序的，也可以标记为任务。这些涵盖了您可能需要的绝大多数情况，并且它们的使用非常简单。对于有序列表，您可以使用连字符（-）或星号（*），并且您可以嵌套它们以创建嵌套列表。对于有序列表，您可以使用数字和字母。最后，要创建任务列表，您只需在项目开头放置一对括号（[]）。如果括号中包含一个 X，则表示该任务已完成。如果括号之间有空格，则表示该项目仍在待办。

如果我们使用以下输入：

1\. This is an ordered item
    - This is an unordered item
    - This is another unordered item
2\. This is another ordered item
    - [ ] This is a pending task
    - [X] This is a completed task
- [ ] This is another incomplete task
    1\. Which contains one ordered item
    - And one unordered item

输出

1. 这是一个有序列表项

   • 这是一个无序列表项

   • 这是另一个无序列表项

2. 这是一个另一个有序列表项

   • 这是一个待办任务

   • 这是一个完成的任务

• 这是另一个未完成的任务

1. 其中有一个有序列表项

   • 有一个无序列表项

表格

在使用 Markdown 时，表格是最繁琐的结构之一来创建。话虽如此，创建它们仍然不难。如果你对齐它们，一切看起来都很正常。然而，大多数时候，人们没有对齐它们，如果你不熟悉语法，它们看起来会有些奇怪。我们所说的非对齐表格是指项目后面没有填充空间，这样垂直线才能对齐。下面显示的表格是一个对齐表格。

如果我们使用以下输入：

| First column | Second column | Third column |
|--------------|---------------|--------------|
| Item one     | Item two      | Item three   |
| Item four    | Item five     | Item six     |
| Item seven   | Item eight    | Item nine    |

我们得到以下输出：

第一列	第二列	第三列
第一项	第二项	第三项
第四项	第五项	第六项
第七项	第八项	第九项

链接

要提供链接，你可以直接写出链接。如果你想给链接命名，以便只显示名称而不显示 URL，就像你在网页上看到的那样，你可以使用包含名称的括号后立即跟包含实际链接的括号，格式为"名称"。

如果我们使用以下输入：

[The R Project for Statistical Computing](https://www.r-project.org/) 
[Packt Publishing](https://www.packtpub.com/)

我们得到以下输出：

The R Project for Statistical Computing

Packt Publishing

图片

图片的结构与链接类似，但它们前面有一个感叹号（!）。图片的名称（括号内的内容）仅在实际图片未显示时（例如，文件未在指定的路径中找到）才会显示。URL 会被替换成你想显示的图片的路径。默认情况下，图片的大小将是尽可能大。假设图片位于与 Markdown 文件相同的目录下的名为 images 的目录中，以下示例是有效的。

如果我们使用以下输入：

The R Project for Statistical Computing 

Packt Publishing

我们得到以下输出：

引用

引用非常有助于强调读者想要强调的点。它们也非常容易创建。你只需要在行首添加一个大于号（>）后跟一个空格。

如果我们使用以下输入：

> Look deep into nature, and then you will understand everything better.
>
> —Albert Einstein

我们得到以下输出：

深入研究自然，然后你就会更好地理解一切。

• 阿尔伯特·爱因斯坦

代码

代码可以通过在它周围使用单反引号（`）来嵌入到文本中，或者可以通过使用三重反引号（py` ```py`). Optionally, you may specify the programming language in the code block to activate syntax highlighting for that code.

If we use the following input:

```pyr
add_two_numbers <- function(x, y) {
    return(x + y)
}

We get the following output:

add_two_numbers <- function(x, y) {

return(x + y)

}

# Mathematics

Embedding mathematics in Markdown is similar to embedding code. However, instead of using backticks (“ ’), you use dollar signs ($). If you want to use mathematics blocks, you may use two (instead of three) dollar signs. Keep in mind that this is not a standard Markdown feature, and, even though R Markdown does support it, it may not be supported in other systems. If you're trying to create a web page using Markdown, to be able to use LaTeX-like code, you need to make sure that the system loads the `MathJax` library to the browser.

If we use the following input:

\[\Theta = \begin{pmatrix} \alpha & \beta \\ \gamma & \delta \end{pmatrix} \]

We get the following output:

![](https://github.com/OpenDocCN/freelearn-ds-zh/raw/master/docs/r-prog-ex/img/00056.jpeg)

# Extending Markdown with R Markdown

As mentioned earlier, R Markdown extends Markdown. It offers many features to enhance it. There are various examples in R Markdown's documentation ([`rmarkdown.rstudio.com/gallery.html`](http://rmarkdown.rstudio.com/gallery.html)) where you may get a sense of what's possible. In this section, we will focus on code chunks, tables, graphs, local and global chunk options, and caching.

# Code chunks

*Code chunks* are simply standard Markdown code blocks, which have a special syntax that uses curly braces (`{}`) along the top line of the block to send metadata to knitr, about how the block should be treated. The metadata sent is in the form of parameters with the `*key = value*` format. We'll cover more on this in the *Chunk options* section.

When you use a block header like (```` ```py{r chunk-label} ````), knitr 知道这是一个 R 代码块，它将被`chunk-label`标签识别。代码块标签不是必需的，如果你没有指定一个，系统会自动为你创建一个，但它们在尝试记住代码块的目的和引用图像时很有用（关于这一点稍后还会详细介绍）。

最后，你应该注意，无论你在标准的 Markdown 代码块中编写什么代码，都不会以任何方式执行，所以它可能充满错误，但什么也不会发生。然而，当使用 R Markdown 代码块时，R 块中的代码实际上在编译文档时会被评估，如果它包含错误，文档或演示文稿将无法成功编译，直到你修复它们。

如果我们使用以下输入：

```py
```{r optional-label}

1 + 2

```py

我们得到以下输出：

1 + 2
[1] 3

表格

在非正式报告中，你可能只需打印出矩阵或数据框，而不是创建正式的表格。如果你需要，有几种方法可以使用 R Markdown 制作表格，可能看起来更美观。我们展示了如何使用knitr包中的kable，因为它是最简单的一个。如果你需要更多控制，你可以查看xtable包，它给你完全的控制。你需要在代码块中确保使用results = "asis"。

如果我们使用以下输入：

```{r r-markdown-label, results = "asis"}

加载 knitr 库

x <- rnorm(100)

y <- 2 * x + rnorm(100)

coeficients <- summary(lm(y ~ x))$coef

以两位小数显示系数(kable(coeficients, digits = 2))

```py

我们得到以下输出：

	估计值	标准误差	t 值	**Pr(>	t	)**
(截距)	0.02	0.10	0.21	0.83
x	2.09	0.09	22.98	0.00

图表

使用 R Markdown 创建图表与在 R 中创建图表一样简单。实际上，你不需要做任何额外的事情；knitr 足够智能，可以自动完成。如果你需要，可以使用下一节中显示的相应代码块选项指定图像的宽度和高度。

如果我们使用以下输入：

```{r basic-r-graph}

添加数据集(mtcars)

绘制散点图(wt, mpg)

添加线性拟合线(abline(lm(mpg ~ wt)))

标题("MPG 对重量的回归")

```py

我们得到以下输出：

代码块选项

当处理代码块时，我们有很大的灵活性，这种灵活性可以通过我们可以调整的许多选项来体现。在这里，我们只提到最常见的几个。为了避免将代码作为输出包含，使用echo = FALSE。为了避免显示结果，使用include = FALSE。为了避免评估代码块，使用eval = FALSE。为了避免显示警告，使用warning = FALSE。要设置图形的宽度和高度，使用fig.height = 10和fig.width = 10，使用你想要的实际数字（默认单位是英寸）。所有这些都可以在代码块标题中使用，如下所示：

```{r some-label, include = TRUE, eval = FALSE}

1 + 2

```py

全局代码块选项

你可以使用全局代码块选项而不是重复的局部代码块选项。无论何时你需要，你都可以通过指定不同的局部代码块选项来覆盖全局代码块选项。使用以下代码将使每个代码块都启用echo = TRUE和eval = FALSE选项，除非在特定块中指定了其他选项：

```{r global-options}

knitr::opts_chunk$set(echo = TRUE, eval = FALSE)

```py

缓存

如我们之前提到的，如果您正在编写一个非常长的文档或涉及复杂计算的文档，knitr 就不那么有用。然而，通过使用缓存，您可以避免一些这些问题。基本问题是，如果您有一个很长的文档或涉及长时间计算的文档，那么每次您想要 刷新 您的文档时，您都需要重新编译它，这意味着您需要重新运行所有的计算。如果您的文档效率高或体积小，这可能不是问题。然而，每次都等待每个计算运行可能效率低下。块缓存是避免这些长时间计算的一种方法。通过设置 cache = TRUE 块选项，knitr 会运行一次块并将输出存储在您的当前工作目录中。当您 重新编织 文档时，knitr 将重新加载存储的输出。如果块中的代码有任何变化，knitr 会检测到并重新运行代码，存储更新的结果。

缓存有一些注意事项。特别是，默认情况下，不会检查块之间的依赖关系。如果一个缓存的块的结果依赖于已经被修改的先前块，那么这些更改不一定能传播到后续的缓存块。此外，具有显著副作用（如向文件写入输出或以任何方式与外部环境交互）的块可能无法缓存。只要您对这些方面小心谨慎，就不应该有任何问题。

使用 knitr 生成最终输出

一旦您完成了文档或准备好查看其下一个迭代版本，如果您使用 R Studio，您可以在其中编译，或者通过执行触发编译的代码。我们将展示后者，因为它更通用，可以供不一定是使用 R Studio 的人使用。您只需执行以下行，将文件名 "document.Rmd" 替换为您自己的，并选择适当的输出：

library(rmarkdown)
outputs <- c("html_document", "pdf_document")
render("document.Rmd", outputs)

我们建议您创建一个名为 compile.R 的文件，其中包含这些行，并在每次您想要重新编译您的文档时执行它。以下输出是可用的：

字符串	输出
html_document	HTML 文档
pdf_document	PDF 文档
word_document	Word 文档
10slides_presentation	HTML 演示文稿，类型 1
slidy_presentation	HTML 演示文稿，类型 2
beamer_presentation	Beamer (LaTeX) PDF 演示文稿

到目前为止，您应该能够创建自己的演示文稿。在接下来的章节中，我们将开始构建为 The Food Factory 示例实际开发的演示文稿。

正常开发图表和分析

正如你在前面的章节中看到的，你可以直接使用我们的 R Markdown 文件进行演示（在我们的案例中是presentation.Rmd）。然而，如果你首先像通常使用 R 一样开发演示内容，利用你可能习惯的任何配置和工具，你会更加高效。当代码最终确定后，你只需将必要的部分翻译成 R Markdown 文件。尽管这看起来似乎反直觉，因为这样会多做一些工作，但实际上这样做会更快，因为你比使用 R Markdown 更习惯于使用 R，你将考虑产生模块化代码，这些代码可以插入到你的演示中。这允许你产生更高质量和可重用的代码。这正是我们将要做的。我们将从我们常用的main.R和functions.R文件开始，开发我们需要的内容。然后，在后面的章节中，我们将把代码迁移到我们的presentation.Rmd文件中。

由于我们想要展示我们在过去几章中开发的分析，我们不应该重写代码，因此我们将从第四章，模拟销售数据和与数据库协同工作中恢复一些内容，以及我们为食品工厂模拟的数据：

source("../../chapter-05/functions.R")
all_time <- readRDS("../../chapter-04/results/sales.rds")

注意，使用我们使用的source()函数，将第五章，通过可视化沟通销售中的所有函数加载到内存中。这可能是你真正需要的，也可能不是，如果你不小心，你可能会在这样做时覆盖一个函数定义。在这种情况下，这不是一个问题，所以我们将保持原样。如果这是一个问题，我们总是可以将所需的函数移动到自己的文件中，然后只source那个文件。我们感兴趣的函数如下：

filter_n_days_back <- function(data, n) {
    if (is.null(n)) {
        return(data)
    }
    n_days_back <- Sys.Date() - n
    return(data[data[, "DATE"] >= n_days_back, ])
}

假设自从你第一次模拟数据以来已经过去很长时间了。如果你执行一个像filter_n_days_back(data, 7)这样的函数调用，你不能保证有上周的数据，你很可能会因为n_days_back <- Sys.Date() - n包含从今天往回推 7 天的数据，而不是数据中最后记录的日期，而得到一个空的结果。这是一个问题。

如何处理这些情况可能会让你与同事进行长时间的辩论。一般来说，我们有两种选择：重写一个独立的函数，或者修复我们已有的代码。正确的答案将取决于你的具体情况和背景，两者都有其优点和缺点。一般来说，当你编写一个新函数时，你可以确信你的代码是正确的，你没有意外地破坏依赖于先前版本的别人的代码。缺点是，你将不得不维护更多的代码，而功能增长却不多，随着时间的推移，这可能会变得非常痛苦。还记得我们之前提到的 DRY 原则吗？不要重复自己（DRY）。如果你决定修复当前版本的代码，你可能会得到一个更健壮的代码库，你可以将其用于更多你最初没有预料到的情况，而无需增加太多（有时甚至减少）需要维护的代码。然而，也存在这样的可能性，即你破坏了依赖于先前功能的代码，当你意识到这一点时，修复起来可能会非常棘手。

在处理这些类型的情况时，有两个基本的原则可以帮你避免严重的头痛。我们在整本书中一直在使用其中一个：开发小型和模块化的代码。通过“小型”，我们指的是遵循第一章中提到的单一职责原则的代码，R 语言简介。当你这样做时，一些神奇的事情会发生；你开始将代码插入到其他代码中，你可以轻松地修改这些插件，并在需要时创建新的插件，而不会遇到太多麻烦。另一个基本的原则是给你的代码编写单元测试。简单来说，单元测试是设计用来测试其他代码是否按预期执行的代码片段。单元测试超出了本书的范围，但如果你还不了解，这绝对是一件事你应该去学习的。

回到这个特定示例的代码，我们选择修复我们已有的代码。为了确保我们不会意外地破坏依赖于这个函数的其他代码，我们遵循开闭原则，该原则指出对象应该是可扩展的，但不可修改的（www.cs.duke.edu/courses/fall07/cps108/papers/ocp.pdf）。

基本上，我们将扩展接口而不对其进行修改，这样使用相同的先前输入时输出结果保持不变，但扩展版本将使我们能够获得我们想要的新输出。这听起来比实际情况要复杂得多。正如你所看到的，我们只是添加了一个具有默认值NULL的新可选参数。然后，我们不再使用当前日期来计算n_days_back，而是检查是否发送了任何值；如果发送了，我们就使用那个值作为起点；如果没有，我们就回到旧的行为：

filter_n_days_back <- function(data, n, from_date = NULL) {
    if (is.null(n)) {
        return(data)
    }
    if (is.null(from_date)) {
        from_date <- Sys.Date()
    } else if (is.character(from_date)) {
        from_date <- as.Date(from_date)
    }
    n_days_back <- from_date - n
    return(data[data[, "DATE"] >= n_days_back, ])
}

现在我们有了这个函数的新版本，我们可以实际使用它来通过计算记录中的最大日期来获取数据中的上周，并使用该日期作为我们的from_date参数。此外，请注意，获取本周的数据以及上周的数据是多么容易。然而，为了使这可行，我们需要确保max_date对象是 R 中的Date对象，这样我们就可以从中减去 7 天，它实际上意味着 7 天。如果它是一个字符串而不是日期，我们会得到一个错误。

作为旁注，请注意，如果我们使用的是不断记录的数据，那么“本周”和“上周”将非常有意义，但因为我们使用的是可能很久以前模拟的数据，所以“本周”和“上周”将取决于我们实际使用的数据中的日期。这不是问题，因为我们使用的是数据中的“最大”日期，它将相应地调整每个情况：

max_date <- max(all_time$DATE)
this_week <- filter_n_days_back(all_time, 7, max_date)
last_week <- filter_n_days_back(all_time, 7, max_date - 7)

现在我们已经拥有了所需的三个数据集（all_time、last_week和this_week），我们可以开始开发使用这些数据集创建我们所需图表的代码。首先，我们需要为每个感兴趣变量和每个数据集获取比例表。像往常一样，我们希望将功能不明确的代码封装到自己的函数中，以便我们可以给它命名并快速了解它的用途。在这种情况下，我们创建了proportion_table()函数，它应该是自解释的，并且我们按照说明应用它。请注意，我们乘以100，因为我们想在图表中显示20%而不是0.2：

proportions_table <- function(data, variable) {
    return(prop.table(table(data[, variable])))
}

quantity_all <- proportions_table(all_time, "QUANTITY")
continent_all <- proportions_table(all_time, "CONTINENT")
protein_all <- proportions_table(all_time, "PROTEIN_SOURCE")

quantity_last <- proportions_table(last_week, "QUANTITY")
continent_last <- proportions_table(last_week, "CONTINENT")
protein_last <- proportions_table(last_week, "PROTEIN_SOURCE")

quantity_this <- proportions_table(this_week, "QUANTITY")
continent_this <- proportions_table(this_week, "CONTINENT")
protein_this <- proportions_table(this_week, "PROTEIN_SOURCE")

到目前为止，这些对象中的每一个都应该包含一个表格，显示感兴趣变量中每个类别的百分比。以_all结尾的包含所有记录数据的百分比。同样，以_last和_this结尾的包含上周和本周的百分比。小数点的数量将取决于实际数据和你的配置。在所有情况下，数字的总和应该是 100：

quantity_all
#>     1     2     3     4    5    6    7    8    9
#> 13.22 27.78 26.09 18.29 9.19 3.77 1.29 0.30 0.07 
quantity_last
#>       1       2       3       4      5      6      7      8
#> 12.1387 33.5260 28.3234 12.7160 5.7803 5.7803 1.1560 0.5780

quantity_this
#>  1  2  3  4  5  6  7  8
#> 12 36 25 14  7  4  1  1

仔细的读者应该已经注意到quantity_all包含的类别比quantity_last和quantity_this多一个。这是因为在过去两周的数据中，有九个商品没有销售。这意味着当我们试图比较这些类别中每个类别的计数变化时，由于quantity_all中额外的类别，我们将会遇到问题。我们将通过只保留任何我们使用的表对中共享的类别来处理这个问题。equal_length_data()函数接收这些表中的两个作为data_1和data_2，然后，它计算它们之间的最小长度（ml），并使用它来获取data_1和data_2中到那个点为止的元素。由于此时它们都是表格，我们想要的是其值的数值数组，而不是表格对象，这就是为什么我们应用了as.numeric()。如果我们不这样做，ggplot2将会抱怨不知道如何处理类型为table的对象。通过将as.numeric()函数应用于表格，我们没有丢失类别名称，因为我们是在返回列表的names元素中单独取那些名称。最后，我们想知道是否删除了任何类别，我们可以通过检查任何数据表的长度的类别数是否少于ml数字所指示的数量来知道这一点。如果是这样，deleted将会是TRUE并且会被发送，否则将是FALSE：

equal_length_data <- function(data_1, data_2) {
    ml <- min(length(data_1), length(data_2))
    return(list(
        names = names(data_1[1:ml]),
        data_1 = as.numeric(data_1[1:ml]),
        data_2 = as.numeric(data_2[1:ml]),
        deleted = ml != length(data_1) || ml != length(data_2))
    )
}

现在，我们能够访问具有相等长度的数据，相应的类别名称，以及一个布尔值，指示是否删除了任何类别。我们可以如下使用这个对象：

parts <- equal_length_data(quantity_all, quantity_this)

parts$names
#> [1] "1" "2" "3" "4" "5" "6" "7" "8"

parts$data_1
#> [1] 0.1322 0.2778 0.2609 0.1829 0.0919 0.0377 0.0129 0.0030

parts$data_2
#> [1] 0.12 0.36 0.25 0.14 0.07 0.04 0.01 0.01

parts$deleted
#> [1] TRUE

现在，我们将专注于为我们的图表准备数据。由于我们将使用ggplot2包，我们知道我们需要创建一个数据框。这个数据框应该包含在Category中的类别名称，两个表匹配类别之间的绝对和百分比差异分别在Difference和Percent中，以及根据绝对差异是正还是负的Sign和Color，以及分别在Before和After中的before和after数据。请注意，parts的计算顺序对于绝对和百分比差异很重要，这反过来又影响颜色和符号。我们必须小心地将最新数据作为data_2发送，这样我们就能得到像“与上周相比，本周我们多了 X”这样的解释。否则，解释将会相反：

prepare_data <- function(parts) {
    data <- data.frame("Category" = parts$names)
    data$Difference <- parts$data_2 - parts$data_1
    data$Percent <- (parts$data_2 - parts$data_1) / parts$data_1 * 100
    data$Sign <- ifelse(data$Difference >= 0, "Positive", "Negative")
    data$Color <- ifelse(data$Difference &gt;= 0, GREEN, RED)
    data$Before <- parts$data_1
    data$After <- parts$data_2
    return(data)
}

我们将使用十六进制表示法定义两种颜色，这样我们就可以通过名称来调用它们，而不是每次都复制十六进制字符串。稍后，如果我们想更改颜色，我们可以在一个地方更改它们，而不是在它们被使用的地方到处替换：

RED <- "#F44336"
GREEN <- "#4CAF50"

如果你阅读了第五章，通过可视化进行销售沟通，difference_bars()函数应该很清晰。正如你所见，我们正在使用前面显示的函数来计算parts和data对象，然后我们使用ggplot2包来开发图表。请注意，如果parts中的deleted布尔值为TRUE，我们只添加一个包含指示某些类别已被删除的副标题：

difference_bars <- function(data_1, data_2, before, after) {
    parts <- equal_length_data(data_1, data_2)
    data <- prepare_data(parts)
    p <- ggplot(data, aes(Category, Difference, fill = Sign))
    p <- p + geom_bar(stat = "identity", width = 0.5)
    p <- p + scale_fill_manual(values = 
    c("Positive" = GREEN, "Negative" = RED))
    p <- p + theme(legend.position = "none", 
    text = element_text(size = 14))
    p <- p + scale_y_continuous(labels = scales::percent)
    p <- p + labs(title = paste(before, "vs", after))
    p <- p + labs(x = "", y = "")
    if (parts$deleted) {
        p <- p + labs(subtitle = 
            "(Extra categories have been deleted)")
    }
    return(p)
}

现在，我们可以创建一些有用的图表，如下所示。请记住，y轴上的值并不表示百分比增长，而是百分比点的变化。这可以通过查看代码立即理解，但在查看图表时并不明显。实际上，我们可能需要在实际演示中包含一些解释：

difference_bars(quantity_all, quantity_this, "This week", "All-time")
difference_bars(continent_all, continent_this, "This week", "All-time")
difference_bars(protein_all, protein_this, "This week", "All-time")

结果图表如下所示：

我们想要开发的第二种图表类型稍微复杂一些。我们将在x轴上的 1 和 2 处创建垂直线，放置文本标签以指示每个类别的百分比在before和after数据集中在哪里，以及中间的变化百分比。首先，我们创建与之前相同的data对象。接下来，我们创建我们将用于每个类别的标签。左侧的是before_labels，中间的是percent_labels，右侧的是after_labels。

percent_y包含 y 轴上percent_labels将被放置的值。x轴的值固定为 1.5，以便它在两条垂直线之间。为了计算percent_y值，我们想要得到每个类别的前后值之间的最小值，并加上它们之间差异的一半。这将确保该值位于连接这两个值的线的中点。

现在，我们准备开始使用ggplot2包。首先，我们像平常一样定义数据，并为每个类别添加一个连接before和after值的段落，从$(1, Before)$元组开始，到$(2, After)$元组结束，其中每个元组的形式为$(x, y)$。我们将使用Sign变量作为条形的填充颜色，并避免显示图例，因为我们自己将显示一些标签。我们将使用*scale_color_manual()*函数来指定根据绝对差异是正还是负而应使用的颜色。

接下来是垂直线，它们是通过geom_vline()函数创建的。如前所述，它们将放置在x轴上的 1 和 2 的位置。我们将使线条为虚线以改善美观，并使用比我们之前创建的段落线条更小的尺寸。

接下来，我们将使用geom_text()函数放置标签。我们开始为每个垂直线创建标签，这些线位于 0.7 和 2.3 x轴值，以及略微增加的之前和之后值的最大值。然后，我们使用geom_text_repel()函数在左侧、中心和右侧放置类别的标签。这个函数不包括在ggplot2包中，实际上它是它的一个扩展。它被设计用来排斥（因此得名）相互重叠的标签。为了做到这一点，函数将标签从点的位置移开，并绘制一条线来指示哪个标签属于每个点。你可以在它的网站上找到很好的例子（cran.r-project.org/web/packages/ggrepel/vignettes/ggrepel.html）。在我们的情况下，我们使用segment.color = NA参数移除这条线，并指示调整的方向仅沿y轴。

实际上，很难有人第一次就能想出所有这些代码，我们的情况也不例外。我们从一个小的图表开始，通过迭代实验不断添加我们需要的元素。特别是，我们意识到一些标签相互重叠，这看起来并不好，所以我们决定使用geom_text_repl()包，这是我们之前不知道的，但很容易在网上找到，因为很多人都有同样的问题，幸运的是有人为这个问题开发了解决方案。

x_adjustment参数是类似实验的结果。我们意识到，不同图表的标签根据类别名称中的字符数不同，会重叠在垂直线上。为了解决这个问题，我们决定引入一个新的参数，它可以调整 x 轴上的位置，我们可以通过实验找到适合它的参数。所有这些都是在说，你应该利用 R 的快速实验周期，迭代地产生你想要的结果。

最后，我们从 x 轴和 y 轴上移除任何文本，并限制它们的值范围，因为它们对于读取图表和提供更清晰的视觉效果是不必要的。你可能需要一点实验来理解代码的每一部分到底在做什么，这是完全可以接受的，你绝对应该这样做：

change_lines <- function(data_1, data_2, before, after, x_adjustment) {
    parts <- equal_length_data(data_1, data_2)
    data <- prepare_data(parts)
    percent_labels <- paste(round(data$Percent, 2), "%", sep = "")
    before_labels <- paste(
        data$Category, " (", round(data$Before, 2), "%)", sep = "")
    after_labels <- paste(
        data$Category, " (", round(data$After, 2), "%)", sep = "")
    percent_y <- (
        apply(data[, c("Before", "After")], 1, min) +
        abs(data$Before - data$After) / 2
    )

    p <- ggplot(data)
    p <- p + geom_segment(
        aes(x = 1, xend = 2, y = Before, yend = After, col = Sign), 
        show.legend = FALSE, 
        size = 1.5)

    p <- p + scale_color_manual(
        values = c("Positive" = GREEN, "Negative" = RED))

    p <- p + geom_vline(xintercept = 1, linetype = "dashed", size = 0.8)
    p <- p + geom_vline(xintercept = 2, linetype = "dashed", size = 0.8)
    p <- p + geom_text(
        label = before, 
        x = 0.7, 
        y = 1.1 * max(data$Before, data$After), 
        size = 7)

    p <- p + geom_text(
        label = after, 
        x = 2.3, 
        y = 1.1 * max(data$Before, data$After), 
        size = 7)

    p <- p + geom_text_repel(
        label = before_labels, 
        x = rep(1 - x_adjustment, nrow(data)), 
        y = data$Before, size = 5, direction = "y", 
        segment.color = NA)

    p <- p + geom_text_repel( label = after_labels, 
        x = rep(2 + x_adjustment, nrow(data)), 
        y = data$After, size = 5, 
        direction = "y", 
        segment.color = NA)

    p <- p + geom_text_repel(label = percent_labels, 
        x = rep(1.5, nrow(data)), 
        y = percent_y, col = data$Color, size = 5, 
        direction = "y", 
        segment.color = NA)

    p <- p + theme(
        axis.ticks = element_blank(),
        axis.text.x = element_blank(),
        axis.text.y = element_blank()
    )

    p <- p + ylim(0, (1.1 * max(data$Before, data$After)))
    p <- p + labs(x = "", y = "")
    p <- p + xlim(0.5, 2.5)
    return(p)
}

现在，我们可以使用以下代码展示一些非常有用且看起来很棒的图表：

change_lines(quantity_last, quantity_this, "This week", "Last week", 0.2)
change_lines(continent_last, continent_this, "This week", "Last week", 0.3)
change_lines(protein_last, protein_this, "This week", "Last week", 0.5)

这些图表很容易解释，并且似乎不像我们之前提到的对于前一个图表的x轴百分比单位问题那样容易受到影响。你可以很容易地看出一个类别在各个时期中百分比是增加还是减少，以及增加了多少百分比。记住，在解释all-time的图表时，它们也包含了本周的数据。实际上，这对你特定的用例可能是正确也可能是错误的。

使用 R Markdown 构建我们的演示文稿

在本节中，我们将开发我们的演示文稿的 R Markdown 文件。我们创建一个名为 presentation.R 的空文件，并在其中放置以下标题。除非您想在标题中包含冒号，否则不需要引号。正如前一个章节所示，使用反引号（“ ”），我们可以执行 R 代码。在这种情况下，我们将当前日期自动放在首页。最后，我们选择了 ioslides_presentation 作为输出格式。您可以自由尝试之前显示的其他输出格式：

---
title:  "The Food Factory"
author: "Weekly Update"
date:   "`r Sys.Date()`"
output: ioslides_presentation
---

以下代码设置了演示文稿中 代码块 的默认配置。我们通过 echo = FALSE 来避免在演示文稿中显示代码，并使每张图片都全宽，除非有其他说明使用 out.width = '100%'：

```{r setup, include=FALSE}

knitr::opts_chunk$set(echo = FALSE, out.width = '100%')

```py

现在，我们需要将我们演示文稿所需的所有资源整合起来。具体来说，我们需要加载我们在过去三章中开发的函数。加载 sales 和 client_messages 数据，并应用我们在前几章中看到的相同转换来设置数据。请注意，在本章中，我们将销售数据引用为 all_time 而不是 sales，为了避免更改我们的代码，以便我们仍然可以轻松地引用我们的开发文件，我们只是简单地将 sales 对象复制到 all_time 对象中。如果您系统内存限制较严格，请在此过程中小心操作：

```{r load-functions-and-data, include=FALSE}

source("../functions.R")

source("../../chapter-05/functions.R")

source ("../../chapter-06/functions.R")

sales           <- readRDS("../../chapter-04/results/sales.rds")

client_messages <- readRDS("../../chapter-04/results/client_messages.rds")

sales           <- add_profits(sales)

all_time  <- sales

max_date  <- max(all_time$DATE)

this_week <- filter_n_days_back(all_time, 7, max_date)

last_week <- filter_n_days_back(all_time, 7, max_date - 7)

quantity_all   <- proportions_table(all_time, "QUANTITY")

continent_all  <- proportions_table(all_time, "CONTINENT")

protein_all    <- proportions_table(all_time, "PROTEIN_SOURCE")

quantity_last  <- proportions_table(last_week, "QUANTITY")

continent_last <- proportions_table(last_week, "CONTINENT")

protein_last   <- proportions_table(last_week, "PROTEIN_SOURCE")

quantity_this  <- proportions_table(this_week, "QUANTITY")

continent_this <- proportions_table(this_week, "CONTINENT")

protein_this   <- proportions_table(this_week, "PROTEIN_SOURCE")

```py

现在我们已经设置了资源，我们可以着手编写将在演示文稿中展示分析的代码。我们首先使用本章先前开发的函数来展示使用条形图和折线图的变化。请注意，我们在每种情况下都指定了条形图和折线图的不同高度。另外请注意，我们使用 50%的宽度来绘制折线图。这是因为我们希望它们在幻灯片中垂直显示。50%的宽度和 10 的高度实现了这种分布。

在现实中，你可能希望为每一张幻灯片选择更好的标题，但在这个例子中我们将保持标题的明显性。请注意，以这种方式工作，我们避免在幻灯片中放置任何逻辑代码，通过简单地阅读函数标题，我们就能确切知道将要展示什么。这让你可以轻松地移动内容，而不会因为代码片段之间的依赖关系而破坏结构，因为我们已经将它们抽象成单独的文件。如果你在演示文稿文件中填充了 R 逻辑，当你需要更改它们时，你会发现非常混乱。最好将这些逻辑放在实际的.R文件中，就像我们在functions.R文件中所做的那样。更不用说，这样也更容易重用：

## Changes in quantity (1/2)

```{r quantity-bars, fig.height = 2.5}

difference_bars_absolute(quantity_last, quantity_this, "This week", "Last week")

difference_bars_absolute(quantity_all, quantity_this, "This week", "All-time")

```py

## Changes in quantity (2/2)

```{r quantity-lines, out.width = '50%', fig.height = 10}

change_lines(quantity_last, quantity_this, "This week", "Last week", 0.2)

change_lines(quantity_all, quantity_this, "This week", "All-time", 0.2)

```py

## Changes in continent (1/2)

```{r continent-bars, fig.height = 2.5}

difference_bars_absolute(continent_last, continent_this, "This week", "Last week")

difference_bars_absolute(continent_all, continent_this, "This week", "All-time")

```py

## Changes in continent (2/2)

```{r continent-lines, out.width = '50%', fig.height = 10}

change_lines(continent_last, continent_this, "This week", "Last week", 0.3)

change_lines(continent_all, continent_this, "This week", "All-time", 0.3)

```py

## Changes in protein source (1/2)

```{r protein-source-bars, fig.height = 2.5}

difference_bars_absolute(protein_last, protein_this, "This week", "Last week")

difference_bars_absolute(protein_all, protein_this, "This week", "All-time")

```py

## Changes in protein source (2/2)

```{r protein-source-lines, out.width = '50%', fig.height = 10}

change_lines(protein_last, protein_this, "This week", "Last week", 0.5)

change_lines(protein_all, protein_this, "This week", "All-time", 0.5)

```py

现在，我们将向之前章节中开发的代码中添加函数调用。正如你所见，这个过程完全相同，因为我们已经在这个load-functions-and-data代码块中加载了这些资源。我们实际上只需要调用为我们生成图表的函数。如果你记不起这些函数的作用，我们建议回到它们对应的章节，回顾它们是如何创建的细节。

如您所见，最后一张幻灯片中的代码块调用了graph_client_messages_interactive()函数，该函数生成了可以在第五章“使用可视化进行销售沟通”中移动的交互式地图。以这种方式创建演示文稿的一个好处是，你实际上可以在演示文稿中玩弄地图！当然，这仅在你使用支持在浏览器中可视化的输出格式时才有效（例如，它不适用于 PDF 或 Word 文档），但如果你使用浏览器进行可视化，这可以是一个向演示文稿添加强大内容的绝佳方式：

## Profit ratio vs continent

```{r sales-proft-ratio-by-continent-and-protein-source }

graph_bars(sales, "CONTINENT", "PROFIT_RATIO", "PROTEIN_SOURCE")

```py

## Cost vs price

```{r price-vs-cost}

graph_marginal_distributions(sales, "COST", "PRICE", "PROTEIN_SOURCE", "CONTINENT")

```py

## Price vs profit

```{r price-vs-profit-ratio}

graph_marginal_distributions(sales, "PRICE", "PROFIT_RATIO", "PROTEIN_SOURCE", "CONTINENT")

```py
## Historic pricing

```{r date-vs-frequency-profit-and-profit-ratio, fig.height = 1.8}

graph_last_n_days(sales, 30, color = "PROTEIN_SOURCE")

graph_last_n_days(sales, 30, "PROFIT", "PROTEIN_SOURCE")

graph_last_n_days(sales, 30, "PROFIT_RATIO", "PROTEIN_SOURCE")

```py

## Top 5 customers' preferences

```{r top-customers-preferences}

subset <- filter_data(sales, 30, 5, "CLIENT_ID")

graph_radar(subset, "CLIENT_ID")

```py

## Customer messages geolocations

```{r customers-dynamic-map}

graph_client_messages_interactive(client_messages, sales)

```py

最后，我们希望使用实际的实时 Twitter 数据来展示最新的推文。由于在本例中提到的 The Food Factory 公司是虚构的，我们无法真正获取其数据，但我们将仍然搜索 Twitter 中的The Food Factory短语，并展示我们得到的排名前 5 的结果。实际上，你可以检索提到你感兴趣特定账户的推文，并在查询过程中更加富有创意。为了本例的简单起见，我们将保持操作简单。

我们必须做的第一件事，如第六章“通过文本分析理解评论”中所示，是使用 Twitter 的 API 来识别自己，以便我们可以检索数据。如果你不记得如何操作，请查看该章节。由于我们想要执行这段代码，但又不想展示它或其输出，我们简单地应用了include = FALSE选项。请注意，我们保持幻灯片标题在认证代码的顶部，作为我们自己的一个标记，表明此代码属于此幻灯片的逻辑：

## Latest messages from Twitter

```{r twitter-setup, include = FALSE}

consumer_key    <- "b9SGfRpz4b1rnHFtN2HtiQ9xl"

consumer_secret <- "YMifSUmCJ4dlgB8RVxKRNcTLQw7Y4IBwDwBRkdz2Va1vcQjOP0"

access_token    <- "171370802-RTl4RBpMDaSFdVf5q9xrSWQKxtae4Wi3y76Ka4Lz"

access_secret   <- "dHfbMtmpeA2QdOH5cYPXO5b4hF8Nj6LjxELfOMSwHoUB8"

setup_twitter_oauth(consumer_key, consumer_secret, access_token, access_secret)

```py

接下来，我们放入另一个实际生成我们想在幻灯片中展示的输出的 代码块。我们正在使用上一章中创建的 get_twitter_data() 从推特获取数据，并将其通过我们将要展示的 format_tweets() 函数传递：

```{r twitter-live-data, size = "footnotesize", comment = ""}

format_tweets(get_twitter_data("The Food Factory", 5))

```py

这个 format_tweets() 函数是必要的，以便打印我们在幻灯片中想要展示的数据。如果你记得，我们从 get_twitter_data() 函数获取的数据包含每条推文周围的大量元数据，这在分析时非常有用，但在这个幻灯片中，我们更愿意只展示发推者的屏幕名、推文的日期和时间戳以及实际的推文内容。我们还需要截断推文的长度，以确保它在演示中看起来不错。即使这是一个小的函数，如果你之前没有见过这些函数，代码可能会有些复杂，所以我们将一步一步地进行。

format_tweets() 函数接收一个单一参数，即我们从 get_twitter_data() 函数获取的数据，我们知道该数据结构包含我们感兴趣的 created、text 和 screenName 变量。由于这是向量化的代码，我们不需要使用循环来独立打印每条推文。我们可以直接使用值数组。如果你不记得向量化代码是什么，你可以在第一章，“R 语言简介”中复习它：

format_tweets <- function(data) {
    write(paste(
        data$screenName, " (", data$created, "): \n",
        iconv(enc2utf8(substr(data$text, 1, 65)), sub = ""),
        "(...) \n", sep = ""
    ), stdout())
}

你可能首先注意到我们没有使用 print() 函数。我们使用 write() 函数传递 stdout() 函数调用。这意味着我们将 写入 一个对象到标准输出。你可以把它想象成一个 简单的 print() 函数调用，其中 R 不会为我们做任何处理，而只是显示我们告诉它的内容。这样做可以避免使用 print 函数时通常得到的编号行。记得之前代码输出开头的那 [1], [2], ... 吗？这个 write(..., stdout()) 技巧避免了它们。你通常不希望这样，但在这个特定情况下，它对美观目的很有用。

接下来，我们使用 paste() 函数，就像我们之前做的那样，将我们想要打印的所有内容组合在一起。在这种情况下，我们以屏幕名称开始，然后是包含时间戳（位于 data$created 中）的括号，然后是一个表示 换行 的组合。当 \n 组合在 write() 函数中使用时，它会告诉 R 在该点实际引入一个新行，就像你按下了 回车 键（键盘上的 Enter 键）。接下来，我们将实际的推文（data$text）传递给 substr() 函数，以便我们可以获取第 1 到 65 个字符。这样做是为了美观，因为我们不希望很长的推文占用超过一行。该输出被发送到 enc2utf8() 函数，该函数将字符串的编码设置为 UTF-8，然后通过带有 sub = "" 参数的 iconv() 函数传递此输出，这将删除任何不可转换的字符。最后，我们添加一个 "(...) \n" 字符串来显示推文可能被截断，并添加另一个 换行 符号。

当使用 iconv() 函数时，它会逐个尝试转换字符，每当它无法转换一个字符时，就会用我们发送的 sub 字符串来替换它。我们需要这样做，因为我们可能从像中文或阿拉伯语这样的语言中获取字符，其输出将包含一个对不熟悉这些类型编码问题的人没有意义的 Unicode 表示。我们试图产生一个用户友好的展示。

如果你重新编译这个演示文稿，你从 Twitter 获取的消息将不同于这里显示的，因为它们将在那一刻被检索。

现在，你可以使用前面提到的方法中的任何一种来编译你的演示文稿，如果一切顺利，你应该会在你的目录中看到一个 presentation.html 文件。如果你在网页浏览器中打开该文件，你应该会看到类似于以下所示的幻灯片。你也可以直接打开这个书的存储库中的实时演示文稿。记住要尝试与交互式地图互动！

Session info ------------------------------------------------------
setting value
version R version 3.4.2 (2017-09-28)
system x86_64, linux-gnu
ui X11
language (EN)
collate en_US.UTF-8
tz America/Mexico_City
date 2017-10-30

Packages --------------------------------------------------------
package * version date source
assertthat 0.2.0 2017-04-11 CRAN (R 3.3.2)
base * 3.4.2 2017-10-28 local
base64enc 0.1-3 2015-07-28 CRAN (R 3.3.2)
bindr 0.1 2016-11-13 CRAN (R 3.3.2)
[... truncated ...]

摘要

在本章中，我们讨论了自动化任务以及内容创建的好处。我们展示了如何集成内容创建的自动化管道，如何编写提供动态内容的 R Markdown 文档，以及如何使用这些文档制作看起来不错且高效的文档和演示文稿。我们展示了如何集成各种 R 资源来创建可以自动更新的内容。

如果你想要开发更技术性或篇幅较长的文档，bookdown 包可能是一个不错的选择。它的目的是通过 R Markdown 使创建长篇文档，如书籍，变得更加容易。实际上，这本书就是使用 bookdown 编写的，整个过程非常愉快。

在下一章中，我们将开始一个新的示例，专注于评估加密货币交易。我们将首先构建一个面向对象的系统，模拟交易平台并自动评估交易者的表现。之后，我们将向您展示如何通过并行化和委托来使我们的算法运行得更快，最后，在最后一章中，我们将向您展示如何从 R 中创建包含交互式仪表板的网页。

第八章：用于跟踪加密货币的面向对象系统

在本章节中，我们将介绍一种在本书中之前未曾明确使用过的编程方式。这种方式被称为面向对象编程，并且将在本书的第三个也是最后一个示例中贯穿使用。面向对象编程在程序员中非常流行，它主要用于允许以不危及系统演变的方式对复杂的抽象关系进行建模和实现。

在开发面向对象系统时，以及在一般编程中，我们应该追求简单性，但这并不自然。当处理复杂领域时，创建复杂的代码比创建简单的代码更容易。程序员必须积极努力地编写简单的代码，因为简单性主要取决于程序员，而不是语言。在本章节中，我们将通过介绍支持它的思想和概念，向您展示如何高效地处理面向对象代码，并且我们将在后面通过使用 R 中最常用的三个对象模型来展示如何实现它。

R 有多种对象模型，或者说面向对象系统，因此一开始可能会有些令人畏惧。本章节的目标不是让你成为面向对象编程或 R 的每个对象模型方面的专家，而是帮助你理解如何使用 R 的不同对象模型来实现面向对象程序的基本构建块。

本章节涵盖的一些重要主题包括：

• 基本面向对象编程概念

• 面向对象系统的设计和架构

• 通过泛型函数实现的 R 的参数多态性

• 可用于 R 的不同对象模型

• 混合 R 不同对象模型的功能

本章节所需包

本章节将利用methods和R6包来加载 S4 和 R6 对象模型的功能。你应该知道，交互式 R 会话默认加载methods，但非交互式会话则不会，因此在这种情况下你需要显式地加载它。jsonlite和lubridate包被引入以简化一些常见任务，例如从 JSON API 获取数据和转换日期。更多信息，请参阅附录，所需包。

包	原因
R6	R6 对象模型
methods	S4 对象模型
lubridate	简易转换日期
jsonlite	从 JSON API 检索数据

加密货币示例

加密货币是一种设计为交换媒介的数字货币。加密货币使用密码学来保护和验证交易，以及控制新单位的创建。简单来说，加密货币是公共和分布式数据库中的条目，只能通过算法共识来更改，并且它们消除了交易处理和货币发行的第三方信任需求。这个概念与文件共享的 P2P 网络非常相似，上面还有一个算法货币政策。如果您想了解更多关于加密货币的信息，您绝对应该看看 Andreas Antonopoulos 的视频。他可以使非常复杂的概念变得非常容易理解。您还可能想阅读他在 2016 年出版的《金钱互联网》一书中对会议的回忆，该书由Merkle Bloom LLC出版。

加密货币目前正在得到大力开发，以提供许多创新功能，这些功能将在未来几年产生颠覆性影响，但到目前为止，它们主要用于购买商品和投资。每一笔交易都包括转帐的币数，以及发送者和接收者的公钥，也称为钱包地址。在本章的示例中，我们将使用这些公钥来跟踪我们拥有的币数，并且我们还将使用 CoinMarketCap API (coinmarketcap.com/)来跟踪加密货币的价格。

由于这将是一个复杂的系统，我们将使用面向对象编程来模块化它，并逐步构建。在示例的最后，我们将拥有一个可以开启以开始跟踪我们的加密货币资产及其价格，并将实时数据保存到磁盘以供以后分析的系统。稍后，在第九章实现高效的简单移动平均中，我们将使用这些数据（以模拟形式），来开发各种简单移动平均（SMA）的实现，以展示如何改进 R 代码使其更快，以及更易于阅读。最后，在第十章通过仪表板添加交互性中，我们将看到如何创建一个现代网络应用程序来展示开发的 SMAs 以及收集到的数据。

面向对象编程简介

作为统计学家和数据科学家，我们努力构建能够产生有价值见解的系统。为了实现这一目标，我们通常使用两种工具——数学和计算机。这本书是为那些对数学方面感到舒适但认为他们的 R 编程技能需要提高的人编写的。

通常，当具有数学背景的人接触到编程时，他们是通过一种函数式方法来接触的，这意味着他们从具有输入和输出的算法的角度思考，这些算法作为函数实现。如果你来自数学背景并且不处理高级抽象，这种方式是直观的，并且这是我们到目前为止在整本书中一直在使用的方式。

本章将展示一种不同的编程方式，称为面向对象编程。面向对象编程和对象模型是许多领域的强大且统一的理念，并且可以在大多数流行的编程语言中找到，R 语言也不例外。根据我的经验，那些没有意识到面向对象编程经验的人通常一开始会感到困惑，并且不理解它的潜力。他们认为这更像是一种麻烦，而不是一种助力，并认为它在尝试编写代码时会阻碍他们。在本章中，我们将尝试以一种对那些习惯于函数式方法（不一定是函数式编程）的人来说可理解的方式提炼面向对象范式，并展示如何实现一个从加密货币市场和钱包中持续检索实时数据的小型面向对象系统。

在我们开始实现这样一个系统之前，我们需要介绍将在整个示例中使用的概念，包括即将到来的两个章节。在接下来的段落中，你将找到关于面向对象编程背后的概念的一般描述，以及旨在说服你这种编程方式对于某些问题来说可以非常强大的解释。为了获得更全面和正式的介绍，你应该阅读 Booch、Maksimchuck、Engle、Young、Conallen 和 Houston 合著的出色书籍，书名为《面向对象分析与设计：应用》，由 Addison-Wesley 出版社于 2007 年出版。

面向对象编程的目的

面向对象编程的主要目的是高效地管理复杂性。这是一种组织代码和数据的方式，使得你可以开发出界限清晰的抽象，并带有受控的依赖关系，以便以受控的方式演进复杂系统。这些抽象被称为对象，它们会根据消息提供行为。它们对其他对象提供的行为被记录在接口中，该接口通过此对象的公共方法实现。对象会从其他对象请求行为，当它们这样做时，它们被认为是依赖于它们的。所有这些对象之间发送的消息以及相关的行为使得面向对象系统变得有用。

在我们继续之前，让我们更详细地解释这些概念。对象是一种抽象形式的存在。例如，整数、汽车、狗、建筑、信用卡和加密货币，都可以是面向对象系统中的对象。对象是对某物的明确概念，我们知道不同种类的对象与它们相关的不同行为，其中一些行为需要一些数据，这些数据通常存储在对象内部。

例如，整数的概念并不与任何特定的数字相关联，就像汽车的概念并不与任何特定的型号或品牌相关联。对于那些熟悉统计学的人来说，可以将随机变量视为一个对象，而该随机变量的一个实现就是一个实例。

面向对象编程是一种将程序视为对象之间交互的方式，而不是通过算法步骤。你仍然可以将面向对象系统视为一个包含大量相互调用的函数的大算法，但对于足够大的系统来说，这不会是一个富有成效或令人愉快的进程。在处理面向对象系统时，你最好只是尝试理解系统的一部分，并清楚地定义它应该如何与其他部分通信。试图完全理解一个复杂的面向对象系统可能会相当具有挑战性。

面向对象语言背后的重要概念

在面向对象语言中实现对象模型有许多方法，而这些具体实现方式意味着语言具有不同的属性集。其中一些属性包括封装、多态、泛型（参数多态）、层次结构（继承和组合）、子类型以及一些其他属性。它们是强大、高级的概念，具有精确的定义，并规定了语言应该如何表现。现在不必过于担心它们；随着我们前进，我们将解释必要的概念。

一个有趣的练习是寻找那些被认为是面向对象的，但又不使用一个或多个这些属性的语言。例如，类概念是不必要的，就像在基于原型的语言如 JavaScript 中看到的那样。子类型也是不必要的，因为在动态类型语言如 R 或 Python 中它没有意义。我们可以继续列举，但你的想法已经很明确了——一个具有所有这些属性的语言是不存在的。此外，所有面向对象语言中唯一共有的属性是多态。这就是为什么人们常说多态是面向对象编程的本质。

任何专业的面向对象程序员都应该理解这些属性，并且应该有使用实现这些属性的语言的正式经验。然而，在接下来的段落中，我们将以 R 的不同对象模型为例，给出这些最常见属性的高层次解释——封装、多态（带和不带泛型）以及层次结构。

封装

封装是关于隐藏对象内部信息以防止其他对象访问。正如 C++语言的创造者 Bjarne Stroustrup 所说，封装隐藏信息不是为了方便欺诈，而是为了防止错误。通过给其他对象提供它们可以向对象发送的最小消息目录（公共方法），我们帮助他们犯更少的错误，避免参与与他们无关的任务。这反过来又帮助对象与其自身解耦，并在对象内部提供内聚性。

封装的一个常见理解方式就像你去餐厅时——你通过服务员传达你的需求，然后服务员将你要求的烹饪任务委托给餐厅的大厨。你无需进入餐厅的厨房告诉厨师如何烹饪你的餐点，如果厨师想要改变烹饪某道菜的方式，她可以这样做而不需要你知道。对于对象来说，它们也不应该进入另一个对象并告诉它如何完成其工作。这听起来很简单，但在实践中，很容易违反这个原则。当我们到达本章后面的迪米特法则部分时，我们会更多地讨论这一点。从技术上讲，将接口与实现分离的过程被称为封装。

多态

多态可能是面向对象编程语言中最强大的功能，仅次于它们对抽象的支持，并且它是将面向对象编程与传统使用抽象数据类型编程区分开来的关键。多态字面上意味着多种形式，这正是它在面向对象编程中使用的。同一个名字在不同的上下文中会有不同的含义，就像我们的自然语言一样。这允许实现更干净、更易于理解的抽象以及代码。

大体来说，多态可以通过两种不同的方式实现：从对象内部或从对象外部。当它从对象内部实现时，每个对象都必须提供一个定义，说明它将如何处理给定的消息。这是最常见的方法，你可以在 Java 或 Python 中找到它。R 在这方面非常特殊，它实现了外部方法，正式称为泛型或参数多态。这种编程方式可能会让只使用内部方法的人感到沮丧，但它可以非常灵活。外部方法允许你为尚未定义且可能永远不会定义的对象类型定义一个通用的方法或函数。Java 和 Python 也可以实现这种类型的多态，但这不是它们的本质，就像 R 也可以实现内部方法，但这也不是它的本质。

层次结构

层次结构可以通过两种方式形成——继承和组合。继承的想法是将新类作为旧类的特殊版本来形成。特殊化的类是子类，更一般的类是超类。这种关系通常被称为is-a类型的关联，因为子类是超类的一种类型。例如，狮子是一种动物，所以动物是超类，狮子是子类。另一种关系称为has-a关系。这意味着一个类包含另一个类的实例。例如，汽车有轮子。我们不会说轮子是汽车的一种类型，所以那里没有继承，但我们会说它们是汽车的一部分，这暗示了组合。

有时候并不清楚应该用继承还是组合来建模关系，在这些情况下，你应该决定使用组合来继续。一般来说，人们认为组合是设计系统的一种更灵活的方式，你应该只在必须建模类的特殊化时使用继承。请注意，当你用组合而不是继承来设计系统时，你的对象承担不同的角色，它们变得更加工具化。这是一件好事，因为你可以轻松地将它们相互连接，并在必要时替换它们，而且通常还会得到更多的小类。

现在你已经理解了面向对象编程背后的某些基本思想，你可能意识到结合这些思想所赋予你的力量。如果你有一个封装行为并且只公开提供其他人正确操作所需的系统，它可以动态地对抽象概念做出正确和具体的行为反应，并允许概念层次结构与其他概念层次结构交互，那么你可以放心，你可以管理相当多的复杂性。

在接下来的段落中，我们将解释一些更贴近实际的概念，这些概念是大多数面向对象系统的基础构建块，并且你需要理解这些概念才能理解我们将为示例开发的代码。

类和构造函数

对象必须以某种方式定义，以便我们可以从中生成特定的实例。提供这些定义最常见的方式是通过类。类是一段代码，它提供了对象的定义，包括它对其他对象消息的响应行为，以及提供该行为所需的内部数据。类的行为在其方法中实现。更多内容将在下一节中介绍。

类必须在某个时候创建，这就是构造函数发挥作用的地方。在大多数情况下，当你创建一个类的实例时，你希望它包含一些关于自己的数据。这些数据通过其构造函数在创建时分配给类。具体来说，构造函数是一个函数，其任务是使用一组特定的数据创建类的实例。正如你所知，这些数据应该保存在对象内部，其他对象不应直接与这些数据交互。相反，对象应提供公共方法，其他对象可以使用这些方法获取它们所需的数据或行为。

公共和私有方法

方法是包含在类中的函数，通常它们将是公共的或私有的。通常，方法可以访问类数据（这些数据应该封装起来，远离其他对象），以及它们的公共和私有方法。

公共方法对其他对象可见，应该尽可能稳定，因为其他对象可能会依赖它们。如果你更改它们，可能会意外地破坏另一个对象的功能。私有方法仅对实例本身可见，这意味着其他对象不能（或不应，如 R 的情况）直接调用这些方法。私有方法可以随时更改。

公共方法利用其他方法（无论是公共的还是私有的）来进一步委派行为。这种委派将问题分解成非常小的部分，这些部分易于理解，并且程序员保留根据需要修改私有方法的权利。其他对象不应依赖于它们。

注意，在技术上，R 中只存在公共方法。在 R 的一个对象模型中，你可以隐藏方法，在另一个对象模型中，你可以将它们放在不同的环境中，但这并不意味着它们不可访问，就像其他语言中的私有方法一样。由此，我们也没有涉及受保护方法的概念，这些方法是可见于类及其子类的。

即使在 R 中技术上没有私有方法，我们也会像有私有方法一样编程。没有某种类型的编译器或错误检查机制来告诉你，当你不应该访问私有方法时，这不是一个合理的借口。你应该始终生产高质量的代码，即使语言机制没有明确强制执行。

我们之前所说的意味着你应该尽可能使你的对象保持私有性，以保持它们的内聚性和解耦性，这些是自包含和独立的高级术语。换句话说，尽量减少你的对象中的方法数量。当然，内聚性和解耦性是比仅仅减少私有方法更普遍的概念，但这是一个好的开始。

接口、工厂和一般模式

接口是一个类的一部分，它是公开的，供其他对象使用。具体来说，它是一组关于类公共方法的定义。当然，一个对象拥有的公共方法越多，它对外的责任就越大，灵活性就越小。请注意，接口不提供任何关于实现的细节；它只是一个合同，定义了当调用方法时预期的输入和输出。

有时，你可能希望根据上下文灵活地更改给定任务的对象。你知道，只要你想要交换的对象的接口相同，一切应该都会好（当然，这假设程序员正确实现了这些接口）。如果你没有提前计划，切换这些对象可能是一项困难的任务。这就是工厂发挥作用的地方。工厂是一种在运行时根据上下文从一组预定义选项中选择要使用哪个对象的方法。

工厂基本上像if语句一样工作，根据某些条件选择用于任务的类。它们是一种今天多投入一点努力，以便将来在决定使用不同对象实现相同接口时节省大量努力的方法。它们应该用于你预计将来会使用不同类型的对象的情况。

工厂是面向对象编程中许多已知模式之一。这些模式是由在设计决策方面经验丰富的人开发的，因此他们知道哪些解决方案可以普遍适用于某些类型的问题。记录这些模式非常有用，并允许许多人通过在自己的环境中不必重新发明轮子来节省大量时间和精力。一些基本面向对象模式的优秀来源可以在 Addison-Wesley 1994 年出版的 Gamma、Vlissides、Johnson 和 Helmfamous 的著名作品《设计模式：可复用面向对象软件元素》中找到。我们鼓励读者研究这些模式，因为它们无疑会在某个时候派上用场。

介绍 R 中的三个对象模型——S3、S4 和 R6

现在你已经对面向对象的基本概念有了基本的了解，我们将深入探讨 R 自身的对象模型。在 R 中进行面向对象编程时，有两个主要的混淆来源。在我们开始编写代码之前，我们将解释这些混淆来源是什么。解释之后，我们将开发一个小示例来展示 R 的 S3、S4 和 R6 对象模型中的继承、组合、多态和封装。相同的示例将用于所有三个模型，以便读者可以精确地指出它们之间的差异。具体来说，我们将模拟一个从Rectangle继承并进一步与Color组合的Square模型。

产生混淆的第一个来源——各种对象模型

在 R 语言中使用面向对象编程的方式与其他语言（如 Python、Java、C++等）中看到的方式不同。在很大程度上，这些语言有一个所有人都使用的单一对象模型。在 R 语言的情况下，请注意，我们一直在编写对象模型，使用复数形式。这是因为 R 是一种非常特殊的语言，并且它有各种实现面向对象系统的方式。具体来说，截至本书编写时，R 有以下对象模型——S3、S4、引用类、R6 和基本类型。在接下来的章节中，我们将深入探讨 S3、S4 和 R6 模型。现在，我们将简要介绍引用类和基本类型。

引用类（RC）是 R 语言中不需要外部库的对象模型，并且与 Python、Java 或 C++中找到的知名对象模型最为相似。它实现了与这些语言相同的信息传递，这意味着方法属于类，而不是函数，并且对象是可变的，这意味着实例的数据可以就地更改，而不是产生带有修改后数据的副本。我们不会深入探讨这个对象模型，因为 R6 似乎是对这种模型更干净的实现。然而，R6 确实需要一个外部包，正如我们稍后将会看到的，这并不是问题，因此它更受欢迎。

基本类型本身并不是一个对象模型。它们是 R 语言背景下的 C 语言实现，用于在它们之上开发其他对象模型。只有 R 的核心开发团队可以向这个模型添加新的类，而且他们很少这样做（可能需要很多年才会这样做）。它们的用法非常高级，我们也不会深入探讨它们。

选择使用哪种对象模型是一个重要的决定，我们将在展示如何使用它们之后对此进行更多讨论。一般来说，这将是灵活性、形式性和代码整洁性之间的权衡。

第二个混淆源——泛型函数

与之前提到的流行面向对象语言（如 Java、C++等）相比，R 语言还有一个很大的不同点，那就是 R 实现了参数多态性，也称为泛型函数，这意味着方法属于函数，而不是类。泛型函数允许使用相同的名称为许多不同的函数命名，这些函数具有许多不同的参数集，并且来自许多不同的类。这意味着调用类方法的语法与其他语言中通常找到的链式语法（通常在类和要调用的方法之间使用一个"."（点））不同，这被称为消息传递。

R 的方法调用看起来就像函数调用，R 必须知道哪些名称需要简单的函数调用，哪些名称需要方法调用。如果你阅读了前面的章节，你应该理解为什么这很重要。R 必须有一种机制来区分它应该做什么。这种机制被称为 泛型函数。通过使用泛型函数，我们将某些名称注册为 R 中的方法，并充当调度器。当我们调用已注册的泛型函数时，R 将检查传递给调用中的对象的属性链，并寻找与该对象类型匹配的方法调用函数；如果找到，它将调用它。

你可能已经注意到，plot() 和 summary() 函数可能会根据传递给它们的对象（例如，数据框或线性模型实例）返回不同的结果。这是因为那些是实现多态性的泛型函数。这种方式为用户提供简单的接口，可以使他们的任务变得更加简单。例如，如果你正在探索一个新的包，并在某个时刻得到了由该包派生出的某种结果，尝试调用 plot(result)，你可能会惊讶地得到一个有意义的图形。这在其他语言中并不常见。

在使用 R 的 S3 和 S4 模型进行面向对象编程时，请记住，你不应该直接调用方法，而应该声明相应的泛型函数并调用它们。这可能会在一开始有些令人困惑，但这是 R 的独特特性之一，随着时间的推移你会习惯它。

S3 对象模型

如你所知，R 语言是从 S 语言派生出来的。S 的对象模型随着时间的推移而发展，其第三个版本引入了 类属性，这允许我们今天在 R 中找到的 S3 对象模型。它仍然是 R 中的对象模型，R 的大多数内置类都是 S3 类型。它是一个有效且非常灵活的对象模型，但它与来自其他面向对象语言的人所习惯的非常不同。

S3 是最不正式的对象模型，因此在某些关键方面存在不足。例如，S3 不提供正式的类定义，这意味着没有正式的继承或封装概念，而多态性是通过泛型实现的。很明显，在关键方面其功能有限，但程序员有很大的灵活性。然而，正如 Hadley Wickham 在《Chapman and Hall，2014 年出版的《高级 R》》中所说：

"S3 在其简约性中具有一定的优雅：你无法去掉任何部分，仍然有一个有用的面向对象系统。"

类、构造函数和组合

对象的想法实际上只是将数据和相应的方法捆绑在一起。R 中的列表非常适合实现这一点，因为它们可以包含不同的数据类型，甚至函数，这些函数是一等对象，可以像任何其他对象一样分配或返回。实际上，我们可以通过将列表的类属性简单地设置为新的值来在 R 中创建新类的对象，这就是我们在 S3 中创建类的方式。

我们不是为 S3 类提供定义，而是提供构造函数。这些构造函数负责创建对象（对于S3Color是传递的参数字符串，对于S3Rectangle是列表）并将字符串分配给它们的类属性。然后返回这些对象，它们代表我们将要使用的类。在矩形的例子中，我们的构造函数接收长度、正交边以及其颜色的名称。颜色构造函数只接收颜色的名称：

color_constructor <- function(color) {
    class(color) <- "S3Color"
    return(color)
}

rectangle_constructor <- function(a, b, color) {
    rectangle <- list(a = a, b = b, color = color_constructor(color))
    class(rectangle) <- "S3Rectangle"
    return(rectangle)
}

正如你所见，我们不是直接在矩形的列表中的color元素里分配作为参数传递给rectangle_constructor()函数的color字符串，而是使用color_constructor()函数提供一个Color类，而不仅仅是字符串。如果你打算为颜色抽象添加行为，就像我们将要做的那样，你应该这样做。

现在，我们可以通过调用rectangle_constructor()来创建一个S3_rectangle，并且我们可以打印它的类，结果显示为S3Rectangle，正如我们所预期的。此外，如果你打印S3_rectangle的结构，你会看到它包含了矩形定义的两个边，颜色类以及属性类名称：

S3_rectangle <- rectangle_constructor(2, 3, "blue")
class(S3_rectangle)
#> [1] "S3Rectangle"

str(S3_rectangle)
#> List of 3
#> $ a : num 2
#> $ b : num 3
#> $ color:Class 'S3Color' chr "blue"
#> - attr(*, "class")= chr "S3Rectangle"

有时，你会看到我们给一个对象添加了一个前缀，这个前缀是我们使用的对象模型名称（在这种情况下是S3）。例如，S3Color和S3Rectangle。当你看到这种情况时，意味着特定的名称与另一个对象模型中的相应对象冲突，我们需要区分它们。如果你不这样做，你可能会遇到相当令人困惑且难以诊断的错误。

公共方法和多态

要为类定义一个方法，我们需要使用UseMethod()函数来定义函数的层次结构。它将告诉 R 寻找一个前缀与当前函数匹配且后缀在传递给对象的类名向量中的函数。方法名称有两部分，由一个"."分隔，其中前缀是函数名，后缀是类的名称。正如你所见，S3 泛型函数是通过命名约定工作的，而不是通过为不同类显式注册方法。

我们首先为S3Rectangle类创建一个S3area方法，我们通过创建一个名为S3area.S3Rectangle的函数来实现这一点。UseMethod()函数将确保S3area.S3Rectangle函数接收一个S4Rectangle类的对象，因此在这个函数内部，我们可以使用类的内部结构。在这种情况下，我们将长度a和b相乘：

S3area.S3Rectangle <- function(rectangle) {
    return(rectangle$a * rectangle$b)
}

注意，我们可以通过使用$运算符在rectangle对象内部访问这样的对象。这不仅仅限于在方法内部进行，所以实际上，任何对象都可以改变 S3 对象的内部结构，但仅仅因为你能够这样做，并不意味着你应该这样做。

现在，我们将把S3area方法称为一个普通的函数调用，我们将传递之前创建的矩形对象，我们应该看到面积被打印到控制台：

S3area(S3_rectangle)
#> Error in S3area(S3_rectangle): could not find function "S3area"

发生了什么？错误？那么，R 是如何知道S3area函数调用实际上应该触发S3area.S3Rectangle方法调用的呢？为了实现这一点，我们需要在 R 中注册这个名称，我们通过调用定义函数来实现，该函数实际上通过自身使用S3area名称。这个S3area函数接收任何类型的对象，不一定是S3Rectangle，并使用UseMethod()函数来告诉它应该为该对象查找"S3area"方法调用。在这种情况下，我们知道它只会在S3Rectangle类中找到：

S3area <- function(object) {
    UseMethod("S3area")
}

现在，我们可以像之前一样调用S3area方法，但这次我们将得到实际的面积。这就是你通常使用 S3 创建方法的方式：

S3area(S3_rectangle)
#> [1] 6

现在，我们将创建S3color方法来返回矩形的颜色对象。由于颜色对象只是字符类型，如果我们只想获取字符，我们不需要做任何额外的事情来解析该对象：

S3color.S3Rectangle <- function(rectangle) {
    return(rectangle$color)
}
S3color <- function(object) {
    UseMethod("S3color")
}

现在，我们将打印矩形。正如你所见，print()调用仅仅显示了对象的内部及其包含的对象：

print(S3_rectangle)
#> $a
#> [1] 2
#>
#> $b
#> [1] 3
#>
#> $color
#> [1] "blue"
#> attr(,"class")
#> [1] "S3Color"
#>
#> attr(,"class")
#> [1] "S3Rectangle"

我们可能想要重载这个函数以提供不同的输出。为此，我们创建print.S3Rectangle()并简单地打印一个字符串，告诉我们矩形的颜色，它是一个矩形，每边的长度，然后是它的面积。注意，颜色和面积都是使用我们之前定义的方法检索的，即S3Color()和S3area()：

print.S3Rectangle <- function(rectangle) {
    print(paste(
        S3color(rectangle), "rectangle:",
        rectangle$a, "x", rectangle$b, "==", S3area(rectangle)
    ))
}

现在，如果我们简单地调用print()函数，就像我们之前调用S3area()函数一样，会发生什么？我们应该得到一个错误，不是吗？让我们看看以下代码：

print(S3_rectangle)
#> [1] "blue rectangle: 2 x 3 == 6"

嗯，正如你所见，我们并没有这样做。在这种情况下，我们实际上得到了我们希望得到的结果。原因是 R 中的print()函数是一个已经注册到UseMethod()函数的 S3 函数。这意味着我们的print.S3Rectangle定义不需要再次注册，我们可以直接使用它。这很酷，不是吗？这是使用参数多态的一个大优点。我们可以将函数注册为可能或可能不会在未来以意想不到的方式使用的方法调用，但它们仍然为用户提供了一致的接口。

封装和可变性

现在，我们将看到 S3 如何处理可变性和封装。为此，我们将打印矩形中的a值，修改它，然后再次打印。正如你所见，我们能够修改它，并且从那时起我们得到不同的结果，而且我们没有进行任何方法调用。这是一件非常危险的事情，你绝对应该在方法调用中封装这种行为：

print(S3_rectangle$a)
#> [1] 2

S3_rectangle$a <- 1

print(S3_rectangle$a) #> [1] 1

即使你可以，也永远不要直接修改对象的内部结构。

修改对象的正确方式应该是通过某种类型的设置函数。将使用set_color.S3Rectangle()方法来修改矩形的颜色，通过接收一个S3Rectangle和一个new_color字符串，并将这个新字符串保存在矩形的color属性中。当你使用这种类型的方法时，你明确了自己的意图，这是一种更好的编程方式。当然，我们还需要像之前展示的那样，将方法调用注册到 R 中：

set_color.S3Rectangle <- function(rectangle, new_color) {
    rectangle$color <- new_color
    return(rectangle)
}

set_color <- function(object, new_color) {
    UseMethod("set_color")
}

你注意到我们的错误了吗？可能没有，但如果注意到了那就太好了！我们故意这样做是为了向你展示在 R 中编程时伤害自己是多么容易。由于 R 没有类型检查，我们无意中分配了一个字符串，而我们应该分配一个Color。这意味着在调用set_color()方法后，我们的矩形中的color属性将不再被识别为Color类；它将被识别为一个字符串。如果你的代码依赖于这个对象是Color类型，它可能会以意想不到和令人困惑的方式失败，并且难以调试。在进行赋值时要小心。相反，我们应该使用rectangle$color <- color_constructor(new_color)来保持一致性。

虽然你可以改变一个对象的数据类型，但你永远不应该这样做。正如 Hadley Wickham 所说，R 不会保护你不犯错误：你很容易自己伤害自己。只要你不把枪口对准自己的脚并扣动扳机，你就不会有问题。

现在，我们将展示如何使用set_color()方法。我们将打印矩形的颜色，尝试将其更改为黑色，然后再次打印。正如你所见，更改并没有持久化在我们的对象中。这是因为 R 通过值传递对象，而不是通过引用。这仅仅意味着当我们修改矩形时，我们实际上是在修改矩形的副本，而不是我们传递给自己的矩形：

print(S3color(S3_rectangle))
#> [1] "blue"
#> attr(,"class")
#> [1] "S3Color"

set_color(S3_rectangle, "black")
#> [1] "black rectangle: 1 x 3 == 3"

print(S3color(S3_rectangle))
#> [1] "blue"
#> attr(,"class")
#> [1] "S3Color"

你注意到在set_color.S3Rectangle()函数的末尾，我们返回了rectangle吗？在其他语言中可能不需要这样做，但在 R 中，我们这样做是为了返回修改后的对象。为了使对象中的更改持久化，我们需要将那个结果对象实际分配到我们自己的S3_rectangle中，当我们这样做时，我们就可以看到颜色更改已经持久化。

这个属性赋予了 S3 不可变性的特性。这在处理函数式编程时非常有用，但在进行面向对象编程时可能会有些麻烦。一些令人困惑的错误可能来自这个属性，让你习惯以这种方式工作。

继承

S3 类缺少在其他语言中通常找到的大量结构。继承是非正式实现的，封装也不是由语言强制执行的，正如我们之前所看到的。

要实现继承，我们将创建一个square_constructor()函数，该函数将接收边长a和颜色名称。然后，我们将使用rectangle_construtor()并将a作为两个长度（使其成为正方形）发送，同时也会发送颜色。然后，我们将添加S3Square类，最后返回创建的对象：

square_constructor <- function(a, color) {
    square <- rectangle_constructor(a, a, color)
    class(square) <- c("S3Square", class(square))
    return(square)
}

现在，我们将创建一个正方形并打印其类。如你所见，它按顺序分配了S3Square和S3Rectangle类，当我们使用print()方法时，实际上是从S3Rectangle类获取打印功能，这是预期的，因为我们发出了继承的信号：

S3_square <- square_constructor(4, "red")

class(S3_square)
#> [1] "S3Square" "S3Rectangle"

print(S3_square)
#> [1] "red rectangle: 4 x 4 == 16"

如果我们想要为正方形提供特定的打印功能，我们必须像现在这样覆盖print()方法，为S3Square类定义我们自己的方法。该函数与之前完全相同，但我们使用的是单词"square"而不是"rectangle"。

print.S3Square <- function(square) {
    print(paste(
        S3color(square), "square:",
        square$a, "x", square$b, "==", S3area(square)
    ))
}

现在，当我们打印时，我们可以看到正在使用正确的方法，因为我们看到输出中出现了单词"square"。请注意，我们不需要使用UseMethod()函数重新注册print()方法，因为我们已经这样做了：

print(S3_square)
#> [1] "red square: 4 x 4 == 16"

最后，请记住，如果类属性是一个包含多个元素的向量，则第一个元素被解释为对象的类，而后续元素被解释为对象继承的类。这使得继承成为对象的属性，而不是类的属性，并且顺序很重要。

如果我们在square_constructor()函数中写成class(square) <- c(class(square), "S3Square")，那么即使创建了print.S3Square()函数，我们仍然会看到print()方法调用print.S3Rectangle()函数。请注意这一点。

S4 对象模型

一些程序员认为 S3 并没有提供与面向对象编程通常相关的安全性。在 S3 中，创建一个类非常容易，但如果不小心使用，也可能导致非常混乱且难以调试的代码。例如，你可能会轻易地拼错一个名称，而 R 不会抱怨。你也很容易将类更改为对象，R 也不会抱怨。

S4 类是在 S3 之后开发的，目的是增加安全性。S4 提供了保护，但也引入了大量的冗余来提供这种安全性。S4 对象模型实现了现代面向对象编程语言的大多数功能——正式的类定义、继承、多态（参数化）和封装。

类、构造函数和组合

使用 setClass() 函数创建 S4 类。至少，必须指定 Class 的名称及其属性，在 S4 中正式称为 槽。槽通过 representation() 函数指定，并且一个整洁的功能是你可以指定此类属性期望的类型。这有助于类型检查。

还有一些内置的功能我们在这里不会探讨。例如，你可以提供一个函数来验证对象的一致性（没有被以某种意外的方式操作）。你还可以指定默认值，在名为 prototype 的参数中。如果你想在 S3 中使用这些功能，你也可以自己实现它们，但它们不是内置功能。S4 被视为一个强大的对象模型，你应该通过浏览其文档来更深入地学习它。

所有与 S4 相关的代码都存储在 methods 包中。当你以交互方式运行 R 时，此包总是可用的，但在批处理模式下运行 R 时可能不可用。因此，在每次使用 S4 时包含一个显式的 library(methods) 调用是一个好主意。

如你所见，与 S3 类的概念区别在于，在这里，我们实际上为每个槽指定了对象的类型。其他的变化更多的是语法上的，而不是概念上的。请注意，你可以使用另一个 S4 类的名称作为其中一个槽的名称，就像我们在 S4Rectangle 的 color 例子中所做的那样。这就是你如何使用 S4 实现组合的方式：

library(methods)

setClass(
    Class = "S4Color",
    representation = representation(
        color = "character"
    )
)

setClass(
    Class = "S4Rectangle",
    representation = representation(
        a = "numeric",
        b = "numeric",
        color = "S4Color"
     )
)

构造函数是通过调用 new() 函数自动为你构建的。正如你所见，你只需传递你正在实例化的类的名称以及应该分配给槽的值：

S4_rectangle <- new(
    "S4Rectangle",
    a = 2,
    b = 3,
    color = new("S4Color", color = "blue")
)

class(S4_rectangle)
#> [1] "S4Rectangle"
#> attr(,"package")
#> [1] ".GlobalEnv"

str(S4_rectangle)
#> Formal class 'S4Rectangle' [package ".GlobalEnv"] with 3 slots
#> ..@ a : num 2
#> ..@ b : num 3
#> ..@ color:Formal class 'S4Color' [package ".GlobalEnv"] with 1 slot
#> .. .. ..@ color: chr "blue"

正如我们之前所做的那样，我们检索对象的类并打印它。当我们打印它时，我们可以看到一个包含一些 @ 符号的结构。这些是用于访问槽的运算符（而不是 S3 中的 $ 运算符）。你还可以看到 Color 类的 color 属性的嵌套槽：

由于这些名称在 R 中是保留关键字，因此一些槽名称是禁止使用的。禁止的名称包括 class、comment、dim、dimnames、names、row.names 和 tsp。

公共方法和多态性

由于 S4 也使用参数多态（方法属于函数，而不是类），并且我们之前已经解释过几次，所以我们现在将只指出与 S3 的不同之处。首先，我们不是使用 UseMethod() 函数在 R 中注册方法，而是使用 setGeneric() 函数，其中包含方法名称，以及一个调用 standardGeneric() 函数的函数。这将提供 S4 对象的调度机制。

要实际创建一个方法，我们不是像在 S3 中那样使用命名约定，而是将类名称和方法名称传递给 setMethod() 函数，以及用作方法的函数。其次，那里的顺序很重要。如果你在调用 setGeneric() 方法之前调用 setMethod() 函数，你的调度机制将不会工作。我们在 S3 中就是这样做的，但在这里，我们需要颠倒顺序。最后，请注意，我们使用 @ 符号访问对象属性（槽位），正如我们之前提到的。

为了使示例完整，以便读者可以并排比较所有三个示例的代码，我们现在展示如何实现我们之前为 S3 情况所展示的相同代码：

setGeneric("S4area", function(self) {
    standardGeneric("S4area")
})
#> [1] "S4area"

setMethod("S4area", "S4Rectangle", function(self) {
    return(self@a * self@b)
})
#> [1] "S4area"

S4area(S4_rectangle)
#> [1] 6

setGeneric("S4color", function(self) {
    standardGeneric("S4color")
})
#> [1] "S4color"

setMethod("S4color", "S4Rectangle", function(self) {
    return(self@color@color)
})
#> [1] "S4color"

如果你使用 print() 在 S4_rectangle 上，你会看到它被识别为某种类型，并且它会显示其槽位：

print(S4_rectangle)
#> An object of class "S4Rectangle"
#> Slot "a":
#> [1] 2
#>
#> Slot "b":
#> [1] 3
#>
#> Slot "color":
#> An object of class "S4Color"
#> Slot "color":
#> [1] "blue"

如果我们想改变这个输出，我们可以像在 S3 的情况下那样用我们自己的方法覆盖它。然而，如果我们这样做，我们将定义 print() 函数以与 S4 对象一起工作，并且它将停止为来自其他对象模型的对象工作。我们鼓励你通过将下面的代码更改为使用 print 方法调用而不是 S4print 名称来亲自尝试。正如你所见，我们正在使用与之前相同的覆盖机制，所以我们将跳过其解释：

setGeneric("S4print", function(self) {
    standardGeneric("S4print")
})
#> [1] "S4print"

setMethod("S4print", "S4Rectangle", function(self) {
    print(paste(
        S4color(self), "rectangle:",
        self@a, "x", self@b, "==", S4area(self)
    ))
})
#> [1] "S4print"

现在，我们可以使用 S4print() 方法来打印所需的输出，如下面的代码所示：

S4print(S4_rectangle)
#> [1] "blue rectangle: 2 x 3 == 6"

封装和可变性

现在，我们将探讨 S4 中的封装和可变性概念。首先，请注意我们使用的是 print() 而不是 S4print() 方法，因为我们正在打印 S4_rectangle 的特定槽位。正如你所见，如果我们不小心，我们仍然可以直接分配值到对象的内部。再次强调，你不应该这样做。

还要注意，如果我们使用之前创建的 S4color() 方法来封装对 color 属性的访问，我们会得到一个错误，告诉我们找不到 S4color<- 函数。这提示我们可以创建这样的函数，我们可以：

print(S4_rectangle@a)
#> [1] 2

S4_rectangle@a <- 1

print(S4_rectangle@a)
#> [1] 1 
print(S4color(S4_rectangle))
#> [1] "blue"

S4color(S4_rectangle) <- "black"
#> Error in S4color(S4_rectangle) <- "black": 
       could not find function "S4color<-"

print(S4color(S4_rectangle))
#> [1] "blue"

要创建一个封装对象属性访问的函数，我们可以使用 setReplaceMethod() 函数，就像我们之前使用 setMethod() 函数一样。请注意，我们传递给 setGeneric() 函数的方法的名称是 R 错误中提示给我们的名称，即槽位的名称后跟 R 中的正常赋值运算符 <-。另外请注意，变量名称和赋值运算符符号之间没有空格。

最后，请注意，我们在给 color 槽位赋新值时确保创建了一个 S4Color 类型的对象。如果你尝试像我们对 S3 类那样简单地赋一个字符串，你会得到一个错误，告诉你你正在尝试做一些你不应该做的事情。这在使用 S4 时是一个很大的优势，因为它可以防止你犯一些意外的错误：

setGeneric("S4color<-", function(self, value) {
    standardGeneric("S4color<-")
})
#> [1] "S4color<-"

setReplaceMethod("S4color", "S4Rectangle", function(self, value) {
    self@color <- new("S4Color", color = value)
    return(self)
})
#> [1] "S4color<-"

一旦我们创建了这样的方法，我们就可以用它直接、封装地给颜色对象赋值，这比直接操作槽位要好得多。正如你所看到的，颜色变化被持久化了：

print(S4color(S4_rectangle))
#> [1] "blue"

S4color(S4_rectangle) <- "black"

print(S4color(S4_rectangle))
#> [1] "black"

继承

创建子类很容易；我们只需像以前一样调用 setClass() 函数，并发送 contains 参数，其中包含它将继承的类的名称。S4 支持多重继承，但我们不会探讨这一点。感兴趣的读者可以查阅文档。

S4 类的一个有趣特性是，如果一个类扩展了 R 的基本类型，那么将会有一个名为 .Data 的槽位，其中包含基本对象类型的数据。在基本对象类型上工作的代码将直接在对象的 .Data 部分上工作，这使得我们的编程变得稍微容易一些：

setClass("S4Square", contains = "S4Rectangle")

注意，当我们实例化 S4Square 类时，我们需要传递长度属性，并确保它们相同。正如我们所看到的，对象的类被正确地识别，我们之前定义的多态 S4print() 方法也正常工作：

S4_square <- new ("S4Square", 
                  a = 4, b = 4, 
                  color = new("S4Color", color = "red"))

class(S4_square)
#> [1] "S4Square"
#> attr(,"package")
#> [1] ".GlobalEnv"

S4print(S4_square)
#> [1] "red rectangle: 4 x 4 == 16"

再次，为了完整性，我们用使用 "square" 词汇的 S4print() 方法覆盖了它，我们可以看到它按预期工作：

setMethod("S4print", "S4Square", function(self) {
    print(paste(
        S4color(self), "square:",
        self@a, "x", self@b, "==", S4area(self)
    ))
})
#> [1] "S4print" 
S4print(S4_square)
#> [1] "red square: 4 x 4 == 16"

R6 对象模型

S3 和 S4 实际上只是实现静态函数多态性的方法。R6 包提供了一种类似于 R 的引用类的类类型，但它更高效，并且不依赖于 S4 类和方法包，正如 RCs 所做的那样。

当引入 RCs 时，一些用户遵循 R 现有类系统 S3 和 S4 的命名，将新的类系统称为 R5。尽管现在实际上并不称为 R5，但这个包及其类的命名遵循这种模式。

尽管 R6 在三年多前就已经发布，但它并不广为人知。然而，它被广泛使用。例如，它在 Shiny（本书最后一章的重点）中使用，并在 dplyr 包中管理数据库连接。

类、构造函数和组合

R6 类是通过R6Class()函数创建的，我们传递类的名称和公共和私有对象的列表。这些对象可以是属性或方法。正如您所看到的，在 R6 中使用类定义生成更干净的代码，这些代码在一个单独的定义中组合，而不是像 S3 和 S4 中使用的逐步过程。这种方法更类似于您在其他流行语言中可以找到的方法。

您可以通过使用initialize方法来指定构造函数应该如何表现。当创建类的实例时，将调用此特定方法。

在以下定义中，我们与 S3 和 S4 示例中使用的名称之间有两个重要的区别。在这种情况下，我们调用打印方法为own_print()，将color属性称为own_color。前者的原因是 R 会在color()方法和color属性之间混淆。为了避免错误，我们可以更改其中一个的名称，为了保持我们的公共接口不变，我们决定在这种情况下更改私有属性。own_print()的原因将在后面解释：

library(R6)
R6Rectangle <- R6Class(
    "R6Rectangle",
    public = list(
        initialize = function(a, b, color) {
            private$a <- a
            private$b <- b
            private$own_color <- color
        },
        area = function() {
            private$a * private$b
        },
        color = function() {
            private$own_color
        },
        set_color = function(new_color) {
            private$own_color <- new_color
        },
        own_print = function() {
            print(paste(
                self$color(), "rectangle:",
                private$a, "x", private$b, " == ", self$area()
            ))
        }
    ),
    private = list(
        a = NULL,
        b = NULL,
        own_color = NULL
    )
)

要创建类的实例，我们调用类对象中的new()方法。我们可以传递一些参数，如果这样做，它们将被类中定义的initialize函数使用。

如您所见，如果我们对R6_rectangle对象使用print()，我们会看到一个漂亮的输出，让我们知道哪些方法和属性是公共的，哪些是私有的，以及一些关于它们的额外信息，例如默认的clone()方法（用于创建 R6 对象的副本）被设置为浅拷贝而不是深拷贝。我们不会深入探讨这些概念的具体细节，但鼓励感兴趣的读者了解按引用传递与按值传递的机制。

如果我们在类中定义了一个print()方法，那么print(R6_rectangle)将默认使用该函数。请注意，这与直接通过执行类似R6_rectangle$print()的命令直接调用方法在语法上会有所不同，但 R 足够智能，知道如果您在类中定义了一个print()方法，那么您可能想在对象上使用print()函数时使用它。如果不是这种情况，那么您应该更改您自定义打印函数的名称，就像我们在own_print()方法名称的情况中所做的那样：

R6_rectangle <- R6Rectangle$new(2, 3, "blue")

class(R6_rectangle)
#> [1] "R6Rectangle" "R6"

print(R6_rectangle)
#> <R6Rectangle>
#> Public:
#>     area: function ()
#>     clone: function (deep = FALSE)
#>     color: function ()
#>     initialize: function (a, b, color)
#>     own_print: function ()
#>     set_color: function (new_color)
#> Private:
#>     a: 2
#>     b: 3
#>     own_color: blue 

如您从输出中看到的，在 R6 类的情况下，我们有两个类而不是一个。我们定义了自己的类，还为我们添加了通用的R6类。

公共方法和多态

我们已经在之前的代码片段中定义了我们想要的方法，因此为了完整性，我们现在将仅展示如何调用这些方法。正如你所见，你只需使用 $ 操作符来访问公共属性或公共方法，如果它是方法，你需要在末尾添加括号（围绕你想要发送的任何参数，就像你通常那样）：

R6_rectangle$own_print()
#> [1] "blue rectangle: 2 x 3 == 6"

R6_rectangle$area()
#> [1] 6

R6_rectangle$color()
#> [1] "blue"

封装和可变性

由于我们在类定义中将 a、b 和 own_color 放入了 private 列表中，它们保持为私有，这就是 R6 中强制封装的方式。正如你所见，我们不允许直接将 a 属性赋值，正如我们预期的那样，因为它被放置在 private 列表中。这确保了我们不能直接从对象外部访问标记为私有的属性或方法，并防止我们在编码时做出错误的决定。这是 R6 模型的一个巨大优势。

R6 中的封装是通过环境实现的。

可变性是通过使用设置器（用于更改类属性的方法）实现的。请注意，在这种情况下，我们不需要像在 S3 中那样重新分配结果对象。状态实际上保存在对象的环境中，并且可以更改；因此，R6 具有可变性：

R6_rectangle$a
#> NULL

R6_rectangle$own_print()
#> [1] "blue rectangle: 2 x 3 == 6"

R6_rectangle$a <- 1
#> Error in R6_rectangle$a <- 1: 
       cannot add bindings to a locked environment

R6_rectangle$own_print()
#> [1] "blue rectangle: 2 x 3 == 6"

R6_rectangle$set_color("black")

R6_rectangle$own_print()
#> [1] "black rectangle: 2 x 3 == 6"

继承

继承在处理 R6 对象模型时也更加熟悉。在这种情况下，你只需将 inherit 参数添加到 R6Class() 函数调用中，并且你可以通过使用 super$initialize() 来调用超类的 initialize 方法。在这种情况下，我们使用这种技术为用户提供一个更直观的构造函数接口：对于正方形的情况，只需提供一个长度值，而不是必须重复相同的值两次，如果不进行检查，这可能会导致反直觉的行为。我们还可以覆盖 print() 方法，就像我们通常添加另一个方法一样：

R6Square <- R6Class(
    "R6Square",
    inherit = R6Rectangle,
    public = list(
        initialize = function(a, color) {
            super$initialize(a, a, color)
        },
        print = function() {
            print(paste(
                self$color(), "square:",
                private$a, "x", private$b, " == ", self$area()
            ))
        }
    )
)

正如你所见，在这种情况下，我们得到了一个包含当前类 R6Square 以及该对象继承的类 R6Rectangle 和 R6 的类列表。由于我们覆盖了 print() 方法，我们可以使用常见的 print(object) 语法，而不是 R6 提供的特定 object$print() 语法：

R6_square <- R6Square$new(4, "red")

class(R6_square)
#> [1] "R6Square" "R6Rectangle" "R6"

print(R6_square)
#> [1] "red square: 4 x 4 == 16"

活跃绑定

活跃绑定看起来像字段，但每次访问它们时，它们都会调用一个函数。它们始终公开可见，类似于 Python 的属性。如果我们想将 color() 方法实现为活跃绑定，我们可以使用以下代码。正如你所见，你可以获取或设置 color 属性，而不需要使用显式的方法调用（注意缺少的括号）：

R6Rectangle <- R6Class(
    "R6Rectangle",
    public = list(
        ...
    ),
    private = list(
        ...
    ),
    active = list(
        color = function(new_color) {
            if (missing(new_color)) {
                return(private$own_color)
            } else {
                private$own_color <- new_color
            }
        }
    )
)

R6_rectangle <- R6Rectangle$new(2, 3, "blue")

R6_rectangle$color
#> [1] "blue"

R6_rectangle$color <- "black"

R6_rectangle$color
#> [1] "black"

如你所见，当活跃绑定用作 getter（用于检索值）时，它调用方法而不传递任何值。当它作为 setter（用于更改属性）被访问时，它传递要分配的值来调用方法。如果函数不接受任何参数，则无法将活跃绑定用作设置器。

析构函数

有时候，在对象被垃圾回收时运行一个函数是有用的。如果你不熟悉垃圾回收，你可以将其视为当对象不再被环境中的其他对象引用时释放未使用内存的一种方式。

这个特性有用的一个例子是当你想要确保在对象被垃圾回收之前关闭文件或数据库连接。为此，你可以定义一个 finalize() 方法，当对象被垃圾回收时，它将不带任何参数被调用。为了测试这个功能，你可以在你的某些对象中简单地添加一个 finalizer，然后查看你何时在控制台看到 "Finalizer called" 消息：

A <- R6Class("A", public = list(
    finalize = function() {
        print("Finalizer called.")
    }
))

当 R 退出时，finalizers 也会被调用。

我们加密货币系统背后的架构

现在已经介绍了使用 R 进行面向对象编程的基础，我们将把这些原则应用到本书剩余部分我们将要处理的示例中。我们将使用面向对象编程来构建一个跟踪加密货币的系统。如果你对加密货币不熟悉，可以阅读本章的开头部分以获得简要介绍。

在这个示例中，你所看到的设计和实现经过了多次迭代和数周的时间演变。实际上，它是我在 CVEST (www.cvest.tech/) 中最初使用的基本系统的一部分，为管理多种加密货币的用户提供一个单一的真实点（尽管它并没有在 R 中实现），所以请不要觉得你应该能够立即想出这样的设计（尽管许多人当然能够做到，但大多数时候，面向对象的系统以不可预测的方式演变）。正如 Grady Booch 所说：“一个运作复杂系统总是发现它是由一个运作的简单系统演变而来的。从头开始设计的复杂系统永远不会运作，也无法修补使其运作。你必须从头开始，从一个运作的简单系统开始。”

让我们开始吧。正如你可能知道的，加密货币可以存储在交易所账户和钱包中。由于将加密货币存储在交易所账户中是一个非常糟糕的想法（它是有风险的，用户可能会失去他们的资产，这种情况已经反复发生），我们将只关注加密货币存储在钱包中的情况。

基本上，我们试图做的是获取关于我们拥有多少加密货币以及它们在特定时间点价值多少的实时数据流。为了实现这个系统，我们首先需要做的是确定主要抽象，在我们的案例中是：用户、资产、钱包和交易所。为了简单起见，我们还将市场和数据库列入这个列表。

我们将使用“资产”这个词而不是“加密货币”，因为其中一些在技术上并不是货币，但你可以在不混淆的情况下自由互换这些术语。

对于我们的情况，假设我们一开始就决定，尽管我们将从单个源读取数据，但我们可能希望在获取数据时将数据写入多个数据库。其中一些数据库可能是本地的，而其他一些可能是远程的。然而，我们不想让系统的每一部分都知道正在使用多个数据库，因为它们实际上不需要这些信息来操作。因此，我们将引入另一个抽象，即存储，它将包含这些信息，并且对于需要读取或写入数据的其他对象来说，它将看起来像一个单一的数据库，并且将为他们处理细节。

我们将这个抽象包含在我们的主要抽象列表中，并且到目前为止这个列表是完整的：

加密货币跟踪架构

现在，我们需要定义这个主要抽象之间如何相互作用。我们知道一个用户可能拥有几个钱包，而这些钱包中包含资产。请注意，我们分离了资产和钱包的抽象，因为一些钱包可能包含多个资产（例如，以太坊钱包可能包含各种类型的代币）。由于我们预计这种情况，我们将确保我们可以通过分离这些概念来相应地处理它。

用户还希望能够存储他们自己的信息以及他们的资产信息。为此，他们将收到一个存储对象，并且他们将在这个对象上调用方法，其公共接口将定义良好。

存储抽象将包含一个用于读取的单个数据库，但可能包含多个用于写入的数据库，正如我们之前提到的。它将存储这些数据库对象并在必要时向它们发送消息，以代表使用它的对象完成读取和写入操作。

最后，正如钱包包含资产一样，交易所包含市场。区别在于资产标识一种单一的加密货币类型，而市场使用恰好两种加密货币来定义。这就是为什么我们可能有一个市场来交换 USD 兑换 BTC（写作 USD/BTC），这意味着人们可以使用美元来购买/出售比特币。其他市场可能是 BTC/LTC 或 LTC/USD（其中 LTC 代表莱特币）。

我们将从钱包中检索的数字是一个表示我们拥有特定资产多少的单一数字。我们将从市场中检索的数字是一个表示价格或一个资产被要求以换取另一个单位的价格的比率。一个 BTC/USD 比率为 8,000 意味着为了收到一个比特币，你预计要给出 8,000 美元（这是本段写作时的价格）。同样，一个 LTC/BTC 比率为 0.0086 意味着你预计要给出 0.0086 比特币以换取一个莱特币。

现在这些关系或多或少已经定义好了，我们需要引入更多的抽象来编写将使我们的系统成为现实的代码。例如，我们知道我们的钱包抽象将使用类似的机制从不同的区块链中检索数据。这可以封装在钱包请求者中。此外，这个钱包请求者将以不同的方式实现，并且必须在运行时根据我们正在处理的特定钱包来决定。我们不需要为每种类型的资产创建不同的钱包，并在每个钱包内部编程从区块链中检索数据的机制，我们将这个机制抽象出来，创建一个钱包请求者工厂，该工厂将为我们的钱包抽象提供所需的特定类型的钱包请求者。

类似地，我们的数据库抽象可以针对各种数据库实现，因此我们将接口与实现分离，并引入一个工厂，该工厂将选择我们最终将使用哪个具体的实现。在我们的案例中，我们将数据保存到 CSV 文件中，但我们可以同样容易地使用 MySQL 数据库，就像我们在第四章，“模拟销售数据和数据库操作”中学到的那样。

以类似的方式，我们的代码目前将从CoinMarketCap（www.coinmarketcap.com）检索数据，但以后可能会改变。CoinMarketCap 本身不是一个交易所；相反，它是一个价格数据的聚合器。然而，由于我们可能希望在将来与来自不同交易所的价格数据（如Bittrex或Bitfinex)一起工作，我们将提供这样的抽象，并且由于我们没有预见需要将 CoinMarketCap 与交易所区别对待，我们将将其包含在那个抽象中。

作为旁注，架构图并不是一个 UML 图。UML代表统一建模语言，这是一种常用于传达面向对象系统背后思想的工具。如果你计划进行严肃的面向对象编程，你绝对应该学习如何使用这个工具。此外，请注意，我们不会实现以灰色显示的对象，即 Bitfinex 请求者、Bittrex 请求者、MySQL 和 Ether 请求者。这些将留给用户作为练习。我们的系统将完全功能，即使没有它们。

到目前为止，我们似乎已经很好地了解了我们想要构建的抽象以及这些抽象之间将发生的交互，因此是时候开始编程了。当我们遍历系统的代码时，我们不会停下来解释我们之前覆盖的概念；我们只会解释可能不明显的功能。

最后，你应该知道，我们实现的每个抽象都将进入自己的文件。这是标准做法，有助于你快速找到需要实现或修改代码的位置。这些文件之间有一个清晰直观的层次结构。实际的代码组织结构如下（文件以 .R 扩展名结尾，目录以 / 符号结尾）：

cryptocurrencies/
    assets/
        analysis-asset.R
        asset.R
        exchanges/
            exchange.R
            market.R
            requesters/
                coinmarketcap-requester.R
                exchange-requester-factory.R
                exchange-requester.R
        wallets/
            requesters/
                btc-requester.R
                ltc-requester.R
                wallet-requester-factory.R
                wallet-requester.R
            wallet.R
    batch/
        create-user-data.R
        update-assets.R
        update-markets.R
    settings.R
    storage/
        csv-files.R
        database-factory.R
        database.R
        storage.R
    users/
        admin.R
        user.R
    utilities/
        requester.R
        time-stamp.R

使用 S3 类从简单的时间戳开始

我们首先编写一个没有外部依赖的类，即 TimeStamp。我们将使用此类在单个字符串 YYYY-MM-DD-HH-mm 格式中表示日期和时间，其中 MM 表示月份，mm 表示分钟。正如你所见，使用这些字符串之一，你就有时间和日期的信息，并且它将与我们从时间序列中检索的数据一起存储，以便在 第九章，“实现高效的简单移动平均”中进行分析。

我们的 TimeStamp 类将使用 S3 实现。正如你所见，我们包括 lubridate 包来为我们处理日期转换的重活，并提供一个构造函数来检查传入的字符串是否是有效的时间戳：

library(lubridate)
timestamp_constructor <- function(timestamp = now.TimeStamp()) {
    class(timestamp) <- "TimeStamp"
    if (valid(timestamp)) { return(timestamp) }
    stop("Invalid timestamp (format should be: 'YYYY-MM-DD-HH-mm')")
}

验证是通过 valid.TimeStamp() 函数完成的，该函数确保字符串中只有破折号（-）和数字，分隔这些数字的数字数量是五个（年、月、日、小时和分钟），并且该字符串可以被 strptime() 函数解析，该函数用于从字符串对象创建日期对象（如果不是 NA，则可以解析）：

valid.TimeStamp <- function(timestamp) {
    if (gsub("-", "", gsub("[[:digit:]]", "", timestamp)) != "") {
        return(FALSE)
    }
    if (length(strsplit(timestamp, "-")[[1]]) != 5) {
        return(FALSE)
    }
    if (is.na(strptime(timestamp, "%Y-%m-%d-%H-%M"))) {
        return(FALSE)
    }
    return(TRUE)
}

valid <- function (object) {
    UseMethod("valid", object)
}

我们还提供了一个 now.TimeStamp() 函数，其职责是创建当前时间和日期的时间戳。它是通过调用 Sys.time() 函数并使用我们之前指定的格式解析结果对象来实现的：

now.TimeStamp <- function() {
    timestamp <- format(Sys.time(), "%Y-%m-%d-%H-%M")
    class(timestamp) <- "TimeStamp"
    return(timestamp)
}

接下来，我们介绍一种将原生时间对象转换为我们的 TimeStamp 对象的方法。我们简单地使用之前使用的 format() 函数。我们还引入了一种机制，将我们的 TimeStamp 对象转换为原生时间对象：

time_to_timestamp.TimeStamp <- function(time) {
    timestamp <- format(time, "%Y-%m-%d-%H-%M")
    class(timestamp) <- "TimeStamp"
    return(timestamp)
}

timestamp_to_time.TimeStamp <- function(timestamp) {
    return(strptime(timestamp, "%Y-%m-%d-%H-%M"))
}

当我们检索数据时，subtract.TimeStamp() 函数将非常重要，因为我们可能希望包含从给定 TimeStamp 中取出的先前时间点的所有资产。该函数接收两个参数：当前的 TimeStamp 和我们希望结果 TimeStamp 表示的时间间隔。根据选择的间隔，可以是 1 小时、1 天、1 周、1 个月或 1 年，分别表示为 1h、1d、1w、1m 和 1y，我们将调用 lubridate 包中的不同函数（hours()、days()、weeks()、months()、years()），这些函数接收在操作中应使用多少指定名称的单位。这些是在 R 中添加或减去时间的一种简单方法。

注意，如果传递了一个未知的间隔，我们将引发错误。有些人认为应该避免添加这些带有某种错误类型的 else 情况，因为这表明编程不安全，从意义上讲，你应该知道应该传递给函数的选项，你永远不应该真正结束在 else 分支中，他们更愿意通过使用单元测试而不是使用条件检查来确保他们的代码工作。然而，我们使用它来举例说明其用法，因为我们没有使用单元测试来证明代码的正确性。我也认为在这些情况下永远不能过于小心，我发现自己处于添加那个简单的 else 分支有助于我更容易地诊断错误的情况：

subtract.TimeStamp <- function(timestamp, interval) {
    time <- timestamp_to_time.TimeStamp(timestamp)
    if (interval == "1h") {
        time <- time - hours(1)
    } else if (interval == "1d") {
        time <- time - days(1)
    } else if (interval == "1w") {
        time <- time - weeks(1)
    } else if (interval == "1m") {
        time <- time - months(1)
    } else if (interval == "1y") {
        time <- time - years(1)
    } else {
        stop("Unknown interval")
   }
   timestamp <- time_to_timestamp.TimeStamp(time)
   return(timestamp)
}

subtract <- function (object, interval) {
    UseMethod("subtract", object)
}

最后，我们添加了一个方便的 one_year_ago.TimeStamp() 函数，它将简单地生成一个当前的 TimeStamp 并从中减去一年。这是那些随着系统开发而演化的函数之一，因为我注意到我反复需要这个功能，所以我可以这样让我的生活变得稍微容易一些：

one_year_ago.TimeStamp <- function() {
    return(subtract(now.TimeStamp(), "1y"))
}

现在，类已经准备好了。请随意使用它来确保它按预期工作。根据你在本章中迄今为止所看到的，你应该能够创建实例并使用我们创建的不同方法。你也应该尝试破坏它以找到其弱点，并可能改进实现的健壮性。

使用 S4 类实现加密货币资产

现在，我们将使用最少的依赖关系实现我们的下一个抽象，Asset。我们将使用 S4 来实现它，并且它只依赖于 TimeStamp。我们使用之前显示的标准方法定义其类，其属性包括 email 以标识资产属于哪个用户，一个 timestamp 以标识资产在某个时间点的情况，一个 name 以了解我们正在处理什么资产，一个 symbol 以在我们的系统中标识资产类型，一个 total 以记录用户拥有多少该资产，以及一个 address 以标识资产属于哪个钱包（用户可能对同一类型的资产有多个钱包）：

setClass(
    Class = "Asset",
    representation = representation(
        email = "character",
        timestamp = "character",
        name = "character",
        symbol = "character",
        total = "numeric",
        address = "character"
     )
)

注意，我们决定在 timestamp 属性中使用 S3 类而不是 TimeStamp，我们简单地将其声明为 character 并自行管理类型之间的转换。这使我们能够保持对这个转换过程的控制，并避免在混合对象模型时出现意外的 R 语言行为。

接下来，我们提供了设置函数来更改 email 和 timestamp 属性，因为我们将在检索资产数据和将其保存到磁盘时需要它们。这是那些随着系统开发而演化的设计决策之一，我们没有预见我们会需要这些方法；它们是在稍后的时间点添加的：

setGeneric("email<-", function(self, value) standardGeneric("email<-"))
setReplaceMethod("email", "Asset", function(self, value) {
    self@email <- value
    return(self)
})

setGeneric("timestamp<-", function(self, value) standardGeneric("timestamp<-"))
setReplaceMethod("timestamp", "Asset", function(self, value) {
    self@timestamp <- value
    return(self)
})

现在，我们实现一个 dataS4 方法，这将使我们能够从我们的 S4 对象中检索需要保存的数据。注意，我们使用了之前展示的相同技术来区分 dataS4 方法和 dataS3 方法，并避免任何与 R 相关的陷阱：

setGeneric("dataS4", function(self) standardGeneric("dataS4"))
setMethod("dataS4", "Asset", function(self) {
    return(list(
        email = self@email,
        timestamp = self@timestamp,
        name = self@name,
        symbol = self@symbol,
        total = self@total,
        address = self@address
     ))
})

AnalysisAsset 的实现将留到下一章，在那里我们将介绍我们打算用这些数据进行的数据分析类型。

使用 R6 类实现我们的存储层

到目前为止，我们代码的复杂性并没有比颜色、矩形和正方形的示例复杂多少。到了这一点，代码将变得更加复杂，因为我们正在处理更复杂的抽象及其之间的交互，但我们已经准备好用我们目前所知道的知识来应对这个挑战。

使用数据库接口进行可用行为的通信

我们将首先在 Database 类中定义数据库的接口。这个类本身永远不会被实例化。它的目的是简单地提供一个接口定义，这个定义必须被特定的数据库实现所遵守，例如我们将开发的 CSVFiles 实现，以及 Storage 实现，以便与任何数据库进行通信。定义此类接口的优势是它为这些对象之间提供了一种共同的语言，并为程序员提供了一个参考，说明了应该做什么以及方法应该如何命名，以便它们能够与系统中的其他部分无缝工作。在 Python 中，它们会被称为抽象基类。R 没有对这些抽象类的正式用法，但我们可以以这种方式自行实现它们。

如您所见，我们的 R6 Database 接口指定了应该公开实现哪些方法，以及用于数据库的表名应该保持私有。我们添加这个 table_names 列属性，而不是直接在我们的类中硬编码表名，因为我们希望能够在设置文件中轻松地更改它们（关于这一点稍后讨论），并且我们希望能够轻松地为我们将要使用此代码的不同环境（主要是生产环境和开发环境）更改它们。

公共方法包括table_names的获取器和设置器，以及用于读取和写入数据的方法组，这些方法包含一个前缀，说明它们的使用目的。它们期望什么和返回什么应该是显而易见的。具体来说，read_exchanges()方法不接收任何参数，应返回一个Exchange对象列表（稍后定义）。read_users()返回一个User对象列表（也将稍后定义），并需要一个Storage实例，该实例将被分配给每个创建的用户，以便他们可以读取和写入数据。read_wallets()方法接收一个电子邮件字符串，并返回一个Wallet对象列表（也将稍后定义）。read_all_wallets()方法仅适用于系统的admins，并将返回系统中的所有钱包列表，而不仅仅是属于特定用户的钱包。

在写入方面，write_user()方法接收一个User对象并将其写入磁盘，如您通过{}符号所看到的，它不期望返回任何内容。类似地，其他写入方法接收一个类的实例并将其保存到磁盘。我们需要为每种类型的类提供一个写入方法，因为它们在保存时需要不同的处理：

Database <- R6Class(
    "Database",
    public = list(
        set_table_names = function(table_names) {
            private$table_names <- table_names
        },
        get_table_names = function() {
            return(private$table_names)
        },
        read_exchanges = function() list(),
        read_users = function(storage) list(),
        read_wallets = function(email) list(),
        read_all_wallets = function() list(),
        read_analysis_assets = function(email) list(),
        write_user = function(user) {},
        write_wallet = function(wallet) {},
        write_assets = function(assets) {},
        write_markets = function(markets) {}
    ),
    private = list(table_names = list())
)

使用 CSV 文件实现类似数据库的存储系统

现在我们已经定义了Database接口，我们将实现一个类似数据库的系统，该系统使用 CSV 文件来存储信息，而不是实际的数据库。

首先，我们确保通过使用source()函数引入CSVFiles类的依赖项，以引入包含所需定义的文件。具体来说，我们引入了Exchange和User类（稍后定义），以及Database接口。我们还定义了DIR常量，它将包含包含我们系统数据的 CSV 文件的目录。

实际的CSVFiles类使用前面显示的标准 R6 方法定义。请注意，它继承自Database类，并为Database接口中的每个方法提供了覆盖，正如它应该做的那样。另外请注意，在构造函数中，即initialize函数内部，我们正在调用initialize_csv_files()函数，并传递在初始化期间接收到的table_names列表。关于这一点，稍后会有更多说明。

由于我们希望读者能够一次性查看完整的类定义，而不是逐部分查看，所以我们在这里包含了所有内容，并在接下来的段落中解释它。由于它包含了Database接口中所有方法的逻辑，所以它有点长，但从高层次来看，它不过是该接口的实现：

source("../assets/exchanges/exchange.R", chdir = TRUE)
source("../users/user.R", chdir = TRUE)
source("./database.R")
DIR <- "./csv-files/"

CSVFiles <- R6Class(
    "CSVFiles",
    inherit = Database,
    public = list(
        initialize = function(table_names) {
            super$set_table_names(table_names)
            initialize_csv_files(table_names)
        },
        read_exchanges = function() {
            return(list(Exchange$new("CoinMarketCap")))
        },
        read_users = function(storage) {
            data <- private$read_csv("users")
            return(lapply(data$email, user_constructor, storage))
        },
        read_wallets = function(email) {
            data <- private$read_csv("wallets")
            wallets <- NULL
            if (nrow(data) >= 1) {
                for (i in 1:nrow(data)) {
                    if (data[i, "email"] == email) {
                        wallets <- c(wallets, list(Wallet$new(
                            data[i, "email"],                 
                            data[i, "symbol"],
                            data[i, "address"], 
                            data[i, "note"])
                        ))
                    }
                }
            } else { wallets <- list() }
            return(wallets)
        },
        read_all_wallets = function() {
            data <- private$read_csv("wallets")
            wallets <- NULL
            if (nrow(data) >= 1) {
                for (i in 1:nrow(data)) {
                    wallets <- c(wallets, list(Wallet$new(
                        data[i, "email"], 
                        data[i, "symbol"],
                        data[i, "address"], 
                        data[i, "note"])
                    ))
                }
            } else { wallets <- list() }
            return(wallets)
        },
        write_user = function(user) {
            data <- private$read_csv("users")
            new_row <- as.data.frame(dataS3(user))
            print(new_row)
            if (private$user_does_not_exist(user, data)) {
                data <- rbind(data, new_row)
            }
            private$write_csv("users", data)
        },
        write_wallets = function(wallets) {
            data <- private$read_csv("wallets")
            for (wallet in wallets) {
                new_row <- as.data.frame(wallet$data())
                print(new_row)
                if (private$wallet_does_not_exist(wallet, data)) {
                    data <- rbind(data, new_row)
                }
            }
            private$write_csv("wallets", data)
        },
        write_assets = function(assets) {
            data <- private$read_csv("assets")
            for (asset in assets) {
                new_row <- as.data.frame(dataS4(asset))
                print(new_row)
                data <- rbind(data, new_row)
            }
            private$write_csv("assets", data)
        },
        write_markets = function(markets) {
            data <- private$read_csv("markets")
            for (market in markets) {
                new_row <- as.data.frame(market$data())
                print(new_row)
                data <- rbind(data, new_row)
            }
            private$write_csv("markets", data)
        }
    ),
    private = list(
        read_csv = function(table_name) {
            return(read.csv (
                       private$file(table_name), 
                       stringsAsFactors = FALSE))
        },
        write_csv = function(table_name, data) {
            write.csv(data, 
                      file = private$file(table_name), 
                      row.names = FALSE)
        },
        file = function(table_name) {
            return(paste(
                DIR, super$get_table_names()[[table_name]], 
                ".csv", sep = ""))
        },
        user_does_not_exist = function(user, data) {
            if (dataS3(user)[["email"]] %in% data$email) {
                return(FALSE)
            }
            return(TRUE)
        },
        wallet_does_not_exist = function(wallet, data) {
            current_addresses <- data[
                data$email == wallet$get_email() &
                data$symbol == wallet$get_symbol(),
                "address"
            ]
            if (wallet$get_address() %in% current_addresses) {
                return(FALSE)
            }
            return(TRUE)
        }
    )
)

现在，我们将简要解释每个方法实现背后的机制。让我们从 read_exchanges() 开始。从理论上讲，这个方法应该在存储的数据中查找，获取系统中注册的交易所列表，为每个交易所创建一个实例，并将其发送回去。然而，在实践中，这并不必要，因为直接硬编码 CoinMarketCap 交易所就足够我们使用了。正如你所见，这就是该方法所做的一切：返回一个包含单个 Exchange 的列表，这就是 CoinMarketCap 的那个。

read_users() 方法使用下面定义的私有方法 read_csv() 从 "user" 文件中读取数据，并返回一个列表，该列表是通过 lapply() 函数构建的，该函数将数据中的每个电子邮件发送到 user_constructor()，同时接收一个作为参数的 storage 对象来创建 User 实例，然后作为方法调用的结果发送回去。如果你不记得 lapply() 函数是如何工作的，请查看 第一章，R 语言入门。

read_wallets() 方法稍微复杂一些。它接收一个 email 作为参数，读取 "wallets" 文件，并创建一个 Wallet 实例的列表。由于我们需要检查数据中的特定观察结果是否包含一个与请求相同的 email，我们可以简单地使用 lapply() 函数（如果我们创建一个包含此检查的单独函数，也可以进行检查，但我们决定不采取那条路线）。此外，请注意，如果数据框至少包含一行，函数将只尝试遍历数据框中的行。这个检查是在我们发现，在没有它的情况下，当我们处理空文件时，我们遇到了错误，因为即使没有行，for 循环实际上也在执行。如果发现 email 与请求的相同，则将一个新的 Wallet 实例追加到 wallets 列表中并返回它。如果没有要创建的钱包，则 wallets 对象被强制转换为空列表。read_all_wallets() 方法以相同的方式工作，但省略了 email 检查。

write_user() 方法接收一个 User 实例，读取 "users" 文件的 data，使用从 User 对象中调用 dataS3 方法提取的数据创建一个数据框，为了信息目的将其打印到控制台，并且如果它被发现当前数据中不存在，则将其添加进去。最后，数据被保存回 "users" 文件。实际的检查是通过前面提到的私有方法 user_does_not_exist() 执行的，该方法简单地检查 User 的电子邮件是否不包含在数据中的 email 列中，正如你在其定义中可以看到的那样。

write_wallets()方法接收一个Wallet实例列表，读取"wallets"文件，并为每个未在数据中找到已存在的wallet添加它。从概念上讲，它与write_user()方法类似，检查是通过私有的wallet_does_not_exist()方法进行的，该方法接收一个Wallet实例并使用其包含的email和symbol来获取已与这种组合关联的addresses。如果Wallet实例中的address被发现已存在于这样的子集中，则不会添加。

write_assets()和write_markets()方法类似，应该容易理解。不同之处在于它们目前不包含任何检查，并且分别保存 S4 和 R6 对象。你可以通过它们调用dataS4()方法和获取Market数据的语法来识别这一点，即market$data()。

用于读取和写入 CSV 文件的私有方法应该容易理解。只需记住，实际的文件名来自file()私有方法，该方法通过调用超类（Database）的super$get_table_names()获取器并检索与给定table_name关联的文件名来使用包含在超类中的table_names。table_name列表将在集中设置的文件中定义，但它只是一个包含每个表名（在CSVFiles的情况下是文件名）的字符串的列表，这些表名与需要存储的每种对象类型相关联。

现在，我们继续讨论initialize_csv_files()函数。这个函数接收table_names列表，并使用dir.create()函数确保DIR目录存在。showWarnings = FALSE参数是为了避免当目录已在磁盘上存在时产生警告。然后，对于table_names列表中的每个元素，它将创建相应的filename，并使用file.exists()函数检查它是否在磁盘上存在。如果不存在，它将创建一个对应类型的空数据框并将其保存到磁盘上：

initialize_csv_files <- function(table_names) {
    dir.create(DIR, showWarnings = FALSE)
    for (table in table_names) {
        filename <- paste(DIR, table, ".csv", sep = "")
        if (!file.exists(filename)) {
            data <- empty_dataframe(table)
            write.csv(data, file = filename, row.names = FALSE)
         }
    }
}

使用empty_dataframe()函数选择不同类型的空数据框，该函数接收table参数中的特定表名并返回相应的空数据框。请注意，检查假设需要保存的不同对象的单词位于集中设置的文件中定义的表名内，并且两个不同的抽象的名称不会在单个表名中同时出现：

empty_dataframe <- function(table) {
    if (grepl("assets", table)) {
        return(empty_assets())
    } else if (grepl("markets", table)) {
        return(empty_markets())
    } else if (grepl("users", table)) {
        return(empty_users())
    } else if (grepl("wallets", table)) {
        return(empty_wallets())
    } else {
        stop("Unknown table name")
    }
}

实际的空数据框是由empty_assets()、empty_markets()、empty_users()和empty_wallets()函数创建的。每个函数都包含了对这些文件中预期数据的规范。具体来说，资产数据中的每个观察值都应有一个电子邮件、时间戳、名称、符号、总数和地址。市场数据中的每个观察值应有一个时间戳、名称、符号、排名、BTC 价格和 USD 价格。排名是基于过去 24 小时内交易量的加密货币排序。用户数据只应包含电子邮件。最后，钱包数据应包含电子邮件、符号、地址和备注。备注是用户可能指定的备注，用于区分不同的钱包，特别是如果它们被用于同一种类型的加密货币。也许一个比特币钱包是用于长期存储，另一个是用于短期存储；那么这些信息可以在备注字段中指定。注意，您可以使用第四章中介绍的概念来识别这些数据方案之间的关系，模拟销售数据和与数据库协同工作。让我们看看以下代码：

empty_assets <- function() {
    return(data.frame(
        email = character(),
        timestamp = character(),
        name = character(),
        symbol = character(),
        total = numeric(),
        address = character()
    ))
}

empty_markets <- function() {
    return(data.frame(
        timestamp = character(),
        name = character(),
        symbol = character(),
        rank = numeric(),
        price_btc = numeric(),
        price_usd = numeric()
    ))
}

empty_users <- function() {
    return(data.frame(
        email = character()
    ))
}

empty_wallets <- function() {
    return(data.frame(
        email = character(),
        symbol = character(),
        address = character(),
        note = character()
    ))
}

通过工厂轻松实现新的数据库集成

目前我们知道我们只会使用CSVFiles 数据库实现来演示这个例子，但我们可以轻松想象出新的数据库实现将如何发挥作用。例如，读者将创建 MySQL 数据库的实现，并希望它能够替代CSVFiles实现。不是吗？当你预期未来可能需要切换一个接口实现到另一个时，工厂是一个很好的工具，可以帮助你在未来方便地实现这种变化。

我们的database_factory()函数接收一个db_setup和table_names对象，这两个对象都将来自我们的集中设置文件。然后它根据数据库的环境选择适当的表名集，并在提供的db_setup中查找需要实例化的Database实现类型。由于目前我们只有一个，唯一可能的选择将是CSVFiles实现，如果我们传递任何其他字符串，那么应该抛出一个错误，正如它所做的那样。实际实例化的Database实现应该接收一个table_names对象并相应地配置自己：

source("./csv-files.R")

database_factory <- function(db_setup, table_names) {
    table_names <- table_names[[db_setup[["environment"]]]]
    if (db_setup[["name"]] == "CSVFiles") {
        return(CSVFiles$new(table_names))
    } else {
        stop("Unknown database name")
    }
}

如您所见，工厂不过是一个if语句，它决定应该实例化并返回给调用对象的哪种实现。

使用存储层封装多个数据库

现在我们已经开发出了我们的数据库接口以及该接口的CSVFiles实现，我们准备开发下一层的抽象，即我们的Storage类。它将使用 R6 来实现。

如你所见，Storage 构造函数在 initialize 函数中实现，它接收一个 settings 对象，这将是我们一直在提到的完整集中式设置文件，并将使用 storage/read、storage/write 和 storage/table_names 部分通过之前解释的 database_factory() 函数创建各种数据库实例。在 read_db 属性的情况下，它将是一个用于读取数据的单个 Database 实现。在 write_dbs 属性的情况下，正如其名称所暗示的，我们将有一个 Database 实现的列表，其中每个其他对象请求保存的数据都将被存储。

通过这个 Storage 抽象，我们可以简单地将其发送给寻找类似数据库对象以保存和读取数据的对象，并且它会根据需要为我们复制数据，同时为这些对象提供数据。为了实现这一点，你可以要求在读取方法的情况下，它只需将任务委托给其 read_db 属性中包含的 Database 实现即可，而在写入方法的情况下，它对其 write_dbs 属性中的每个 Database 实现都做同样的事情。就这么简单：

source("./database-factory.R")
Storage <- R6Class(
    "Storage",
    public = list(
        initialize = function(settings) {
            private$read_db <- database_factory(
                settings[["storage"]][["read"]],
                settings[["storage"]][["table_names"]]
            )
            private$write_dbs <- lapply(
                settings[["storage"]][["write"]],
                database_factory,
                settings[["storage"]][["table_names"]]
            )
        },
        read_exchanges = function() {
            return(private$read_db$read_exchanges())
        },
        read_users = function() {
            return(private$read_db$read_users(self))
        },
        read_wallets = function(email) {
            return(private$read_db$read_wallets(email))
        },
        read_all_wallets = function() {
            return(private$read_db$read_all_wallets())
        },
        read_analysis_assets = function(email) {
            return(private$read_db$read_analysis_assets(email))
        },
        write_user = function(user) {
            for (db in private$write_dbs) { db$write_user(user) }
        },
        write_wallets = function(wallets) {
            for (db in private$write_dbs) { db$write_wallets(wallets) }
        },
        write_assets = function(assets) {
            for (db in private$write_dbs) { db$write_assets(assets) }
        },
        write_markets = function(markets) {
            for (db in private$write_dbs) { db$write_markets(markets) }
        }
    ),
    private = list(read_db = NULL, write_dbs = list())
)

这就是我们的存储抽象的全部内容。到目前为止，我们已经实现了一个 Database 接口，一个 CSVFiles 接口实现，以及一个 Storage 层，它允许我们同时使用多个 Database 实现并为我们解耦读取和写入对象。我们可以选择为读取操作使用一种类型的数据库，为写入操作使用另一种类型的数据库，并有一种外部机制在 R 外部将它们同步起来。这可能在性能方面很有用，例如。

使用 R6 类检索市场和钱包的实时数据

本节将解释如何创建一个简单的请求者，这是一个请求外部信息（在这种情况下是通过互联网上的 API）的对象。我们还将开发我们的交易所和钱包基础设施。

创建一个非常简单的请求者以隔离 API 调用

现在，我们将关注我们如何实际检索实时数据。此功能也将使用 R6 类来实现，因为交互可能很复杂。首先，我们创建一个简单的 Requester 类，该类包含从互联网其他地方找到的 JSON API 获取数据的逻辑，并将用于获取钱包和市场的实时加密货币数据。我们不希望逻辑与外部 API 交互散布在我们的类中，因此我们将其集中在这里，以便在以后出现更专业化的需求时进行管理。

正如你所见，这个对象所做的一切就是提供一个公共的 request() 方法，它所做的一切就是使用 jsonlite 包中的 formJSON() 函数调用传递给它的 URL，并将获取的数据发送回用户。具体来说，当从外部 API 接收到的数据可以被强制转换为数据框格式时，它会将其作为数据框发送。

library(jsonlite)

Requester <- R6Class(
    "Requester",
    public = list(
        request = function(URL) {
            return(fromJSON(URL))
        }
    )
)

开发我们的交易所基础设施

我们交易所内部有多个市场，这就是我们现在要定义的抽象。Market 有各种私有属性，正如我们在定义每个文件期望的数据时所见，这就是我们在构造函数中看到的数据。它还提供了一个 data() 方法，用于返回一个列表，其中包含应保存到数据库中的数据。最后，它提供了所需的设置器和获取器。请注意，价格设置器取决于请求的单位，可以是 usd 或 btc，以分别获取以美元或比特币计价的市场资产价格：

Market <- R6Class(
    "Market",
    public = list(
        initialize = function(timestamp, name, symbol, rank,
                              price_btc, price_usd) {
            private$timestamp <- timestamp
            private$name <- name
            private$symbol <- symbol
            private$rank <- rank
            private$price_btc <- price_btc
            private$price_usd <- price_usd
        },
        data = function() {
            return(list(
                timestamp = private$timestamp,
                name = private$name,
                symbol = private$symbol,
                rank = private$rank,
                price_btc = private$price_btc,
                price_usd = private$price_usd
            ))
        },
        set_timestamp = function(timestamp) {
            private$timestamp <- timestamp
        },
        get_symbol = function() {
            return(private$symbol)
        },
        get_rank = function() {
            return(private$rank)
        },
        get_price = function(base) {
            if (base == 'btc') {
                return(private$price_btc)
            } else if (base == 'usd') {
                return(private$price_usd)
            }
        }
    ),
    private = list(
        timestamp = NULL,
        name = "",
        symbol = "",
        rank = NA,
        price_btc = NA,
        price_usd = NA
    )
)

现在我们已经有了 Market 定义，我们继续创建 Exchange 定义。这个类将接收一个交易所名称作为 name，并使用 exchange_requester_factory() 函数获取相应 ExchangeRequester 的实例。它还提供了一个 update_markets() 方法，该方法将用于通过私有的 markets() 方法检索市场数据，并使用传递给它的 timestamp 和 storage 对象将其存储到磁盘上。请注意，与通过私有 markets() 方法的参数传递 timestamp 不同，它被保存为类属性，并在私有的 insert_metadata() 方法中使用。这种技术提供了更干净的代码，因为 timestamp 不需要通过每个函数传递，并在需要时检索。

私有的 markets() 方法在 ExchangeRequester 实例中调用公共的 markets() 方法（该实例存储在私有的 requester 属性中，由工厂分配），并在将它们写入数据库之前，应用私有的 insert_metadata() 方法来更新这些对象的 timestamp，以匹配之前发送给公共 update_markets() 方法调用的那个：

source("./requesters/exchange-requester-factory.R", chdir = TRUE)

Exchange <- R6Class(
    "Exchange",
    public = list(
        initialize = function(name) {
            private$requester <- exchange_requester_factory(name)
        },
        update_markets = function(timestamp, storage) {
            private$timestamp <- unclass(timestamp)
            storage$write_markets(private$markets())
        }
    ),
    private = list(
        requester = NULL,
        timestamp = NULL,
        markets = function() {
            return(lapply(private$requester$markets(), private$insert_metadata))
        },
        insert_metadata = function(market) {
            market$set_timestamp(private$timestamp)
            return(market)
        }
    )
)

现在，我们需要为我们的 ExchangeRequester 实现提供一个定义。正如在 Database 的情况下，这个 ExchangeRequester 将充当接口定义，将由 CoinMarketCapRequester 实现。我们看到 ExchangeRequester 指定所有交易所请求实例都应该提供一个公共的 markets() 方法，并且该方法应返回一个列表。从上下文来看，我们知道这个列表应包含 Market 实例。此外，每个 ExchangeRequester 实现默认将包含一个 Requester 对象，因为它在类实例化时创建并分配给 requester 私有属性。最后，每个实现还必须提供一个 create_market() 私有方法，并且可以使用我们之前定义的 request() 私有方法与 Requester 的 request() 方法进行通信：

source("../../../utilities/requester.R")

KNOWN_ASSETS = list(
    "BTC" = "Bitcoin",
    "LTC" = "Litecoin"
)
ExchangeRequester <- R6Class(
    "ExchangeRequester",
    public = list(
        markets = function() list()
    ),
    private = list(
        requester = Requester$new(),
        create_market = function(resp) NULL,
        request = function(URL) {
            return(private$requester$request(URL))
        }
    )
)

现在我们继续为 CoinMarketCapRequester 提供一个实现。如您所见，它继承自 ExchangeRequester，并提供了所需的方法实现。具体来说，markets() 公共方法调用 ExchangeRequester 中的私有 request() 方法，后者又调用我们之前看到的 Requester 的 request() 方法，以从指定的私有 URL 获取数据。

如果您通过打开网页并导航到显示的 URL（api.coinmarketcap.com/v1/ticker）来从 CoinMarketCap 的 API 请求数据，您将获得一系列市场数据。这些数据将以数据框的形式接收，存储在我们的 CoinMarketCapRequester 实例中，归功于 Requester 对象，并且将使用私有的 clean() 方法进行适当的转换，以便稍后使用 apply() 函数调用创建 Market 实例。请注意，由于您可能还记得我们的 Exchange 类，所有以这种方式创建的市场 timestamp 都被设置为 NULL，因为它在写入数据库之前被设置。没有必要将 timestamp 信息发送到 CoinMarketCapRequester，因为我们可以在将数据发送到数据库之前直接在 Exchange 层级上写入：

source("./exchange-requester.R")
source("../market.R")

CoinMarketCapRequester <- R6Class(
    "CoinMarketCapRequester",
    inherit = ExchangeRequester,
    public = list(
        markets = function() {
            data <- private$clean(private$request(private$URL))
            return(apply(data, 1, private$create_market))
        }
    ),
    private = list(
        URL = "https://api.coinmarketcap.com/v1/ticker",
        create_market = function(row) {
            timestamp <- NULL
            return(Market$new(
                timestamp,
                row[["name"]],
                row[["symbol"]],
                row[["rank"]],
                row[["price_btc"]],
                row[["price_usd"]]
            ))
        },
        clean = function(data) {
            data$price_usd <- as.numeric(data$price_usd)
            data$price_btc <- as.numeric(data$price_btc)
            data$rank <- as.numeric(data$rank)
            return(data)
        }
    )
)

最后，这是我们的 exchange_requester_factory() 的代码。如您所见，它与我们在其他工厂中使用的想法基本相同，其目的是通过在其中添加 else-if 语句来轻松地让我们为我们的 ExchangeRequeseter 添加更多实现：

source("./coinmarketcap-requester.R")

exchange_requester_factory <- function(name) {
    if (name == "CoinMarketCap") {
        return(CoinMarketCapRequester$new())
    } else {
        stop("Unknown exchange name")
    }   
}

开发我们的钱包基础设施

现在我们能够从交易所检索实时价格数据后，我们转向我们的 Wallet 定义。如您所见，它指定了我们期望用于处理所需数据的私有属性类型，以及公共的 data() 方法，用于创建需要在某个时候保存到数据库中的数据列表。

它还提供了 email、symbol 和 address 的获取器，以及公共的 pudate_assets() 方法，该方法将用于将资产获取并保存到数据库中，就像我们在 Exchange 的情况下所做的那样。事实上，遵循的技术是完全相同的，所以我们不会再次解释：

source("./requesters/wallet-requester-factory.R", chdir = TRUE)

Wallet <- R6Class(
    "Wallet",
    public = list(
        initialize = function(email, symbol, address, note) {
            private$requester <- wallet_requester_factory(symbol, address)
            private$email <- email
            private$symbol <- symbol
            private$address <- address
            private$note <- note
        },
        data = function() {
            return(list(
                email = private$email,
                symbol = private$symbol,
                address = private$address,
                note = private$note
            ))
        },
        get_email = function() {
            return(as.character(private$email))
        },
        get_symbol = function() {
            return(as.character(private$symbol))
        },
        get_address = function() {
            return(as.character(private$address))
        },
        update_assets = function(timestamp, storage) {
            private$timestamp <- timestamp
            storage$write_assets(private$assets())
        }
    ),
    private = list(
        timestamp = NULL,
        requester = NULL,
        email = NULL,
        symbol = NULL,
        address = NULL,
        note = NULL,
        assets = function() {
            return (lapply (
                    private$requester$assets(), 
                    private$insert_metadata))
        },
        insert_metadata = function(asset) {
            timestamp(asset) <- unclass(private$timestamp)
            email(asset) <- private$email
            return(asset)
        }
    )
)

实现我们的钱包请求器

WalletRequester 在概念上将与 ExchangeRequester 相似。它将是一个接口，并将在我们 BTCRequester 和 LTCRequester 接口中实现。正如你所看到的，它需要一个名为 assets() 的公共方法来实现，并返回一个 Asset 实例的列表。它还需要实现一个私有的 create_asset() 方法，该方法应返回单个 Asset 实例，以及一个私有的 url 方法，它将构建 API 调用所需的 URL。它提供了一个 request() 私有方法，该方法将由实现用于从外部 API 获取数据：

source("../../../utilities/requester.R")

WalletRequester <- R6Class(
    "WalletRequester",
    public = list(
        assets = function() list()
    ),
    private = list(
        requester = Requester$new(),
        create_asset = function() NULL,
        url = function(address) "",
        request = function(URL) {
            return(private$requester$request(URL))
        }
    )
)

以下展示了 BTCRequester 和 LTCRequester 的实现，以示完整性，但不会进行解释。如果你已经跟随了前面的内容，它们应该很容易理解：

source("./wallet-requester.R")
source("../../asset.R")

BTCRequester <- R6Class(
    "BTCRequester",
    inherit = WalletRequester,
    public = list(
        initialize = function(address) {
            private$address <- address
        },
        assets = function() {
            total <- as.numeric(private$request(private$url()))
            if (total > 0) { return(list(private$create_asset(total))) }
            return(list())
        }
    ),
    private = list(
        address = "",
        url = function(address) {
            return(paste(
                "https://chainz.cryptoid.info/btc/api.dws",
                "?q=getbalance",
                "&a=",
                private$address,
                sep = ""
            ))
        },
        create_asset = function(total) {
            return(new(
                "Asset",
                email = "",
                timestamp = "",
                name = "Bitcoin",
                symbol = "BTC",
                total = total,
                address = private$address
            ))
        }
    )
)

source("./wallet-requester.R")
source("../../asset.R")

LTCRequester <- R6Class(
    "LTCRequester",
    inherit = WalletRequester,
    public = list(
        initialize = function(address) {
            private$address <- address
        },
        assets = function() {
            total <- as.numeric(private$request(private$url()))
            if (total > 0) { return(list(private$create_asset(total))) }
            return(list())
        }
    ),
    private = list(
        address = "",
        url = function(address) {
            return(paste(
                "https://chainz.cryptoid.info/ltc/api.dws",
                "?q=getbalance",
                "&a=",
                private$address,
                sep = ""
            ))
        },
        create_asset = function(total) {
            return(new(
                "Asset",
                email = "",
                timestamp = "",
                name = "Litecoin",
                symbol = "LTC",
                total = total,
                address = private$address
            ))
        }
    )
)

wallet_requester_factory() 与其他工厂的工作方式相同；唯一的区别是，在这种情况下，我们有两种可能的实现可以返回，这可以在 if 语句中看到。如果我们决定为另一种加密货币，如以太坊，添加一个 WalletRequester，我们只需简单地在这里添加相应的分支，它应该可以正常工作：

source("./btc-requester.R")
source("./ltc-requester.R")

wallet_requester_factory <- function(symbol, address) {
    if (symbol == "BTC") {
        return(BTCRequester$new(address))
    } else if (symbol == "LTC") {
        return(LTCRequester$new(address))
    } else {
        stop("Unknown symbol")
    }
}

最后介绍使用 S3 类的用户

我们面向对象系统几乎已经完成。我们唯一缺少的是 User 定义。在这种情况下，我们将使用 S3 来定义 User 类。user_constructor() 函数接受一个 email 和一个在 storage 中的 Storage 实例来创建一个 User 实例。然而，在它这样做之前，它会使用下面定义的 valid_email() 函数检查电子邮件是否有效。在用户创建后，将调用 get_wallets() 方法来获取与用户关联的钱包，然后再将其发送回去。

valid_email() 函数简单地接收一个字符串，该字符串应是一个电子邮件地址，并检查其中是否至少包含一个 @ 和一个 . 符号。当然，这不是一个健壮的机制来检查它是否是一个电子邮件地址，它只是用来说明如何实现检查机制：

source("../assets/wallets/wallet.R", chdir = TRUE)

user_constructor <- function(email, storage) {
    if (!valid_email(email)) { stop("Invalid email") }
    user <- list(storage = storage, email = email, wallets = list())
    class(user) <- "User"
    user <- get_wallets(user)
    return(user)
}

valid_email <- function(string) {
    if (grepl("@", string) && grepl(".", string)) { return(TRUE) }
    return(FALSE)
}

get_wallets.User() 函数简单地请求对象中的 storage 属性以获取与其电子邮件地址关联的钱包，将它们分配给 wallets 列表属性，并将 User 对象返回：

get_wallets.User <- function(user) {
    user$wallets <- user$storage$read_wallets(user$email)
    return(user)
}

get_wallets <- function(object) {
    UseMethod("get_wallets")
}

new_wallet.User() 函数接收一个 User 实例、一个 symbol 字符串、一个 address 字符串和一个 note 字符串，以创建一个新的 Wallet 实例并将其附加到传递给它的 User 实例的 wallets 列表属性中。然而，在它这样做之前，它会检查所有之前注册的用户钱包。如果它发现一个钱包已经注册，它将简单地忽略添加并返回相同的 User 实例。这是你可能在自己的系统中实现的一种检查类型：

new_wallet.User <- function(user, symbol, address, note) {
    if (length(user$wallets) >= 1) {
        for (wallet in user$wallets) {
            if (wallet$get_symbol() == symbol &
                wallet$get_address() == address) {
                return(user)
            }
       }
   }
   wallet <- Wallet$new(user$email, symbol, address, note)
   user$wallets <- c(user$wallets, list(wallet))
   return(user)
}
new_wallet <- function(object, symbol, address, note) {
    UseMethod("new_wallet")
}

update_assets.User() 函数简单地遍历 wallets 列表属性中的每个 Wallet 实例，并使用传递给它的当前 timestamps 和包含在 User 实例内的 Storage 实例调用其公共 update_assets() 方法。正如我们之前所看到的，这会导致资产被更新并保存到数据库中，而 Wallet 对象则代表 User 实例处理这一过程：

update_assets.User <- function(user, timestamp) {
    for (wallet in user$wallets) {
        wallet$update_assets(timestamp, user$storage)
    }
}
update_assets <- function(object, timestamp) {
    UseMethod("update_assets")
}

save.User() 函数简单地使用 storage 属性来保存 User 实例及其钱包数据。正如我们所见，如果钱包已经在保存的数据中存在，它们将不会被重复，而 CSVFiles 实现则代表 User 实例处理这一过程：

save.User <- function(user) {
    user$storage$write_user(user)
    user$storage$write_wallets(user$wallets)
}

save <- function(object) {
    UseMethod("save")
}

最后，用户提供了一个 dataS3.User() 方法来返回一个包含用户电子邮件的列表，以便将其保存回数据库：

dataS3.User <- function(user) {
    return(list(email = user$email))
}
dataS3 <- function(object) {
    UseMethod("dataS3")
}

正如本节所展示的，在投入一些工作之后，我们可以开发出既美观又直观的抽象，利用其他对象中实现的功能来提供强大的机制，例如通过简单的调用将数据保存到数据库中。

利用集中式设置文件

最后，我们展示了在整个示例中提到的著名的集中式设置文件。正如你所见，它只是一个包含我们系统应如何行为的参数的列表列表。像我们这里这样做，将这些选项集中在一个文件中通常非常方便。当我们想要从系统中获得不同的行为时，我们只需更改此文件，所有的事情都会为我们处理：

SETTINGS <- list(
    "debug" = TRUE,
    "storage" = list(
        "read" = list(
            "name" = "CSVFiles",
            "environment" = "production"
        ),
        "write" = list(
            list(
                "name" = "CSVFiles",
                "environment" = "production"
            )
        ),
        "table_names" = list(
            "production" = list(
                "assets" = "production_assets",
                "markets" = "production_markets",
                "users" = "production_users",
                "wallets" = "production_wallets"
            ),
            "development" = list(
                "assets" = "development_assets",
                "markets" = "development_markets",
                "users" = "development_users",
                "wallets" = "development_wallets"
            )
        )
    ),
    "batch_data_collection" = list(
        "assets" = list(
            "minutes" = 60
       ),
       "markets" = list(
            "minutes" = 60
       )
    )
)

特别注意，有一个名为 debug 的布尔值，我们最终没有使用，但在某个时候调试我们的系统时可能会很有用。另外，请注意，我们的设置文件有两个主要部分，即 storage 部分和 batch_data_collection 部分。storage 部分是我们迄今为止使用的部分，它包含通过在 name 元素中提供应使用的实现名称来指定哪些数据库应被用于读取和写入数据，以及我们当前正在运行的 environment，这可以是 production 或 development。这两个元素都被工厂用于在系统开始运行之前适当地设置系统。另外，请注意，将要创建的 CSV 文件对应于在 table_names 元素中找到的字符串，并且将根据数据库指示运行的 environment 而有所不同。

将我们的初始用户数据保存到系统中

在我们开始使用我们的系统之前，我们需要向其中引入一些数据，这些数据将被用来为我们检索数据。具体来说，我们需要创建一些用户，向他们添加一些钱包，并将它们保存。为此，我们创建了一个名为 create-user-data.R 的文件，其中包含将为我们完成此任务的脚本。该脚本加载了 S4 和 R6 对象模型（S3 不需要显式加载），源文件包含我们直接需要的定义，即 Storage、User 和 SETTINGS，为我们创建了两个用户，并将它们保存：

library(R6)
library(methods)

source("../storage/storage.R", chdir = TRUE)
source("../users/user.R")
source("../settings.R")

storage = Storage$new(SETTINGS)
user_1 <- user_constructor("1@somewhere.com", storage)

user_1 <- new_wallet(user_1, 
                     "BTC", 
                     "3D2oetdNuZUqQHPJmcMDDHYoqkyNVsFk9r", "")

user_1 <- new_wallet(user_1, 
                     "LTC", 
                     "LdP8Qox1VAhCzLJNqrr74YovaWYyNBUWvL", "")
save(user_1)

user_2 <- user_constructor("2@somewhere.com", storage)

user_2 <- new_wallet(user_2, 
                     "BTC", 
                     "16rCmCmbuWDhPjWTrpQGaU3EPdZF7MTdUk", "")

user_2 <- new_wallet(user_2, 
                     "LTC", 
                     "LbGi4Ujj2dhcMdiS9vaCpWxtayBujBQYZw", "")
save(user_2)

脚本执行后，您可以查看 csv-files/ 目录，并找到相应的数据。在这种情况下，我们使用了拥有最多比特币和莱特币的钱包，这些钱包可以在网上找到（bitinfocharts.com/top-100-richest-bitcoin-addresses.html 和 bitinfocharts.com/top-100-richest-litecoin-addresses.html）。您可以使用自己的钱包进行实验，或者任何您想要跟踪内容的钱包。当然，email 和 note 参数不需要是真实的；唯一必须真实的参数是资产符号，对于我们所实现的系统，这些符号只能是 BTC 或 LTC，以及此类符号的钱包地址。您可以像示例中那样留空 note 字段。

通过两个简单的函数激活我们的系统

在你将一些数据加载到系统中之后，你将能够执行 update-markets.R 和 update-assets.R 文件，其内容如下所示。第一个文件加载所需的定义，就像我们之前在创建用户数据时做的那样，并提供了 update_markets_loop() 函数，该函数接收一个参数，指定每次检索实时市场数据之间的分钟数。每 60 分钟是一个不错的选择，这也是我们在下面使用的。该函数简单地使用之前显示的 SETTINGS 规范创建一个 Storage 实例，获取现有的交易所（目前只有 CoinMarketCap），并在每个交易所上调用公共的 update_markets() 方法，并使用相应的参数：

library(R6)
library(methods)

source("../storage/storage.R", chdir = TRUE)
source("../utilities/time-stamp.R")
source("../settings.R")

update_markets_loop <- function(minutes_interval) {
    storage = Storage$new(SETTINGS)
    exchanges <- storage$read_exchanges()
    repeat {
        timestamp = now.TimeStamp()
        for (exchange in exchanges) {
            exchange$update_markets(timestamp, storage)
        }
        Sys.sleep(minutes_interval * 60)
    }
}
update_markets_loop(60)

当你执行此文件时，你将在控制台看到一些数据，如下所示。注意，我们使用我们在第一章中提到的 Rscript 命令来启动脚本，R 语言简介：

$ Rscript update-markets.R 
...
         timestamp    name symbol rank  price_btc   price_usd
1 2017-11-21-20-03 Bitcoin    BTC    1 1.00000000 8.12675e+03
         timestamp     name symbol rank  price_btc   price_usd
1 2017-11-21-20-03 Ethereum    ETH    2 0.04440240 3.61538e+02
         timestamp         name symbol rank  price_btc   price_usd
1 2017-11-21-20-03 Bitcoin Cash    BCH    3 0.14527100 1.18284e+03
         timestamp   name symbol rank  price_btc   price_usd
1 2017-11-21-20-03 Ripple    XRP    4 0.00002866 2.33352e-01
         timestamp name symbol rank  price_btc   price_usd
1 2017-11-21-20-03 Dash   DASH    5 0.06127300 4.98903e+02
         timestamp     name symbol rank  price_btc   price_usd
1 2017-11-21-20-03 Litecoin    LTC    6 0.00863902 7.03415e+01
         timestamp name symbol rank  price_btc   price_usd
1 2017-11-21-20-03 IOTA  MIOTA    7 0.00011163 9.08941e-01
         timestamp name symbol rank  price_btc   price_usd
1 2017-11-21-20-03  NEO    NEO    8 0.00427168 3.47813e+01
         timestamp   name symbol rank  price_btc   price_usd
1 2017-11-21-20-03 Monero    XMR    9 0.01752360 1.42683e+02
         timestamp name symbol rank  price_btc   price_usd
1 2017-11-21-20-03  NEM    XEM   10 0.00002513 2.04613e-01
...

update_assets_loop() 函数的工作方式类似，但它会在每次迭代中检索用户，这会动态地适应包括在函数等待下一次周期时可能发生的任何用户添加或删除，并为每个 User 实例调用 update_assets() 公共方法：

library(R6)
library(methods)

source("../storage/storage.R", chdir = TRUE)
source("../utilities/time-stamp.R")
source("../settings.R")

update_assets_loop <- function(minutes_interval) {
    storage = Storage$new(SETTINGS)
    repeat {
        users <- storage$read_users()
        timestamp = now.TimeStamp()
        lapply(users, update_assets, timestamp)
        Sys.sleep(minutes_interval * 60)
    }
}
update_assets_loop(60)

下面展示了 update-assets.R 文件的一个输出示例：

$ Rscript update-markets.R

...
            email        timestamp    name symbol    total
1 1@somewhere.com 2017-11-21-20-02 Bitcoin    BTC 76031.29
                             address
1 3D2oetdNuZUqQHPJmcMDDHYoqkyNVsFk9r
            email        timestamp     name symbol   total
1 1@somewhere.com 2017-11-21-20-02 Litecoin    LTC 1420001
                             address
1 LdP8Qox1VAhCzLJNqrr74YovaWYyNBUWvL
            email        timestamp    name symbol total
1 2@somewhere.com 2017-11-21-20-02 Bitcoin    BTC 14001
                             address
1 16rCmCmbuWDhPjWTrpQGaU3EPdZF7MTdUk
            email        timestamp     name symbol   total
1 2@somewhere.com 2017-11-21-20-02 Litecoin    LTC 1397089
                             address
1 LbGi4Ujj2dhcMdiS9vaCpWxtayBujBQYZw
...

当你执行这两个文件时，我们开发的整个面向对象系统将开始工作，定期检索实时数据并将其保存到相应的 CSV 文件中。你可以直接查看这些文件以查看正在保存的数据。记住，如果一个钱包不包含一个资产的正面数量，它将不会显示。

当你实现你的第一个面向对象系统时，几乎感觉就像魔法一样。如果你是第一次构建面向对象系统，我当然希望你能感受到这种感觉，我也希望这个例子对你来说既有趣又有用。

在使用面向对象系统时的一些建议

面向对象编程允许很大的灵活性，但如果使用不当，它也可能导致很多困惑，因为当有更简单的解决方案时，很容易开发出非常复杂的系统。

在将系统进化成更复杂的系统之前，你应该先启动一个小型的工作系统。同时，意识到大多数现实世界的设计都是过度约束的，你不可能取悦所有人，所以你必须决定你系统的优先级。

你的系统中的每一部分都应该专注于一件事情，并且做好这件事。当不确定时，制作更短的东西。创建更短的类和更短的方法。这样做将迫使你的对象专注于单一责任，这反过来又会改善你的设计，并使你更容易重用代码。

尽可能使你的对象尽可能私有。公共类不应有任何公共字段，也就是说，你应该在所有地方使用封装。最大化信息隐藏并最小化耦合。此外，记住名字很重要。在代码中避免使用晦涩的缩写，并保持一致性。相同的单词在系统中应该意味着相同的事情。

最后，尽量使你的代码尽可能不可变。这会产生易于理解的代码，可重用性更高，且线程安全，这在并行化时非常有用，正如我们将在下一章中看到的。然而，如果你实现了一个可变系统，尽量保持状态空间尽可能小。

作为一般建议，你的设计应该是易于理解且难以误用的，即使没有文档。你的代码应该是易于阅读和易于维护的，你投入使代码易于更改的努力应该与这种更改发生的可能性呈正相关。

摘要

在本章中，我们介绍了面向对象编程的基本原理，并展示了如何在 R 中使用三种不同的对象模型（S3、S4 和 R6）实现面向对象系统。我们探讨了对象模型的基本构建块，例如封装、多态性和层次结构。我们展示了如何使用 S3 和 S4 实现参数多态性，以及如何使用 R6 实现常规多态性，并且展示了如何使用诸如接口等概念，即使 R 中没有明确的支持。

我们实现了一个完整的面向对象系统来跟踪加密货币信息，在这个过程中，我们研究了各种模式和技巧，以及如何将三种不同的对象模型结合起来使用。

在 R 程序员中，关于使用哪种对象模型存在一些争议，这个决定取决于你希望代码有多灵活、正式或直观。一般来说，如果你更喜欢灵活性，使用 S3；如果你更喜欢正式性和健壮性，使用 S4；如果你希望代码对来自其他语言且不熟悉 S3 和 S4 的人来说易于理解和直观，那么使用 R6。然而，争议仍然存在。

S 语言创造者之一、R 的核心开发者约翰·钱伯斯在他的著作《数据分析软件》（Springer，2008 年）中推荐使用 S4 而不是 S3。谷歌的 R 风格指南 (google.github.io/styleguide/Rguide.xml) 表示，应尽可能避免使用 S4，而应使用 S3。

希望在阅读完本章之后，您对您下一个项目所偏好的系统以及原因有一个清晰的认识。在第九章《实现高效的简单移动平均》中，我们将继续扩展本章所创建的系统，以便在开始处理大量数据时，系统能有更好的性能表现。

第九章：实现高效的简单移动平均

在过去几十年中，随着数据量的增加和模型的复杂化，对计算能力的需求稳步增长。显然，最小化这些计算所需的时间已成为一项重要任务，并且存在明显的性能问题需要解决。这些性能问题源于数据量与现有分析方法之间的不匹配。最终，数据分析技术将需要进行根本性的转变，但就目前而言，我们必须满足于提高我们实现的效率。

R 被设计为一种具有高级表达性的解释型语言，这也是它缺乏许多支持高性能代码的细粒度控制和基本结构的原因之一。正如阿罗拉在 2016 年 Springer 出版的《用高性能计算征服大数据》一书中所说：“虽然 R 显然是一种高生产力语言，但它并不一定是一种高性能语言。”

R 程序的执行时间以小时或甚至以天来衡量并不罕见。随着要分析的数据量的增加，执行时间可能会变得过长，数据科学家和统计学家常常会遇到这些瓶颈。当这种情况发生时，如果他们对性能优化了解不多，他们可能会满足于减少数据量，这可能会阻碍他们的分析。然而，不用担心；R 程序可能会慢，但编写良好的 R 程序通常足够快，我们将探讨你可以使用的各种技术来提高你的 R 代码性能。

本章的目的不是让你成为一个性能优化专家，而是提供一个概述，介绍你如何尝试提高代码性能时可以使用的各种技术。我们将探讨许多不同的技术，每个技术都可能有自己的章节甚至书籍，因此我们只能从非常高的层面来看待它们，但如果你发现自己经常受到计算资源的限制，那么这些内容是你需要进一步深入了解的。

本章涵盖的一些重要主题如下：

• 决定实现必须有多快

• 使用良好算法的重要性

• 为什么 R 有时会慢或效率低下

• 小的改变可能对性能产生的影响

• 测量代码性能以找到瓶颈

• 比较不同实现之间的差异

• 通过并行化从计算机中获得最大效益

• 通过与其他语言接口提高性能

需要的包

我们已经使用了一些本章所需的包，例如 ggplot2 和 lubridate。其他三个包被介绍用于基准函数，并比较它们之间的性能，以及用于高级优化技术如委托和并行化，这些将在各自的章节中解释。

为了能够复制本章中的所有示例，你还需要为 Fortran 和 C++ 代码安装可工作的编译器。有关如何在您的操作系统上安装它们的说明，请参阅附录，所需包。

让我们看一下以下表格，描述了所需包的用途：

包	原因
ggplot2	高质量图表
lubridate	容易转换日期
microbenchmark	基准函数的性能

从使用好的算法开始

为了能够清楚地传达本章包含的思想，首先我需要提供一些简单的定义。当我提到一个算法时，我指的是一个过程的抽象规范。当我提到一个实现时，我指的是算法实际编程的方式。最后，当我提到一个程序或应用时，我指的是一组这样的算法实现协同工作。有了这些，很容易看出一个算法可以以许多不同的方式实现（例如，一个实现可能使用列表，而另一个可能使用数组）。这些实现中的每一个都会有不同的性能，并且它们与算法的时间复杂度相关，但并不等价。

对于那些不熟悉最后一个术语的人来说，每个算法都有以下两个基本属性

• 时间复杂度：这个属性指的是算法需要执行的计算次数，与它接收到的输入大小相关。有各种数学工具可以测量这种复杂性，最常见的是大 O 符号，它衡量算法的最坏情况。

• 空间复杂度：这个属性指的是执行算法所需的内存量，再次与它接收到的输入大小相关，也可以用相同的数学工具来衡量。

众所周知，一个效率低下的算法即使实现得非常高效，也可能比一个效率高的算法实现得低效慢得多。这意味着，大多数情况下，算法选择比实现优化更重要。

在评估算法时，除了之前提到的复杂度之外，还有许多其他因素需要考虑，例如效率资源使用（例如，互联网带宽），以及其他属性，如安全性或实现难度。在这本书中，我们不会深入探讨这些主题。然而，如果你想让你的代码表现良好，你必须正式地学习数据结构和算法。这些主题的入门资源包括 Cormen、Leiserson、Rivest 和 Stein 合著的书籍，书名为《算法导论》，由 MIT 出版社于 2009 年出版，以及 Skiena 的《算法设计手册》，由 Springer 出版社于 2008 年出版。

算法选择可以产生多大的影响？

计算斐波那契数是教授递归性的传统例子。在这里，我们将用它来比较两种算法的性能，一种是递归的，另一种是顺序的。

如果你不熟悉它们，斐波那契数是在一个序列中递归定义的，其中下一个数是前两个数的和，前两个数都是 1（我们的基本情况）。实际的序列是 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144，等等。这被称为斐波那契序列，它表现出有趣的性质，例如与黄金比例相关，如果你不知道它是什么，你绝对应该查找一下。

我们的fibonacci_recursive()函数接收我们想要计算的斐波那契数的位置n，限制为大于或等于 1 的整数。如果n是基本情况，即如果它小于 1，我们将简单地返回它（不是如果我们正在计算第二个位置的斐波那契数，我们的操作n - 2将是零，这不是一个有效的位置，这就是为什么我们需要使用<=而不是==）。否则，我们将返回对前两个递归调用的和，即fibonacci_recursive(n - 1)和fibonacci_recursive(n - 2)，如下面的代码片段所示：

fibonacci_recursive <- function(n) {
    if(n <= 1) { return(n) }
    return(fibonacci_recursive(n - 1) + fibonacci_recursive(n - 2)) 
}
th or 40th Fibonacci number? As you may experience when running this code, the further the Fibonacci number is from the base cases, the more time it will take, and somewhere around the 30th position, it starts being noticeably slower. If you try to compute the 100th Fibonacci number, you'll be waiting for a long while before you get the result:

fibonacci_recursive(1)
#> [1] 1

fibonacci_recursive(2)
#> [1] 1

fibonacci_recursive(3)
#> [1] 2

fibonacci_recursive(4)
#> [1] 3

fibonacci_recursive(5)
 #> [1] 5

fibonacci_recursive(35)
#> [1] 9227465

为什么会发生这种情况？答案是，这个算法做了很多不必要的操作，使其成为一个糟糕的算法。为了理解原因，让我们在脑海中回顾一下计算第三个和第四个斐波那契数的算法执行过程，并制作相应的执行树，如下所示：

在前面的图中，f(n)是fibonacci_recursive(n)的简称，这样我们就可以将所有对象都放入其中，颜色用于显示哪些函数调用是重复的。正如你所看到的，当你执行fibonacci_recusive(3)时，fibonacci_recursive(1)调用执行了两次。当执行fibonacci_recursive(4)时，相同的调用执行了三次。fibonacci_recursive(5)和fibonacci_recursive(6)将执行多少次？这是一个练习，留给读者去完成，你会发现，这个数字呈指数增长。

技术上讲，算法的时间复杂度是 O(2^n)，这是最糟糕的情况。此外，大多数计算都是完全不必要的，因为它们是重复的。算法是正确的，但它的性能是最差的。正如我们之前提到的，即使您为这个算法提供了可能的最有效实现，它也将比一个更有效算法的低效实现慢得多。

如果我们设计一个正确的算法，避免进行所有不必要的计算，我们可以拥有一个运行速度更快的程序，这正是以下算法所做到的。我们不会构建递归调用的树，而是简单地按顺序计算我们要求的斐波那契数。我们将简单地添加前两个数，并将结果存储在数组f中，该数组将有n个整数。我们指定两个基本情况，并继续计算，如下面的代码片段所示：

fibonacci_sequential <- function(n) {
    if (n <= 2) { return(1) }
    f <- integer(n)
    f[1] <- 1
    f[2] <- 1
    for (i in 3:n) { 
        f[i] <- f[i-2] + f[i-1]
    }
    return(f[n])
}

如您所见，每个数字只计算一次，这是我们为这个问题能设计的最有效算法。这避免了递归算法的所有开销，并使我们保持线性时间复杂度 O(n)。即使我们不关心性能优化地编写这个算法，它的执行时间也将快得多。

使用这个算法，我们实际上可以计算出第 1476 个斐波那契数，这是 R 语言内部架构允许的最大值。如果我们尝试计算第 1477 个斐波那契数，由于 R 语言存储整数所使用的机制，我们将得到无穷大（Inf）作为响应，这个机制我们不会深入探讨。此外，计算第 1476 个斐波那契数几乎是瞬间的，这展示了在选择算法之前优化它的重要性：

fibonacci_sequential(1476)
#[1] 1.306989e+308

fibonacci_sequential(1477)
#[1] Inf

最后，请注意，我们是在牺牲更多内存使用的情况下提高了速度。递归算法在计算完每个斐波那契数后就会丢弃它，而顺序算法则将每个数都保留在内存中。对于这个问题，这似乎是一个很好的权衡。在性能优化中，时间和空间之间的权衡是常见的。

既然我们已经看到了算法选择的重要性，那么在接下来的章节中，我们将使用一个单一的算法，并专注于优化其实现。然而，选择一个高效的算法比高效地实现它更重要。

多快才算快？

假设您已经选择了一个好的算法，并且没有过多考虑优化地实现了它，这在第一次尝试中很常见。您是否应该投入时间去优化它？性能优化可能是一项非常昂贵的活动。除非您必须这样做，否则不要尝试优化您的代码。您的时间很宝贵，可能最好花在其他事情上。

假设由于某种原因，你必须使你的实现更快。你必须首先决定的是多快才算足够快。你的算法是否只需要在几小时内完成，而不是几天，或者你需要降低到微秒级别？这是一个绝对要求，还是你只需要在特定时间内尽你所能做好？在优化代码之前，你必须考虑这些问题，有时解决方案甚至不是优化。

客户更喜欢花费更多金钱使用某种类型的云资源来解决性能问题，而不是花费宝贵的时间优化算法的性能，这种情况并不少见，尤其是如果他们可以通过做其他事情提供更多商业价值的话。

除了之前提到的机器时间与人类时间的权衡之外，在决定是否优化算法实现时，还有其他需要考虑的因素。你希望你的代码易于阅读吗？你希望你的代码可以共享吗？通常情况下，性能更好的代码也更难以理解。此外，如果你正在开发并行执行的代码，它将对可以执行它的系统类型施加一系列限制，你需要记住这一点。

我建议你坚持最小化优化的数量；这将帮助你实现关于实现运行速度的目标，并且不要超过这个范围。这个过程将会很简单：找出最重要的瓶颈，移除它（或者至少减少其影响），检查你的实现是否足够快，如果不是，就重复这个过程。我们将在本章中多次经历这个循环，尽管在回顾时它看起来很简单，但在现实中可能会相当困难，尤其是在处理复杂算法时。

低效地计算简单移动平均

我们将在本章剩余部分使用的算法被称为简单移动平均（SMA）。它是进行时间序列技术分析的一个非常著名的工具，特别是用于金融市场和交易。SMA 背后的想法是，你将通过回顾预定义的周期数来计算每个时间点的平均值。例如，假设你正在查看每分钟的时间序列，并且你将计算 SMA(30)。这意味着在你的时间序列中的每个观察点，你将取从特定观察点开始对应于之前 30 分钟的观察值（30 个观察值），并将这些 30 个观察值的平均值保存为该时间点的 SMA(30)值。

在后面的图中，你可以可视化 SMA 背后的思想。该图显示了一个单调递增的时间序列，每个时间单位增加一个值单位，两者都从 1 开始（也就是说，它在时间1的值是1，在时间2的值是2，依此类推），以及一些围绕 SMA 计算将采用的观察值组的图形。正如你所看到的，对于 SMA(3)，我们在时间序列的每个点上得到最后三个元素；同样，对于 SMA(4)，我们得到最后四个元素。当你计算图中元素子集的平均值时，你得到的是左上角的数字，这些数字对应于特定 SMA 时间序列的计算。具体来说，对于这样的时间序列，对于 SMA(3)的情况，结果是 NA，NA，2，3，4，5，6，7，和8，而对于 SMA(4)的情况，结果是 NA，NA，NA，2.5，3.5，4.5，5.5，6.5，和7.5。

关于 SMA，我们应该注意以下两个属性：

• 首先，请注意，SMA(3)和 SMA(4)都是包含与原始时间序列相同数量的观察值的序列，9个在这个例子中。

• 第二点，请注意，它们两者都以一个等于 SMA 参数减一的 NA 数量开始。这是因为，在 SMA(3)的情况下，在时间2时，我们并没有三个观察值，我们只有两个。因此，使用 NA 来表示在那个点上无法计算 SMA(3)。同样的解释适用于所有其他的 NA 值。

• 第三点也是最后一点，请注意，每次我们移动一个时间单位，我们就会向当前子集中添加一个观察值，并移除另一个观察值（即尾部）。

看一下以下描述先前属性的图：

模拟时间序列

当然，自从你实现了我们在上一章开发的面向对象系统的个人版本以来，你一直在收集加密货币市场的数据，对吧？我只是在开玩笑。如果你已经这样做了，那么可能对于我们将在本章中要做的事情来说，数据量可能还不够，所以这里有一小段代码，它将模拟比特币和莱特币的美元价格的两个时间序列。数据结构类似于上一章中使用的结构，这使得我们在这里开发的代码对于那个系统也是有用的。

我们不会深入探讨函数的工作原理，因为此时你应该已经很清楚，除了指出我们正在使用我们在上一章中开发的time_to_timestamp.TimeStamp()函数，以及simulate_prices()函数在 ARIMA 模拟之上使用二次模型。如果你不知道 ARIMA 模型是什么，不必过于担心（它对本章的理解不是必需的）。如果你对它感兴趣并想了解更多，可以查看 Shumway 和 Stoffer 的书籍，《时间序列分析及其应用：带 R 示例，Springer，2011》。我们使用二次模型是因为比特币的价格在过去几个月中一直在加速（本书在 2017 年 11 月撰写）。让我们看一下以下代码：

source("../chapter-08/cryptocurrencies/utilities/time-stamp.R")
library(lubridate)
N <- 60 * 24 * 365

simulate_market <- function(name, symbol, now, n, base, sd, x) {
    dates <- seq(now - minutes(n - 1), now, by = "min")
    ts <- unlist(lapply(lapply (
                            dates, 
                            time_to_timestamp.TimeStamp), 
                            unclass))
    price_usd <- simulate_prices(n, base, sd, x)
    data <- data.frame(timestamp = ts, price_usd = price_usd) 
    data$name <- name
    data$symbol <- symbol
    return(data)
}

simulate_prices <- function(n, base, sd, x) {
    ts <- arima.sim(list(15, 15, 15), n = n, sd = sd)
    quadratic_model <- base + (x - 1) * base / (n²) * (1:n)²
    return(as.numeric(ts + quadratic_model))
}

now <- Sys.time()
btc <- simulate_market("Bitcoin", "BTC", now, N, 8000, 8, 2)
ltc <- simulate_market("Litecoin", "LTC", now, N, 80, 0.08, 1.5)
data <- rbind(btc, ltc)
data <- data[order(data$timestamp), ]
write.csv(data, "./data.csv", row.names = FALSE) 

注意，用于调用simulate_market()函数的参数试图与目前比特币和莱特币价格中看到的情况相似，但请记住，这是一个非常简单的模型，所以不要期望它像这些资产的实际价格时间序列那样表现。最后，我们对每个资产模拟了 525,600 个观察值，这大约等于一年中的分钟数（N <- 60 * 24 * 365，其中包含每小时的秒数、每天的小时数和每年的天数）。这意味着我们正在模拟每分钟的数据。

为了可视化我们模拟的比特币价格，你可以使用以下代码。它简单地生成一个图表，使用全年的 1,000 个样本元素（更多的元素是不必要的，因为你无法感知更多的点，而且会减慢计算速度）；此外，还会生成另一个图表，它展示了数据中第一小时的放大效果：

s <- sample(1:nrow(btc), 1000)
plot(btc[s[order(s)], "price_usd"], xlab="Minutes", ylab="Price", xaxt='n')
title(main="Bitcoin price simulation for 1 year")
lines(btc[s[order(s)], "price_usd"])
plot(btc[1:60, "price_usd"], xlab="Minutes", ylab="Price", xaxt='n')
title(main="Bitcoin price simulation for 1 hour")
lines(btc[1:60, "price_usd"])

如所示，在查看全年的模拟时，存在一个明显的上升趋势，但如果你将时间范围缩小，你会看到相当多的价格波动，这允许进行有用的简单移动平均（SMA）实现。让我们看一下以下图表：

我们对 SMA 的第一个（非常低效）尝试

如前所述，我们将在本章的剩余部分使用 SMA 实现。为了区分它们，我们将为每个后续实现更改函数名称，从sma_slow_1()开始。所有 SMA 实现都将接收以下参数：

• period：指定用于 SMA 的观察值数量。

• symbol：表示我们想要进行计算的资产

  • 在这个例子中，选项将是BTC表示比特币或LTC表示莱特币。然而，当你自己执行系统时，你可以根据需要将其扩展到任何加密货币符号。

• data：包含每个资产价格时间序列的实际数据。

我们将对 data 做两个假设——timestamp 列是递增的，并且时间序列中没有空缺，这意味着我们每分钟都有价格数据。这允许我们跳过任何排序程序，并检查当没有数据时 SMA 是否应该内部包含 NA。请注意，这两个假设都由我们的数据模拟满足。

现在，我们将解释 sma_slow_1() 函数是如何工作的。请注意，这是一个非常低效的实现，你绝对应该避免以这种方式编程。然而，这些是人们常犯的错误，在我们测量它们对代码速度的实际影响时，我们将逐一移除它们。让我们通过以下步骤来查看它是如何完成的：

1. 首先，我们创建一个名为 result 的空数据框，它包含一个名为 sma 的单列。

2. 然后，我们遍历数据中的所有行；end 表示正在考虑的简单移动平均（SMA）区间的结束，或右端点。

3. 我们创建一个 position 整数，每次开始循环时它与 end 相同，以及一个 sma 对象，它将包含实际 SMA 计算的末尾位置，一个 n_accumulated 整数，用于跟踪我们累积的观测值数量，以及一个 period_prices 数据框，它包含一个单列来存储当前 SMA 计算的价格。

4. 接下来，我们检查当前 end 位置的观测值是否对应于我们感兴趣的 symbol。如果不是，我们简单地忽略这次迭代，但如果它是，我们将从 end 位置开始累积 period_prices，向后直到累积的价格数量等于我们感兴趣的 period 或当前 position 低于 1（这意味着我们处于时间序列的开始）。为此，我们使用一个 while 循环来检查之前提到的条件，当找到具有相同 symbol 的观测值并将其数据附加到 period_prices 数据框时，增加 n_accumulated，并且无论观测值是否有用，都增加 position，这样我们才不会陷入困境。

5. 当 while 循环完成后，我们知道我们已经累积了等于我们感兴趣的 period 的价格数量，或者我们遇到了时间序列的开始。在前一种情况下，我们通过遍历 period_prices 数据框来计算这些价格的均值，并将其作为当前 end 位置的 sma 值。在第二种情况下，我们简单地记录一个 NA 值，因为我们无法计算完整的 SMA。请看以下代码片段：

sma_slow_1 <- function(period, symbol, data) {
    result <- data.frame(sma=numeric())
    for(end in 1:nrow(data)) {
        position <- end
        sma <- NA
        n_accumulated <- 0
        period_prices <- data.frame(price=numeric()) 
        if (data[end, "symbol"] == symbol) {
            while(n_accumulated < period & position >= 1) {
                if (data[position, "symbol"] == symbol) {
                    period_prices <- rbind(
                        period_prices,
                        data.frame(price=data[position, "price_usd"])
                    )
                    n_accumulated <- n_accumulated + 1
                }
                position <- position - 1
            }
            if (n_accumulated == period) {
                sma <- 0
                for (price in period_prices$price) {
                    sma <- sma + price
                }
                sma <- sma / period
            } else {
                sma <- NA
            }
            result <- rbind(result, data.frame(sma=sma))
        }
    }
    return(result)
} 

如果实现看起来很复杂，那是因为它确实如此。当我们开始改进我们的代码时，它自然会简化，这将使其更容易理解。

1. 现在，我们想要真正看到它是否工作。为此，我们将sma-slow.R文件（其中包含所有慢速实现）以及数据载入内存（如下代码片段所示）：

source("./sma-slow.R")
data_original <- read.csv("./data.csv")

注意，我们只取前 100 个观测值，这对应于 50 分钟的比特币价格波动（记住这 100 个观测值中只有 50 个是比特币的；其他 50 个是莱特币的）。我们可以看到，比特币的 SMA(5)是有意义的，包括前四个 NA（你可以手动检查这些数字，但请记住使用你自己的数据模拟的数据和结果）：

data   <- data_original[1:100, ]
symbol <- "BTC"
period <- 5

sma_1 <- sma_slow_1(period, symbol, data)
sma_1
#>         sma
#> 1        NA
#> 2        NA
#> 3        NA
#> 4        NA
#> 5  7999.639
#> 6  7997.138
#> 7  8000.098
#> 8  8001.677
#> 9  8000.633
#> 10 8000.182
(Truncated output)

在我们了解如何修复这段代码之前，我们需要了解为什么 R 可能会慢，以及如何衡量我们在改进它时所产生的影响。

理解为什么 R 可能会慢

理解为什么一种编程语言可能会慢，是能够提高其实现速度的基本技能。任何编程语言中的任何实现都会受到算法的时间和内存复杂性的影响，因为它们是算法，而不是实现属性。然而，语言处理特定实现的方式可能会有很大差异，这就是我们现在要关注的。

在 R 的情况下，人们经常发现以下四个主要瓶颈：

• 对象不可变性

• 解释型动态类型

• 内存密集型进程

• 单线程进程

绝对不能说这个列表是完整的，或者在每个实现中都会遇到。这仅仅是我看到人们遇到的最常见的瓶颈，而且这些瓶颈在修复后，产生了最大的速度提升。它们通常是很好的起点，但每个实现都是不同的，因此很难提出通用的性能优化规则，你应该记住这一点。

对象不可变性

提高 R 实现的性能并不一定需要高级优化技术，例如并行化。实际上，有一些简单的调整，虽然并不总是显而易见，但可以使 R 运行得更快。人们在使用 R 时遇到的最常见的瓶颈是对其对象不可变性属性缺乏理解，以及复制此类对象时产生的开销。仅仅注意这一点就可以产生显著的性能提升，一旦你了解了如何做到这一点，这并不太难。这是一个很好的起点，开始寻找优化。

作为可能出现的一些问题的例子，假设你有一个名为a的数字数组。现在，假设你想要将a的第一个元素更新为10，如下代码片段所示：

a[1] <- 10

这个任务比看起来要复杂得多。实际上，它是通过这个调用和赋值中的`"<-"`替换函数来实现的：

a <- `"[<-"`(a, 1, value = 10)

最初，你可能觉得这种语法非常奇怪，但记住，正如我们在[第一章“R 语言简介”中看到的，我们可以有表示对象（包括函数）的字符串，就像这里的情况一样。```py "[<-"`` parts of the line is actually a function name being called with thea, 1, and value = 10parameters. If you execute the previous two lines, you should get the same result; that is the first element inabeing equal to10`.

What actually happens is that an internal copy of a is made; the first element of such an object is changed to 10 and the resulting object is reassigned to a. Even though we are simply changing just one element of the array, in reality, the entire vector is recomputed. The larger the vector, the worse the problem is, and this can considerably slow down your implementation. It's even worse when you're using heavy data structures, such as data frames.

Languages that allow for mutabilty, such as Fortran or C++, will simply change a specific value in the array instead of producing a new copy of the full array. That's why it's often the case where code that would be just fine in other languages produces a very large, and often unnecessary, overhead when programmed similarly in R. We will see ways to mitigate this impact as we go through the chapter.

Interpreted dynamic typings

The second most important bottleneck people find is R's nature of being an interpreted and dynamically-typed language. This means that at any given line in your program, an object may be an integer, in the next line it may be a data frame, then a string, and it may be a list of data frames two lines later. This is the nature of not having fixed types for your objects, and since the interpreter can't know how to handle such objects in advance because they may be entirely different each time, it must check the object's type every time it wants to apply some kind of operation on it. This is a little exaggerated, but the point remains that since it's possible that an object's type changed, it must be continuously checked.

We will see how to avoid some of these checks to increase performance, but to deal with the interpreted and dynamically typed nature, we will have to resort to other programming languages, such as Fortran or C++, as we will show you later in the chapter. These languages fix an object's type when it's created and if you attempt to change it at some point, the program will throw an error. This may seen like an unnecessary restriction, but actually it can be very powerful when communicating some code's intent as well as to allow compilers to provide powerful optimizations for handling such objects.

Memory-bound processes

The third most important bottleneck people find is that R must have all objects in memory. This means that the computer being used for the analysis must have enough RAM to hold the entire data at once, as well as intermediate and resulting objects, and keep in mind that this RAM is shared with all the other applications running in the computer.

If R doesn't have enough RAM to hold every object in memory, the operating system will perform a swapping operation that, within R, will look as if you had all data in memory but data will be written and read from the hard drive in reality. Reading and writing from hard drives is orders of magnitude slower than doing equivalent operations in-memory, and R won't let you know that this is happening since it really can't (this is done by the operating system). To detect that this is happening, you should keep an eye on the tool provided by your operating system to monitor your system's resources.

Even though this is the third bottleneck in the list, when it happens, it's by far the most damaging one, as we have a disk input/output bottleneck on top of the memory bottleneck. When you encounter this problem, you'll be able to tell because R will seem to have frozen or will be unresponsive. If it's happening to you, you should definitely look for ways to eliminate it. It's the third in the list because it's not encountered as often as the previous two, not because it has less of an impact.

Single-threaded processes

The fourth most important bottleneck people encounter is the fact that R language has no explicit constructs for parallelism. An out-of-the-box R installation cannot take advantage of multiple CPUs, and it does not matter if you install R on a powerful server with 64 CPU cores, R will only use one of them.

The way to fix this is to introduce parallelism in your implementations. However, doing so is not an easy task at all. In fact, serious parallelization efforts require deep hardware and software knowledge, and often depend on the specific hardware used to execute an implementation.

Even though it's a very difficult thing to do, and maybe even because of that, R has a lot of packages whose objectives are to provide parallel solutions for specific R functions. There are some general packages you may use to create your own parallel implementations, as we will see later in the chapter, but it's definitely not the first place to start looking for performance enhancements.

Now that you understand why R can be slow, we will use this knowledge to gradually improve the SMA implementation we showed earlier, but before we do that, we must learn to measure our code's performance, and that's the focus of the next section.

Measuring by profiling and benchmarking

There's a common saying which states that you can't change what you can't measure. Even though you can technically change your code's performance in R, you definitely won't be able to know whether a change is worth it if you don't measure it. In this section, we will introduce three tools you can use to measure your code: Rprof(), system.time(), and microbenchmark(). The first two are included in R, and the third one requires the microbenchmark package to be installed. The Rprof() tool is used to profile code, while system.time() and microbenchmark() are used to benchmark code.

• Profiling means that you measure how much time a particular implementation is spending on each of its parts.
• Benchmarking means that you compare the total amount of time to execute different implementations to compare them among themselves, without regard for their internal parts.

Profiling fundamentals with Rprof()

Even experienced programmers have a hard time identifying bottlenecks in their code. Unless you have quite a bit of experience and a good sense of what parts of your code are slowing down its execution, you're probably better-off profiling your code before you start optimizing it. Only once you've identified the most important bottlenecks can you attempt to eliminate them. It's difficult to provide general advice on improving performance since every implementation is quite different.

The Rprof() function is a built-in tool for profiling the execution of R functions. At regular intervals, the profiler stops the interpreter, records the current function call stack, and saves the information to a file. We can then look at summaries of such information to find out where our implementation is spending the most time.

Keep in mind that the results from Rprof() are stochastic. Each time we use it, the results will be slightly different, depending on many things specific to your system, which are out of R's control. Therefore, the results we get from Rprof() are estimates and can vary within the sample implementation.

To use the Rprof() function, we simply call it without parameters before we call the code we want to measure, and then we call it again, this time sending the NULL parameter. The results are saved to a file in your hard drive and can be invoked with the summaryRprof() function call.

In this particular case, note that we sent the first 10,000 elements. If we had sent a small amount of data, the sma_slow_1() function would have finished so fast that we would not have any meaningful output (remember that Rprof() measures by time intervals). Also, the results shown here are truncated, since the actual results are much larger because they show many function calls our code used. We left the top five results for each table.

Both tables have the same information. The difference is that the $by.self table (the first one) is ordered by self, while the $by.total table (the second one) is ordered by total; self indicates how much time a function call took without regard for its child function calls, while total information includes the child function calls. This means that self data must sum to 100, while aggregated total data will commonly sum to much more than 100:

Rprof()

sma_1 <- sma_slow_1(period, symbol, data_original[1:10000, ])

Rprof(NULL)

summaryRprof()

#> $by.self

#>                         self.time self.pct total.time total.pct

#> "rbind"                      1.06    10.84       6.16     62.99

#> "structure"                  0.82     8.38       0.94      9.61

#> "data.frame"                 0.68     6.95       4.32     44.17

#> "[.data.frame"               0.54     5.52       1.76     18.00

#> "sma_slow_1"                 0.48     4.91       9.78    100.00

#> (输出截断)

#>

#> $by.total

#>                         total.time total.pct self.time self.pct

#> "sma_slow_1"                  9.78    100.00      0.48     4.91

#> "rbind"                       6.16     62.99      1.06    10.84

#> "data.frame"                  4.32     44.17      0.68     6.95

#> "["                           1.88     19.22      0.20     2.04

#> "as.data.frame"               1.86     19.02      0.10     1.02

#> (输出截断)

#>

#> $sample.interval

#> [1] 0.02

#>

#> $sampling.time

#> [1] 9.78

```py

As you can see in the results, the first column indicates a function call in the stack, and the numbers indicate how much time was spent in a particular function call, either in absolute (`time`) or relative terms (`pct`). Normally, you'll want to focus on the top values in the `self.pct` column of the `$by.self` table, since they show the functions that are taking the most amount of time by themselves. In this particular case, `rbind`, `structure`, and `data.frame` are the functions taking the most amount of time.

Finally, you should know that some of the names found in the functions call stack can be very cryptic, and sometimes you'll have a hard time finding references or documentation for them. This is because they are probably internal R implementations that are not meant to be used directly by R users. What I suggest is that you simply try to fix those function calls that you recognize, unless you're dealing with situations where highly-optimized code is an absolute requirement, but in that case, you would be better off reading a specialized book on the subject.

# Benchmarking manually with system.time()

Now, we will look into how to benchmark your code. If you're looking for a simple measurement of execution time, `system.time()` is a good choice. You simply call a function inside of it, and it will print the following three time measures for you: .

*   `user`: It is the `user` time that we should pay more attention to, since it measures the CPU time used by R to execute the code
*   `system`: The `system` time is a measure of time spent by the system to be able to execute the function
*   `elapsed`:  The `elapsed` time is total time it took to execute the code, even if it was slowed down due to other system processes

Sometimes, `elapsed` time is longer than the sum of `user` time and `system` time because the CPU is multitasking on other processes, or it has to wait for resources such as files and network connections to be available. Other times, elapsed time is shorter than the sum of `user` time and `system` time. This can happen when multiple threads or CPUs are used to execute the expression. For example, a task that takes 10 seconds of user time can be completed in 5 seconds if there are two CPUs sharing the load.

Most of the time, however, we are interested in the total elapsed time to execute the given expression. When the expression is executed on a single thread (the default for R), the elapsed time is usually very close to the sum of the `user` time and `system` time. If that is not the case, either the expression has spent time waiting for resources to be available, or there were many other processes on the system competing for the CPU's time. In any case, if you're suspicious of your measurements, try measuring the same code various times while the computer is not spending resources in other applications.

In this particular case, we see that the execution took approximately 9 seconds to complete, which is roughly equivalent to the same time it took to execute it when measured by `Rprof()` in the previous section, as can be seen in the column  `total.time` on the `sma_slow_1` observation of the `$by.total` table.

system.time(sma_slow_1(period, symbol, data_original[1:10000, ]))

> user system elapsed

> 9.251 0.015 9.277

If you want to measure multiple functions to compare their times, you will have to use the `system.time()` function on each of them, so it's somewhat of a manual process. A better alternative for such a thing is the `microbenchmark()` function shown in the next section.

# Benchmarking automatically with microbenchmark()

If you have identified a function that is called many times in your code and needs to be accelerated, you can write several implementations for it and use the `microbenchmark()` function from the `microbenchmark` package to compare them. Its results will also normally be more reliable because, by default, it runs each function 100 times and thus is able to produce statistics on its performance.

To use the `microbenchmark()` function, you simply wrap it around a piece of code you want to measure. Some handy features are that you can make an assignment, within which it's very handy to measure and use the results in one go; also, you can pass various function calls separated by commas, and it will give you results for each of them. This way, you can automatically benchmark various functions at the same time.

Here, we will assign the results of `sma_slow_1()` to `sma_1`, as we did previously, but since it's wrapped with the `microbenchmark()` function, it will also be measured and the performance results will be stored in the `performance` data frame. This object contains the following columns: `expr` is a string that contains the function call used, `neval` is the number of times the function was executed (by default, it's `100`), and the `min`, `lq` (first quartile), `mean`, `median`, `uq` (third quartile), and `max` statistics:

performance <- microbenchmark(

sma_1 <- sma_slow_1(period, symbol, data),

unit = "us"

)

summary(performance)$median

> [1] 81035.19

If you want to look at the full performance data frame, simply print it. Here, we only showed that the `median` time it took when executing the `sma_slow_1()` function call was `81,035.19` microseconds (which was the unit specified with the `unit = "us"` parameter). By default, this would have used milliseconds instead of microseconds, but we want to provide the same units for all comparisons we perform along the chapter, and microseconds is a better option for that.

We will continue to add records to the following table. Each row will contain an implementation identifier, the median microseconds it took to execute such a function, indication of the fastest implementation so far, and a percentage when being compared to the fastest one we have so far. In this particular case, since it's the only one we have done, it is obviously the fastest one and is also 100% from the best one, which is itself:

| **Fastest** | **Implementation** | **Microseconds median** | **% From Fastest** |
| `    ⇒` | `sma_slow_1` | `81,035.19` | `100%` |

The objective of the rest of the chapter is to extend this table to provide precise measurements of just how much performance improvements we're making as we improve our SMA implementation.

# Easily achieving high benefit - cost improvements

In this section, we will show how the efficiency of R can be drastically improved without resorting to advanced techniques such as delegating to other programming languages or implementing parallelization. Those techniques will be shown in the later sections.

# Using the simple data structure for the job

Many R users would agree that data frame as a data structure is a basic tool for data analysis. It provides an intuitive way to represent a typical structured dataset with rows and columns representing observations and variables, respectively, but it provides more flexibility than a matrix by allowing variables of different types (such as character and numeric variables in a single structure). Furthermore, when data frames contain only numeric variables, basic matrix operations conveniently become applicable to it without any explicit coercing required. This convenience, however, comes with a performance cost that people often don't mention.

Here, we avoid repeating the `Rprof()` results we got from profiling the `sma_slow_1()` function. However, if you look back at them, you will see that `rbind()` and `data.frame()` were among the functions that took the most time. This is precisely the performance cost mentioned earlier. If you want your implementations to be faster, avoiding using data frames can be a good start. Data frames can be a great tool for data analysis, but not when writing fast code.

As you can see in `sma_slow_2()`, the code is practically the same as `sma_slow_1()`, except that the `period_prices` object is no longer a data frame. Instead, it has become a vector, which is extended with the `c()` function in place of the `rbind()` function. Note that we are still dynamically expanding the size of an object when calling the `c()` function, which is something you shouldn't be doing for performant code, but we will take it step-by-step:

sma_slow_2 <- function(period, symbol, data) {

result <- data.frame(sma=numeric())

for(end in 1:nrow(data)) {

    position <- end

    sma <- NA

    n_accumulated <- 0

    period_prices <- NULL

    如果(data[end, "symbol"] == symbol) {

        while(n_accumulated < period & position >= 1) {

            if(data[position, "symbol"] == symbol) {

                period_prices <- c(period_prices,

                    data[position, "price_usd"])

                n_accumulated <- n_accumulated + 1

            }

            position <- position - 1

        }

        if (n_accumulated == period) {

            sma <- 0

            for (price in period_prices) {

                sma <- sma + price

            }

            sma <- sma / period

        } else {

            sma <- NA

        }

        result <- rbind(result, data.frame(sma=sma))

    }

}

return(result)

}

In this case, we measure its execution time just as we did earlier, but we also perform a very important verification, which is often overlooked. We verify that the values we get from `sma_slow_1()` are the same as those we get from `sma_slow_2()`. It wouldn't be a correct comparison if we measured implementations that do different things. Performing the check is also useful to increase our confidence that every change we make does not introduce unexpected behavior. As can be seen, all values are the same, so we can proceed with confidence:

performance <- microbenchmark(

sma_2 <- sma_slow_2(period, symbol, data),

unit = "us"

)

all(sma_1\(sma == sma_2\)sma, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 33031.7785

We record our results in our table, and realize that removing this data frame structure allowed us to remove two-thirds of the execution time. That's pretty good for such an easy change, isn't it? Since our base case (the fastest implementation we have so far) is `sma_slow_2()`, we can see that `sma_slow_1()` would take approximately 145% more time to execute:

| **Fastest** | **Implementation** | **Microseconds median** | **% from fastest** |
|  | `sma_slow_1` | `81,035.1900` | `245.32%` |
| ⇒ | `sma_slow_2` | `33,031.7785` | `100%` |

Now that we realize what an impact unnecessary data frames can have in the performance of our code, we proceed to also remove the other data frame we were using for the `result` object. We also replace it with a vector, and use the `c()` function to append to it. The same dynamic expansion problem mentioned earlier appears here, too. As you can see, everything else is kept the same.

We proceed to benchmark as we did earlier, and also check that the results we got are also the same. The cautious reader may have noted that the previous check was performed with an equality operator, while this one is performed with an inequality operator. In reality, when checking real numbers, you're better off checking that they are close enough as opposed to exactly the same. If you checked for identical numbers, you may get a `FALSE` result due to one of the numbers having a difference of `0.000000001`, which is not significant in our case. Therefore, we establish what is a significant check for our specific use case, and test that each pair of numbers has a difference not larger than that threshold, just as we do here, with our threshold being `0.001`:

performance <- microbenchmark(

sma_3 <- sma_slow_3(period, symbol, data),

unit = "us"

)

all(sma_1$sma - sma_3 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 19628.243

In this case, the median time it took to execute `sma_slow_3()` was of `19,628.243` microseconds. We go ahead and record that into our table, and recalculate the percentage from the best, which is `sma_slow_3()` at this point. Note that we are able to remove close to half the time from the already improved `sma_slow_2()` function, and that using the original `sma_slow_1()` function will take 312% more time than the latest one. It can be surprising how much performance gain you can get by simply using a simpler data structure.

# Vectorizing as much as possible

Vectorization means removing a manual looping mechanism in favor of an operation optimized to do the same thing without a need for an explicit loop. It is very helpful because it helps avoid the overhead incurred on by explicit loops in R. Vectorizing is a fundamental tool in R, and you should get used to programming using it instead of using explicit loops whenever possible, without waiting until a performance stage comes into play. Once you understand how it works, it will come naturally. A good read for this topic is Ross's blog post, *Vectorization in R: Why?* ([`www.noamross.net/blog/2014/4/16/vectorization-in-r--why.html`](http://www.noamross.net/blog/2014/4/16/vectorization-in-r--why.html)).

Explicit loops may be efficient in other languages, such as Fortran and C++. However, in R, you're better off using vectorization most of the time.

There are various ways of vectorizing operations. For example, if you want to perform a matrix-vector multiplication, instead of iterating over the elements of vector and the matrix, multiplying the appropriate coefficients, and adding them together as is normally done in other programming languages, you can simply do something like `A %*% b` to perform all of those operations in a vectorized manner in R. Vectorization provides more expressive code that is easier to understand as well as more performant, and that's why you should always attempt to use it.

Another way of vectorizing is using the family of the `apply()` function R provides (for example, `lapply()`, `sapply()`, and so on). This will produce simpler code than explicit loops and will also make your implementation faster. In reality, the `apply()` function is a special case since it's not as optimized as the other functions in its family, so the performance gains won't be as much as with the other functions, but the code clarity will indeed increase.

Another way of vectorizing code is to replace loops with R built-in functions, and that's the case we will use in the next modification. In the third `if` in the code, the one after the `while` loop has finished, there's a `for` loop that adds the elements we have in the `period_prices` vector, and then it is divided by the `period` vector to produce the mean. We can simply use the `mean()` function instead of using such a loop, and that's what we do.

Now, when you read that part of the code, it reads easily as if the number accumulated prices is equal to the period, making the SMA equal to the mean of the accumulated prices. It's much easier to understand code than using the loop:

sma_slow_4 <- function(period, symbol, data) {

result <- NULL

for(end in 1:nrow(data)) {

    position <- end

    sma <- NA

    n_accumulated <- 0

    period_prices <- NULL

    if (data[end, "symbol"] == symbol) {

        while(n_accumulated < period & position >= 1) {

            if (data[position, "symbol"] == symbol) {

                period_prices <- c(period_prices,

                    data[position, "price_usd"])

                n_accumulated <- n_accumulated + 1

            }

            position <- position - 1

        }

        if (n_accumulated == period) {

            sma <- mean(period_prices)

        } else {

            sma <- NA

        }

        result <- c(result, sma)

    }

}

return(result)

}

Again, we benchmark and check correctness. However, in this case, we find that the median time is `20,825.879` microseconds, which is more than the current minimum from `sma_slow_3()`. Wasn't vectorized code supposed to be faster? The answer is that most of the time it is, but in situations like this, there's an overhead within the `mean()` function, due to the fact that it needs to check what type of object it's dealing with, before using it for any operations, which can cause an implementation to be slower. When we were using the explicit loop, the sums and the division incurred in a much lower overhead because they could be applied to a much smaller set of objects. Therefore, as you see in the table below, `sma_slow_4()` takes 6% more time than `sma_slow_3()`. This is not much, and since I prefer expressive code, I'll keep the change:

performance <- microbenchmark(

sma_4 <- sma_slow_4(period, symbol, data),

unit = "us"

)

all(sma_1$sma - sma_4 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 20825.8790

Take a look at the following table:

| **Fastest** | **Implementation** | **Microseconds median** | **% from fastest** |
|  | `sma_slow_1` | `81,035.1900` | `412.84 %` |
|  | `sma_slow_2` | `33,031.7785` | `168.28 %` |
| ⇒ | `sma_slow_3` | `19,628.2430` | `100 %` |
|  | `sma_slow_4` | `20,825.8790` | `106.10 %` |

If you want to compare the overhead of the `mean()` function to the overhead of other ways of doing the same calculation, take a look at the following benchmark. The `.Internal(mean(x))` function avoids the dispatch mechanism for methods we showed in the previous chapter and skips directly to a C implementation of the `mean()` function, as shown in the following code snippet:

x <- sample(100)

performance <- microbenchmark(

mean(x),

sum(x) / length(x),

.Internal(mean(x)),

times = 1e+05

)

performance

> Unit: nanoseconds

> expr min lq mean median uq max neval

> mean(x) 1518 1797 2238.2607 1987 2230 2335285 1e+05

> sum(x)/length(x) 291 345 750.2324 403 488 27016544 1e+05

> .Internal(mean(x)) 138 153 187.0588 160 176 34513 1e+05

# Removing unnecessary logic

There are times when simple logic shows us that there are parts of our implementations that are unnecessary. In this particular case, the accumulation of `period_prices` can be avoided by setting `sma` to `0` initially instead of `NA`, and adding to it each price. However, when doing so, we lose track of the number of elements in the vector, so the `mean()` function doesn't make sense any more, and we proceed to simply divide the sum by `period` as we were doing earlier:

sma_slow_5 <- function(period, symbol, data) {

result <- NULL

for(end in 1:nrow(data)) {

    position <- end

    sma <- 0

    n_accumulated <- 0

    if (data[end, "symbol"] == symbol) {

        while(n_accumulated < period & position >= 1) {

            if (data[position, "symbol"] == symbol) {

                sma <- sma + data[position, "price_usd"]

                n_accumulated <- n_accumulated + 1

            }

            position <- position - 1

        }

        if (n_accumulated == period) {

            sma <- sma / period

        } else {

            sma <- NA

        }

        result <- c(result, sma)

    }

}

return(result)

}

Again, we benchmark and check correctness, as shown in the following code snippet:

performance <- microbenchmark(

sma_5 <- sma_slow_5(period, symbol, data),

unit = "us"

)

all(sma_1$sma - sma_5 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 16682.68

In this case, our median time was `16682.68` microseconds, making this our fastest implementation so far. Again, note how a very simple change produced a reduction of around 17% with respect to the previously fastest implementation:

| **Fastest** | **Implementation** | **Microseconds median** | **% from fastest** |
|  | `sma_slow_1` | `81,035.1900` | `485.74 %` |
|  | `sma_slow_2` | `33,031.7785` | `198.00 %` |
|  | `sma_slow_3` | `19,628.2430` | `117.65 %` |
|  | `sma_slow_4` | `20,825.8790` | `124.83 %` |
| ⇒ | `sma_slow_5` | `16,682.6800` | `100 %` |

# Moving checks out of iterative processes

Suppose that we're stuck in our optimization process and don't know what we should change next. What should we do? Well, as we mentioned earlier, we should profile our code to find out our current bottlenecks, and that's what we do here. We use the `Rprof()` function again to profile our `sma_slow_5()` implementation.

The results show that the `[.data.frame` and `[` functions are our biggest bottlenecks, and although their names are a bit cryptic, we can guess that they are related to subsetting data frames (which they are). This means that our current most important bottleneck is checking whether we are at an observation that corresponds to `symbol` we are using, and we are performing such checks at different places in our code:

Rprof()

sma_5 <- sma_slow_5(period, symbol, data_original[1:10000, ])

Rprof(NULL)

summaryRprof()

> $by.self

> self.time self.pct total.time total.pct

> "[.data.frame" 0.54 26.21 1.24 60.19

> "[" 0.22 10.68 1.34 65.05

> "NextMethod" 0.20 9.71 0.20 9.71

> "sma_slow_5" 0.14 6.80 2.06 100.00

> "Ops.factor" 0.12 5.83 0.52 25.24

> (Truncated output)

>

> $by.total

> total.time total.pct self.time self.pct

> "sma_slow_5" 2.06 100.00 0.14 6.80

> "[" 1.34 65.05 0.22 10.68

> "[.data.frame" 1.24 60.19 0.54 26.21

> "Ops.factor" 0.52 25.24 0.12 5.83

> "NextMethod" 0.20 9.71 0.20 9.71

> (Truncated output)

Now that we know our current largest bottleneck, we can remove it by avoiding to check whether the current observation corresponds `symbol` we receive as a parameter. To accomplish this, we simply introduce a filter at the beginning of the function that keeps only observations that contain the correct symbol.

Note that this simple filter allows us to remove the two checks we were performing earlier, since we are sure that all observations have the correct symbol. This reduces two indentation levels in our code, since these checks were nested. Doing so feels great, doesn't it? Now it seems that we have a very simple implementation which will intuitively perform much better.

To verify this, we proceed to benchmark and check for correctness, as earlier:

performance <- microbenchmark(

sma_6 <- sma_slow_6(period, symbol, data),

unit = "us"

)

all(sma_1$sma - sma_6 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 2991.5720

Also, our intuition is confirmed; our median time for `sma_slow_6()` is `2,991.57`. That's only 17% from the previously fastest implementation we had, which was `sma_slow_5()`, and it takes only 3% of the time that our initial implementation took. Is this awesome or what? Take a look at the following table:

| **Fastest** | **Implementation** | **Microseconds median** | **% from fastest** |
|  | `sma_slow_1` | `81,035.1900` | `2,708.78 %` |
|  | `sma_slow_2` | `33,031.7785` | `1,104.16 %` |
|  | `sma_slow_3` | `19,628.2430` | `656.11 %` |
|  | `sma_slow_4` | `20,825.8790` | `696.15 %` |
|  | `sma_slow_5` | `16,682.6800` | `557.65 %` |
| ⇒ | `sma_slow_6` | `2,991.5720` | `100 %` |

# If you can, avoid iterating at all

In the previous section, we realized how large an impact can unnecessary overhead within iterations have on our implementation's performance. However, what if we could avoid iterating at all? Now that would be better, wouldn't it? Well, as we mentioned earlier, doing so is achievable with vectorization.

In this case, we will remove the `while` loop and replace it with a vectorized mean over the `start` and `end` positions, where `end` continues to be defined as it has been so far, and `start` is defined as the `end` position minus `period` we receive as a parameter, plus one. This ensures that we get the exact number of prices we need, and we can create an interval with `start:end` that will take the specific subset we need from `data` so that we can apply the `mean()` function to it:

sma_slow_7 <- function(period, symbol, data) {

data <- data[data$symbol == symbol, ]

result <- NULL

for(end in 1:nrow(data)) {

    start <- end - period + 1

    if (start >= 1) {

        sma <- mean(data[start:end, "price_usd"])

    } else {

        sma <- NA

    }

    result <- c(result, sma)

}

return(result)

}

Note that this change would not have been possible if we had not filtered the data at the top of the function, since we would have observations that correspond to different symbols mixed among themselves and our `start:end` interval would pick observations that contain other symbols. This goes to show that sometimes optimizations depend on each other, and one can't be applied without applying a previous one, and these relations are often found accidentally.

As always, we benchmark and check for correctness as shown  in the following code snippet:

performance <- microbenchmark(

sma_7 <- sma_slow_7(period, symbol, data),

unit = "us"

)

all(sma_1$sma - sma_7 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 910.793

The median time is now `910.793` microseconds. This was expected as we know that removing explicit loops can produce big performance improvements. In this case, we were able to reduce to a little under one-third of the time from our previously fastest implementation. Note that we are now dealing with hundreds of microseconds, instead of thousands of microseconds. This means that we have achieved performance improvements in the orders of magnitude. Take a look at the following table:

| **Fastest** | **Implementation** | **Microseconds median** | **% from fastest** |
|  | `sma_slow_1` | `81,035.1900` | `8,897.21 %` |
|  | `sma_slow_2` | `33,031.7785` | `3,626.70 %` |
|  | `sma_slow_3` | `19,628.2430` | `2,155.07 %` |
|  | `sma_slow_4` | `20,825.8790` | `2,286.56 %` |
|  | `sma_slow_5` | `16,682.68` | `1,831.66 %` |
|  | `sma_slow_6` | `2,991.5720` | `328.45 %` |
| ⇒ | `sma_slow_7` | `910.7930` | `100 %` |

# Using R's way of iterating efficiently

At this point, we're left with a single `for` loop, which we would like to remove. However, there's a bit of logic in there that gets in the way. This is where the `lapply()` function comes in handy. As you know from Chapter 1, *Introduction to R*, this function receives a list of objects that will be sent to a function provided as a second argument, and it will return the results from such function calls in a list. An added benefit of the `lapply()` function is that it takes care of the memory preallocation for us, which is a very efficient way to reduce execution time in R.

In this case, we encapsulate the logic inside our `for` loop in a separate function called `sma_from_position_1()` and use it within our `lapply()` function call. Our `sma_from_position_1()` function receives the `end`, `period`, and `data` objects we have been working with, and they keep the same meaning and perform the same vectorized mean computation we were doing earlier. However, instead of using an explicit `if…else` conditional, it uses the `ifelse()` function we introduced in Chapter 1, *Introduction to R*, which takes the condition to be checked as its first argument, the desired result in case of the condition being met as its second argument, and the desired result in case the condition is not met as its third argument. In our case, these are `start >= 1`, `mean(data[start:end]`, `price_usd`, and `NA`, respectively.

The result we get from the function calls to  `sma_from_position_1()` are unlisted into a single vector so that we get a vector result instead of a list, and that is in turn returned by `sma_efficient_1()`. Note the change in the name? At this point, this implementation can be considered an efficient one. Hurray! Take a look at the following code snippet:

sma_efficient_1 <- function(period, symbol, data) {

data <- data[data$symbol == symbol, ]

return(unlist(lapply(1:nrow(data),

                    sma_from_position_1,

                    period, data)))

}

sma_from_position_1 <- function(end, period, data) {

start <- end - period + 1

return(ifelse(start >= 1,

            mean(data[start:end, "price_usd"]), NA))

}

Just in case you don't remember the mechanics of the `lapply()` function and you're a bit confused about the way it's being used here, let me remind you that it will take each of the elements in the list provided as the first argument, and feed them as the first argument to the function provided in the second argument. If the said function requires more parameters, those can also be passed after the function object has been provided to the `lapply()` function, which is the case of the `period` and `data` arguments you see toward the end.

Again, benchmark and check for correctness, as shown in the following code snippet:

performance <- microbenchmark(

sma_8 <- sma_efficient_1(period, symbol, data),

unit = "us"

)

all(sma_1$sma - sma_8 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 1137.704

This time, our median time is `1,137.704` microseconds. This is more than our previously fastest implementation. What happened? If you want to know the details, you should profile the function, but in essence, the problem is that we're adding a function call that is executed many times (`sma_from_position_1()`) and function calls can be expensive, and also adding a transformation from a list to a vector we were not doing before (`unlist()`). However, we prefer to advance with version for reasons that shall become clear in a later section. Take a look at the following table:

| **Fastest** | **Implementation** | **Microseconds median** | **% from fastest** |
|  | `sma_slow_1` | `81,035.1900` | `8,897.21 %` |
|  | `sma_slow_2` | `33,031.7785` | `3,626.70 %` |
|  | `sma_slow_3` | `19,628.2430` | `2,155.07 %` |
|  | `sma_slow_4` | `20,825.8790` | `2,286.56 %` |
|  | `sma_slow_5` | `16,682.68` | `1,466.63 %` |
|  | `sma_slow_6` | `2,991.5720` | `328.45 %` |
| ⇒ | `sma_slow_7` | `910.7930` | `100 %` |
|  | `sma_efficient_1`  | `1,137.7040`  | `124.91 %`  |

Thera are many other vectorized functions in R that may help speed your code. Some examples are `which()`, `where()`, `any()`, `all()`, `cumsum()`, and `cumprod()`. When working with matrices, you may use `rowSums()`, `colSums()`, `lower.tri()`, `upper.tri()`, and others, and when working with combinations, you may use `combin()`. There are many more, and when dealing with something that seems like it could be vectorized, chances are that there's already a function for that.

# Avoiding sending data structures with overheads

We know that operating on heavy data structures such as data frames should be avoided when possible, and here it seems that it's still possible to do just that. What if instead of passing our data frame, we extract the `price_usd` variable we're interested in and simply use that? That seems promising.

To accomplish this, at the top of the function, we not only filter for observations containing `symbol` we want, but we also extract the `price_usd` variable at that point. Now, we may send this lower-overhead data structure to our slightly modified the `sma_from_position_2()` function. It is simply modified to work with this vector instead of the full data frame:

sma_efficient_2 <- function(period, symbol, data) {

data <- data[data$symbol == symbol, "price_usd"]

return(unlist(lapply(1:length(data),

                    sma_from_position_2,

                    period, data)))

}

sma_from_position_2 <- function(end, period, data) {

start <- end - period + 1

return(ifelse(start >= 1, sum(data[start:end]) / period, NA))

}

Again, benchmark and check for correctness, as shown in the following code snippet:

performance <- microbenchmark(

sma_9 <- sma_efficient_2(period, symbol, data),

unit = "us"

)

all(sma_1$sma - sma_9 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 238.2425

This time, our mean time is `238.2425` microseconds. That's a big change. In fact, it's the largest performance improvement we have been able to produce pondered by the amount of change required, with respect to the previously fastest implementation.

Do you realize how drastic the performance improvement has been? Our first implementation takes approximately 33,900% more time to execute. Inversely, our `sma_efficient_2()` implementation takes only around 0.2% of the time that our `sma_slow_1()` implementation took. Were you expecting such a large time reduction by only writing better R code when we started this chapter? Take a look at the following table:

| **Fastest** | **Implementation** | **Microseconds median** | **% from fastest** |
|  | `sma_slow_1` | `81,035.1900` | `34,013.74 %` |
|  | `sma_slow_2` | `33,031.7785` | `13,865.77 %` |
|  | `sma_slow_3` | `19,628.2430` | `8,238.76 %` |
|  | `sma_slow_4` | `20,825.8790` | `8,741.46 %` |
|  | `sma_slow_5` | `16,682.6800` | `7,002.39 %` |
|  | `sma_slow_6` | `2,991.5720` | `1,255.68 %` |
| ⇒ | `sma_slow_7` | `910.7930` | `382.29 %` |
|  | `sma_efficient_1`  | `1,137.7040`  | `477.54 %` |
|  | `sma_efficient_2` | `238.2425`  | `100%` |

Let's assume that we are very picky, and we want to further improve performance. What should we do? Well, let's profile our code again to find out. As you can see here, the number of function calls is reduced to just one in the `$by.self` table and only five in the `$by.total` table. Unfortunately, these results don't show us any way we can further improve performance, since all the functions shown are highly optimized already. The only thing you can attempt is to replace the `mean()` function with one of the faster alternatives shown earlier, but we won't do it in this case, since the effect of doing so was already shown previously:

Rprof()

sma_9 <- sma_efficient_2(period, symbol, data_original[1:10000, ])

Rprof(NULL)

summaryRprof()

> $by.self

> self.time self.pct total.time total.pct

> "ifelse" 0.02 100 0.02 100

>

> $by.total

> total.time total.pct self.time self.pct

> "ifelse" 0.02 100 0.02 100

> "FUN" 0.02 100 0.00 0

> "lapply" 0.02 100 0.00 0

> "sma_efficient_2" 0.02 100 0.00 0

> "unlist" 0.02 100 0.00 0

To further reduce the execution time of our implementation, we will have to resort to more advanced techniques such as parallelization and delegation, which are the subjects of the following sections.

Note that that's where `Rprof()` will stop being useful most of the time, since we will start using advanced tools, outside of R, to continue to improve performance, and such tools require their own profiling techniques and knowledge that we won't go into in this book.

# Using parallelization to divide and conquer

So far, we have learned various ways to optimize the performance of R programs running serially, that is, in a single thread. This does not take advantage of the multiple CPU cores most computers have nowadays. Parallel computing allows us to tap into them by splitting our implementations in multiple parts that are sent to these processors independently, and it has the potential to accelerate programs when a single thread is an important bottleneck.

Parallelizing real-world applications can be a very challenging task, and it requires deep software as well as hardware knowledge. The extent of possible parallelization depends on the particular algorithm we're working with, and there are many types of parallelizations available. Furthermore, parallelization is not a yes/no decision; it involves a continuous scale. On one side of the scale, we have embarrassingly parallel tasks, where there are no dependencies between the parallel subtasks, thus making them great candidates for parallelization. On the other side, we have tasks that cannot be parallelized at all, since each step of the task depends on the results of previous steps. Most algorithms fall in between these two extremes, and most real-world parallelized applications perform some tasks serially and others in parallel.

Some tasks that are relatively easy to implement in parallel (some of them would be classified as embarrassingly parallel tasks) are converting hundreds of images from color to grayscale, adding millions of numbers, brute-force searches, and Monte Carlo simulations. The common property among these is that each subtask can be done independently of the others. For example, each image can be processed independently, or we can add various subgroups of numbers and then add the results together, and so on. The moment we introduce an order-dependency, parallelization breaks out.

# How deep does the parallelization rabbit hole go?

With parallelizing and algorithm, there are a lot of decisions that must be made. First of all, we must decide what parts of the algorithm will be implemented in parallel and which parts will be implemented serially, and how to manage these parts to work correctly among themselves. Next we must decide, whether explicitly or implicitly, whether the parallelized parts will have shared or distributed memory, whether we will do data or task parallelization, whether we need to introduce some type of distributed or concurrent mechanism, and if so, what protocol will be used to coordinate them. Once we have established those high-level decisions, we must take care of the fine-grained decisions regarding the number and architecture of the processors we will use as well as the amount of memory and control permissions.

Don't worry too much about the concepts mentioned earlier; they are for more advanced usage than the intended level for this book. I will provide very general and simple explanations here to ensure that you understand the type of parallelization we will implement ourselves, but feel free to skip this section if you want.

**Shared memory** systems share objects stored in-memory across different processes, which can be very resource efficient, but also dangerous since one process may modify an object that is used by another process without it knowing that it happened. Another disadvantage of such systems is that they don't scale well. A more powerful, but also more complex alternative, is **distributed memory**, which makes copies of the data needed for different processes that may reside in different systems altogether. This approach can scale to thousands of CPUs, but comes at the cost of complex coordination among processes.

**Data parallelism** is when data is partitioned and each task is executed using a different partition. These types of parallelization help algorithm scale as more data is acquired, since we can simply create more partitions. Note that using data parallelism does not necessarily imply distributed memory, and vice versa. **Task parallelism** is when tasks are sent to different processors to be executed in parallel and they may or may not be working on top of the same data.

A disadvantage of parallel computing is that people run code on different machines, and if you are writing software that you expect to share with others, you need to be careful that your implementation is useful even when executed in different hardware configurations.

All the decisions mentioned earlier require deep technical knowledge to be properly taken, and if they seem complex, it's because they really are. Implementing parallelization can be quite complex activity, depending on the level of control you want to have over it.

Most importantly, remember that R is an interpreted language, so speed gains from utilizing compiled languages will almost always exceed speed gains from parallelizing `for` loops or other loop-hiding functions.

# Practical parallelization with R

In this section, we will show you how to take advantage of multiple cores with R. We will show you how to perform a shared memory single system with multiple cores approach. This is the simplest parallel technique you can implement.

A deep look at various parallelization mechanisms available in R can be found in Theubl's doctoral thesis, *Applied High Performance Computing Using R, by Wirtschafts Universitat, 2007*.

Implementing parallel programs with R has become increasingly easier with time since it's a topic of much interest, and many people have provided, and continue to provide, better ways of doing so. Currently, there are over 70 packages in CRAN that provide some kind of parallelization functionality. Choosing the right package for the right problem, or simply knowing that a variety of options exist, remains a challenge.

In this case, we will use the `parallel` package that comes preinstalled in the recent versions of R. Other very popular packages are `doSNOW`, `doMC`, and `foreach`, but it really depends on what kind of parallelization you want to perform.

The most common parallelization technique in R is to use parallelized replacements of the `lapply()`, `sapply()`, and `apply()` functions. In the case of the `parallel` package, we have the `parLapply()`, `parSapply()`, and `parApply()` functions available, respectively. The fact that signatures among this function pairs are very similar makes the barrier to using this form of parallelization very low, and that's why I decided to showcase this technique.

Implementing the parallelization technique we will showcase is simple enough, and it involves the following three main steps once you have loaded the `parallel` package:

1.  Create a cluster with the `makeCluster()` function
2.  Replace a `apply()` function with one a `par*pply()` one
3.  Stop the cluster you created in the first step

For our case, we will replace the `lapply()` function with `parLapply()` in our `sma_efficient_2()` implementation. However, you should avoid a common mistake done by people just starting with parallelization. Normally, they will create and later destroy a cluster within the function called to perform a task, instead of receiving a cluster from the outside and using it within. This creates performance problems, because the cluster will potentially be started many times, and starting a parallelization cluster can have quite a bit of overhead. A function that makes such a mistake is the `sma_parallel_inefficient()` function, as follows:

library(parallel)

sma_parallel_inefficient <- function(period, symbol, data) {

data <- as.numeric(data[data$symbol == symbol, "price_usd"])

cluster <- makeCluster(detectCores())

result <- unlist(parLapply(

cluster, 1:length(data), sma_from_position_2, period, data))

stopCluster(cluster)

return(result)

}

As you can see, `sma_parallel_inefficient()` is just `sma_efficient_2()` with the added logic for the cluster creation and deletion, and the `lapply()` replacement with `parLapply()`. You shouldn't really use this function, but it's put here to showcase how bad it can be for performance if you do. As always, we benchmark and check for correctness, as shown in the following code snippet:

performance <- microbenchmark(

sma_10 <- sma_parallel_inefficient(period, symbol, data),

unit = "us"

)

all(sma_1$sma - sma_10 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 1197329.3980

In this case, our median time is `1,197,329.398` microseconds, which should not be too surprising after mentioning that creating and destroying a cluster multiple times can be quite inefficient. Take a look at the following table:

![](https://github.com/OpenDocCN/freelearn-ds-zh/raw/master/docs/r-prog-ex/img/00064.jpeg)

Now, we proceed to remove the logic that creates and destroys the cluster out of the function, and instead receive the `cluster` as a parameter to `sma_parallel()`. In that case, our implementation looks just like the one we had before, except for the use of `parLapply()`. It's nice to be able to achieve something as complex as parallelization with simply this change, but it's really a product of having simplified our code up to what we have now. If we attempted to parallelize our initial `sma_slow_1()` implementation, we would have a hard time doing so. Take a look at the following code snippet:

sma_parallel <- function(period, symbol, data, cluster) {

data <- as.numeric(data[data$symbol == symbol, "price_usd"])

return(unlist(parLapply(

    cluster, 1:length(data), sma_from_position_2, period, data)))

}

Again, we benchmark and check for correctness, as shown in the following code snippet:

cluster <- makeCluster(detectCores())

performance <- microbenchmark(

sma_11 <- sma_parallel(period, symbol, data, cluster),

unit = "us"

)

all(sma_1$sma - sma_11 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 44825.9355

In this case, our median time is `44,825.9355` microseconds, which is roughly worse than we were able to achieve with `sma_slow_2()`. Wasn't parallelization supposed to be much faster? The answer is yes, when working with larger inputs. When we use data that has millions of observations (not the 100 observations we have been using for these tests), it will be faster, because its execution time won't increase as much as the one for other implementations. Right now, `sma_paralle()` is paying a big fixed cost that is not a good investment when working with small datasets, but as we start working with larger datasets, the fixed cost starts being small as compared to the performance gains. Take a look at the following table:

![](https://github.com/OpenDocCN/freelearn-ds-zh/raw/master/docs/r-prog-ex/img/00065.jpeg)

To finalize the section, remember to call `stopCluster(cluster)` when you want to stop using the cluster. In this case, we will leave it running as we will continue to perform more benchmarks through the rest of the chapter.

# Using C++ and Fortran to accelerate calculations

Sometimes, R code just isn't fast enough. Sometimes, you've used profiling to figure out where your bottlenecks are, and you've done everything you can think of within R, but your code still isn't fast enough. In those cases, a useful alternative can be to delegate some parts of the implementation to more efficient languages such as Fortran and C++. This is an advanced technique that can often prove to be quite useful if know how to program in such languages.

Delegating code to other languages can address bottlenecks such as the following:

*   Loops that can't be easily vectorized due to iteration dependencies
*   Processes that involve calling functions millions of times
*   Inefficient but necessary data structures that are slow in R

Delegating code to other languages can provide great performance benefits, but it also incurs the cost of being more explicit and careful with the types of objects that are being moved around. In R, you can get away with simple things such as being imprecise about a number being an integer or a real. In these other languages, you can't; every object must have a precise type, and it remains fixed for the entire execution.

# Using an old-school approach with Fortran

We will start with an old-school approach using Fortran first. If you are not familiar with it, Fortran is the oldest programming language still under use today. It was designed to perform lots of calculations very efficiently and with very few resources. There are a lot of numerical libraries developed with it, and many high-performance systems nowadays still use it, either directly or indirectly.

Here's our implementation, named `sma_fortran()`. The syntax may throw you off if you're not used to working with Fortran code, but it's simple enough to understand. First, note that to define a function technically known as a `subroutine` in Fortran, we use the `subroutine` keyword before the name of the function. As our previous implementations do, it receives the `period` and `data` (we use the `dataa` name with an extra `a` at the end because Fortran has a reserved keyword `data`, which we shouldn't use in this case), and we will assume that the data is already filtered for the correct symbol at this point.

Next, note that we are sending new arguments that we did not send before, namely `smas` and `n`. Fortran is a peculiar language in the sense that it does not return values, it uses side effects instead. This means that instead of expecting something back from a call to a Fortran subroutine, we should expect that subroutine to change one of the objects that was passed to it, and we should treat that as our `return` value. In this case, `smas` fulfills that role; initially, it will be sent as an array of undefined real values, and the objective is to modify its contents with the appropriate SMA values. Finally, the `n` represents the number of elements in the data we send. Classic Fortran doesn't have a way to determine the size of an array being passed to it, and it needs us to specify the size manually; that's why we need to send `n`. In reality, there are ways to work around this, but since this is not a book about Fortran, we will keep the code as simple as possible.

Next, note that we need to declare the type of objects we're dealing with as well as their size in case they are arrays. We proceed to declare `pos` (which takes the place of position in our previous implementation, because Fortran imposes a limit on the length of each line, which we don't want to violate), `n`, `endd` (again, `end` is a keyword in Fortran, so we use the name `endd` instead), and `period` as integers. We also declare `dataa(n)`, `smas(n)`, and `sma` as reals because they will contain decimal parts. Note that we specify the size of the array with the `(n)` part in the first two objects.

Once we have declared everything we will use, we proceed with our logic. We first create a `for` loop, which is done with the `do` keyword in Fortran, followed by a unique identifier (which are normally named with multiples of tens or hundreds), the variable name that will be used to iterate, and the values that it will take, `endd` and `1` to `n` in this case, respectively.

Within the `for` loop, we assign `pos` to be equal to `endd` and `sma` to be equal to `0`, just as we did in some of our previous implementations. Next, we create a `while` loop with the `do…while` keyword combination, and we provide the condition that should be checked to decide when to break out of it. Note that Fortran uses a very different syntax for the comparison operators. Specifically, the `.lt.` operator stand for less-than, while the `.ge.` operator stands for greater-than-or-equal-to. If any of the two conditions specified is not met, then we will exit the `while` loop.

Having said that, the rest of the code should be self-explanatory. The only other uncommon syntax property is that the code is indented to the sixth position. This indentation has meaning within Fortran, and it should be kept as it is. Also, the number IDs provided in the first columns in the code should match the corresponding looping mechanisms, and they should be kept toward the left of the logic-code.

For a good introduction to Fortran, you may take a look at *Stanford's Fortran 77 Tutorial* ([`web.stanford.edu/class/me200c/tutorial_77/`](https://web.stanford.edu/class/me200c/tutorial_77/)). You should know that there are various Fortran versions, and the 77 version is one of the oldest ones. However, it's also one of the better supported ones:

subroutine sma_fortran(period, dataa, smas, n)

integer pos, n, endd, period

real dataa(n), smas(n), sma

do 10 endd = 1, n

    pos = endd

    sma = 0.0

    do 20 while ((endd - pos .lt. period) .and. (pos .ge. 1))

        sma = sma + dataa(pos)

        pos = pos - 1

20 end do

    if (endd - pos .eq. period) then

        sma = sma / period

    else

        sma = 0

    end if

    smas(endd) = sma

10 continue

end

Once your code is finished, you need to compile it before it can be executed within R. Compilation is the process of translating code into machine-level instructions. You have two options when compiling Fortran code: you can either do it manually outside of R or you can do it within R. The second one is recommended since you can take advantage of R's tools for doing so. However, we show both of them. The first one can be achieved with the following code:

$ gfortran -c sma-delegated-fortran.f -o sma-delegated-fortran.so

This code should be executed in a Bash terminal (which can be found in Linux or Mac operating systems). We must ensure that we have the `gfortran` compiler installed, which was probably installed when R was. Then, we call it, telling it to compile (using the `-c` option) the `sma-delegated-fortran.f` file (which contains the Fortran code we showed before) and provide an output file (with the `-o` option) named `sma-delegated-fortran.so`. Our objective is to get this `.so` file, which is what we need within R to execute the Fortran code.

The way to compile within R, which is the recommended way, is to use the following line:

system("R CMD SHLIB sma-delegated-fortran.f")

It basically tells R to execute the command that produces a shared library derived from the `sma-delegated-fortran.f` file. Note that the `system()` function simply sends the string it receives to a terminal in the operating system, which means that you could have used that same command in the Bash terminal used to compile the code manually.

To load the shared library into R's memory, we use the `dyn.load()` function, providing the location of the `.so` file we want to use, and to actually call the shared library that contains the Fortran implementation, we use the `.Fortran()` function. This function requires type checking and coercion to be explicitly performed by the user before calling it.

To provide a similar signature as the one provided by the previous functions, we will create a function named `sma_delegated_fortran()`, which receives the `period`, `symbol`, and `data` parameters as we did before, also filters the data as we did earlier, calculates the length of the data and puts it in `n`, and uses the `.Fortran()` function to call the `sma_fortran()` subroutine, providing the appropriate parameters. Note that we're wrapping the parameters around functions that coerce the types of these objects as required by our Fortran code. The `results` list created by the `.Fortran()` function contains the `period`, `dataa`, `smas`, and `n` objects, corresponding to the parameters sent to the subroutine, with the contents left in them after the subroutine was executed. As we mentioned earlier, we are interested in the contents of the `sma` object since they contain the values we're looking for. That's why we send only that part back after converting it to a `numeric` type within R.

The transformations you see before sending objects to Fortran and after getting them back is something that you need to be very careful with. For example, if instead of using `single(n)` and `as.single(data)`, we use `double(n)` and `as.double(data)`, our Fortran implementation will not work. This is something that can be ignored within R, but it can't be ignored in the case of Fortran:

system("R CMD SHLIB sma-delegated-fortran.f")

dyn.load("sma-delegated-fortran.so")

sma_delegated_fortran <- function(period, symbol, data) {

data <- data[which(data$symbol == symbol), "price_usd"]

n <- length(data)

results <- .Fortran(

    "sma_fortran",

    period = as.integer(period),

    dataa = as.single(data),

    smas = single(n),

    n = as.integer(n)

)

return(as.numeric(results$smas))

}

Just as we did earlier, we benchmark and test for correctness:

performance <- microbenchmark(

sma_12 <- sma_delegated_fortran(period, symboo, data),

unit = "us"

)

all(sma_1$sma - sma_12 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 148.0335

In this case, our median time is of `148.0335` microseconds, making this the fastest implementation up to this point. Note that it's barely over half of the time from the most efficient implementation we were able to come up with using only R. Take a look at the following table:

![](https://github.com/OpenDocCN/freelearn-ds-zh/raw/master/docs/r-prog-ex/img/00066.jpeg)

# Using a modern approach with C++

Now, we will show you how to use a more modern approach using C++. The aim of this section is to provide just enough information for you to start experimenting using C++ within R on your own. We will only look at a tiny piece of what can be done by interfacing R with C++ through the `Rcpp` package (which is installed by default in R), but it should be enough to get you started.

If you have never heard of C++, it's a language used mostly when resource restrictions play an important role and performance optimization is of paramount importance. Some good resources to learn more about C++ are Meyer's books on the topic, a popular one being *Effective C++* (Addison-Wesley, 2005), and specifically for the `Rcpp` package, Eddelbuettel's *Seamless R and C++ integration with Rcpp* *by Springer, 2013*, is great.

Before we continue, you need to ensure that you have a C++ compiler in your system. On Linux, you should be able to use `gcc`. On Mac, you should install Xcode from the application store. O n Windows, you should install Rtools. Once you test your compiler and know that it's working, you should be able to follow this section. We'll cover more on how to do this in Appendix, *Required Packages*.

C++ is more readable than Fortran code because it follows more syntax conventions we're used to nowadays. However, just because the example we will use is readable, don't think that C++ in general is an easy language to use; it's not. It's a very low-level language and using it correctly requires a good amount of knowledge. Having said that, let's begin.

The `#include` line is used to bring variable and function definitions from R into this file when it's compiled. Literally, the contents of the `Rcpp.h` file are pasted right where the `include` statement is. Files ending with the `.h` extensions are called header files, and they are used to provide some common definitions between a code's user and its developers. They play a similar role to what we called an interface in the previous chapter.

The `using namespace Rcpp` line allows you to use shorter names for your function. Instead of having to specify `Rcpp::NumericVector`, we can simply use `NumericVector` to define the type of the `data` object. Doing so in this example may not be too beneficial, but when you start developing for complex C++ code, it will really come in handy.

Next, you will notice the `// [[Rcpp::export(sma_delegated_cpp)]]` code. This is a tag that marks the function right below it so that R know that it should import it and make it available within R code. The argument sent to `export()` is the name of the function that will be accessible within R, and it does not necessarily have to match the name of the function in C++. In this case, `sma_delegated_cpp()` will be the function we call within R, and it will call the  `smaDelegated()` function within C++:

include

using namespace Rcpp;

// [[Rcpp::export(sma_delegated_cpp)]]

NumericVector smaDelegated(int period, NumericVector data) {

int position, n = data.size();

NumericVector result(n);

double sma;

for (int end = 0; end < n; end++) {

    position = end;

    sma = 0;

    while(end - position < period && position >= 0) {

        sma = sma + data[position];

        position = position - 1;

    }

    if (end - position == period) {

        sma = sma / period;

    } else {

        sma = NA_REAL;

    }

    result[end] = sma;

}

return result;

}

Next, we will explain the actual `smaDelegated()` function. Since you have a good idea of what it's doing at this point, we won't explain its logic, only the syntax that is not so obvious. The first thing to note is that the function name has a keyword before it, which is the type of the `return` value for the function. In this case, it's `NumericVector`, which is provided in the `Rcpp.h` file. This is an object designed to interface vectors between R and C++. Other types of vector provided by `Rcpp` are `IntegerVector`, `LogicalVector`, and `CharacterVector`. You also have `IntegerMatrix`, `NumericMatrix`, `LogicalMatrix`, and `CharacterMatrix` available.

Next, you should note that the parameters received by the function also have types associated with them. Specifically, `period` is an integer (`int`), and `data` is `NumericVector`, just like the output of the function. In this case, we did not have to pass the `output` or `length` objects as we did with Fortran. Since functions in C++ do have output values, it also has an easy enough way of computing the length of objects.

The first line in the function declare a variables `position` and `n`, and assigns the length of the data to the latter one. You may use commas, as we do, to declare various objects of the same type one after another instead of splitting the declarations and assignments into its own lines. We also declare the vector `result` with length `n`; note that this notation is similar to Fortran's. Finally, instead of using the `real` keyword as we do in Fortran, we use the `float` or `double` keyword here to denote such numbers. Technically, there's a difference regarding the precision allowed by such keywords, and they are not interchangeable, but we won't worry about that here.

The rest of the function should be clear, except for maybe the `sma = NA_REAL` assignment. This `NA_REAL` object is also provided by `Rcpp` as a way to denote what should be sent to R as an `NA`. Everything else should result familiar.

Now that our function is ready, we save it in a file called `sma-delegated-cpp.cpp` and use R's `sourceCpp()` function to bring compile it for us and bring it into R. The `.cpp` extension denotes contents written in the C++ language. Keep in mind that functions brought into R from C++ files cannot be saved in a `.Rdata` file for a later session. The nature of C++ is to be very dependent on the hardware under which it's compiled, and doing so will probably produce various errors for you. Every time you want to use a C++ function, you should compile it and load it with the `sourceCpp()` function at the moment of usage.

library(Rcpp)

sourceCpp("./sma-delegated-cpp.cpp")

sma_delegated_cpp <- function(period, symbol, data) {

data <- as.numeric(data[which(data$symbol == symbol), "price_usd"])

return(sma_cpp(period, data))

}

If everything worked fine, our function should be usable within R, so we benchmark and test for correctness. I promise this is the last one:

performance <- microbenchmark(

sma_13 <- sma_delegated_cpp(period, symboo, data),

unit = "us"

)

all(sma_1$sma - sma_13 <= 0.001, na.rm = TRUE)

> TRUE

summary(performance)$median

> [1] 80.6415

This time, our median time was `80.6415` microseconds, which is three orders of magnitude faster than our first implementation. Think about it this way: if you provide an input for `sma_delegated_cpp()` so that it took around one hour for it to execute, `sma_slow_1()` would take around 1,000 hours, which is roughly 41 days. Isn't that a surprising difference? When you are in situations that take that much execution time, it's definitely worth it to try and make your implementations as optimized as possible.

You may use the `cppFunction()` function to write your C++ code directly inside an `.R` file, but you should not do so. Keep that just for testing small pieces of code. Separating your C++ implementation into its own files allows you to use the power of your editor of choice (or IDE) to guide you through the development as well as perform deeper syntax checks for you.

# Looking back at what we have achieved

As you know, up to now, we have benchmarked our code using a subset of the data that contains only the first 100 observations. However, as we saw at the beginning of the chapter, performance can vary for different implementations, depending on the size of the input. To bring together all our efforts in the chapter, we will create a couple of functions that will help us measure how the execution times for our implementations change as we use more observations from our data. 

First, we bring our requirements into R, mainly, the `microbenchmark` and `ggplot2` packages and the files that contain our implementations.

Next, we create the `sma_performance()` function that takes a `symbol`, a `period`, the `original_data`, a list named `sizes` whose elements are the number of observations that will be taken from `original_data` to test our implementations, a `cluster` to avoid the overhead of initializing it within our `sma_parallel()` function as we saw in the corresponding section, and the number of times we want to measure each implementation.

As you can see, for each size in sizes, we take the corresponding number of observations in the `data` object, and we send it along with the other necessary arguments for the `sma_microbenchmark()` function. Then, we add the `size` value into the `result` data frame, which is provided by the `summary()` function applied on top of the resulting object from the `microbenchmark()` function from `sma_microbenchmark()`. We need to add this ourselves because the `microbenchmark()` function doesn't have any knowledge about the size of the data it's dealing with. Finally, we flatten the list of data frames in the `results` list with the `do.call("rbind", results)` function call, which sends a single data frame as output.

The `sma_microbenchmark()` function is very simple. It only receives some parameters and passes them forward to each of the implementations that will be measured by the `microbenchmark()` function. Note that we are leaving inside the `sma_paralel_inefficient()` function, but it's commented out to avoid any scale issues in the graph we will end up producing (since it is very slow, it will skew our graph).

The resulting object from the `sma_performance()` function returns a data frame with the results for all the tests, which is used as input for the `graph_sma_performance()` function in the form of `results` objects. It also receives the `sizes`, which will be used to define the values in the x axis. As you can see, we call `remove_arguments()`, which we mention as we move ahead. It creates a graph using the `ggplot()`, `geom_point()`, and `geom_line()` functions as we saw earlier, and we use logarithmic scales for both axes.

The `remove_arguments()` function does exactly what it says—it removes the parenthesis and the arguments from the function calls so that we keep only the function name. This is done to reduce the space in the graph's legend. To accomplish this, we use the `gsub()` function we saw in Chapter 1, *Introduction to R*.

To use the code we just presented, we simply create the `sizes` list we are missing and use all the other objects we had defined previously in this chapter. In this particular case, we want to measure the first 10, 100, 1,000, and 10,000 observations. If you want, you can increase this list with larger amounts. Remember that the total amount of observations in the simulated data is a little over 1,000,000.

The resulting graph shows the number of observations in the *x* axis and the microseconds median in the *y* axis. Both axes use logarithmic scale, so keep in mind when interpreting the relations. As you can see, when the size of the input is smaller (toward the left of the graph) the execution time difference is smaller, and as we increase the input size, differences start being larger and larger, specially considering the logarithmic scales.

Some interesting things to note are as listed as follows:

*   `sma_efficient_1()`: The function was shown to be slower than the `sma_slow_7()` for 100 observations, is actually faster when using 10,000 observations. This shows that the tradeoff made sense, specially as inputs increase.
*   `sma_efficient_2()`: This implementation is faster, for 10 observations, than the Fortran implementation. That's pretty surprising and shows that the overhead incurred in calling Fortran code is not worth it for that input size. However, `sma_efficient_2()` quickly becomes slower as input size increases.
*   `sma_parallel()`: This implementation is slow due to all the overhead it incurs as we saw in the corresponding section, but it's also the implementation where percentage time increase is the least as input size increases. This should makes us wonder what happens when we're dealing with the full data? Will it be faster, at that point, that the Fortran or C++ implementations which seem to be increasing faster? That's left as an exercise for the reader.

Finally, for the curious reader, what do you think will happen if you use the `sma_delegated_cpp()` implementation along with the parallelization approach we showed? If you want to know the answer, you should definitely try it yourself.

# Other topics of interest to enhance performance

We saw an overview of the most important and common techniques used to optimize R implementations. However, there is still a lot we have not covered. In the following sections, we will briefly mention some of them.

# Preallocating memory to avoid duplication

Memory preallocation is an important technique we covered implicitly when we used the `lapply()` function, since it does preallocation for us. However, a more explicit explanation can be useful. As we have already seen, dynamically growing objects in R is not great for performance. Instead, you should define an object with the full size you will need and then perform updates on its elements instead of recreating them. To accomplish this, you may use something like `double(10)` to define an vector of doubles that will contain 10 elements at most. Whenever you define an object's size before you start using it, will help you avoid recreating new objects each time its size is increased and will save you a lot of time.

However, accurate preallocation is not always feasible because it requires that we know the total number prior to the iteration. Sometimes, we can only ask for a result to store repeatedly without knowing the exact total number. In this case, maybe it is still a good idea to preallocate a list or vector with a reasonable length. When the iteration is over, if the number of iterations does not reach the preallocated length, we can take a subset of the list or vector. In this way, we can avoid intensive reallocation of data structures.

When it comes to preallocating memory, R is no different from the other programming languages. However, being an interpreted language, it imposes less restrictions; thus, it is easy for users to overlook this types of issues. R will not throw any compilation error if a vector's memory is not preallocated. You should keep this in mind when writing fast code.

# Making R code a bit faster with byte code compilation

Even though R is an interpreted language, it can go through a small phase before code execution called **byte code compilation**, which is a less strict compilation procedure. Under some scenarios, it can save between 5% to 10% of time if already optimized functions are not being used heavily. All base R functions are byte code compiled by default.

To byte code compile your functions, you use the `cmpfunc()` function wrapped around the function you want to compile, after loading the `compiler` package. You may also send an `options` arguments such as `options = list(optimize = 3))`, where the optimize element should be an integer between `0` and `3`. The higher the number, the more effort R will put into optimizing the compilation. The following lines show how to create a function called `sma_efficient_2_compiled()`, which is a compiled version of the `sma_efficient_2()` function:

library(compiler)

sma_efficient_2_compiled <-

cmpfun(sma_efficient_2, options = list(optimize = e))

# Just-in-time (JIT) compilation of R code

R also supports **Just-in-time** (**JIT**) compilation. When JIT compilation is enabled, R will automatically byte code compile any code that is executed without explicitly having called one of the compile functions. To activate JIT compilation, use the `enableJIT()` function.

The level argument tells R how much code to compile before execution; `0` disables `JIT`, `1` compiles functions before their first use, `2` also compiles functions before they are duplicated, and `3` also compiles loops before they are executed:

library(compiler)

enableJIT(level = 3)

**JIT** 编译可以通过在启动 R 之前在操作系统中设置 `R_ENABLE_JIT` 环境变量来启用。`R_ENABLE_JIT` 的值应设置为 level 参数的值。

# 使用记忆化或缓存层

如果你具有确定性的算法，每次提供相同的输入时，你应该收到相同的输出，如果情况如此，并且从输入到输出的过程非常耗时，你可以使用记忆化或缓存层。基本思想是存储一些输入和输出的副本，每次将输入发送到函数时，在计算输出之前，检查该特定输入的输出是否已经计算过。如果是，发送它而不是再次做所有的工作。这意味着你只需为每个输入计算一次输出。

你应该尝试在本书开头创建的 `fibonacci_recursive()` 函数中实现这样的层，以了解这类技术即使在使用慢速算法时也能产生多大的影响。

有时，即使给定输入的输出随时间变化，也会使用这类技术。在这种情况下，你只需要提供一个机制，在特定时间后使存储的输入/输出关系失效或删除，以便下次使用输入时实际上重新计算。

# 提高我们的数据和内存管理

R，作为任何编程语言，都受限于 CPU、RAM 和 I/O，在本章中，我们专注于提高 CPU 部分的效率。然而，通过使我们的 RAM 和 I/O 使用更加高效，也可以实现相当大的性能提升。

在 R 之外使用操作系统提供的工具来测量 RAM（内存）使用情况是最佳做法，这些工具正是为此目的而设计的。这些工具报告的信息会根据操作系统而有所不同，但以下是一些你应该关注的关键指标：CPU 使用率、空闲内存、物理内存、交换空间大小以及每秒读取/写入的字节数。

如果你遇到高 CPU 利用率，CPU 很可能是 R 性能的主要瓶颈。使用本章中介绍的性能分析技术来识别代码中占用 CPU 时间最多的部分是解决问题的方法。

如果你遇到足够的空闲系统内存和高磁盘 I/O 的情况，你的代码可能正在执行大量的磁盘读取/写入操作。移除任何不必要的 I/O 操作，并在有足够内存的情况下将中间数据存储在内存中。

如果你遇到 CPU 利用率低、空闲系统内存低以及大交换空间的情况，系统可能正在耗尽物理内存，因此将内存交换到磁盘上。在这种情况下，检查你是否拥有足够的资源来处理发送给 R 的负载，如果有，尝试使用`rm()`函数从 R 会话中删除等待内存的未使用对象。

如果你遇到与上一个情况类似的情况，但你知道你没有足够的内存来处理你正在处理的全数据，即使你这样做得很高效，你可以尝试对数据进行分区。你能通过部分处理数据，然后将结果汇总吗？如果是这样，你应该尝试这样做。例如，如果你的全部数据不适合内存，你正在尝试找到最大值，你可能想将数据分成四部分，一次加载一个，计算每个的最大值，然后在计算完之后从内存中删除它们，同时保留最大值，然后得到四个单独计算出的最大值中的最大值。

对于类似前一种情况的可能性，你可以简单地迁移你的数据处理到数据库。数据库是专门用于处理数据的工具，可以避免数据成为 R 的瓶颈，因为只有你需要的数据预处理子集被带入 R。如今的大多数数据库也执行非常高效的简单操作，如查找最大值。你可以利用我们在第四章中展示的技术，*模拟销售数据和数据库操作*，来完成这项工作。

# 使用专门的性能包

提高你实现性能的另一种好方法是寻找在 CRAN 软件包或其他地方发布的专用函数。在你开始修改自己的代码之前，先看看是否可以在其他地方找到一个非常高效的实现。CRAN 软件包的质量和速度差异很大，但利用它们肯定可以为你节省大量时间。

有两个非常强大的软件包可以帮助你开发高效的实现，分别是 `data.table` 和 `dplyr` 软件包。它们可以提供处理数据框的高效方法，在 `dplyr` 的情况下还可以处理其他对象。**基本线性代数子程序**（**BLAS**）库在执行线性代数操作时也非常有帮助。它是用 Fortran 编写的，并且高度优化。

# 云计算带来的灵活性和强大功能

有时候，你甚至不需要更多的计算能力或高效的资源使用。有时候，你只需要在其他计算机上运行 R，而不用占用你自己的计算机数小时或数天。在这些情况下，使用云计算资源可能非常有用。

云计算资源不仅在你想使用额外机器时很有用，而且是一种非常有效的方式来获取超级计算机为你做一些工作。构建一个具有 64 个 CPU 核心和 512 GB RAM 的机器非常容易。使用这样的系统可能比你想象的要便宜，并且可以用于非常昂贵的计算，这些计算在通用硬件上会花费太多时间。

# 专业的 R 分布

最后，如果你之前尝试的选项都没有奏效，你也可以使用专业的 R 分布。这些分布是独立于常见的 R 分布维护的，并且专注于优化 R 中的特定方面。其中一些是为了提供细粒度控制的并行化而构建的，而另一些则是自动为你完成。学习使用这些分布可能需要大量的时间投入，这对你具体情况可能有益也可能无益。

# 摘要

在本章中，我们看到了导致 R 代码运行缓慢的最重要原因：在不理解对象不可变性的情况下编程、解释动态类型的特点、内存受限的过程以及单线程过程。我们了解到，第一个可以通过正确使用 R 来减少，第二个可以通过委托给 Fortran 或 C++ 等统计类型语言来减少，第三个可以通过使用更强大的计算机（特别是具有更多 RAM 的计算机）来减少，最后，第四个可以通过并行化来减少。

我们还提到了一些变量，这些变量在决定是否优化我们的实现时可能需要考虑，一个很小的实现差异可能带来大的性能提升，以及随着输入规模的增长，这些提升的性能可以变得更大。最后，我们还学习了如何进行性能分析和基准测试以改进我们的实现。

在下一章和最后一章中，我们将学习如何使用`Shiny`包来创建交互式仪表板，这些仪表板将利用本章中我们开发的全局移动平均（SMA）实现。


# 第十章：使用仪表板添加交互性

Shiny 允许您完全使用 R 编写强大的交互式网络应用程序。使用 R，您可以创建用户界面和服务器，Shiny 将您的 R 代码编译成显示在网页上所需的 HTML、CSS 和 JavaScript 代码。使 Shiny 应用程序特别强大的是，它可以在后端执行 R 代码，因此您的应用程序可以执行您在桌面上可以运行的任何 R 计算。您可能希望应用程序根据用户输入处理一些数据，并提供一些交互性，使数据分析更加直观。在本章中，我们将向您展示如何实现这一点。

Shiny 实现了推动许多当今最现代网络应用程序的 *函数式响应式编程* 范式。我们将解释它是什么以及它在 Shiny 中的工作方式。我们将展示如何处理来自应用程序用户的流式事件以及如何相应地做出反应。为此，我们将通过一个示例来演示，该示例接收用户输入并提供数据和图表。到本章结束时，您将意识到创建强大的网络应用程序是多么容易，这些应用程序可以将您的 R 技能提升到新的水平。

本章涵盖的一些重要主题如下：

+   Shiny 网络应用程序架构

+   函数式响应式编程范式

+   Shiny 中如何实现响应性

+   从用户交互中接收输入

+   向网络浏览器发送响应输出

+   向 Shiny 应用程序添加交互性

# 必需的包

我们已经使用过前两个包，即 `ggplot2` 和 `lubridate`。`shiny` 包用于直接从 R 构建网络应用程序，而 `shinythemes` 和 `ggthemr` 包用于将主题应用于我们的网络应用程序。有关更多信息，请参阅 附录，*必需的包*。本章所需的必需包如下表所示：

| **包** | **原因** |
| --- | --- |
| `ggplot2` | 高质量图表 |
| `lubridate` | 轻松转换日期 |
| `shiny` | 创建现代网络应用程序 |
| `ggthemr` | 将主题应用于 `ggplot2` 图表 |
| `shinythemes` | 将主题应用于 Shiny 应用程序 |

# 介绍 Shiny 应用程序架构和响应性

在其最简单形式中，Shiny 应用程序需要一个服务器和一个 **用户界面**（**UI**）。这些组件构成了所有 Shiny 应用程序背后的基本架构。`ui` 对象控制着应用程序的布局和外观，而 `server` 函数包含应用程序所需的逻辑。如果您了解网络应用程序的工作原理，您可以将其视为分别的 *前端* 和 *后端*。`shinyApp()` 函数从显式的 UI/server 对创建并启动一个 Shiny 应用程序。它将 R 代码编译成网络友好的语言 HTML、JavaScript 和 CSS。

下面是我们能想到的最简单的 Shiny 应用程序，它有一个空的服务器和带有基本信息的 UI。如果您在一个交互式的 R 会话中，您的网络浏览器应该会启动并显示该应用程序。如果它没有这样做，您可以自己导航到 URL，其形式为`http://127.0.0.1:6924/`，其中`127.0.0.1`是您自己计算机的 IP 地址，而`6924`是 Shiny 用于监听连接的端口。正如您在浏览器中看到的那样，它并不令人惊叹，但它是一个仅使用 R 创建的运行中的网络应用程序：

```py
library(shiny)
server <- function(input, output) { }
ui <- fluidPage("This is a Shiny application.")
shinyApp(ui, server)

使用固定的端口，而不是在每次shinyApp()调用时随机分配的端口，可以简化开发。要使用固定端口，将函数调用更改为shinyApp(ui, server, options = list(port = 6924))，并使用您偏好的端口。

注意，当应用程序处于活动状态时，您的 R 会话将会忙碌，因此您将无法运行任何 R 命令。R 正在监控应用程序并执行应用程序的反应。要恢复您的 R 会话，请按Ctrl + C，或者如果您正在使用 RStudio，请点击停止标志图标。

为了简单起见，我们将在单个文件中创建我们的 Shiny 应用程序。然而，对于更大的应用程序，您可能会将组件拆分为ui.R和server.R文件（这些是 Shiny 应用程序的标准文件）。

如本章所述，Shiny 提供了一个极好的范例，用于开发当今许多尖端系统所使用的网络应用程序。它被称为函数式响应式编程。这是一个不易掌握的概念，但它非常强大，我们将在本章中学习如何使用其基本原理。然而，在我们这样做之前，我将尝试提供一个简单的解释，说明它是什么以及如何在 Shiny 中工作。

函数式响应式编程是什么，为什么它有用？

让我们从响应式编程部分开始。响应式编程是与异步数据流进行编程。我们首先在一般层面上定义这些术语。

一个流是一系列按时间顺序排列的持续事件。在现实中，几乎所有东西都可以被视为一个流，但简单的例子是球弹跳，其中每次球击中地面都被视为一个事件。它可以反复多次发生，没有特定的模式，暂停一会儿，然后继续，然后再次停止。用户在网站上点击也是一个流，其中每次点击都是一个事件。正如您所想象的那样，我们周围到处都是流。

需要定义的另一个术语是异步，字面上意味着没有同步。通常，同步函数在函数调用行等待，直到被调用的函数执行完成，可能返回一个值。这是我们迄今为止编程的方式。然而，异步函数不一定会等待它们调用的函数完成。这意味着我们的函数需要响应它，无论何时它到达。

如果我们将这两个术语结合起来，我们可以理解，使用异步数据流进行编程是通过编写能够对发生的事件做出反应的代码来实现的，这些反应是持续和随机的。在本章的情况下，这些事件将是与我们的应用程序交互的用户操作（点击或按键），这意味着我们的 R 代码将直接对这些点击和按键做出反应。

如果这个概念仍然难以理解，可以将其想象成一个带有公式的电子表格。当你改变一个其他单元格依赖或监听的值（在我们的应用程序中相当于从用户那里接收一些输入），那么其他单元格会相应地做出反应，并展示新的计算值（这将是展示给用户的输出变化）。这真的很简单。对流的监听被称为订阅。我们定义的函数是观察者，而流是被观察的可观察对象。这正是观察者设计模式。看看 Gamma、Helm、Johnson 和 Vlissides 合著的书籍《设计模式：可重用面向对象软件元素》，由 Addison-Wesley 出版社，1994 年出版。

此外，你有一套强大的工具，允许你创建、过滤和组合这些流中的任何一个。这就是函数式编程魔法开始发挥作用的地方。函数式编程允许进行组合，这正是我们将要使用的，来组合流。一个流可以用作另一个流的输入。甚至多个流也可以作为多个其他流的输入。此外，你可以在代码的任何地方使用这些原始或转换后的流。这正是 Shiny 成为一个如此伟大工具的原因。

函数式反应编程提高了你代码的抽象级别，因此你可以专注于定义应用程序逻辑的事件之间的相互依赖性，而不是不断调整大量实现细节。函数式反应代码也可能更加简洁。

在高度交互的现代应用程序中，这种好处更为明显。如今的应用程序拥有大量的实时事件，这些事件能够提供高度交互的体验，而函数式反应编程是处理这种需求的绝佳工具。

在 Shiny 中如何处理功能反应性？

反应性是使你的 Shiny 应用程序响应的关键。看起来应用程序似乎在用户做出更改时立即更新自己。然而，实际上，Shiny 每隔几微秒就会以精心安排的方式重新运行你的 R 表达式，从而创造出响应性的错觉。你不需要了解反应性是如何发生的就可以使用它，但了解反应性会使你成为一个更好的 Shiny 程序员。

记得在我们之前章节中执行非常简单的 Shiny 应用程序时，R 控制台停止了交互吗？嗯，那是因为执行shinyApp()函数会让 R 忙碌，不断地监控和根据需要更新表达式，这就是为用户创建响应式体验的原因。

现在，想象一下你有一个复杂的应用程序，其中包含大量的交互性，那么每两微秒运行每一个表达式将会完全饱和你的处理器，并且你的用户将会有一个糟糕的用户体验。这就是为什么 Shiny 需要足够智能，只更新那些需要更新的表达式。每当用户提交一个动作（事件）时，处理此类事件的表达式会变得无效，实际上标记自己需要更新，并且这种行为会在所有依赖于它们的表达式之间传播。当过去了几微秒之后，R 会检查哪些表达式被标记为需要更新，并且只更新那些。

正如刚才描述的机制可以减少需要重新计算的表达式的数量，从数千个减少到零，如果没有用户动作，并且最多只有几个，因为用户在几微秒内完成很多事情是非常困难的，这反过来又会导致几个所需的更新，而不是每次都进行完整的应用程序更新。这种机制允许 R 处理复杂的 Shiny 应用程序，并且它是响应性的关键。它允许应用程序尽可能快地更新，使输入/输出协调几乎瞬间完成。

Shiny 中响应性的构建块

Shiny 中响应性的构建块围绕三种类型的函数构建：输入、输出和渲染函数。输入函数大多数情况下以Input字符串结尾（不总是），我将它们称为Input()函数。输出函数总是以Output字符串结尾，我将它们称为Output()函数。最后，渲染函数以render字符串开头，我将类似地称它们为render*()函数。

Input*()函数在ui对象中使用，并生成响应式值，这些值是通过网络浏览器与交互接收到的，并通过server函数中的input参数传递。render*()函数在server函数中使用，并利用响应式值生成可观察值，这些值通过server函数的output参数返回到ui对象。最后，*Output()函数在ui对象中使用，以在网页浏览器中显示这些可观察值的内容。

响应式值通过server()函数中的input参数接收，该参数是一个列表，其元素通过作为唯一标识符的字符串与ui对象相关联。server函数中的output参数也是一个列表，但它用于接收将被发送到网页浏览器的可观察对象。

知道如何处理响应式值的函数被称为响应式函数。并非每个 R 函数都是响应式函数，它们需要 Shiny 提供的特殊构建机制，如果你尝试在一个非响应式函数中使用响应式值，你会得到一个错误（这是开始使用 Shiny 时的一个常见错误）。render*()函数用于创建响应式函数。另一种方法是使用本章后面将要解释的reactive()函数。

响应式函数通常用于生成其他响应式函数或render*()函数可能使用的可观察对象。然而，响应式函数也可以产生副作用（例如，写入数据库）。如果响应式函数有return值，它们将被缓存，这样如果相应的响应式值没有改变，就不需要重新执行该函数。

输入、输出和渲染函数

每个*Input*()函数都需要几个参数。第一个是一个字符串，包含小部件的名称，这只会被你使用。第二个是一个标签，它将在你的应用程序中显示给用户。每个*Input*()函数的其余参数根据其功能而变化。它们包括初始值、范围和增量等。你可以在小部件函数的帮助页面上找到所需的小部件的确切参数（例如，? selectInput）。以下表格显示了所有可用的*Input*()函数及其用途的说明：

输入*Input*()函数	用途
actionButton()	操作按钮
checkboxGroupInput()	复选框组
checkboxInput()	单个复选框
dateInput()	日期选择
dateRangeInput()	日期范围选择
fileInput()	文件上传
helpText()	输入表单的帮助文本
numericInput()	数字输入字段
radioButtons()	单选按钮中的选项集
selectInput()	下拉菜单中的选项集
sliderInput()	数字输入滑动条
submitButton()	提交按钮
textInput()	文本输入字段

每个 *Output() 函数需要一个单一参数，这是一个字符字符串，Shiny 将使用它从 server 函数中的 output 参数识别相应的 observer。用户将看不到这个名称，它只供您使用。以下表格显示了所有可用的 *Output() 函数列表，以及它们的使用说明。您可以通过它们对应的使用帮助页面了解更多信息（例如，? tableOutput）：

*Output() 函数	用途
dataTableOutput()	数据表
htmlOutput()	原始 HTML
imageOutput()	图片
plotOutput()	图表
tableOutput()	表格
textOutput()	文本
uiOutput()	原始 HTML
verbatimTextOutput()	纯文本

最后，每个 render*() 函数接受一个单一参数，一个由大括号 {} 包围的 R 表达式。这些表达式可以包含一行简单的文本，也可以包含多行代码和函数调用。以下表格显示了所有 render*() 函数列表，以及它们的使用说明。正如你所猜到的，你可以通过它们对应的使用帮助页面了解更多信息（例如，? renderText）：

render*() 函数	用途
renderDataTable()	数据表
renderImage()	图片
renderPlot()	图
renderPrint()	任何打印输出
renderTable()	数据框、矩阵或其他类似表格的结构
renderText()	字符串
renderUI()	Shiny 标签对象或 HTML

Shiny 应用程序结合了 *Input()、*Output() 和 render*() 函数来生成强大的网络应用程序。最简单的应用程序将只由响应值和观察者组成，它们之间没有太多的逻辑。然而，我们也可以在它们之间放置尽可能多的表达式，这允许构建更复杂的应用程序。

在 Shiny 中处理响应性有许多方法。一个非常友好的介绍视频可以在 RStudio 的 Learn Shiny 视频教程中找到（shiny.rstudio.com/tutorial/）。

设计我们的高级应用程序结构

理论就到这里，让我们动手构建自己的应用程序。我们将构建的应用程序将利用前一章的内容，所以如果你还没有阅读那一章，请务必阅读。我们将构建的仪表板将更有意义，如果你已经阅读了。这个仪表板将显示来自前一章数据模拟的价格数据点图表以及我们开发的 SMA 计算。此外，它将允许我们使用动态表格来探索价格数据。这里的“动态”意味着它会对用户输入做出响应。

设置两列分布

你为应用程序选择使用的布局取决于其目标。在这种情况下，两列布局就足够了。为了实现这一点，我们使用fluidPage()函数并将其分配给ui对象。此函数根据网页浏览器的尺寸调整内容：

在fluidPage()内部，我们使用titlePanel()函数为我们的应用程序提供标题，并使用sidebarLayout()函数创建两列布局。这个最后的函数需要在其中调用另外两个函数来创建每个列的对应内容。这两个函数分别称为sidebarPanel()和mainPanel()，它们接收我们想要在它们内部创建的内容作为参数。左侧的列将用于显示用户可用的选项，右侧的列将显示用户输入的结果内容，因此我们使用一些字符串作为占位符，精确描述了这一点：

ui <- fluidPage(
    titlePanel("Cryptocurrency Markets"),
    sidebarLayout(
        sidebarPanel("Options"),
        mainPanel("Content")
    )
)

fluidPage简单地生成 HTML，并将其发送到网页浏览器。随着我们沿着本章的进展，你可以在 R 控制台中打印ui对象，以查看它创建的 HTML。

这段代码将创建一个非常基本的结构，就像下一张图片中所示的那样。随着我们的进展，我们将使应用程序越来越复杂，但我们需要从某个地方开始。

如你所见，在ui对象中嵌套函数调用将是一个常见模式来构建应用程序。这可能会很棘手，如果由于某种原因，你在某个地方遗漏了一个逗号（,），你可能会看到一个像下面这样的神秘信息。如果是这种情况，确保你的逗号放置正确是修复这个错误的好开始：

Error in tag("div", list(...)) : argument is missing, with no default
Calls: fluidPage ... tabsetPanel -> tabPanel -> div ->  -> tag

介绍带有面板的分区

为了显示一个用于图表的分区和一个用于数据表的单独分区，我们将使用tabsPanel()函数与tabPanel()函数结合。tabsPanel()函数接收并排列一个或多个tablePanel()函数调用，其中每个调用接收一个标签的名称及其实际内容：

ui <- fluidPage(
    titlePanel("Cryptocurrency Markets"),
    sidebarLayout(
        sidebarPanel("Options"),
        mainPanel(
            tabsetPanel(
                tabPanel("Simple Moving Averages", "Content 1"),
                tabPanel("Data Overview", "Content 2")
            )
        )
    )
)

由于我们创建了两个带有标题的标签页，分别是简单移动平均和数据概览，所以我们看到的就是这些标签页的名称。如果你现在自己运行这个应用程序，你可以点击它们，你会看到Content 1或Content 2字符串，具体取决于你点击的是哪一个：

注意，tabsetPanel()函数取代了我们之前在其位置上的"Content"字符串。这将成为一个常见模式。随着我们开始向应用程序中引入越来越多的元素，它们将替换之前的占位符。一旦你习惯了 Shiny，你可能完全避免创建占位符。

插入一个动态数据表

现在，我们将添加一个动态表格，其中包含我们在上一章中模拟的数据，因此首先，我们需要将那些数据带入应用程序，我们通过下面的行来实现。你应该将此数据加载行放在你的应用程序中的 ui 对象之上。这样，它只会在启动 Shiny 应用程序时运行一次，就像执行 R 脚本时通常会运行的任何代码一样：

ORIGINAL_DATA <- 
read.csv("../chapter-09/data.csv", stringsAsFactors = FALSE)

在这一点上，我们需要引入 DT 包。它为 Shiny 应用程序提供了一个创建动态表格的简单方法。由于我们将通过其包名引用它，所以我们不需要使用 library(DT) 来加载它。通过包名引用它有助于我们区分原生 Shiny 函数和来自外部包的函数。

要实现这一点，我们需要修改我们之前未曾触及的 server 函数。我们需要在其中引入一些逻辑，以便能够将数据从 R 移动到网页界面。为此，我们将它分配给其 output 参数中的 table 元素，该元素将充当观察者。我们分配给它的元素名称可以是任何我们希望的有效列表元素，但使用描述观察者内容的名称是个好主意。请记住，这些名称必须是唯一的，因为 Shiny 将使用它们来识别在 ui 对象和 server 函数之间传递和接收的对象。观察者是通过 DT 包中的 renderDataTable() 函数创建的。这个函数就像任何其他的 render*() 函数一样工作，它接收一个参数，该参数是一个返回值的表达式，该值将是观察者的内容。

在这种情况下，使用 DT 包中的 datatable() 函数创建的数据表。为了创建这个数据表，我们只是传递之前加载的 ORIGINAL_DATA 对象。现在服务器端调整完成后，我们在 ui 对象中添加一个 fluidRow() 而不是 "Content 2"，以引入一个根据网页浏览器尺寸调整其长度的行，并在其中调用 DT 包中的 dataTableOutput() 函数。请注意，作为此函数唯一参数发送的字符串是我们在 server 函数中分配给 output 参数的元素名称。这是 Shiny 用于从 server 向 ui 传递数据的机制：

ui <- fluidPage(
    titlePanel("Cryptocurrency Markets"),
    sidebarLayout(
        sidebarPanel("Options"),
        mainPanel(
            tabsetPanel(
                tabPanel("Simple Moving Averages", 
                          "Content 1"),
                tabPanel("Data Overview", 
                          fluidRow(DT::dataTableOutput("table"))                                    
                )
            )
        )
    )
)

server <- function(input, output) {
    output$table <- 
    DT::renderDataTable(DT::datatable({return(ORIGINAL_DATA)}))
}

现在我们代码已经准备好了，我们应该在“数据概览”标签页中看到一个表格出现。这个表格是动态的，这意味着你可以通过点击列标题来对列进行排序，以及更改显示的观测数，并搜索其内容。此外，请注意，自动为我们添加了分页机制和观测计数器。这些表格非常容易创建，但非常有用，我们将在本章后面看到如何进一步扩展它们的功能。

通过用户输入引入交互性

我们之前看到的与动态数据表交互的交互性是在网页浏览器本身内使用 JavaScript 实现的，它不需要通过server函数提供交互性，只需传递表格本身即可。然而，许多有趣的交互功能需要通过server来实现，这样我们就可以为它们提供定制的响应。在本节中，我们展示如何将各种类型的输入添加到我们的应用程序中。

设置静态用户输入

首先，我们将展示如何过滤数据中的时间戳，只显示用户定义范围内的观测值。为此，我们首先需要定义四个时间戳：最小值、初始左边界、初始右边界和最大值。这四个值将由我们的日期范围小部件用于定义用户允许的范围（最小值和最大值用于此目的），以及初始日期范围（初始左边界和右边界用于此），这些可能不同于允许范围的限制。

因此，我们需要提取这样的值，我们通过使用我们在第八章中创建的TimeStamp类来实现，该章节是面向对象的加密货币跟踪系统。请注意，我们使用lubridate包中的days()函数（你应在文件顶部添加library(lubridate)行），就像在提到的章节中做的那样。

由于我们只需要创建这些对象一次，因此它们应该位于用于加载ORIGINAL_DATA的代码下方，在ui对象定义之前：

DATE_MIN <- 
timestamp_to_date_string.TimeStamp(min(ORIGINAL_DATA$timestamp))

DATE_MAX <- 
timestamp_to_date_string.TimeStamp(max(ORIGINAL_DATA$timestamp))

DATE_END <- 
timestamp_to_date_string.TimeStamp(time_to_timestamp.TimeStamp(
    timestamp_to_time.TimeStamp(min(ORIGINAL_DATA$timestamp)) + days(2)))

TimeStamp类中的timestamp_to_date_string()函数尚未创建，我们为此章节添加了它。它非常简单，如下面的代码所示。其目的是简单地获取TimeStamp的前 10 个字符，这对应于格式 YYYY-MM-DD：

timestamp_to_date_string.TimeStamp <- function(timestamp) {
    return(substr(timestamp, 1, 10))
}

现在我们已经创建了这些对象，我们可以使用以下代码来扩展ui对象。我们所做的是将"Options"字符串替换为对dateRangeInput()函数的调用，该函数用于创建日期范围，正如其名称所暗示的。它接收作为参数的唯一标识符，该标识符将通过input参数在server中检索其反应值，用户看到的label，前面提到的start、end、min和max值，我们希望在网页浏览器输入框之间使用的separator，我们想要使用的日期format，以及一周中哪一天被认为是开始日（0代表星期日，1代表星期一，依此类推）：

ui <- fluidPage(
    titlePanel("Cryptocurrency Markets"),
    sidebarLayout(
        sidebarPanel(
            dateRangeInput(
                "date_range",
                label = paste("Date range:"),
                start = DATE_MIN,
                end = DATE_END,
                min = DATE_MIN,
                max = DATE_MAX,
                separator = " to ",
                format = "yyyy-mm-dd",
                weekstart = 1
            )
        ),
        mainPanel(
            tabsetPanel(
                tabPanel("Simple Moving Averages", 
                         "Content 1"),
                tabPanel("Data Overview", 
                         fluidRow(DT::dataTableOutput("table"))
                )
            )
        )
    )
)

在服务器端，我们将在传递给 datatable() 函数的 reactive expression 中添加更多逻辑。我们不会简单地发送原始的 ORIGINAL_DATA 数据框，而是在发送之前对其进行过滤。为此，我们首先将其副本分配给 data 对象，并从 ui 对象中创建的小部件中提取两个日期值，使用它们在 input 参数中的引用。然后，我们检查这些值中的任何一个是否与它们的初始值不同。如果它们不同，我们将只使用那些在指定范围内观察到的 data 对象更新，这是通过标准的 dataframe 选择来完成的。最后，我们将这个过滤后的 data 发送到 datatable() 函数，并继续我们之前所做的工作。

这些对 ui 和 server 的更改的结果是，我们现在可以过滤在数据概览选项卡中显示的动态表中的日期，这是我们之前无法做到的。以下截图显示了正在运行的日期范围小部件。尝试更改其日期，看看动态表是如何更新的：

在下拉列表中设置动态选项

现在，我们将看到如何添加一个下拉输入，其条目会根据用户当前查看的选项卡进行调整。具体来说，我们将添加用户可以选择他们想要用于过滤数据的资产的可能性。如果您仔细观察，您可能会注意到动态数据表包含比特币和莱特币的观察结果，当我们只是查看表格时这可能没问题，但当我们尝试显示价格时间序列时，将会有多个资产的数据，这将成为一个问题。我们希望提供一个机制来选择其中之一，但我们还想保留在动态数据表中一起查看所有选项的能力，就像我们现在所做的那样。

我们首先创建一个包含当前数据中独特资产名称的对象。这比直接将它们的名称硬编码到代码中要好得多，因为当我们的数据发生变化时，它们将自动更新，而如果我们硬编码它们，则不会是这样。这一行应该位于之前的 global 对象下方，这些对象只需要创建一次：

DATA_ASSETS <- unique(ORIGINAL_DATA$name)

由于在此情况下输入小部件具有动态逻辑，我们无法直接在ui对象内部创建它，我们需要在server函数中创建它，并将其传递给ui对象。这样做的方法是引入一个新的观察者到output参数中，命名为select_asset，它通过renderUI()函数创建，因为它将包含一个 Shiny *Input()函数。正如我们在上一节中对data所做的那样，我们将分配默认资产名称，只有在用户处于第二个标签页，即数据概览标签页的情况下（更多关于这个来源的信息见下文），它还会将All选项添加到下拉菜单中。否则，它将只保留资产名称，不包含All选项，这正是我们将在稍后创建的 SMA 图表所希望的：

server <- function(input, output) {
    output$table <- DT::renderDataTable(DT::datatable({
        data  <- ORIGINAL_DATA
        start <- input$date_range[1]
        end   <- input$date_range[2]
        if (time_to_date_string.TimeStamp(start) != DATE_MIN |
            time_to_date_string.TimeStamp(end) != DATE_END) {
            data <- data[
                data$timestamp >= time_to_timestamp.TimeStamp(start) &
                data$timestamp <= time_to_timestamp.TimeStamp(end), ]
        }
        return(data)
    }))

    output$select_asset <- renderUI({
        assets <- DATA_ASSETS
        if (input$tab_selected == 2) {
            assets <- c("All", assets)
        }
        return(selectInput("asset", "Asset:", assets))
    })
}

为了实际上提供一个机制，让server理解用户当前查看的是哪个标签页，ui对象需要调整，以便tabsetPanel()函数接收一个带有包含当前标签页编号的对象名称的id参数，在这个例子中是tab_selected（这是在server函数中用来检查的名称）。此外，每个标签页内部都必须使用value参数分配一个值，正如所示。这样我们确保数据概览标签页与2值相关联。

还请注意，我们在sidePanel()函数中刚刚引入的wellPanel()函数调用内添加了htmlOutput()函数调用。wellPanel()函数在视觉上将面板分组，为用户提供更直观的界面，而htmlOutput()函数使用观察者的名称来确定在网页浏览器中显示什么，在这个例子中是output对象的select_asset元素：

ui <- fluidPage(
    titlePanel("Cryptocurrency Markets"),
    sidebarLayout(
        sidebarPanel(
            wellPanel(
                dateRangeInput(
                    "date_range",
                    label = paste("Date range:"),
                    start = DATE_MIN,
                    end = DATE_END,
                    min = DATE_MIN,
                    max = DATE_MAX,
                    separator = " to ",
                    format = "yyyy-mm-dd",
                    weekstart = 1,
                    startview = "year"
                ),
                htmlOutput("select_asset")
            )
        ),
        mainPanel(
            tabsetPanel(
                id = "tab_selected",
                tabPanel(
                    "Simple Moving Averages",
                    value = 1,
                    "Content 1"
                ),
                tabPanel(
                    "Data Overview",
                    value = 2,
                    fluidRow(DT::dataTableOutput("table"))
                )
            )
        )
    )
)

完成这些更改后，我们可以看到，当用户处于简单移动平均（Simple Moving Average）标签页时，我们的应用程序显示了一个资产名称下拉菜单，其中包括Bitcoin和Litecoin选项，并且当他们在数据概览（Data Overview）标签页时，还包括了All选项，正如我们想要的，也如以下截图所示：

设置动态输入面板

我们将要引入的最后两个输入将用于稍后使用的 SMA 图表。第一个用于选择用户想要使用的 SMA 实现。选项包括我们在上一章中创建的sma_efficient_1()、sma_efficient_2()、sma_delegated_fortran()和sma_delegated_cpp()函数。第二个用于定义用于 SMA 计算的周期，并作为之前某个函数的输入。

由于代码可能会变得过于重复且占用太多空间，并且您很可能已经理解了在创建ui时使用的嵌套模式，我将避免重复完整的ui对象声明，而只是指出需要做出更改的地方。

在此情况下，我们想在 wellPanel() 函数结束后和 sidebarPanel() 函数结束前添加以下代码。以下代码将是 sidebarPanel() 的第二个参数，所以别忘了在 wellPanel() 函数完成后添加一个逗号（","），否则您将得到一个错误。

conditionalPanel() 函数检查一个使用字符串指定的 JavaScript 条件，以决定是否向用户显示面板。由于 input 对象通过一个方便命名为 input 的 JavaScript 对象发送到网页浏览器，我们可以使用它来获取我们想要的值，即用户是否正在查看第一个标签，“简单移动平均”。如果是的话，我们将显示面板：

JavaScript 使用点（"."）表示法来访问元素，而不是 R 中使用的 money ($) 表示法。

展示的面板是 wellPanel()，其中包含两个输入对象：radioButtons() 和 sliderInput()。第一个接收用户可用的选项列表，通过 choices 参数发送（每个元素的名称是显示给用户的，而每个元素的值在 R 中内部使用，在本例中是 SMA 实现名称），以及默认的 selected 选项。第二个接收数字滑块的 min、max 和默认 value。两者都接收唯一标识符和标签作为前两个参数，就像其他每个 *Input() 函数一样：

conditionalPanel(
    condition = "input.tab_selected == 1",
    wellPanel(
        radioButtons(
            "sma_implementation",
            "Implementation:",
            choices = list(
                "C++" = "sma_delegated_cpp",
                "Fortran" = "sma_delegated_fortran",
                "Efficient 1" = "sma_efficient_1",
                "Efficient 2" = "sma_efficient_2"
            ),
            selected = "sma_delegated_cpp"
        ),
        sliderInput(
            "sma_period",
            "Period:",
            min = 5,
            max = 200,
            value = 30
        )
    )
)

我们将把实际的图形创建留到以后，所以不需要在 server 端做任何改变。到目前为止，从 input$sma_implementation 和 input$sma_period 出来的 reactive values 不会被使用。以下是一个截图，展示了这些输入是如何显示的。如果您导航到“简单移动平均”标签，它们应该会显示，但如果您导航到“数据概览”标签，它们应该被隐藏：

如您所见，允许用户与应用程序交互并不太难，这是通过在 ui 对象中使用 *Input() 函数来实现的，其 reactive values 可以在 server 函数中使用。

添加包含共享数据的摘要表

现在我们将在我们的动态数据表顶部添加一个摘要表。这个摘要表应该根据所选资产更新（注意复数形式，因为我们允许在此标签中包含“所有”情况）。花点时间想想您会如何自己实现这个功能？如果您试图复制我们之前展示的 data 对象的模式，您将得到一个正确但效率不高的解决方案。原因是过滤数据的逻辑会被重复，这是不必要的。

为了避免这个陷阱，我们接下来将展示如何使用reactive()函数在不同反应函数之间共享流，reactive()函数是一个用于为其他反应函数准备反应值的函数。在这种情况下，我们将之前创建的所有逻辑移动到作为参数发送给这个函数的表达式中，并将其分配给data对象，现在它本身就是一个反应函数。请注意，我们还添加了一些代码来检查当前资产选择是否不同于All，如果是，则使用该值来过滤数据，类似于我们使用日期过滤数据的方式。

一旦我们完成了这个操作，我们可以用对data()反应函数的简单调用替换datatable()函数内部的逻辑，这个反应函数将提供预期的数据框。现在我们已经提取了这部分逻辑，我们可以在使用renderTable()函数创建的output$summary_table观察者中重用data()调用。正如你所见，它传递了一个使用data()函数返回的数据框的统计数据创建的数据框。在这种情况下，我们可以保证在output$table()和output$summary_table()函数中使用的数据是相同的：

server <- function(input, output) {

    data <- reactive({
        data  <- ORIGINAL_DATA
        start <- input$date_range[1]
        end   <- input$date_range[2]
        if (input$asset != "All") {
            data <- data[data$name == input$asset, ]
        }
        if (time_to_date_string.TimeStamp(start) != DATE_MIN |
            time_to_date_string.TimeStamp(end) != DATE_MAX) {
            data <- data[
                data$timestamp >= time_to_timestamp.TimeStamp(start) &
                data$timestamp <= time_to_timestamp.TimeStamp(end), ]
        }
        return(data)
    })

    output$table <- DT::renderDataTable(DT::datatable({return(data())}))

    output$select_asset <- renderUI({
        assets <- DATA_ASSETS
        if (input$tab_selected == 2) {
            assets <- c("All", assets)
        }
        return(selectInput("asset", "Asset:", assets))
    })

    output$summary_table <- renderTable(data.frame(
        Minimum = min(data()$price_usd),
        Median = mean(data()$price_usd),
        Mean = mean(data()$price_usd),
        Max = max(data()$price_usd)
    ))
}

如果你在使用随机数据（例如，随机数）且没有使用reactive()函数而是复制数据逻辑，请务必小心，因为你可能无法在这两个地方得到相同的数据。

我们还需要在ui对象中引入相应的函数调用，我们将它放在相应的tabPanel()中。为了将我们刚刚创建的数据框放入其中，我们使用带有相应summary_table字符串参数的tableOutput()函数。代码如下（注意，我省略了这段代码周围的ui代码）：

tabPanel(
    "Data Overview",
    value = 2,
    fluidRow(tableOutput("summary_table")),
    fluidRow(DT::dataTableOutput("table"))
)

实施这些更改后，你应该会看到一个包含所提统计数据的摘要表，位于动态数据表顶部，并且当作为日期和资产选择的输入发送不同值时，它们应该会更新。

添加简单移动平均图表

现在我们将创建我们的第一个简单移动平均（SMA）图表。这个图表将通过package创建，并显示两条线。黑色线将是实际的价格数据，蓝色线将是 SMA。

在我们开始之前，由于使用日期的ggplot2图表比使用时间戳字符串创建得更好，我们在ORIGINAL_DATA数据框中添加了相应的日期的time列。这应该放在加载数据后立即进行：

ORIGINAL_DATA$time <- timestamp_to_time.TimeStamp(ORIGINAL_DATA$timestamp)

接下来，我们展示如何实现我们的 sma_graph() 函数。如所见，它将接收两个参数，即 data 数据框和从前述 SMA 实现中出来的 sma 向量。该函数非常简单，它创建一个以 time 为 x 轴和 price_usd 为 y 轴的图，为这些数据添加点和线，然后添加一个来自 sma 向量的第二个蓝色线。group = 1 参数用于避免任何错误，告诉 ggplot() 函数该数据中只有一个组，而 size = 1 参数只是为了使线条更加突出。

注意，我们返回的是图对象。最后，你应该记住，使用 geom_line() 函数将插值引入到示例中，这可能会错误地表示我们为价格所拥有的离散数据，但它也有助于理解价格动态，这就是我们使用它的原因：

sma_graph <- function(data, sma) {
    g <- ggplot(data, aes(time, price_usd))
    g <- g + geom_point()
    g <- g + geom_line(group = 1)
    g <- g + geom_line(aes_string(y = sma),
                       group = 1, color = "blue", size = 1)
    return(g)
}

现在，为了遵循良好的实践，我们将 SMA 计算放在一个自己的 reactive() 函数中（就在我们之前创建的 data reactive function 下方）。请注意，这是一个依赖于另一个 reactive function 的 reactive function，即 data() 函数。

以下代码（省略了 server 函数的其余部分）显示，这个 sma 定义使用了 do.call() 函数来执行我们从 input$sma_implementation 小部件接收到的作为 reactive value 的实现名称。do.call() 还接收一个列表作为第二个参数，这个列表包含将发送到我们想要调用的实际函数的参数。在这种情况下，它是 input$sma_period，symbol（在这种情况下将是一个单一值，因为我们限制了这个标签页的数据只有一个资产），以及通过调用 data() reactive function 的实际数据：

sma <- reactive({
    return(do.call(
        input$sma_implementation,
        list(input$sma_period, data()[1, "symbol"], data())
    ))
})

在实现了这个 sma() reactive function 之后，我们可以按照以下方式实现观察者 output$graph_top()（再次省略了一些代码）：

output$graph_top <- renderPlot({
    return(sma_graph(data(), sma()))
})

最后，我们需要更新我们的 ui 对象，用 fluidRow() 和 ploutOutput() 替换 "Content 1" 占位符。我们发送 "graph_top" 唯一标识符到我们感兴趣的观察者：

fluidRow(plotOutput("graph_top"))

这很简单，不是吗？现在我们可以运行我们的应用程序，它应该显示数据的前两天，上面有一个蓝色 SMA(30) 如下截图所示：

注意，你可以更改选项，并且图表将相应更新。例如，如果我们只选择了数据中的第一天，并决定在上面绘制 SMA(5)。

最后，如果你的电脑可以处理，你可能会决定显示完整的数据（这有很多观察值，所以请小心）。在这种情况下，SMA 将不可见，但它仍然会被绘制出来。结果如图所示：

通过添加一个二级缩放图来增加交互性

最后，我们将通过实现另一个类似的图表来为我们的图形添加一些交互性，该图表将对之前创建的图表产生放大效果。想法是，我们可以选择图形中我们刚刚创建的区域，下面放置的图形将只显示我们选择的特定区域。这听起来很有趣，不是吗？

为了完成这个任务，我们需要修改之前章节末尾插入的plotOutput()，以包括一个带有对brushOpts()函数调用的brush参数，该函数接收我们创建的刷输入的唯一标识符。此参数用于创建一种特殊类型的输入，它从在网页浏览器中显示的图形中检索所选区域。我们还添加了另一个fluidRow()，其中包含另一个plotOutput()，位于其下方以包含将提供放大效果的图形。代码如下：

tabPanel(
    "Simple Moving Averages",
    value = 1,
    fluidRow(plotOutput("graph_top", brush = brushOpts("graph_brush"))),
    fluidRow(plotOutput("graph_bottom"))
)

现在，input$graph_brush反应值将包含一个包含四个元素的列表xmin、xmax、ymin和ymax，这些坐标构成了顶部图形中选定的区域。我们的ranges()反应函数将使用它们将适当的值作为限制发送到底部图形。它的工作方式是检查input$graph_brush是否为NULL，如果不是，意味着已选择一个区域，那么它将返回一个包含两个元素的列表，x和y，其中每个元素都包含适当的坐标。如果input$graph_brush是NULL，那么返回列表的x和y元素将是NULL，这会向我们将要用于sma_graph()顶部的coord_cartesian()函数发出信号，以避免在轴上放置任何约束。实际函数如下所示，并且与其他使用reactive()创建的函数一样，它应该放在server函数内部。

还要注意，我们需要对x轴的值进行一些小的转换，因为它们作为整数返回，而不是ggplot()用于该轴的对象类型——日期。我们简单地使用as.POSIXct()函数将这样的整数转换为有效的日期，使用oring = "1970-01-01"，这是ggplot()默认使用的。如果我们不进行转换，我们将得到一个错误：

ranges <- reactive({
    if (!is.null(input$graph_brush)) {
        return(list(
            x = c(as.POSIXct(input$graph_brush$xmin, 
                             origin = "1970-01-01"),
                  as.POSIXct(input$graph_brush$xmax, 
                             origin = "1970-01-01")),

            y = c(input$graph_brush$ymin, 
                  input$graph_brush$ymax)
        ))
    }
    return(list(x = NULL, y = NULL))
})

现在，我们能够创建output$bottom_graph观察者，就像我们创建之前的图表一样，但在这个情况下，我们将在sma_graph()返回的图形对象上添加coord_cartesian()函数来限制轴的值。请注意，我们使用expand = FALSE来强制使用ranges()反应函数提供的限制，这是我们之前代码中刚刚创建的：

output$graph_bottom <- renderPlot({
    return(sma_graph(data(), sma()) +
           coord_cartesian(xlim = ranges()$x,
                           ylim = ranges()$y, expand = FALSE))
})

实施了这些更改后，我们应该会得到期望的效果。为了测试它，我们可以打开应用程序，查看两个重叠的相同图表，如下面的截图所示：

然而，如果我们选择顶部图表上的某个区域，那么底部图表应该更新，只显示该特定部分的图表。这很酷，不是吗？

最后，您应该知道，引入交互式图形的另一种方法是使用众所周知的 JavaScript，如Plot.ly（我们在第五章[part0110.html#38STS0-f494c932c729429fb734ce52cafce730]，通过可视化沟通销售中使用过）。Shiny 创建的网站在后台使用 JavaScript，因此这种技术是一个自然的选择。然而，这是一个高级技术，其使用比我们在这里展示的要复杂得多，所以我们不会展示它，但您应该知道这是可能的，以防您想自己尝试。

使用主题美化我们的应用

到目前为止，我们一直在使用 Shiny 默认提供的主题，但现在我们的应用已经完成，我们希望用一些看起来像科技感的颜色来美化它。在这种情况下，我们可以使用shinythemes和ggthemr包，它们为我们提供了将主题应用于 Shiny 应用和ggplot2图表的简单方法。

我们要应用主题所做的全部事情就是告诉ggplot2框架应用由ggthemr包提供的扁平暗色主题，并且为了确保图表的外部部分也被美化，我们使用type = outer参数，如下所示。代码应该放在我们放置ggplot2代码的地方，以确保连贯性，对于本章来说是在functions.R文件中：

library(ggthemr)
ggthemr('flat dark', type = 'outer')

要美化 Shiny 应用本身，我们通过shinytheme()函数将theme参数发送到fluidPage()函数，就在调用titlePanel()函数之前，如下所示：

ui <- fluidPage(
    theme = shinytheme("superhero"),
    titlePanel("Cryptocurrency Markets"),
    ...
)

我们还将图表中的 SMA 线改为白色，这个操作您已经知道如何做了，并且通过这些改动，现在我们的应用看起来相当高科技。以下展示了简单移动平均（Simple Moving Average）标签页：

这里您可以看到数据概览标签页的截图：

要查找其他主题，您可以查看shinythemes仓库（[rstudio.github.io/shinythemes/](http://rstudio.github.io/shinythemes/））和ggthemr仓库（https://github.com/cttobin/ggthemr）。为了确保读者能够立即意识到完整的代码是什么样的，我在这里也放置了应用的完整代码以及用于图表的函数：

library(shiny)
library(ggplot2)
library(lubridate)
library(shinythemes)

source("../chapter-08/cryptocurrencies/utilities/time-stamp.R")
source("../chapter-09/sma-delegated.R", chdir = TRUE)
source("../chapter-09/sma-efficient.R")
source("./functions.R")

ORIGINAL_DATA <- 
read.csv("../chapter-09/data.csv", stringsAsFactors = FALSE)

ORIGINAL_DATA$time <- 
timestamp_to_time.TimeStamp(ORIGINAL_DATA$timestamp)

DATA_ASSETS <- unique(ORIGINAL_DATA$name)

DATE_MIN <- 
timestamp_to_date_string.TimeStamp(min(ORIGINAL_DATA$timestamp))

DATE_MAX <- 
timestamp_to_date_string.TimeStamp(max(ORIGINAL_DATA$timestamp))

DATE_END <- 
timestamp_to_date_string.TimeStamp(time_to_timestamp.TimeStamp(
    timestamp_to_time.TimeStamp(min(ORIGINAL_DATA$timestamp)) + days(2)))

ui <- fluidPage(
    theme = shinytheme("superhero"),
    titlePanel("Cryptocurrency Markets"),
    sidebarLayout(
        sidebarPanel(
            "Options",
            wellPanel(
                dateRangeInput(
                    "date_range",
                    label = paste("Date range:"),
                    start = DATE_MIN,
                    end = DATE_END,
                    min = DATE_MIN,
                    max = DATE_MAX,
                    separator = " to ",
                    format = "yyyy-mm-dd",
                    weekstart = 1,
                    startview = "year"
                ),
                htmlOutput("select_asset")
            ),
            conditionalPanel(
                condition = "input.tab_selected == 1",
                wellPanel(
                    radioButtons(
                        "sma_implementation",
                        "Implementation:",
                        choices = list(
                            "C++" = "sma_delegated_cpp",
                            "Fortran" = "sma_delegated_fortran",
                            "Efficient 1" = "sma_efficient_1",
                            "Efficient 2" = "sma_efficient_2"
                        ),
                        selected = "sma_delegated_cpp"
                    ),
                    sliderInput(
                        "sma_period",
                        "Period:",
                        min = 5,
                        max = 200,
                        value = 30
                    )
                )
            )
        ),
        mainPanel(
            tabsetPanel(
                id = "tab_selected",
                tabPanel(
                    "Simple Moving Averages",
                    value = 1,
                    fluidRow(plotOutput("graph_top", 
                                         brush = brushOpts(
                                         "graph_brush"))),
                    fluidRow(plotOutput("graph_bottom"))
                ),
                tabPanel(
                    "Data Overview",
                    value = 2,
                    fluidRow(tableOutput("summary_table")),
                    fluidRow(DT::dataTableOutput("table"))
                )
            )
        )
    )
)

server <- function(input, output) {

    data <- reactive({
        data <- ORIGINAL_DATA
        start <- input$date_range[1]
        end <- input$date_range[2]
        if (input$asset != "All") {
            data <- data[data$name == input$asset, ]
        }
        if (time_to_date_string.TimeStamp(start) != DATE_MIN |
            time_to_date_string.TimeStamp(end) != DATE_MAX) {
            data <- data[
                data$timestamp >= time_to_timestamp.TimeStamp(start) &
                data$timestamp <= time_to_timestamp.TimeStamp(end), ]
        }
        return(data)
    })

    sma <- reactive({
        return(do.call(
            input$sma_implementation,
            list(input$sma_period, data()[1, "symbol"], data())
        ))
    })

    ranges <- reactive({
        if (!is.null(input$graph_brush)) {
            return(list(
                x = c(as.POSIXct(input$graph_brush$xmin, 
                                 origin = "1970-01-01"),
                      as.POSIXct(input$graph_brush$xmax, 
                                 origin = "1970-01-01")),
                y = c(input$graph_brush$ymin, 
                      input$graph_brush$ymax)
            ))
        }
        return(list(x = NULL, y = NULL))
    })

    output$table <- DT::renderDataTable(DT::datatable({
        return(data())
    }), style = "bootstrap")

    output$select_asset <- renderUI({
        assets <- DATA_ASSETS
        if (input$tab_selected == 2) {
            assets <- c("All", assets)
        }
        return(selectInput("asset", "Asset:", assets))
    })

    output$summary_table <- renderTable(data.frame(
        Minimum = min(data()$price_usd),
        Median = mean(data()$price_usd),
        Mean = mean(data()$price_usd),
        Max = max(data()$price_usd)
    ))

    output$graph_top <- renderPlot({
        return(sma_graph(data(), sma()))
    })

    output$graph_bottom <- renderPlot({
        return(sma_graph(data(), sma()) +
               coord_cartesian(xlim = ranges()$x,
                               ylim = ranges()$y, expand = FALSE))
    })
}

shinyApp(ui, server, options = list(port = 6924))

其他感兴趣的话题

当使用 Shiny 时，有一些常见的任务可以用来自定义您的 Web 应用。其中一些任务包括添加静态图片、HTML 和 CSS。在接下来的章节中，我们将简要介绍如何使用 Shiny 实现这些功能。最后，我们还将提到一些选项，您可以使用这些选项与他人共享您的应用，而无需设置自己的 Web 服务器，这样他们就可以通过互联网连接在他们的 Web 浏览器中使用它。

添加静态图片

图片可以增强你应用程序的外观，并帮助用户理解内容。Shiny 会查找img()函数来在你的应用程序中放置图片文件。要插入图片，只需使用src指定图片的位置。你还可以包含其他 HTML 友好参数，如高度和宽度（它们将以像素值传递）：

img(src = "image.png", height = 250, width = 250)

image.png文件必须在与app.R脚本相同的目录中名为www的文件夹内。Shiny 会将这里放置的任何文件与用户的网络浏览器共享，这使得www成为放置图片、样式表和其他浏览器需要构建你的 Shiny 应用程序 Web 组件的绝佳位置。

在你的 Web 应用程序中添加 HTML

使用 HTML 标签很容易将 HTML 元素添加到你的 Shiny 应用程序中。你可以使用诸如tags$h1()或tags$p()之类的语法添加许多元素到你的页面中，分别用于一级标题和段落。在下面的代码片段中，你可以看到这些是如何被用来创建一个包含一个一级标题、随后是一个段落、一个二级标题，然后是另一个段落的页面的。

HTML 标签的完整列表可以在 Shiny HTML 标签术语表（shiny.rstudio.com/articles/tag-glossary.html）中找到：

ui <- fluidPage(
    tag$h1("This is a first level heading"),
    tag$p("This is a paragraph.)
    tag$h2("This is a second level heading"),
    tag$p("This is a another paragraph.)
)

然而，有时你可能需要对你想要使用的 HTML 有更多的控制。在这种情况下，你可以通过使用HTML()函数直接在你的应用程序中指定 HTML。在这种情况下，Shiny 不会为你执行任何转义，你将拥有完整的 HTML 功能，你只需传递如这里所示的原生 HTML 即可。请注意，这个原生 HTML 可以包含在其他标签中，就像这里一样，它被divHTML 标签包裹：

tags$div(
    HTML("Raw HTML")
)

添加自定义 CSS 样式

Shiny 使用 Bootstrap 框架进行结构和样式设计。如果你是 CSS 层叠样式表（CSS）的新手或者不熟悉 Bootstrap，在尝试应用自己的样式之前，阅读入门指南（getbootstrap.com/docs/3.3/getting-started/)是个不错的选择。

要包含你自己的 CSS，你有几个选择，但我们只会展示如何使用includeCSS()函数以及如何直接将样式应用到 HTML 标签中。includeCSS()函数由 Shiny 提供，可以用来直接从上一节中提到的www目录包含 CSS 文件。其用法相当简单。

尽管通常这不是一个好主意，因为很难找到你的样式，而且保持一致性更难，但有时直接将样式应用到 HTML 标签中是有用的。如果你想这样做，你可以向特定标签发送一个style参数。

假设你有一个名为style.css的文件位于www目录中，它提供了你想要的所有样式，除了你想要应用到一级标题上的绿色颜色。然后，你可以使用以下代码，它包含了这两种技术：

ui <- fluidPage(
    includeCSS("style.css"),
    h1(style = "color: blue;", "A blue heading"),
)
server <- function(input, output) { }
shinyApp(ui, server)

分享你新创建的应用程序

尽管 Shiny 应用程序最终以 HTML 文件的形式呈现，但你不能简单地将其复制到你的服务器上。它们需要一个 Shiny 服务器，就像我们在本章中一直在使用的那样。运行 Shiny 应用程序（就像其他任何应用程序一样）有两种方式：本地或远程。本地意味着你需要启动一个带有 Shiny 和所需依赖项的 R 安装程序，并像我们在本章中做的那样运行它。远程意味着你可以通过一个网站访问它，这在某些时候可能会非常酷和方便。

要本地运行，你需要将应用程序的文件放在将要执行它们的计算机上。有许多方法可以做到这一点，但最常见的一种是将它们上传到 Git 仓库，从那里下载，然后遵循你已知的步骤。此外，如果你的文件存储在 GitHub（www.github.com）上托管的 Git 仓库中，你可以使用带有存储库名称和拥有存储库的账户用户名的runGitHub()函数。在这种情况下，下载、解包和执行将由你完成。例如，要运行本章中开发的应用程序，你可以使用以下行：

runGitHub("", "")

如果你想要提供对应用程序的远程访问，你有许多选择，但主要的有三个：ShinyApps、RStudio Connect 和 Shiny Server。ShinyApps (www.shinyapps.io)为小型应用程序提供免费服务，访问量有限，并且可以通过付费版本进行扩展。RStudio Connect (www.rstudio.com/products/connect/)是一个 Shiny 应用程序和 R Markdown 报告的发布平台。使用它，你可以直接从 RStudio 发布。最后，Shiny Server (www.rstudio.com/products/shiny/shiny-server/)是本章中使用的 Shiny 服务器的开源版本，额外的好处是你可以在你控制的 Linux 服务器上运行它（当然，这包括云服务提供商的服务器）。与开源版本相比，RStudio 还出售 Shiny Server Pro 的年度订阅，它提供了安全、管理和其他增强功能。

摘要

正如我们在本章中看到的那样，使用函数式响应式编程范式通过 Shiny 创建强大的 Web 应用程序并不一定困难。这只需要良好的概念理解和一点探索。

我们展示了如何为用户提供输入，使他们能够向后端发送反应性值，即向服务器发送，并使其能够适当地响应这些事件流。我们还展示了如何添加更复杂的交互，例如带有缩放效果的两个图表。

这是本书的最后一章，您看到了如何使用 Shiny 提供的许多工具来创建交互式应用程序。然而，我们只是触及了 Shiny 和 R 在一般情况下的可能性的一小部分。希望您能将本书中学到的知识应用到创建令人惊叹的应用程序中。感谢您走到这一步！祝您好运！

第十一章：必需的包

在本附录中，我将向您展示如何安装复制本书中示例所需的软件。我将向您展示如何在 Linux 和 macOS 上这样做，特别是 Ubuntu 17.10 和 High Sierra。如果您使用 Windows，则适用相同的原理，但具体细节可能略有不同。然而，我相信在任何情况下都不会太难。

执行本书中所有代码需要两种类型的要求：外部和内部。R 语言之外的应用软件，我称之为外部要求。R 语言内部的应用软件，即 R 包，我称之为内部要求。我将向您介绍这两种要求的安装过程。

外部要求 - R 语言之外的应用软件

本书代码复现所需的某些 R 包有外部依赖项，这些依赖项可以是安装或执行依赖项。我们将在以下章节中介绍每个外部依赖项的安装。安装外部依赖项并不困难，但它可能是一个需要我们在 R 之外做一些工作的不熟悉的过程。一旦我们成功安装了这些外部依赖项，安装 R 包应该会变得容易。

在我们继续之前，我想说的是，在尝试安装 R 包之前，您并不总是事先知道需要哪些外部依赖项。通常，您只需尝试安装包，看看会发生什么。如果没有出现任何问题，那么您就准备好了。如果出现问题，控制台输出的信息将提示您下一步需要做什么。大多数时候，快速在线搜索错误或查看包的文档就足够了解如何继续。随着您经验的增加，您将能够快速诊断并解决任何问题。

下表显示了我们需要安装的外部软件，以及它在哪些章节中使用，为什么使用它，以及您可以从哪里获取它的 URL。下表中提供的 Fortran 和 C++编译器的 URL 适用于 macOS。在 Linux 的情况下，我没有提供任何，因为我们将通过终端通过包管理器安装它们，您不需要导航到外部网站下载它们的安装程序。最后，所有这些软件都是免费的，您应该安装最新版本。R 包运行所需的外部软件如下表所示：

软件	章节	原因	下载 URL
MySQL 社区服务器	4	提供 MySQL 数据库	dev.mysql.com/downloads/mysql/
GDAL 系统	5	Linux 中的 3D 图形	www.gdal.org/index.html
XQuartz 系统	5	macOS 中的 3D 图形	www.xquartz.org/
Fortran 编译器	9	编译 Fortran	gcc.gnu.org/wiki/GFortranBinaries
C++ 编译器	9	编译 C++	developer.apple.com/xcode/

根据您的配置，您执行的某些终端命令（在 Linux 和 macOS 上）可能需要在前面加上 sudo 字符串，以便它们实际上可以修改您的系统。您可以在维基百科上关于 sudo 命令的文章中找到更多信息（en.wikipedia.org/wiki/Sudo），以及您操作系统的文档中。

RMySQL R 包的依赖项

第四章，模拟销售数据和与数据库协同工作，依赖于 MySQL 数据库。这意味着即使系统中没有 MySQL 数据库，RMySQL R 包也可以正常安装，但当 R 使用它来与 MySQL 数据库接口时，您必须有一个可用的且配置适当的数据库正在运行，否则您将遇到错误。

现在，我将向您展示如何在 Ubuntu 17.10 和 macOS High Sierra 中安装 MySQL 社区数据库。在安装过程中，您可能会被要求输入可选的用户名和密码，如果是这样，您应该抓住这个机会并实际指定这些值，而不是留空，因为我们将在 R 中需要实际值。如果您这样做，您可以跳过以下关于设置用户名/密码组合的部分。

Ubuntu 17.10

在 Ubuntu 中安装 MySQL 非常简单。你只需更新你的包管理器并安装 mysql-server 包，如下所示：

$ apt-get update
$ apt-get install mysql-server 

数据库应该会自动为您执行，您可以通过查看下一节标题为 Both 的内容来验证。如果不是这样，您可以使用以下命令来启动数据库：

$ sudo service mysql start 

查阅 Rackspace 的帖子 在 Ubuntu 上安装 MySQL 服务器 (support.rackspace.com/how-to/installing-mysql-server-on-ubuntu/) 以获取更详细的说明。

macOS High Sierra

您需要做的第一件事是安装 Xcode (developer.apple.com/xcode/)。为此，您需要在您的计算机上打开 App Store，搜索 Xcode 并安装它。如果您有任何与 macOS 相关的开发工作，您很可能已经安装了它，因为它是大多数 macOS 下开发的基本依赖项。

接下来，我建议您使用出色的 Homebrew 软件包管理器 (brew.sh/)）。它是您在 Ubuntu 中可以获得的与 apt-get 类似工具的近似物。要安装它，您需要在您的终端中执行以下行。请注意，命令中的实际 URL 可能会更改，并且您应该确保它与 Homebrew 网站上显示的相匹配。

以下命令使用 "\" 符号进行了分割。如果您想将其作为单行使用，您可以删除这样的符号并将两行合并为一行。

让我们看看以下命令：

$ /usr/bin/ruby -e "$(curl -fsSL \
 https://raw.githubusercontent.com/Homebrew/install/master/install)"

一旦您安装了 Xcode 和 Homebrew，然后您只需在您的终端中执行以下行即可安装 MySQL，并且您应该已经设置好了：

$ brew install mysql

如果您以这种方式安装 MySQL 时遇到任何问题，您可以尝试更手动的方法，通过访问 MySQL 社区下载页面(dev.mysql.com/downloads/mysql/)，下载适当的 DMG 文件，并将其作为任何其他 macOS 应用程序安装。

在 Linux 和 macOS 上设置用户/密码

一旦您在计算机上安装了 MySQL 数据库，您需要确保您可以使用明确的用户/密码组合访问它。如果您已经设置了它们，您应该能够像前面所示那样访问数据库。

<YOUR_PASSWORD>值显示在第二行，并且没有命令提示符($)，因为它不应该包含在第一行中，您应该等待 MySQL 请求它，这通常是在执行第一行之后，这是一个不可见的提示，意味着您不会看到您正在输入的内容（出于安全原因）：

$ mysql -u <YOU_USER> -p
<YOUR_PASSWORD>

如果您看到类似前面的信息，并且得到类似mysql>的命令提示符，那么您已经设置好了，当您从 R 中连接到数据库时应该使用该用户/密码组合：

$ mysql

Welcome to the MySQL monitor. Commands end with ; or \g.
Your MySQL connection id is 15
Server version: 5.7.20-0ubuntu0.17.10.1 (Ubuntu)

Copyright (c) 2000, 2017, Oracle and/or its affiliates. All rights reserved.

Oracle is a registered trademark of Oracle Corporation and/or its
affiliates. Other names may be trademarks of their respective
owners.

Type 'help;' or '\h' for help. Type '\c' to clear the current input statement.

mysql>

如果您无法连接，或者您没有明确的用户/密码组合，那么我们需要创建一个。为此，您需要弄清楚如何登录到您的 MySQL 服务器，这取决于安装数据库时使用的配置（即使是类似操作系统也可能不同）。您很可能会通过在终端中执行以下命令来访问它：

$ mysql

一旦您进入 MySQL 命令提示符，您应该执行以下行来为您的本地安装创建用户/密码组合。完成此操作后，您应该已经设置好了，并且您应该能够使用之前显示的用户/密码组合明确登录：

mysql> CREATE USER ''@'localhost' IDENTIFIED BY '';
mysql> GRANT ALL ON *.* TO ''@'localhost'; 

最后，为了明确起见，当您在相应章节中看到以下代码时，您需要使用在这里创建的相同的用户/密码替换<YOUR_USER>和<YOUR_PASSWORD>占位符：

db <- dbConnect(
    MySQL(),
    user = <YOU_USER>,
    password = <YOUR_PASSWORD>,
    host = "localhost"
)

rgl 和 rgdal R 包的依赖项

第五章，通过可视化进行销售沟通，使用了rgl和rgdal包来创建 3D 和地理数据图表。这两个包是我们将在本书中看到的具有最复杂外部依赖的包，因此我们将提供不同的安装方法，以防其中一个对您不起作用。

我们需要在 Ubuntu 或 macOS 的 Xquartz 中安装 GDAL（地理空间数据抽象库）系统库 (www.gdal.org/) 以及地理空间和 X11 (www.x.org/wiki/) 以创建具有动态内容的窗口。

在 Windows 的情况下，您不需要像 X11 或 Xquartz 这样的外部工具，因为 Windows 本地处理必要的窗口。

Ubuntu 17.10

要安装 GDAL 和 X11，我们需要在 Ubuntu 中安装各种系统库。最简单的方法是使用以下行。如果您没有遇到问题，那么您应该已经设置好了：

$ apt-get update
$ apt-get install r-cran-rgl 

如果使用之前的行导致错误或无法正常工作，您可以尝试使用以下行以更明确的方式安装 GDAL。最后两行可以合并为一句，如果需要，它们被拆分是因为空间限制：

# apt-get update
$ apt-get install mesa-common-dev libglu1-mesa-dev libgdal1-dev
$ apt-get install libx11-dev libudunits2-dev libproj-dev 

如果您在使用之前的命令时遇到某种错误，您可以尝试添加 ubuntugis 仓库信息，更新您的包管理器，然后重试之前的代码：

$ add-apt-repository ppa:ubuntugis/ubuntugis-unstable
$ apt-get update

macOS High Sierra

在 macOS 中安装 GDAL，您可以使用我们之前提到的 Homebrew 包安装。当然，此时您也可以在您的电脑上安装 Xcode：

$ brew install proj geos udunits
$ brew install gdal2 --with-armadillo --with-complete --with-libkml --with-unsupported 

最后，我们需要安装 Xquartz 系统（类似于 Ubuntu 的 X11）。为此，请访问 Xquartz 网站 (www.xquartz.org/)，下载适当的 DMG 文件，并像安装任何其他 macOS 应用程序一样安装它。

Rcpp 包和 .Fortran() 函数的依赖项

第九章，实现高效简单移动平均，展示了如何将代码委托给 Fortran 和 C++ 以提高速度。这些语言都有自己的编译器，必须使用它们来编译相应的代码，以便 R 可以使用。如何在章节中编译此类代码。在这里，我们将展示如何安装编译器。

C++ 代码的编译器称为 gcc，Fortran 的编译器称为 gfortran。您可能已经在电脑上安装了它们，因为它们是 R 的依赖项，但如果没有，安装它们也很容易。

Ubuntu 17.10

在 Ubuntu 中安装这两个编译器，只需在您的终端中执行以下行：

$ apt-get update
$ apt-get install gcc ggfortran 

macOS High Sierra

在 macOS 中安装 C++ 编译器，只需安装 Xcode (developer.apple.com/xcode/)。正如我们之前提到的，它可以通过您电脑中应有的 App Store 应用程序安装。

要安装 Fortran 编译器，您可以使用前面所示 Homebrew 包管理器。但是，如果由于某种原因它不起作用，您也可以尝试使用 GNU 网站上找到的二进制文件 (gcc.gnu.org/wiki/GFortranBinaries)：

$ brew install gfortran

内部要求 - R 包

R 包 是一组相关的函数、帮助文件和数据文件，它们被捆绑在一起。在撰写本文时，综合 R 档案网络（CRAN）(cran.r-project.org/)提供了超过 12,000 个 R 包。当使用 R 时，这是一个巨大的优势，因为您不必重新发明轮子来利用可能实现您所需功能的非常高质量的包，如果没有这样的包，您还可以贡献自己的包！

即使 CRAN 没有您需要的功能包，它可能存在于 GitLab、GitHub、Bitbucket 和其他 Git 托管网站的个人 Git 仓库中。实际上，我们将要安装的两个包来自 GitHub，而不是 CRAN，具体是ggbiplot和ggthemr。最后，您可能需要安装特定版本的包，就像我们将要做的caret包一样。

本书使用的所有包都在以下表中列出，包括它们使用的章节、您应该安装的版本以及我们为什么在书中使用它们的原因。在本书的示例中，我们使用了以下表中未显示的 R 包，但由于它们是内置的，我们不需要自己安装它们，因此没有显示。例如，methods和parallel包就是这种情况，它们分别用于与 S4 对象系统一起工作以及执行并行计算。我们需要安装的 R 包在以下表中列出：

包	章节	版本	原因
ggplot2	2, 3, 5, 9, and 10	最新版	高质量图表
ggbiplot	2	最新版	主成分图
viridis	2 and 5	最新版	图表颜色调色板
corrplot	2 and 3	最新版	相关性图
progress	2 and 3	最新版	显示迭代进度
RMySQL	4	最新版	MySQL 数据库接口
ggExtra	5	最新版	带边缘分布的图表
threejs	5	最新版	交互式地球图表
leaflet	5	最新版	交互式高质量地图
plotly	5	最新版	交互式高质量图表
rgl	5	最新版	交互式 3D 图表
rgdal	5	最新版	地理数据处理
plyr	5	最新版	数据框追加
lsa	6	最新版	余弦相似度计算
rilba	6	最新版	高效 SVD 分解
caret	6 and 7	最新版	机器学习框架
twitteR	6	最新版	Twitter API 接口
quanteda	6	最新版	文本数据处理
sentimentr	6	最新版	文本数据情感分析
randomForest	6	最新版	随机森林模型
ggrepel	7	最新版	避免图表中标签重叠
rmarkdown	7	最新版	带有可执行代码的 Markdown 文档
R6	8	最新版	R6 对象模型
jsonlite	8	最新	从 JSON API 检索数据
lubridate	8, 9, 10	最新	简单地转换日期
microbenchmark	9	最新	基准函数的性能
shiny	10	最新	创建现代网络应用程序
shinythemes	10	最新	应用 Shiny 应用程序的主题
ggthemr	10	最新	应用ggplot2图形的主题

要安装这些包，你可以使用install.packages(ggplot2)命令，并将包更改为之前表中显示的每个包。然而，安装所有包的更有效的方法是将我们想要安装的所有包的名称向量发送到install.packages()函数，如下面的代码所示。最后，请注意，你可以发送dependencies = TRUE参数来告诉 R 尝试为你安装任何缺失的依赖项：

install.packages(c(
    "ggplot2",
    "viridis",
    "corrplot",
    "progress",
    "RMySQL",
    "ggExtra",
    "threejs",
    "leaflet",
    "plotly",
    "rgl",
    "rgdal",
    "plyr",
    "lsa",
    "rilba",
    "twitteR",
    "quanteda",
    "sentimentr",
    "randomForest",
    "ggrepel",
    "rmarkdown",
    "R6",
    "jsonlite",
    "lubridate",
    "microbenchmark",
    "shiny",
    "shinythemes",
    dependencies = TRUE
))

注意，前面的向量省略了三个包：ggbiplot、ggthemr和caret。它们被省略是因为前两个只能直接从 GitHub（不是 CRAN）安装，而第三个需要一个特定的版本，因为最新的版本包含一个影响我们编写此内容时的一些代码的 bug。要安装ggbiplot包，我们需要 GitHub 上包的所有者的用户名。如果你访问包的 URL（github.com/vqv/ggbiplot），你会看到它是vqv。现在，为了执行实际的安装，我们使用devtools包中的install_github()函数，并向它提供一个包含用户名（vqv）和存储库名称（ggbiplot）的字符串，这两个名称由斜杠（/）分隔。

如果你愿意，你可以将devtools包加载到内存中，然后直接调用install_github()函数。

让我们看看以下命令：

devtools::install_github("vqv/ggbiplot")

类似地，要安装ggthemr包（github.com/cttobin/ggthemr），我们使用以下命令行：

devtools::install_github("cttobin/ggthemr")

最后，要安装caret包，我们可以使用 CRAN，但我们必须指定我们想要的版本，在这个例子中是6.0.76。为了完成这个任务，我们使用来自同一devtools包的install_version函数。在这种情况下，我们向它发送包的名称和我们想要的版本：

devtools::install_version("caret", version = "6.0.76")

到现在为止，你应该拥有复制书中代码所需的一切。如果你遇到任何问题，我确信在线和 Stack Overflow（stackoverflow.com/）的搜索将非常有帮助。

加载 R 包

到目前为止，你应该能够加载这本书所需的 R 包，你可以使用library()或require()函数来这样做，这两个函数都接受你想要加载的包的名称作为参数。

你可能想知道为什么需要将包加载到 R 中才能使用它们。如果每个包都默认加载到 R 中，你可能会认为你正在使用一个函数，但实际上却在使用另一个函数。更糟糕的是，可能存在内部冲突：两个不同的包可能会使用完全相同的函数名，导致出现奇怪和意外的结果。通过只加载你需要的包，你可以最小化这些冲突的可能性。