机器学习实践秘籍-全-

机器学习实践秘籍（全）

原文：annas-archive.org/md5/15b58dbdde87ea8cb4894e5d29bf0db5

译者：飞龙

协议：CC BY-NC-SA 4.0

前言

在当今世界，数据是新的黑色黄金，其增长呈指数级。这种增长可以归因于现有数据的增长，以及来自社交媒体、互联网、文档和物联网等多个来源的结构化和非结构化新数据。数据的流动必须被收集、处理、分析，并最终实时呈现，以确保数据的消费者能够在当今快速变化的环境中做出明智的决策。机器学习技术被应用于数据，使用解决问题的上下文来确保使用统计技术以科学的方式分析快速到达和复杂的数据。使用迭代地从数据中学习的机器学习算法，可以发现隐藏的模式。机器学习的迭代特性很重要，因为当模型接触到新数据时，它们能够独立地适应并从新的数据集中学习，以产生可靠的决策。

我们将首先介绍本书将涵盖的机器学习的各种主题。基于现实世界的挑战，我们在各个章节中探讨每个主题，例如 分类、聚类、模型选择和正则化、非线性、监督学习、无监督学习、强化学习、结构化预测、神经网络、深度学习，最后是案例研究。这些算法都是使用 R 语言开发的。本书对 R 语言的初学者友好，但熟悉 R 编程无疑会帮助你在代码中游刃有余。

你将学习如何就所需使用的算法类型做出明智的决策，以及如何实现这些算法以获得最佳结果。如果你想构建能够理解图像、文本、语音或其他形式数据的多功能应用程序，这本关于机器学习的书一定会对你有所帮助！

本书涵盖内容

第一章, 机器学习简介，涵盖了关于机器学习的各种概念。本章使读者了解本书将涵盖的各种主题。

第二章, 分类，涵盖了以下主题和算法：判别函数分析、多项式逻辑回归、Tobit 回归和泊松回归。

第三章, 聚类，涵盖了以下主题和算法：层次聚类、二进制聚类和 k-means 聚类。

第四章, 模型选择和正则化，涵盖了以下主题和算法：收缩方法、降维方法、主成分分析。

第五章, 非线性，涵盖了以下主题和算法：广义加性模型、平滑样条和局部回归。

第六章, 监督学习，涵盖了以下主题和算法：决策树学习、朴素贝叶斯、随机森林、支持向量机和随机梯度下降。

第七章, 无监督学习，涵盖了以下主题和算法：自组织映射和矢量量化。

第八章, 强化学习，涵盖了以下主题和算法：马尔可夫链和蒙特卡洛模拟。

第九章, 结构化预测，涵盖了以下主题和算法：隐马尔可夫模型。

第十章, 神经网络，涵盖了以下主题和算法：神经网络。

第十一章, 深度学习，涵盖了以下主题和算法：循环神经网络。

第十二章, 案例研究 - 探索世界银行数据，涵盖了世界银行数据分析。

第十三章, 案例研究 - 重新保险合同定价，涵盖了重新保险合同的定价。

第十四章, 案例研究 - 预测电力消费，涵盖了预测电力消费。

您需要这本书的内容

本书专注于在 R 中构建基于机器学习的应用程序。我们使用了 R 来构建各种解决方案。我们专注于如何以最佳方式利用各种 R 库和函数来克服现实世界的挑战。我们尽量使所有代码都尽可能友好和易于阅读。我们相信这将使我们的读者能够轻松理解代码并在不同场景中轻松使用它。

本书面向的对象

本书面向统计学、数据分析、机器学习和计算机科学领域的学生和专业人士，或希望构建现实世界基于机器学习应用程序的其他专业人士。本书对 R 入门者友好，但熟悉 R 将有助于在代码中探索。对于希望在其现有技术堆栈中探索机器学习技术的经验丰富的 R 程序员来说，这也会很有用。

章节内容

在本书中，您将找到频繁出现的标题（准备工作 和 如何操作）。

为了清楚地说明如何完成食谱，我们使用以下章节如下：

准备工作

本节将向您介绍食谱中可以期待的内容，并描述如何设置任何软件或食谱所需的任何初步设置。

如何操作…

本节包含遵循食谱所需的步骤。

规范

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

文本中的代码单词、数据库表名、文件夹名、文件名、文件扩展名、路径名、虚拟 URL、用户输入和 Twitter 用户名如下所示：“我们将数据保存到fitbit_details框架中：”

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

install.packages("ggplot2")

新术语和重要词汇以粗体显示。您在屏幕上看到的单词，例如在菜单或对话框中，在文本中显示如下：“蒙特卡洛与市场零利率”。

注意

警告或重要注意事项以如下框中的形式出现。

小贴士

小技巧和窍门看起来像这样。

读者反馈

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

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

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

客户支持

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

下载示例代码

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

您可以通过以下步骤下载示例代码：

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

2. 将鼠标指针悬停在顶部的支持标签上。

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

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

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

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

7. 点击代码下载。

您还可以通过点击 Packt Publishing 网站书籍网页上的代码文件按钮来下载代码文件。您可以通过在搜索框中输入书籍名称来访问此页面。请注意，您需要登录到您的 Packt 账户。

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

• WinRAR / 7-Zip for Windows

• Zipeg / iZip / UnRarX for Mac

• 7-Zip / PeaZip for Linux

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

下载本书的彩色图像

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

勘误

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

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

盗版

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

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

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

问题

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

第一章：机器学习简介

在本章中，我们将介绍机器学习的基础知识以及机器学习涵盖的各种主题。在本章中，你将学习以下主题：

• 什么是机器学习？

• 分类概述

• 聚类概述

• 模型选择和正则化概述

• 非线性的概述

• 监督学习概述

• 无监督学习的概述

• 强化学习概述

• 结构化预测概述

• 神经网络的概述

• 深度学习概述

什么是机器学习？

人类从出生开始就接触数据。眼睛、耳朵、鼻子、皮肤和舌头持续收集各种形式的数据，大脑将这些数据转化为视觉、听觉、嗅觉、触觉和味觉。大脑随后通过感官器官接收到的各种原始数据，将其转化为语言，用于表达对所接收到的原始数据性质的意见。

在当今世界，机器上安装的传感器被用来收集数据。数据通过各种网站和社交网站从互联网收集。数字化后的古老手稿的电子形式也增加了数据集。数据还通过各种网站和社交网站从互联网收集。数据还从其他电子形式中收集，例如数字化后的古老手稿。这些来自多个来源的丰富数据形式需要处理，以便获得洞察力，并理解更有意义的模式。

机器学习算法有助于从各种来源收集数据，转换丰富数据集，并帮助我们根据提供的结果采取智能行动。机器学习算法被设计为高效和准确，并提供一般学习以执行以下操作：

• 处理大规模问题

• 做出准确的预测

• 处理各种不同的学习问题

• 可学习的内容及其可学习的条件

机器学习算法的一些应用领域如下：

• 基于销售的定价预测

• 药物分子反应的预测

• 检测机动车保险欺诈

• 分析股市回报

• 识别风险禁贷

• 预测风力发电场预测

• 跟踪和监控医疗设备的利用和位置

• 计算能源的高效利用

• 理解智能城市交通增长趋势

• 矿业矿石储备估计

分类概述

线性回归模型呈现的是性质为定量的响应变量。然而，某些响应变量是定性的。例如，态度（强烈不同意、不同意、中立、同意和强烈同意）就是定性的。对观察到的定性响应进行预测可以称为对该观察进行分类，因为它涉及到将观察分配到某个类别或类别中。分类器是许多任务中不可或缺的工具，例如医学或基因组学预测、垃圾邮件检测、人脸识别和金融。

聚类概述

聚类是将数据划分为相似对象组的过程。每个对象（聚类）由彼此相似且与其他组对象不相似的对象组成。聚类的目标是确定一组未标记数据中的内在分组。聚类可用于数据挖掘（DNA 分析、市场研究、保险研究等）、文本挖掘、信息检索、统计计算语言学家和基于语料库的计算词典学等领域。聚类算法必须满足的一些要求如下：

• 可扩展性

• 处理各种类型的属性

• 发现任意形状的聚类

• 处理噪声和异常值的能力

• 可解释性和可用性

以下图表展示了聚类的表示：

监督学习概述

监督学习涉及学习一组输入变量（通常是一个向量）与输出变量（也称为监督信号）之间的映射，并将此映射应用于预测未见数据。监督方法试图发现输入变量和目标变量之间的关系。发现的关系以称为模型的结构表示。通常，模型描述和解释隐藏在数据集中的现象，并可用于在知道输入属性值的情况下预测目标属性的值。

监督学习是机器学习任务，从监督训练数据（训练样本集）中推断出一个函数。训练数据由一组训练样本组成。在监督学习中，每个样本都是一个由输入对象和期望输出值组成的对。监督学习算法分析训练数据并产生一个推断函数。

为了解决监督学习问题，必须执行以下步骤：

1. 确定训练样本的类型。

2. 收集训练集。

3. 确定学习函数的输入变量。

4. 确定学习函数的结构和相应的学习算法。

5. 完成设计。

6. 评估学习函数的准确性。

监督方法可以在营销、金融和制造等各种领域实现。

在监督学习中需要考虑的一些问题如下：

• 偏差-方差权衡

• 函数复杂度和训练数据量

• 输入空间的维度

• 输出值中的噪声

• 数据的同质性

• 数据的冗余

• 存在交互和非线性

无监督学习概述

无监督学习研究系统如何以反映整体输入模式集合的统计结构的方式学习表示特定的输入模式。无监督学习很重要，因为它在脑中可能比监督学习更常见。例如，眼睛中光感受器的活动始终随着视觉世界的变化而变化。它们继续提供所有可用的信息，以表明世界中有什么物体，它们是如何呈现的，光照条件如何，等等。然而，在学习过程中，关于场景内容的信息基本上都是不可用的。这使得无监督方法变得至关重要，并允许它们被用作突触适应的计算模型。

在无监督学习中，机器接收输入但既不获得监督目标输出，也不从其环境中获得奖励。想象机器在没有从其环境中获得任何反馈的情况下可能学习到什么，这似乎有些神秘。然而，可以基于机器的目标是构建可用于决策、预测未来输入、高效地将输入传达给另一台机器等表示，为无监督学习开发一个形式化的框架。从某种意义上说，无监督学习可以被视为在数据中找到模式，这些模式超越了被认为是噪声的内容。

无监督学习的一些目标如下：

• 在不要求目标期望输出的情况下，在大数据集中发现有用的结构

• 提高输入的学习速度

• 通过为每个可能的数据向量分配一个分数或概率来构建数据向量的模型

强化学习概述

强化学习是让智能体在世界中采取行动以最大化其奖励的问题。它关乎做什么以及如何将情况映射到动作，以最大化数值奖励信号。学习者没有被告知采取哪些动作，如大多数机器学习形式，而是必须通过尝试来发现哪些动作能带来最多的奖励。强化学习的两个最重要的区分特征是试错和搜索以及延迟奖励。以下是一些强化学习的例子：

• 下棋的玩家在走棋时，选择既受计划的影响，也受预期可能的回应和反回应的影响。

• 一个自适应控制器实时调整石油精炼厂操作参数。控制器根据指定的边际成本优化产量/成本/质量权衡，而不严格遵循工程师最初建议的设定点。

• 一只羚羊小牛出生后几分钟就努力站起来。半小时后，它就能以每小时 20 英里的速度奔跑。

• 教狗学新把戏——你不能告诉它做什么，但如果它做对了/做错了，你可以奖励/惩罚它。它必须弄清楚是什么让它得到了奖励/惩罚，这被称为信用分配问题。

强化学习就像试错学习。智能体应该从其对环境的经验中找到一条好的策略，而在这个过程中不要损失太多的奖励。探索是指寻找更多关于环境的信息，而利用则是利用已知信息来最大化奖励。例如：

• 餐厅选择：利用；去你最喜欢的餐厅。探索；尝试一家新餐厅。

• 石油钻探：利用；在已知最佳位置钻探。探索；在新的位置钻探。

强化学习的主要组成部分如下：

• 策略：这是一个智能体的行为函数。它决定了从感知到的环境状态到采取行动的映射，当处于这些状态时。在心理学中，这相当于一套刺激-反应规则或联想。

• 价值函数：这是一个对未来奖励的预测。一个状态的价值是一个智能体从该状态开始，在未来可以期望积累的总奖励量。而奖励决定了环境状态的即时、内在的吸引力，而价值则表示在考虑了可能跟随的状态以及那些状态中可用的奖励后，状态的长期吸引力。

• 模型：模型预测环境接下来会做什么。它预测下一个状态以及下一个状态中的即时奖励。

结构化预测概述

结构化预测是机器学习在多个领域应用中的重要领域。考虑输入 x 和输出 y，例如时间步的标记、图像的属性集合、句子的解析或图像分割成对象，这些问题具有挑战性，因为 y 的数量与构成它的输出变量的数量呈指数关系。这些计算上具有挑战性，因为预测需要搜索巨大的空间，并且还需要考虑统计因素，因为从有限的数据中学习准确模型需要推理不同结构输出之间的共性。结构化预测本质上是一个表示问题，其中表示必须捕捉 x 和 y 之间的判别性交互，并允许对 y 进行有效的组合优化。

结构化预测是关于从输入数据预测结构化输出，而不是像分类或回归那样预测单个数字。例如：

• 自然语言处理--自动翻译（输出：句子）或句子解析（输出：解析树）

• 生物信息学--二级结构预测（输出：二分图）或酶功能预测（输出：树中的路径）

• 语音处理--自动转录（输出：句子）或文本转语音（输出：音频信号）

• 机器人学--规划（输出：动作序列）

神经网络的概述

神经网络代表了信息处理的大脑隐喻。这些模型是生物启发的，而不是大脑实际功能的精确复制品。神经网络已被证明在许多预测应用和商业分类应用中是非常有前途的系统，这得益于它们从数据中学习的能力。

人工神经网络通过更新网络架构和连接权重来学习，以便网络能够高效地执行任务。它可以从可用的训练模式中学习，或者从示例或输入输出关系中自动学习。学习过程由以下之一设计：

• 了解可用信息

• 学习范式--从环境中获得模型

• 学习规则--弄清楚权重更新过程

• 学习算法--通过学习规则识别调整权重的程序

有四种基本类型的学习规则：

• 错误校正规则

• 伯尔兹曼

• 赫布理论

• 竞争学习

深度学习的概述

深度学习指的是一类相当广泛的机器学习技术和架构，其标志是使用许多层非线性信息处理，这些处理在本质上是有层次的。深度学习架构大致分为三类：

• 用于无监督或生成学习的深度网络

• 用于监督学习的深度网络

• 混合深度网络

第二章. 分类

在本章中，我们将介绍以下食谱：

• 判别函数分析 - 对来自井的卤水进行地质测量

• 多项式逻辑回归 - 理解学生做出的课程选择

• 托比特回归 - 测量学生的学术能力

• 泊松回归 - 理解加勒比海群岛上的物种

简介

判别分析用于区分不同的观测集，并将新的观测分配到先前定义的组中。例如，如果一项研究旨在调查区分（1）灵长类动物、（2）鸟类或（3）松鼠所食用的水果的变量，研究人员可以收集关于每个动物群体所食用的水果的众多特征数据。大多数水果自然会落入三个类别之一。然后可以使用判别分析来确定哪些变量是预测水果是否被鸟类、灵长类动物或松鼠食用的最佳预测变量。判别分析常用于生物物种分类、肿瘤的医学分类、面部识别技术以及信用卡和保险行业中的风险评估。判别分析的主要目标是判别和分类。关于判别分析的前提假设包括多元正态性、组内方差协方差相等以及变量的低多重共线性。

多项式逻辑回归用于根据多个自变量预测因变量的分类位置或类别成员的概率。当因变量有超过两个名义或无序类别时使用，此时独立变量的虚拟编码相当常见。独立变量可以是二元的（二进制）或连续的（尺度上的区间或比率）。多项式逻辑回归使用最大似然估计来评估类别成员的概率。它使用最大似然估计而不是传统多元回归中使用的最小二乘估计。假设分布的一般形式。使用估计参数的起始值，并计算样本来自具有这些参数的群体的似然性。通过迭代调整估计参数的值，直到获得估计参数的最大似然值。

Tobit 回归用于描述非负因变量与自变量之间的关系。它也被称为截断回归模型，旨在估计变量之间的线性关系，当因变量中存在左截断或右截断时。截断发生在具有某个阈值或以上值的案例中，所有这些案例都采用该阈值的价值，因此真实值可能等于该阈值，但也可能更高。Tobit 模型已在大量应用中使用，其中样本中的一些个体的因变量被观察到为零（汽车支出、医疗支出、工作时间、工资等）。此模型适用于度量因变量，并且它在观察到的值仅在它高于或低于某个截断水平时才被观察到的意义上是有限的。例如：

• 工资可能因最低工资限制而从下限受限。

• 捐赠给慈善机构的金额

• 顶码收入

• 个人的时间使用和休闲活动

泊松回归处理因变量为计数的情形。泊松回归类似于常规的多重回归，除了因变量（Y）是一个遵循泊松分布的观察计数。因此，Y 的可能值是非负整数：0，1，2，3，等等。假设大计数是罕见的。因此，泊松回归类似于逻辑回归，后者也有一个离散的响应变量。然而，响应值并不限于特定值，正如逻辑回归中的那样。

鉴别函数分析 - 来自井的卤水地质测量

假设需要对从矿山收集的古文物进行研究。已经从矿山收集了岩石样本。在收集的岩石样本上进行了地球化学测量。对收集到的文物也进行了类似的研究。为了将样本分离到它们挖掘的矿山，可以使用 DFA 作为函数。然后可以将该函数应用于文物以预测每个文物的来源矿山。

准备就绪

为了进行鉴别函数分析，我们将使用从矿山收集的数据集。

第 1 步 - 收集和描述数据

应使用名为BRINE的地质数据分析数据集。这可以从www.kgs.ku.edu/Mathgeo/Books/Stat/ASCII/BRINE.TXT 获取。数据集采用标准形式，行对应样本，列对应变量。每个样本被分配到一个地层单元，列在最后一列列出。数据集中有 19 个案例和 8 个变量。八个数值测量包括以下内容：

• No

• HCO3

• SO4

• CL

• CA

• MG

• NA

• Group

如何做...

让我们深入了解。

第 2 步 - 探索数据

第一步是加载以下包：

    > library(MASS)

注意

版本信息：本页面的代码在 R 版本 3.2.3（2015-12-10）中进行了测试

让我们探索数据并了解变量之间的关系。我们将从导入名为brine.txt的 txt 数据文件开始。我们将把数据保存到brine数据框中，如下所示：

> brine <- read.table("d:/brine.txt", header=TRUE, sep=",", row.names=1)

接下来我们将打印brine数据框。head()函数返回brine数据框。将brine数据框作为输入参数传递。使用以下代码：

    > head(brine)

结果如下：

 HCO3    SO4      Cl      Ca      Mg       Na   GROUP
1   10.4   30.0    967.1    95.9    53.7    857.7     1
2    6.2   29.6   1174.9   111.7    43.9   1054.7     1
3    2.1   11.4   2387.1   348.3   119.3   1932.4     1
4    8.5   22.5   2186.1   339.6    73.6   1803.4     1
5    6.7   32.8   2015.5   287.6    75.1   1691.8     1
6    3.8   18.9   2175.8   340.4    63.8   1793.9     1

DFA 假设多元正态性。在进行分析之前，必须检查数据以验证正态性。

为了验证转换的适当性，执行数据绘图。使用pairs ()函数绘制数据。它产生一个散点矩阵。交叉图应仅比较第 1-6 列的测量变量，最后一列（第 7 列）是组名。考虑以下内容：

> pairs(brine[ ,1:6])

图形如下所示：

第 3 步 - 转换数据

可以明显看出数据具有彗星形状的分布模式。这表明需要对数据进行对数转换，这在地球化学数据中很常见。一个好的做法是首先复制整个数据集，然后只对地球化学测量值应用对数转换。由于数据中包含零；应对数据集执行log+1转换而不是log转换。将brine数据框复制到brine.log数据框。对数据框执行对数转换。如前所述，执行对数转换。查看以下代码：

 > brine.log <- brine
 > brine.log[ ,1:6] <- log(brine[ ,1:6]+1)
 > pairs(brine.log[ ,1:6])

数据转换后，为了使用pairs()函数数据框重新评估正态性条件，重新绘制brine.log。分布看起来更接近正态。与之前的图形相比，偏度已经降低：

    > pairs(brine.log[ ,1:6])

图形如下所示：

第 4 步 - 训练模型

下一步是训练模型。这是通过判别函数分析来完成的。调用lda()函数执行判别函数分析，如下所示：

> brine.log.lda <- lda(GROUP ~ HCO3 + SO4 + Cl + Ca + Mg + Na, data=brine.log)

这个调用的格式与线性回归或方差分析非常相似，即我们指定一个公式。在这里，GROUP变量应被视为因变量，地球化学测量值作为自变量。在这种情况下，没有建模变量之间的交互作用，因此变量通过+而不是*添加。由于没有调用attach()，必须提供数据框的名称作为数据参数。运行 DFA 后，第一步是查看结果，如下所示：

    > brine.log.lda

结果如下：

Call:
lda(GROUP ~ HCO3 + SO4 + Cl + Ca + Mg + Na, data = brine.log)
Prior probabilities of groups:
 1             2             3 
0.3684211     0.3157895     0.3157895 
Group means:
 HCO3        SO4         Cl         Ca         Mg         Na
1   1.759502   3.129009   7.496891   5.500942   4.283490   7.320686
2   2.736481   3.815399   6.829565   4.302573   4.007725   6.765017
3   1.374438   2.378965   6.510211   4.641049   3.923851   6.289692
Coefficients of linear discriminants:
 LD1             LD2
HCO3      -1.67799521      0.64415802
SO4        0.07983656      0.02903096
Cl         22.27520614     -0.31427770
Ca        -1.26859368      2.54458682
Mg        -1.88732009     -2.89413332
Na       -20.86566883      1.29368129
Proportion of trace:
 LD1        LD2 
 0.7435     0.2565

• 输出的第一部分显示了拟合的公式。

• 第二部分是组的先验概率，它反映了每个组在数据集中的比例。换句话说，如果你没有任何测量，并且测量的样本数量代表了组的实际相对丰度，那么先验概率将描述任何未知样本属于每个组的概率。

• 第三部分显示了组均值，这是一个表格，列出了每个组中每个变量的平均值。扫描这个表格可以帮助你看到组是否在某个或多个变量方面具有独特性。

• 第四部分报告了判别函数的系数（a、b 和 c）。因为有三个组，所以有 3-1 个线性判别函数（如果你只有两个组，你只需要 1 个 [2-1] 线性判别函数）。对于每个线性判别函数（LD1 和 LD2），有一个系数依次对应于每个变量。

• 最后，第五部分显示了迹的比率，它给出了每个判别函数解释的方差。在这里，首先判别函数解释了 75% 的方差，其余的方差由第二个判别函数解释。

第 5 步 - 分类数据

predict() 函数，也是 MASS 包的一部分，使用 lda() 的结果将样本分配到组中。换句话说，由于 lda() 推导出一个线性函数，该函数应该用于分类组，因此 predict() 允许您将此函数应用于相同的数据以查看分类函数的成功程度。遵循统计惯例，x-hat 是 x 的预测（在对象名称中添加帽子以使其清晰，这些是预测）。考虑以下内容：

    > brine.log.hat <- predict(brine.log.lda)

让我们按照以下方式打印 brine.log.hat：

> brine.log.hat

结果如下：

$class
 [1] 2 1 1 1 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3
Levels: 1 2 3
$posterior
 1                2                3
1    2.312733e-01     7.627845e-01     5.942270e-03
2    9.488842e-01     3.257237e-02     1.854347e-02
3    8.453057e-01     9.482540e-04     1.537461e-01
4    9.990242e-01     8.794725e-04     9.632578e-05
5    9.965920e-01     2.849903e-03     5.581176e-04
6    9.984987e-01     1.845534e-05     1.482872e-03
7    8.676660e-01     7.666611e-06     1.323263e-01
8    4.938019e-03     9.949035e-01     1.584755e-04
9    4.356152e-03     9.956351e-01     8.770078e-06
10   2.545287e-05     9.999439e-01     3.066264e-05
11   2.081510e-02     9.791728e-01     1.210748e-05
12   1.097540e-03     9.989023e-01     1.455693e-07
13   1.440307e-02     9.854613e-01     1.356671e-04
14   4.359641e-01     2.367602e-03     5.616683e-01
15   6.169265e-02     1.540353e-04     9.381533e-01
16   7.500357e-04     4.706701e-09     9.992500e-01
17   1.430433e-03     1.095281e-06     9.985685e-01
18   2.549733e-04     3.225658e-07     9.997447e-01
19   6.433759e-02     8.576694e-03     9.270857e-01
$x
 LD1            LD2
1      -1.1576284     -0.1998499
2     -0.1846803      0.6655823
3       1.0179998      0.6827867
4      -0.3939366      2.6798084
5      -0.3167164      2.0188002
6       1.0061340      2.6434491
7       2.0725443      1.5714400
8      -2.0387449     -0.9731745
9      -2.6054261     -0.2774844
10     -2.5191350     -2.8304663
11     -2.4915044      0.3194247
12     -3.4448401      0.1869864
13     -2.0343204     -0.4674925
14      1.0441237     -0.0991014
15      1.6987023     -0.6036252
16      3.9138884     -0.7211078
17      2.7083649     -1.3896956
18      2.9310268     -1.9243611
19      0.7941483     -1.2819190

输出从每个样本的分配分类开始。接下来，它列出了每个样本对每个组的后验概率，其中每行的概率（即，对于每个样本）总和为 1.0。这些后验概率衡量了每个分类的强度。如果一个样本的这些概率中有一个远大于其他所有概率，那么这个样本就非常确定地分配到了一个组。如果有两个或更多概率几乎相等，那么分配就不是很确定。如果有许多组，以下命令是快速找到每个样本最大概率的方法：

> apply(brine.log.hat$posterior, MARGIN=1, FUN=max)
 1           2             3  4             5         6             7         8 
0.7627845 0.9488842 0.8453057 0.9990242 0.9965920 0.9984987 0.8676660 0.9949035 
 9          10          11        12          13        14          15        16 
0.9956351 0.9999439 0.9791728 0.9989023 0.9854613 0.5616683 0.9381533 0.9992500 
 17          18          19 
0.9985685 0.9997447 0.9270857

由于数据集中的大部分概率都很大（>0.9），这表明该集合中的大多数样本已经被分配到了一个组。

如果这些概率中的大多数都很大，则整体分类成功。predict()输出的最后部分列出了每个样本在每个判别函数轴上的得分。这些得分可以绘制成图，以图形方式显示组在判别函数中的分布，就像主成分分析得分可以绘制一样，如下所示：

> plot(brine.log.lda)

三个组占据明显不同且不重叠的区域。只有一个第 1 组靠近第 2 组，因此可以清楚地声明判别是成功的。

图如下所示：

第二种类型的图显示了数据沿特定判别函数轴的分布，如下所示：

> plot(brine.log.lda, dimen=1, type="both")

再次注意，组在判别函数 1 上的分离很好，尤其是第 2 组。

第 6 步 - 评估模型

必须评估 DFA 在分类组中的有效性，这是通过比较predict()所做的分配与实际组分配来完成的。table()函数对此非常有用。按照惯例，它使用实际分配作为第一个参数，拟合分配作为第二个参数，如下所示：

> tab <- table(brine.log$GROUP, brine.log.hat$class)

打印制表符的值。

 > tab

结果如下：

 1   2   3
 1   6   1   0
 2   0   6   0
 3   0   0   6

输出的行对应于原始数据中指定的组，列对应于 DFA 所做的分类。在完美的分类中，大值将沿对角线排列，对角线外的值为零，这表明所有属于第 1 组的样本都被 DFA 判别为属于第 1 组，依此类推。这种表格的形式可以让你对哪些组被可靠地区分开来有相当大的洞察力。它还可以显示哪些组可能被混淆，以及哪些类型的误分类比其他类型更常见。以下命令将计算整体预测准确率，即沿对角线排列的案例比例：

> sum(tab[row(tab) == col(tab)]) / sum(tab)

结果如下：

[1] 0.9473684

这里预测准确率几乎为 95%，相当成功。这种方法衡量的是所谓的重置误差，即当所有样本都用于开发判别函数时，样本被分类得有多好。

评估 DFA 的第二种方法是留一法交叉验证（也称为刀切验证），它排除一个观测值。这种评估 DFA 的方法使用被排除的数据，即排除一个观测值。我们现在剩下 n - 1 个观测值。这种交叉验证技术会自动对数据集中的每个样本进行。为此，将CV=TRUE（考虑交叉验证）添加到lda()调用中，如下所示：

> brine.log.lda <- lda(GROUP ~ HCO3 + SO4 + Cl + Ca + Mg + Na, data=brine.log, CV=TRUE) 

可以用类似的方式衡量判别的成功，如下所示：

> tab <- table(brine.log$GROUP, brine.log.lda$class)

按如下方式打印制表符的值：

> tab

结果如下：

 1   2   3
 1  6   1   0
 2   1   4   1
 3   1   0   5
> sum(tab[row(tab) == col(tab)]) / sum(tab)

结果如下：

[1] 0.7894737

在这个数据集中，Jackknife 验证的准确性相当低（只有 79%的准确性），反映出重置误差总是高估 DFA 的性能。这种差异在这个小型数据集中尤其常见，而判别函数分析在大数据集中通常要成功得多。

多项式逻辑回归 - 理解学生做出的课程选择

假设高中生将被录取到某个课程。学生有机会选择他们喜欢的课程。学生的选择基于三个选项。这些选择是一般课程、职业教育课程和学术课程。每个学生的选择基于每个学生的写作分数和社会经济状况。

准备工作

为了完成这个食谱，我们将使用一个学生数据集。第一步是收集数据。

第 1 步 - 收集数据

正在使用标题为 hsbdemo 的学生数据集。数据集以 MS Excel 格式提供，可在以下网址找到：voia.yolasite.com/resources/hsbdemo.csv。数据集中有 201 个数据行和 13 个变量。八个数值测量值如下：

• id

• read

• write

• math

• science

• socst

• awards

• cid

非数值测量值如下：

• gender

• ses

• schtyp

• prog

• honors

如何操作...

让我们深入了解细节。

第 2 步 - 探索数据

第一步是加载包。如果包不存在，library() 函数会返回错误。请使用以下命令：

 > library(foreign)
 > library (nnet)
 > library (ggplot2)
 > library (reshape2)

注意

版本信息：本页面的代码在 R 版本 3.2.3（2015-12-10）上进行了测试。

探索数据使数据的关联关系更加清晰。标题为 hsbdemo.csv 的 CSV 文件需要导入到 R 环境中。导入的数据被保存在标题为 ml 的数据框中，如下所示：

> ml <- read.table("d:/hsbdemo.csv", header=TRUE, sep=",", row.names="id")

使用 with() 函数执行对感兴趣的变量的描述性统计探索，如下所示：

> with(ml, table(ses, prog))

结果如下：

 prog
 ses         academic         general    vocation
 high           42                9           7
 low            19               16          12
 middle         44               20          31

让我们按照以下方式获取平均值和标准差：

> with(ml, do.call(rbind, tapply(write, prog, function(x) c(M = mean(x), SD = sd(x)))))

结果如下：

 M           SD
academic     56.25714     7.943343
general      51.33333     9.397775
vocation     46.76000     9.318754

平均值最高的是学术课程，标准差最高的是普通课程。

第 3 步 - 训练模型

为了估计多项式逻辑回归，使用 multinom() 函数。multinom() 函数不需要对数据进行重塑。

选择结果参考组很重要。我们可以选择我们希望用作基线的结果水平。这由relevel()函数指定。然后，我们使用multinom()函数运行我们的模型。由于没有对回归系数进行 p 值计算，因此使用 Wald 测试（z 测试）进行 p 值测试。multinom()函数中提到的公式形式为 response ~ predictors。数据框ml是要解释公式中出现的变量的数据框，如下所示：

 > ml$prog2 <- relevel(ml$prog, ref = "academic") 
 > test <- multinom(prog2 ~ ses + write, data = ml)

结果如下：

# weights:  15 (8 variable)
initial  value          219.722458 
iter     10 value     179.983731
final    value         179.981726 
converged

 > summary(test)

结果如下：

 Call:
multinom(formula = prog2 ~ ses + write, data = ml)
Coefficients:
 (Intercept)       seslow   sesmiddle         write
general     1.689478       1.1628411   0.6295638   -0.05793086
vocation    4.235574       0.9827182   1.2740985   -0.11360389

 Std. Errors:
 (Intercept)       seslow   sesmiddle        write
general     1.226939       0.5142211   0.4650289   0.02141101
vocation    1.204690       0.5955688   0.5111119   0.02222000
Residual Deviance: 359.9635 
AIC: 375.9635 

接下来，将系数的测试总结除以标准误差的测试总结，如下所示：

> z <- summary(test)$coefficients/summary(test)$standard.errors

按如下方式显示z的值：

> z

结果如下：

 (Intercept)     seslow     sesmiddle       write
general       1.376987   2.261364      1.353816   -2.705658
vocation      3.515904   1.650050      2.492798   -5.112687

第 4 步 - 测试模型的输出结果

进行双尾 z 测试，如下所示：

> p <- (1 - pnorm(abs(z), 0, 1))*2

按如下方式显示 p 的值：

> p

结果如下：

 (Intercept)       seslow     sesmiddle          write
general    0.1685163893   0.02373673     0.1757949   6.816914e-03
vocation   0.0004382601   0.09893276     0.0126741   3.176088e-07

第 5 步 - 提高模型性能

相对风险定义为选择一个结果类别与选择基线类别之间的比率。相对风险是线性方程右侧的指数。指数回归系数是预测变量单位变化的相对风险比。

从模型中提取系数，并按如下方式对其进行指数运算：

> exp(coef(test))

结果如下：

 (Intercept)   seslow         sesmiddle       write
general         5.416653   3.199009    1.876792   0.9437152
vocation       69.101326   2.671709    3.575477   0.8926115

变量 write 增加一个单位时，相对于普通项目与学术项目的相对风险比是.9437。从ses = 1切换到3时，相对于普通项目与学术项目的相对风险比是.3126。使用预测的概率来深入了解模型。使用fitted()函数按如下方式计算每个结果级别的预测概率：

> head(pp <- fitted(test))

结果如下：

 academic     general    vocation
45     .1482721   0.3382509   0.5134769
108   0.1201988   0.1806335   0.6991678
15    0.4186768   0.2368137   0.3445095
67    0.1726839   0.3508433   0.4764728
153   0.1001206   0.1689428   0.7309367
51    0.3533583   0.2378047   0.4088370

检查与两个变量之一（ses和write）相关的概率变化。创建小数据集，改变一个变量而保持另一个变量不变。首先，将 write 变量保持在平均值，然后按如下方式检查ses变量每个级别的预测概率：

 > dses <- data.frame(ses = c("low", "middle", "high"),write = mean(ml$write))
 > predict(test, newdata = dses, "probs")

结果如下：

 academic     general      vocation
1   0.4396813   0.3581915   0.2021272
2   0.4777451   0.2283359   0.2939190
3   0.7009046   0.1784928   0.1206026

通过查看不同连续预测变量值的平均预测概率，使用如下预测概率：

> dwrite <- data.frame(ses = rep(c("low", "middle", "high"), each = 41), write = rep(c(30:70), 3))

将每个ses值的预测概率存储下来，并按如下方式写入：

> pp.write <- cbind(dwrite, predict(test, newdata = dwrite, type = "probs", se = TRUE))

按如下方式计算ses每个级别的平均概率：

> by(pp.write[, 3:5], pp.write$ses, colMeans)

结果如下：

pp.write$ses: high
 academic     general      vocation 
 0.6164348   0.1808049   0.2027603 
-------------------------------------------------------------------------- 
pp.write$ses: low
 academic     general      vocation 
 0.3972955   0.3278180   0.2748864 
-------------------------------------------------------------------------- 
pp.write$ses: middle 
 academic     general      vocation 
 0.4256172   0.2010877   0.3732951 

有时，几个图表可以传达大量信息。使用我们之前为pp.write对象生成的预测，我们可以根据ses的不同水平绘制预测概率与写作分数的关系图。melt()函数将宽格式数据转换为单列数据。lpp数据帧用于指定数据帧如下：

> lpp <- melt(pp.write, id.vars = c("ses", "write"), value.name = "probability")

按照以下方式打印head的值：

> head(lpp)

结果如下：

 ses   write   variable     probability
1  low      30   academic    0.09843258
2   low      31   academic    0.10716517
3   low      32   academic    0.11650018
4   low      33   academic    0.12645441
5   low      34   academic    0.13704163
6   low      35   academic    0.14827211

接下来，我们按ses的每个水平绘制预测概率与写作值的关系图，按项目类型细分如下：

> ggplot(lpp, aes(x = write, y = probability, colour = ses)) +
+     geom_line() +
+     facet_grid(variable ~ ., scales="free")

Tobit 回归 - 测量学生的学术能力

让我们测量学生在 200-800 分范围内的学术能力。这种测量基于阅读和数学分数的模型。学生所注册的项目的性质也需考虑。有三种类型的课程：学术、普通和职业。问题是，一些学生可能正确回答学术能力测试的所有问题，得分 800 分，尽管这些学生可能并不真正在能力上相等。这可能适用于所有可能回答所有问题错误并得分 200 分的学生。

准备工作

为了完成这个食谱，我们将使用一个学生的数据集。第一步是收集数据。

第 1 步 - 收集数据

为了开发 Tobit 回归模型，我们将使用名为 tobit 的学生数据集，该数据集以 MS Excel 格式存储在www.ats.ucla.edu/stat/data/tobit.csv。数据集中有 201 个数据行和五个变量。四个数值测量值如下：

• id

• read

• math

• apt

非数值测量值如下：

• prog

如何做到这一点...

让我们深入了解细节。

第 2 步 - 探索数据

第一步是加载以下包。require()函数是为在其它函数中使用而设计的；如果包不存在，它返回FALSE并给出警告（而不是默认的library()函数产生的错误）。使用以下命令：

    > require(ggplot2)
    > require(GGally)
    > require(VGAM)

注意

版本信息：本页面的代码在 R 版本 3.2.3（2015-12-10）上进行了测试

探索数据并理解变量之间的关系。首先导入名为gala.txt的 CSV 数据文件。这将数据保存到dat数据帧中如下：

> dat <- read.table("d:/tobit.csv", header=TRUE, sep=",", row.names="id")

在这个数据集中，apt的最小值是 352。这表明没有学生得到最低的 200 分。尽管存在向下截断的可能性，但在这个数据集中并不需要。使用以下命令：

> summary(dat)

结果如下：

Id         read         math      prog           apt 
Min.   :  1.0   Min.   :28.0   Min.   :33.0   academic  : 45 Min.   :352
1st Qu.: 50.8   1st Qu.:44.0   1st Qu.:45.0   general   :105 1st Qu.:576
Median :100.5   Median :50.0   Median :52.0   vocational: 50 Median :633
Mean   :100.5   Mean   :52.2   Mean   :52.6      Mean   :640
3rd Qu.:150.2   3rd Qu.:60.0   3rd Qu.:59.0      3rd Qu.:705
Max.   :200.0   Max.   :76.0   Max.   :75.0       Max.   :800

第 3 步 - 绘制数据

Write 是一个函数，它给出了给定均值和标准差的正态分布密度，该密度已在计数度量上进行了缩放。为了生成直方图，使用以下代码将计数表示为 *密度 * 样本大小 * 箱宽：

    > f <- function(x, var, bw = 15) {
    dnorm(x, mean = mean(var), sd(var)) * length(var) * bw
    }

现在我们将按照以下方式设置基础图表：

> p <- ggplot(dat, aes(x = apt, fill=prog))

现在我们将准备一个按不同项目比例着色的直方图，并叠加正态分布，如下所示：

> p + stat_bin(binwidth=15) +
 stat_function(fun = f, size = 1,
 args = list(var = dat$apt))

绘制的直方图如下所示：

观察前面的直方图，我们可以看到 apt 值的截断，也就是说，与分布的其他部分相比，得分在 750 到 800 之间的案例数量远多于预期。

在以下替代直方图中，apt=800 的情况过剩已被突出显示。在以下直方图中，breaks 选项产生一个直方图，其中 apt 的每个唯一值都有自己的条形（通过将 breaks 设置为包含 apt 最小值和最大值值的向量的向量）。因为 apt 是连续的，所以数据集中大多数 apt 的值是唯一的，尽管在分布的接近中心处有几个 apt 的值有两个或三个案例。

直方图最右侧的峰值是 apt=800 的情况的条形，这个条形的高度相对于其他所有条形，清楚地显示了具有此值的案例数量过剩。使用以下命令：

> p + stat_bin(binwidth = 1) + stat_function(fun = f, size = 1, args = list(var = dat$apt, 
 bw = 1))

步骤 4 - 探索关系

以下命令使我们能够探索数据集中的双变量关系：

> cor(dat[, c("read", "math", "apt")])

结果如下：

 read        math             apt
read     1.0000000   0.6622801   0.6451215
math     0.6622801   1.0000000   0.7332702
apt      0.6451215   0.7332702   1.0000000

现在按照以下方式绘制矩阵：

> ggpairs(dat[, c("read", "math", "apt")])

在散点图矩阵的第一行中，散点图显示了 read 和 apt 之间的关系。也建立了 math 和 apt 之间的关系。

步骤 5 - 训练模型

使用 VGAM 包中的 vglm 函数运行 Tobit 模型，使用以下命令：

    > summary(m <- vglm(apt ~ read + math + prog, tobit(Upper = 800), data = dat))

结果如下：

Call:
vglm(formula = apt ~ read + math + prog, family = tobit(Upper = 800), 
 data = dat)

Pearson residuals:
 Min        1Q           Median        3Q       Max
mu           -2.5684    -0.7311        -0.03976    0.7531     2.802
loge(sd)     -0.9689    -0.6359        -0.33365    0.2364     4.845

Coefficients:
 Estimate Std.       Error     z value     Pr(>|z|) 
(Intercept):1     209.55956     32.54590     6.439     1.20e-10 ***
(Intercept):2       4.18476      0.05235    79.944      < 2e-16 ***
read                2.69796      0.61928     4.357     1.32e-05 ***
math                5.91460      0.70539     8.385      < 2e-16 ***
proggeneral       -12.71458     12.40857    -1.025     0.305523 
progvocational   -46.14327     13.70667    -3.366     0.000761 ***
---
Signif. codes:    0 '***'   0.001 '**'   0.01 '*'   0.05 '.' 0.1 ' ' 1
Number of linear predictors:  2 
Names of linear predictors: mu, loge(sd)
Dispersion Parameter for tobit family:   1
Log-likelihood: -1041.063 on 394 degrees of freedom
Number of iterations: 5 

前面的输出告诉我们指定了哪些选项。

标有系数的表格给出了系数、标准误差和 z 统计量。总结表中不包含 p 值。

Tobit 回归系数的解释与 OLS 回归系数类似。线性系数影响未截断的潜在变量：

• 对于 read 增加 1 个单位，apt 的预测值增加 2.6981 分。

• math 增加 1 个单位与 apt 预测值增加 5.9146 个单位相关。

• prog 的术语有略微不同的解释。对于职业教育项目中的学生，预测的 apt 值比学术项目中的学生低 46.1419 分。

• 标有 (Intercept):1 的系数是模型的截距或常数。

• 标记为(Intercept):2的系数是一个辅助统计量。此值的指数与 OLS 回归中残差方差的平方根类似。65.6773的值可以与学术能力倾向的标准差99.21进行比较，这是一个显著的降低。

最终对数似然值为-1041.0629，显示在输出结果的底部；它可以用于嵌套模型的比较。

第 6 步 - 测试模型

模型中每个系数的 p 值计算如下。使用 z 值计算每个系数的 p 值，然后以表格形式展示。read、math和prog = 3（职业）的系数在统计上具有显著性，如下所示：

    > ctable <- coef(summary(m))
> pvals <- 2 * pt(abs(ctable[, "z value"]), df.residual(m), lower.tail = FALSE) 
    > cbind(ctable, pvals)

结果如下：

 Estimate    Std. Error      z value       Pr(>|z|)       pvals
(Intercept):1    209.559557   32.54589921    6.438893   1.203481e-10  3.505839e-10
(Intercept):2      4.184759    0.05234618   79.943922   0.000000e+00 1.299833e-245
read               2.697959    0.61927743    4.356625   1.320835e-05  1.686815e-05
math               5.914596    0.70538721    8.384892   5.077232e-17  9.122434e-16
proggeneral      -12.714581   12.40856959   -1.024661   3.055230e-01  3.061517e-01
progvocational   -46.143271   13.70667208   -3.366482   7.613343e-04  8.361912e-04

我们可以通过拟合一个没有程序的模型并使用似然比检验来测试程序类型的整体显著性，如下所示：

> m2 <- vglm(apt ~ read + math, tobit(Upper = 800), data = dat) 
    > (p <- pchisq(2 * (logLik(m) - logLik(m2)), df = 2, lower.tail = FALSE))

结果如下：

 [1] 0.003155176

变量 prog 的统计显著性由 p 值等于0.0032表示。我们如下计算系数的上下 95%置信区间：

    > b <- coef(m)
    > se <- sqrt(diag(vcov(m)))
    > cbind(LL = b - qnorm(0.975) * se, UL = b + qnorm(0.975) * se)

结果如下：

 LL             UL
(Intercept):1      145.770767   273.348348
(Intercept):2        4.082163     4.287356
read                 1.484198     3.911721
math                 4.532062     7.297129
proggeneral        -37.034931    11.605768
progvocational     -73.007854   -19.278687

通过绘制残差图，我们可以评估绝对值以及相对值（皮尔逊值）和假设，如正态性和方差齐性。这将有助于检查模型和数据拟合。

我们还可能希望检查我们的模型与数据拟合得如何。一种方法是绘制残差图来评估它们的绝对值以及相对值（皮尔逊值）和假设，如正态性和方差齐性。使用以下命令：

    > dat$yhat <- fitted(m)[,1]
    > dat$rr <- resid(m, type = "response")
    > dat$rp <- resid(m, type = "pearson")[,1]
    > par(mfcol = c(2, 3))
    > with(dat, {
 plot(yhat, rr, main = "Fitted vs Residuals")
      qqnorm(rr)
      plot(yhat, rp, main = "Fitted vs Pearson Residuals")
      qqnorm(rp)
      plot(apt, rp, main = "Actual vs Pearson Residuals")
      plot(apt, yhat, main = "Actual vs Fitted")
    })

图表如下所示：

建立如下相关性：

> (r <- with(dat, cor(yhat, apt)))

结果如下：

[1] 0.7825

解释方差如下计算：

> r²

结果如下：

[1] 0.6123

预测值和观察值之间的相关系数为0.7825。如果我们平方这个值，我们得到多重平方相关系数，这表明预测值与apt共享 61.23%的方差。

泊松回归 - 理解加拉帕戈斯群岛中的物种

加拉帕戈斯群岛位于太平洋上，距离厄瓜多尔海岸约 1000 公里。群岛由 13 个岛屿组成，其中 5 个有人居住。岛屿生物多样，动植物资源丰富。科学家们仍然对这样一个物种多样的集合能在如此小且偏远的岛屿群中繁荣感到困惑。

准备工作

为了完成这个食谱，我们将使用物种数据集。第一步是收集数据。

第 1 步 - 收集和描述数据

我们将利用名为gala的物种数量数据集，该数据集可在github.com/burakbayramli/kod/blob/master/books/Practical_Regression_Anove_Using_R_Faraway/gala.txt找到。

数据集包括 30 个案例和七个变量。数据集中的七个数值测量包括以下内容：

• Species

• Endemics

• Area

• Elevation

• Nearest

• Scruz

• Adjcacent

如何做到这一点...

让我们深入了解细节。

第 2 步 - 探索数据

探索数据将有助于了解关系。首先导入名为 gala.txt 的 txt 数据文件。我们将如下将数据保存到 gala 数据框中：

> gala <- read.table("d:/gala.txt")

regpois() 给出的是从生态学角度预期可能重要的变量的泊松回归，如下所示：

> regpois <- glm( Species ~ Area + Elevation + Nearest, family=poisson, data=gala)

接下来提供数据的摘要如下：

> summary(regpois)

summary 函数将提供偏差残差、系数、signif 代码、零偏差、残差偏差、AIC 和 Fisher 分数迭代次数。结果如下：

Deviance residuals:
 Min          1Q      Median          3Q         Max
-17.1900     -6.1715     -2.7125      0.7063     21.4237

Coefficients:
 Estimate      Std. Error     z value      Pr(>|z|) 
(Intercept)    3.548e+00       3.933e-02      90.211       < 2e-16 *** 
Area          -5.529e-05        1.890e-05      -2.925       0.00344 ** 
Elevation      1.588e-03        5.040e-05      31.502        < 2e-16 ***
Nearest        5.921e-03       1.466e-03      4.039          5.38e-05 ***
---

Signif. codes:
 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

（泊松家族的离散参数取为 1）

Null deviance:
3510.7  on 29  degrees of freedom

Residual deviance:
1797.8  on 26  degrees of freedom

AIC:
1966.7

Fisher 分数迭代次数：

5
> plot(regpois$fit,gala$Species)

图表显示在以下截图上：

第 3 步 - 绘制数据和测试经验数据

ppois() 是参数为 lambda=regpois$fit 的泊松分布的分布函数，它在 gala$Species 中如下计算：

> p <- ppois(gala$Species,regpois$fit)

这些值在自然界中应该是接近均匀的。通过以下方式绘制值来检查均匀性：

> hist(p,breaks=10)

图形结果显示在截图上：

图表清楚地显示它们不是均匀的。

现在执行关于经验数据是否符合给定分布的 Kolmogorov-Smirnov 测试。

Kolmogorov-Smirnov 测试是拟合优度检验，它通常涉及检查来自某个未知分布的随机样本，以检验零假设，即未知分布函数实际上是一个已知、指定的函数。我们通常使用 Kolmogorov-Smirnov 测试来检查方差分析中的正态性假设。

Kolmogorov-Smirnov 测试被构建为一个统计假设检验。我们确定一个零假设，即，我们正在测试的两个样本来自相同的分布。然后我们寻找证据表明这个假设应该被拒绝，并以概率的形式表达这一点。如果样本来自不同分布的似然性超过我们要求的置信水平，那么原始假设将被拒绝，以支持假设，即，两个样本来自不同的分布。

要做到这一点，我们设计一个从样本计算出的单一数值，即一个统计量。技巧是找到一个统计量，其值域不依赖于我们不知道的事情，例如在这种情况下实际的潜在分布。

Kolmogorov-Smirnov 测试中的检验统计量非常简单；它只是两个样本的经验累积分布函数之间的最大垂直距离。一个样本的经验累积分布是样本值小于或等于给定值的比例。

一个样本 Kolmogorov-Smirnov 测试如下：

> ks.test(p,"punif")

结果如下：

One-sample Kolmogorov-Smirnov test
data:  p
D = 0.57731, p-value = 4.134e-09
alternative hypothesis: two-sided 

因此，我们可以安全地得出结论，该模型不足。

第 4 步 - 矫正泊松模型的离散化

由于泊松是离散的，现在进行更正。变化如下：

 p = 1/2*(F(Y)+F(Y-1)) 
 ; where Y are the data, 
 ; and F are the distribution functions coming from Poisson

对程序进行了更正，考虑了离散分布，如下所示：

> p <- 0.5*(ppois(gala$Species,regpois$fit) + ppois(gala$Species-1,regpois$fit))

按如下方式绘制值以检查均匀性：

> hist(p,breaks=10)

图形结果如下所示：

更正并没有带来太大的变化。图清楚地显示它们并不均匀。

现在，让我们再次进行 Kolmogorov-Smirnov 测试，以验证经验数据是否适合给定的分布，如下所示：

> ks.test(p,"punif")

结果如下：

 One-sample Kolmogorov-Smirnov test
data:  p
D = 0.58571, p-value = 2.3e-09
alternative hypothesis: two-sided

第 5 步 - 使用链接函数训练和评估模型

我们将看到如何使用glm( )函数来拟合广义线性模型：

> regpois2 <- glm( Species ~ Area + Elevation + Nearest, family=poisson(link=sqrt), data=gala)

按如下方式打印regpois2的结果：

> summary(regpois2)

结果如下：

Call:
glm(formula = Species ~ Area + Elevation + Nearest, family = poisson(link = sqrt), 
 data = gala)
Deviance Residuals: 
 Min         1Q       Median         3Q          Max 
-19.108     -5.129     -1.335      1.846       16.918 
Coefficients:
 Estimate   Std. Error   z value     Pr(>|z|) 
(Intercept)    4.1764222    0.1446592    28.871    < 2e-16 ***
Area          -0.0004844    0.0001655    -2.926      0.00343 ** 
Elevation      0.0110143    0.0003372    32.664    < 2e-16 ***
Nearest        0.0083908    0.0065858     1.274      0.20264 
---
Signif. codes:    0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for poisson family taken to be 1)
Null deviance:   3510.7 on 29 degrees of freedom
Residual deviance:   1377.5 on 26 degrees of freedom
AIC: 1546.3
Number of Fisher Scoring iterations: 5

第 6 步 - 使用泊松模型重新评估

对程序进行了更正，考虑了离散分布，如下所示：

> p2 <- 0.5*(ppois(gala$Species,regpois2$fit) + ppois(gala$Species-1,regpois2$fit)) 

按如下方式绘制值以检查均匀性：

> hist(p,breaks=10)

图形结果如下所示：

再次进行 Kolmogorov-Smirnov 测试，以验证经验数据是否适合给定的分布，如下所示：

> ks.test(p2,"punif")

按如下方式执行一个样本 Kolmogorov-Smirnov 测试：

data:  p2
D = 0.47262, p-value = 3.023e-06
alternative hypothesis: two-sided

结果仍然没有通过测试。

第 7 步 - 使用线性模型重新评估

应用常规线性模型：lm()函数用于拟合线性模型。它可以用于执行回归、单层方差分析和协方差分析（尽管[aov](https://stat.ethz.ch/R-manual/R-devel/library/stats/html/aov.html)可能为这些操作提供更方便的界面）。reg数据框用于存储lm()函数返回的结果，如下所示：

> reg <- lm(Species ~ Area+Elevation+Nearest, data=gala)

现在让我们使用以下命令查看reg数据框的结果：

> summary(reg)

结果如下：

Call:
lm(formula = Species ~ Area + Elevation + Nearest, data = gala)
Residuals:
 Min         1Q       Median         3Q          Max 
-191.856    -33.111    -18.626      5.673      262.209 
Coefficients:
 Estimate   Std. Error   t value     Pr(>|t|) 
(Intercept)   16.46471     23.38884     0.704      0.48772 
Area           0.01908      0.02676     0.713      0.48216 
Elevation      0.17134      0.05452     3.143      0.00415 **
Nearest        0.07123      1.06481     0.067      0.94718 
---
Signif. codes:    0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error:   80.84 on 26 degrees of freedom
Multiple R-squared:      0.5541,  Adjusted R-squared:  0.5027 
F-statistic:       10.77 on 3 and 26 DF,  p-value: 8.817e-05

现在，让我们按如下方式绘制reg数据框：

> plot(reg)

残差与拟合图如下所示：

正态 Q-Q 线性模型图如下截图所示：

尺度-位置线性模型图如下所示：

现在让我们使用以下平方根函数进行转换。reg2数据框用于存储lm函数返回的结果：

> reg2 <- lm(sqrt(Species) ~ Area+Elevation+Nearest, data=gala)

让我们按照以下步骤查看reg数据框的结果：

> summary(reg2)

结果如下：

Call:
lm(formula = sqrt(Species) ~ Area + Elevation + Nearest, data = gala)
Residuals:
 Min          1Q      Median        3Q         Max 
-8.8057   -2.1775   -0.2086    1.3943    8.8730 
Coefficients:
 Estimate   Std. Error   t value     Pr(>|t|) 
(Intercept)    3.744e+00    1.072e+00     3.492     0.001729 ** 
Area          -2.253e-05    1.227e-03    -0.018     0.985485 
Elevation      9.795e-03    2.499e-03     3.920 0\.  000576 ***
Nearest        2.002e-02    4.880e-02     0.410     0.685062 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error:   3.705 on 26 degrees of freedom
Multiple R-squared:    0.5799,  Adjusted R-squared:  0.5315 
F-statistic:     11.96 on 3 and 26 DF,  p-value: 4.144e-05

现在让我们按照以下步骤绘制reg2数据框：

> plot(reg2)

残差与拟合值图如下所示：

正态 Q-Q线性模型图如下所示：

泊松回归的尺度-位置线性模型图如下截图所示：

尺度-位置线性模型图如下所示：

让我们进行 Shapiro 测试。给定一个包含 n 个实值观测值的样本 X1, ..., Xn，Shapiro-Wilk 测试（Shapiro 和 Wilk，1965）是对复合假设的检验，即数据是独立同分布（独立且同分布）且正态分布的，即对于某些未知的实数µ和某些σ > 0，N(µ, σ2)。使用以下命令：

> shapiro.test(reg2$res)

结果如下：

Shapiro-Wilk normality test
data:  reg2$res
W = 0.9633, p-value = 0.375

现在让我们使用对数函数进行以下转换。

reg3数据框用于存储lm()函数返回的结果如下：

> reg3 <- lm(log(Species) ~ Area+Elevation+Nearest, data=gala)

现在让我们按照以下步骤查看reg3数据框的结果：

> summary(reg3)

结果如下：

Call:
lm(formula = log(Species) ~ Area + Elevation + Nearest, data = gala)
Residuals: 
 Min        1Q      Median        3Q         Max 
-2.0739   -0.5161    0.3307    0.7472    1.6271 
Coefficients:
 Estimate   Std. Error   t value     Pr(>|t|) 
(Intercept)    2.3724325    0.3448586     6.879     2.65e-07 ***
Area          -0.0002687    0.0003946    -0.681    0.50197 
Elevation      0.0029096    0.0008039     3.620      0.00125 ** 
Nearest        0.0133869    0.0157001     0.853      0.40163 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error:   1.192 on 26 degrees of freedom
Multiple R-squared:      0.4789,  Adjusted R-squared:  0.4187 
F-statistic:       7.964 on 3 and 26 DF,  p-value: 0.0006281

现在让我们按照以下步骤绘制reg3数据框：

> plot(reg3)

残差与拟合值图如下所示：

正态 Q-Q线性模型图如下所示：

尺度-位置线性模型图如下所示：

让我们按照以下步骤进行 Shapiro 测试：

> shapiro.test(reg3$res)

结果如下：

Shapiro-Wilk normality test
data:  reg3$res
W = 0.91925, p-value = 0.02565

第三章。聚类

在本章中，我们将介绍以下内容：

• 层次聚类 - 世界银行

• 层次聚类 - 1999-2010 年间亚马逊雨林火灾

• 层次聚类 - 基因聚类

• 二元聚类 - 数学测试

• K-means 聚类 - 欧洲国家蛋白质消耗

• K-means 聚类 - 食品

简介

层次聚类：在无监督学习中，层次聚类是其中最重要的方法之一。在层次聚类中，对于一组给定的数据点，输出以二叉树（树状图）的形式呈现。在二叉树中，叶子代表数据点，而内部节点代表各种大小的嵌套簇。每个对象被分配到一个单独的簇。所有簇的评估基于成对距离矩阵。距离矩阵将使用距离值构建。必须考虑距离最短的簇对。然后应从矩阵中删除已识别的这对簇并将它们合并。合并后的簇与其它簇的距离必须被评估，距离矩阵应更新。这个过程需要重复进行，直到距离矩阵减少到单个元素。

层次聚类产生对象的排序。这有助于信息数据的展示。产生的较小簇有助于信息的发现。层次聚类的缺点是，如果对象在早期阶段被错误地分组，那么没有提供对象重新定位的方案。使用不同的距离度量来衡量簇之间的距离可能会导致生成不同的结果。

K-means 聚类：K-means 聚类算法是一种估计 K 组均值（向量）的方法。K-means 聚类方法本质上是无监督的、非确定性的和迭代的。该方法产生特定数量的不相交的、平坦的（非层次）簇。K 表示簇的数量。这些簇基于现有数据。每个簇至少有一个数据点。簇在本质上是非重叠和非层次化的。数据集被划分为 K 个簇。数据点随机分配到每个簇中。这导致数据点在簇中的早期阶段几乎均匀分布。如果一个数据点最接近其自己的簇，则不会改变。如果一个数据点不接近其自己的簇，则将其移动到最接近的簇。对于所有数据点重复这些步骤，直到没有数据点从一个簇移动到另一个簇。在这个时候，簇稳定下来，聚类过程结束。初始分区和选择的选择可以极大地影响最终簇的结果，包括簇间和簇内距离以及凝聚力。

K-means 聚类的优点是，与层次聚类相比，它在计算上相对节省时间。主要挑战是确定簇的数量有困难。

层次聚类 - 世界银行样本数据集

世界银行成立的主要目标之一是抗击和消除贫困。在不断变化的世界中持续发展和微调其政策，一直帮助该机构实现消除贫困的目标。消除贫困的成功指标是以改善健康、教育、卫生、基础设施和其他改善贫困人民生活的服务中的每个参数来衡量的。确保目标必须以环境、社会和经济可持续的方式追求的发展收益。

准备工作

为了执行层次聚类，我们将使用来自世界银行数据集收集的数据集。

步骤 1 - 收集和描述数据

应使用标题为WBClust2013的数据集。该数据集以WBClust2013.csv为标题的 CSV 格式提供。数据集是标准格式。有 80 行数据和 14 个变量。数值变量包括：

• new.forest

• Rural

• log.CO2

• log.GNI

• log.Energy.2011

• LifeExp

• Fertility

• InfMort

• log.Exports

• log.Imports

• CellPhone

• RuralWater

• Pop

非数值变量是：

• Country

如何操作...

让我们深入了解。

步骤 2 - 探索数据

注意

版本信息：本页面的代码在 R 版本 3.2.3（2015-12-10）中进行了测试

让我们探索数据并了解变量之间的关系。我们将从导入名为WBClust2013.csv的 CSV 文件开始。我们将数据保存到wbclust数据框中：

> wbclust=read.csv("d:/WBClust2013.csv",header=T)

接下来，我们将打印wbclust数据框。head()函数返回wbclust数据框。将wbclust数据框作为输入参数传递：

> head(wbclust)

结果如下：

步骤 3 - 转换数据

将变量居中并创建 z 分数是两种常见的数据分析活动，用于标准化数据。上述提到的数值变量需要创建 z 分数。scale()函数是一个通用函数，其默认方法是对数值矩阵的列进行居中或缩放。数据框wbclust被传递给scale函数。只有数值字段被考虑。结果存储在另一个数据框wbnorm中。

 > wbnorm <- scale(wbclust[,2:13])
 > wbnorm

结果如下：

所有数据框都有一个rownames属性。为了检索或设置类似矩阵的对象的行或列名，使用rownames()函数。将具有第一列的数据框wbclust传递给rownames()函数。

 > rownames(wbnorm)=wbclust[,1]
 > rownames(wbnorm)

函数调用rownames(wbnorm)的结果是显示第一列的值。结果如下：

第 4 步 - 训练和评估模型性能

下一步是训练模型。第一步是计算距离矩阵。使用 dist() 函数。使用指定的距离度量，计算数据矩阵行之间的距离。使用的距离度量可以是欧几里得、最大、曼哈顿、Canberra、二进制或闵可夫斯基。使用的距离度量是欧几里得。欧几里得距离计算两个向量之间的距离为 sqrt(sum((x_i - y_i)²))。然后将结果存储在一个新的数据框中，dist1。

> dist1 <- dist(wbnorm, method="euclidean")

下一步是使用 Ward 方法进行聚类。使用 hclust() 函数。为了对一个由 n 个对象的相似性集合进行聚类分析，使用 hclust() 函数。在第一阶段，每个对象被分配到它自己的聚类中。之后，在每一阶段，算法迭代并合并两个最相似的聚类。这个过程一直持续到只剩下一个聚类。hclust() 函数要求我们以距离矩阵的形式提供数据。dist1 数据框被传递。默认情况下，使用完全链接方法。有多个聚合方法可以使用，其中一些可能是 ward.D、ward.D2、single、complete 和 average。

 > clust1 <- hclust(dist1,method="ward.D")
 > clust1

函数 clust1 的调用结果显示了使用的聚合方法、距离计算的方式以及对象的数量。结果如下：

第 5 步 - 绘制模型

plot() 函数是一个用于绘制 R 对象的通用函数。在这里，plot() 函数用于绘制树状图：

> plot(clust1,labels= wbclust$Country, cex=0.7, xlab="",ylab="Distance",main="Clustering for 80 Most Populous Countries")

结果如下：

rect.hclust() 函数突出显示聚类并在树状图的分支周围绘制矩形。首先在某个级别上切割树状图，然后围绕选定的分支绘制矩形。

将对象 clust1 作为对象传递给函数，并指定要形成的聚类数量：

> rect.hclust(clust1,k=5)

结果如下：

cuts() 函数应根据所需的组数或切割高度将树切割成多个组。在这里，将 clust1 作为对象传递给函数，并指定所需的组数：

 > cuts=cutree(clust1,k=5)
 > cuts

结果如下：

获取每个组的国家列表：

for (i in 1:5){
 print(paste("Countries in Cluster ",i))
 print(wbclust$Country[cuts==i])
 print (" ")
}

结果如下：

层次聚类 - 亚马逊雨林在 1999-2010 年间被烧毁

在 1999-2010 年之间，亚马逊雨林有 33,000 平方英里（85,500 平方公里），即 2.8%被烧毁。这是 NASA 领导的研究发现。研究的主要目的是测量森林冠层下火灾的蔓延程度。研究发现，燃烧的森林破坏的面积比农业和牧场清理森林土地时大得多。然而，无法在火灾和森林砍伐之间建立相关性。

关于火灾与森林砍伐之间无相关性的查询答案在于 NASA 的 Aqua 卫星上搭载的大气红外探测器（AIRS）仪器收集的湿度数据。火灾频率与夜间低湿度相吻合，这使得低强度地表火灾得以持续燃烧。

准备工作

为了执行层次聚类，我们将使用收集于亚马逊雨林的 dataset，该雨林从 1999 年至 2010 年发生火灾。

第 1 步 - 收集和描述数据

将使用NASAUnderstory数据集。该数据集以 CSV 格式作为NASAUnderstory.csv提供。数据集是标准格式。有 64 行数据，32 个变量。数值变量是：

• PlotID

• SPHA

• BLIT

• ASMA

• MOSS

• LEGR

• CHCA

• GRAS

• SEDG

• SMTR

• PTAQ

• COCA

• VAAN

• GAHI

• ARNU

• LYOB

• PIMA

• RUBU

• VAOX

• ACSP

• COCO

• ACRU

• TRBO

• MACA

• CLOB

• STRO

• FUNG

• DILO

• ERIO

• GATR

非数值变量是：

• Overstory Species

• 标签

如何做...

让我们深入了解。

第 2 步 - 探索数据

注意

版本信息：本页面的代码在 R 版本 3.2.3（2015-12-10）上进行了测试。

让我们探索数据并了解变量之间的关系。我们将从导入名为NASAUnderstory.csv的文件开始。我们将把数据保存到NASA数据框中：

> NASA = read.csv("d:/NASAU   nderstory.csv",header=T)

接下来，我们将获取每个物种列标签的长版本：

 *>* NASA.lab=NASA$Labels

接下来，我们将打印NASA.lab数据框。它包含每个物种的完整名称，如所获得。

结果如下：

接下来，我们将整个数据内容传递到NASA数据框中：

> NASA=NASA[,-32]

打印NASA数据框将显示整个数据内容。

> NASA

结果如下：

第 3 步 - 转换数据

接下来，将执行数据标准化。scale()函数将中心化和缩放前面提到的所有数值变量的列：

> NASAscale <- scale(NASA[,3:31])

这将缩放NASA数据框中第3列到第31列之间的所有数值。

打印NASAscale数据框将显示所有缩放和居中的NASAscale值。

> NASAscale

结果如下：

为了将向量编码为因子，使用 factor 函数。如果 ordered 参数为 TRUE，则假设因子级别是有序的。在这里，我们将 OverstorySpecies 列作为值传递给因子函数：

> rownames(NASAscale)=as.factor(NASA$Overstory.Species) 

as.factor() 返回一个具有行名的数据框。

打印数据框 rownames(NASAscale) 会显示 OverstorySpecies 列的所有值：

> rownames(NASAscale)

结果如下：

步骤 4 - 训练和评估模型性能

下一步是训练模型。第一步是计算距离矩阵。使用 dist() 函数。该函数使用指定的距离度量来计算数据矩阵行之间的距离。使用的距离度量可以是欧几里得、最大、曼哈顿、Canberra、二元或 Minkowski。使用的距离度量是欧几里得。欧几里得距离计算两个向量之间的距离为 sqrt(sum((x_i - y_i)²))。然后将结果存储在一个新的数据框 dist1 中。

> dist1 <- dist(NASAscale, method="euclidean")

下一步是使用 Ward 方法进行聚类。使用 hclust() 函数。为了对一个由 n 个对象的相似性集合进行聚类分析，使用 hclust() 函数。在第一阶段，每个对象被分配到它自己的聚类中。然后算法在每个阶段迭代地连接两个最相似的聚类。这个过程一直持续到只剩下一个聚类为止。hclust() 函数需要我们以距离矩阵的形式提供数据。dist1 数据框被传递。默认情况下，使用完全连接方法。可以使用多种聚合方法，其中一些可能是 ward.D、ward.D2、single、complete 和 average。

 > clust1 <- hclust(dist1,method="ward.D")
 > clust1

函数调用 clust1 会显示所使用的聚合方法、计算距离的方式以及对象的数量。结果如下：

步骤 5 - 绘制模型

plot() 函数是 R 对象的通用绘图函数。在这里，使用 plot() 函数绘制树状图：

> plot(clust1,labels= NASA[,2], cex=0.5, xlab="",ylab="Distance",main="Clustering for NASA Understory Data")

结果如下：

rect.hclust() 函数突出显示聚类并在树状图的分支周围绘制矩形。首先在某个级别上切割树状图，然后围绕选定的分支绘制矩形。

将对象 clust1 作为对象传递给函数，并指定要形成的聚类数量：

> rect.hclust(clust1,k=2)

结果如下：

cuts() 函数根据所需的组数或切割高度将树切割成多个组。在这里，将 clust1 作为对象传递给函数，并指定所需的组数：

 > cuts=cutree(clust1,k=2)
 > cuts

结果如下：

步骤 6 - 提高模型性能

首先需要加载以下包：

> library(vegan)

vegan 库主要被群落和植被生态学家使用。它包含排序方法、多样性分析和其他功能。一些流行的工具包括多样性分析、物种丰度模型、物种丰富度分析、相似性分析等等。

下一步是使用距离方法 jaccard 训练以提高模型。第一步是计算距离矩阵。使用 vegdist() 函数。该函数计算成对距离。然后将结果存储在一个新的数据框 dist1 中。jaccard 系数衡量有限样本集之间的相似性。这是通过将交集的大小除以并集的大小来计算的：

> dist1 <- vegdist(NASA[,3:31], method="jaccard", upper=T)

下一步是使用 Ward 方法进行聚类。使用 hclust() 函数：

 > clust1 <- hclust(dist1,method="ward.D")
 > clust1

调用 clust1 函数会导致显示所使用的聚类方法、计算距离的方式以及对象的数量。结果如下：

plot() 函数是 R 对象绘图的通用函数：

> plot(clust1,labels= NASA[,2], cex=0.5, xlab="",ylab="Distance",main="Clustering for NASA Understory Data")

将 clust1 数据框作为对象传递给函数。cex 提供了相对于默认值的文本和符号放大数值。

结果如下：

将对象 clust1 和要形成的聚类数量一起传递给函数：

> rect.hclust(clust1,k=2)

结果如下：

cuts() 函数应根据所需的组数或切割高度将树切割成多个组：

 > cuts=cutree(clust1,k=2)
 > cuts

结果如下：

使用主成分分析使我们能够绘制两个聚类解决方案。

clusplot() 函数应绘制二维聚类图。在此，将 NASA 数据框作为对象传递。

结果如下：

使用判别函数使我们能够绘制两个聚类解决方案。

plotcluster() 函数使用投影方法进行绘图，以区分给定的类别。各种投影方法包括经典判别坐标、投影均值和协方差结构差异的方法、非对称方法（将同质类与异质类分离）、基于局部邻域的方法以及基于鲁棒协方差矩阵的方法。

clusplot() 函数应绘制二维聚类图。在此，将 NASA 数据框作为对象传递：

> clusplot(NASA, cuts, color=TRUE, shade=TRUE, labels=2, lines=0,  main="NASA Two Cluster  Plot, Ward's Method, First two PC")

结果如下：

接下来，使用t()函数对NASAscale数据框进行转置：

 > library(fpc)
 > NASAtrans=t(NASAscale)

下一步是使用 Minkowski 距离方法通过训练来提高模型。第一步是计算距离矩阵。使用dist()函数。

Minkowski 距离常用于变量在具有绝对零值的比率尺度上测量时。

 > dist1 <- dist(NASAtrans, method="minkowski", p=3) 

下一步是使用 Ward 方法进行聚类分析。使用hclust()函数。

 > clust1 <- hclust(dist1,method="ward.D")
 > clust1

调用clust1函数将显示所使用的聚合方法、计算距离的方式以及对象的数量。结果如下：

plot()函数是 R 对象绘图的通用函数。在这里，plot()函数用于绘制树状图：

> plot(clust1,labels= NASA.lab[1:29], cex=1, xlab="",ylab="Distance",main="Clustering for NASA Understory Data")

结果如下：

rect.hclust()函数将在树状图的分支周围绘制矩形，突出相应的簇。首先，在某个级别上切割树状图，然后围绕选定的分支绘制矩形。

将clust1对象作为对象传递给函数，同时指定要形成的簇数：

> rect.hclust(clust1,k=3)

结果如下：

cuts()函数将根据所需的组数或切割高度将树切割成多个组。在这里，将clust1对象作为对象传递给函数，同时指定所需的组数：

 > cuts=cutree(clust1,k=3)
 > cuts

结果如下：

层次聚类 - 基因聚类

收集全基因组表达数据的能力是一项计算上复杂的任务。人类大脑由于其局限性无法解决这个问题。然而，通过将基因细分为更少的类别，然后进行分析，可以将数据细化到易于理解的水平。

聚类分析的目标是以一种方式细分一组基因，使得相似的项目落在同一个簇中，而不相似的项目落在不同的簇中。需要考虑的重要问题是关于相似性和对已聚类的项目的使用决策。在这里，我们将探索使用两种基因型的光感受器时间序列对基因和样本进行聚类。

准备中

为了执行层次聚类，我们将使用在老鼠身上收集的数据集。

第 1 步 - 收集和描述数据

将使用标题为GSE4051_data和GSE4051_design的数据集。这些数据集以GSE4051_data.csv和GSE4051_design.csv的 CSV 格式提供。数据集是标准格式。

在GSE4051_data中，有 29,949 行数据以及 39 个变量。数值变量包括：

• Sample_21

• Sample_22

• Sample_23

• Sample_16

• Sample_17

• Sample_6

• Sample_24

• Sample_25

• Sample_26

• Sample_27

• Sample_14

• Sample_3

• Sample_5

• Sample_8

• Sample_28

• Sample_29

• Sample_30

• Sample_31

• Sample_1

• Sample_10

• Sample_4

• Sample_7

• Sample_32

• Sample_33

• Sample_34

• Sample_35

• Sample_13

• Sample_15

• Sample_18

• Sample_19

• Sample_36

• Sample_37

• Sample_38

• Sample_39

• Sample_11

• Sample_12

• Sample_2

• Sample_9

在GSE4051_design数据集中有 39 行数据 和 4 个变量。数值变量是：

• sidNum

非数值变量是：

• sidChar

• devStage

• gType

如何操作...

让我们深入了解。

第 2 步 - 探索数据

注意

版本信息：本页面的代码在 R 版本 3.2.3（2015-12-10）中进行了测试

The RColorBrewer package is an R package from colorbrewer2.org  and provides color schemes for maps and other graphics.

The pvclust package is used for assessing uncertainty in hierarchical cluster analysis. In hierarchical clustering, each of the clusters calculates p-values via multi-scale bootstrap resampling. The p-value of a cluster is measured between 0 and 1. There are two types of p-value available: approximately unbiased (AU) and bootstrap probability (BP) value. The AU p-value is calculated using the multi-scale bootstrap resampling method, while the ordinary bootstrap resampling method is used to calculate the BP p-value. The AU p-value has superiority bias compared to the BP p-value.

LaTeX 格式的表格由xtable包生成。使用xtable，可以将特定包的 R 对象转换为xtables。然后，这些xtables可以以 LaTeX 或 HTML 格式输出。

The plyr package is used as a tool for carrying out split-apply-combine (SAC) procedures. It breaks a big problem down into manageable pieces, operates on each piece, and then puts all the pieces back together.

The following packages must be loaded:

 > library(RColorBrewer)
 > library(cluster)
 > library(pvclust)
 > library(xtable)
 > library(plyr)

让我们探索数据并了解变量之间的关系。我们将从导入名为GSE4051_data.csv的 CSV 文件开始。我们将数据保存到GSE4051_data数据框中：

> GSE4051_data =read.csv("d:/ GSE4051_data.csv",header=T)

接下来，我们将打印关于GSE4051_data数据框的信息。str()函数返回关于GSE4051_data数据框结构的信息。它紧凑地显示GSE4051_data数据框的内部结构。max.level表示用于显示嵌套结构的最大嵌套级别：

> str(GSE4051_data, max.level = 0) 

结果如下：

接下来，我们将导入名为GSE4051_design.csv的 CSV 文件。我们将数据保存到GSE4051_design数据框中：

> GSE4051_design =read.csv("d:/ GSE4051_design.csv",header=T)

前一行打印了GSE4051_design数据框的内部结构。

结果如下：

第 3 步 - 转换数据

为了便于后续的可视化，对行进行了缩放。由于当前所需的基因表达之间的绝对差异，因此执行了行的缩放。

变量中心化和创建 z 分数是两种常见的数据分析活动。scale函数对数值矩阵的列进行中心化和/或缩放。

转置矩阵。将GSE4051_data数据框传递以进行数据框的转置：

> trans_GSE4051_data <- t(scale(t(GSE4051_data)))

接下来，我们将打印有关GSE4051_data数据框的信息。使用give.attr = FALSE，不显示属性作为子结构。

> str(trans_GSE4051_data, max.level = 0, give.attr = FALSE)

结果如下：

head()函数返回向量、矩阵、表格、数据框或函数的第一部分。GSE4051_data和trans_GSE4051_data数据框作为对象传递。rowMeans()函数计算行的平均值。data.frame()函数创建数据框，它们是紧密耦合的变量集合，并共享许多矩阵的性质：

 > round(data.frame(avgBefore = rowMeans(head(GSE4051_data)), 
avgAfter = rowMeans(head(trans_GSE4051_data)), 
varBefore = apply(head(GSE4051_data), 1, var), 
                      varAfter = apply(head(trans_GSE4051_data),                      1, var)), 2)

结果如下：

步骤 4 - 训练模型

下一步是训练模型。第一步是计算距离矩阵。使用dist()函数。该函数使用指定的距离度量来计算数据矩阵行之间的距离。使用的距离度量可以是欧几里得、最大值、曼哈顿、Canberra、二元或闵可夫斯基。使用的距离度量是欧几里得。欧几里得距离计算两个向量之间的距离为sqrt(sum((x_i - y_i)²))。使用转置的trans_GSE4051_data数据框来计算距离。然后将结果存储在pair_dist_GSE4051_data数据框中。

> pair_dist_GSE4051_data <- dist(t(trans_GSE4051_data), method = 'euclidean')

接下来，使用interaction()函数，该函数计算并返回一个包含gType、devStage变量交互作用的未排序因子。未排序因子的结果与数据框GSE4051_design一起传递给with()函数，从而创建一个表示gType、devStage变量交互作用的新因子：

> GSE4051_design$group <- with(GSE4051_design, interaction(gType, devStage))

使用summary()函数来生成数据框GSE4051_design$group的结果摘要：

> summary(GSE4051_design$group)

结果如下：

接下来，执行使用各种连接类型的层次聚类计算。

使用hclust()函数。为了对n个对象的相似性集进行聚类分析，使用hclust()函数。在第一阶段，每个对象被分配到它自己的簇中。然后算法在每个阶段迭代地连接两个最相似的簇。这个过程一直持续到只剩下一个簇为止。hclust()函数需要我们以距离矩阵的形式提供数据。pair_dist_GSE4051_data数据框被传递。

聚合法single作为第一种情况使用：

> pr.hc.single <- hclust(pair_dist_GSE4051_data, method = 'single')

调用pr.hc.single会导致显示使用的聚合法、距离计算方式以及对象的数量：

> pr.hc.single

结果如下：

聚类方法 complete 被用作第二个案例：

> pr.hc.complete <- hclust(pair_dist_GSE4051_data, method = 'complete')

调用 pr.hc.complete 将显示所使用的聚类方法、计算距离的方式以及对象的数量：

> pr.hc.complete

结果如下：

聚类方法 average 被用作第三个案例：

> pr.hc.average <- hclust(pair_dist_GSE4051_data, method = 'average')

调用 pr.hc.average 将显示所使用的聚类方法、计算距离的方式以及对象的数量：

> pr.hc.average

结果如下：

聚类方法 ward 被用作第四个案例：

> pr.hc.ward <- hclust(pair_dist_GSE4051_data, method = 'ward.D2')

调用 pr.hc.ward 将显示所使用的聚类方法、计算距离的方式以及对象的数量：

> pr.hc.ward

结果如下：

> op <- par(mar = c(0,4,4,2), mfrow = c(2,2))

plot() 函数是用于绘制 R 对象的通用函数。

第一次调用 plot() 函数时，将 pr.hc.single 数据框作为对象传递：

> plot(pr.hc.single, labels = FALSE, main = "Single Linkage Representation", xlab = "")

结果如下：

第二次调用 plot() 函数时，将 pr.hc.complete 数据框作为对象传递：

> plot(pr.hc.complete, labels = FALSE, main = "Complete Linkage Representation", xlab = "")

结果如下：

第三次调用 plot() 函数时，将 pr.hc.average 数据框作为对象传递：

> plot(pr.hc.average, labels = FALSE, main = "Average Linkage Representation", xlab = "")

结果如下：

第四次调用 plot() 函数时，将 pr.hc.ward 数据框作为对象传递：

> plot(pr.hc.ward, labels = FALSE, main = "Ward Linkage Representation", xlab = "")

结果如下：

 > par(op)
 > op <- par(mar = c(1,4,4,1))

步骤 5 - 绘制模型

plot() 函数是用于绘制 R 对象的通用函数。在这里，plot() 函数被用来绘制树状图。

rect.hclust() 函数应在树状图的分支周围绘制矩形，突出显示相应的聚类。首先在某个级别上切割树状图，然后围绕选定的分支绘制矩形。

RColorBrewer 使用 colorbrewer2.org/ 上的工作来为 R 中的图形选择合理的颜色方案。

颜色被分为三个组：

• 顺序：低数据--浅色；高数据--深色

• 分离：中间范围数据--浅色；低和高范围数据--对比深色

• 定性：颜色被设计用来突出显示类别之间的最大视觉差异

RColorBrewer 的重要功能之一是 brewer.pal()。此函数允许用户通过传递颜色数量和调色板名称来从 display.brewer.all() 函数中选择。

作为第一个案例，pr.hc.single 被作为对象传递给 plot() 函数：

 > plot(pr.hc.single, labels = GSE4051_design$group, cex = 0.6, main = "Single Hierarchical Cluster - 10 clusters")
 > rect.hclust(clust1,k=5)

结果如下：

接下来，我们使用 single 聚类方法创建热图。默认情况下，heatmap() 函数使用聚类方法 euclidean：

     > par(op)
     > jGraysFun <- colorRampPalette(brewer.pal(n = 9, "Blues"))
     > gTypeCols <- brewer.pal(9, "Spectral")[c(4,7)]
     > heatmap(as.matrix(trans_GSE4051_data), Rowv = NA, col = jGraysFun(256), hclustfun = function(x) hclust(x, method = 'single'),
scale = "none", labCol = GSE4051_design$group, labRow = NA, margins = c(8,1), 
 ColSideColor = gTypeCols[unclass(GSE4051_design$gType)])
     > legend("topright", legend = levels(GSE4051_design$gType), col = gTypeCols, lty = 1, lwd = 5, cex = 0.5)

结果如下：

作为第二个案例，pr.hc.complete 作为对象传递给 plot() 函数：

 > plot(pr.hc.complete, labels = GSE4051_design$group, cex = 0.6, main = "Complete Hierarchical Cluster - 10 clusters")
 > rect.hclust(pr.hc.complete, k = 10)

结果如下：

接下来，我们使用 complete 聚类方法创建热图。

    > par(op)
    > jGraysFun <- colorRampPalette(brewer.pal(n = 9, "Greens"))
    > gTypeCols <- brewer.pal(11, "PRGn")[c(4,7)]
> heatmap(as.matrix(trans_GSE4051_data), Rowv = NA, col = jGraysFun(256), hclustfun = function(x) hclust(x, method = 'complete'), 
 scale = "none", labCol = GSE4051_design$group, labRow = NA, margins = c(8,1),
 ColSideColor = gTypeCols[unclass(GSE4051_design$gType)])
    > legend("topright", legend = levels(GSE4051_design$gType), col = gTypeCols, lty = 1, lwd = 5, cex = 0.5)

结果如下：

作为第三个案例，pr.hc.average 作为对象传递给 plot() 函数：

 > plot(pr.hc.average, labels = GSE4051_design$group, cex = 0.6, main = "Average Hierarchical Cluster - 10 clusters")
 > rect.hclust(pr.hc.average, k = 10)

结果如下：

接下来，我们使用 average 聚类方法创建热图：

    > jGraysFun <- colorRampPalette(brewer.pal(n = 9, "Oranges"))
    > gTypeCols <- brewer.pal(9, "Oranges")[c(4,7)]
> heatmap(as.matrix(trans_GSE4051_data), Rowv = NA, col = jGraysFun(256), hclustfun = function(x) hclust(x, method = 'average'), 
scale = "none", labCol = GSE4051_design$group, labRow = NA, margins = c(8,1), 
 ColSideColor = gTypeCols[unclass(GSE4051_design$gType)])
    > legend("topright", legend = levels(GSE4051_design$gType), col = gTypeCols, lty = 1, lwd = 5, cex = 0.5)

结果如下：

作为第四个案例，pr.hc.ward 作为对象传递给 plot() 函数：

 > plot(pr.hc.ward, labels = GSE4051_design$group, cex = 0.6, main = "Ward Hierarchical Cluster - 10 clusters")
 > rect.hclust(pr.hc.ward, k = 10)

结果如下：

接下来，我们使用 ward 聚类方法创建热图：

 > jGraysFun <- colorRampPalette(brewer.pal(n = 9, "Reds")) 
 > gTypeCols <- brewer.pal(9, "Reds")[c(4,7)] 
 > heatmap(as.matrix(trans_GSE4051_data), Rowv = NA, col = jGraysFun(256), hclustfun = function(x) hclust(x, method = 'ward.D2'), 
 scale = "none", labCol = GSE4051_design$group, labRow = NA, margins = c(8,1), 
 ColSideColor = gTypeCols[unclass(GSE4051_design$gType)]) 
 > legend("topright", legend = levels(GSE4051_design$gType), col = gTypeCols, lty = 1, lwd = 5, cex = 0.5)

结果如下：

二元聚类 - 数学测试

在教育体系中，测试和考试是主要特征。考试系统的优势在于它可以作为区分表现好与差的一种方式。考试系统使学生有责任提升到下一个标准，他们应该参加并通过考试。它使学生有责任定期学习。考试系统使学生为应对未来的挑战做好准备。它帮助他们分析原因，并在固定时间内有效地传达他们的想法。另一方面，也注意到一些缺点，如学习慢的学生在测试中表现不佳，这会在学生中造成低劣的复杂性。

准备工作

为了执行二元聚类，我们将使用在数学测试中收集的数据集。

步骤 1 - 收集和描述数据

将使用标题为 math test 的数据集。该数据集以 math test.txt 的 TXT 格式提供。数据集是标准格式。有 60 行数据。有 60 列。列是 55 名男生的项目得分。

如何操作...

让我们深入了解。

步骤 2 - 探索数据

注意

版本信息：本页面的代码在 R 版本 3.2.3（2015-12-10）上进行了测试。

让我们探索数据并了解变量之间的关系。我们将从导入名为 ACT math test.txt 的 TXT 文件开始。我们将数据保存到 Mathtest 数据框中：

> Mathtest = read.table("d:/math test.txt",header=T)

步骤 3 - 训练和评估模型性能

接下来，我们将对项目进行聚类。根据学生的分数，将项目分组在一起。

首先，我们将根据平方欧几里得距离计算总的不匹配数。

调用 dist() 函数。将 Mathtest 数据框作为输入传递给 dist() 函数。根据平方欧几里得距离计算总的不匹配数，结果应存储在 dist.items 数据框中：

> dist.items <- dist(Mathtest[,-1], method='euclidean')²

接下来，我们将打印 dist.items 数据框。

> dist.items

结果如下：

接下来，距离度量完全忽略 0-0 匹配。在 dist() 函数中应使用二进制方法。在二进制方法中，非零元素处于开启状态，而零元素处于关闭状态，因为向量被视为二进制位。

> dist.items.2 <- dist(Mathtest[,-1], method='binary')

接下来，我们将打印数据框 dist.items.2 以观察结果。

结果如下：

接下来，距离度量完全忽略 1-1 匹配。在 dist() 函数中应使用二进制方法。在二进制方法中，非零元素处于开启状态，而零元素处于关闭状态，因为向量被视为二进制位。

> dist.items.3 <- dist(1 - Mathtest[,-1], method='binary')

接下来，我们将打印数据框 dist.items.3 以观察结果。

结果如下：

下一步是使用 complete 方法进行聚类。使用 hclust() 函数。为了对 n 个对象的相似性集进行聚类分析，使用 hclust() 函数。在第一阶段，每个对象都被分配到它自己的簇中。然后算法在每个阶段迭代地连接两个最相似的簇。这个过程一直持续到只剩下一个簇为止。hclust() 函数要求我们以距离矩阵的形式提供数据。dist1 数据框被传递。默认情况下，使用完整链接方法。可以有多个聚合方法可供使用，其中一些可能是 ward.D、ward.D2、single、complete 或 average。

使用的方法是完整的。当使用完整方法时，形成的簇中任何对象与其他对象之间的最大距离：

 > items.complete.link <- hclust(dist.items, method='complete')
 > items.complete.link

调用 items.complete.link 函数会导致显示所使用的聚合方法、计算距离的方式以及对象的数量。结果如下：

第 4 步 - 绘制模型

plot() 函数是 R 对象的通用绘图函数。在这里，plot() 函数用于绘制完整链接树状图。

完整链接用于层次聚类，并确保两个簇之间的距离是最大距离。在算法的每个步骤中使用完整链接时，将两个最近的簇合并在一起。这个过程迭代进行，直到整个数据集合并成一个单一的簇：

> plot(items.complete.link, labels=Mathtest[,1], ylab="Distance")

结果如下：

接下来，我们将在树状图上执行单链接。在单链接层次聚类中，每一步都是基于与其他对象的最小距离合并成两个簇，或者簇之间的最小成对距离：

 > items.sing.link <- hclust(dist.items, method='single')
 > items.sing.link

调用 items.sing.link 函数将显示使用的聚合方法、距离计算方式以及对象数量。结果如下：

这里，plot() 函数用于绘制完整的链接树状图。items.sing.link 作为数据框传递：

> plot(items.sing.link, labels=Mathtest[,1], ylab="Distance")

结果如下：

步骤 5 - K-medoids 聚类

加载 cluster() 库：

> library(cluster)

为了计算平均轮廓宽度，我们编写了一个函数。

轮廓是指一种用于解释和验证数据簇内一致性的方法。为了提供对象在簇中的位置，该技术使用图形表示。轮廓范围在 -1 到 1 之间，其中 1 表示对象与其自身簇的最高匹配度，-1 表示对象与其自身簇的最低匹配度。在一个簇中，如果大多数对象具有高值，例如接近 1，则聚类配置是合适的。

> my.k.choices <- 2:8

rep() 是一个通用函数，用于复制 my.k.choices 的值。结果存储在数据框 avg.sil.width 中：

> avg.sil.width <- rep(0, times=length(my.k.choices))

PAM 代表 基于聚类中心的划分。PAM 要求用户知道期望的簇数（类似于 k-means 聚类），但它比 k-means 聚类进行更多的计算，以确保找到的聚类中心真正代表给定簇内的观测值。

 > for (ii in (1:length(my.k.choices)) ){
 + avg.sil.width[ii] <- pam(dist.items, k=my.k.choices[ii])$silinfo$avg.width
 + }

打印带有轮廓值的选项值。

> print( cbind(my.k.choices, avg.sil.width) )

结果如下：

基于两个簇进行聚类：

 > items.kmed.2 <- pam(dist.items, k=2, diss=T)
 > items.kmed.2

结果如下：

lapply() 函数是一个通用函数，用于复制 my.k.choices 的值。结果存储在数据框 avg.sil.width 中：

 > items.2.clust <- lapply(1:2, function(nc) Mathtest[,1][items.kmed.2$clustering==nc]) 
 > items.2.clust

结果如下：

基于三个簇进行聚类。

 > items.kmed.3 <- pam(dist.items, k=3, diss=T)
 > items.kmed.3

结果如下：

 > items.3.clust <- lapply(1:3, function(nc) Mathtest[,1][items.kmed.3$clustering==nc])
 > items.3.clust

结果如下：

K-means 聚类 - 欧洲国家蛋白质消耗

在医学和营养学领域，食物消费模式非常有趣。食物消费与个人的整体健康、食物的营养价值、购买食物项涉及的经济以及消费的环境相关。这项分析关注的是 25 个欧洲国家中肉类与其他食物项之间的关系。观察肉类与其他食物项之间的相关性很有趣。数据包括红肉、白肉、鸡蛋、牛奶、鱼类、谷物、淀粉类食物、坚果（包括豆类和油料种子）、水果和蔬菜的测量值。

准备中

为了执行 K-means 聚类，我们将使用收集的 25 个欧洲国家的蛋白质消费数据集。

步骤 1 - 收集和描述数据

标题为 protein 的数据集，该数据集为 CSV 格式，应被使用。数据集为标准格式。共有 25 行数据，包含 10 个变量。

数值变量是：

• 红肉

• 白肉

• 鸡蛋

• 牛奶

• 鱼类

• 谷物

• 淀粉

• 坚果

• 水果和蔬菜

非数值变量是：

• 国家

如何操作...

让我们深入了解。

步骤 2 - 探索数据

注意

版本信息：本页面的代码在 R 版本 3.2.3（2015-12-10）上进行了测试

让我们探索数据并了解变量之间的关系。我们将从导入名为 protein.csv 的 CSV 文件开始。我们将把数据保存到 protein 数据框中：

> protein = read.csv("d:/Europenaprotein.csv",header=T)

head() 返回向量、矩阵、表、数据框或函数的第一部分或最后一部分。将 protein 数据框传递给 head() 函数。

> head(protein)

结果如下：

步骤 3 - 聚类

基于三个聚类开始聚类。

为了在初始阶段找到随机的聚类数量，调用 set.seed() 函数。set.seed() 函数的结果是生成随机数：

> set.seed(123456789)

kmeans() 函数将对数据矩阵执行 K-means 聚类。protein 数据矩阵作为可以强制转换为数值矩阵的对象传递。centers=3 表示初始（不同）聚类中心的数量。由于聚类数量用数字表示，nstart=10 定义了要选择的随机集的数量：

 > groupMeat <- kmeans(protein[,c("WhiteMeat","RedMeat")], centers=3, nstart=10)
 > groupMeat

结果如下：

接下来，进行聚类分配的列表。order() 函数返回一个排列，它重新排列其第一个参数，以升序或降序排列。将数据框 groupMeat 作为数据框对象传递：

> o=order(groupMeat$cluster)

调用 data.frame() 函数的结果是显示国家和它们所在的聚类：

> data.frame(protein$Country[o],groupMeat$cluster[o])

结果如下：

plot()函数是一个通用的绘图 R 对象函数。参数类型表示要绘制的图类型。xlim参数意味着应该给出范围的极限，而不是一个范围。xlab和ylab分别提供x-轴和y-轴的标题：

 > plot(protein$Red, protein$White, type="n", xlim=c(3,19), xlab="Red Meat", ylab="White Meat")
 > text(x=protein$Red, y=protein$White, labels=protein$Country,col=groupMeat$cluster+1)

结果如下：

步骤 4 - 改进模型

接下来，对所有九个蛋白质组进行聚类，创建了七个簇。白色肉类与红色肉类的彩色散点图之间存在密切的相关性。地理位置相近的国家往往被聚类到同一个组。

set.seed()函数会导致随机数的生成：

> set.seed(123456789)

centers=7表示初始（不同）簇中心的数量：

 > groupProtein <- kmeans(protein[,-1], centers=7, nstart=10)
 > o=order(groupProtein$cluster)
 > data.frame(protein$Country[o],groupProtein$cluster[o])

形成了七个不同的簇。25 个国家中的每一个都被放置在一个簇中。

结果如下：

 > library(cluster)

clustplot()函数创建了一个双变量图，可以将其可视化为数据的分区（聚类）。所有观测值都通过图中的点表示，使用主成分。在每个簇周围画一个椭圆。将数据框protein作为对象传递：

> clusplot(protein[,-1], groupProtein$cluster, main='2D representation of the Cluster solution', color=TRUE, shade=TRUE, labels=2, lines=0)

结果如下：

另一种方法是将其以层次形式查看。使用agnes()函数。通过将diss=FALSE，使用原始数据计算距离矩阵。metric="euclidean"表示使用欧几里得距离度量：

 > foodagg=agnes(protein,diss=FALSE,metric="euclidean")
 > foodagg

结果如下：

> plot(foodagg, main='Dendrogram')

结果如下：

cutree()函数通过指定所需的组数或切割高度将树切割成几个组：

> groups <- cutree(foodagg, k=4)

> rect.hclust(foodagg, k=4, border="red")

结果如下：

K-means 聚类 - 食品

我们摄入的食物中的营养素可以根据它们在构建身体质量中的作用进行分类。这些营养素可以分为宏量营养素或必需的微量营养素。宏量营养素的一些例子是碳水化合物、蛋白质和脂肪，而必需的微量营养素的一些例子是维生素、矿物质和水。

准备工作

让我们从食谱开始。

步骤 1 - 收集和描述数据

为了执行 K-means 聚类，我们将使用收集的各种食品及其相应的能量、蛋白质、脂肪、钙和铁含量的数据集。数值变量包括：

• 能量

• 蛋白质

• 脂肪

• 钙

• 铁

非数值变量是：

• 食品

如何做...

让我们深入了解细节。

步骤 2 - 探索数据

注意

版本信息：本页面的代码在 R 版本 3.2.3（2015-12-10）中进行了测试。

加载cluster()库。

> library(cluster)

让我们探索数据并了解变量之间的关系。我们将从导入名为 foodstuffs.txt 的文本文件开始。我们将数据保存到 food.energycontent 数据框中：

> food.energycontent <- read.table("d:/foodstuffs.txt", header=T)

head() 函数返回向量、矩阵、表、数据框或函数的第一部分或最后一部分。food.energycontent 数据框传递给 head() 函数：

> head(food.energycontent) 

结果如下：

str() 函数返回有关 food.energycontent 数据框结构的提供信息。它紧凑地显示内部结构：

> str(food.energycontent)

结果如下：

步骤 3 - 转换数据

apply() 函数对数据框和矩阵进行逐项更改。它返回一个向量、数组或列表，该列表是通过将函数应用于数组的边缘或矩阵的边缘而获得的值。2 表示函数将应用到的列子索引。sd 是标准差函数，它将应用于数据框：

 > standard.deviation <- apply(food.energycontent[,-1], 2, sd)
 > standard.deviation

结果如下：

sweep() 函数返回一个从输入数组中通过清除汇总统计量获得的数组。food.energycontent[,-1] 作为数组传递。2 表示函数将应用到的列子索引。standard.deviation 是要清除的汇总统计量：

 > foodergycnt.stddev <- sweep(food.energycontent[,-1],2,standard.deviation,FUN="/") 
 > foodergycnt.stddev

结果如下：

步骤 4 - 聚类

kmeans() 函数应在数据矩阵上执行 K-means 聚类。数据矩阵 foodergycnt.stddev 作为可以强制转换为数据数值矩阵的对象传递。centers=5 表示初始（不同）聚类中心的数量。iter.max=100 表示允许的最大迭代次数。由于聚类数量用数字表示，nstart=25 定义了要选择的随机集的数量：

 > food.5cluster <- kmeans(foodergycnt.stddev, centers=5, iter.max=100, nstart=25)
 > food.5cluster

结果如下：

 > food.4cluster <- kmeans(foodergycnt.stddev, centers=4, iter.max=100, nstart=25)
 > food.4cluster

结果如下：

打印 4 聚类解决方案的聚类向量：

> food.4cluster$cluster

结果如下：

接下来，我们将按食品标签打印 4 聚类解决方案的聚类。

lapply() 函数返回一个与 X 长度相同的列表：

 > food.4cluster.clust <- lapply(1:4, function(nc) protein[food.4cluster$cluster==nc])
 > food.4cluster.clust

结果如下：

步骤 5 - 可视化聚类

使用 pairs() 函数，生成一个散点图矩阵。food.energycontent[,-1] 提供了作为矩阵或数据框的数值列的点坐标。

> pairs(food.energycontent[,-1], panel=function(x,y) text(x,y,food.4cluster$cluster))

结果如下：

princomp()函数对给定的数值数据矩阵执行主成分分析。该函数产生一个未旋转的主成分分析。cor=T表示一个逻辑值，指示计算应使用相关矩阵：

 > food.pc <- princomp(food.energycontent[,-1],cor=T)
 > my.color.vector <- rep("green", times=nrow(food.energycontent))
 > my.color.vector[food.4cluster$cluster==2] <- "blue"
 > my.color.vector[food.4cluster$cluster==3] <- "red"
 > my.color.vector[food.4cluster$cluster==4] <- "orange"

par()函数将多个图表组合成一个整体图形。s生成一个正方形绘图区域：

> par(pty="s")

绘制聚类图：

 > plot(food.pc$scores[,1], food.pc$scores[,2], ylim=range(food.pc$scores[,1]), 
 + xlab="PC 1", ylab="PC 2", type ='n', lwd=2)
 > text(food.pc$scores[,1], food.pc$scores[,2], labels=Food, cex=0.7, lwd=2,
 + col=my.color.vector)

结果如下：

第四章：模型选择和正则化

在本章中，我们将介绍以下内容：

• 收敛方法 - 每日燃烧的卡路里

• 维度缩减方法 - Delta 的飞机机队

• 主成分分析 - 理解世界美食

引言

子集选择：在机器学习中，监督分类的主要挑战之一是使用标记示例来诱导一个将对象分类到有限已知类别的模型。数值或名义特征向量用于描述各种示例。在特征子集选择问题中，学习算法面临的问题是在选择一些特征子集上集中注意力，同时忽略其余部分。

当拟合线性回归模型时，我们感兴趣的变量子集是最好描述数据的。在寻找变量集时，可以采用多种不同的策略来选择最佳子集。如果有 m 个变量，并且最佳回归模型由 p 个变量组成，p≤m，那么选择最佳子集的更通用方法可能是尝试所有可能的 p 个变量的组合，并选择最适合数据的模型。

然而，存在 m! p!(m−p)! 种可能的组合，随着 m 值的增加而增加，例如，m = 20 和 p = 4 会产生 4,845 种可能的组合。此外，通过使用更少的特点，我们可以降低获取数据成本并提高分类模型的易理解性。

收敛方法：收敛回归指的是回归情况下的估计或预测的收敛方法；当回归变量之间存在多重共线性时很有用。在数据集相对于研究的协变量数量较小的情况下，收敛技术可以提高预测。常见的收敛方法如下：

• 线性收敛因子--以相同的因子收缩所有系数

• 岭回归--惩罚最大似然，惩罚因子添加到似然函数中，使得系数根据每个协变量的方差单独收缩

• Lasso--通过在标准化协变量的系数绝对值之和上设置约束，将一些系数收缩到零

收敛方法保留预测变量的一部分，同时丢弃其余部分。子集选择产生一个可解释的模型，并且可能比全模型产生更低的预测误差，而不会降低全模型的预测误差。收敛方法更连续，并且不会像高变异性那样受到很大影响。当线性回归模型中有许多相关变量时，它们的系数难以确定，并且表现出高方差。

降维方法：在包括模式识别、数据压缩、机器学习和数据库导航在内的广泛信息处理领域中，降维是一个重要的挑战。测量的数据向量是高维的，在许多情况下，数据位于一个低维流形附近。高维数据的主要挑战是它们是多元的；它们间接地测量了底层来源，这通常不能直接测量。降维也可以被视为推导出一组自由度的过程，这些自由度可以用来再现数据集的大部分变异性。

收缩方法 - 每日燃烧卡路里

为了比较人类的代谢率，基础代谢率（BMR）的概念在临床环境中至关重要，作为确定人类甲状腺状态的手段。哺乳动物的基础代谢率与体重成正比，与场代谢率具有相同的异速增长指数，以及许多生理和生化速率。Fitbit 作为一种设备，使用基础代谢率和一天中进行的活动来估计一天中燃烧的卡路里。

准备中

为了执行收缩方法，我们将使用从 Fitbit 收集的数据集和燃烧卡路里数据集。

第 1 步 - 收集和描述数据

应使用标题为fitbit_export_20160806.csv的 CSV 格式数据集。数据集是标准格式。有 30 行数据，10 个变量。数值变量如下：

• Calories Burned

• Steps

• Distance

• Floors

• Minutes Sedentary

• Minutes Lightly Active

• Minutes Fairly Active

• ExAng

• Minutes Very Active

• Activity Calories

非数值变量如下：

• Date

如何操作...

让我们深入了解。

第 2 步 - 探索数据

作为第一步，需要加载以下包：

    > install.packages("glmnet")
    > install.packages("dplyr")
    > install.packages("tidyr")
    > install.packages("ggplot2")
    > install.packages("caret")
    > install.packages("boot")
    > install.packages("RColorBrewer")
    > install.packages("Metrics")
    > library(dplyr)
    > library(tidyr)
    > library(ggplot2)
    > library(caret)
    > library(glmnet)
    > library(boot)
    > library(RColorBrewer)
    > library(Metrics)

备注

版本信息：本页面的代码在 R 版本 3.3.0（2016-05-03）中进行了测试

让我们探索数据并了解变量之间的关系。我们将从导入名为fitbit_export_20160806.csv的 csv 数据文件开始。我们将把数据保存到fitbit_details框架中：

> fitbit_details <- read.csv("https://raw.githubusercontent.com/ellisp/ellisp.github.io/source/data/fitbit_export_20160806.csv", 
    + skip = 1, stringsAsFactors = FALSE) %>%
    + mutate(
    + Calories.Burned = as.numeric(gsub(",", "", Calories.Burned)),
    + Steps = as.numeric(gsub(",", "", Steps)),
    + Activity.Calories = as.numeric(gsub(",", "", Activity.Calories)),
    + Date = as.Date(Date, format = "%d/%m/%Y")
    + )

将fitbit_details数据框存储到fitbit数据框中：

> fitbit <- fitbit_details

打印fitbit数据框。head()函数返回fitbit数据框的第一部分。fitbit数据框作为输入参数传递：

 > head(fitbit)

结果如下：

将Activity.Calories和Date值设置为 NULL：

> fitbit$Activity.Calories <- NULL

> fitbit$Date <- NULL

将缩放系数设置为每千步卡路里。然后将结果设置为fitbit$Steps数据框：

> fitbit$Steps <- fitbit$Steps / 1000

打印fitbit$Steps数据框：

> fitbit$Steps

结果如下：

探索所有候选变量。计算相关系数的函数：

    > panel_correlations <- function(x, y, digits = 2, prefix = "", cex.cor, ...){
    # combining multiple plots into one overall graph
    + usr <- par("usr")
    + on.exit(par(usr))
    + par(usr = c(0, 1, 0, 1))
    # computing the absolute value
    + r <- abs(cor(x, y))
# Formatting object 
    + txt <- format(c(r, 0.123456789), digits = digits)[1]
    + txt <- paste0(prefix, txt)
    + if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt)
    + text(0.5, 0.5, txt, cex = cex.cor * r)
    + }

生成散点矩阵。pairs()函数以矩阵形式生成散点图。"fitbit"是散点图的数据集。距离可以直接从"Steps"中几乎精确地计算出来：

> pairs(fitbit[ , -1], lower.panel = panel_correlations, main = "Pairwise Relationship - Fitbit's Measured Activities")

结果如下：

打印fitbit 数据框：

> ggplot(fitbit, aes(x = Distance / Steps)) + geom_rug() + geom_density() +ggtitle("Stride Length Reverse- Engineered from Fitbit Data", subtitle = "Not all strides identical, due to rounding or other jitter")

结果如下：

步骤 3 - 构建模型

使用"Steps"作为唯一解释变量和"Calories.Burned"作为响应变量构建普通最小二乘估计。"lm()"作为一个函数用于拟合线性模型。"Calories.Burned ~ Steps"是公式，而"fitbit"是数据框。结果存储在moderate数据框中：

> moderate <- lm(Calories.Burned ~ Steps, data = fitbit)

打印moderate数据框：

> moderate

结果如下：

将moderate数据框的值四舍五入：

> round(coef(moderate))

结果如下：

使用模型中的残差绘制预测卡路里。plot()函数是一个通用的绘图 R 对象的函数。moderate数据框作为函数值传递。bty参数确定围绕绘图绘制的框的类型：

> plot(moderate, which = 1, bty = "l", main = "Predicted Calories compared with Residuals")

结果如下：

检查残差的偏自相关函数。"pacf()"用于计算偏自相关。"resid()"作为一个函数计算因变量观测数据之间的差异。"moderate"作为一个数据框传递给"resid()"函数，以计算因变量观测数据之间的差异：

> pacf(resid(moderate), main = "Partial Autocorrelation of residuals from single variable regression")

grid()函数向绘制的数据添加网格：

> grid()

结果如下：

步骤 4 - 改进模型

根据所有七个解释变量预测每日卡路里。使用拟合模型在多个不同 alpha 值下对样本进行拟合，使用拟合模型从原始样本中预测未在重新抽样的样本中的外袋点。这是通过选择适当的 alpha 值来在岭回归和 lasso 估计的极端之间创建平衡。

通过标准化创建矩阵X。as.matrix()函数将fitbit[ , -1]（即除日期列之外的部分）转换为矩阵：

 > X <- as.matrix(fitbit[ , -1])

打印X数据框。"head()"函数返回X数据框的第一部分。"X"数据框作为输入参数传递：

> head(X)

结果如下：

通过标准化创建向量Y：

> Y <- fitbit$Calories.Burned

打印Y数据框：

> Y

结果如下：

> set.seed(123)

生成常规序列：

 > alphas <- seq(from = 0, to  = 1, length.out = 10)
 > res <- matrix(0, nrow = length(alphas), ncol = 6)

创建每个 CV 运行的五次重复：

    > for(i in 1:length(alphas)){
    + for(j in 2:6){
    # k-fold cross-validation for glmnet
    + cvmod <- cv.glmnet(X, Y, alpha = alphas[i])
    + res[i, c(1, j)] <- c(alphas[i], sqrt(min(cvmod$cvm)))
    + }
    + }

创建要使用的数据集。"data.frame()"函数用于根据紧密耦合的变量集创建数据框。这些变量共享矩阵的性质：

> res <- data.frame(res)

打印res数据框：

> res

结果如下：

创建average_rmse向量：

> res$average_rmse <- apply(res[ , 2:6], 1, mean)

打印res$average_rmse向量：

> res$average_rmse

结果如下：

将res$average_rmse按升序排列。结果存储在res数据框中：

> res <- res[order(res$average_rmse), ]

打印res数据框：

> res

结果如下：

    > names(res)[1] <- "alpha"
    > res %>%
    + select(-average_rmse) %>%
    + gather(trial, rmse, -alpha) %>%
    + ggplot(aes(x = alpha, y = rmse)) +
    + geom_point() +
    + geom_smooth(se = FALSE) +
    + labs(y = "Root Mean Square Error") +
    + ggtitle("Cross Validation best RMSE for differing values of alpha")

结果如下：

> bestalpha <- res[1, 1]

打印bestalpha数据框：

> bestalpha

使用弹性网络比较普通最小二乘等价物与八个系数（七个解释变量加一个截距）的估计值。

确定 alpha 的最佳值处的 lambda。通过调用cv.glmnet()函数计算glmnet的 k 折交叉验证：

> crossvalidated <- cv.glmnet(X, Y, alpha = bestalpha)

创建模型。glmnet()通过惩罚最大似然估计拟合广义线性模型。正则化路径在正则化参数 lambda 的值网格上计算，对于 lasso 或elasticnet惩罚。X是输入矩阵，而Y是响应变量。alpha是elasticnet混合参数，范围是 0 ≤ α ≤ 1：

> moderate1 <- glmnet(X, Y, alpha = bestalpha)

建立普通最小二乘估计，以fitbit作为唯一的解释变量，以Calories.Burned作为响应变量。使用lm()函数拟合线性模型。Calories.Burned ~ Steps是公式，而fitbit是数据框。结果存储在OLSmodel数据框中：

> OLSmodel <- lm(Calories.Burned ~ ., data = fitbit)

打印OLSmodel数据框：

> OLSmodel

结果如下：

比较普通最小二乘等价物与八个系数（七个解释变量加一个截距）的估计值。结果存储在coeffs数据框中：

 > coeffs <- data.frame(original = coef(OLSmodel), 
 + shrunk = as.vector(coef(moderate1, s = crossvalidated$lambda.min)),
 + very.shrunk = as.vector(coef(moderate1, s = crossvalidated$lambda.1se)))

打印coeffs数据框：

> coeffs

结果如下：

将moderate数据框的值四舍五入到三位有效数字：

> round(coeffs, 3)

结果如下：

创建模型。glmnet()通过惩罚最大似然估计拟合广义线性模型：

> moderate2 <- glmnet(X, Y, lambda = 0)

打印moderate2数据框：

> moderate2

结果如下：

将值四舍五入到三位有效数字：

> round(data.frame("elastic, lambda = 0" = as.vector(coef(moderate2)), "lm" = coef(OLSmodel), check.names = FALSE), 3)

结果如下：

创建模型。在消除距离列后，glmnet()通过惩罚最大似然估计拟合广义线性模型：

> moderate3 <- glmnet(X[ , -2], Y, lambda = 0)

打印moderate3数据框：

> moderate3

结果如下：

建立普通最小二乘估计Y ~ X[ , -2]是公式。结果存储在moderate4数据框中：

> moderate4 <- lm(Y ~ X[ , -2])

打印moderate4数据框：

> moderate4

结果如下：

将数值四舍五入到三位有效数字：

> round(data.frame("elastic, lambda = 0" = as.vector(coef(moderate3)), "lm" = coef(moderate4), check.names = FALSE), 3)

结果如下：

步骤 5 - 比较模型

通过使用 bootstrapping 比较不同模型的预测能力，其中建模方法应用于数据的 bootstrap 重采样。然后使用估计模型来预测完整的原始数据集。

传递给 boot 以进行弹性建模的函数：

    > modellingfucn1 <- function(data, i){
    + X <- as.matrix(data[i , -1])
    + Y <- data[i , 1]
    # k-fold cross-validation for glmnet
    + crossvalidated <- cv.glmnet(X, Y, alpha = 1, nfolds = 30)
    # Fitting a generalized linear model via penalized maximum likelihood
    + moderate1 <- glmnet(X, Y, alpha = 1)
    # Computing the root mean squared error
    + rmse(predict(moderate1, newx = as.matrix(data[ , -1]), s =     crossvalidated$lambda.min), data[ , 1])
    + }

生成应用于数据的统计量的 R bootstrap 副本。fitbit是数据集，statistic = modellingfucn1是函数，当应用于fitbit时，返回包含感兴趣统计量的向量。R = 99表示 bootstrap 副本的数量：

> elastic_boot <- boot(fitbit, statistic = modellingfucn1, R = 99)

打印elastic_boot数据框：

 > elastic_boot

结果如下：

传递给 boot 以进行 OLS 建模的函数：

    > modellingOLS <- function(data, i){
    + mod0 <- lm(Calories.Burned ~ Steps, data = data[i, ])
    + rmse(predict(moderate, newdata = data), data[ , 1])
    + }

生成应用于数据的统计量的 R bootstrap 副本。fitbit是数据集，statistic = modellingOLS是函数，当应用于fitbit时，返回包含感兴趣统计量的向量。R = 99表示 bootstrap 副本的数量：

> lmOLS_boot <- boot(fitbit, statistic = modellingOLS, R = 99)

打印lmOLS_boot数据框：

> lmOLS_boot

结果如下：

生成应用于数据的统计量的 R bootstrap 副本。fitbit是数据集，statistic = modellingfucn2是函数，当应用于fitbit时，返回包含感兴趣统计量的向量。R = 99表示 bootstrap 副本的数量：

> lm_boot <- boot(fitbit, statistic = modellingfucn2, R = 99)

打印lm_boot数据框：

> lm_boot

结果如下：

 > round(c("elastic modelling" = mean(elastic_boot$t), 
 + "OLS modelling" = mean(lm_boot$t),
 + "OLS modelling, only one explanatory variable" = mean(lmOLS_boot$t)), 1)

结果如下：

使用缩放变量重新拟合模型。

创建模型。glmnet()通过惩罚最大似然估计拟合广义线性模型。

 > ordering <- c(7,5,6,2,1,3,4)
 > par(mar = c(5.1, 4.1, 6.5, 1), bg = "grey90")
 > model_scaled <- glmnet(scale(X), Y, alpha = bestalpha)
 > the_palette <- brewer.pal(7, "Set1")
 > plot(model_scaled, xvar = "dev", label = TRUE, col = the_pallete, lwd = 2, main = "Increasing contribution of different explanatory variablesnas penalty for including them is relaxed")
 > legend("topleft", legend = colnames(X)[ordering], text.col = the_palette[ordering], lwd = 2, bty = "n", col = the_palette[ordering])

结果如下：

维度缩减方法 - Delta 的机队

航空公司战略规划过程中的一个部分是机队规划。机队是指航空公司运营的飞机总数，以及构成总机队的具体飞机类型。飞机采购的航空公司选择标准基于技术/性能特性、经济和财务影响、环境法规和限制、营销考虑以及政治现实。机队构成是航空公司公司的关键长期战略决策。每种飞机类型都有不同的技术性能特性，例如，携带有效载荷在最大飞行距离或范围内的能力。它影响财务状况、运营成本，尤其是服务特定路线的能力。

准备中

为了进行降维，我们将使用收集于 Delta 航空公司机队的数据集。

第一步 - 收集和描述数据

应使用标题为 delta.csv 的数据集。该数据集采用标准格式。共有 44 行数据，34 个变量。

如何做到这一点...

让我们深入了解细节。

步骤 2 - 探索数据

第一步是加载以下包：

    > install.packages("rgl")
    > install.packages("RColorBrewer")
    > install.packages("scales")
    > library(rgl)
    > library(RColorBrewer)
    > library(scales)

注意

版本信息：本页面的代码在 R 版本 3.3.2（2016-10-31）上进行了测试

让我们探索数据并了解变量之间的关系。我们将首先导入名为 delta.csv 的 csv 数据文件。我们将把数据保存到 delta 数据框中：

 > delta <- read.csv(file="d:/delta.csv", header=T, sep=",", row.names=1)

探索 delta 数据框的内部结构。str() 函数显示数据框的内部结构。将作为 R 对象传递给 str() 函数的详细信息：

> str(delta)

结果如下：

探索与飞机物理特性相关的中间定量变量：住宿、巡航速度、航程、引擎、翼展、尾高和 Length.Scatter 折线图矩阵。plot() 函数是一个用于绘制 R 对象的通用函数。将 delta[,16:22] 数据框作为函数值传递：

> plot(delta[,16:22], main = "Aircraft Physical Characteristics", col = "red")

结果如下：

所有这些变量之间都存在正相关关系，因为它们都与飞机的整体尺寸有关。

步骤 3 - 应用主成分分析

可视化高维数据集，如引擎数量。对数据进行主成分分析。princomp() 函数对 delta 数据矩阵执行主成分分析。结果是 principal_comp_analysis，它是一个 princomp 类的对象：

> principal_comp_analysis <- princomp(delta)

打印 principal_comp_analysis 数据框：

> principal_comp_analysis

结果如下：

绘制 principal_comp_analysis 数据：

> plot(principal_comp_analysis, main ="Principal Components Analysis of Raw Data", col ="blue")

结果如下：

可以证明，第一个主成分具有标准差，它解释了数据中超过 99.8% 的方差。

打印主成分分析加载项。loadings() 函数使用 principal_comp_analysis 主成分分析数据对象作为输入：

> loadings(principal_comp_analysis)

结果如下：

观察加载的第一个列，很明显，第一个主成分仅仅是航程，以英里为单位。数据集中每个变量的尺度都不同。

在常规尺度上绘制方差。barplot() 绘制垂直和水平条形图。sapply() 是一个包装函数，它返回与 delta.horiz=T 相同长度的列表，表示条形图将水平绘制，第一个在底部：

 > mar <- par()$mar
 > par(mar=mar+c(0,5,0,0))
 > barplot(sapply(delta, var), horiz=T, las=1, cex.names=0.8, main = "Regular Scaling of Variance", col = "Red", xlab = "Variance")

结果如下：

在对数尺度上绘制方差。barplot() 绘制垂直和水平条形：

> barplot(sapply(delta, var), horiz=T, las=1, cex.names=0.8, log='x', main = "Logarithmic  Scaling of Variance", col = "Blue", xlab = "Variance")

结果如下：

> par(mar=mar)

第 4 步 - 缩放数据

在某些情况下，缩放 delta 数据是有用的，因为变量跨越不同的范围。scale() 函数作为函数对 delta 矩阵的列进行中心化和/或缩放。结果存储在 delta2 数据框中：

> delta2 <- data.frame(scale(delta))

验证方差是否均匀：

> plot(sapply(delta2, var), main = "Variances Across Different Variables", ylab = "Variances")

结果如下：

现在方差在变量间是恒定的。

将主成分应用于缩放后的数据 delta2。princomp() 函数对 delta2 数据矩阵执行主成分分析。结果是 principal_comp_analysis，它是一个 princomp 类的对象：

> principal_comp_analysis <- princomp(delta2)

绘制 principal_comp_analysis 对象：

> plot(principal_comp_analysis, main ="Principal Components Analysis of Scaled Data", col ="red")

结果如下：

> plot(principal_comp_analysis, type='l', main ="Principal Components Analysis of Scaled Data")

结果如下：

使用 summary() 函数生成各种模型拟合函数结果的摘要：

> summary(principal_comp_analysis)

结果如下：

将主成分应用于缩放后的数据 delta2。prcomp() 函数对 delta2 数据矩阵执行主成分分析。结果是 principal_comp_analysis，它是一个 prcomp 类的对象：

> principal_comp_vectors <- prcomp(delta2)

创建 principal_comp_vectors 的数据框：

> comp <- data.frame(principal_comp_vectors$x[,1:4])

使用 k = 4 进行 k 均值聚类。kmeans() 函数对 comp 执行 k 均值聚类。nstart=25 表示要选择的随机集的数量。iter.max=1000 是允许的最大迭代次数：

> k_means <- kmeans(comp, 4, nstart=25, iter.max=1000)

创建一个包含九种连续颜色的向量：

> palette(alpha(brewer.pal(9,'Set1'), 0.5))

绘制 comp：

> plot(comp, col=k_means$clust, pch=16)

结果如下：

第 5 步 - 在 3D 图中可视化

在 3D 中绘制 comp$PC1、comp$PC2、comp$PC3：

> plot3d(comp$PC1, comp$PC2, comp$PC3, col=k_means$clust) 

结果如下：

在 3D 中绘制 comp$PC1、comp$PC3、comp$PC4：

> plot3d(comp$PC1, comp$PC3, comp$PC4, col=k_means$clust)

结果如下：

按照大小顺序检查簇：

> sort(table(k_means$clust))

结果如下：

> clust <- names(sort(table(k_means$clust)))

如第一簇中显示的名称：

> row.names(delta[k_means$clust==clust[1],])

结果如下：

如第二簇中显示的名称：

> row.names(delta[k_means$clust==clust[2],])

结果如下：

如第三簇中显示的名称：

> row.names(delta[k_means$clust==clust[3],])

结果如下：

如第四簇中显示的名称：

> row.names(delta[k_means$clust==clust[4],])

结果如下：

主成分分析 - 理解世界美食

食物是我们身份的强大象征。有许多类型的食物识别，如民族、宗教和阶级识别。在存在味觉外国人（如出国或在外国人访问家乡时）的情况下，民族食物偏好成为身份标志。

准备工作

为了进行主成分分析，我们将使用在 Epicurious 菜谱数据集上收集的数据集。

第 1 步 - 收集和描述数据

将使用标题为 epic_recipes.txt 的数据集。该数据集为标准格式。

如何操作...

让我们深入了解细节。

第 2 步 - 探索数据

第一步是加载以下包：

> install.packages("glmnet") 
    > library(ggplot2)
    > library(glmnet)

注意

版本信息：本页代码在 R 版本 3.3.2（2016-10-31）上进行了测试

让我们探索数据并了解变量之间的关系。我们将首先导入名为 epic_recipes.txt 的 TXT 数据文件。我们将数据保存到 datafile 数据框中：

> datafile <- file.path("d:","epic_recipes.txt")

从表格格式文件中读取文件并创建数据框。datafile 是文件名，作为输入传递：

> recipes_data <- read.table(datafile, fill=TRUE, col.names=1:max(count.fields(datafile)), na.strings=c("", "NA"), stringsAsFactors = FALSE)

第 3 步 - 准备数据

将数据拆分为子集。aggregate() 函数将 recipes_data[,-1] 拆分并计算汇总统计信息。recipes_data[,-1] 是一个分组元素列表，每个元素与数据框中的变量长度相同。结果存储在 agg 数据框中：

> agg <- aggregate(recipes_data[,-1], by=list(recipes_data[,1]), paste, collapse=",")

创建一个向量、数组或值列表：

> agg$combined <- apply(agg[,2:ncol(agg)], 1, paste, collapse=",")

替换所有模式出现。gsub() 函数在搜索 agg$combined 后将每个 ,NA 替换为 ""：

> agg$combined <- gsub(",NA","",agg$combined)

提取所有菜系的名称：

> cuisines <- as.data.frame(table(recipes_data[,1]))

打印菜系数据框：

> cuisines

结果如下：

提取成分的频率：

 > ingredients_freq <- lapply(lapply(strsplit(a$combined,","), table), as.data.frame) 
 > names(ingredients_freq) <- agg[,1]

标准化成分的频率：

 > proportion <- lapply(seq_along(ingredients_freq), function(i) {
 + colnames(ingredients_freq[[i]])[2] <- names(ingredients_freq)[i]
 + ingredients_freq[[i]][,2] <- ingredients_freq[[i]][,2]/cuisines[i,2] 
 + ingredients_freq[[i]]}
 + )

包含 26 个元素，每个元素对应一种菜系：

    > names(proportion) <- a[,1]
    > final <- Reduce(function(...) merge(..., all=TRUE, by="Var1"), proportion)
    > row.names(final) <- final[,1]
    > final <- final[,-1]
    > final[is.na(final)] <- 0
    > prop_matrix <- t(final)
    > s <- sort(apply(prop_matrix, 2, sd), decreasing=TRUE)

scale() 函数将 prop_matrix 矩阵的列进行居中和/或缩放。结果存储在 final_impdata 数据框中：

 > final_imp <- scale(subset(prop_matrix, select=names(which(s > 0.1))))

创建热图。final_imp 是作为输入传递的数据框。trace="none" 表示字符串，指示是否在行或列上绘制实线 "trace"，"both" 或 "none"。key=TRUE 值表示应显示颜色键：

> heatmap.2(final_imp, trace="none", margins = c(6,11), col=topo.colors(7), key=TRUE, key.title=NA, keysize=1.2, density.info="none")

结果如下：

第 4 步 - 应用主成分分析

对数据进行主成分分析。princomp() 函数对 final_imp 数据矩阵执行主成分分析。结果是 pca_computation，它是一个 princomp 类的对象：

> pca_computation <- princomp(final_imp) 

打印 pca_computation 数据框：

> pca_computation

结果如下：

生成双变量图。pca_computation 是一个 princomp 类的对象。pc.biplot=TRUE 表示它是一个主成分双变量图：

> biplot(pca_computation, pc.biplot=TRUE, col=c("black","red"), cex=c(0.9,0.8), xlim=c(-2.5,2.5), xlab="PC1, 39.7%", ylab="PC2, 24.5%")

结果如下：

第五章。非线性

在本章中，我们将介绍以下食谱：

• 广义加性模型 - 测量新西兰的家庭收入

• 光滑样条 - 理解汽车和速度

• 局部回归 - 理解干旱预警和影响

广义加性模型 - 测量新西兰的家庭收入

收入调查提供了人们和家庭收入水平的快照。它给出了来自大多数来源的中位数和平均每周收入。存在不同人口群体之间的收入比较。收入是间歇性收到的，而消费是随时间平滑的。因此，可以合理地预期，消费与当前生活水平比当前收入更直接相关，至少在短期参考期内是这样。

准备工作

为了执行收缩方法，我们将使用 2013 年新西兰人口普查收集的数据集。

步骤 1 - 收集和描述数据

nzcensus 包包含超过 60 个新西兰人口统计值。这些值在网格块、面积单位、地区当局和地区议会级别累积。

如何做到这一点...

让我们深入了解。

步骤 2 - 探索数据

第一步是加载以下包：

 > devtools::install_github("ellisp/nzelect/pkg2")
> library(leaflet)
> library(nzcensus)
> library(Metrics)
> library(ggplot2)
> library(scales)
> library(boot)
> library(dplyr)
> library(Hmisc)
> library(mgcv)
> library(caret)
> library(grid)
> library(stringr)
> library(ggrepel)
> library(glmnet)
> library(maps)

从数据集中删除查塔姆群岛。AreaUnits2013 是一个 esriGeometryPolygon 几何类型对象。它定义了来自 2013 年人口普查模式的面积单位：

    > tmp <- AreaUnits2013[AreaUnits2013$WGS84Longitude> 0 & !is.na(AreaUnits2013$MedianIncome2013), ]

创建颜色调色板函数：

    > palette <- colorQuantile("RdBu", NULL, n = 10)

为弹出窗口创建标签。paste0() 函数在转换为字符后将向量连接起来：

    > labels <- paste0(tmp$AU_NAM, " $", format(tmp$MedianIncome2013, big.mark = ","))

绘制地图：

> leaflet() %>%
+ addProviderTiles("CartoDB.Positron") %>%
+ addCircles(lng = tmp$WGS84Longitude, lat = tmp$WGS84Latitude,
+ color = pal(-tmp$MedianIncome2013),
+ popup = labs,
+ radius = 500) %>%
+ addLegend(
+ pal = pal,
+ values = -tmp$MedianIncome2013,
+ title = "Quantile of median<br>household income",
+ position = "topleft",
+ bins = 5) 

结果如下：

步骤 3 - 为模型设置数据

将数据整理成方便的形状。消除区域的代码和名称，以及冗余的坐标系：

    > au <- AreaUnits2013 %>%     +  select(-AU2014, -AU_NAM, -NZTM2000Easting, -NZTM2000Northing) %>%     +  select(-PropWorked40_49hours2013, -Prop35to39_2013, -PropFemale2013)     > row.names(au) <- AreaUnits2013$AU_NAM

替换所有重复模式的实例。gsub() 函数搜索模式 "_2013"、"2013" 和 "Prop"，然后将它们替换为 names(au)：

 names(au) <- gsub("_2013", "", names(au))
> names(au) <- gsub("2013", "", names(au))
> names(au) <- gsub("Prop", "", names(au))

获取一个逻辑向量，指示一组案例是否完整：

    > au <- au[complete.cases(au), ]

提供一个通用名称：

    > data_use <- au

探索 data_use 数据框的维度。dim() 函数返回 data_use 框架的维度。将 data_use 数据框作为输入参数传递。结果清楚地表明有 1785 行数据和 69 列：

    > dim(data_use)

结果如下：

    > data_use <- data_use[the_data$WGS84Longitude > 100, ]

从字符向量创建语法有效的名称并设置它们。names() 函数在从返回的字符向量创建语法有效的名称的同时设置 data_use 对象的名称：

    > names(data_use) <- make.names(names(data_use))

显示从 data_use 数据框创建的名称：

    > names(data_use)

结果如下：

步骤 4 - 构建模型

估计非参数模型的强度。spearman2()计算 Spearman 的 rho 秩相关系数的平方，以及其推广，其中x可以非单调地与y相关。这是通过计算(rank(x), rank(x)²)与y之间的 Spearman 多重 rho 平方来完成的：

    > reg_data <- spearman2(MedianIncome ~ ., data = data_use)

按降序排列数据：

    > reg_data[order(-reg_data[ ,6])[1:15], ]

结果如下：

将灵活的样条分配给前 15 个变量。terms()函数从多个 R 数据对象中提取terms对象：

> reg_formula <- terms(MedianIncome ~
s(FullTimeEmployed, k = 6) +
s(InternetHH, k = 6) +
s(NoQualification, k = 5) +
s(UnemploymentBenefit, k = 5) +
s(Smoker, k = 5) +
s(Partnered, k = 5) +
s(Managers, k = 4) +
s(Bachelor, k = 4) +
s(SelfEmployed, k = 4) +
s(NoMotorVehicle, k = 4) +
s(Unemployed, k = 3) +
s(Labourers, k = 3) +
s(Worked50_59hours, k = 3) +
s(Separated, k = 3) +
s(Maori, k = 3) +
s(WGS84Longitude, WGS84Latitude) +
.,
data = data_use)

拟合广义加性模型。reg_formula是公式，而data_use是数据集。

> gam_model <- gam(reg_formula, data = data_use) 

绘制gam_model。

    > par(bty = "l", mar = c(5,4, 2, 1))     > par(mar = rep(2, 4))     > plot(gam_model, residuals = TRUE, pages = 1, shade = TRUE, seWithMean = TRUE, ylab = "")

结果如下：

    > rmses_gam_boot <- boot(data = data_use, statistic = fit_gam, R = 99)

打印rmses_gam_boot数据框：

    > rmses_gam_boot

结果如下：

计算rmses_gam_boot$t的均值：

    > gam_rmse <- mean(rmses_gam_boot$t)

打印gam_rmse数据框：

    > gam_rmse

结果如下：

平滑样条 - 理解汽车和速度

为了确定用于拟合模型的统计参数，可以使用多种方法。在每种情况下，拟合都涉及从数据中估计少量参数。除了估计参数外，两个重要阶段是确定合适的模型和验证模型。这些平滑方法可以以多种方式使用：帮助理解并生成平滑图，从平滑数据形状中识别合适的参数模型，或者专注于感兴趣的效应，以消除无用的复杂效应。

如何做到这一点...

让我们深入了解细节。

步骤 1 - 探索数据

第一步是加载以下包：

> install.packages("graphics")
> install.packages("splines")
> library(graphics)
> library(splines)

创建矩阵。cbind()函数将数字序列组合成一个矩阵。然后将结果传递给matrix()函数，创建一个两行的矩阵。结果存储在矩阵中：

    > matrx = matrix(cbind(1,.99, .99,1),nrow=2)

步骤 2 - 创建模型

Cholesky 分解创建正定矩阵A，它可以分解为A=LL^T，其中L是下三角矩阵，对角线元素为正。chol()函数计算实对称正定方阵的 Cholesky 分解。结果存储在cholsky中：

> cholsky = t(chol(matrx))
> nvars = dim(cholsky)[1]

密度分布的观测数：

    > numobs = 1000     
> set.seed(1)

使用正态分布计算矩阵。rnorm()计算正态分布，numobs为要使用的观测数。然后将结果用于matrix()函数计算矩阵，nrow=nvars为两行，ncol=numobs为 1,000 列。结果存储在random_normal中：

    > random_normal = matrix(rnorm(nvars*numobs,10,1), nrow=nvars, ncol=numobs)

执行矩阵乘法。cholsky与矩阵random_normal相乘：

    > X = cholsky %*% random_normal

转置矩阵X：

    > newX = t(X)

创建矩阵的数据框。as.data.frame() 函数创建数据框 raw，它是一组紧密耦合的变量，这些变量共享矩阵 newX 的许多属性：

    > raw = as.data.frame(newX)

打印原始数据框。head() 函数返回原始数据框的第一部分。原始数据框作为输入参数传递：

    > head(raw)

结果如下：

创建 random_normal 的转置数据框。t() 函数创建 random_normal 矩阵的转置矩阵，然后将其转换为紧密耦合的变量集合。这些变量共享矩阵的许多属性：

    > raw_original = as.data.frame(t(random_normal))

结合响应和 predictor1 的名称。c() 函数将响应和 predictor1 作为参数结合，形成一个向量：

    > names(raw) = c("response","predictor1")

raw$predictor1 的指数增长到 3 次方：

    > raw$predictor1_3 = raw$predictor1³

打印 raw$predictor1_3 数据框。head() 函数返回 raw$predictor1_3 数据框的第一部分。raw$predictor1_3 数据框作为输入参数传递：

    > head(raw$predictor1_3)

结果如下：

raw$predictor1 的指数增长到 2 次方：

    > raw$predictor1_2 = raw$predictor1²

打印 raw$predictor1_2 数据框。head() 函数返回 raw$predictor1_2 数据框的第一部分。raw$predictor1_2 数据框作为输入参数传递：

    > head(raw$predictor1_2)

结果如下：

使用 raw$response ~ raw$predictor1_3 作为公式的普通最小二乘估计。lm() 函数用于拟合线性模型。raw$response ~ raw$predictor1_3 是公式。结果存储在拟合数据框中：

    > fit = lm(raw$response ~ raw$predictor1_3)

打印拟合数据框：

    > fit

结果如下：

绘制普通最小二乘估计公式。plot() 函数是用于绘制 R 对象的通用函数。raw$response ~ raw$predictor1_3 公式作为函数值传递：

    > plot(raw$response ~ raw$predictor1_3, pch=16, cex=.4, xlab="Predictor", ylab="Response", col ="red", main="Simulated Data with Slight Curve")

结果如下：

在当前图表上添加直线函数：

    > abline(fit)

结果如下：

在 x 轴上拟合汽车和速度的值：

    > x_axis <- with(cars, speed)

在 y 轴上拟合汽车和速度的值：

    > y_axis <- with(cars, dist)

设置平滑曲线评估的点数：

    > eval_length = 50

第 3 步 - 拟合平滑曲线模型

在两个变量之间拟合平滑曲线是一种非参数方法，因为传统回归方法的线性假设已经被放宽。它被称为局部回归，因为在点 x 处的拟合是加权向 x 附近的数据：

loess.smooth()函数在散点图上绘制并添加计算出的平滑曲线。x_axis，y_axis是提供给绘图 x 和 y 坐标的参数。例如evaluation = eval.length，eval_length = 50表示平滑曲线评估的点数。span=.75是平滑度参数。degree=1是局部多项式的次数：

> fit_loess <- loess.smooth(x_axis, y_axis, evaluation = eval_length, family="gaussian", span=.75, degree=1) 

打印fit_loess数据框：

    > fit_loess

结果如下：

在一个或多个数值预测的基础上，使用局部拟合拟合多项式表面。loess()函数拟合多项式表面。y_axis ~ x_axis表示公式。span=.75是平滑度参数。degree=1是局部多项式的次数：

    > fit_loess_2 <- loess(y_axis ~ x_axis, family="gaussian", span=.75, degree=1)

打印fit_loess_2数据框：

    > fit_loess_2

结果如下：

生成y轴最小值和最大值的常规序列。Seq()函数接受length.out=eval_length，例如eval_length = 50，表示从x轴的最小值和最大值生成的序列的期望长度：

    > new_x_axis = seq(min(x_axis),max(x_axis), length.out=eval_length)

打印new_x_axis数据框：

    > new_x_axis

结果如下：

在fit.loess模型上设置 95%的置信水平：

> conf_int = cbind( 
 + predict(fit_loess_2, data.frame(x=new_x_axis)), 
 + predict(fit_loess_2, data.frame(x=new_x_axis))+ 
 + predict(fit_loess_2, data.frame(x=new_x_axis), se=TRUE)$se.fit*qnorm(1-.05/2), 
 + predict(fit_loess_2, data.frame(x=new_x_axis))- 
+ predict(fit_loess_2, data.frame(x=new_x_axis), se=TRUE)$se.fit*qnorm(1-.05/2) 
 + )

使用y_axis ~ x_axis作为公式构建普通最小二乘估计。使用lm()函数拟合线性模型。y_axis ~ x_axis是公式。结果存储在fit_lm数据框中：

    > fit_lm = lm(y_axis ~ x_axis)

打印fit_lm数据框：

    > fit_lm

结果如下：

构建多项式函数。y_axis ~ poly(x_axis,3)是具有三个自由度的多项式函数。使用lm()函数拟合线性模型。y_axis ~ poly(x_axis,3)是公式。结果存储在fit_poly数据框中：

    > fit_poly = lm(y_axis ~ poly(x_axis,3) )

打印fit_poly数据框：

    > fit_poly

结果如下：

构建自然样条函数。y_axis ~ ns(x_axis, 3)是具有 3 个自由度的自然样条函数。使用lm()函数拟合线性模型。y_axis ~ ns(x_axis, 3)是公式。结果存储在fit_nat_spline数据框中：

    > fit_nat_spline = lm(y_axis ~ ns(x_axis, 3) )

打印fit_nat_spline数据框：

    > fit_nat_spline

结果如下：

样条曲线的平滑处理：

    > fit_smth_spline <- smooth.spline(y_axis ~ x_axis, nknots=15)

打印fit_smth_spline数据框：

    > fit_smth_spline

结果如下：

步骤 4 - 绘制结果

绘制模型：

    > plot(x_axis, y_axis, xlim=c(min(x_axis),max(x_axis)), ylim=c(min(y_axis),max(y_axis)), pch=16, cex=.5, ylab = "Stopping Distance (feet)", xlab= "Speed (MPH)", main="Comparison of Models", sub="Splines")

结果如下：

向图中添加额外的模型。绘制带有置信区间的 LOESS：

    > matplot(new_x_axis, conf_int, lty = c(1,2,2), col=c(1,2,2), type = "l", add=T)

结果如下：

绘制普通最小二乘估计。predict() 函数根据线性模型预测值。fit_lm 是 lm 类的对象：

    > lines(new_x_axis, predict(fit_lm, data.frame(x=new_x_axis)), col="red", lty=3)

结果如下：

绘制多项式函数估计：

    > lines(new_x_axis, predict(fit_poly, data.frame(x=new_x_axis)), col="blue", lty=4)

结果如下：

绘制自然样条函数：

    > lines(new_x_axis, predict(fit_nat_spline, data.frame(x=new_x_axis)), col="green", lty=5)

结果如下：

绘制平滑样条：

    > lines(fit_smth_spline, col="dark grey", lty=6)

结果如下：

绘制核曲线。ksmooth() 函数：

    > lines(ksmooth(x_axis, y_axis, "normal", bandwidth = 5), col = 'purple', lty=7)

结果如下：

局部回归 - 理解干旱预警和影响

干旱是一种自然灾害，其特征是低于预期的或低于正常水平的降雨。当这种状况在超过正常时间周期的更长时期内持续时，不足以满足人类活动的需求，对环境有害。干旱是一种暂时现象。干旱的三个主要特征是强度、持续时间和空间覆盖范围。干旱预警系统可以帮助识别气候变化，了解供水趋势，并为即将到来的紧急情况做好准备。干旱预警可以帮助决策者采取适当的措施来应对即将到来的挑战。然后，他们可以衡量影响的严重程度，并了解特定地点、特定人群或经济部门脆弱性的潜在原因，以降低风险。

准备就绪

让我们从配方开始。

第 1 步 - 收集和描述数据

dataRetrieval 包是一组函数，用于帮助检索美国地质调查局（USGS）和美国环境保护署（EPA）。

如何操作...

让我们深入了解细节。

第 2 步 - 收集和探索数据

第一步是加载以下包：

> library(dataRetrieval)
> library(dplyr)

获取站点编号。站点编号通常是一个八位数的数字，它被表示为一个字符串或向量：

> siteNumber <- c("01538000") 

获取参数代码：

    > parameterCd <- "00060"

使用站点编号和参数代码从 NWIS 网络服务导入数据。结果存储在 Q_daily 数据框中：

    > Q_daily <- readNWISdv(siteNumber, parameterCd)

打印 Q_daily 数据框。tail() 函数返回 Q_daily 数据框的最后部分。Q_daily 数据框作为输入参数传递：

    > tail(Q_daily)

结果如下：

探索 Q_daily 数据框的内部结构。str() 函数显示数据框的内部结构。Q_daily 作为 R 对象传递给 str() 函数：

    > str(Q_daily)

结果如下：

重命名列 -- renameNWISColumns() 函数重命名从 NWIS 获取的列。Q_daily 是从 NWIS 网站获取的每日或单位值数据集：

    > Q_daily <- renameNWISColumns(Q_daily)

打印重命名的 Q_daily 数据框。tail() 函数返回 Q_daily 数据框的最后部分。Q_daily 数据框作为输入参数传递：

    > tail(Q_daily)

结果如下：

从 USGS 文件站点导入数据。readNWISsite() 函数使用 8 位数字的 siteNumber，它代表 USGS 站点编号。结果存储在 stationInfo 数据框中：

    > stationInfo <- readNWISsite(siteNumber)

步骤 3 - 计算移动平均

检查缺失天数：

> if(as.numeric(diff(range(Q_daily$Date))) != (nrow(Q_daily)+1)){
+ fullDates <- seq(from=min(Q_daily$Date),
+ to = max(Q_daily$Date), by="1 day")
+ fullDates <- data.frame(Date = fullDates,
+ agency_cd = Q_daily$agency_cd[1],
+ site_no = Q_daily$site_no[1],
+ stringsAsFactors = FALSE)
+ Q_daily <- full_join(Q_daily, fullDates,
+ by=c("Date","agency_cd","site_no")) %>%
+ arrange(Date)
+ }

计算 30 天的移动平均。filter() 函数对时间序列应用线性滤波。sides=1，仅对过去值应用滤波系数：

> moving_avg <- function(x,n=30){stats::filter(x,rep(1/n,n), sides=1)}     > 
Q_daily <- Q_daily %>% mutate(rollMean = as.numeric(moving_avg(Flow)), day.of.year = as.numeric(strftime(Date, format = "%j")))

打印 Q_daily 数据框。tail() 函数返回 Q_daily 数据框的最后部分。Q_daily 数据框作为输入参数传递：

    > tail(Q_daily)

结果如下：

步骤 4 - 计算百分位数

计算历史百分位数。使用相应的概率计算各种分位数。然后，使用 summarize() 函数将数据框折叠成单行。最后，使用 group_by() 函数，将结果（以表格形式）转换为并分组到表格中：

> Q_summary >- Q_daily %>%
+ group_by(day.of.year) %>%
+ summarize(p75 = quantile(rollMean, probs = .75, na.rm = TRUE),
+ p25 = quantile(rollMean, probs = .25, na.rm = TRUE),
+ p10 = quantile(rollMean, probs = 0.1, na.rm = TRUE),
+ p05 = quantile(rollMean, probs = 0.05, na.rm = TRUE),
+ p00 = quantile(rollMean, probs = 0, na.rm = TRUE))

从系统中获取当前年份：

> current_year <- as.numeric(strftime(Sys.Date(), format = "%Y"))
> summary.0 <- Q_summary %>% mutate(Date = as.Date(day.of.year - 1,
origin = paste0(current_year-2,"-01-01")), day.of.year = day.of.year - 365)
> summary.1 <- Q_summary %>% mutate(Date = as.Date(day.of.year - 1,
origin = paste0(current_year-1,"-01-01")))
> summary.2 <- Q_summary %>% mutate(Date = as.Date(day.of.year - 1,
origin = paste0(current_year,"-01-01")), day.of.year = day.of.year + 365)

合并每个数据框：

    > Q_summary <- bind_rows(summary.0, summary.1, summary.2) 

打印 Q_summary 数据框：

    > Q_summary

结果如下：

    > smooth.span <- 0.3

根据线性模型预测值并拟合多项式曲面。loess() 函数拟合多项式曲面。p75~day.of.year 表示公式，而 span = smooth.span 例如 smooth.span= 0.3 控制平滑程度：

    > Q_summary$sm.75 <- predict(loess(p75~day.of.year, data = Q_summary, span = smooth.span))

打印 Q_summary$sm.75 数据框：

    > head(Q_summary$sm.75)

结果如下：

    > Q_summary$sm.25 <- predict(loess(p25~day.of.year, data = Q_summary, span = smooth.span))

打印 Q_summary$sm.25 数据框：

    > head(summaryQ$sm.25)

结果如下：

    > Q_summary$sm.10 <- predict(loess(p10~day.of.year, data = Q_summary, span = smooth.span))

打印 Q_summary$sm.10 数据框：

    > head(summaryQ$sm.10)

结果如下：

    > Q_summary$sm.05 <- predict(loess(p05~day.of.year, data = Q_summary, span = smooth.span))

打印 Q_summary$sm.05 数据框：

    > head(summaryQ$sm.05)

结果如下：

    > Q_summary$sm.00 <- predict(loess(p00~day.of.year, data = Q_summary, span = smooth.span))

打印 Q_summary$sm.05 数据框：

    > head(summaryQ$sm.00)

结果如下：

    > Q_summary <- select(Q_summary, Date, day.of.year, sm.75, sm.25, sm.10, sm.05, sm.00) %>% filter(Date >= as.Date(paste0(current_year-1,"-01-01")))

打印 Q_summary 数据框：

    > Q_summary

结果如下：

    > latest.years <- Q_daily %>% filter(Date >= as.Date(paste0(current_year-1,"-01-01"))) %>% mutate(day.of.year = 1:nrow(.))

步骤 5 - 绘制结果

绘制数据：

> title.text <- paste0(stationInfo$station_nm,"n", "Provisional Data - Subject to changen", "Record Start = ", min(Q_daily$Date), "  Number of years = ", as.integer (as.numeric(difftime(time1 = max(Q_daily$Date), time2 = min(Q_daily$Date), units = "weeks"))/52.25), "nDate of plot = ",Sys.Date(), "  Drainage Area = ",stationInfo$drain_area_va, "mi²")     > mid.month.days <- c(15, 45, 74, 105, 135, 166, 196, 227, 258, 288, 319, 349)     > month.letters <- c("J","F","M","A","M","J","J","A","S","O","N","D")     > start.month.days <- c(1, 32, 61, 92, 121, 152, 182, 214, 245, 274, 305, 335)     > label.text <- c("Normal","DroughtWatch","DroughtWarning","Drought Emergency")     > year1_summary <- data.frame(Q_summary[2:366,])     > head(year1_summary) 

结果如下：

    > year2_summary <- data.frame(Q_summary[367:733,])     
> head(year2_summary)

结果如下：

> simple.plot <- ggplot(data = Q_summary, aes(x = day.of.year)) + 
+ geom_ribbon(aes(ymin = sm.25, ymax = sm.75, fill = "Normal")) + 
    + geom_ribbon(aes(ymin = sm.10, ymax = sm.25, fill =       "Drought Watch")) +
    + geom_ribbon(aes(ymin = sm.05, ymax = sm.10, fill = "Drought Warning")) +
+ geom_ribbon(aes(ymin = sm.00, ymax = sm.05, fill = "Drought Emergency")) + 
+ scale_y_log10(limits = c(1,1000)) + 
+ geom_line(data = latest.years, aes(x=day.of.year, y=rollMean, color = "30-Day Mean"),size=2) + 
+ geom_vline(xintercept = 365) 
    > simple.plot

结果如下：

第六章. 监督学习

在本章中，我们将涵盖以下内容：

• 决策树学习 - 胸痛患者的健康指导

• 决策树学习 - 房地产价值基于收入的分布

• 决策树学习 - 预测股票运动的方向

• 朴素贝叶斯 - 预测股票运动的方向

• 随机森林 - 货币交易策略

• 支持向量机 - 货币交易策略

• 随机梯度下降 - 成人收入

简介

决策树学习：决策树是分类和预测问题中非常流行的工具。决策树是一种递归地将实例空间或变量集进行划分的分类器。决策树以树结构表示，其中每个节点可以分类为叶节点或决策节点。叶节点包含目标属性的值，而决策节点指定对单个属性值要实施的规则。每个决策节点根据输入属性值的某个离散函数将实例空间划分为两个或更多子空间。每个测试考虑一个属性，因此实例空间根据属性值进行划分。在数值属性的情况下，条件指的是一个范围。在决策节点上实施规则后，子树是一个结果。每个叶节点都包含一个概率向量，表示目标属性具有某个值的概率。通过沿着路径的测试结果，从树的根节点导航到叶节点来对实例进行分类。

使用决策树挖掘数据的关键要求如下：

• 属性值描述：对象可以用一组固定的属性或属性来表示

• 预定义类别：要分配给示例的类别必须是监督数据

• 充足数据：使用多个训练案例

朴素贝叶斯：朴素贝叶斯是一种监督学习方法。它是一个线性分类器。它基于贝叶斯定理，该定理表明一个类别的特定特征的存在与任何其他特征的存在无关。它是一个健壮且高效的算法。贝叶斯分类器可以预测类成员概率，例如给定元组属于特定类的概率。贝叶斯信念网络是联合条件概率分布。它允许在变量子集之间定义类条件独立性。它提供了一个因果关系的图形模型，可以在其上进行学习。

随机森林：随机森林是决策树的集合，提供对数据结构的预测。它们是利用多个决策树在合理随机化、集成学习中的力量来产生预测模型的一种工具。它们为每个记录提供变量排名、缺失值、分割和报告，以确保深入理解数据。在每棵树构建完成后，所有数据都会通过树。对于每一对案例，计算邻近区域。如果两个案例占据相同的终端节点，它们的邻近区域增加一。运行结束后，通过树的数量进行归一化。邻近区域用于替换缺失数据、定位异常值和揭示数据的低维理解。训练数据，即袋外数据，用于估计分类错误和计算变量的重要性。

随机森林在大数据库上运行非常高效，产生准确的结果。它们处理多个变量而不删除，给出变量对解决分类问题重要性的估计。它们在森林构建过程中生成内部无偏估计的泛化误差。随机森林是估计缺失数据的有效方法，并且在大量数据缺失时保持准确性。

支持向量机：机器学习算法使用正确的特征集来解决学习问题。SVMs 利用一个（非线性）映射函数φ，将输入空间中的数据转换为特征空间中的数据，以便使问题线性可分。然后 SVM 发现最优的分离超平面，然后通过φ-1 将其映射回输入空间。在所有可能超平面中，我们选择距离最近数据点（边缘）距离尽可能大的那个超平面。

决策树学习 - 胸痛患者的健康指导文件

健康指导文件声明了关于个人在各种医疗条件下未来医疗保健的指示。它指导个人在紧急情况下或需要时做出正确的决定。该文件帮助个人了解其医疗保健决策的性质和后果，了解指导的性质和影响，自由自愿地做出这些决定，并以某种方式传达这些决定。

准备工作

为了执行决策树分类，我们将使用从心脏病患者数据集中收集的数据集。

第 1 步 - 收集和描述数据

将使用标题为Heart.csv的数据集，该数据集以 CSV 格式提供。数据集是标准格式。有 303 行数据。有 15 个变量。数值变量如下：

• Age

• Sex

• RestBP

• Chol

• Fbs

• RestECG

• MaxHR

• ExAng

• Oldpeak

• Slope

• Ca

非数值变量如下：

• ChestPain

• Thal

• AHD

如何做...

让我们深入了解。

第 2 步 - 探索数据

以下包需要在第一步执行时加载：

> install.packages("tree")
> install.packages("caret")
> install.packages("e1071")
> library(tree)
> library(caret)

注意

版本信息：本页面的代码在 R 版本 3.3.0（2016-05-03）上进行了测试。

让我们探索数据并了解变量之间的关系。我们将首先导入名为 Heart.csv 的 CSV 数据文件。我们将数据保存到 AHD_data 数据框中：

    > AHD_data <- read.csv("d:/Heart.csv", header = TRUE)

探索 AHD_data 数据框的内部结构。str() 函数显示数据框的内部结构。AHD_data 作为 R 对象传递给 str() 函数：

> str(AHD_data) 

结果如下：

打印 AHD_data 数据框。head() 函数返回 AHD_data 数据框的前部分。AHD_data 数据框作为输入参数传递：

    > head(AHD_data)

结果如下：

探索 AHD_data 数据框的维度。dim() 函数返回 AHD_data 数据框的维度。将 AHD_data 数据框作为输入参数传递。结果清楚地表明有 303 行数据和 15 列：

    >dim(AHD_data)

结果如下：

第 3 步 - 准备数据

需要准备数据以执行模型构建和测试。数据分为两部分--一部分用于构建模型，另一部分用于测试模型，这将准备。

使用 createDataPartition() 函数创建数据的分割。将 AHD_data 作为参数传递给函数。进行随机抽样。表示用于训练的数据百分比的 p。在这里，p 的值为 0.5，这意味着 50% 的数据用于训练。List = 'FALSE' 避免以列表的形式返回数据。结果存储在数据框 split 中：

    > split <- createDataPartition(y=AHD_data$AHD, p = 0.5, list=FALSE)

调用 split 数据框显示用于训练目的的训练集数据：

    > split

结果如下：

将创建训练数据。使用 split 数据框创建训练数据。train 数据框用于存储训练数据的值：

    > train <- AHD_data[split,]

打印训练数据框：

    > train

结果如下：

将创建测试数据。使用 split 数据框创建测试数据。split 数据框前的 - 符号表示所有那些未被考虑用于训练目的的数据行。测试数据框用于存储测试数据的值：

    > test <- AHD_data[-split,]

打印测试数据框：

    > test

结果如下：

第 4 步 - 训练模型

模型现在将被准备并在训练数据集上训练。当数据集被分成组时使用决策树，与调查数值响应及其与一组描述符变量的关系相比。在 R 中使用 tree() 函数实现分类树。

使用 tree() 函数实现分类树。通过二分递归分割来生长树。训练数据集上的 AHD 字段用于形成分类树。结果数据框存储在 trees 数据框中：

    > trees <- tree(AHD ~., train)

将显示数据框的图形版本。plot() 函数是 R 对象绘图的通用函数。将数据框 trees 作为函数值传递：

    > plot(trees)

结果如下：

通过运行交叉验证实验来查找偏差或错误分类的数量。将使用 cv.tree() 函数。将 trees 数据框对象传递。FUN=prune.misclass 通过递归剪掉最不重要的分割来获取提供的 data frame trees 的嵌套子树序列。结果存储在 cv.trees 数据框中：

    > cv.trees <- cv.tree(trees, FUN=prune.misclass)

打印数据框 cv.trees 的结果：

    > cv.trees

$dev 字段给出了每个 K 的偏差。

结果如下：

使用 plot() 函数数据框，显示 cv.trees。$dev 值位于 y 轴（右侧）。$k 值位于顶部。$size 值位于 x 轴。

如清晰可见，当 $size = 1，$k = 30.000000，$dev = 1。我们使用以下方式绘制数据框：

    > plot(cv.trees)

结果如下：

步骤 5 - 改进模型

让我们通过分割偏差最低的树来改进模型。调用 prune.misclass() 函数来分割树。prune.misclass 通过递归剪掉最不重要的分割来获取提供的 data frame trees 的嵌套子树序列。结果存储在 prune.trees 数据框中。best=4 表示要返回的成本-复杂度序列中特定子树的大小（例如，终端节点的数量）：

    > prune.trees <- prune.misclass(trees, best=4)

使用 plot() 函数数据框，显示 prune.trees：

    > plot(prune.trees)

结果如下：

向前面的修剪树添加文本：

    > text(prune.trees, pretty=0)

结果如下：

为了根据线性模型对象预测值，我们将使用 predict() 函数。将 prune.trees 作为对象传递。将 test 数据对象传递作为查找预测变量的对象。结果将存储在 tree.pred 数据框中：

    > tree.pred <- predict(prune.trees, test, type='class')

显示变量 test.pred 的值：

    > tree.pred

结果如下：

总结模型的成果。confusionMatrix() 计算观察到的和预测的类别的交叉表。tree.pred 作为预测类别的因子传递：

    > confusionMatrix(tree.pred, test$AHD)

结果如下：

决策树学习 - 基于收入的房地产价值分布

收入一直是房地产作为一种资产类别提供的具有吸引力的长期总回报的一个基本组成部分。投资房地产产生的年度收入回报比股票高出 2.5 倍以上，仅落后于债券 50 个基点。房地产通常为租户支付的租金提供稳定的收入来源。

准备工作

为了执行决策树分类，我们将使用从房地产数据集中收集的数据集。

步骤 1 - 收集和描述数据

将使用标题为 RealEstate.txt 的数据集。此数据集以 TXT 格式提供，标题为 RealEstate.txt。数据集是标准格式。有 20,640 行数据。9 个数值变量如下：

• MedianHouseValue

• MedianIncome

• MedianHouseAge

• TotalRooms

• TotalBedrooms

• Population

• Households

• Latitude

• Longitude

如何做到这一点...

让我们深入了解细节。

步骤 2 - 探索数据

需要在第一步中加载以下包：

    > install.packages("tree")

注意

版本信息：本页面的代码在 R 版本 3.3.0（2016-05-03）中进行了测试。

让我们探索数据并了解变量之间的关系。我们将从导入名为 RealEstate.txt 的 TXT 数据文件开始。我们将数据保存到 realEstate 数据框中：

    > realEstate <- read.table("d:/RealEstate.txt", header=TRUE)

探索 realEstate 数据框的维度。dim() 函数返回 realEstate 框的维度。realEstate 数据框作为输入参数传递。结果清楚地表明有 20,640 行数据和 9 列：

    > dim(realEstate)

结果如下：

探索 realEstate 数据框的内部结构。str() 函数显示数据框的内部结构。realEstate 作为 R 对象传递给 str() 函数：

    > str(realEstate)

结果如下：

打印 realEstate 数据框。head() 函数返回 realEstate 数据框的前部分。realEstate 数据框作为输入参数传递：

    > head(realEstate)

结果如下：

打印 realEstate 数据框的摘要。summary() 函数是一个多功能函数。summary() 是一个通用函数，它提供与单个对象或数据框相关的数据摘要。realEstate 数据框作为 R 对象传递给 summary() 函数：

    > summary(realEstate)

结果如下：

步骤 3 - 训练模型

模型现在将在数据集上准备。决策树是分类和预测的工具。它们代表人类可以理解并用于如数据库等知识系统的规则。它们通过从树的根开始并移动到叶节点来对实例进行分类。节点指定对单个属性的测试，叶节点指示目标属性的值，边分割出一个属性。

使用tree()函数实现分类树。通过二元递归分区来生长树。这些模型是计算密集型技术，因为它们根据响应变量与一个或多个预测变量的关系递归地将响应变量分割成子集。

公式表达式基于变量纬度和经度的总和。总和的结果存储在MedianHouseValue的对数值中。data=realEstate表示优先解释公式、权重和子集的数据框。

结果数据框存储在数据框treeModel中：

> treeModel <- tree(log(MedianHouseValue) ~ Longitude + Latitude, data=realEstate) 

将显示treeModel的摘要。摘要显示了所使用的公式，以及树中的终端节点或叶子的数量。还显示了残差的统计分布。

使用summary()函数显示treeModel的统计摘要。它是一个泛型，用于生成各种拟合函数的结果摘要。希望进行摘要的数据框是treeModel，它作为输入参数传递。

在这里，偏差表示均方误差：

    > summary(treeModel)

结果如下：

将显示treeModel数据框的图形版本。plot()函数是用于绘制 R 对象的泛型函数。treeModel数据框作为函数值传递：

> plot(treeModel) 

结果如下：

在显示treeModel数据框的图形版本后，需要插入文本以显示每个节点和叶子的值。使用text()函数在给定的坐标处插入标签向量中给出的字符串：

    > text(treeModel, cex=.75)

结果如下：

第 4 步 - 比较预测

将预测与反映全球价格趋势的数据集进行比较。我们希望总结MedianHouseValue的频率分布，以便于报告或比较。最直接的方法是使用分位数。分位数是分布中的点，与该分布中值的排名顺序相关。分位数将分割MedianHouseValue分布，使得观测值在分位数下方的比例是给定的。

quantile() 函数产生与给定概率相对应的样本分位数。realEstate$MedianHouseValue 是想要样本分位数的数值向量。quantile() 函数返回长度为的 priceDeciles 向量：

    > priceDeciles <- quantile(realEstate$MedianHouseValue, 0:10/10)

显示 priceDeciles 数据框的值：

    > priceDeciles

结果如下：

接下来，将显示 priceDeciles 的摘要。使用 summary() 函数显示 priceDeciles 的统计摘要。希望摘要的数据框是 priceDeciles，它作为输入参数传递：

    > summary(priceDeciles)

结果如下：

将 priceDeciles 向量划分为不同的范围。cut() 函数根据它们所属的区间来划分区间范围。realEstate 数据框中的数值向量 MedianHouseValue 需要通过切割转换为因子：

    > cutPrices <- cut(realEstate$MedianHouseValue, priceDeciles, include.lowest=TRUE)

打印 cutPrices 数据框。head() 函数返回 cutPrices 数据框的前部分。cutPrices 数据框作为输入参数传递：

    > head(cutPrices)

结果如下：

将显示 cutPrices 的摘要。使用 summary() 函数显示 treeModel 的统计摘要。希望摘要的数据框是 cutPrices，它作为输入参数传递：

    > summary(cutPrices)

结果如下：

绘制 cutPrices 的值。plot() 函数是 R 对象绘图的通用函数。realEstate 数据集中的经度变量代表图中点的 x 坐标。realEstate 数据集中的纬度变量代表图中点的 y 坐标。col=grey(10:2/11) 代表绘图颜色。pch=20 代表在绘图点时使用的符号大小。xlab="Longitude" 代表 x 轴的标题，而 ylab="Latitude" 代表 y 轴的标题：

> plot(realEstate$Longitude, realEstate$Latitude, col=grey(10:2/11)[cutPrices], pch=20, xlab="Longitude",ylab="Latitude") 

结果如下：

将显示 Longitude 的摘要。使用 summary() 函数显示统计摘要：

    > summary(realEstate$Longitude)

结果如下：

打印 Longitude 数据框。head() 函数返回 Longitude 数据框的前部分：

    > head(realEstate$Longitude)

结果如下：

将显示 Latitude 的摘要。使用 summary() 函数显示统计摘要：

    > summary(realEstate$Latitude)

结果如下：

打印 纬度 数据框。head() 函数返回 纬度 数据框的前部分：

    > head(realEstate$Latitude)

结果如下：

使用 partition.tree() 函数对涉及两个或更多变量的树进行分区。treeModel 作为树对象传递。ordvars=c("经度","纬度") 表示用于绘图的变量顺序。经度代表 x 轴，而 纬度 代表 y 轴。add=TRUE 表示添加到现有图形：

    > partition.tree(treeModel, ordvars=c("Longitude","Latitude"), add=TRUE)

结果如下：

步骤 5 - 改进模型

树中的叶子节点数量控制着树的灵活性。叶子节点的数量表示它们将树分割成多少个单元格。每个节点必须包含一定数量的点，并且添加节点必须至少减少一定的错误。min.dev 的默认值是 0.01。

接下来，我们将 min.dev 的值降低到 0.001。

使用 tree() 函数实现分类树。公式表达式基于变量 纬度 和 经度 的总和。总和的结果存储在 MedianHouseValue 的对数值中。data=realEstate 表示在其中的数据框中优先解释公式、权重和子集。min.dev 的值表示必须至少是根节点偏差的 0.001 倍才能进行节点分割。

结果数据框存储在 treeModel2 数据框中：

    > treeModel2 <- tree(log(MedianHouseValue) ~ Longitude + Latitude, data=realEstate, mindev=0.001)

将显示 treeModel2 的摘要。摘要显示使用的公式，以及树中的终端节点或叶子节点的数量。还显示了残差的统计分布。

使用 summary() 函数显示 treeModel2 的统计摘要。希望进行摘要的数据框是 treeModel2，它作为输入参数传递。

偏差在这里意味着均方误差：

    > summary(treeModel2)

结果如下：

与 treeModel 的摘要相比，treeModel2 中的叶子节点值从 12 增加到 68。对于 treeModel 和 treeModel2，偏差值分别从 0.1666 变为 0.1052。

将显示 treeModel2 数据框的图形版本。plot() 函数是用于绘图 R 对象的通用函数。将 treeModel2 数据框作为函数值传递：

    > plot(treeModel2)

结果如下：

在显示 treeModel2 数据框的图形版本后，需要插入文本以显示每个节点和叶子节点的值。使用 text() 函数在给定的坐标处插入向量标签中给出的字符串：

    > text(treeModel2, cex=.65)

结果如下：

在公式扩展中包含所有变量。

使用tree()函数实现分类树。公式表达式基于所有变量。

结果数据框存储在treeModel3数据框中：

    > treeModel3 <- tree(log(MedianHouseValue) ~ ., data=realEstate)

将显示treeModel3的摘要。摘要显示了使用的公式以及树中的终端节点或叶子节点的数量。还显示了残差的统计分布。

使用summary()函数显示treeModel3的统计摘要。希望进行摘要的数据框是treeModel3，它作为输入参数传递。

偏差在这里表示均方误差：

    > summary(treeModel3)

结果如下：

公式明确指出realEstate数据集中的所有变量。

将显示treeModel3数据框的图形版本。plot()函数是用于绘制 R 对象的通用函数。treeModel3数据框作为函数值传递：

    > plot(treeModel3)

结果如下：

在显示treeModel3数据框的图形版本后，需要插入文本以显示每个节点和叶子节点的值。使用text()函数在给定的坐标处插入向量标签中的字符串：

    > text(treeModel3, cex=.75)

结果如下：

决策树学习 - 预测股票运动方向

股票交易是统计学家试图解决的最具挑战性的问题之一。有多个技术指标，例如趋势方向、动量或市场中的动量不足、盈利潜力的波动性和用于监测市场流行度的成交量等。这些指标可以用来创建策略以创造高概率的交易机会。可以花费数天/周/月来发现技术指标之间的关系。可以使用像决策树这样的高效且节省时间的工具。决策树的主要优势是它是一个强大且易于解释的算法，为良好的起点提供了帮助。

准备工作

为了执行决策树分类，我们将使用从股票市场数据集中收集的数据集。

第 1 步 - 收集和描述数据

要使用的数据集是美国银行 2012 年 1 月 1 日至 2014 年 1 月 1 日的每日收盘价。此数据集在yahoo.com/上免费提供，我们将从那里下载数据。

如何做到这一点...

让我们深入了解。

第 2 步 - 探索数据

需要在第一步加载以下包：

> install.packages("quantmod")
> install.packages("rpart")
> install.packages("rpart.plot")

注意

版本信息：本页面的代码在 R 版本 3.3.0（2016-05-03）上进行了测试。

上述每个库都需要安装：

> library("quantmod")
> library("rpart")
> library("rpart.plot")

让我们下载数据。我们将首先标记所需数据的时间段的开始和结束日期。

使用as.Date()函数将字符表示和Date类的对象转换为日历日期。

数据集的起始日期存储在startDate中，它代表日历日期的字符向量表示。表示的格式为YYYY-MM-DD：

    > startDate = as.Date("2012-01-01")

数据集的结束日期存储在endDate中，它代表日历日期的字符向量表示。表示的格式为YYYY-MM-DD：

    > endDate = as.Date("2014-01-01")

使用getSymbols()函数加载数据。该函数从多个来源加载数据，无论是本地还是远程。数据被检索并存储在指定的env中。env的默认值是.GlobalEnv。BAC是字符向量，指定要加载的符号名称。src = yahoo指定数据来源方法：

    > getSymbols("BAC", env = .GlobalEnv,  src = "yahoo", from = startDate, to = endDate)

步骤 3 - 计算指标

相对强弱指数（Relative Strength Index）已计算。它是最近上升价格变动与绝对价格变动的比率。使用RSI()函数来计算相对强弱指数。BAC符号用作价格序列。n = 3代表移动平均的周期数。结果存储在relativeStrengthIndex3数据框中：

> relativeStrengthIndex3 <- RSI(Op(BAC), n= 3) 

显示relativeStrengthIndex3的值：

    > relativeStrengthIndex3

结果如下：

计算移动平均。指数移动平均用于技术分析和作为技术指标。在简单移动平均中，序列中的每个值具有相等的权重。时间序列之外的价值不包括在平均中。然而，指数移动平均是一个累积计算，包括所有数据。过去的数据具有递减的价值，而最近的数据值具有更大的贡献。

EMA()使用BAC符号，并用作价格序列。n = 5代表平均的时间周期。结果存储在exponentialMovingAverage5数据框中：

    > exponentialMovingAverage5 <- EMA(Op(BAC),n=5)

显示exponentialMovingAverage5的值：

    > exponentialMovingAverage5

结果如下：

探索exponentialMovingAverage5数据框的维度。dim()函数返回exponentialMovingAverage5框架的维度。将exponentialMovingAverage5数据框作为输入参数传递。结果清楚地表明有 502 行数据和 1 列：

    > dim(exponentialMovingAverage5)

结果如下：

探索exponentialMovingAverage5数据框的内部结构。str()函数显示数据框的内部结构。将exponentialMovingAverage5作为 R 对象传递给str()函数：

    > str(exponentialMovingAverage5)

结果如下：

计算价格和计算出的exponentialMovingAverage5（例如，五年指数移动平均值）之间的差异。结果存储在exponentialMovingAverageDiff数据框中：

    > exponentialMovingAverageDiff <- Op(BAC)-exponentialMovingAverage5

比较 BAC 系列快速移动平均与 BAC 系列慢速移动平均。BAC作为价格矩阵传递。fast = 12表示快速移动平均的周期数，slow = 26表示慢速移动平均的周期数，signal = 9表示移动平均的信号：

    > MACD <- MACD(Op(BAC),fast = 12, slow = 26, signal = 9)

显示 MACD 值：

    > MACD

结果如下：

打印 MACD 数据框。head()函数返回MACD数据框的第一部分。MACD数据框作为输入参数传递：

    > head(MACD)

结果如下：

捕获信号线作为指标。结果存储在MACDsignal数据框中：

    > MACDsignal <- MACD[,2]

显示MACDsignal值：

    > MACDsignal

结果如下：

确定收盘价相对于高低范围的中间位置。为了确定每天收盘价相对于高低范围的位置，使用随机振荡器。SMI()函数用于动量指标。

BAC是包含高低收盘价矩阵。n = 13表示周期数。slow=25表示双平滑的周期数。fast=2表示初始平滑的周期数。signal=9表示信号线的周期数。结果存储在stochasticOscillator数据框中：

    > stochasticOscillator <- SMI(Op(BAC),n=13,slow=25,fast=2,signal=9)

显示stochasticOscillator值：

    > stochasticOscillator

结果如下：

捕获振荡器作为指标。结果存储在stochasticOscillatorSignal数据框中：

    > stochasticOscillatorSignal <- stochasticOscillator[,1]

显示stochasticOscillatorSignal值：

    > stochasticOscillatorSignal

结果如下：

第 4 步 - 准备变量以构建数据集

计算收盘价和开盘价之间的差异。Cl代表收盘价，Op代表开盘价。结果存储在PriceChange数据框中：

    > PriceChange <- Cl(BAC) - Op(BAC)

显示PriceChange值：

    > PriceChange

结果如下：

创建一个二元分类变量。ifelse()函数使用一个测试表达式来返回值，该值本身是一个向量，其长度与测试表达式相同。如果test表达式的对应值为TRUE，则返回x中的元素；如果test表达式的对应值为FALSE，则返回y中的元素。

在这里，PriceChange>0 是测试函数，将在逻辑模式下进行测试。UP 和 DOWN 执行逻辑测试。结果随后存储在 binaryClassification 数据框中：

    > binaryClassification <- ifelse(PriceChange>0,"UP","DOWN")

显示 binaryClassification 值：

    > binaryClassification

结果如下：

探索 binaryClassification 数据框的内部结构。str() 函数显示数据框的内部结构。binaryClassification 作为 R 对象传递给 str() 函数：

    > str(binaryClassification)

结果如下：

创建要使用的数据集。data.frame() 函数用于根据紧密耦合的变量集创建数据框。这些变量具有矩阵的性质。传递给 data.frame() 的参数变量有 relativeStrengthIndex3、exponentialMovingAverageDiff、MACDsignal、stochasticOscillator 和 binaryClassification。

结果随后存储在 DataSet 数据框中：

> AAPLDataSetNew >-
data.frame(weekDays,exponentialMovingAverageDiffRound,
binaryClassification) 

显示 DataSet 值：

    > DataSet

结果如下：

打印 DataSet 数据框。head() 函数返回 DataSet 数据框的第一部分。DataSet 数据框作为输入参数传递：

    > head(DataSet)

结果如下：

探索 DataSet 数据框的内部结构。str() 函数显示数据框的内部结构。DataSet 作为 R 对象传递给 str() 函数：

    > str(DataSet)

结果如下：

命名列。c() 函数用于将参数组合成向量。

传递给 c() 函数的参数变量有 relativeStrengthIndex3、exponentialMovingAverageDiff、MACDsignal、stochasticOscillator 和 binaryClassification：

    > colnames(DataSet) <- c("relativeStrengthIndex3", "exponentialMovingAverageDiff", "MACDsignal", "stochasticOscillator", "binaryClassification")

显示 colnames(DataSet) 值：

    > colnames(DataSet)

结果如下：

删除要计算指标的数据：

    > DataSet <- DataSet[-c(1:33),]

显示 DataSet 值：

    > DataSet

结果如下：

打印 DataSet 数据框。head() 函数返回 DataSet 数据框的第一部分。DataSet 数据框作为输入参数传递：

    > head(DataSet)

结果如下：

探索 DataSet 数据框的内部结构。str() 函数显示数据框的内部结构。DataSet 作为 R 对象传递给 str() 函数：

    > str(DataSet)

结果如下：

探索DataSet数据框的维度。dim()函数返回DataSet框的维度。将DataSet数据框作为输入参数传递。结果显示，共有 469 行数据和 5 列：

    > dim(DataSet)

结果如下：

构建训练数据集。DataSet数据框中的三分之二元素将用作训练数据集，而DataSet数据框中的一分之一元素将用作测试数据集。

训练数据集将存储在TrainingDataSet中：

    > TrainingDataSet <- DataSet[1:312,]

显示TrainingDataSet的值：

    > TrainingDataSet

结果如下：

探索TrainingDataSet数据框的内部结构。str()函数显示数据框的内部结构。将TrainingDataSet作为 R 对象传递给str()函数：

    > str(TrainingDataSet)

结果如下：

训练数据集将存储在TestDataSet中：

    > TestDataSet <- DataSet[313:469,]

显示TestDataSet的值：

    > TestDataSet

结果如下：

探索TestDataSet数据框的内部结构。str()函数显示数据框的内部结构。将TestDataSet作为 R 对象传递给str()函数：

    > str(TestDataSet)

结果如下：

步骤 5 - 构建模型

通过指定指标构建树模型。将使用rpart()函数。它将拟合模型。binaryClassification是结果，使用relativeStrengthIndex3、exponentialMovingAverageDiff、MACDsignal和stochasticOscillator的总和作为预测因子。data=TrainingDataSet表示数据框。cp=.001表示复杂性参数。该参数的主要作用是通过剪枝来节省计算时间。结果随后存储在DecisionTree数据框中：

    > DecisionTree <- rpart(binaryClassification~relativeStrengthIndex3+exponentialMovingAverageDiff+MACDsignal+stochasticOscillator,data=TrainingDataSet, cp=.001)

绘制树模型。将使用prp()函数绘制DecisionTree数据框。type=2将交替节点垂直移动：

    > prp(DecisionTree,type=2)

结果如下：

显示DecisionTree数据框的cp表。使用printcp()函数。将DecisionTree作为输入传递：

    > printcp(DecisionTree)

结果如下：

绘制树的几何平均。使用plotcp()函数。它提供了DecisionTree数据框交叉验证结果的视觉表示：

    > plotcp(DecisionTree,upper="splits")

结果如下：

步骤 6 - 改进模型

在剪枝后改进模型。使用prune()函数。DecisionTree是作为输入传递的数据框。cp=0.041428已被采用，因为这是最低的交叉验证错误值（x 错误）：

    > PrunedDecisionTree <- prune(DecisionTree,cp=0.041428)

绘制tree模型。将使用prp()函数绘制DecisionTree数据框。type=4将交替节点垂直移动：

    > prp(PrunedDecisionTree, type=4)

结果如下：

测试模型：

> table(predict(PrunedDecisionTree,TestDataSet), TestDataSet[,5],dnn=list('predicted','actual')) 

结果如下：

简单贝叶斯 - 预测股票运动的方向

股票交易是统计学家试图解决的最具挑战性的问题之一。市场中有多个技术指标，例如趋势方向、动量或市场动量的缺乏、波动性以衡量盈利潜力，以及用于监控市场流行度的成交量等，仅举几例。这些指标可以用来创建策略以捕捉高概率的交易机会。可能需要花费数日/数周/数月来发现技术指标之间的关系。可以使用像决策树这样的高效且节省时间的工具。决策树的主要优势在于它是一个强大且易于解释的算法，这为良好的起点提供了帮助。

准备工作

为了执行简单贝叶斯，我们将使用从股票市场数据集中收集的数据集。

第 1 步 - 收集和描述数据

要使用的数据集是 2012 年 1 月 1 日至 2014 年 1 月 1 日苹果公司每日收盘价。此数据集在www.yahoo.com/上免费提供，我们将从那里下载数据。

如何做到这一点...

让我们深入了解细节。

第 2 步 - 探索数据

以下包需要在执行第一步时加载：

    > install.packages("quantmod")
    > install.packages("lubridate")
    > install.packages("e1071")

注意

版本信息：本页面的代码在 R 版本 3.3.0（2016-05-03）上进行了测试

以下每个库都需要安装：

    > library("quantmod")
    > library("lubridate")
    > library("e1071")

让我们下载数据。我们首先标记所需数据的时间段的开始和结束日期。

使用as.Date()函数将字符表示和Date类的对象转换为日历日期。

数据集的开始日期存储在startDate中，它表示日历日期的字符向量表示。表示的格式是YYYY-MM-DD：

    > startDate = as.Date("2012-01-01")

数据集的结束日期存储在endDate中，它表示日历日期的字符向量表示。表示的格式是 YYYY-MM-DD：

    > endDate = as.Date("2014-01-01")

使用getSymbols()函数加载数据。该函数从多个来源加载数据，无论是本地还是远程。数据被检索并保存在指定的env中。对于env，默认值是.GlobalEnv。AAPL是字符向量，指定要加载的符号名称。src = yahoo指定了数据来源方法：

    > getSymbols("AAPL", env = .GlobalEnv, src = "yahoo", from = startDate,  to = endDate)

探索数据可用的星期几。使用 wday() 函数。该函数以十进制格式返回星期几。AAPL 代表数据框。label = TRUE 将星期几显示为字符串，例如，星期日。结果随后存储在 weekDays 数据框中：

    > weekDays <- wday(AAPL, label=TRUE)

打印 weekDays 数据框。head() 函数返回 weekDays 数据框的前部分。将 weekDays 数据框作为输入参数传递：

    > head(weekDays)

结果如下：

第 3 步 - 准备构建数据集的变量

计算收盘价和开盘价之间的差异。Cl 代表收盘价，Op 代表开盘价。结果存储在 changeInPrices 数据框中：

    > changeInPrices <- Cl(AAPL) - Op(AAPL)

打印 changeInPrices 数据框。head() 函数返回 changeInPrices 数据框的前部分。将 changeInPrices 数据框作为输入参数传递：

    > head(changeInPrices)

结果如下：

探索价格变化的摘要。使用 summary() 函数。该函数提供一系列描述性统计，以生成 changeInPrices 数据框的结果摘要：

    > summary(changeInPrices)

结果如下：

探索 changeInPrices 数据框的维度。dim() 函数返回 changeInPrices 框的维度。将 changeInPrices 数据框作为输入参数传递。结果清楚地表明有 502 行数据和 1 列：

    > dim(changeInPrices)

结果如下：

创建一个二元分类变量。ifelse() 函数使用测试表达式返回值，该值本身是一个向量，其长度与测试表达式相同。如果测试表达式的对应值为 TRUE，则从 x 中返回向量中的一个元素，如果测试表达式的对应值为 FALSE，则从 y 中返回。

在这里，changeInPrices>0 是一个测试函数，用于测试逻辑模式。UP 和 DOWN 执行逻辑测试。结果随后存储在 binaryClassification 数据框中：

    > binaryClassification <- ifelse(changeInPrices>0,"UP","DOWN")

显示 binaryClassification 值：

    > binaryClassification

结果如下：

探索价格变化的摘要。使用 summary() 函数。该函数提供一系列描述性统计，以生成 binaryClassification 数据框的结果摘要：

    > summary(binaryClassification)

结果如下：

创建要使用的数据集。使用 data.frame() 函数根据紧密耦合的变量集创建数据框。这些变量具有矩阵的性质。

将作为data.frame()参数传递的变量是weekDays和binaryClassification。结果随后存储在DataSet数据框中：

    > AAPLDataSet <- data.frame(weekDays,binaryClassification)

显示AAPLDataSet值：

    > AAPLDataSet

结果如下：

打印AAPLDataSet数据框。head()函数返回AAPLDataSet数据框的前部分。将AAPLDataSet数据框作为输入参数传递：

    > head(AAPLDataSet)

结果如下：

探索AAPLDataSet数据框的维度。dim()函数返回AAPLDataSet数据框的维度。将AAPLDataSet数据框作为输入参数传递。结果明确指出有 502 行数据和 2 列：

    > dim(AAPLDataSet)

结果如下：

第 4 步 - 构建模型

通过指定指标构建朴素贝叶斯分类器。将使用naiveBayes()函数。该函数使用贝叶斯规则来计算给定一组独立预测变量的后验概率。该函数假设度量预测变量服从高斯分布。"NaiveBayesclassifier"是函数的输出结果，其中独立变量是AAPLDataSet[,1]，因变量是AAPLDataSet[,2]：

    > NaiveBayesclassifier <- naiveBayes(AAPLDataSet[,1], AAPLDataSet[,2])

显示NaiveBayesclassifier结果：

    > NaiveBayesclassifier

结果如下：

结果覆盖整个数据集，并显示价格增加或减少的概率。其本质上是看跌的。

第 5 步 - 创建新的、改进模型的数据

制定一个复杂的策略，展望超过一天。对模型计算 5 年的移动平均。EMA()使用 AAPL 符号作为价格序列。"n = 5"代表平均的时间段。结果随后存储在exponentialMovingAverage5数据框中：

    > exponentialMovingAverage5 <- EMA(Op(AAPL),n = 5)

显示exponentialMovingAverage5值：

    > exponentialMovingAverage5

结果如下：

探索价格变化的摘要。使用summary()函数。该函数提供一系列描述性统计量，以生成exponentialMovingAverage5数据框的结果摘要：

    > summary(exponentialMovingAverage5)

结果如下：

对模型计算 10 年的移动平均。

EMA()使用 AAPL 符号作为价格序列。"n = 10"代表平均的时间段。结果随后存储在exponentialMovingAverage10数据框中：

    > exponentialMovingAverage10 <- EMA(Op(AAPL),n = 10)

显示exponentialMovingAverage10值：

    > exponentialMovingAverage10

结果如下：

探索价格变化的摘要。使用 summary() 函数。该函数提供一系列描述性统计量，以生成 exponentialMovingAverage10 数据框的结果摘要：

    > summary(exponentialMovingAverage10)

结果如下：

探索 exponentialMovingAverage10 数据框的维度。dim() 函数返回 exponentialMovingAverage10 框的维度。将 exponentialMovingAverage10 数据框作为输入参数传递。结果清楚地表明有 502 行数据和 1 列：

    > dim(exponentialMovingAverage10)

结果如下：

计算 exponentialMovingAverage5 和 exponentialMovingAverage10 之间的差异：

    > exponentialMovingAverageDiff <- exponentialMovingAverage5 - exponentialMovingAverage10

显示 exponentialMovingAverageDiff 值：

    > exponentialMovingAverageDiff

结果如下：

探索价格变化的摘要。使用 summary() 函数。该函数提供一系列描述性统计量，以生成 exponentialMovingAverageDiff 数据框的结果摘要：

    > summary(exponentialMovingAverageDiff)

结果如下：

将 exponentialMovingAverageDiff 数据框四舍五入到两位有效数字：

    > exponentialMovingAverageDiffRound <- round(exponentialMovingAverageDiff, 2)

探索价格变化的摘要。使用 summary() 函数。该函数提供一系列描述性统计量，以生成 exponentialMovingAverageDiffRound 数据框的结果摘要：

    > summary(exponentialMovingAverageDiffRound)

结果如下：

步骤 6 - 改进模型

创建用于的数据集。使用 data.frame() 函数根据一组紧密耦合的变量创建数据框。这些变量具有矩阵的性质。传递给 data.frame() 的参数变量是 weekDays、exponentialMovingAverageDiffRound 和 binaryClassification。结果存储在 AAPLDataSetNew 数据框中：

> AAPLDataSetNew <- data.frame(weekDays,exponentialMovingAverageDiffRound, binaryClassification) 

显示 AAPLDataSetNew 值：

> AAPLDataSetNew 

结果如下：

探索价格变化的摘要。使用 summary() 函数。该函数提供一系列描述性统计量，以生成 AAPLDataSetNew 数据框的结果摘要：

    > summary(AAPLDataSetNew)

结果如下：

    > AAPLDataSetNew <- AAPLDataSetNew[-c(1:10),]

结果如下：

探索价格变化的摘要。使用 summary() 函数。该函数提供一系列描述性统计量，以生成 AAPLDataSetNew 数据框的结果摘要：

> summary(AAPLDataSetNew) 

结果如下：

探索 AAPLDataSetNew 数据框的维度。dim() 函数返回 AAPLDataSetNew 框的维度。将 AAPLDataSetNew 数据框作为输入参数传递。结果明确指出有 492 行数据和 3 列：

    > dim(AAPLDataSetNew)

结果如下：

构建训练数据集。AAPLDataSetNew 数据框中的三分之二元素将用作训练数据集，而 AAPLDataSetNew 数据框中的一分之一元素将用作测试数据集。

训练数据集将存储在 trainingDataSet 数据框中：

> trainingDataSet <- AAPLDataSetNew[1:328,] 

探索 trainingDataSet 数据框的维度。dim() 函数返回 trainingDataSet 数据框的维度。将 trainingDataSet 数据框作为输入参数传递。结果明确指出有 328 行数据和 3 列：

    > dim(trainingDataSet)

结果如下：

探索价格变化的摘要。使用 trainingDataSet() 函数。该函数提供一系列描述性统计量，以生成 trainingDataSet 数据框的结果摘要：

    > summary(trainingDataSet)

结果如下：

训练数据集将存储在 TestDataSet 数据框中：

    > TestDataSet <- AAPLDataSetNew[329:492,]

探索 TestDataSet 数据框的维度。dim() 函数返回 TestDataSet 框的维度。将 TestDataSet 数据框作为输入参数传递。结果明确指出有 164 行数据和 3 列：

    > dim(TestDataSet)

结果如下：

    > summary(TestDataSet)

结果如下：

通过指定指标构建朴素贝叶斯分类器。将使用 naiveBayes() 函数。它使用贝叶斯规则计算给定一组类别变量和独立预测变量后的后验概率。该函数假设度量预测变量的高斯分布。

exponentialMovingAverageDiffRoundModel 是函数的输出结果，其中自变量是 trainingDataSet[,1:2]，因变量是 trainingDataSet[,3]：

> exponentialMovingAverageDiffRoundModel <-
naiveBayes(trainingDataSet[,1:2],trainingDataSet[,3])

显示 exponentialMovingAverageDiffRoundModel 结果：

    > exponentialMovingAverageDiffRoundModel

结果如下：

测试结果：

    > table(predict(exponentialMovingAverageDiffRoundModel,TestDataSet),
TestDataSet[,3],dnn=list('Predicted','Actual')) 

结果如下：

随机森林 - 货币交易策略

在进行技术分析后，可以科学地实现预测外汇市场未来价格趋势的目标。外汇交易者根据市场趋势、成交量、范围、支撑和阻力水平、图表模式和指标等多种技术分析制定策略，并使用不同时间框架的图表进行多时间框架分析。基于过去市场行动的统计数据，如过去价格和过去成交量，创建技术分析策略以评估资产。分析的主要目标不是衡量资产的基本价值，而是计算市场的历史表现所指示的未来市场表现。

准备工作

为了执行随机森林，我们将使用从美元和英镑数据集收集的数据集。

第一步 - 收集和描述数据

将使用标题为 PoundDollar.csv 的数据集。数据集是标准格式。有 5,257 行数据和 6 个变量。数值变量如下：

• 日期

• 开盘价

• 最高价

• 最低价

• 收盘价

• 成交量

如何操作...

让我们深入了解细节。

第二步 - 探索数据

作为第一步要执行，以下包需要加载：

> install.packages("quantmod")
> install.packages("randomForest")
> install.packages("Hmisc")

备注

版本信息：本页代码在 R 版本 3.3.0（2016-05-03）中进行了测试。

以下每个库都需要安装：

> library("quantmod")
> library("randomForest")
> library("Hmisc")

让我们探索数据并了解变量之间的关系。我们将首先导入名为 PoundDollar.csv 的 CSV 数据文件。我们将把数据保存到 PoundDollar 数据框中：

    > PoundDollar <- read.csv("d:/PoundDollar.csv")

打印 PoundDollar 数据框。head() 函数返回 PoundDollar 数据框的前一部分。PoundDollar 数据框作为输入参数传递：

    > head(PoundDollar)

结果如下：

打印 PoundDollar 数据框的摘要。summary() 函数是一个多功能函数。summary() 是一个通用函数，它提供了与单个对象或数据框相关的数据的摘要。PoundDollar 数据框作为 R 对象传递给 summary() 函数：

    > summary(PoundDollar)

结果如下：

探索 PoundDollar 数据框的维度。dim() 函数返回 PoundDollar 框的维度。PoundDollar 数据框作为输入参数传递。结果清楚地表明有 5,257 行数据和 7 列：

    > dim(PoundDollar)

结果如下：

第三步 - 准备变量以构建数据集

表示日历日期和时间。as.POSIXlt() 函数将对象操作为表示日期和时间。PoundDollar 作为参数传递。format="%m/%d/%y %H:%M 表示日期时间格式。结果存储在 DateAndTime 数据框中：

    > DateAndTime <- as.POSIXlt(PoundDollar[,2],format="%m/%d/%y %H:%M")

捕获 最高价、最低价 和 收盘价 值：

    > HighLowClose <- PoundDollar[,4:6]

PoundDollar数据框捕获了第四、第五和第六列中的High、Low和Close值。打印HighLowClose数据框。head()函数返回HighLowClose数据框的第一部分。HighLowClose数据框被作为输入参数传递：

    > head(HighLowClose)

结果如下：

打印HighLowClose数据框的摘要。summary()函数是一个多功能函数。summary()是一个泛型函数，它提供了与单个对象或数据框相关的数据的摘要。HighLowClose数据框被作为 R 对象传递给summary()函数：

    > summary(HighLowClose)

结果如下：

探索HighLowClose数据框的内部结构。str()函数显示数据框的内部结构。将HighLowClose作为 R 对象传递给str()函数：

    > str(HighLowClose)

结果如下：

创建要使用的数据集。使用data.frame()函数根据紧密耦合的变量集创建数据框。这些变量具有矩阵的性质。将HighLowClose作为参数传递给data.frame()。然后将结果存储在HighLowClosets数据框中。row.names=DateAndTime表示一个整数字符串，指定用作行名的列。结果存储在HighLowClose数据框中：

> HighLowClosets <- data.frame(HighLowClose, row.names=DateAndTime) 

描述数据集。describe()函数提供项目分析。HighLowClosets作为输入参数传递：

    > describe(HighLowClosets)

结果如下：

创建时间序列对象。使用as.xts()函数。它将任意类别的数据对象转换为xts类，而不丢失原始格式的任何属性。HighLowClosets被作为输入对象传递：

    > HighLowClosexts <- as.xts(HighLowClosets)

计算布林带。布林带是一种范围指标，它从移动平均数计算标准差。布林带遵循的逻辑是，货币对的价格最有可能趋向于其平均值，因此当它偏离太多，例如两个标准差之外时，它将回溯到其移动平均数。使用BBands()函数来计算布林带。HighLowClosexts被作为对象传递，该对象被转换为包含高低收盘价的矩阵。n=20表示移动平均数的周期数。SMA 命名要调用的函数。sd=2表示两个标准差：

    > BollingerBands <- BBands(HighLowClosexts,n=20,SMA,sd=2)

描述数据集。describe()函数提供项目分析。BollingerBands作为输入参数传递：

    > describe(BollingerBands)

结果如下：

构建上限带：

    > Upper <- BollingerBands$up - HighLowClosexts$Close

打印上界数据框的摘要。summary() 函数是一个多功能函数。summary() 是一个通用函数，它提供了与单个对象或数据框相关的数据的摘要。Upper 数据框作为 R 对象传递给 summary() 函数：

    > summary(Upper)

结果如下：

构建下界带：

    > Lower <- BollingerBands$dn - HighLowClosexts$Close

打印下界数据框的摘要。summary() 函数是一个多功能函数。summary() 是一个通用函数，它提供了与单个对象或数据框相关的数据的摘要。下界数据框作为 R 对象传递给 summary() 函数：

    > summary(Upper)

结果如下：

构建中间带：

    > Middle <- BollingerBands$mavg - HighLowClosexts$Close

打印中间数据框的摘要。summary() 函数是一个多功能函数。summary() 是一个通用函数，它提供了与单个对象或数据框相关的数据的摘要。Middle 数据框作为 R 对象传递给 summary() 函数：

    > summary(Middle)

结果如下：

计算百分比变化。使用 Delt() 函数计算给定序列从一个时期到另一个时期的百分比变化。k=1 表示在各个时期的变化。结果存储在 PercentageChngpctB 数据框中：

    > PercentageChngpctB <- Delt(BollingerBands$pctB,k=1)

描述数据集。describe() 函数提供项目分析。PercentageChngpctB 作为输入参数传递：

    > describe(PercentageChngpctB)

结果如下：

计算上界数据框的百分比变化。k=1 表示在各个时期的变化：

    > PercentageChngUp <- Delt(Upper,k=1)

描述数据集。describe() 函数提供项目分析。PercentageChngUp 作为输入参数传递：

    > describe(PercentageChngUp)

结果如下：

计算下界数据框的百分比变化。k=1 表示在各个时期的变化：

    > PercentageChngLow <- Delt(Lower, k=1)

描述数据集。describe() 函数提供项目分析。PercentageChngLow 作为输入参数传递：

    > describe(PercentageChngLow)

结果如下：

计算中间数据框的百分比变化。k=1 表示在各个时期的变化：

    > PercentageChngMid <- Delt(Middle,k=1)

描述数据集。describe() 函数提供项目分析。PercentageChngMid 作为输入参数传递：

    > describe(PercentageChngMid)

结果如下：

计算变量 HighLowClosexts$Close 的百分比变化。k=1 表示在各个时期的变化：

    > Returns <- Delt(HighLowClosexts$Close, k=1)

第 4 步 - 构建模型

创建二元分类变量。ifelse() 函数使用测试表达式返回值，该值本身是一个向量，其长度与测试表达式相同。如果测试表达式的对应值为 TRUE，则从 x 中返回一个元素；如果测试表达式的对应值为 FALSE，则从 y 中返回一个元素。

在这里，Returns>0 是测试函数，需要在逻辑模式下进行测试。UP 和 DOWN 执行逻辑测试。结果随后存储在 binaryClassification 数据框中：

> binaryClassification <- ifelse(Returns>0,"Up","Down") 

探索价格变化的摘要。使用 summary() 函数。该函数提供一系列描述性统计量，以生成 binaryClassification 数据框的结果摘要：

    > summary(binaryClassification)

结果如下：

将类别回退一个：

    > ClassShifted <- binaryClassification[-1]

结合所有特征。使用 data.frame() 函数根据紧密耦合的变量集创建数据框。这些变量具有矩阵的性质。

传递给 data.frame() 的参数变量有 Upper、Lower、Middle、BollingerBands$pctB、PercentageChngpctB、PercentageChngUp、PercentageChngLow 和 PercentageChngMid。结果随后存储在 FeaturesCombined 数据框中：

    > FeaturesCombined <- data.frame(Upper, Lower, Middle, BollingerBands$pctB, PercentageChngpctB, PercentageChngUp, PercentageChngLow, PercentageChngMid)

探索价格变化的摘要。使用 summary() 函数。该函数提供一系列描述性统计量，以生成 FeaturesCombined 数据框的结果摘要：

    > summary(FeaturesCombined)

结果如下：

匹配类别：

    > FeaturesShifted <- FeaturesCombined[-5257,]

结合 FeaturesShifted 和 ClassShifted 数据框。传递给 data.frame() 的参数变量是 FeaturesShifted 和 ClassShifted。结果随后存储在 FeaturesClassData 数据框中：

    > FeaturesClassData <- data.frame(FeaturesShifted, ClassShifted)

探索价格变化的摘要。使用 summary() 函数。该函数提供一系列描述性统计量，以生成 FeaturesClassData 数据框的结果摘要：

    > summary(FeaturesClassData)

结果如下：

计算指标正在被移除：

    > FinalModelData <- FeaturesClassData[-c(1:20),]

命名列。使用 c() 函数将参数组合成向量：

    > colnames(FinalModelData) <- c("pctB","LowDiff","UpDiff","MidDiff","PercentageChngpctB","PercentageChngUp","PercentageChngLow","PercentageChngMid","binaryClassification")

探索 FinalModelData 数据框的内部结构。str() 函数显示数据框的内部结构。FinalModelData 作为 R 对象传递给 str() 函数：

    > str(FinalModelData)

结果如下：

设置初始随机变量：

    > set.seed(1)

使用类别（第 9 列）评估特征（第 1 至 9 列）以找到每棵树的最佳特征数量。"FinalModelData[,-9]" 表示预测变量数据框，"FinalModelData[,9]" 表示响应变量数据框。"ntreeTry=100" 表示在调整步骤中使用的树的数量。"stepFactor=1.5" 表示每次迭代的值，"mtry" 通过这个值膨胀（或缩水），"improve=0.01" 表示搜索必须继续的（相对）出袋误差的改善量。"trace=TRUE" 表示是否打印搜索的进度。"dobest=FALSE" 表示是否使用找到的最佳 "mtry" 运行森林：

    > FeatureNumber <- tuneRF(FinalModelData[,-9], FinalModelData[,9], ntreeTry=100, stepFactor=1.5, improve=0.01, trace=TRUE, plot=TRUE, dobest=FALSE)

使用所有特征进行分类预测，每棵树有两个特征。使用 "randomForest()" 函数。data=FinalModelData 表示包含模型中变量的数据框。"mtry=2" 表示在每次分割中随机采样的变量作为候选者的数量。"ntree=2000" 表示要生长的树的数量。"keep.forest=TRUE" 表示森林将保留在输出对象中。"importance=TRUE" 表示要评估预测变量的重要性：

    > RandomForest <- randomForest(binaryClassification~., data=FinalModelData, mtry=2,  ntree=2000, keep.forest=TRUE, importance=TRUE)

结果如下：

绘制随机森林：

    > varImpPlot(RandomForest, main = 'Random Forest: Measurement of Importance of Each Feature',pch=16,col='blue' )

结果如下：

支持向量机 - 货币交易策略

外汇市场是一个国际交易市场，各国货币可以自由买卖。一种货币的价格仅由市场参与者决定，由供求关系驱动。交易通过个别合约进行。标准合约规模（也称为一手）通常是 100,000 单位。这意味着，对于每份标准合约，控制的是 100,000 单位的基础货币。对于这个合约规模，每个点（最小的价格变动单位）价值 10 美元。根据交易者的交易策略，头寸可以维持非常短的时间，也可以维持更长的时间，甚至数年。有几个工具允许交易者理解和在市场上做出决策，这些工具基本上分为基本面分析或技术分析。基本面分析考虑了政治和经济信息的持续交换。技术分析基本上基于价格、时间和成交量——货币达到的最低和最高价格、时间段、交易次数等。技术分析还假设市场的重复性，它很可能在未来再次执行，就像它在过去已经执行的那样。它分析过去的报价，并根据统计和数学计算预测未来的价格。

准备中

为了执行支持向量机，我们将使用从美元和英镑数据集中收集的数据集。

步骤 1 - 收集和描述数据

将使用标题为 PoundDollar.csv 的数据集。数据集是标准格式。有 5,257 行数据，6 个变量。数值变量如下：

• 日期

• 开盘价

• 最高价

• 低

• 收盘价

• 成交量

如何操作...

让我们深入了解细节。

步骤 2 - 探索数据

作为第一步需要加载以下包：

> install.packages("quantmod")
> install.packages("e1071")
> install.packages("Hmisc")
> install.packages("ggplot2")

注意

版本信息：本页代码在 R 版本 3.3.0（2016-05-03）中进行了测试。

以下每个库都需要安装：

> library("quantmod")
> library("e1071")
> library("Hmisc")
> install.packages("ggplot2")

让我们探索数据并了解变量之间的关系。我们将从导入名为 PoundDollar.csv 的 CSV 数据文件开始。我们将数据保存到 PoundDollar 数据框中：

    > PoundDollar <- read.csv("d:/PoundDollar.csv")

打印 PoundDollar 数据框。head() 函数返回 PoundDollar 数据框的前一部分。PoundDollar 数据框作为输入参数传递：

    > head(PoundDollar)

结果如下：

探索 PoundDollar 数据框的内部结构。str() 函数显示数据框的内部结构。PoundDollar 作为 R 对象传递给 str() 函数：

    > str(PoundDollar)

结果如下：

步骤 3 - 计算指标

计算相对强弱指数（RSI）。它是最近向上价格变动与绝对价格变动的比率。使用 RSI() 函数计算相对强弱指数。PoundDollar 数据框用作价格序列。n = 3 表示移动平均的周期数。结果存储在 relativeStrengthIndex3 数据框中：

    > relativeStrengthIndex3 <- RSI(Op(PoundDollar), n= 3)

探索价格变化的摘要。使用 summary() 函数。该函数提供了一系列描述性统计量，以生成 relativeStrengthIndex3 数据框的结果摘要：

    > summary(relativeStrengthIndex3)

结果如下：

计算 PoundDollar 序列的 移动平均（MA）。SMA 计算过去一系列观察值的算术平均值。n=50 表示平均的周期数：

    > SeriesMeanAvg50 <- SMA(Op(PoundDollar), n=50)

打印 SeriesMeanAvg50 数据框的摘要。summary() 函数是一个多功能函数。summary() 是一个通用函数，它提供了与单个对象或数据框相关的数据的摘要。SeriesMeanAvg50 数据框作为 R 对象传递给 summary() 函数：

    > summary(SeriesMeanAvg50)

结果如下：

描述数据集。describe() 函数提供项目分析。SeriesMeanAvg50 作为输入参数传递：

    > describe(SeriesMeanAvg50)

结果如下：

测量趋势。找出开盘价与 50 期简单移动平均价之间的差异：

    > Trend <- Op(PoundDollar) - SeriesMeanAvg50

打印 SeriesMeanAvg50 数据框的摘要。Trend 数据框作为 R 对象传递给 summary() 函数：

    > summary(Trend)

结果如下：

计算收盘价和开盘价之间的价格差异。结果存储在数据框 PriceDiff 中：

    > PriceDiff <- Cl(PoundDollar) - Op(PoundDollar)

打印 PriceDiff 数据框的摘要。Trend 数据框作为 R 对象传递给 summary() 函数：

    > summary(PriceDiff)

结果如下：

步骤 4 - 准备变量以构建数据集

创建二元分类变量。ifelse() 函数使用测试表达式返回值，该值本身是一个向量，其长度与测试表达式相同。如果测试表达式的对应值为 TRUE，则返回 x 的元素；如果对应值为 FALSE，则返回 y 的元素。

这里，PriceChange>0 是测试函数，需要在逻辑模式下进行测试。UP 和 DOWN 执行逻辑测试。结果随后存储在 binaryClassification 数据框中：

    > binaryClassification <- ifelse(PriceDiff>0,"UP","DOWN")

打印 binaryClassification 数据框的摘要。Trend 数据框作为 R 对象传递给 summary() 函数：

    > summary(binaryClassification)

结果如下：

结合相对 StrengthIndex3、Trend 和 binaryClassification 数据框。传递给 data.frame() 的参数是 relativeStrengthIndex3、Trend 和 binaryClassification。结果存储在 DataSet 数据框中：

    > DataSet <- data.frame(relativeStrengthIndex3, Trend, binaryClassification)

打印 DataSet 数据框的摘要。Trend 数据框作为 R 对象传递给 summary() 函数：

    > summary(DataSet)

结果如下：

探索 DataSet 数据框的内部结构。str() 函数显示数据框的内部结构。DataSet 作为 R 对象传递给 str() 函数：

    > str(DataSet)

结果如下：

计算指标、创建数据集和删除点：

    > DataSet <- DataSet[-c(1:49),]

探索 DataSet 数据框的维度。dim() 函数返回 DataSet 框的维度。DataSet 数据框作为输入参数传递。结果清楚地表明有 5,208 行数据和 3 列：

> dim(DataSet) 

结果如下：

分离训练数据集：

    > TrainingDataSet <- DataSet[1:4528,]

探索 TrainingDataSet 数据框的维度。dim() 函数返回 TrainingDataSet 框的维度。TrainingDataSet 数据框作为输入参数传递。结果清楚地表明有 4,528 行数据和 3 列：

    > dim(TrainingDataSet)

结果如下：

打印TrainingDataSet数据框的摘要。TrainingDataSet数据框作为 R 对象传递给summary()函数：

    > summary(TrainingDataSet)

结果如下：

分离测试数据集：

    > TestDataSet <- DataSet[4529:6038,]

探索TestDataSet数据框的维度。dim()函数返回TestDataSet框的维度。将TestDataSet数据框作为输入参数传递。结果清楚地表明有 1,510 行数据和 3 列：

    > dim(TestDataSet)

打印TestDataSet数据框的摘要。TestDataSet数据框作为 R 对象传递给summary()函数：

    > summary(TestDataSet)

结果如下：

步骤 5 - 构建模型

使用svm()函数构建支持向量机。使用binaryClassification~relativeStrengthIndex3+Trend作为公式。data=TrainingDataSet用作包含模型变量的数据框。kernel="radial"表示在训练和预测中使用径向基核函数。cost=1表示违反约束的成本。gamma=1/2表示除线性核函数之外所有核函数所需的参数：

    > SVM <- svm(binaryClassification~relativeStrengthIndex3+Trend, data=TrainingDataSet, kernel="radial", cost=1, gamma=1/2)

打印SVM数据框的摘要。SVM数据框作为 R 对象传递给summary()函数：

    > summary(SVM)

结果如下：

为了根据模型对象预测值，我们将使用predict()函数。将SVM作为对象传递。将TrainingDataSet数据对象作为对象传递，在其中查找用于预测的变量：

    > TrainingPredictions <- predict(SVM, TrainingDataSet, type="class")

打印TrainingPredictions数据框的摘要。SVM数据框作为 R 对象传递给summary()函数：

    > summary(TrainingPredictions)

结果如下：

描述数据集。describe()函数提供项目分析。将TrainingPredictions作为输入参数传递：

    > describe(TrainingPredictions)

结果如下：

合并TrainingDataSet和TrainingPredictions数据框。传递给data.frame()函数的参数是TrainingDataSet和TrainingPredictions。结果存储在TrainingDatadata数据框中：

    > TrainingData <- data.frame (TrainingDataSet, TrainingPredictions)

打印TrainingData数据框的摘要。TrainingData数据框作为 R 对象传递给summary()函数：

    > summary(TrainingData)

结果如下：

打印TrainingData：

    > ggplot(TrainingData,aes(x=Trend,y=relativeStrengthIndex3))    +stat_density2d(geom="contour",aes(color=TrainingPredictions))    +labs(,x="Open - SMA50",y="RSI3",color="Training Predictions")

结果如下：

随机梯度下降 - 成人收入

随机梯度下降也称为增量梯度下降，是梯度下降优化方法的一个随机近似，该方法用于最小化一个表示为可微函数之和的目标函数。它通过迭代尝试找到最小值或最大值。在随机梯度下降中，Q(w)的真正梯度被一个单例的梯度近似：

当算法遍历训练集时，它会对每个训练示例执行上述更新。可以在训练集上多次遍历，直到算法收敛。如果这样做，则可以在每次遍历中打乱数据以防止循环。典型的实现可能使用自适应学习率，以便算法收敛。

准备工作

为了执行随机梯度下降，我们将使用从人口普查数据收集的数据集来预测收入。

第 1 步 - 收集和描述数据

将使用名为adult.txt的数据集。数据集是标准格式。有 32,561 行数据和 15 个变量。数值变量如下：

• 年龄

• fnlwgt

• 教育年限

• 资本收益

• 资本损失

• 每周工作小时数

非数值变量如下：

• 工作类别

• 教育

• 婚姻状况

• 职业

• 关系

• 种族

• 性别

• 国籍

• 收入范围

如何做到这一点...

让我们深入了解细节。

第 2 步 - 探索数据

以下每个库都需要安装：

> library("klar")
> library("caret")
> library ("stringr")

注意

版本信息：本页面的代码在 R 版本 3.3.0（2016-05-03）中进行了测试。

让我们探索数据并了解变量之间的关系。我们将从导入名为adult.txt的 TXT 数据文件开始。我们将数据保存到labels数据框中：

    > labels <- read.csv("d:/adult.txt")

探索allData数据框的内部结构。str()函数显示数据框的内部结构。将allData作为 R 对象传递给str()函数：

    > str(allData)

结果如下：

第 3 步 - 准备数据

从主文件中获取标签。使用as.factor()函数将allData[,15]向量编码为因子，以确保格式兼容性。然后，结果存储在labels数据框中：

    > labels <- as.factor(allData[,15])

在去除标签后获取数据的所有特征。结果存储在allFeatures数据框中：

    > allFeatures <- allData[,-c(15)]

打印allFeatures数据框。head()函数返回allFeatures数据框的前部分。将allFeatures数据框作为输入参数传递：

    > head(allFeatures)

结果如下：

标准化特征。均值和尺度转换为z分数，使得variance = 1。scale()函数的默认方法将数值矩阵的列中心化和/或缩放。continuousFeatures是数值矩阵。结果存储在continuousFeatures数据框中：

    > continuousFeatures <- scale(continuousFeatures)

打印continuousFeatures数据框。head()函数返回continuousFeatures数据框的前部分。continuousFeatures数据框作为输入参数传递：

    > head(continuousFeatures)

结果如下：

将标签转换为1或-1。使用rep()函数复制值。结果存储在labels.n数据框中：

    > labels.n = rep(0,length(labels))     
> labels.n[labels==" <=50K"] = -1     
> labels.n[labels==" >50K"] = 1     
> labels = labels.n     
> rm(labels.n)

分离训练数据集。createDataPartition()函数创建一组训练数据分区。y=labels表示结果向量。p=.8表示 80%的数据用于训练数据集：

    > trainingData <- createDataPartition(y=labels, p=.8, list=FALSE)

探索trainingData数据框的维度。dim()函数返回trainingData数据框的维度。trainingData数据框作为输入参数传递。结果清楚地表明有 26,049 行数据和单列：

    > dim(trainingData)

结果如下：

创建trainingData数据框的训练特征和训练标签：

    > trainingFeatures <- continuousFeatures[trainingData,]     
> trainingLabels <- labels[trainingData]

确定剩余 20%的数据用于测试和验证：

    > remainingLabels <- labels[-trainingData]     
> remainingFeatures <- continuousFeatures[-trainingData,]

创建trainingData数据框的测试特征和测试标签。在 20%的数据中，其中 50%用于测试目的，剩余的 50%用于验证目的。

createDataPartition()函数创建一组训练数据分区。y=remainingLabels表示结果向量。p=.5表示 50%的数据用于训练数据集。结果存储在testingData数据框中：

    > testingData <- createDataPartition(y=remainingLabels, p=.5, list=FALSE)     
> testingLabels <- remainingLabels[testingData]     
> testingFeatures <- remainingFeatures[testingData,]

创建testingData数据框的验证特征和测试标签：

    > validationLabels <- remainingLabels[-testingData]
    > validationFeatures <- remainingFeatures[-testingData,]

定义所需的准确度度量：

> getAccuracy >- function(a,b,features,labels){
+ estFxn = features %*% a + b;
+ predictedLabels = rep(0,length(labels));
+ predictedLabels [estFxn < 0] = -1 ;
+ predictedLabels [estFxn >= 0] = 1 ;
+ return(sum(predictedLabels == labels) / length(labels))
+ }

第 4 步 - 构建模型

设置初始参数：

> numEpochs = 100
> numStepsPerEpoch = 500
> nStepsPerPlot = 30
> evalidationSetSize = 50
> c1 = 0.01
> c2 = 50

组合一组参数。结果存储在lambda_vals数据框中：

    > lambda_vals = c(0.001, 0.01, 0.1, 1)     
> bestAccuracy = 0

探索lambda_vals数据框的内部结构。str()函数显示数据框的内部结构。lambda_vals作为 R 对象传递给str()函数：

    > str(lambda_vals)

结果如下：

从给定的一组值中创建每个 epoch 的矩阵。使用matrix()函数。nrow = (numStepsPerEpoch/nStepsPerPlot)*numEpochs+1表示矩阵的行数，而ncol = length(lambda_vals)表示矩阵的列数：

    > accMat <- matrix(NA, nrow = (numStepsPerEpoch/nStepsPerPlot)*numEpochs+1, ncol = length(lambda_vals))

从给定的一组值中创建用于验证集准确性的矩阵。matrix() 函数被使用。nrow = (numStepsPerEpoch/nStepsPerPlot)*numEpochs+1 表示矩阵的行数，而 ncol = length(lambda_vals) 表示矩阵的列数：

    > accMatv <- matrix(NA, nrow = (numStepsPerEpoch/nStepsPerPlot)*numEpochs+1, ncol = length(lambda_vals))

设置分类器模型：

for(i in 1:4){ 
lambda = lambda_vals[i] 
accMatRow = 1 
accMatCol = i 
a = rep(0,ncol(continuousFeatures)) 
b = 0 
stepIndex = 0 
       for (e in 1:numEpochs){

#createDataPartition() 函数创建一组训练数据分区。y= trainingLabels 表示结果向量。p = (1 - evalidationSetSize/length(trainingLabels)) 百分比的数据用于训练数据集。结果存储在 etrainingData 数据框中：

etrainingData <- createDataPartition(y=trainingLabels, p=(1 -   evalidationSetSize/length(trainingLabels)), list=FALSE) 
 etrainingFeatures <- trainingFeatures[etrainingData,] 
 etrainingLabels <- trainingLabels[etrainingData] 
 evalidationFeatures <- trainingFeatures[-etrainingData,] 
 evalidationLabels <- trainingLabels[-etrainingData] 
 steplength = 1 / (e*c1 + c2) 
 for (step in 1:numStepsPerEpoch){ 
 stepIndex = stepIndex+1 
 index = sample.int(nrow(etrainingFeatures),1) 
 xk = etrainingFeatures[index,] 
 yk = etrainingLabels[index] 
 costfxn = yk * (a %*% xk + b) 
 if(costfxn >= 1){ 
 a_dir = lambda * a 
 a = a - steplength * a_dir 
 } else { 
 a_dir = (lambda * a) - (yk * xk) 
 a = a - steplength * a_dir 
 b_dir = -yk 
 b = b - (steplength * b_dir) 
 } 

记录准确性。调用 getAccuracy()：

if (stepIndex %% nStepsPerPlot == 1){#30){ 
accMat[accMatRow,accMatCol] = getAccuracy(a,b,evalidationFeatures,evalidationLabels) 
accMatv[accMatRow,accMatCol] = getAccuracy(a,b,validationFeatures,validationLabels) 
accMatRow = accMatRow + 1 
} 
} 
} 
tempAccuracy = getAccuracy(a,b,validationFeatures,validationLabels) 
print(str_c("tempAcc = ", tempAccuracy," and bestAcc = ", bestAccuracy) ) 
if(tempAccuracy > bestAccuracy){ 
bestAccuracy = tempAccuracy 
best_a = a 
best_b = b 
best_lambdaIndex = i 
} 
   }

计算模型的准确性。使用先前定义的 getAccuracy()：

   > getAccuracy(best_a,best_b, testingFeatures, testingLabels)

步骤 5 - 绘制模型

绘制训练过程中模型的准确性。使用 c() 函数将参数组合成向量：

    > colors = c("red","blue","green","black")

设置用于图表的向量：

> xaxislabel = "Step"
> yaxislabels = c("Accuracy on Randomized Epoch Validation
Set","Accuracy on Validation Set")
>
> ylims=c(0,1)
> stepValues = seq(1,15000,length=500)

创建一个通用向量。调用 list()，它将 accMat 和 accMatv 数据框连接起来：

    > mats =  list(accMat,accMatv)

绘制图表：

> for(j in 1:length(mats)){
mat = mats[[j]]
for(i in 1:4){
if(i == 1){

# plot() 函数是一个用于绘制 R 对象的通用函数。将 stepValues 数据框作为函数值传递：

 plot(stepValues, mat[1:500,i], type = "l",xlim=c(0, 15000), ylim=ylims, 
 col=colors[i],xlab=xaxislabel,ylab=yaxislabels[j],main=title) 
 } else{ 
 lines(stepValues, mat[1:500,i], type = "l",xlim=c(0, 15000), ylim=ylims, 
 col=colors[i],xlab=xaxislabel,ylab=yaxislabels[j],main=title) 
 } 
 Sys.sleep(1) 
 } 
 legend(x=10000,y=.5,legend=c("lambda=.001","lambda=.01","lambda=.1","lambda=1"),fill=colors) 
 } 

生成的图表将如下所示：

第七章。无监督学习

在本章中，我们将介绍以下食谱：

• 自组织映射 - 热图可视化

• 矢量量化--图像聚类

简介

自组织映射（SOM）：自组织映射属于基于竞争学习的一种无监督学习类别，在这种学习中，输出神经元之间相互竞争以被激活，结果是任何给定时间只有一个被激活。这个被激活的神经元被称为获胜神经元。这种竞争可以通过在神经元之间具有侧抑制连接（负反馈路径）来诱导/实现，从而导致神经元自我组织。SOM 可以想象成一种片状的神经网络，节点排列成规则的、通常是二维的网格。SOM 的主要目标是将任意维度的输入信号转换为一维或二维的离散映射，并以拓扑有序的方式自适应地执行这种转换。在竞争学习过程中，神经元被选择性地调整以适应各种输入模式（刺激）或输入模式的类别。这样调整的神经元（获胜神经元）的位置是有序的，并在晶格上创建了一个有意义的输入特征坐标系。因此，SOM 形成了输入模式的所需拓扑映射。

矢量量化：量化是将无限集合的标量或矢量量通过有限集合的标量或矢量量进行映射的过程。量化在信号处理、语音处理和图像处理等领域有应用。矢量量化对数据块进行量化，而不是单个标量值。量化输出是一个索引值，它指示来自有限矢量集合（称为码本）的另一个数据块（矢量）。所选矢量通常是输入数据块的近似。再现矢量被称为编码器和解码器。编码器接收一个输入矢量，确定最佳表示的再现矢量，并传输该矢量的索引。解码器接收该索引并形成再现矢量。

自组织映射 - 热图可视化

在过去十年中，信息呈指数增长。如果手动从这样的数据库中获取新知识，将会很困难、成本高且耗时。当数据超过一定的大小和复杂度限制时，甚至可能无法实现。因此，在过去的几年中，对大规模多维数据集的自动分析和可视化一直是科学研究的重点。本分析和可视化的主要目标是找到数据中的规律性和关系，从而获取隐藏的潜在有用知识。自组织映射（SOM）是一种无监督的神经网络算法，它将高维数据投影到二维映射上。这种投影保留了数据的拓扑结构，使得相似的数据项将被映射到地图上的相邻位置。

如何操作...

让我们深入了解细节。

第 1 步 - 探索数据

以下包首先需要加载：

> install.packages("kohonen")
> library(kohonen)

注意

版本信息：本页面的代码在 R 版本 3.3.2（2016-10-31）中进行了测试

创建一个示例数据集：

    > training_frame <- data[, c(2,4,5,8)]

将带有训练数据的 data frame 转换为矩阵：scale() 函数作为 training_frame 矩阵的列进行中心化和缩放。as.matrix() 函数从 scale(training_frame) 的结果创建一个矩阵。

    > training_matrix <- as.matrix(scale(training_frame))

打印 training_matrix：

    > training_matrix

结果如下：

第 2 步 - 训练模型

创建 SOM 网格：somgrid() 绘制自组织映射网格的函数。xdim = 20 和 ydim=20 是网格的维度，而 topo="hexagonal" 表示网格的拓扑结构：

    > som_grid <- somgrid(xdim = 20, ydim=20, topo="hexagonal")

训练自组织映射：som() 是自组织映射的一个函数，用于将高维光谱或模式映射到 2D。使用欧几里得距离度量。training_matrix 是数据矩阵，rlen=1000 是完整数据集将向网络展示以进行训练的次数，alpha 是学习率。keep.data = TRUE 表示数据需要保存在返回对象中，n.hood="circular" 表示邻域的形状：

> som_model <- som(training_matrix,
+ grid=som_grid,
+ rlen=1000,
+ alpha=c(0.05,0.01),
+ keep.data = TRUE,
+ n.hood="circular")

第 3 步 - 绘制模型

绘制 som_model 对象：

    > plot(som_model, main ="Training Progress", type="changes", col = "red")

结果如下：

基于节点计数绘制模型：

    > plot(som_model, main ="Node Count", type="count")

结果如下：

基于邻域距离绘制模型。

    > plot(som_model, main ="Neighbour Distances", type="dist.neighbours")

结果如下：

以下代码基于 type = "codes" 绘制模型。

    > plot(som_model, type="codes")

结果如下：

以下代码基于属性图绘制模型。

    > plot(som_model, type = "property", property = som_model$codes[,4], main=names(som_model$data)[4])

结果如下：

向量量化 - 图像聚类

数字媒体领域的科技发展产生了大量的非文本信息，以图像的形式存在。如果程序能够理解这些图像的重要性并理解它们的意义，这将导致大量不同的应用。其中一种应用可能是使用机器人从医院患者的身体扫描图像中提取恶性组织，以解释组织的位置。图像被认为是传达信息最重要的媒体之一。信息检索的潜力巨大，以至于用户可能会被检索到的信息量所淹没。图像的无结构格式对分类和聚类技术构成了挑战。机器学习算法用于提取信息以理解图像。理解图像的第一步是分割它们并识别其中的不同对象。为此，可以使用直方图和频域变换等特征。

准备工作

让我们开始吧。

步骤 1 - 收集和描述数据

使用 JPEG 文件。

如何操作...

让我们深入了解。

步骤 2 - 探索数据

以下包首先需要加载：

> install.packages("jpeg")
> install.packages("ggplot2")
> library(jpeg)
> library(ggplot2)

注意

版本信息：本页面的代码在 R 版本 3.3.2 中进行了测试

使用 readJPEG() 函数读取 JPEG 文件格式的图像，并将其转换为栅格数组：。

    > img <- readJPEG("d:/Image.jpg")

步骤 3 - 数据清洗

探索 img 的维度：dim() 函数返回 img 框架的维度。将 img 数据框作为输入参数传递：

    > img_Dim <- dim(img)

现在我们来打印 img_Dim：

    > img_Dim

结果如下：

现在，我们将 RGB（红色、绿色和蓝色--RGB 通道大致遵循人眼中的颜色受体）通道分配给数据框。结果存储在 img_RGB_channels 数据框中：

> img_RGB_channels <- data.frame(
+ x = rep(1:img_Dim[2], each = img_Dim[1]),
+ y = rep(img_Dim[1]:1, img_Dim[2]),
+ R = as.vector(img[,,1]),
+ G = as.vector(img[,,2]),
+ B = as.vector(img[,,3])
+ )

步骤 4 - 可视化清洗后的数据

让我们绘制原始图像：

> plotTheme <- function() {
theme(
panel.background = element_rect(
size = 3,
colour = "black",
fill = "white"),
axis.ticks = element_line(
size = 2),
panel.grid.major = element_line(
colour = "gray80",
linetype = "dotted"),
panel.grid.minor = element_line(
colour = "gray90",
linetype = "dashed"),
axis.title.x = element_text(
size = rel(1.2),
face = "bold"),
axis.title.y = element_text(
size = rel(1.2),
face = "bold"),
plot.title = element_text(
size = 20,
face = "bold",
Unsupervised Learning
[ 327 ]
vjust = 1.5)
)
}
> ggplot(data = img_RGB_channels, aes(x = x, y = y)) +
+ geom_point(colour = rgb(img_RGB_channels[c("R", "G", "B")])) +
+ labs(title = "Original Image: Colorful Bird") +
+ xlab("x") +
+ ylab("y") +
+ plotTheme()

结果如下：

步骤 5 - 构建模型并可视化

分配聚类颜色：

    > kClusters <- 3

执行 k-means 聚类：kmeans() 函数对数据矩阵 img_RGB_channels 进行聚类。centers = kClusters 表示初始聚类的数量：

    > kMeans_clst <- kmeans(img_RGB_channels[, c("R", "G", "B")], centers = kClusters)

创建与给定红色、绿色和蓝色基色强度相对应的颜色。

    > kColours <- rgb(kMeans_clst$centers[kMeans_clst$cluster,])

使用三个聚类绘制图像：

> ggplot(data = img_RGB_channels, aes(x = x, y = y)) +
+ geom_point(colour = kColours) +
+ labs(title = paste("k-Means Clustering of", kClusters, "Colours"))
+
+ xlab("x") +
+ ylab("y") +
+ plotTheme()

结果如下：

分配聚类颜色：

    > kClusters <- 5

执行 k-means 聚类：

    > kMeans_clst <- kmeans(img_RGB_channels[, c("R", "G", "B")], centers = kClusters)

创建与给定红色、绿色和蓝色基色强度相对应的颜色。

    > kColours <- rgb(kMeans_clst$centers[kMeans_clst$cluster,])

使用五个聚类绘制图像：

> ggplot(data = img_RGB_channels, aes(x = x, y = y)) +
+ geom_point(colour = kColours) +
+ labs(title = paste("k-Means Clustering of", kClusters, "Colours"))
+
+ xlab("x") +
+ ylab("y") +
+ plotTheme()

结果如下：

第八章. 强化学习

在本章中，我们将介绍以下食谱：

• 马尔可夫链 - 股票状态切换模型

• 马尔可夫链 - 多渠道归因模型

• 马尔可夫链 - 汽车租赁代理服务

• 连续马尔可夫链 - 加油站车辆服务

• 蒙特卡洛模拟 - 校准的 Hull 和 White 短期利率

简介

马尔可夫链：如果一个实验的每次试验的结果是离散状态集合中的一个，并且试验的结果只依赖于当前状态而不依赖于任何过去的状态，那么这个实验的试验序列就是一个马尔可夫链。从一个状态转换到另一个状态的概率表示为。这被称为转移概率。转移概率矩阵是一个 n × n 矩阵，其中矩阵的每个元素都是非负的，并且矩阵的每一行之和为 1。

连续时间马尔可夫链：连续时间马尔可夫链可以被标记为带有离散状态的速率增强的转移系统。状态具有连续的时间步长，延迟是指数分布的。连续时间马尔可夫链适用于建模可靠性模型、控制系统、生物途径、化学反应等。

蒙特卡洛模拟：蒙特卡洛模拟是对系统行为的随机模拟。模拟使用对模型进行的采样实验，然后使用计算机进行数值实验，以获得对系统行为的统计理解。蒙特卡洛模拟用于构建复杂系统观察行为的理论，预测系统的未来行为，并研究系统内部输入和参数变化对最终结果的影响。随机模拟是一种实验系统以找到改进或更好地理解系统行为的方法。它使用在区间[0, 1]上均匀分布的随机数。这些均匀分布的随机数用于从各种概率分布中生成随机变量。然后生成与系统行为建模相关的采样实验。

马尔可夫链 - 股票状态切换模型

在过去几十年中，对波动性的分析和预测进行了大量研究。波动性是指随着时间的推移，通过回报率的标准差来衡量的交易价格系列的变动程度。股票回报率模型假设回报率遵循几何布朗运动。这意味着在任何离散时间间隔内，股票的回报率是对数正态分布的，且非重叠间隔内的回报率是独立的。研究发现，该模型无法捕捉极端价格变动和波动性参数中的随机变异性。随机波动性取离散值，在这些值之间随机切换。这是制度切换对数正态过程（RSLN）的基础。

准备中

为了执行马尔可夫链制度切换模型，我们将使用从股票数据集中收集的数据。

第一步 - 收集和描述数据

将使用名为StocksRegimeSwitching.csv的数据集。该数据集以 csv 格式提供，并命名为StocksRegimeSwitching.csv。数据集采用标准格式。有 66 行数据。有七个变量。数值变量如下：

• LRY

• LRV

• INT

• LRC

• LVS

• LGS

非数值变量如下：

• DATE

如何做到这一点...

让我们深入了解细节。

第二步 - 探索数据

第一步是加载以下包：

 >install.packages("MSwM")
 >library(MSwM)

注意

版本信息：本页面的代码在 R 版本 3.2.2（2015-08-14）中进行了测试。

让我们探索数据并了解变量之间的关系。我们将首先导入名为StocksRegimeSwitching.csv的 CSV 数据文件。我们将把数据保存到MarkovSwitchData数据框中：

> MarkovSwitchData <- read.csv("d:/StocksRegimeSwitching.csv", header = TRUE)

附加数据集。attach()函数将数据集附加到搜索路径。在评估变量时搜索数据集。MarkovSwitchData作为参数传递：

> attach(MarkovSwitchData)

打印MarkovSwitchData数据框。head()函数返回MarkovSwitchData数据框的前部分。MarkovSwitchData数据框作为输入参数传递：

> head(MarkovSwitchData)

结果如下：

探索MarkovSwitchData数据框的维度。dim()函数返回MarkovSwitchData数据框的维度。MarkovSwitchData数据框作为输入参数传递。结果清楚地表明，有 66 行数据，七个单列：

> dim(MarkovSwitchData)

结果如下：

打印MarkovSwitchData数据框的摘要。summary()函数是一个多功能函数。summary()函数是一个通用函数，它提供了与单个对象或数据框相关的数据摘要。MarkovSwitchData数据框作为 R 对象传递给summary()函数：

> summary(MarkovSwitchData)

结果如下：

步骤 3 - 准备回归模型

在数据集上准备回归模型。当认为两个或更多变量通过线性关系系统性地连接时，使用回归分析。回归模型用于从一个变量预测另一个变量。它们基于信息提供关于过去、现在和未来事件的预测。

定义因变量。cbind() 函数用于定义因变量。该函数接受 LVS 数据框。结果数据框存储在 yLogValueStocks 数据框中：

 > yLogValueStocks <- cbind(LVS)

打印 yLogValueStocks 数据框。head() 函数返回 yLogValueStocks 数据框的前部分。yLogValueStocks 数据框作为输入参数传递：

 > head(yLogValueStocks)

结果如下：

cbind() 函数接受 LGS 数据框。结果数据框存储在 yLogGrowthStocks 数据框中。

打印 yLogGrowthStocks 数据框。head() 函数返回 yLogGrowthStocks 数据框的前部分。yLogGrowthStocks 数据框作为输入参数传递：

> head(yLogGrowthStocks)

结果如下：

定义自变量。cbind() 函数用于定义因变量。该函数接受 LRY、LRC、INT、LRV 数据框。结果数据框存储在 x 数据框中：

> x <- cbind(LRY, LRC, INT, LRV)

创建一个普通最小二乘（OLS）回归方程。使用 lm() 函数拟合线性模型。要拟合的模型以符号形式表示为 yLogValueStocks~x。结果存储在 olsLogValueStocks 数据框中：

> olsLogValueStocks <- lm(yLogValueStocks~x)

打印 olsLogValueStocks 数据框的摘要。使用 summary() 函数提供与单个对象或数据框相关的数据摘要。将 olsLogValueStocks 数据框作为 R 对象传递给 summary() 函数：

> summary(olsLogValueStocks)

结果如下：

创建一个普通最小二乘回归方程。要拟合的模型以符号形式表示为 yLogGrowthStocks~x。结果存储在 olsLogGrowthStocks 数据框中：

> olsLogGrowthStocks <- lm(yLogGrowthStocks~x)

打印 olsLogGrowthStocks 数据框的摘要。将 olsLogGrowthStocks 数据框作为 R 对象传递给 summary() 函数：

> summary(olsLogGrowthStocks)

结果如下：

步骤 4 - 准备马尔可夫切换模型

马尔可夫切换模型涉及多个方程，可以表征不同制度下的时间序列行为。模型通过在结构之间切换来捕捉复杂的动态模式。状态变量的当前值取决于即时过去值，该值由马尔可夫性质控制。

为股票价值创建马尔可夫切换模型。msmFit() 函数使用 EM 算法实现马尔可夫切换模型，如下所示。olsLogValueStocks 是 lm 类型的对象。k = 2 代表估计的状态数量。结果存储在 MarkovSwtchLogValueStocks 数据框中：

> MarkovSwtchLogValueStocks <- msmFit(olsLogValueStocks, k = 2, sw = rep(TRUE, 6))

按如下方式打印 MarkovSwtchLogValueStocks 数据框的摘要。将 MarkovSwtchLogValueStocks 数据框作为 R 对象传递给 summary() 函数：

> summary(MarkovSwtchLogValueStocks)

结果如下：

创建增长股票的马尔可夫切换模型。msmFit() 函数使用 EM 算法实现马尔可夫切换模型。olsLogGrowthStocks 是 lm 类型的对象。k = 2 代表估计的状态数量。结果存储在 MarkoSwtchLogGrowthStocks 数据框中：

> MarkoSwtchLogGrowthStocks<- msmFit(olsLogGrowthStocks, k = 2, sw = rep(TRUE, 6))

打印 MarkoSwtchLogGrowthStocks 数据框的摘要。将 MarkoSwtchLogGrowthStocks 数据框作为 R 对象传递给 summary() 函数：

> summary(MarkoSwtchLogGrowthStocks)

结果如下：

步骤 5 - 绘制状态概率图

接下来，我们将绘制已计算出的状态概率图。

绘制股票价值的状态概率图。使用 par() 函数查询图形参数如下：

> par(mar=c(3,3,3,3))

plotProb() 函数为每个状态创建每个图。该图包含平滑和过滤后的概率。MarkovSwtchLogValueStocks 作为 MSM.lm 类型的对象传递。which = 1 的值代表所需的图集子集。使用以下命令：

> plotProb(MarkovSwtchLogValueStocks, which=1)

结果如下：

plotProb() 函数为每个状态创建每个图。该图包含平滑和过滤后的概率。MarkovSwtchLogValueStocks 作为 MSM.lm 类型的对象传递。which = 2 的值代表响应变量与平滑概率的图。使用以下命令：

> plotProb(MarkovSwtchLogValueStocks, which=2)

结果如下：

plotProb() 函数为每个状态创建每个图。MarkoSwtchLogGrowthStocks 作为 MSM.lm 类型的对象传递。which = 1 的值代表所需的图集子集：

> plotProb(MarkoSwtchLogGrowthStocks, which=1)

结果如下：

plotProb() 函数为每个状态创建每个图。MarkoSwtchLogGrowthStocks 作为 MSM.lm 类型的对象传递。which = 2 的值代表响应变量与平滑概率的图。使用以下命令：

> plotProb(MarkoSwtchLogGrowthStocks, which=2)

结果如下：

第 6 步 - 测试马尔可夫切换模型

接下来，我们将对马尔可夫切换模型运行一系列诊断测试。

绘制股票价值的制度概率图。使用 par() 函数查询图形参数：

> par(mar=c(3,3,3,3))

创建残差分析的绘图。plotDiag() 函数将残差与拟合值进行绘图。MarkovSwtchLogValueStocks 作为 MSM.lm 类型的对象传递。which = 1 的值表示所需的绘图子集。which=1 的值表示残差与拟合值的绘图：

> plotDiag(MarkovSwtchLogValueStocks, regime=1, which=1)

结果如下：

plotDiag() 函数将残差与拟合值进行绘图。MarkovSwtchLogValueStocks 作为 MSM.lm 类型的对象传递。which = 2 表示所需的绘图子集。which=2 表示正态 Q-Q 图：

> plotDiag(MarkovSwtchLogValueStocks, regime=1, which=2)

结果如下：

plotDiag() 函数将残差与拟合值进行绘图。MarkoSwtchLogGrowthStocks 作为 MSM.lm 类型的对象传递。which = 3 表示所需的绘图子集。which=3 表示残差和平方残差的 ACF/PACF：

> plotDiag(MarkoSwtchLogGrowthStocks, regime=1, which=3)

结果如下：

plotDiag() 函数将残差与拟合值进行绘图。MarkoSwtchLogGrowthStocks 作为 MSM.lm 类型的对象传递。which = 1 表示所需的绘图子集。which = 1 表示残差与拟合值的绘图：

> plotDiag(MarkoSwtchLogGrowthStocks, regime=1, which=1)

结果如下：

plotDiag() 函数将残差与拟合值进行绘图。MarkoSwtchLogGrowthStocks 作为 MSM.lm 类型的对象传递。which = 2 表示所需的绘图子集。which=2 表示正态 Q-Q 图：

> plotDiag(MarkoSwtchLogGrowthStocks, regime=1, which=2)

结果如下：

plotDiag() 函数将残差与拟合值进行绘图。MarkoSwtchLogGrowthStocks 作为 MSM.lm 类型的对象传递。which = 3 表示所需的绘图子集。which=3 表示残差和平方残差的 ACF/PACF：

> plotDiag(MarkoSwtchLogGrowthStocks, regime=1, which=3)

结果如下：

马尔可夫链 - 多渠道归因模型

在电子商务网站上，顾客的购物之旅会经历不同的渠道路径，在购买之前。多渠道归因会给旅程中的每一步分配一个价值。问题是人们在你网站上采取哪些行动可以识别导致转化的价值。通常，企业使用“最后点击”归因，这意味着将所有转化价值分配给旅程中的最后一步或“首次点击”归因。发展多渠道归因分析的第一步是理解顾客的旅程——从意识通过购买到购买后的支持。最终目标是培养忠诚的顾客，他们在购买上花费大量金钱，向他人推荐品牌，并可能成为品牌。

准备工作

为了执行马尔可夫链多渠道归因模型，我们将模拟包含三个独特渠道的顾客旅程。

如何操作...

让我们深入了解细节。

步骤 1 - 准备数据集

首先加载以下包：

    > install.packages("dplyr")
    > install.packages("reshape2")
    > install.packages("ggplot2")
    > install.packages("ChannelAttribution")
    > install.packages("markovchain")
    > library(dplyr)
    > library(reshape2)
    > library(ggplot2)
    > library(ChannelAttribution)
    > library(markovchain)

注意

版本信息：本页面的代码在 R 版本 3.2.2（2015-08-14）中进行了测试。

创建数据样本：c()函数将参数组合起来形成一个向量。传递给函数的所有参数都会组合成一个共同类型，即返回值的类型。data.frame()函数创建了一个紧密耦合的数据框，它是具有许多矩阵和列表属性变量的集合。我们将以下方式将数据保存到datafrm1数据框中：

> datafrm1 <- data.frame(path = c('c1 > c2 > c3', 'c1', 'c2 > c3'), conv = c(1, 0, 0), conv_null = c(0, 1, 1))

按以下方式打印datafrm1数据框：

> datafrm1

结果如下：

步骤 2 - 准备模型

准备马尔可夫模型。markov_model()函数从顾客旅程数据中估计 k 阶马尔可夫模型。datafrm1是包含定义好的顾客旅程的数据框。var_path变量包含包含旅程路径的列名。var_conv变量代表包含总转化的列名。var_null变量代表包含不导致转化的总路径的列。out_more = TRUE返回渠道之间的转移概率和消除效应。

估计的 k 阶马尔可夫模型的结果存储在以下model1数据框中：

> model1 <- markov_model(datafrm1, var_path = 'path', var_conv = 'conv', var_null = 'conv_null', out_more = TRUE)

打印model1数据框：

> model1

结果如下：

按以下方式从model1data数据框中提取结果归因。结果随后存储在datafrmresult1数据框中：

> datafr{BS}l1$result

按以下方式从model1data数据框中提取transition_matrix归因。结果随后存储在datafrmtransmatrix1数据框中：

> datafrmtransmatrix1 <- model1$transition_matrix

重新塑形数据框。重塑后的数据框结果存储在datafrmtransmatrix：

> datafrmtransmatrix <- dcast(datafrmtransmatrix1, channel_from ~ channel_to, value.var = 'transition_probability')

打印datafrmtransmatrix数据框：

> datafrmtransmatrix

结果如下：

步骤 3 - 绘制马尔可夫图

从 model1 数据框中提取 transition_matrix 属性。结果随后存储在 datafrmtransmatrix 数据框中：

> datafrmtransmatrix <- model1$transition_matrix

按如下方式打印 datafrmtransmatrix 数据框：

> datafrmtransmatrix

结果如下：

创建 datafrmdummy 数据样本。c() 函数将参数组合成向量。传递给函数的所有参数组合成一个返回值的公共类型。data.frame() 函数创建一个紧密耦合的数据框，它是具有矩阵和列表许多属性的变量的集合。我们将如下将数据保存到 datafrmdummy 数据框中：

> datafrmdummy <- data.frame(channel_from = c('(start)', '(conversion)', '(null)'), channel_to = c('(start)', '(conversion)', '(null)'), transition_probability = c(0, 1, 1))

打印 datafrmtransmatrix 数据框：

> datafrmtransmatrix

结果如下：

按如下方式合并列. rbind() 函数接受一系列数据框并将它们合并。datafrmtransmatrix 和 df_dummy 作为输入参数传递。结果是 datafrmtransmatrix 数据框：

> datafrmtransmatrix <- rbind(datafrmtransmatrix, datafrmdummy)

打印 datafrmtransmatrix 数据框：

> datafrmtransmatrix

结果如下：

按以下顺序排列通道。factor() 函数用作将向量编码为因子的函数。datafrmtransmatrix$channel_from 作为数据向量传递。levels = c('(start)', '(conversion)', '(null)', 'c1', 'c2', 'c3') 表示一个可选的值向量：

> datafrmtransmatrix$channel_from <- factor(datafrmtransmatrix$channel_from, levels = c('(start)', '(conversion)', '(null)', 'c1', 'c2', 'c3'))

按如下方式打印 datafrmtransmatrix$channel_from 数据框：

> datafrmtransmatrix$channel_from

结果如下：

按以下顺序排列通道。datafrmtransmatrix$channel_to 作为数据向量传递：

> datafrmtransmatrix$channel_to <- factor(datafrmtransmatrix$channel_to, levels = c('(start)', '(conversion)', '(null)', 'c1', 'c2', 'c3'))

打印 datafrmtransmatrix$channel_to 数据框：

> datafrmtransmatrix$channel_to

结果如下：

重新塑形数据框。重塑数据框的结果存储在 datafrmtransmatrix 中：

> datafrmtransmatrix <- dcast(datafrmtransmatrix, channel_from ~ channel_to, value.var = 'transition_probability')

打印 datafrmtransmatrix 数据框：

> datafrmtransmatrix

结果如下：

创建马尔可夫链对象。matrix() 函数从给定的一组值创建矩阵：

> transitionmatrix <- matrix(data = as.matrix(datafrmtransmatrix[, -1]), nrow = nrow(datafrmtransmatrix[, -1]), ncol = ncol(datafrmtransmatrix[, -1]), dimnames = list
(c(as.character(datafrmtransmatrix[, 1])), c(colnames(datafrmtransmatrix[, -1]))))

打印 transitionmatrix 数据框：

> transitionmatrix

结果如下：

> transitionmatrix[is.na(transitionmatrix)] <- 0

创建马尔可夫链对象。transitionMatrix 将是一个转换矩阵，即所有条目都是概率，并且所有行或所有列的总和都等于一：

> transitionmatrix1 <- new("markovchain", transitionMatrix = transitionmatrix)

打印 transitionmatrix1 数据框：

> transitionmatrix1

结果如下：

绘制图形：

> plot(transitionmatrix1, edge.arrow.size = 0.5, main = "Markov Graph Transition Matrix - transitionmatrix1")

结果如下：

步骤 4 - 模拟客户旅程数据集

data.frame() 函数创建了一个紧密耦合的数据框，它是具有许多矩阵和列表属性集合的变量。我们将如下将数据保存到 datafrm2 数据框中：

    > set.seed(354)
    > datafrm2 <- data.frame(client_id = sample(c(1:1000), 5000, replace = TRUE), date = sample(c(1:32), 5000, replace = TRUE), channel = sample(c(0:9), 5000, replace = TRUE, prob = c(0.1, 0.15, 0.05, 0.07, 0.11, 0.07, 0.13, 0.1, 0.06, 0.16)))

打印 datafrm2 数据框。head() 函数返回 datafrm2 数据框的前部分。将 datafrm2 数据框作为输入参数传递：

> head(datafrm2)

结果如下：

将字符对象转换为日期对象。datafrm2$date 表示要转换的对象。origin = "2016-01-01" 表示 Date 对象：

> datafrm2$date <- as.Date(datafrm2$date, origin = "2016-01-01")

在转换为字符后连接向量。将 channel_ 对象添加到渠道中。datafrm2$channel 表示数据框：

> datafrm2$channel <- paste0('channel_', datafrm2$channel)

打印 datafrm2 数据框。head() 函数返回 datafrm2 数据框的前部分。将 datafrm2 数据框作为输入参数传递：

> head(datafrm2)

结果如下：

将渠道聚合到每个客户的路径中：

> datafrm2 <- datafrm2 %>% group_by(client_id) %>% summarise(path = paste(channel, collapse = ' > '), conv = 1, conv_null = 0) %>% ungroup()

打印 datafrm2 数据框：

> datafrm2

结果如下：

准备马尔可夫模型。markov_model() 函数从客户旅程数据中估计 k 阶马尔可夫模型。datafrm2 是包含客户旅程数据的数据框。var_path 包含包含旅程路径的列名。var_conv 表示包含总转换的列名。var_null 表示包含总路径但不导致转换的列。out_more = TRUE 返回渠道之间的转换概率和移除效果。

估计的 k 阶马尔可夫模型的结果存储在 model2 数据框中，如下所示：

> model2 <- markov_model(datafrm2, var_path = 'path', var_conv = 'conv', var_null = 'conv_null', out_more = TRUE)

> datafrmheuristic <- datafrm2 %>% mutate(channel_name_ft = sub('>.*', '', path), channel_name_ft = sub(' ', '', channel_name_ft), channel_name_lt = sub('.*>', '', path), channel_name_lt = sub(' ', '', channel_name_lt))

打印 datafrmheuristic 数据框：

> datafrmheuristic

结果如下：

> datafrmfirsttouch <- datafrmheuristic %>% group_by(channel_name_ft) %>% summarise(first_touch_conversions = sum(conv)) %>% ungroup()

打印 datafrmfirsttouch 数据框：

> datafrmfirsttouch

结果如下：

> datafrmlasttouch <- datafrmheuristic %>% group_by(channel_name_lt) %>% summarise(last_touch_conversions = sum(conv)) %>% ungroup()

打印 datafrmfirsttouch 数据框：

> datafrmfirsttouch

结果如下：

通过公共列合并两个数据框。结果存储在 heuristicmodel2 数据框中：

> heuristicmodel2 <- merge(datafrmfirsttouch, datafrmlasttouch, by.x = 'channel_name_ft', by.y = 'channel_name_lt')

打印 heuristicmodel2 数据框：

> heuristicmodel2

结果如下：

合并所有模型：

> allmodels <- merge(heuristicmodel2, model2$result, by.x = 'channel_name_ft', by.y = 'channel_name')

打印 allmodels 数据框：

> allmodels

结果如下：

步骤 5 - 准备真实数据的转换矩阵热图

绘制热图。

    > colnames(allmodels)[c(1, 4)] <- c('channel_name', 'attrib_model_conversions')
    > datafrmplottransition <- model2$transition_matrix
    > cols <- c("#e7f0fa", "#c9e2f6", "#95cbee", "#0099dc", "#4ab04a", "#ffd73e", "#eec73a", "#e29421", "#e29421", "#f05336", "#ce472e")

从 datafrmplottransition$transition_probability 数据框中返回所有参数的最大值：

> t <- max(datafrmplottransition$transition_probability)

打印 t 的值：

> t

结果如下：

> ggplot(datafrmplottransition, aes(y = channel_from, x = channel_to, fill = transition_probability)) + theme_minimal() + geom_tile(colour = "white", width = .9, height = .9) + scale_fill_gradientn(colours = cols, limits = c(0, t), breaks = seq(0, t, by = t/4), labels = c("0", round(t/4*1, 2), round(t/4*2, 2), round(t/4*3, 2), round(t/4*4, 2)), guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10)) + geom_text(aes(label = round(transition_probability, 2)), fontface = "bold", size = 4) + theme(legend.position = 'bottom', legend.direction = "horizontal", panel.grid.major = element_blank(), panel.grid.minor = element_blank(), plot.title = element_text(size = 20, face = "bold", vjust = 2, color = 'black', lineheight = 0.8), axis.title.x = element_text(size = 24, face = "bold"), axis.title.y = element_text(size = 24, face = "bold"), axis.text.y = element_text(size = 8, face = "bold", color = 'black'), axis.text.x = element_text(size = 8, angle = 90, hjust = 0.5, vjust = 0.5, face = "plain")) + ggtitle("Heatmap - Transition Matrix ")

结果如下：

马尔可夫链 - 汽车租赁机构服务

假设一家汽车租赁机构在渥太华有三个位置：一个市中心位置（标记为 A），一个东部端位置（标记为 B），以及一个西部端位置（标记为 C）。该机构有一组送货司机为所有三个位置提供服务。该机构的统计学家已经确定了以下情况：

• 在对“市中心”位置的呼叫中，30%的呼叫被投递到市中心区域，30%的呼叫被投递到“东部”端，40%的呼叫被投递到“西部”端

• 在对“东部”端位置的呼叫中，40%的呼叫被投递到市中心区域，40%的呼叫被投递到“东部”端，20%的呼叫被投递到“西部”端

• 在对“西部”端位置的呼叫中，50%的呼叫被投递到市中心区域，30%的呼叫被投递到“东部”端，20%的呼叫被投递到“西部”端

在完成一次送货后，司机前往最近的地点进行下一次送货。这样，特定司机的位置仅由其先前位置决定。

如何做到这一点...

让我们深入了解。

步骤 1 - 准备数据集

加载以下包：

    > install.packages("markovchain")
    > library(markovchain)

注意

版本信息：本页代码在 R 版本 3.2.2（2015-08-14）中进行了测试。

创建数据样本。c()函数将参数组合成一个向量。传递给函数的所有参数都被组合成一个返回值的共同类型。我们将数据保存到RentalStates数据框中：

> RentalStates <- c("Downtown", "East", "West")

打印RentalStates的值：

> RentalStates

结果如下：

创建矩阵。matrix()函数从给定的值集合创建矩阵。byrow = T矩阵按行填充。nrow = 3代表所需的行数。c()函数将参数组合成一个向量。传递给函数的所有参数都被组合成一个返回值的共同类型：

> RentalTransitionMatrix <- matrix(c(0.3, 0.3, 0.4, 
 0.4, 0.4, 0.2, 
 0.5, 0.3, 0.2),
 byrow = T, nrow = 3, dimnames = list(RentalStates, RentalStates))

打印RentalTransitionMatrix的值：

> RentalTransitionMatrix

结果如下：

步骤 2 - 准备模型

创建马尔可夫链对象。new()函数创建markovchain类型的对象。状态表示之前定义的RentalStates。byrow = T矩阵按行填充。结果随后存储在数据框mcRental中：

> mcRental <- new("markovchain", states = RentalStates, byrow = T, transitionMatrix = RentalTransitionMatrix, name = "Rental Cars")

打印mcRental数据框：

> mcRental

结果如下：

通过调用mcRental对象来访问转移矩阵如下：

> mcRental[2]

结果如下：

绘制mcRental对象。plot()是一个通用的绘图函数：

> plot(mcRental)

结果如下：

计算转移概率。transitionProbability () 提供了对转移概率的直接访问。

> transitionProbability(mcRental, "East", "West")

结果如下：

步骤 3 - 改进模型

计算两次行程中在市中心的可能性；市中心到市中心：

> x <- 0.3 * 0.3

计算从东位置前往市中心的概率；东到市中心：

> y <- 0.3 * 0.4

计算从西位置前往市中心的概率；西到市中心：

    > z <- 0.4 * 0.5
    > x + y + z

结果如下：

将 mcRental 矩阵平方以计算两次行程中到达市中心的概率：

> mcRental ^ 2

结果如下：

使用 mcRental 矩阵概率计算检查我们将在 20 次行程中到达市中心的概率如下：

> mcRental ^ 20

结果如下：

使用 mcRental 矩阵概率计算检查我们将在三次行程中到达市中心的概率如下：

> mcRental ^ 30

结果如下：

此方法返回 markovchain 对象的矩阵形式的稳态向量：

> 70 * steadyStates(mcRental)

结果如下：

打印 mcRental 的摘要：

> summary(mcRental)

结果如下：

提取给定当前状态的后续状态的条件分布。mcRental 是传递的 markov chain 对象，而 "Downtown" 是下一个状态：

> conditionalDistribution(mcRental, "Downtown")

结果如下：

> conditionalDistribution(mcRental, "West")

结果如下：

> conditionalDistribution(mcRental, "East")

结果如下：

连续马尔可夫链 - 加油站车辆服务

一个加油站只有一个加油机。没有空间供车辆等待。如果一辆车到达加油机，且没有地方加油，那么车辆将离开加油机而不加油。车辆以每分钟 3/20 辆车的速率按照泊松过程到达加油站。到达加油机的车辆中，75% 是汽车，25% 是摩托车。加油时间可以用平均为八分钟的指数随机变量来建模，对于摩托车则是三分钟。

准备中

为了对加油站车辆服务进行连续马尔可夫链模拟，我们需要模拟数据。

如何操作...

让我们深入了解。

步骤 1 - 准备数据集

加载以下包：

    > install.packages("simmer")
    > install.packages("ggplot2")
    > library(simmer)
    > library(ggplot2)

注意

版本信息：本页面的代码在 R 版本 3.2.2（2015-08-14）下进行了测试

初始化车辆到达速率：

> ArrivalRate <- 3/20

打印 ArrivalRate 数据框：

> ArrivalRate

结果如下：

初始化车辆的服务速率并创建数据样本。c() 函数将参数组合成一个向量。传递给函数的所有参数组合形成一个返回值的共同类型。我们将数据保存到 ServiceRate 数据框中：

> ServiceRate <- c(1/8, 1/3)

打印 ServiceRate 数据框：

> ServiceRate

结果如下：

初始化汽车到达的概率：

> p <- 0.75

创建转移矩阵。matrix() 函数从给定的一组值创建矩阵。结果存储在 TransitionMatrix 数据框中：

> TransitionMatrix <- matrix(c(1,   ServiceRate[1],     0,
 1,   -ArrivalRate,       (1-p)*ArrivalRate,
 1,   ServiceRate[2],     -ServiceRate[2]), byrow=T, ncol=3)

打印 TransitionMatrix 数据框：

> TransitionMatrix

结果如下：

初始化向量：

> B <- c(1, 0, 0)

步骤 2 - 计算理论分辨率

解线性方程组。solve() 用于计算线性方程。t(A) 表示转移矩阵，而 B 是向量。结果随后存储在 P 中：

> P <- solve(t(A), B)

打印 P 数据框：

> P

结果如下：

计算理论分辨率。sum() 计算总和。结果随后存储在 Resolution 中：

> Resolution <- sum(P * c(1, 0, 1)) 

打印 Resolution 数据框：

> Resolution

结果如下：

步骤 3 - 验证理论解的收敛性

模拟系统并验证其收敛到理论解：

> set.seed(1234)

定义 option.1 函数。一个 create_trajectory() 函数创建汽车和摩托车类型的轨迹对象。这些对象构成一个要附加到生成器对象的活动链。通过名称捕获泵对象的活动被执行。amount=1 表示需要捕获的对象数量。timeout() 函数根据用户定义插入延迟。timeout() 函数还接受 rexp() 函数，该函数随机生成指数分布，其速率定义为 ServiceRate[1] = 1/8 用于 car 对象，以及 ServiceRate[1] = 1/3 用于 motorcycle 对象。

然后创建如下模拟对象。该方法初始化模拟环境。使用指数分布创建 car 和 motorcycle 对象，其速率定义为 p*ArrivalRate，其中 ArrivalRate = 0.15。然后在模拟环境中创建一个新的到达生成器：

> option.1 <- function(t) {
 car <- create_trajectory() %>%
 seize("pump", amount=1) %>%
 timeout(function() rexp(1, ServiceRate[1])) %>%
 release("pump", amount=1)

 motorcycle <- create_trajectory() %>%
 seize("pump", amount=1) %>%
 timeout(function() rexp(1, ServiceRate[2])) %>%
 release("pump", amount=1)

 simmer() %>%
 add_resource("pump", capacity=1, queue_size=0) %>%
 add_generator("car", car, function() rexp(1, p*ArrivalRate)) %>%
 add_generator("motorcycle", motorcycle, function() rexp(1, (1-p)*ArrivalRate)) %>%
 run(until=t)
 }

定义 option.2 函数。为所有类型的车辆定义一个生成器和一个轨迹。为了区分汽车和摩托车，在捕获资源后定义一个分支以选择适当的服务时间。

create_trajectory()函数创建了vehicle类型的轨迹对象。此对象包含一系列要附加到生成器对象的活动。执行按名称捕获泵对象的活动。amount=1表示需要捕获的对象数量。然后create_trajectory()函数调用timeout()函数，该函数根据用户定义插入延迟。timeout()函数还接受rexp()函数，该函数随机生成指数分布，其速率定义为汽车对象的ServiceRate[1] = 1/8和摩托车对象的ServiceRate[1] = 1/3。

然后按照以下方式创建一个模拟对象。该方法初始化一个模拟环境。使用指数分布创建了car和motorcycle对象，其速率定义为p*ArrivalRate. ArrivalRate = 0.15。然后run()函数继续运行，直到用户定义的超时时间，如until=t所述：

> option.2 <- function(t) {
 vehicle <- create_trajectory() %>%
 seize("pump", amount=1) %>%
 branch(function() sample(c(1, 2), 1, prob=c(p, 1-p)), merge=c(T, T),
 create_trajectory("car") %>%
 timeout(function() rexp(1, ServiceRate[1])),
 create_trajectory("motorcycle") %>%
 timeout(function() rexp(1, ServiceRate[2]))) %>%
 release("pump", amount=1)
 simmer() %>%
 add_resource("pump", capacity=1, queue_size=0) %>%
 add_generator("vehicle", vehicle, function() rexp(1, ArrivalRate)) %>%
 run(until=t)
 }

定义option.3函数。option.2添加了不必要的开销。额外调用以选择分支，因此性能降低。直接在timeout()函数内选择服务时间：

    > option.3 <- function(t) {
       vehicle <- create_trajectory() %>%
       seize("pump", amount=1) %>%
       timeout(function() {
if (runif(1) < p) rexp(1, ServiceRate[1]) 
else rexp(1, ServiceRate[2]) 
       }) %>%
    release("pump", amount=1)
    simmer() %>%
    add_resource("pump", capacity=1, queue_size=0) %>%
    add_generator("vehicle", vehicle, function() rexp(1, ArrivalRate)) %>%
    run(until=t)
    }

按照以下方式调用创建的选项：

> gas.station <- option.3(5000)

步骤 4 - 绘制结果

绘制结果。使用plot_resource_usage()绘制资源在模拟时间框架内的使用情况。gas.station代表单个模拟环境。"pump"代表资源的名称。"items="system"指的是要绘制的资源组件。结果随后存储在ggplot2`类型图形的对象中：

    > graph <- plot_resource_usage(gas.station, "pump", items="system")
    > graph + geom_hline(yintercept = Resolution)

结果如下：

蒙特卡洛模拟 - 校准的 Hull 和 White 短期利率

蒙特卡洛模拟是对系统行为的随机模拟。模拟使用采样实验在模型上执行，然后使用计算机进行数值实验，以获得对系统行为的统计理解。

准备工作

为了对校准的船体和白短期利率进行蒙特卡洛模拟，从与QuantLib 0.3.10 一起发布的示例代码中获取数据，使用市场数据构建利率期限结构和期权波动率矩阵，并对应于到期日和期限。

步骤 1 - 安装包和库

加载以下包：

    >install.packages("RQuantLib", type="binary")
    >install.packages("ESGtoolkit")
    >library(RQuantLib)
    >library(ESGtoolkit)

注意

版本信息：本页面的代码在 R 版本 3.2.2（2015-08-14）中进行了测试

为了使Quantlib包的部分内容对 R 环境RQuantLib可用，使用了RQuantLib。Quantlib包提供了一个用于定量金融的全面软件框架。RQuantLib的目标是提供用于建模、交易、来源的源库，无论是本地还是远程来源。GSPC 是资产。

type="binary" 表示要下载和安装的包的类型。这意味着要安装的包的性质不是源包。

如何做到这一点...

让我们深入了解。

第 2 步 - 初始化数据和变量

初始化变量：

    > freq <- "monthly"
    > delta_t <- 1/12

打印 delta_t 的值：

> delta_t

结果如下：

从与 QuantLib 0.3.10 集成的示例代码中初始化变量。一个指定 tradeDate（月/日/年）、settleDate、远期利率时间跨度 dt 以及两个曲线构建选项：interpWhat（可能的值为贴现、远期和零）和 interpHow（可能的值为线性、对数线性和平滑）。这里的平滑意味着对 interpWhat 值进行三次样条插值。

然后将结果存储在 params 数据框中：

> params <- list(tradeDate=as.Date('2002-2-15'),
 settleDate=as.Date('2002-2-19'),
 payFixed=TRUE,
 dt=delta_t,
 strike=.06,
 method="HWAnalytic",
 interpWhat="zero",
 interpHow= "spline")

初始化市场数据。为利率、存款和掉期构建了期限结构。然后将结果存储在 TermQuotes 中：

> TermQuotes  <- list(d1w =0.0382, # 1-week deposit rate
 d1m =0.0372,# 1-month deposit rate
 d3m = 0.0363,# 3-month deposit rate
 d6m = 0.0353,# 6-month deposit rate
 d9m = 0.0348,# 9-month deposit rate
 d1y = 0.0345,# 1-year deposit rate
 s2y = 0.037125,# 2-year swap rate
 s3y =0.0398,# 3-year swap rate
 s5y =0.0443,# 5-year swap rate
 s10y =0.05165,# 10-year swap rate
 s15y =0.055175)# 15-year swap rate

初始化 Swaptionmaturities：

> SwaptionMaturities <- c(1,2,3,4,5)

打印 SwaptionMaturities 的值：

> SwaptionMaturities

结果如下：

初始化掉期期限：

> SwapTenors <- c(1,2,3,4,5)

打印 SwapTenors 的值：

> SwapTenors

结果如下：

初始化波动率矩阵。matrix() 函数从给定的值集中创建矩阵。ncol=5 表示所需的列数。byrow=TRUE 表示矩阵按行填充。然后将结果存储在 VolatilityMatrix 中：

> VolatilityMatrix <- matrix(
 c(0.1490, 0.1340, 0.1228, 0.1189, 0.1148,
 0.1290, 0.1201, 0.1146, 0.1108, 0.1040,
 0.1149, 0.1112, 0.1070, 0.1010, 0.0957,
 0.1047, 0.1021, 0.0980, 0.0951, 0.1270,
 0.1000, 0.0950, 0.0900, 0.1230, 0.1160),
 ncol=5, byrow=TRUE)

第 3 步 - 评估伯努利掉期期权

按以下方式评估伯努利掉期期权。BermudanSwaption 是 Quantlib 包的一部分。通过 RQuantLib 可在 R 环境中使用。BermudanSwaption 在将选定的短期利率模型校准到输入的掉期波动率矩阵后，评估具有指定行权和到期日（以年为单位）的伯努利掉期期权。掉期期权的到期日和掉期期限以年为单位。假设伯努利掉期期权在基础掉期的每个重置日均可行使。通过传递 params、TermQuotes、SwaptionMaturities、SwapTenors 和 VolatilityMatrix 作为输入来计算伯努利掉期期权。结果存储在 BermudanSwaption 中：

> BermudanSwaption <- RQuantLib::BermudanSwaption(params, TermQuotes, SwaptionMaturities, SwapTenors, VolatilityMatrix)

显示 BermudanSwaption 的估值。结果如下：

打印 BermudanSwaption 的摘要：

> summary(BermudanSwaption)

结果如下：

打印 BermudanSwaption 的估值：

> BermudanSwaption

结果如下：

第 4 步 - 构建利率的现货期限结构

初始化返回贴现因子、远期利率和零利率的时间向量。时间指定为最大时间加上 delta_t 不超过用于校准的金融工具的最长期限（不进行外推）：

> times <- seq(from = delta_t, to = 5, by = delta_t)

DiscountCurve 根据输入的市场数据构建利率的即期期限结构，包括结算日期、存款利率和掉期利率。它返回指定为输入的时间向量对应的贴现因子、零利率和远期利率。params 代表一个列表，指定了 tradeDate（月/日/年）、settleDate、远期利率时间跨度以及两个曲线构建选项：interpWhat（可能的值为贴现、远期和零）和 interpHow（可能的值为 linear、loglinear 和 spline）。这里的 spline 表示对 interpWhat 值的三次样条插值。TermQuotes 代表构建利率即期期限结构的市场报价。使用以下命令：

> DiscountCurve <- RQuantLib::DiscountCurve(params, TermQuotes, times)

探索 DiscountCurve 数据框的内部结构。str() 函数显示数据框的内部结构。DiscountCurve 作为 R 对象传递给 str() 函数：

> str(DiscountCurve)

结果如下：

寻找返回贴现因子、远期利率和零利率的到期时间：

> maturities <- DiscountCurve$times

打印到期日的值：

> maturities

结果如下：

寻找零息利率：

> MarketZeroRates <- DiscountCurve$zerorates

打印零息利率的值：

> MarketZeroRates

结果如下：

寻找贴现因子：

> MarketPrices <- DiscountCurve$discounts

打印贴现因子：

> MarketPrices

结果如下：

第 5 步 - 模拟 Hull-White 短期利率

设置时间范围：

> horizon <- 5

设置模拟次数：

    > NoSimulations <- 10000
    > a <- BermudanSwaption$a

打印 a 的值：

> a

> sigma <- BermudanSwaption$sigma

打印 sigma 的值：

> sigma

模拟高斯冲击。simshocks() 创建与风险因子相关的或依赖的高斯冲击的模拟版本。n = NoSimulations 表示模拟次数。horizon = 5 表示时间范围。frequency = monthly。结果随后存储在 GaussianShocks 数据框中：

> GaussianShocks <- ESGtoolkit::simshocks(n = NoSimulations, horizon = horizon, frequency = freq)

simdiff() 用于模拟扩散过程。n = NoSimulations 表示独立观察的数量。frequency = freq 表示每月。model = "OU" 代表奥恩斯坦-乌伦贝克方法。x0 = 0 是过程的起始值。eps = GaussianShocks 代表高斯冲击：

> x <- ESGtoolkit::simdiff(n = NoSimulations, horizon = horizon, frequency = freq, model = "OU", x0 = 0, theta1 = 0, theta2 = a, theta3 = sigma, eps = GaussianShocks)

计算远期利率。ts() 创建时间序列对象。replicate(nb.sims, DiscountCurve$forwards) 创建时间序列值向量。start = start(x) 表示第一次观察的时间。deltat = deltat(x) 表示连续观察之间的采样周期分数。结果存储在 ForwardRates 数据框中：

> ForwardRates <- ts(replicate(nb.sims, DiscountCurve$forwards), start = start(x), deltat = deltat(x))

生成常规序列。from = 0，to = horizon 表示序列的起始和结束值。by = delta_t 表示序列的增量：

    > t.out <- seq(from = 0, to = horizon, by = delta_t)
    > param.alpha <- ts(replicate(NoSimulations, 0.5*(sigma²)*(1 - exp(-a*t.out))²/(a²)), start = start(x), deltat = deltat(x))
    > alpha <- ForwardRates + param.alpha

生成短期利率：

> ShortRates <- x + alpha

计算随机贴现值：

> StochasticDiscount <- ESGtoolkit::esgdiscountfactor(r = ShortRates, X = 1)

计算随机贴现值的平均值：

> MonteCarloPrices <- rowMeans(StochasticDiscount)

打印 MonteCarloPrices 的值：

> MonteCarloPrices

结果如下：

计算随机贴现值的零利率：

> MonteCarloZeroRates <- -log(MonteCarloPrices)/maturities

打印 MonteCarloZeroRates 的值：

> MonteCarloZeroRates

结果如下：

对随机贴现项与市场价格之间的差异进行学生 t 检验。t.test(x) 执行 t 检验。conf.int 表示均值适当的置信区间：

> ConfidenceInterval <- t(apply((StochasticDiscount - MarketPrices)[-1, ], 1, function(x) t.test(x)$conf.int))

head() 函数返回 ConfidenceInterval 框架的第一部分。ConfidenceInterval 框架作为输入参数按如下方式传递：

> head(ConfidenceInterval)

设置图形参数如下：

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

esgplotbands() 按如下方式绘制颜色置信区间带。ShortRates 表示置信区间：

> ESGtoolkit::esgplotbands(ShortRates, xlab = "maturities", ylab = "short-rate quantiles", main = "Short Rate Quantiles")

按如下方式绘制 蒙特卡洛与市场 n 零利率 对比图。到期日，MonteCarloZeroRates 表示时间序列：

> plot(maturities, MonteCarloZeroRates, type='l', col = 'blue', lwd = 1, main = "Monte Carlo v/s Market n Zero Rates")

在到期日 MonteCarloZeroRates 之间的指定坐标处添加一系列点：

> points(maturities, MonteCarloZeroRates, col = 'red')

按如下方式绘制蒙特卡洛与市场价格对比图。到期日，MonteCarloPrices 表示时间序列：

> plot(maturities, MonteCarloPrices, type='l', col = 'blue', lwd = 1, main = "Monte Carlo v/s Market Prices")

在到期日 MonteCarloPrices 之间的指定坐标处添加一系列点：

> points(maturities, MonteCarloPrices, col = 'red')

> matplot(maturities[-1], conf.int, type = 'l', main = "Confidence Interval for the price difference")

第九章：结构化预测

在本章中，我们将介绍以下食谱：

• 隐藏马尔可夫模型 - 欧元和美元

• 用于制度检测的隐藏马尔可夫模型

简介

隐藏马尔可夫模型（HMM）是一种非常强大的统计方法，用于表征离散时间序列的观察数据样本。它不仅能够提供一种构建简约参数模型的高效方法，还可以将其核心中的动态规划原理用于统一的时间序列数据序列的模式分割和模式分类。时间序列中的数据样本可以是离散的或连续的；它们可以是标量或向量。HMM 的潜在假设是数据样本可以很好地表征为参数随机过程，并且随机过程的参数可以在精确和定义良好的框架中估计。

隐藏马尔可夫模型 - 欧元和美元

欧元/美元（EUR/USD）是外汇市场中最常交易的货币对。它们的流行可以归因于这样一个事实：每种货币都代表着世界上两个最大的经济和贸易集团，以及许多在跨大西洋地区开展业务的跨国公司。

对于这个货币对的汇率变动通常与影响欧元或美元价值的因素有关。作为世界上最具流动性的货币对，EUR/USD 为寻求即时买入或卖出的交易者提供了紧密的价差和持续的流动性。稳定性和波动性的结合使 EUR/USD 成为初学者和高级交易者的绝佳选择。EUR/USD 对为交易者提供了高流动性，并且具有非常紧密和具有竞争力的价差。美国经济和欧洲经济的相对强度，可以通过每日新闻追踪，通常影响这一对。

准备工作

为了将隐藏马尔可夫模型应用于寻找不同的市场制度，并因此优化交易策略，我们将使用收集在欧元/美元数据集上的数据集。

第 1 步 - 收集和描述数据

将使用标题为EURUSD1d.csv的数据集。此数据集以 CSV 格式提供，称为EURUSD1d.csv。数据集采用标准格式。有 1,008 行数据，五个变量。数值变量如下：

• 开盘

• 高

• 低

• 收盘价

非数值变量是：

• 开盘时间戳

如何操作...

让我们深入了解。

第 2 步 - 探索数据

需要在第一步中加载以下包：

 > install.packages("depmixS4")
 > install.packages("quantmod")
 > install.packages("ggplot2")
 > library(depmixS4)
 > library(quantmod)
 > library(ggplot2)

注意

版本信息：本页面的代码在 R 版本 3.2.2（2015-08-14）上进行了测试

让我们探索数据并了解变量之间的关系：

我们将首先导入名为EURUSD1d.csv的 CSV 数据文件。我们将如下将数据保存到EuroUSD数据框中：

> EuroUSD <- read.csv("d:/EURUSD1d.csv", header = TRUE)

打印EuroUSD框架：head()函数返回EuroUSD框架的第一部分。EuroUSD框架作为输入参数传递：

> head(EuroUSD)

结果如下：

打印 EuroUSD 数据框的摘要：summary() 函数是一个多功能函数。summary() 是一个通用函数，它提供了与单个对象或数据框相关的数据的摘要。EuroUSD 数据框作为 R 对象传递给 summary() 函数：

> summary(EuroUSD)

结果如下：

探索 EuroUSD 数据框的内部结构：str() 函数显示数据框的内部结构。EuroUSD 作为 R 对象传递给 str() 函数：

> str(EuroUSD)

结果如下：

第 3 步 - 将数据转换为时间序列

创建字符类型对象：as.character() 函数将实数和复数表示为 15 位有效数字。除了第 1 列之外，整个 EuroUSD 数据框被传递：

> Date <- as.character(EuroUSD[,1])

操作 Date 数据框以表示日历日期。结果随后存储在数据框 DateTimeSeries 中：

> DateTimeSeries <- as.POSIXlt(Date, format = "%Y.%m.%d %H:%M:%S")

创建紧密耦合的数据框。data.frame() 为 EuroUSD[,2:5] 创建数据框。row.names = DateTimeSeries 为创建的数据框提供行名：

> TimeSeriesData <- data.frame(EuroUSD[,2:5], row.names = DateTimeSeries)

打印 TimeSeriesData 数据框。head() 函数返回 TimeSeriesData 数据框的前部分。TimeSeriesData 数据框作为输入参数传递：

> head(TimeSeriesData)

结果如下：

as.xts() 函数将 TimeSeriesData 数据对象转换为 xts 类，而不丢失 TimeSeriesData 数据框的任何属性，如下所示：

> TimeSeriesData <- as.xts(TimeSeriesData)

测量高低收盘价序列的波动性。ATR() 函数测量 TimeSeriesData 高低收盘价序列的平均波动性。TimeSeriesData[,2:4] 表示 TimeSeriesData 的高低收盘价。结果随后存储在 ATRindicator 数据框中：

> ATRindicator <- ATR(TimeSeriesData[,2:4],n=14)

打印 ATRindicator 数据框。head() 函数返回 ATRindicator 数据框的前部分。ATRindicator 数据框作为输入参数传递：

> head(ATRindicator)

结果如下：

测量高频率序列的波动性。ATRindicator [,2] 表示 TimeSeriesData 的高点。结果随后存储在 TrueRange 数据框中：

> TrueRange <- ATRindicator[,2]

打印 TrueRange 数据框：

> head(TrueRange)

结果如下：

计算收盘价和开盘价的 LogReturns 之间的差异。结果随后存储在 LogReturns 数据框中：

> LogReturns <- log(EuroUSD$Close) - log(EuroUSD$Open)

打印 LogReturns 数据框的摘要。summary() 函数用于提供与单个对象或数据框相关的数据的摘要。LogReturns 数据框作为 R 对象传递给 summary() 函数：

> summary(LogReturns)

结果如下：

第 4 步 - 建立模型

创建 HMM 模型的数据框。data.frame() 函数创建紧密耦合的数据框，这些数据框具有许多与矩阵相似的属性：

> HMMModel <- data.frame(LogReturns, TrueRange)

删除计算 HMMModel 指标的数据：

> HMMModel <- HMMModel[-c(1:14),]

打印 HMMModel 数据框：

> head(HMMModel)

结果如下：

命名列。c() 函数将参数组合成向量。传递给函数的所有参数组合成返回值的共同类型：

> colnames(HMMModel) <- c("LogReturns","TrueRange")

打印列名：

> colnames(HMMModel)

结果如下：

> set.seed(1)

建立三状态机制并将响应分布设置为高斯状态。depmix() 函数创建隐马尔可夫模型。LogReturns~1、TrueRange~1 代表要建模的响应。data = HMMModel 代表解释响应变量的数据框，而 nstates=3 是状态的数量：

> HMM <- depmix(list(LogReturns~1, TrueRange~1), data = HMMModel, nstates=3, family=list(gaussian(), gaussian()))

将 HMM 模型拟合到定义的数据集。fit() 函数优化 HMM 模型的参数，受线性不等式约束。HMM 是 HMM 类的对象，而 verbose = FALSE 表示信息不应显示在屏幕上。优化后的参数存储在 depmix 类的 HMMfit 对象中：

> HMMfit <- fit(HMM, verbose = FALSE)

比较对数似然、AIC 和 BIC 值。print() 函数打印 HMMfit 的参数：

> print(HMMfit)

结果如下：

> summary(HMMfit)

打印 LogReturns 数据框的摘要。summary() 函数用于提供与单个对象或数据框相关的数据摘要。将 LogReturns 数据框作为 R 对象传递给 summary() 函数：

结果如下：

为数据集中的每个状态找到后验概率。结果存储在 HMMstate 中：

> HMMstate <- posterior(HMMfit)

打印 HMMstate 数据框。显示每一天每个状态的概率以及最高概率的类别：

> head(HMMstate)

结果如下：

第 5 步 - 显示结果

按以下步骤显示计算出的 HMMstate 数据框：

创建 HMM 模型的数据框。data.frame() 函数创建紧密耦合的数据框，这些数据框具有许多与矩阵相似的属性。DateTimeSeries、LogReturns 和 TrueRange 数据框被传递以紧密耦合。结果随后存储在 DFIndicators 中：

 > DFIndicators <- data.frame(DateTimeSeries, LogReturns, TrueRange)
 > DFIndicatorsClean <- DFIndicators[-c(1:14), ]

创建如下数据框：

> Plot1Data <- data.frame(DFIndicatorsClean, HMMstate$state)

使用 ggplot() 绘制结果：

 > LogReturnsPlot <- ggplot(Plot1Data,aes(x=Plot1Data[,1],y=Plot1Data[,2]))+geom_line(color="darkred")+labs(,y="Log Return Values",x="Date")
 > LogReturnsPlot

结果如下：

隐藏马尔可夫模型 - 机制检测

标准普尔 500 指数（S&P 500）是美国股票市场 500 支股票的指数。它是美国股票市场的一个领先指标，反映了经济学家选定的大型公司的表现。在确定 500 支股票时，专家会考虑包括在指数中的因素，包括市场规模、流动性和行业分组。它是一个市值加权指数，也是美国股市的常见基准之一。基于 S&P 500 的投资产品包括指数基金和交易所交易基金，可供投资者购买。由于需要 500 家公司的股票按整个投资组合的比例来复制指数的市场资本化方法，因此投资者复制 S&P 500 具有挑战性。对于投资者来说，购买 S&P 500 投资产品之一，如先锋 S&P 500 ETF、SPDR S&P 500 ETF 或 S&P 500 指数 ETF，会更容易一些。

准备工作

为了执行隐藏马尔可夫模型，我们将使用收集在 S&P500 回报集中的数据集。

第一步 - 收集和描述数据

要使用的数据集是从 2004 年 1 月 1 日到现在的 S&P500 每日回报值。此数据集在 yahoo.com/ 上免费提供，我们将从那里下载数据。

如何操作...

让我们深入了解细节。

第二步 - 探索数据

加载以下包：

 > install.packages("depmixS4")
 > install.packages("quantmod")

注意

版本信息：本页面的代码在 R 版本 3.3.0（2016-05-03）上进行了测试

上述每个库都需要安装。

 > library("depmixS4 ")
 > library("quantmod")
 > set.seed(1)

让我们下载数据。我们首先为所需数据的时间段标记开始日期和结束日期。

使用 getSymbols() 函数按以下方式加载数据。该函数从多个来源加载数据，无论是本地还是远程来源。GSPC 是字符向量，指定要加载的符号名称：

> getSymbols( "^GSPC", from="2004-01-01" )

计算每个收盘价的对数差异。然后将结果保存在 GSPCDiff 数据框中：

> GSPCDiff = diff( log( Cl( GSPC ) ) )

探索 GSPCDiff 框架的内部结构。str() 函数显示数据框的内部结构。GSPCDiff 作为 R 对象传递给 str() 函数：

> str(GSPCDiff)

结果如下：

按以下方式打印 GSPCDiff 数据框：

> head(GSPCDiff)

结果如下：

创建 GSPCDiff 数据框的数值：

> returns = as.numeric(GSPCDiff)

绘制 GSPCDiff 数据框：

> plot(GSPCDiff)

第三步 - 准备模型

将具有两个状态的隐藏马尔可夫模型拟合到 S&P 回报。为两个状态创建隐藏马尔可夫模型。

depmix() 函数创建隐藏马尔可夫模型。returns ~ 1 表示要建模的响应。data=data.frame(returns=returns) 表示数据框，用于解释响应中的变量，而 nstates = 2 是状态的数量：

 > hmm2states <- depmix(returns ~ 1, family = gaussian(), nstates = 2, data=data.frame(returns=returns))
 > hmm2states

结果如下：

将 HMM 模型拟合到定义的数据集。fit()函数优化 HMM 模型的参数，受线性不等式约束。hmm2states是 HMM 类的一个对象，而verbose = FALSE指示信息不应显示在屏幕上。优化后的参数存储在depmix类的hmmfit2states对象中：

> hmmfit2states <- fit(hmm2states, verbose = FALSE)

比较对数似然、AIC 和 BIC 值：

> hmmfit2states

结果如下：

为数据集的每个状态找到后验概率。结果存储在PosteriorProbs中：

> PosteriorProbs <- posterior(hmmfit2states)

打印PosteriorProbs框架。head()函数返回PosteriorProbs框架的第一部分。PosteriorProbs框架作为输入参数传递：

> head (PosteriorProbs)

结果如下：

绘制两个状态的结果。type='l'表示为线图：

> plot(returns, type='l', main='Regime Detection', xlab='No of Observations', ylab='Returns')

结果如下：

绘制PosteriorProbs数据框的列：

> matplot(PosteriorProbs[,-1], type='l', main='Regime Posterior Probabilities', xlab='No of Observations', ylab='Probability')

结果如下：

创建三个状态的秘密马尔可夫模型：

 > hmm3states <- depmix(returns ~ 1, family = gaussian(), nstates = 3, data=data.frame(returns=returns))
 > hmm3states

结果如下：

将 HMM 模型拟合到定义的数据集：

> hmmfit3states <- fit(hmm3states, verbose = FALSE)

为数据集的每个状态找到后验概率：

> PosteriorProbs <- posterior(hmmfit3states)

打印PosteriorProbs框架：

> head(PosteriorProbs)

结果如下：

> plot(returns, type='l', main='Regime Detection', xlab='No of Observations', ylab='Returns')

结果如下：

> matplot(PosteriorProbs[,-1], type='l', main='Regime Posterior Probabilities', xlab='No of Observations', ylab='Probability')

结果如下：

创建四个状态的秘密马尔可夫模型：

    > hmm4states <- depmix(returns ~ 1, family = gaussian(), nstates = 4, data=data.frame(returns=returns))
    > hmm4states

结果如下：

将 HMM 模型拟合到定义的数据集：

> hmmfit4states <- fit(hmm4states, verbose = FALSE)

为数据集的每个状态找到后验概率：

    > PosteriorProbs <- posterior(hmmfit4states)    > plot(returns, type='l', main='Regime Detection', xlab='No of Observations', ylab='Returns')

结果如下：

> matplot(PosteriorProbs[,-1], type='l', main='Regime Posterior Probabilities', xlab='No of Observations', ylab='Probability')

结果如下：

第十章：神经网络

在本章中，我们将介绍以下内容：

• 模拟标准普尔 500

• 测量失业率

简介

神经网络：神经网络是一个有序的三元组 ，其中 是神经元的集合， 是一个集合 ，其元素被称为神经元 和神经元 之间的连接。函数 定义了权重，其中 是神经元 和神经元 之间连接的权重。数据通过连接在神经元之间传输，连接权重可以是兴奋的或抑制的。

模拟标准普尔 500

根据市值，纽约证券交易所或纳斯达克综合指数上市的 500 家最大公司的股票市值是通过标准普尔 500 指数来衡量的。标准普尔提供了一种基于股票价格的市场和经济走势的快速观察。标准普尔 500 指数是金融媒体和专业人士最常用的衡量指标。标准普尔 500 指数是通过将所有标准普尔 500 股票的调整市值相加，然后除以标准普尔开发的指数除数来计算的。当出现股票分割、特殊股息或分拆等可能影响指数价值的情况时，除数会进行调整。除数确保这些非经济因素不会影响指数。

准备工作

为了使用神经网络来模拟标准普尔 500 指数，我们将使用从 GSPC 数据集收集的数据集。

第 1 步 - 收集和描述数据

要使用的数据集是 2009 年 1 月 1 日至 2014 年 1 月 1 日之间的 GSPC 每日收盘股票价值。这个数据集在 www.yahoo.com/ 上免费提供，我们将从那里下载数据。

如何操作...

让我们深入了解细节。

第 2 步 - 探索数据

首先，需要加载以下包：

 > install.packages("quantmod")
 > install.packages("neuralnet")
 > library(quantmod)
 > library(neuralnet)

让我们下载数据。我们将首先标记所需时间段的开始和结束日期。

as.Date() 函数用于将字符表示和 Date 类对象转换为日历日期。

数据集的开始日期存储在 startDate 中，它代表日历日期的字符向量表示。这种表示的格式是 YYYY-MM-DD：

> startDate = as.Date("2009-01-01")

数据集的结束日期存储在 endDate 中，它代表日历日期的字符向量表示。这种表示的格式是 YYYY-MM-DD：

> endDate = as.Date("2014-01-01")

使用getSymbols()函数加载数据：该函数从多个来源加载数据，无论是本地还是远程。GSPC是字符向量，指定要加载的符号名称。src = yahoo指定了数据来源方法：

> getSymbols("^GSPC", src="img/yahoo", from=startDate, to=endDate)

步骤 3 - 计算指标

计算相对强弱指数：这是最近上升价格变动与绝对价格变动的比率。使用RSI()函数计算相对强弱指数。GSPC数据框用作价格序列。n = 3代表移动平均的周期数。结果存储在relativeStrengthIndex3数据框中：

> relativeStrengthIndex3 <- RSI(Op(GSPC),n=3)

探索价格变化的总结：为此使用summary()函数。该函数提供一系列描述性统计，以生成relativeStrengthIndex3数据框的结果摘要：

> summary(relativeStrengthIndex3)

结果如下：

EMA()函数使用GSPC符号作为价格序列。n = 5代表平均的时间周期。结果存储在exponentialMovingAverage5数据框中：

> exponentialMovingAverage5 <- EMA(Op(GSPC),n=5)

打印exponentialMovingAverage5数据框：head()函数返回exponentialMovingAverage5数据框的前部分。exponentialMovingAverage5数据框作为输入参数传递：

> head(exponentialMovingAverage5)

结果如下：

探索价格变化的总结。为此，使用summary()函数。此函数提供一系列描述性统计，以生成exponentialMovingAverage5数据框的结果摘要。

> summary(exponentialMovingAverage5)

结果如下：

计算GSPC和exponentialMovingAverage5的指数开盘价之间的差异：

> exponentialMovingAverageDiff <- Op(GSPC) - exponentialMovingAverage5

现在让我们打印exponentialMovingAverageDiff数据框。head()函数返回exponentialMovingAverageDiff数据框的前部分。exponentialMovingAverageDiff数据框作为输入参数传递：

> head(exponentialMovingAverageDiff)

结果如下：

探索价格变化的总结：为此使用summary()函数。此函数提供一系列描述性统计，以生成exponentialMovingAverageDiff数据框的结果摘要。

> summary(exponentialMovingAverageDiff)

结果如下：

我们现在将比较GSPC系列快速移动平均与GSPC系列的慢速移动平均。为此，将GSPC作为价格矩阵传递。fast = 12代表快速移动平均的周期数，slow = 26代表慢速移动平均的周期数，signal = 9代表移动平均的信号：

> MACD <- MACD(Op(GSPC),fast = 12, slow = 26, signal = 9)

打印 MACD 数据框：tail() 函数返回 MACD 数据框的最后部分。MACD 数据框作为输入参数传递：

> tail(MACD)

结果如下：

使用 summary() 函数探索价格变化摘要：

> summary(MACD)

结果如下：

接下来，我们将抓取信号线作为指标。结果存储在 MACDsignal 数据框中：

> MACDsignal <- MACD[,2]

计算 布林带：它们是范围指标，从移动平均线计算标准差。布林带在以下逻辑下运行：货币对的价格最有可能趋向于其平均值；因此，当它偏离太多，比如说两个标准差之外时，它将回落到其移动平均线。BBands() 函数用于计算布林带。GSPC 作为对象传递，n=20 表示移动平均期的数量。sd=2 表示两个标准差：

> BollingerBands <- BBands(Op(GSPC),n=20,sd=2)

现在让我们打印 BollingerBands 数据框：

> tail(BollingerBands)

结果如下：

探索价格变化的摘要：

> summary(BollingerBands)

结果如下：

现在让我们从 BollingerBands 抓取信号线作为指标：

> PercentageChngpctB <- BollingerBands[,4]

打印 PercentageChngpctB 数据框：

> tail(PercentageChngpctB)

结果如下：

探索 PercentageChngpctB 的变化摘要：

> summary(PercentageChngpctB)

结果如下：

查找收盘价和开盘价之间的差异：

> Price <- Cl(GSPC)-Op(GSPC)

打印 price 数据框：

> tail(Price)

结果如下：

结合 relativeStrengthIndex3、expMvAvg5Cross、MACDsignal、PercentageChngpctB 和 Price 数据框：结果随后存储在 DataSet 数据框中：

> DataSet <- data.frame(relativeStrengthIndex3, expMvAvg5Cross, MACDsignal, PercentageChngpctB, Price)

探索 DataSet 数据框的内部结构：str() 函数显示数据框的内部结构。DataSet 作为 R 对象传递给 str() 函数：

> str(DataSet)

结果如下：

计算指标、创建数据集和移除点：

> DataSet <- DataSet[-c(1:33),]

探索 DataSet 数据框的维度：dim() 函数返回 DataSet 数据框的维度。DataSet 数据框作为输入参数传递。结果清楚地表明有 1,176 行数据和 5 列：

> dim(DataSet)

结果如下：

命名列：c() 函数用于将参数组合成向量：

> colnames(DataSet) <- c("RSI3","EMAcross","MACDsignal","BollingerB","Price")

探索 DataSet 数据框的维度：

> str(DataSet)

结果如下：

步骤 4 - 为模型构建准备数据

将数据集归一化到 0 到 1 之间：

> Normalized <- function(x) {(x-min(x))/(max(x)-min(x))}

调用归一化数据集的函数：

> NormalizedData <- as.data.frame(lapply(DataSet,Normalized))

打印 NormalizedData 数据框：

> tail(NormalizedData)

结果如下：

构建训练数据集：NormalizedData 数据框中的 1:816 数据元素将被用作训练数据集。训练数据集应存储在 TrainingSet 中：

> TrainingSet <- NormalizedData[1:816,]

探索 TrainingSet 数据框的维度：

> dim(TrainingSet)

结果如下：

探索 TrainingSet 的变化摘要：

> summary(TrainingSet)

结果如下：

构建测试数据集：NormalizedData 数据框中的 817:1225 数据元素将被用作训练数据集。此测试数据集应存储在 TestSet 中：

> TestSet <- NormalizedData[817:1225 ,]

探索 TrainingSet 数据框的维度：

> dim(TestSet)

结果如下：

探索 TestSet 的变化摘要：

> summary(TestSet)

结果如下：

第 5 步 - 构建模型

构建神经网络：neuralnet() 函数使用不带权重回溯的反向传播算法训练神经网络。Price~RSI3+EMAcross+MACDsignal+BollingerB 是要拟合的模型的描述。data=TrainingSet 是包含公式中指定变量的数据框。hidden=c(3,3) 指定了每层的隐藏神经元（顶点）数量。learningrate=.001 表示反向传播算法使用的学习率。algorithm="backprop" 指的是反向传播算法：

> nn1 <- neuralnet(Price~RSI3+EMAcross+MACDsignal+BollingerB,data=TrainingSet, hidden=c(3,3), learningrate=.001,algorithm="backprop")

绘制神经网络：

> plot(nn1)

结果如下：

测量失业率

失业率定义为失业的劳动力占总劳动力的百分比，且积极寻找工作并愿意工作。根据国际劳工组织（ILO）的定义，失业者是指积极寻找工作但没有工作的人。失业率是衡量失业人数同时失业和寻找工作的指标。

准备就绪

为了使用神经网络进行失业率测量，我们将使用收集到的威斯康星州失业率数据集。

第 1 步 - 收集和描述数据

为此，我们将使用标题为 FRED-WIUR.csv 的 CSV 数据集。有 448 行数据。有两个数值变量如下：

• 日期

• 值

此数据集显示了 1976 年 1 月 1 日至 2013 年 4 月 1 日间威斯康星州的失业率。

如何操作...

让我们深入了解。

第 2 步 - 探索数据

首先，需要加载以下包：

 > install.packages("forecast ")
 > install.packages("lmtest") 
 > install.packages("caret ")
 > library(forecast)
 > library(lmtest)
 > library(caret)

注意

版本信息：本页面的代码在 R 版本 3.3.0 中进行了测试

让我们探索数据并了解变量之间的关系。我们将首先导入名为 FRED-WIUR.csv 的 CSV 数据文件。我们将数据保存到 ud 数据框中：

> ud <- read.csv("d:/FRED-WIUR.csv", colClasses=c('Date'='Date'))

打印 ud 数据框：tail() 函数返回 ud 数据框的最后部分。将 ud 数据框作为输入参数传递：

> tail(ud)

结果如下：

命名列：使用 c() 函数将参数组合成向量：

> colnames(ud) <- c('date', 'rate')

使用 as.Date() 函数将字符表示和 Date 类的对象转换为日期：

> ud$date <- as.Date(ud$date)

探索失业数据的摘要：为此，使用 summary() 函数。该函数提供一系列描述性统计，以生成 ud 数据框的结果摘要：

> summary (ud)

结果如下：

现在，让我们从第 1 行到第 436 行创建基础数据：

> ud.b <- ud[1:436,]

探索基础失业数据的摘要。为此，使用 summary() 函数。该函数提供一系列描述性统计，以生成 ud.b 数据框的结果摘要：

> summary(ud.b)

结果如下：

现在，让我们从第 437 行到第 448 行创建测试数据：

> ud.p <- ud[437:448,]

探索测试失业数据的摘要：

> summary(ud.p)

结果如下：

从 1976 年创建基础时间序列数据：ts() 函数作为创建时间序列对象的函数。ud.b$rate 代表观察到的时序值向量：

> ud.ts <- ts(ud.b$rate, start=c(1976, 1), frequency=12)

打印 ud.ts 数据框的值：

> ud.ts

结果如下：

创建测试时间序列数据：ts() 函数创建时间序列对象。ud.b$rate 代表观察到的时序值向量：

> ud.p.ts <- ts(ud.p$rate, start=c(2012, 5), frequency=12)

打印 ud.ts 数据框的值：

> ud.ts

结果如下：

绘制基础时间序列数据：

> plot.ts(ud.ts)

结果如下：

绘制测试时间序列数据：

> plot.ts(ud.p.ts)

结果如下：

第三步 - 准备和验证模型

计算基础时间序列数据集的平均值。meanf() 函数返回对 ud.ts 数据集应用 i.i.d 模型后的预测和预测区间。12 表示预测的周期：

> mean <- meanf(ud.ts, 12)

对具有漂移的基础时间序列进行预测和预测区间。rwf() 函数对时间序列 ud.ts 进行随机游走预测并返回。参数 12 表示预测的周期：

> forecast_randomwalk <- rwf(ud.ts, 12)

从 ARIMA(0,0,0)(0,1,0)m 基础时间序列对随机游走进行预测和预测区间：snaive()函数对时间序列ud.ts执行 ARIMA(0,0,0)(0,1,0)m，并返回预测结果。参数12表示预测的周期：

> forecast_arima <- snaive(ud.ts, 12)

预测基础时间序列的漂移。rwf()函数对时间序列ud.ts上的随机游走进行预测并返回结果。参数12表示预测的周期。drift=T是一个逻辑标志，用于拟合带有漂移模型的随机游走：

> drift <- rwf(ud.ts, 12, drift=T)

接下来，我们将为趋势基础时间序列数据准备线性拟合模型。tslm()函数将线性模型拟合到ud.ts时间序列。ud.ts~trend公式表示必须考虑趋势成分：

> m1 <- tslm(ud.ts~trend)

为基础时间序列数据准备趋势和季节性的线性拟合模型：tslm()函数将线性模型拟合到ud.ts时间序列。ud.ts~trend+season公式表示趋势和季节性成分必须被考虑：

> m2 <- tslm(ud.ts~trend+season)

residuals()是一个通用函数，在为趋势基础时间序列数据拟合模型后，从对象m1中提取模型残差。

> residual_1 <- residuals(m1)

绘制残差模型：

> plot(residual_1, ylab="Residuals",xlab="Year", title("Residual - Trends"), col = "red")

结果如下：

现在我们来看如何估计自协方差函数。residual_1是单变量数值时间序列对象：

> acf(residual_1, main="ACF of residuals")

结果如下：

residuals()是一个通用函数，在为趋势基础时间序列数据拟合模型后，从对象m2中提取模型残差。

> residual_2 <- residuals(m2)

绘制残差模型：

> plot(residual_2, ylab="Residuals",xlab="Year",title("Residual - Trends + Seasonality"), col = "red")

结果如下：

> acf(residual_2, main="ACF of residuals")

结果如下：

杜宾-沃森检验用于确定线性回归或多元回归的残差是否独立。在杜宾-沃森检验中通常考虑的假设如下：

测试统计量如下：

在此方程中，，是单个的观测值，而是单个的预测值。

随着序列相关性的增加，的值降低。对于的不同值（解释变量的数量）和，已经为上、下临界值和编制了表格：

如果拒绝

如果不拒绝

如果的测试结果不确定。

对基础时间序列数据的趋势进行线性拟合模型的 Durbin-Watson 测试：

> dwtest(m1, alt="two.sided")

结果如下：

对基础时间序列数据的趋势和季节性进行线性拟合模型的 Durbin-Watson 测试：

 > dwtest(m2, alt="two.sided")

结果如下：

使用 LOESS 将基础数据时间序列分解为周期、季节、趋势和不规则成分：

> m3 <- stl(ud.ts, s.window='periodic')

绘制分解后的基础数据时间序列图：

> plot(m3)

结果如下：

对基础数据时间序列执行指数平滑状态空间模型。ets()函数返回ud.ts时间序列上的ets模型。ZZZ - "Z"表示自动选择。第一个字母表示误差类型，第二个字母表示趋势类型，第三个字母表示季节类型：

> m4 <- ets(ud.ts, model='ZZZ')

绘制基础数据时间序列的指数平滑状态空间模型图：

> plot(m4)

结果如下：

返回基础数据时间序列单变量 ARIMA 的阶数：

> m5 <- auto.arima(ud.ts)

绘制基础数据时间序列的单变量 ARIMA 图：

> plot(forecast(m5, h=12))

结果如下：

构建前馈神经网络模型：nnetar()函数使用单个隐藏层和滞后输入构建前馈神经网络，用于预测基础数据的单变量时间序列：

> m6 <- nnetar(ud.ts)

打印前馈神经网络模型的值：

> m6

结果如下：

绘制前馈神经网络模型图：

> plot(forecast(m6, h=12))

结果如下：

步骤 4 - 预测和测试构建的模型的准确性

使用测试数据时间序列测试基础数据时间序列平均值的准确性。accuracy()函数返回预测准确性的汇总度量范围。ud.p.ts是测试数据时间序列：

> a1 <- accuracy(mean, ud.p.ts)

使用漂移测试预测和预测的基础数据时间序列的准确性：

> a2 <- accuracy(forecast_randomwalk, ud.p.ts)

使用 ARIMA(0,0,0)(0,1,0)m 测试预测和预测的基础数据时间序列的准确性：

> a3 <- accuracy(forecast_arima, ud.p.ts)

测试基础数据时间序列漂移的准确性：

> a4 <- accuracy(drift, ud.p.ts)

将结果组合到表格中：

> a.table <- rbind(a1, a2, a3, a4)

打印结果：

> a.table

结果如下：

预测趋势的基础时间序列数据的线性拟合模型。h=12表示预测的周期：

> f1 <- forecast(m1, h=12)

预测趋势和季节性的基础时间序列数据的线性拟合模型：

> f2 <- forecast(m2, h=12)

使用 LOESS 将分解的基础数据时间序列预测为周期、季节、趋势和不规则成分：

> f3 <- forecast(m3, h=12)

预测基础数据时间序列的指数平滑状态空间模型：

> f4 <- forecast(m4, h=12)

预测基础数据时间序列的有序单变量 ARIMA：

> f5 <- forecast(m5, h=12)

预测具有单个隐藏层的前馈神经网络模型：

> f6 <- forecast(m6, h=12)

测试预测的趋势的基础时间序列数据的线性拟合模型的准确性：

> a5 <- accuracy(f1, ud.p.ts)

测试预测的趋势和季节性的基础时间序列数据的线性拟合模型的准确性：

> a6 <- accuracy(f2, ud.p.ts)

使用 LOESS 测试预测分解的基础数据时间序列（周期、季节、趋势和不规则成分）的准确性：

> a7 <- accuracy(f3, ud.p.ts)

测试基础数据时间序列预测的指数平滑状态空间模型的准确性：

> a8 <- accuracy(f4, ud.p.ts)

测试基础数据时间序列预测的有序单变量 ARIMA 的准确性：

> a9 <- accuracy(f5, ud.p.ts)

测试预测的前馈神经网络模型（具有单个隐藏层）的准确性：

> a10 <- accuracy(f6, ud.p.ts)

将结果组合到表格中：

> a.table.1 <- rbind(a5, a6, a7, a8, a9, a10)

打印结果：

> a.table.1

结果如下：

第十一章：深度学习

在本章中，我们将介绍以下内容：

循环神经网络 - 预测周期信号

简介

大多数机器学习算法由于预定义的表示和输入特征而表现良好。机器学习算法通过优化权重来最佳地做出最终预测，而表示学习试图自动学习良好的特征或表示。深度学习算法通过增加复杂性来尝试在多个表示级别上学习。深度架构由多个非线性行为级别组成，例如具有许多隐藏层的神经网络。深度学习技术的目标主要是学习特征层次。深度学习技术可以分为三大类；用于无监督或生成学习的深度网络，用于监督学习的深度网络和混合深度网络

循环神经网络 - 预测周期信号

振荡器是产生特定、周期性波形的电路，如方波、三角波、锯齿波和正弦波。为了生成输出，振荡器通常使用某种形式的主动设备-灯，它被电阻器、电容器和电感器所包围。振荡器的两种主要类型是弛豫振荡器和正弦振荡器。三角波、锯齿波和其他非正弦波形是通过弛豫振荡器产生的，而正弦振荡器由外部组件和放大器组成，以产生振荡。通常，纯正弦波中不含有谐波，它们只包含一个频率。

准备工作...

任务是从一个带噪声的正弦波中预测余弦波。使用 5Hz 频率的正弦波，其中包含一些正态分布的噪声和一个平滑的余弦波。创建的数据集是一组 10 个序列，每个序列包含 40 个观测值。

如何做...

需要在第一步加载以下包：

 > install.packages("rnn")
 > library(rnn)

将初始种子设置为随机数，以实现可重复性：

> set.seed(10)

初始化所需的频率：

> f <- 5

创建所需的向量：

> w <- 2*pi*f

生成序列：seq()函数生成常规序列。0.005是起始值，2是结束值。by=0.005确定增量序列：

> t <- seq(0.005,2,by=0.005)

生成sin和cos值：

 > x <- sin(t*w) + rnorm(200, 0, 0.25)
 > y <- cos(t*w)

生成时间序列样本：matrix()函数从x和y值创建矩阵。nrow = 40表示所需的行数：

 > X <- matrix(x, nrow = 40)
 > Y <- matrix(y, nrow = 40)

绘制带噪声的波形：plot()函数是用于绘制 R 对象的通用函数。as.vector(X)数据框作为函数值传递。type='l'表示线条：

> plot(as.vector(X), col='blue', type='l', ylab = "x-matrix, y-matrix", main = "Noisy waves")

结果如下：

> lines(as.vector(Y), col = "red")

结果如下：

标准化X的值。值的范围在 0 到 1 之间：

> X <- (X - min(X)) / (max(X) - min(X))

打印X的值：

> X

结果如下：

标准化 Y 的值。值的范围介于 0 和 1 之间：

> X <- (X - min(X)) / (max(X) - min(X))

打印 X 的值：

> X

结果如下：

转置 X 和 Y 的值：

 > X <- t(X)
 > Y <- t(Y)

创建训练集和测试集：

 > train <- 1:8
 > test <- 9:10

训练循环神经网络。Y = Y[train,] 表示输出值的数组。X = X[train,] 表示输入值的数组。learningrate = 0.05 表示权重迭代的速率。hidden_dim = 16 是隐藏层的维度。numepochs = 1500 是整个数据集进行训练的次数。

这个阶段将花费时间。所需时间取决于学习率、维度数量以及整个数据集进行训练的次数：

> model <- trainr(Y = Y[train,],X = X[train,],learningrate = 0.05,hidden_dim = 16,numepochs = 1500)

结果如下：

预测循环神经网络（Recurrent Neural Network）的输出：

> Y_predicted <- predictr(model, X)

绘制 实际值与预测值 的对比图。输出构成训练集和测试集：

> plot(as.vector(t(Y)), col = 'red', type = 'l', main = "Actual values vs Predicted values", ylab = "Y, Y-predicted")

结果如下：

> lines(as.vector(t(Y_predicted)), type = 'l', col = 'blue')

结果如下：

绘制 实际值与预测值 的对比图。输出仅构成测试集：

> plot(as.vector(t(Y[test,])), col = 'red', type='l', main = "Actual vs predicted: testing set", ylab = "Y,Y-predicted")

结果如下：

> lines(as.vector(t(Y_predicted[test,])), type = 'l', col = 'blue')

结果如下：

第十二章. 案例研究 - 探索世界银行数据

简介

世界银行指标（WDI）是世界银行汇编的关于全球发展增长及其对人们生活质量的国际可比和可衡量统计数据的集合。通过分析来自 200 多个经济体和 50 多个合作伙伴组织收集的数据，衡量各国、地区和收入群体的发展状况，展示了 1400 多个指标。2015 年 9 月 25 日，联合国大会正式通过了 2030 年可持续发展议程，以指导未来 15 年的全球行动。可持续发展目标（SDG）的五大主要关注主题是人、地球、繁荣、和平和伙伴关系。各国已承诺消除贫困和饥饿，并确保所有人都能在尊严和平等的环境中充分发挥其潜能；保护地球免受退化，并就气候变化采取紧急行动；确保所有人都能享有繁荣充实的生活，并且进步与自然和谐共生；培育和平、公正和包容的社会，消除恐惧和暴力；并动员实施 2030 年议程的手段，重点关注最贫困和最脆弱的人群，通过强大的全球伙伴关系。对于这 17 个目标，世界银行发展数据组、全球实践和跨领域解决方案领域的专家为每个目标选择了指标，以识别和分析重要趋势和挑战，并就测量问题进行讨论。《世界发展指标》是众多国际机构、200 多个国家统计办公室以及许多其他机构合作的结果。

探索世界银行数据

2012 年，全球 13%的人口生活在每天 1.90 美元的国际贫困线以下，而 1990 年这一比例为 37%。所有地区的下降都为提前实现全球减半极端贫困的千年发展目标做出了贡献。目标是到 2030 年消除所有形式的贫困，并为贫困人口提供社会保障，增加基本服务的获取，并支持受冲突和气候相关灾害影响的人。

在低收入国家记录的死亡中，超过一半是由于传染病或母体、围产期或营养状况。而在中高收入国家，记录的死亡中超过三分之二是由于非传染性疾病。全球能源使用量在 1990 年至 2013 年之间增长了约 54%。能源获取是发展的基础，但随着经济的演变，收入增长和人口增长对能源的需求也在增加。能源，尤其是电力，对于提高低收入和中收入国家人们的生活水平至关重要。

准备中...

为了执行再保险合同的定价，我们将使用从飓风数据集收集的数据集。

为了对世界银行的数据模式进行分析，我们将使用从以下数据集收集的数据集：

• 全球总人口（1960-2015）

• 所有国家和地区的出生预期寿命（1960-2014）

• 所有国家和地区的生育率（每名女性的出生数），时间范围为（1960-2014）

• 所有国家和地区的 GDP（以美元计），时间范围为（1960-2015）

• 所有国家和地区的贫困人口比例（1960-2016）

• 所有国家和地区的卫生设施普及率（1960-2016）

• 所有国家和地区的电力普及率（1960-2016）

• 所有国家和地区的二氧化碳排放量（1960-2016）

第 1 步 - 收集和描述数据

世界银行用于分析的数据集可以从世界银行数据库免费下载。

如何操作...

让我们深入了解细节。

第 2 步 - 下载数据

加载以下包：

 > install.packages("wbstats")
 > install.packages("data.table")
 > install.packages("googleVis")

备注

版本信息：本页面的代码在 R 版本 3.3.0（2016-05-03）上进行了测试

以下每个库都需要安装：

 > library(wbstats)
 > library(data.table)
 > library(googleVis)

让我们下载数据并了解变量之间的关系。我们将首先从世界银行网站下载数据。data.table()函数允许快速聚合大型数据集，排序连接，通过组添加/修改/删除列，列出列，友好的文件读取器，以及并行文件写入器。wb()函数使用世界银行 API 下载所需信息。indicator 代表指标代码的字符向量。

指标代码如下：

• SP.POP.TOTL: 全球总人口（1960-2015）

• SP.DYN.LE00.IN: 所有国家和地区的出生预期寿命（1960-2014）

• SP.DYN.TFRT.IN: 所有国家和地区的生育率（每名女性的出生数），时间范围为（1960-2014）

结果存储在Pop_LifeExp_FertRt数据框中。使用以下命令：

> Pop_LifeExp_FertRt <- data.table(wb(indicator = c("SP.POP.TOTL", "SP.DYN.LE00.IN", "SP.DYN.TFRT.IN"), startdate = 1960, enddate = 2016))

指标代码如下：

• SP.POP.TOTL: 全球总人口（1960-2015）

• NY.GDP.MKTP.CD-GDP: 所有国家和地区的 GDP（以美元计），时间范围为（1960-2015）

• SI.POV.2DAY: 所有国家和地区的贫困人口比例（1960-2016）

结果存储在Pop_GDPUSD_HeadCnt数据框中。使用以下命令：

> Pop_GDPUSD_HeadCnt <- data.table(wb(indicator = c("SP.POP.TOTL", "NY.GDP.MKTP.CD", "SI.POV.2DAY"), startdate = 1960, enddate = 2016))

指标代码如下：

• SP.POP.TOTL: 全球总人口（1960-2015）

• NY.GDP.MKTP.CD: 所有国家和地区的 GDP（以美元计），时间范围为（1960-2015）

• SH.STA.ACSN: 所有国家和地区的卫生设施普及率（1960-2016）

结果存储在Pop_GDPUSD_Sanitation数据框中。使用以下命令：

> Pop_GDPUSD_Sanitation <- data.table(wb(indicator = c("SP.POP.TOTL", "NY.GDP.MKTP.CD", "SH.STA.ACSN"), startdate = 1960, enddate = 2016))

指标代码如下：

• NY.GDP.MKTP.CD: 所有国家和地区的 GDP（以美元计），时间范围为（1960-2015）

• EG.ELC.ACCS.ZS: 所有国家和地区的电力普及率（1960-2016）

• EN.ATM.CO2E.KT：所有国家和地区的每人大电力消耗 KWh（1960-2016）

结果存储在 GDPUSD_Electricity_CO2 数据框中。使用以下命令：

> GDPUSD_Electricity_CO2 <- data.table(wb(indicator = c("NY.GDP.MKTP.CD", "EG.ELC.ACCS.ZS", "EN.ATM.CO2E.KT"), startdate = 1960, enddate = 2016))

步骤 3 - 探索数据

探索 Pop_LifeExp_FertRt 数据框的维度：dim() 函数返回 Pop_LifeExp_FertRt 数据框的维度。Pop_LifeExp_FertRt 数据框作为输入参数传递。结果明确指出有 41150 行数据和六个列：

> dim(Pop_LifeExp_FertRt)

结果如下：

探索 Pop_LifeExp_FertRt 数据框的维度：结果明确指出有 27023 行数据和六个列：

> dim(Pop_GDPUSD_HeadCnt)

结果如下：

探索 Pop_GDPUSD_Sanitation 数据框的维度：结果明确指出有 31884 行数据和六个列：

> dim(Pop_GDPUSD_Sanitation)

结果如下：

探索 GDPUSD_Electricity_CO2 数据框的维度：结果明确指出有 23994 行数据和六个列：

> dim(GDPUSD_Electricity_CO2)

结果如下：

探索 Pop_LifeExp_FertRt 数据框的内部结构：str() 函数显示数据框的内部结构。Pop_LifeExp_FertRt 作为 R 对象传递给 str() 函数：

> str(Pop_LifeExp_FertRt)

结果如下：

探索 Pop_GDPUSD_HeadCnt 数据框的内部结构：

> str(Pop_GDPUSD_HeadCnt)

结果如下：

探索 Pop_GDPUSD_Sanitation 数据框的内部结构：

> str(Pop_GDPUSD_Sanitation)

结果如下：

探索 GDPUSD_Electricity_CO2 数据框的内部结构：

> str(GDPUSD_Electricity_CO2)

结果如下：

探索 GDPUSD_Electricity_CO2 数据框的内部结构：

> str(GDPUSD_Electricity_CO2)

结果如下：

打印 Pop_LifeExp_FertRt 数据框：head() 函数返回 Pop_LifeExp_FertRt 数据框的前部分。Pop_LifeExp_FertRt 数据框作为输入参数传递：

> head(Pop_LifeExp_FertRt)

结果如下：

打印 Pop_GDPUSD_HeadCnt 数据框：

> head(Pop_GDPUSD_HeadCnt)

结果如下：

打印 Pop_GDPUSD_Sanitation 数据框：

> head(Pop_GDPUSD_Sanitation)

结果如下：

打印 GDPUSD_Electricity_CO2 数据框：

> head(GDPUSD_Electricity_CO2)

结果如下：

探索 SP.POP.TOTL 数据框的维度：dim() 函数返回 SP.POP.TOTL 数据框的维度。SP.POP.TOTL 数据框作为输入参数传递。结果清楚地表明有 14623 行数据和六个列：

> dim(wb(indicator = "SP.POP.TOTL"))

结果如下：

探索 SP.DYN.LE00.IN 数据框的维度：

> dim(wb(indicator = "SP.DYN.LE00.IN"))

结果如下：

探索 SP.DYN.TFRT.IN 数据框的维度：

> dim(wb(indicator = " SP.DYN.TFRT.IN "))

结果如下：

探索 NY.GDP.MKTP.CD 数据框的维度：

> dim(wb(indicator = " NY.GDP.MKTP.CD"))

结果如下：

探索 SI.POV.2DAY 数据框的维度：

> dim(wb(indicator = " SI.POV.2DAY "))

结果如下：

探索 SH.STA.ACSN 数据框的维度：

> dim(wb(indicator = " SH.STA.ACSN "))

结果如下：

探索 EG.ELC.ACCS.ZS 数据框的维度：

> dim(wb(indicator = "EG.ELC.ACCS.ZS"))

结果如下：

探索 EN.ATM.CO2E.KT 数据框的维度：

> dim(wb(indicator = "EN.ATM.CO2E.KT"))

结果如下：

使用 wbcountries() 函数从世界银行 API 下载更新的国家和区域信息：

> Countries <- data.table(wbcountries())

打印 Countries 数据框：head() 函数返回 Countries 数据框的前部分：

> head(Countries)

结果如下：

步骤 4 - 构建模型

对 Pop_LifeExp_FertRt 数据表进行排序：setkey() 函数对 Pop_LifeExp_FertRt 数据表进行排序并标记为已排序。排序的列是键。键位于 iso2c 列；iso2c 列始终按升序排序。表通过引用进行更改，因此非常节省内存：

> setkey(Pop_LifeExp_FertRt, iso2c)

对 Pop_GDPUSD_HeadCnt 数据表进行排序：

> setkey(Pop_GDPUSD_HeadCnt, iso2c)

对 Pop_GDPUSD_Sanitation 数据表进行排序：

> setkey(Pop_GDPUSD_Sanitation, iso2c)

对 GDPUSD_Electricity_CO2 数据表进行排序：

> setkey(GDPUSD_Electricity_CO2, iso2c)

对 Countries 数据表进行排序：

> setkey(Countries, iso2c)

打印 Countries 数据表：

> head(setkey(Countries, iso2c))

结果如下：

在数据集中添加区域的同时从 Pop_LifeExp_FertRt 数据集中移除聚合：

> Pop_LifeExp_FertRt <- Countries[Pop_LifeExp_FertRt][ ! region %in% "Aggregates"]

打印 Pop_LifeExp_FertRt 数据表：

> head(Pop_LifeExp_FertRt)

结果如下：

在数据集中添加区域的同时从 Pop_GDPUSD_HeadCnt 数据集中移除聚合：

> Pop_GDPUSD_HeadCnt <- Countries[Pop_GDPUSD_HeadCnt][ ! region %in% "Aggregates"]

在数据集中添加区域的同时从 Pop_GDPUSD_Sanitation 数据集中移除聚合：

> Pop_GDPUSD_Sanitation <- Countries[Pop_GDPUSD_Sanitation][ ! region %in% "Aggregates"]

在数据集中添加区域的同时从 GDPUSD_Electricity_CO2 数据集中移除聚合：

> GDPUSD_Electricity_CO2 <- Countries[GDPUSD_Electricity_CO2][ ! region %in% "Aggregates"]

 > wPop_LifeExp_FertRt <- reshape(Pop_LifeExp_FertRt[, list(country, region, date, value, indicator)], v.names = "value", idvar=c("date", "country", "region"), timevar="indicator", direction = "wide")
 > wPop_GDPUSD_HeadCnt <- reshape(Pop_GDPUSD_HeadCnt[, list(country, region, date, value, indicator)], v.names = "value", idvar=c("date", "country", "region"), timevar="indicator", direction = "wide")
 > wPop_GDPUSD_Sanitation <- reshape(Pop_GDPUSD_Sanitation[, list(country, region, date, value, indicator)], v.names = "value", idvar=c("date", "country", "region"), timevar="indicator", direction = "wide")
 > wGDPUSD_Electricity_CO2 <- reshape(GDPUSD_Electricity_CO2[, list(country, region, date, value, indicator)], v.names = "value", idvar=c("date", "country", "region"), timevar="indicator", direction = "wide")

打印数据框 wPop_LifeExp_FertRt 的内容：

> wPop_LifeExp_FertRt

结果如下：

打印数据框 wGDPUSD_Electricity_CO2 的内容：

> wGDPUSD_Electricity_CO2

结果如下：

将wPop_LifeExp_FertRt、wPop_GDPUSD_HeadCnt、wPop_GDPUSD_Sanitation和wGDPUSD_Electricity_CO2数据集从字符格式转换为整数格式：

 > wPop_LifeExp_FertRt[, date := as.integer(date)]
 > wPop_GDPUSD_HeadCnt[, date := as.integer(date)]
 > wPop_GDPUSD_Sanitation[, date := as.integer(date)]
 > wGDPUSD_Electricity_CO2[, date := as.integer(date)]

设置名称：setnames()函数设置wPop_LifeExp_FertRt、wPop_GDPUSD_HeadCnt、wPop_GDPUSD_Sanitation和wGDPUSD_Electricity_CO2对象的名字：

    > setnames(wPop_LifeExp_FertRt, names(wPop_LifeExp_FertRt), c("Country", "Region", "Year", "Population", "Fertility", "LifeExpectancy"))
    > setnames(wPop_GDPUSD_HeadCnt, names(wPop_GDPUSD_HeadCnt), c("Country", "Region", "Year", "Population", "GDPUSD", "PovertyHead"))
    > setnames(wPop_GDPUSD_Sanitation, names(wPop_GDPUSD_Sanitation), c("Country", "Region", "Year", "Population", "GDPUSD", "SanitationAccess"))
    > setnames(wGDPUSD_Electricity_CO2, names(wGDPUSD_Electricity_CO2), c("Country", "Region", "Year", "GDPUSD", "ElectricityConsumption", "CO2Emissions"))

第 5 步 - 绘制模型

按以下步骤绘制wPop_LifeExp_FertRt数据框模型。gvisMotionChart()函数读取wPop_LifeExp_FertRt数据框。它使用 Google Visualization API 创建包含在网页中的文本输出。图表由网络浏览器在 Flash 中渲染。动态的动图探索指标。wPop_LifeExp_FertRt是数据框。idvar = "Country"表示要分析的数据的列名。timevar = "Year"是表示时间维度的数据的列名。xvar = "LifeExpectancy"是要绘制在x轴上的数据的数值向量。yvar = "Fertility"是要绘制在 y 轴上的数据的数值向量。sizevar = "Population"表示要映射到实际像素值的列值。colorvar = "Region"标识气泡。使用以下命令：

 > pltPop_LifeExp_FertRt <- gvisMotionChart(wPop_LifeExp_FertRt, idvar = "Country", timevar = "Year", xvar = "LifeExpectancy", yvar = "Fertility", sizevar = "Population", colorvar = "Region")
 > plot(pltPop_LifeExp_FertRt)

绘制wPop_GDPUSD_HeadCnt数据框模型：

 > pltPop_GDPUSD_HeadCnt <- gvisMotionChart(wPop_GDPUSD_HeadCnt, idvar = "Country", timevar = "Year", xvar = "GDPUSD", yvar = "PovertyHead", sizevar = "Population", colorvar = "Region")
 > plot(pltPop_GDPUSD_HeadCnt)

绘制wPop_GDPUSD_Sanitation数据框模型：

 > pltPop_GDPUSD_Sanitation <- gvisMotionChart(wPop_GDPUSD_Sanitation, idvar = "Country", timevar = "Year", xvar = "GDPUSD", yvar = "SanitationAccess", sizevar = "Population", colorvar = "Region")
 > plot(pltPop_GDPUSD_Sanitation)

绘制pltGDPUSD_Electricity_CO2数据框模型：

 > pltGDPUSD_Electricity_CO2 <- gvisMotionChart(wGDPUSD_Electricity_CO2, idvar = "Country", timevar = "Year", xvar = "GDPUSD", yvar = "ElectricityAccess", sizevar = "CO2Emissions", colorvar = "Region")
 > plot(pltGDPUSD_Electricity_CO2)

结果如下，生育率与预期寿命的关系：

人口增长：

以美元计算的 GDP 增长：

贫困人口比例与人口增长的关系：

人群获得卫生设施的增长：

卫生设施普及率：

卫生设施普及率的改善与人口增长的关系：

所有国家和地区的电力普及率人口：

二氧化碳排放（对数刻度）：

二氧化碳排放与电力消费的关系：

第十三章. 案例研究 - 重新保险合同的定价

简介

如同其名，再保险是从保险业务发展而来的，其使用的程度不仅取决于直接承保人要承保的风险的金额，还取决于这些风险的特征。可以进行的再保险业务的量主要取决于任何给定时间可用的直接业务量。再保险的想法根植于与保险产生相同的人类本能，即希望一个人的损失由许多人分担。

重新保险合同的定价

保险公司安排重新保险的关键目标包括但不限于：通过将不会因财务限制而承担的那部分风险转嫁给再保险公司，从而增加处理更大风险的能力；增强接受比资本允许的更大保额的能力；通过再保险公司吸收更大的索赔或灾难损失，使年度经营结果稳定；通过加强承保人建立既在规模又在风险质量上同质化的账户的尝试，增加盈利的机会；能够承保新的风险敞口。再保险的功能可以视为提供保护增加能力、财务稳定性、稳定索赔比率、积累不同类别的索赔、风险分散、保护偿付能力边际和稳定利润的服务。再保险有助于吸收由经济变化、社会变化、保险方法的变化以及科学发展引起的新的风险敞口。重新保险合同可以安排的方式只有两种：一种是自愿再保险，针对单一保单的一次性；另一种是合同再保险，针对定义好的保单组的自动安排。

准备中...

为了进行重新保险合同的定价，我们将使用收集在飓风数据集上的数据集。

第 1 步 - 收集和描述数据

将使用名为 publicdatamay2007.xls 的 XLS 格式数据集。该数据集采用标准格式。共有 207 行数据。有 7 个变量。数值变量如下：

• 年份

• 基础经济损失

• 标准化 PL05

• 标准化 CL05

非数值变量如下：

• 飓风描述

• 状态

• 类别

如何操作...

让我们深入了解细节。

第 2 步 - 探索数据

加载以下包：

 > install.packages("gdata")
 > install.packages("evir")
 > library(gdata)
 > library(evir)

注意

版本信息：本页面的代码在 R 版本 3.2.2 中进行了测试

让我们探索数据并了解变量之间的关系，如下所示。我们将首先导入名为 publicdatamay2007.xls 的 XLS 数据文件。我们将把数据保存到 StormDamageData 数据框中：

> StormDamageData <- read.xls("d:/publicdatamay2007.xls", sheet = 1)

打印 StormDamageData 数据框：head() 函数返回 StormDamageData 数据框的第一部分。将 StormDamageData 数据框作为输入参数传递：

> head(StormDamageData)

结果如下：

tail()函数返回StormDamageData框的最后部分，如下所示。将StormDamageData框作为输入参数传递。

> tail(StormDamageData)

结果如下：

探索StormDamageData数据框的维度：dim()函数返回StormDamageData框的维度。将StormDamageData数据框作为输入参数传递。结果清楚地表明有 207 行数据和九列：

> dim(StormDamageData)

结果如下：

步骤 3 - 计算个别损失索赔

格式化数据：包装函数ChangeFormat消除了传递的值中的逗号（,），并以数值形式返回结果：

 > ChangeFormat <- function(x){
 x = as.character(x)
 for(i in 1:10){x=sub(",","",as.character(x))}
 return(as.numeric(x)) }

将StormDamageData数据框存储在基础中：

> base <- StormDamageData[,1:4]

调用包装函数，ChangeFormat：将StormDamageData数据框中的Base.Economic.Damage作为输入传递。Vectorize()函数创建了对ChangeFormat()函数的包装。结果存储在base$Base.Economic.Damage数据框中：

> base$Base.Economic.Damage <- Vectorize(ChangeFormat)(StormDamageData$Base.Economic.Damage)

调用包装函数，ChangeFormat：将StormDamageData数据框中的Normalized.PL05作为输入传递。结果随后存储在base$ Normalized.PL05数据框中：

> base$Normalized.PL05 <- Vectorize(ChangeFormat)(StormDamageData$Normalized.PL05)

调用包装函数，ChangeFormat：将StormDamageData数据框中的Normalized.CL05作为输入传递。结果随后存储在base$ Normalized.CL05数据框中：

> base$Normalized.CL05 <- Vectorize(ChangeFormat)(StormDamageData$Normalized.CL05)

打印base数据框：head()函数返回基础数据框的前部分。将base数据框作为输入参数传递：

> head(base)

结果如下：

绘制 207 个飓风的标准化成本图：plot()是一个通用函数。base$Normalized.PL05/1e9代表图的x坐标。type="h"代表直方图表示风格。ylim=c(0,155)将 y 轴表示的上限设置为 0（下限）和 155（上限）。x 轴代表损失索引：

> plot(base$Normalized.PL05/1e9, type="h", ylim=c(0,155), main = "207 Hurricanes, Normalized Costs: 1900 - 2005", xlab = "Index of Loss", ylab = "Normalized Costs", col = "red")

结果如下：

步骤 4 - 计算飓风数量

提取每年飓风计数及其频率：基础数据框包含前文所示详情。table()使用base$Year构建每年飓风计数的列联表。结果存储在TestBase数据框中：

> TestBase <- table(base$Year)

打印TestBase数据框的内容：

> TestBase

结果如下：

从 TestBase 数据框中提取年份：names() 函数提取每个年份的名称。as.numeric() 将提取的每个年份名称转换为数值。结果存储在年份数据框中：

> years <- as.numeric(names(TestBase))

打印 years 数据框的内容：

> years

结果如下：

从 TestBase 数据框中提取每年飓风计数的频率：names() 提取每年飓风计数的频率。as.numeric() 将提取的每个飓风计数频率转换为数值。结果存储在频率数据框中：

> frequency <- as.numeric(TestBase)

打印 frequency 数据框的内容：

> frequency

结果如下：

从 TestBase 数据框中提取没有飓风发生年份的飓风计数频率：结果存储在 years0frequency 数据框中：

> years0frequency <- (1900:2005)[which(!(1900:2005)%in%years)]

打印 years0frequency 数据框的内容：

> years0frequency

结果如下：

提取每年飓风的全部计数。结果存储在 StormDamageData 数据框中：

> StormDamageData <- data.frame(years=c(years, years0frequency), frequency=c(frequency, rep(0,length(years0frequency))))

打印 StormDamageData 数据框。head() 函数返回 StormDamageData 数据框的前部分。将 StormDamageData 数据框作为输入参数传递：

> head(StormDamageData) 

结果如下：

绘制 1900 年到 2005 年每年飓风的年份和频率计数：plot() 是一个通用函数。years 代表图表的 x 坐标，而 frequency 代表图表的 y 坐标。type="h" 代表直方图表示风格：

> plot(years, frequency, type="h", main = "Frequency of Hurricanes: 1900 - 2005", xlab = "Time (Years)", ylab = "Annual Frequency", col = "red")

结果如下：

计算从 1900 年到 2005 年所有年份的飓风数量平均值：

> mean(StormDamageData$frequency)

结果如下：

平均每年有两次飓风。

步骤 5 - 构建预测模型

让我们找出飓风发生频率中可能存在的线性趋势。使用 glm() 函数拟合广义线性模型。frequency~years 定义了公式。data = StormDamageData 定义了公式的数据集。family=poisson(link="identity") 函数表示泊松分布。

使用 lm() 函数拟合线性模型。frequency~years 定义了公式。data = StormDamageData 定义了公式的数据集。使用以下命令：

> LinearTrend <- glm(frequency~years, data = StormDamageData, family=poisson(link="identity"), start=lm(frequency~years, data = StormDamageData)$coefficients)

打印 LinearTrend 的详细信息：

> LinearTrend

结果如下：

探索飓风发生频率中可能存在的指数趋势：

使用 glm() 函数拟合广义线性模型。frequency~years 定义公式。data = StormDamageData 定义用于公式的数据集。family=poisson(link="identity") 函数表示泊松分布。我们通过以下命令实现：

> ExpTrend <- glm(frequency~years, data=StormDamageData, family = poisson(link="log"))

打印 ExpTrend 的详细信息：

> ExpTrend

结果如下：

绘制 1900 年至 2005 年间每年飓风的年份和频率计数：plot() 是一个通用函数。年份代表图形的 x 坐标，而频率代表图形的 y 坐标。type="h" 代表直方图表示风格。ylim=c(0,6) 函数将 y 轴表示的上限设置为 0（下限）和 6（上限）：

> plot(years, frequency, type='h', ylim=c(0,6), main = "No. of Major Hurricanes Predicted for 2014", xlim=c(1900,2020))

结果如下：

根据 2014 年的指数趋势预测趋势：使用 predict() 函数根据线性模型对象预测值。ExpTrend 代表从 lm 类继承的对象。newdata = data.frame(years=1890:2030) 函数代表用于查找预测变量的数据框：

> cpred1 <- predict(ExpTrend, newdata = data.frame(years=1890:2030), type="response")

打印 cpred1 的详细信息：

> cpred1

结果如下：

将 cpred1 的点与线段连接：lines() 是一个通用函数，它将 cpred1 数据框的值作为 y 轴的坐标，并用线段连接相应的点。1890:2030 代表 x 轴：

> lines(1890:2030,cpred1,col="blue")

结果如下：

根据 2014 年的线性趋势预测趋势：使用 predict() 函数根据线性模型对象预测值。LinearTrend 代表从 lm 类继承的对象。newdata = data.frame(years=1890:2030) 函数代表用于查找预测变量的数据框：

> cpred0 <- predict(LinearTrend, newdata=data.frame(years=1890:2030), type="response")

打印 cpred0 的详细信息：

> cpred0

结果如下：

将 cpred0 的点与线段连接：lines() 是一个通用函数，它将 cpred0 数据框的值作为 y- 轴的坐标，并用线段连接相应的点。1890:2030 代表 x-轴：

> lines(1890:2030, cpred0, col="red"))

结果如下：

绘制平均值：abline() 作为函数使用平均值绘制直线，该平均值是 StormDamageData$frequency 的 1.95283。h = mean(StormDamageData$frequency) 是水平线的 y 值：

> abline(h = mean(StormDamageData$frequency), col="black")

结果如下：

将 StormDamageData$frequency、cpred0 和 cpred1 的数据框值合并为平均值：

> predictions <- cbind(constant = mean(StormDamageData$frequency), linear = cpred0[126], exponential=cpred1[126])

打印预测的详细信息：

> predictions

结果如下：

在 2014 年的图表上绘制预测点的位置：

> points(rep((1890:2030)[126],3), predictions, col=c("black","red","blue"), pch=19)

结果如下：

重要的是要注意，通过改变预测模型，保费将会发生变化。在平坦的预测中，不到两个（主要）飓风，但以指数趋势，则超过四个（主要）飓风。

步骤 6 - 计算再保险合同的纯保费

现在我们找到一个合适的模型来计算具有免赔额和有限保额的再保险合同的保费。使用希尔尾指数估计器估计尾指数如下。hill() 是用于估计重尾数据的指数尾部的函数，base$Normalized.PL05：

> hill(base$Normalized.PL05)

结果如下：

前面的图示显示，主要飓风的成本具有重尾分布。

将帕累托模型的损失阈值设置为 5 亿以上如下：

> threshold <- .5

我们使用以下命令返回一个表示广义帕累托模型对超过阈值的拟合的 gpd 类对象。数据集由 base$Normalized.PL05/1e9/20 表示：

 > gpd.PL <- gpd(base$Normalized.PL05/1e9/20, threshold)$par.ests

结果如下：

计算超过阈值 0.5 的 base$Normalized.CL05/1e9/20 数据框的均值：

> mean(base$Normalized.CL05/1e9/20> .5)

结果如下：

假设损失超过 5 亿，我们现在可以计算再保险合同的期望值：

 > ExpectedValue <- function(yinf,ysup,xi,beta){
 + as.numeric(integrate(function(x) (x-yinf) * dgpd(x,xi,mu=threshold,beta),
 + lower=yinf,upper=ysup)$value +
 + (1-pgpd(ysup,xi,mu=threshold,beta))*(ysup-yinf))
 + }

按如下方式找到预测数据框的均值：

> predictions[1]

结果如下：

计算超过阈值 0.5 的 base$Normalized.PL05/1e9/20 数据框的均值：

> mean(base$Normalized.PL05/1e9/20>.5)

结果如下：

这表明每个飓风有 12.5% 的可能性会使保险公司损失超过 5 亿。

计算再保险合同的期望值：

> ExpectedValue(2,6,gpd.PL[1],gpd.PL[2])*1e3

结果如下：

这表明再保险公司预期的还款金额约为 3.309865 亿。

计算再保险合同的保费：

> predictions[1] * mean(base$Normalized.PL05/1e9/20> .5) * ExpectedValue(2, 6, gpd.PL[1], gpd.PL[2]) * 1e3

结果如下：

第十四章. 案例研究 - 电力消费预测

简介

电力是唯一一种生产和消费同时进行的商品；因此，在电力市场必须始终保持供应和消费之间的完美平衡。对于任何国家来说，预测电力消费都是国家利益所在，因为电力是能源的关键来源。可靠的能源消费、生产和分配预测符合稳定和长期的政策。规模经济、关注环境问题、监管要求、良好的公众形象，以及通货膨胀、能源价格快速上涨、替代燃料和技术的出现、生活方式的变化等，都产生了使用建模技术的需求，这些技术可以捕捉价格、收入、人口、技术以及其他经济、人口、政策和技术变量的影响。

低估可能导致产能利用率不足，这会导致服务质量下降，包括局部停电，甚至停电。而另一方面，高估可能导致授权一个可能在未来几年内不需要的工厂。要求是确保投资的最佳时机，这是一个长期考虑，合理化定价结构并设计需求管理计划，以满足短期或中期需求的特点。预测进一步推动各种投资、建设和保护计划。

准备工作

为了进行电力消费预测，我们将使用一个收集于智能电表数据的数据集，该数据集按四个位于不同行业的行业进行时间序列汇总。

第 1 步 - 收集和描述数据

应使用名为 DT_4_ind 的数据集。数值变量如下：

• value

非数值变量如下：

• date_time

• week

• date

• type

如何操作...

让我们深入了解。

第 2 步 - 探索数据

以下包需要在第一步加载：

> install.packages("feather")
> install.packages("data.table")
> install.packages("ggplot2")
> install.packages("plotly")
> install.packages("animation")
> library(feather)
> library(data.table)
> library(ggplot2)
> library(plotly)
> library(animation)

注意

版本信息：本页面的代码在 R 版本 3.2.2 中进行了测试

让我们探索数据并了解变量之间的关系。

检查对象是否为 as.data.table()：数据框的二进制列式序列化使用 feather 实现。为了方便在不同数据分析语言之间共享、读取和写入数据，使用 feather。使用 read_feather() 函数读取 feather 文件。

我们将首先导入 DT_4_ind 数据集。我们将把数据保存到 AggData 数据框中：

> AggData <- as.data.table(read_feather("d:/DT_4_ind"))

探索 AggData 数据框的内部结构：str() 函数显示数据框的内部结构。AggData 作为 R 对象传递给 str() 函数：

> str(AggData)

结果如下：

打印 AggData 数据框。head() 函数返回基本数据框的前部分。将 AggData 数据框作为输入参数传递：

> head(AggData)

结果如下：

绘制按行业汇总的电力消耗时间序列数据。

ggplot() 函数声明用于图形的数据框，并指定在整个图形中要共同使用的绘图美学集。data = AggData 是用于绘图的数据库集，而 aes() 描述了数据中的变量如何映射到视觉属性。geom_line() 生成尝试连接所有观察值的单条线：

    > ggplot(data = AggData, aes(x = date, y = value)) +
+ geom_line() + 
    + facet_grid(type ~ ., scales = "free_y") +
    + theme(panel.border = element_blank(),
    + panel.background = element_blank(),
    + panel.grid.minor = element_line(colour = "grey90"),
    + panel.grid.major = element_line(colour = "green"),
    + panel.grid.major.x = element_line(colour = "red"),
    + axis.text = element_text(size = 10),
    + axis.title = element_text(size = 12, face = "bold"),
    + strip.text = element_text(size = 9, face = "bold")) +
    + labs(title = "Electricity Consumption - Industry", x = "Date", y = "Load (kW)")

结果如下：

注意

重要的一点是，与其它行业相比，食品销售与储存行业的消费在假日期间变化不大。

步骤 3 - 时间序列 - 回归分析

回归模型如下所示：

变量（输入）有两种类型的季节性虚拟变量--每日 和每周 。 是时间 i 时的电力消耗，其中 是要估计的回归系数。

打印 AggData 数据框的内容：

> AggData

结果如下：

将工作日的字符转换为整数：使用 as.factor() 函数将向量编码为因子。as.integer() 函数创建 AggData[, week] 的整数类型对象：

> AggData[, week_num := as.integer(as.factor(AggData[, week]))]

打印更改后的 AggData 数据框内容：

> AggData

结果如下：

使用以下方法从 AggData 数据框中提取唯一的行业类型：

 > n_type <- unique(AggData[, type]) 

打印更改后的数据框 n_type 内容：

 > n_type 

结果如下：

使用以下方法从 AggData 数据框中提取唯一日期：

 > n_date <- unique(AggData[, date]) 

使用以下方法从 AggData 数据框中提取唯一的工作日：

 > n_weekdays <- unique(AggData[, week]) 

使用以下方法设置 period 值：

 > period <- 48 

在样本数据集上执行回归分析。

我们在两周的时间内提取教育（学校）建筑。结果存储在 data_reg 数据框中。n_type[2] 代表教育建筑，而 n_date[57:70] 表示两周的时间段：

 > data_reg <- AggData[(type == n_type[2] & date %in% n_date[57:70])] 

打印更改后的 data_reg 数据框内容：

 > data_reg 

结果如下：

在 2 周期间（2 月 27 日至 3 月 12 日）绘制教育（学校建筑）样本数据集：

ggplot() 函数声明了图形的输入数据框并指定了在整个图形中要通用的绘图美学集。data_reg 是用于绘图的数据库，而 aes() 描述了数据中的变量如何映射到视觉属性。geom_line() 生成单条线，试图连接所有观测值：

    > ggplot(data_reg, aes(date_time, value)) +
    + geom_line() +
    + theme(panel.border = element_blank(),
    + panel.background = element_blank(),
    + panel.grid.minor = element_line(colour = "grey90"),
    + panel.grid.major = element_line(colour = "green"),
    + panel.grid.major.x = element_line(colour = "red"),
    + axis.text = element_text(size = 10),
+ axis.title = element_text(size = 12, face = "bold")) 
    + labs(title = "Regression Analysis - Education Buildings", x = "Date", y = "Load (kW)")

结果如下：

从 data_reg 数据框中提取行数：

 > N <- nrow(data_reg) 

计算训练集中的天数：

 > trainset_window <- N / period 

创建独立的季节性虚拟变量--每日 和每周 。每日季节性值从 1,.....period, 1,.......period 中提取 48 个每日变量的向量。每周值从 week_num 中提取。然后将结果存储在一个向量 matrix_train 中：

 > matrix_train <- data.table(Load = data_reg[, value], Daily = as.factor(rep(1:period, trainset_window)), Weekly = as.factor(data_reg[, week_num])) 

在更改后打印 matrix_train 数据框的内容：

 > matrix_train 

结果如下：

创建线性模型。lm() 函数拟合线性模型：Load ~ 0 + . 是公式。由于 lm() 自动添加到线性模型的截距，我们将其现在定义为 0。data = matrix_train 定义了包含数据的数据框：

 > linear_model_1 <- lm(Load ~ 0 + ., data = matrix_train) 

在更改后打印 linear_model_1 数据框的内容：

 > linear_model_1 

结果如下：

生成模型 linear_model_1 的结果摘要：

> summary_1 <- summary(linear_model_1)

在更改后打印 summary_1 数据框的内容：

 > summary_1 

结果如下：

使用 summary_1 数据框中的 r.squared 属性提取决定系数：

> paste("R-squared: ", round(summary_1$r.squared, 3), ", p-value of F test: ", 1-pf(summary_1$fstatistic[1], summary_1$fstatistic[2], summary_1$fstatistic[3]))

从 data_reg 列表创建一个 data.table：

 > datas <- rbindlist(list(data_reg[, .(value, date_time)], data.table(value = linear_model_1$fitted.values, data_time = data_reg[, date_time]))) 

在更改后打印 datas 数据框的内容：

 > datas 

结果如下：

绘制 linear_model_1 的拟合值。

data = datas 是用于绘图的数据库，而 aes() 描述了数据中的变量如何映射到视觉属性。geom_line() 生成单条线，试图连接所有观测值：

 > ggplot(data = datas, aes(date_time, value, group = type, colour = type)) + geom_line(size = 0.8) + theme_bw() + 
 + labs(x = "Time", y = "Load (kW)", title = "Fit from Multiple Linear Regression") 

结果如下：

绘制拟合值与残差值的关系图。

data 是用于绘图的数据库，而 aes() 描述了数据中的变量如何映射到视觉属性：

> ggplot(data = data.table(Fitted_values =
linear_model_2$fitted.values, Residuals = linear_model_2$residuals),
aes(Fitted_values, Residuals)) + geom_point(size = 1.7)
+ geom_hline(yintercept = 0, color = "red", size = 1) +
+ labs(title = "Fitted values vs Residuals")

结果如下：

函数首先给出线性模型的标准化残差。然后计算1Q和4Q线。接着，从正态分布生成分位数分布。然后计算斜率和截距，并将其绘制出来：

    > ggQQ <- function(lm) {
    # extracting residuals from the fit
    + d <- data.frame(std.resid = rstandard(lm))
    # calculate 1Q, 4Q line
    + y <- quantile(d$std.resid[!is.na(d$std.resid)], c(0.25, 0.75))
    # calculate 1Q, 4Q line
    + x <- qnorm(c(0.25, 0.75))
    + slope <- diff(y)/diff(x)
    + int <- y[1L] - slope * x[1L]
+ 
    + p <- ggplot(data = d, aes(sample = std.resid)) +
+ stat_qq(shape = 1, size = 3) + 
+ labs(title = "Normal Q-Q", 
+ x = "Theoretical Quantiles", 
+ y = "Standardized Residuals") + 
    + geom_abline(slope = slope, intercept = int, linetype = "dashed",
+ size = 1, col = "firebrick1") 
    + return(p)
    + }

我们可以使用以下命令绘制 Q-Q 图：

 > ggQQ(linear_model_1) 

结果如下：

如清晰可见，点不在红色线上，它们不正常。由于周变量的估计系数，白天的测量值不断移动，但白天的行为没有被捕捉到。我们需要捕捉这种行为，因为周末的行为尤其不同。

步骤 4 - 时间序列 - 改进回归分析

创建线性模型：lm()函数拟合线性模型。Load ~ 0 + Daily + Weekly + Daily:Weekly是新的公式。由于lm()自动添加到线性模型的截距，我们将其现在定义为0。data = matrix_train定义了包含数据的数据框：

> linear_model_2 <- lm(Load ~ 0 + Daily + Weekly + Daily:Weekly, data = matrix_train)

在更改后打印linear_model_2数据框的内容：

 > linear_model_2 

结果如下：

比较来自linear_model_1和linear_model_2模型摘要的 R-squared 值：

> c(Previous = summary(linear_model_1)$r.squared, New = summary(linear_model_2)$r.squared)

结果如下：

第二个模型的 R-squared 值有显著提高。

图形比较linear_model_1和linear_model_2模型的残差。

 > ggplot(data.table(Residuals = c(linear_model_1$residuals, linear_model_2$residuals), Type = c(rep("Multiple Linear Reg - simple", nrow(data_reg)), rep("Multiple Linear Reg with interactions", nrow(data_reg)))), aes(Type, Residuals, fill = Type)) + geom_boxplot()
 > ggplotly()

结果如下：

linear_model_1的残差细节。

结果如下：

linear_model_2的残差细节。

结果如下：

从data_reg和linear_model_2的列表中创建一个data.table：

 > datas <- rbindlist(list(data_reg[, .(value, date_time)], data.table(value = linear_model_2$fitted.values, data_time = data_reg[, date_time]))) 

在更改后打印datas数据框的内容：

 > datas 

结果如下：

向datas添加Real和Fitted列：

 > datas[, type := rep(c("Real", "Fitted"), each = nrow(data_reg))] 

在更改后打印datas数据框的内容：

 > datas 

结果如下：

绘制linear_model_2的拟合值。

data = datas是用于绘图的数据库集，而aes()描述了数据中的变量如何映射到视觉属性。geom_line()生成试图连接所有观察值的单一线条：

 > ggplot(data = datas, aes(date_time, value, group = type, colour =
type)) + geom_line(size = 0.8) + theme_bw() +
+ labs(x = "Time", y = "Load (kW)", title = "Fit from Multiple Linear
Regression")

结果如下：

与之前 linear_model_1 的绘图相比，拟合值和实际值非常接近。

绘制拟合值与残差值的关系图。Data 是用于绘图的数据库，而 aes() 描述了数据中的变量如何映射到视觉属性：

 > ggplot(data = data.table(Fitted_values = linear_model_2$fitted.values, Residuals = linear_model_2$residuals), aes(Fitted_values, Residuals)) + geom_point(size = 1.7) 
 + geom_hline(yintercept = 0, color = "red", size = 1) + 
 + labs(title = "Fitted values vs Residuals") 

结果如下：

与之前 linear_model_1 的绘图相比，这些图看起来更接近残差线。

我们可以使用以下方式绘制 Q-Q 图：

 > ggQQ(linear_model_2) 

结果如下：

步骤 5 - 构建预测模型

我们可以定义一个函数来返回一周前预测的预测结果。输入参数是 data 和 set_of_date：

    > predWeekReg <- function(data, set_of_date){
    + #creating the dataset by dates
+ data_train <- data[date %in% set_of_date] 
    + N <- nrow(data_train)
    +
    + # number of days in the train set
    + window <- N / period # number of days in the train set
    +
    + #1, ..., period, 1, ..., period - daily season periods
    + #feature "week_num"- weekly season
    + matrix_train <- data.table(Load = data_train[, value],
    + Daily = as.factor(rep(1:period, window)),
    + Weekly = as.factor(data_train[, week_num]))
    +
    + #creating linear model.
    + # formula - Load ~ 0 + Daily + Weekly + Daily:Weekly
    + # dataset - data = matrix_train
    + lm_m <- lm(Load ~ 0 + Daily + Weekly + Daily:Weekly, data = matrix_train)
+ 
    + #forecast of one week ahead
    + pred_week <- predict(lm_m, matrix_train[1:(7*period), -1, with = FALSE])
    + return(as.vector(pred_week))
    + }

定义评估预测的平均绝对百分比误差：

 > mape <- function(real, pred){
 + return(100 * mean(abs((real - pred)/real)))
 + }

将训练集长度设置为 2 周，因此减去 2。将生成 50 周的预测。使用滑动窗口方法进行训练预测，为每种行业进行预测：

> n_weeks <- floor(length(n_date)/7) - 2

打印周数：

> n_weeks

结果如下：

计算每种行业一周前预测的预测结果。

调用函数返回 AggData 商业地产和数据集一周前预测的预测结果：

 > lm_pred_weeks_1 <- sapply(0:(n_weeks-1), function(i)
 + predWeekReg(AggData[type == n_type[1]], n_date[((i*7)+1):((i*7)+7*2)]))

调用函数返回 AggData - 教育和日期集一周前预测的预测结果：

 > lm_pred_weeks_2 <- sapply(0:(n_weeks-1), function(i)
 + predWeekReg(AggData[type == n_type[2]], n_date[((i*7)+1):((i*7)+7*2)]))

调用函数返回 AggData 食品和销售以及日期集一周前预测的预测结果：

 > lm_pred_weeks_3 <- sapply(0:(n_weeks-1), function(i)
 + predWeekReg(AggData[type == n_type[3]], n_date[((i*7)+1):((i*7)+7*2)]))

调用函数返回 AggData 照明行业和日期集一周前预测的预测结果：

 > lm_pred_weeks_4 <- sapply(0:(n_weeks-1), function(i)
 + predWeekReg(AggData[type == n_type[4]], n_date[((i*7)+1):((i*7)+7*2)]))

计算每种行业的平均绝对百分比误差以评估预测。调用函数返回平均绝对百分比。计算评估 AggData 照明行业和日期集预测的误差：

 > lm_err_mape_1 <- sapply(0:(n_weeks-1), function(i)
 + mape(AggData[(type == n_type[1] & date %in% n_date[(15+(i*7)):(21+(i*7))]), value],
 + lm_pred_weeks_1[, i+1]))

打印 lm_err_mape_1 数据框：

> lm_err_mape_1

结果如下：

调用函数返回评估 AggData 教育和日期集预测的平均绝对百分比误差：

 > lm_err_mape_2 <- sapply(0:(n_weeks-1), function(i)
 + mape(AggData[(type == n_type[2] & date %in% n_date[(15+(i*7)):(21+(i*7))]), value],
 + lm_pred_weeks_2[, i+1]))

打印 lm_err_mape_2 数据框：

> lm_err_mape_2

结果如下：

调用函数返回评估 AggData 食品和销售以及日期集预测的平均绝对百分比误差：

 > lm_err_mape_3 <- sapply(0:(n_weeks-1), function(i)
 + mape(AggData[(type == n_type[3] & date %in% n_date[(15+(i*7)):(21+(i*7))]), value],
 + lm_pred_weeks_3[, i+1]))

打印 lm_err_mape_3 数据框：

> lm_err_mape_3

结果如下：

调用函数返回评估 AggData 照明行业和日期集预测的平均绝对百分比误差：

 > lm_err_mape_4 <- sapply(0:(n_weeks-1), function(i)
 + mape(AggData[(type == n_type[4] & date %in% n_date[(15+(i*7)):(21+(i*7))]), value],
 + lm_pred_weeks_4[, i+1]))

打印 lm_err_mape_4data 数据框：

> lm_err_mape_4

结果如下：

步骤 6 - 绘制一年的预测图

绘制结果：

注意

您需要安装 ImageMagick-7.0.4-Q16 以使 saveGIF 功能正常工作。

    > datas <- data.table(value = c(as.vector(lm_pred_weeks_1),
 AggData[(type == n_type[1]) & (date %in% n_date[-c(1:14,365)]), value]),
    date_time = c(rep(AggData[-c(1:(14*48), (17473:nrow(AggData))), date_time], 2)),
    type = c(rep("MLR", nrow(lm_pred_weeks_1)*ncol(lm_pred_weeks_1)),
    rep("Real", nrow(lm_pred_weeks_1)*ncol(lm_pred_weeks_1))),
    week = c(rep(1:50, each = 336), rep(1:50, each = 336)))

    > saveGIF({
    oopt = ani.options(interval = 0.9, nmax = 50)
    for(i in 1:ani.options("nmax")){
    print(ggplot(data = datas[week == i], aes(date_time, value, group = type, colour = type)) +
    geom_line(size = 0.8) +
scale_y_continuous(limits = c(min(datas[, value]), max(datas[, value]))) + 
    theme(panel.border = element_blank(), panel.background = element_blank(),
    panel.grid.minor = element_line(colour = "grey90"),
    panel.grid.major = element_line(colour = "grey90"),
    panel.grid.major.x = element_line(colour = "grey90"),
    title = element_text(size = 15),
    axis.text = element_text(size = 10),
    axis.title = element_text(size = 12, face = "bold")) +
    labs(x = "Time", y = "Load (kW)",
    title = paste("Forecast of MLR (", n_type[1], "); ", "week: ", i, "; MAPE: ",
    round(lm_err_mape_1[i], 2), "%", sep = "")))
    ani.pause()
    }
    }, movie.name = "industry_1.gif", ani.height = 450, ani.width = 750)

结果如下：

前面的结果证明，电力消耗模式是基于外部因素，如假日、天气、物业性质等。消耗模式在本质上是非常随机的。

注意

目标是向读者介绍如何应用多重线性回归来预测双季节时间序列。包含独立变量的交互作用以确保模型的有效性是非常有效的。