R-深度学习秘籍-全-

R 深度学习秘籍（全）

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

译者：飞龙

协议：CC BY-NC-SA 4.0

前言

深度学习是机器学习中最常讨论的领域之一，因为它能够建模复杂的函数并通过各种数据源和结构（如横截面数据、序列数据、图像、文本、音频和视频）进行学习。此外，R 是数据科学社区中最流行的编程语言之一。随着深度学习的快速发展，R 与深度学习之间的关系也在迅速增长。因此，深度学习食谱：R 篇旨在提供构建不同深度学习模型的速成课程。通过结构化、非结构化、图像和音频案例研究，展示了深度学习的应用。本书还将涵盖迁移学习以及如何利用 GPU 的强大计算能力来提高深度学习模型的计算效率。

本书内容概览

第一章，入门指南，介绍了用于构建深度学习模型的不同包，如 TensorFlow、MXNet 和 H2O，并讲解了如何设置它们以便在本书中后续使用。

第二章，使用 R 进行深度学习，介绍了神经网络和深度学习的基础。本章涵盖了使用 R 中多个工具箱构建神经网络模型的多个食谱。

第三章，卷积神经网络，通过图像处理和分类应用，介绍了卷积神经网络（CNN）的相关技术。

第四章，使用自编码器的数据表示，通过多个食谱构建自编码器的基础，并讨论其在数据压缩和去噪中的应用。

第五章，深度学习中的生成模型，将自编码器的概念扩展到生成模型，介绍了如玻尔兹曼机、限制玻尔兹曼机（RBMs）和深度置信网络等技术。

第六章，循环神经网络，为在序列数据集上构建机器学习模型打下基础，使用多个循环神经网络（RNNs）。

第七章，强化学习，提供了使用马尔可夫决策过程（MDP）构建强化学习的基础，并涵盖了基于模型的学习和无模型学习。

第八章，深度学习在文本挖掘中的应用，提供了深度学习在文本挖掘领域的端到端实现。

第九章，深度学习在信号处理中的应用，详细介绍了深度学习在信号处理领域的案例研究。

第十章，迁移学习，包括使用预训练模型如 VGG16 和 Inception 的配方，并解释如何使用 GPU 部署深度学习模型。

您需要本书

在数据科学中建立坚实背景需要大量的求知欲、毅力和热情。深度学习的范围非常广泛；因此，以下背景知识是有效利用本书的前提条件：

• 机器学习和数据分析基础

• 精通 R 编程

• Python 和 Docker 的基础知识

最后，您需要欣赏深度学习算法，并了解它们如何在多个领域解决复杂问题。

本书适合哪些人

本书适用于已执行机器学习任务的数据科学专业人士或分析师，现在希望探索深度学习，并希望一本快速参考书来解决在实施深度学习时出现的问题。那些希望在其他深度学习专业人士之上占据优势的人会发现本书非常有用。

惯例

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

文本中的代码词、数据库表名、文件夹名、文件名、文件扩展名、路径名、虚拟网址、用户输入和 Twitter 句柄显示如下：“我们可以通过使用包含指令来包含其他上下文。”

代码块设置如下：

[default]
 exten => s,1,Dial(Zap/1|30)
 exten => s,2,Voicemail(u100)
 exten => s,102,Voicemail(b100)
 exten => i,1,Voicemail(s0)

当我们希望引起您对代码块特定部分的注意时，相关行或项目设置为粗体：

[default]
 exten => s,1,Dial(Zap/1|30)
 exten => s,2,Voicemail(u100)
 exten => s,102,Voicemail(b100)
 exten => i,1,Voicemail(s0)

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

# cp /usr/src/asterisk-addons/configs/cdr_mysql.conf.sample   /etc/asterisk/cdr_mysql.conf

新术语和重要单词以粗体显示。例如，屏幕上看到的菜单或对话框中的单词会在文本中显示为：“点击“下一步”按钮将您移至下一屏。”

警告或重要提示将显示在此框中。

小贴士和技巧像这样显示。

读者反馈

我们随时欢迎读者的反馈。告诉我们您对本书的看法--您喜欢或不喜欢的内容。读者的反馈对我们非常重要，因为它帮助我们开发真正能让您受益的标题。

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

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

客户支持

现在您是 Packt 书籍的骄傲所有者，我们有几件事情可以帮助您充分利用您的购买。

下载示例代码

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

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

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

2. 将鼠标悬停在页面顶部的“支持”标签上。

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

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

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

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

7. 点击“代码下载”按钮。

您还可以通过点击本书网页上的“代码文件”按钮下载代码文件，Packt 出版网站上的该页面可以通过在搜索框中输入书名来访问。请注意，您需要登录 Packt 账号。

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

• Windows 版 WinRAR / 7-Zip

• Mac 版 Zipeg / iZip / UnRarX

• Linux 版 7-Zip / PeaZip

本书的代码包也托管在 GitHub 上，网址为github.com/PacktPublishing/R-Deep-Learning-Cookbook。我们还在github.com/PacktPublishing/上提供了其他书籍和视频的代码包，欢迎查看！

下载本书的彩色图片

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

勘误

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

要查看先前提交的勘误表，请访问www.packtpub.com/books/content/support，并在搜索框中输入书名。相关信息将出现在勘误表部分。

盗版

互联网版权材料的盗版问题在所有媒体中持续存在。在 Packt，我们非常重视版权和许可证的保护。如果您在互联网上发现任何形式的我们作品的非法复制品，请立即向我们提供该网址或网站名称，以便我们采取措施。

如发现涉嫌盗版的内容，请通过copyright@packtpub.com与我们联系，并提供相关链接。

我们感谢您在保护我们的作者以及我们为您带来有价值内容方面的帮助。

问题

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

第一章：入门

在本章中，我们将覆盖以下主题：

• 使用 IDE 安装 R

• 安装 Jupyter Notebook 应用程序

• 从 R 中的机器学习基础开始

• 在 R 中设置深度学习工具/包

• 在 R 中安装 MXNet

• 在 R 中安装 TensorFlow

• 在 R 中安装 H2O

• 使用 Docker 一次性安装所有三个包

介绍

本章将帮助你开始深度学习，并帮助你设置系统以开发深度学习模型。本章更侧重于让读者了解本书的期望内容以及阅读本书所需的前置条件。本书面向那些希望快速建立深度学习应用背景的学生或专业人士。本书将更侧重于实践和应用，使用 R 作为工具来构建深度学习模型。

深度学习的详细理论请参考*《深度学习》*（Goodfellow 等人，2016）。对于机器学习的背景知识，请参考 《Python 机器学习》（S. Raschka，2015）。

我们将使用 R 编程语言来演示深度学习的应用。你在本书中需要具备以下前置知识：

• 基本的 R 编程知识

• 基本了解 Linux；我们将使用 Ubuntu（16.04）操作系统

• 机器学习概念的基础理解

• 对于 Windows 或 macOS，基本了解 Docker

使用 IDE 安装 R

在我们开始之前，让我们先为 R 安装一个 IDE。对于 R，最受欢迎的 IDE 是 Rstudio 和 Jupyter。Rstudio 专注于 R，而 Jupyter 提供包括 R 在内的多语言支持。Jupyter 还提供一个交互式环境，允许你将代码、文本和图形合并成一个单一的笔记本。

准备工作

R 支持多种操作系统，如 Windows、macOS X 和 Linux。R 的安装文件可以从 Comprehensive R Archive Network（CRAN）的任何一个镜像站点下载，网址为 cran.r-project.org/。CRAN 也是 R 包的一个主要仓库。编程语言 R 有 32 位和 64 位架构可供选择。

如何做到...

1. 强烈推荐安装 r-base-dev，因为它有许多内建函数。它还启用了 install.packages() 命令，可用于通过 R 控制台直接从 CRAN 编译并安装新的 R 包。默认的 R 控制台如下所示：

默认 R 控制台

1. 为了编程目的，推荐使用 集成开发环境（IDE），因为它有助于提高生产力。最受欢迎的开源 IDE 之一是 Rstudio。Rstudio 还提供了一个 Rstudio 服务器，便于你在基于 Web 的环境中编程。Rstudio IDE 的界面如下所示：

Rstudio 集成开发环境

安装 Jupyter Notebook 应用程序

近年来，另一个著名的编辑器是 Jupyter Notebook 应用程序。该应用程序生成整合了文档、代码和分析的 notebook 文件。它支持多种计算内核，包括 R。它是一个基于浏览器的客户端服务器应用程序，可以通过浏览器访问。

如何操作...

Jupyter Notebook 可以通过以下步骤进行安装：

1. 可以使用 pip 安装 Jupyter Notebook：

pip3 install --upgrade pip
pip3 install jupyter

1. 如果您已安装 Anaconda，那么默认安装的计算内核是 Python。要在同一环境中为 Jupyter 安装 R 计算内核，请在终端中输入以下命令：

conda install -c r r-essentials

1. 要在 conda 中安装名为 new-env 的新环境中的 R 计算内核，请输入以下命令：

conda create -n new-env -c r r-essentials

1. 另一种将 R 计算内核添加到 Jupyter Notebook 的方式是使用 IRkernel 包。通过此方法安装时，请启动 R IDE。第一步是安装 IRkernel 安装所需的依赖项：

chooseCRANmirror(ind=55) # choose mirror for installation
install.packages(c('repr', 'IRdisplay', 'crayon', 'pbdZMQ',
'devtools'), dependencies=TRUE)

1. 一旦所有依赖项从 CRAN 安装完成，便可以从 GitHub 安装 IRkernel 包：

library(devtools)
library(methods)
options(repos=c(CRAN='https://cran.rstudio.com'))
devtools::install_github('IRkernel/IRkernel')

1. 一旦满足所有要求，可以使用以下脚本在 Jupyter Notebook 中设置 R 计算内核：

library(IRkernel)
IRkernel::installspec(name = 'ir32', displayname = 'R 3.2')

1. 可以通过打开 shell/终端启动 Jupyter Notebook。运行以下命令即可在浏览器中启动 Jupyter Notebook 界面，如代码后的截图所示：

jupyter notebook

带有 R 计算引擎的 Jupyter Notebook

还有更多...

R 和本书中使用的大多数软件包一样，支持大多数操作系统。然而，您可以使用 Docker 或 VirtualBox 来设置一个与本书中使用的工作环境类似的环境。

有关 Docker 安装和设置的详细信息，请参考 docs.docker.com/，并选择适合您操作系统的 Docker 镜像。同样，VirtualBox 的二进制文件可以在 www.virtualbox.org/wiki/Downloads 下载并安装。

从 R 中学习机器学习基础

深度学习是受人类大脑结构和功能启发的机器学习的一个子领域。近年来，深度学习因更强的计算能力、更大的数据集、更好的算法（具有人工智能学习能力）以及对数据驱动见解的更高需求而得到了广泛关注。在我们深入探讨深度学习的细节之前，让我们先了解一些机器学习的基本概念，这些概念构成了大多数分析解决方案的基础。

机器学习是一个开发算法的领域，这些算法能够从数据中挖掘自然模式，从而通过预测性洞察做出更好的决策。这些洞察力在多个现实世界应用中都具有重要意义，从医学诊断（使用计算生物学）到实时股票交易（使用计算金融），从天气预测到自然语言处理，从预测性维护（在自动化和制造业中）到处方推荐（在电子商务和电子零售中）等。

以下图表阐明了机器学习的两种主要技术：即监督学习和无监督学习：

机器学习中不同技术的分类

监督学习：监督学习是一种基于证据的学习方式。证据是给定输入的已知结果，进而用来训练预测模型。模型进一步根据结果数据类型分为回归和分类。在回归中，结果是连续的，而在分类中，结果是离散的。股票交易和天气预测是回归模型的广泛应用，跨度检测、语音识别和图像分类是分类模型的广泛应用。

回归算法包括线性回归、广义线性模型（GLM）、支持向量回归（SVR）、神经网络、决策树等；在分类问题中，我们有逻辑回归、支持向量机（SVM）、线性判别分析（LDA）、朴素贝叶斯、最近邻等。

半监督学习：半监督学习是一类使用无监督技术的监督学习。这种技术在需要对整个数据集进行标注的成本过高，而获取和分析未标注数据的成本较低的场景中非常有用。

无监督学习：顾名思义，学习没有结果（或监督）的数据称为无监督学习。这是一种基于给定数据中隐藏模式和内在分组的推理性学习方式。其应用包括市场模式识别、基因聚类等。

一些广泛使用的聚类算法包括 k-均值、层次聚类、k-中值、模糊 C 均值、隐马尔可夫、神经网络等。

如何做到...

让我们来看一下监督学习中的线性回归：

1. 让我们从一个简单的线性回归示例开始，其中我们需要确定男性身高（以厘米为单位）和体重（以千克为单位）之间的关系。以下样本数据代表了 10 个随机男性的身高和体重：

data <- data.frame("height" = c(131, 154, 120, 166, 108, 115,
158, 144, 131, 112), 
"weight" = c(54, 70, 47, 79, 36, 48, 65,
63, 54, 40))

1. 现在，生成一个线性回归模型，如下所示：

lm_model <- lm(weight ~ height, data)

1. 下图展示了男性身高与体重之间的关系，并且包含了拟合线：

plot(data, col = "red", main = "Relationship between height and
weight",cex = 1.7, pch = 1, xlab = "Height in cms", ylab = "Weight
in kgs")
abline(lm(weight ~ height, data))

体重和身高之间的线性关系

1. 在半监督模型中，学习主要是通过使用标签数据（通常量较小）来启动的，然后使用未标签数据（通常量较大）进行增强。

让我们对一个广泛使用的数据集——鸢尾花（iris）执行 K-means 聚类（无监督学习）。

1. 该数据集包含三种不同的鸢尾花种类（Setosa、Versicolor 和 Virginica），以及它们的不同特征，如萼片长度、萼片宽度、花瓣长度和花瓣宽度：

data(iris)
head(iris)
Sepal.Length Sepal.Width Petal.Length Petal.Width Species
1 5.1 3.5 1.4 0.2 setosa
2 4.9 3.0 1.4 0.2 setosa
3 4.7 3.2 1.3 0.2 setosa
4 4.6 3.1 1.5 0.2 setosa
5 5.0 3.6 1.4 0.2 setosa
6 5.4 3.9 1.7 0.4 setosa

1. 下图展示了鸢尾花特征的变异。与萼片特征相比，花瓣特征表现出明显的变化：

library(ggplot2)
library(gridExtra)
plot1 <- ggplot(iris, aes(Sepal.Length, Sepal.Width, color =
Species)) 
  geom_point(size = 2) 
  ggtitle("Variation by Sepal features")
plot2 <- ggplot(iris, aes(Petal.Length, Petal.Width, color =
  Species)) 
   geom_point(size = 2) 
   ggtitle("Variation by Petal features")
grid.arrange(plot1, plot2, ncol=2)

按长度和宽度划分的萼片和花瓣特征的变异

1. 由于花瓣特征在鸢尾花中有很好的变异性，让我们使用花瓣长度和花瓣宽度来执行 K-means 聚类：

set.seed(1234567)
iris.cluster <- kmeans(iris[, c("Petal.Length","Petal.Width")],
 3, nstart = 10)
iris.cluster$cluster <- as.factor(iris.cluster$cluster)

1. 以下代码片段展示了聚类与物种（鸢尾花）之间的交叉表。我们可以看到，聚类 1 主要归为 Setosa，聚类 2 主要归为 Versicolor，而聚类 3 主要归为 Virginica：

> table(cluster=iris.cluster$cluster,species= iris$Species)
species
cluster setosa versicolor virginica
1 50 0 0
2 0 48 4
3 0 2 46

ggplot(iris, aes(Petal.Length, Petal.Width, color =
iris.cluster$cluster)) + geom_point() + ggtitle("Variation by
Clusters")

1. 下图展示了聚类的分布：

三个聚类中的鸢尾花变异

它是如何工作的...

模型评估是任何机器学习过程中的关键步骤。它对于监督模型和无监督模型有所不同。在监督模型中，预测起着重要作用；而在无监督模型中，聚类内部的同质性和聚类之间的异质性起着重要作用。

一些广泛使用的回归模型评估参数（包括交叉验证）如下：

• 确定系数

• 均方根误差

• 平均绝对误差

• 赤池信息量准则（AIC）或贝叶斯信息量准则（BIC）

一些广泛使用的分类模型评估参数（包括交叉验证）如下：

• 混淆矩阵（准确率、精确度、召回率和 F1 分数）

• 增益或提升图

• ROC（接收操作特征）曲线下的面积

• 一致比率和不一致比率

一些广泛使用的无监督模型（聚类）评估参数如下：

• 列联表

• 聚类对象与聚类中心或质心之间的平方误差和

• 轮廓值

• 兰德指数

• 匹配指数

• 成对及调整后的成对精度和召回率（主要用于自然语言处理）

偏差和方差是任何监督学习模型的两个关键误差组成部分；它们的权衡在模型调优和选择中起着至关重要的作用。偏差是由于预测模型在学习结果时做出的不正确假设，而方差是由于模型对训练数据集的僵化。换句话说，较高的偏差会导致欠拟合，较高的方差会导致过拟合。

在偏差中，假设是关于目标函数形式的。因此，这在参数模型中占主导地位，例如线性回归、逻辑回归和线性判别分析，因为它们的结果是输入变量的函数形式。

另一方面，方差展示了模型对数据集变化的敏感度。通常，目标函数形式控制方差。因此，这在非参数化模型中占主导地位，例如决策树、支持向量机和 K 最近邻，因为它们的结果不是输入变量的直接函数形式。换句话说，非参数化模型的超参数可能会导致预测模型的过拟合。

在 R 中设置深度学习工具/包

主要的深度学习包都是用 C/C++ 开发的，以提高效率，而 R 中则开发了包装器，旨在高效地开发、扩展和执行深度学习模型。

有许多开源深度学习库可供使用。该领域的主要库如下：

• Theano

• TensorFlow

• Torch

• Caffe

市面上还有其他一些知名的包，如 H2O、CNTK（微软认知工具包）、darch、Mocha 和 ConvNetJS。围绕这些包，已经开发了许多包装器，支持深度学习模型的便捷开发，例如 Python 中的 Keras 和 Lasagne 以及支持多种语言的 MXNet。

如何操作...

1. 本章将介绍 MXNet 和 TensorFlow 包（这两个包使用 C++ 和 CUDA 开发，以便在 GPU 上实现高度优化的性能）。

2. 此外，h2o 包将用于开发一些深度学习模型。R 中的 h2o 包作为 REST API 实现，连接到 H2O 服务器（它作为 Java 虚拟机（JVM）运行）。我们将在接下来的部分中提供这些包的快速设置说明。

在 R 中安装 MXNet

本节将介绍如何在 R 中安装 MXNet。

准备工作

MXNet 包是一个轻量级的深度学习架构，支持 R、Python 和 Julia 等多种编程语言。从编程角度看，它结合了符号式和命令式编程，支持 CPU 和 GPU。

R 中的基于 CPU 的 MXNet 可以通过预构建的二进制包或源代码安装，源代码需要构建相关的库。在 Windows/mac 上，预构建的二进制包可以直接从 R 控制台下载并安装。MXNet 要求 R 版本为 3.2.0 或更高版本。安装过程需要 CRAN 中的 drat 包。drat 包帮助维护 R 仓库，可以通过 install.packages() 命令安装。

要在 Linux（13.10 或更高版本）上安装 MXNet，以下是一些依赖项：

• Git（从 GitHub 获取代码）

• libatlas-base-dev（用于执行线性代数运算）

• libopencv-dev（用于执行计算机视觉操作）

要安装带 GPU 处理器的 MXNet，以下是一些依赖项：

• Microsoft Visual Studio 2013

• NVIDIA CUDA 工具包

• MXNet 包

• cuDNN（提供深度神经网络库）

安装 mxnet 及其所有依赖项的另一种快速方法是使用 chstone 仓库中的预构建 Docker 镜像。以下工具将用于安装 chstone/mxnet-gpu Docker 镜像：

• R 和 Python 中的 MXNet

• Ubuntu 16.04

• CUDA（可选，适用于 GPU）

• cuDNN（可选，适用于 GPU）

如何操作...

1. 以下 R 命令通过使用预构建的二进制包来安装 MXNet，操作简单方便。然后使用 drat 包从 Git 添加 dlmc 仓库，并随后安装 mxnet：

install.packages("drat", repos="https://cran.rstudio.com")
drat:::addRepo("dmlc")
install.packages("mxnet")

2. 以下代码帮助在 Ubuntu（V16.04）中安装 MXNet。前两行用于安装依赖项，剩余的行用于安装 MXNet，前提是满足所有依赖项：

sudo apt-get update
sudo apt-get install -y build-essential git libatlas-base-dev
libopencv-dev
git clone https://github.com/dmlc/mxnet.git ~/mxnet --recursive
cd ~/mxnet
cp make/config.mk .
echo "USE_BLAS=openblas" >>config.mk
make -j$(nproc)

3. 如果要为 GPU 构建 MXNet，则需要在运行 make 命令之前更新以下 config：

echo "USE_CUDA=1" >>config.mk
echo "USE_CUDA_PATH=/usr/local/cuda" >>config.mk
echo "USE_CUDNN=1" >>config.mk

有关其他操作系统的 MXNet 详细安装说明，请访问 mxnet.io/get_started/setup.html。

4. 使用以下命令通过 Docker 安装 MXNet（基于 GPU），并安装所有依赖项：

docker pull chstone/mxnet-gpu

在 R 中安装 TensorFlow

本节将介绍另一个非常流行的开源机器学习包——TensorFlow，它在构建深度学习模型方面非常有效。

准备就绪

TensorFlow 是由 Google Brain 团队开发的另一个开源库，旨在使用数据流图构建数值计算模型。TensorFlow 的核心是用 C++ 开发的，并且在 Python 中提供了封装。R 中的 tensorflow 包使您能够访问由 Python 模块组成的 TensorFlow API 来执行计算模型。TensorFlow 支持基于 CPU 和 GPU 的计算。

R 中的 tensorflow 包调用 Python tensorflow API 执行计算，这就需要在 R 和 Python 中都安装 tensorflow 包，以便让 R 正常工作。以下是 tensorflow 的依赖项：

• Python 2.7 / 3.x

• R (>3.2)

• R 中用于从 GitHub 安装 TensorFlow 的 devtools 包

• Python 中的 TensorFlow

• pip

如何操作...

1. 一旦安装了所有提到的依赖项，可以通过 devtools 使用以下 install_github 命令直接安装 tensorflow：

devtools::install_github("rstudio/tensorflow")

1. 在 R 中加载 tensorflow 之前，您需要将 Python 的路径设置为系统环境变量。这可以直接从 R 环境中完成，方法如下命令所示：

Sys.setenv(TENSORFLOW_PYTHON="/usr/bin/python")
library(tensorflow)

如果未安装 Python tensorflow 模块，R 将显示以下错误：

如果 Python 中未安装 tensorflow，R 会引发错误

tensorflow 在 Python 中可以通过 pip 安装：

pip install tensorflow # Python 2.7 with no GPU support
pip3 install tensorflow # Python 3.x with no GPU support
pip install tensorflow-gpu # Python 2.7 with GPU support
pip3 install tensorflow-gpu # Python 3.x with GPU support

它是如何工作的...

TensorFlow 遵循有向图哲学来设置计算模型，其中数学操作表示为节点，每个节点支持多个输入和输出，而边缘代表节点间数据的传输。TensorFlow 中还有一些边缘被称为控制依赖，它们不代表数据流；而是提供与控制依赖相关的信息，如控制依赖的节点必须在目标控制依赖节点开始执行之前完成处理。

以下图示出了一个示例 TensorFlow 图，用于逻辑回归评分：

逻辑回归的 TensorFlow 图

上图展示了一个 TensorFlow 图，说明如何用优化后的权重对逻辑回归进行评分：

MatMul节点执行输入特征矩阵X与优化后的权重β之间的矩阵乘法。常数C随后被加到MatMul节点的输出上。然后，Add的输出会通过Sigmoid函数转化，最终输出Pr(y=1|X)。

另见

使用rstudio.github.io/tensorflow/中的资源，在 R 中开始使用 TensorFlow。

在 R 中安装 H2O

H2O 是另一个非常流行的开源库，用于构建机器学习模型。它由 H2O.ai 开发，支持包括 R 和 Python 在内的多种语言。H2O 包是一个多功能的机器学习库，专为分布式环境而开发，用于在大数据上运行算法。

准备工作

要设置 H2O，以下系统是必需的：

• 64 位 Java 运行时环境（版本 1.6 或更高）

• 最小 2GB RAM

可以通过h2o包从 R 中调用 H2O。h2o包有以下依赖项：

• RCurl

• rjson

• statmod

• 生存分析

• stats

• tools

• utils

• methods

对于没有安装 curl-config 的机器，RCurl 依赖项在 R 中安装会失败，curl-config 需要在 R 之外进行安装。

如何操作...

1. 可以直接从 CRAN 安装 H2O，并使用依赖参数 TRUE 来安装所有与 CRAN 相关的h2o依赖项。此命令将安装h2o包所需的所有 R 依赖项：

install.packages("h2o", dependencies = T)

1. 以下命令用于在当前 R 环境中调用h2o包。第一次执行h2o包时，会自动下载 JAR 文件，然后启动 H2O，如下图所示：

library(h2o) 
localH2O = h2o.init()

启动 H2O 集群

1. 可以通过集群的IP 地址和端口信息访问 H2O 集群。目前，H2O 集群在本地主机的54321端口上运行，如下截图所示：

在浏览器中运行 H2O 集群

可以通过浏览器交互式地开发 H2O 中的模型，或者通过 R 脚本进行开发。H2O 建模就像创建一个 Jupyter Notebook，但你在其中创建一个包含不同操作的流程，如导入数据、拆分数据、设置模型和评分。

它是如何工作的...

让我们使用 H2O 浏览器互动地构建一个逻辑回归模型。

1. 开始一个新流程，如下图所示：

在 H2O 中创建一个新流程

1. 使用“数据”菜单导入数据集，如下图所示：

将文件导入到 H2O 环境

1. 导入到 H2O 中的文件可以通过 解析这些文件 操作转换为 hex 格式（H2O 的原生文件格式），该操作将在文件导入到 H2O 环境后出现：

将文件解析为 hex 格式

1. 解析后的数据框可以使用 数据 | 拆分框架操作，在 H2O 中拆分为训练集和验证集，如下图所示：

将数据集拆分为训练集和验证集

1. 从“模型”菜单中选择模型并设置模型相关的参数。以下截图展示了一个 glm 模型的示例：

在 H2O 中构建模型

1. | 预测操作可以用来对另一个 H2O 数据框进行评分：

在 H2O 中进行评分

还有更多...

对于涉及大量预处理的复杂场景，可以直接从 R 调用 H2O。本书将更多关注如何直接从 R 使用 H2O 构建模型。如果 H2O 被设置在本地主机以外的位置，则可以通过在 R 中定义正确的 ip 和 port 来连接该集群：

localH2O = h2o.init(ip = "localhost", port = 54321, nthreads = -1) 

另一个关键参数是构建模型时使用的线程数；默认情况下，n 线程设置为 -2，这意味着将使用两个核心。n 线程值为 -1 时，将使用所有可用核心。

docs.h2o.ai/h2o/latest-stable/index.html#gettingstarted 在交互模式下使用 H2O 非常好。

使用 Docker 一次性安装所有三个软件包

Docker 是一个软件容器平台，用于在隔离的容器中并行托管多个软件或应用，以提高计算密度。与虚拟机不同，容器仅使用所需的库和设置来构建软件，但不包含整个操作系统，因此更加轻量和高效。

准备工作

设置所有三个软件包可能会很麻烦，具体取决于所使用的操作系统。以下的 dockerfile 代码可以用来设置一个安装了 tensorflow、带 GPU 的 mxnet 和 h2o 的环境，并且包含所有依赖项：

FROM chstone/mxnet-gpu:latest
MAINTAINER PKS Prakash <prakash5801>

# Install dependencies
RUN apt-get update && apt-get install -y
 python2.7 
 python-pip 
 python-dev 
 ipython 
 ipython-notebook 
 python-pip 
 default-jre

# Install pip and Jupyter notebook
RUN pip install --upgrade pip && 
 pip install jupyter

# Add R to Jupyter kernel 
RUN Rscript -e "install.packages(c('repr', 'IRdisplay', 'crayon', 'pbdZMQ'), dependencies=TRUE, repos='https://cran.rstudio.com')" && 
 Rscript -e "library(devtools); library(methods); options(repos=c(CRAN='https://cran.rstudio.com')); devtools::install_github('IRkernel/IRkernel')" && 
 Rscript -e "library(IRkernel); IRkernel::installspec(name = 'ir32', displayname = 'R 3.2')" 

# Install H2O
RUN Rscript -e "install.packages('h2o', dependencies=TRUE, repos='http://cran.rstudio.com')"

# Install tensorflow fixing the proxy port
RUN pip install tensorflow-gpu
RUN Rscript -e "library(devtools); devtools::install_github('rstudio/tensorflow')"

当前的镜像是基于 chstone/mxnet-gpu Docker 镜像创建的。

chstone/mxnet-gpu 是一个 Docker Hub 仓库，地址为 hub.docker.com/r/chstone/mxnet-gpu/。

如何操作...

Docker 将通过以下步骤安装所有依赖项：

1. 将前面的代码保存到一个位置，命名为 Dockerfile。

2. 使用命令行，进入文件所在位置，并运行以下命令，命令后面的截图也展示了相同内容：

docker run -t "TagName:FILENAME"

构建 Docker 镜像

1. 使用docker images命令查看镜像，方法如下：

查看 Docker 镜像

1. Docker 镜像可以使用以下命令来执行：

docker run -it -p 8888:8888 -p 54321:54321 <<IMAGE ID>>

运行 Docker 镜像

这里，选项-i表示交互模式，-t用于分配--tty。选项-p用于端口转发。由于我们将 Jupyter 运行在端口8888，将 H2O 运行在端口54321，因此我们将两个端口转发以便从本地浏览器访问。

还有更多...

更多 Docker 选项可以通过运行docker run --help来查看。

第二章：使用 R 进行深度学习

本章将为神经网络打下基础，接着是深度学习基础和趋势的介绍。我们将涵盖以下主题：

• 从逻辑回归开始

• 引入数据集

• 使用 H2O 执行逻辑回归

• 使用 TensorFlow 执行逻辑回归

• 可视化 TensorFlow 图

• 从多层感知机开始

• 使用 H2O 设置神经网络

• 使用 H2O 的网格搜索调优超参数

• 使用 MXNet 设置神经网络

• 使用 TensorFlow 设置神经网络

从逻辑回归开始

在深入探讨神经网络和深度学习模型之前，让我们先了解一下逻辑回归，它可以看作是一个单层神经网络。即使是逻辑回归中常用的sigmoid函数，也被用作神经网络中的激活函数。

准备工作

逻辑回归是一种监督学习方法，用于对二分类/有序（顺序离散）类别进行分类。

如何操作...

逻辑回归作为构建复杂神经网络模型的基础，使用 sigmoid 作为激活函数。逻辑函数（或 sigmoid）可以表示如下：

上述的 sigmoid 函数形成一个连续曲线，其值限制在 [0, 1] 之间，如下图所示：

Sigmoid 函数形式

逻辑回归模型的公式可以写作如下：

这里，W 是与特征 X = ** [x[1], x[2], ..., x[m]] 相关的权重，b 是模型的截距，也称为模型偏差。整个目标是优化 W，以适应给定的损失函数，例如交叉熵。另一种看待逻辑回归模型的方法是为了获得 Pr(*y=1|*X)，如下图所示：

带有 sigmoid 激活函数的逻辑回归架构

引入数据集

该配方展示了如何准备一个数据集，供展示不同的模型使用。

准备工作

由于逻辑回归是线性分类器，它假设独立变量与对数几率之间是线性关系。因此，在独立特征与对数几率之间存在线性依赖的情况下，模型表现非常好。可以将高阶特征包含在模型中，以捕获非线性行为。让我们看看如何使用前一章讨论的主要深度学习包构建逻辑回归模型。需要互联网连接才能从 UCI 仓库下载数据集。

如何操作...

在本章中，将使用UC Irivine ML 库中的占用检测数据集，构建逻辑回归和神经网络模型。该数据集是一个实验性数据集，主要用于二元分类，判断一个房间是否被占用（1）或未被占用（0），基于多变量预测因子，如下表所示。该数据集的贡献者是Luis Candanedo，来自 UMONS。

下载数据集：archive.ics.uci.edu/ml/datasets/Occupancy+Detection+。

有三个数据集需要下载；然而，我们将使用datatraining.txt进行训练/交叉验证，并使用datatest.txt进行测试。

该数据集包含七个属性（包括响应变量占用情况），共 20,560 个实例。以下表格总结了属性信息：

属性	描述	特性
日期时间	年-月-日 时:分:秒格式	日期
温度	单位为摄氏度（Celsius）	实际值
相对湿度	单位为百分比（%）	实际值
光照	单位为勒克斯（Lux）	实际值
CO2	单位为 ppm	实际值
湿度比	由温度和相对湿度推导而来，单位为水蒸气/空气，单位为 kg/kg	实际值
占用状态	0 表示未占用；1 表示已占用	二元类别

使用 H2O 执行逻辑回归

广义线性模型（GLM）广泛应用于基于回归和分类的预测分析。这些模型通过最大似然法进行优化，并能够很好地扩展至更大的数据集。在 H2O 中，GLM 具有处理 L1 和 L2 惩罚（包括弹性网）的灵活性。它支持高斯、二项、泊松和伽玛分布的因变量。它在处理分类变量、计算完整的正则化并执行分布式n 折交叉验证以防止模型过拟合方面非常高效。它具有优化超参数的功能，如使用分布式网格搜索来优化弹性网（α），并处理预测属性系数的上下界。它还可以自动处理缺失值填充。它采用 Hogwild 方法进行优化，这是随机梯度下降的并行版本。

准备就绪

前一章提供了 H2O 在 R 中的安装细节，并展示了使用其 Web 界面的工作示例。要开始建模，请在 R 环境中加载h20包：

require(h2o)

然后，使用h2o.init()函数初始化一个单节点的 H2O 实例，运行在八个核心上，并在 IP 地址localhost和端口号54321上实例化相应的客户端模块：

localH2O = h2o.init(ip = "localhost", port = 54321, startH2O = TRUE,min_mem_size = "20G",nthreads = 8)

H2O 包依赖 Java JRE。因此，必须在执行初始化命令之前预先安装它。

如何执行...

本节将演示使用 H2O 构建 GLM 模型的步骤。

1. 现在，在 R 中加载占用训练集和测试集数据集：

# Load the occupancy data 
occupancy_train <-read.csv("C:/occupation_detection/datatraining.txt",stringsAsFactors = T)
occupancy_test <- read.csv("C:/occupation_detection/datatest.txt",stringsAsFactors = T)

1. 以下独立变量（x）和因变量（y）将用于建模 GLM：

# Define input (x) and output (y) variables"
x = c("Temperature", "Humidity", "Light", "CO2", "HumidityRatio")
y = "Occupancy"

1. 根据 H2O 的要求，将因变量转换为因子，如下所示：

# Convert the outcome variable into factor
occupancy_train$Occupancy <- as.factor(occupancy_train$Occupancy)
occupancy_test$Occupancy <- as.factor(occupancy_test$Occupancy)

1. 然后，将数据集转换为 H2OParsedData 对象：

occupancy_train.hex <- as.h2o(x = occupancy_train, destination_frame = "occupancy_train.hex")
occupancy_test.hex <- as.h2o(x = occupancy_test, destination_frame = "occupancy_test.hex")

1. 一旦数据被加载并转换为 H2OParsedData 对象，使用h2o.glm函数运行 GLM 模型。在当前的设置中，我们计划训练五折交叉验证、弹性网正则化（α = 5）和最优正则化强度（lamda_search = TRUE）等参数：

# Train the model
occupancy_train.glm <- h2o.glm(x = x, # Vector of predictor variable names
                               y = y, # Name of response/dependent variable
                               training_frame = occupancy_train.hex, # Training data
                               seed = 1234567,        # Seed for random numbers
                               family = "binomial",   # Outcome variable
                               lambda_search = TRUE,  # Optimum regularisation lambda
                               alpha = 0.5,           # Elastic net regularisation
                               nfolds = 5             # N-fold cross validation
                               )

1. 除了前面的命令外，您还可以定义其他参数来微调模型性能。以下列表未涵盖所有功能参数，而是根据重要性涵盖了一些。完整的参数列表可以在h2o包的文档中找到。

• • 使用 fold_assignment 指定生成交叉验证样本的策略，如随机抽样、分层抽样、模数抽样和自动（选择）。也可以通过指定列名（fold_column）在特定属性上进行采样。

  • 通过为每个观测值指定权重（weights_column）或执行过/欠采样（balance_classes）来处理倾斜结果（不平衡数据）的选项。

  • 通过均值插补或跳过观测值的方式处理缺失值的选项，使用 missing_values_handling。

  • 通过使用 non_negative 选项限制系数为非负，并使用 beta_constraints 约束其值的选项。

  • 如果响应变量的均值未反映现实，可以为 y==1（逻辑回归）提供先验概率（prior）以用于抽样数据。

  • 指定需要考虑交互作用（interactions）的变量。

它是如何工作的...

模型的性能可以通过多种指标进行评估，例如准确率、曲线下面积（AUC）、误分类错误（%）、误分类错误计数、F1 分数、精度、召回率、特异性等。然而，在本章中，模型性能的评估是基于 AUC 的。

以下是训练模型的训练和交叉验证准确度：

# Training accuracy (AUC)
> occupancy_train.glm@model$training_metrics@metrics$AUC
[1] 0.994583

# Cross validation accuracy (AUC)
> occupancy_train.glm@model$cross_validation_metrics@metrics$AUC
[1] 0.9945057

现在，让我们评估模型在测试数据上的表现。以下代码帮助预测测试数据的结果：

# Predict on test data
yhat <- h2o.predict(occupancy_train.glm, occupancy_test.hex)

然后，根据实际测试结果评估AUC值，如下所示：

# Test accuracy (AUC)
> yhat$pmax <- pmax(yhat$p0, yhat$p1, na.rm = TRUE) 
> roc_obj <- pROC::roc(c(as.matrix(occupancy_test.hex$Occupancy)),
                       c(as.matrix(yhat$pmax)))
> auc(roc_obj)
Area under the curve: 0.9915

在 H2O 中，还可以从 GLM 模型中计算变量的重要性，如下图所示：

#compute variable importance and performance
h2o.varimp_plot(occupancy_train.glm, num_of_features = 5)

使用 H2O 进行变量重要性评估

另见

更多关于h2o.glm的功能参数可以参考www.rdocumentation.org/packages/h2o/versions/3.10.3.6/topics/h2o.gbm。

使用 TensorFlow 执行逻辑回归

在本节中，我们将介绍 TensorFlow 在设置逻辑回归模型中的应用。示例将使用与 H2O 模型设置中类似的数据集。

准备就绪

前一章提供了 TensorFlow 安装的详细信息。本节的代码是在 Linux 上创建的，但可以在任何操作系统上运行。要开始建模，请在环境中加载 tensorflow 包。R 会加载默认的 TensorFlow 环境变量，还会从 Python 中加载 NumPy 库至 np 变量：

library("tensorflow") # Load TensorFlow 
np <- import("numpy") # Load numpy library

如何执行...

数据使用 R 中的标准函数导入，如以下代码所示。

1. 数据使用 read.csv 文件导入，并转换为矩阵格式，接着选择用于建模的特征，如 xFeatures 和 yFeatures. 接下来的步骤是在 TensorFlow 中设置一个图形以进行优化：

# Loading input and test data
xFeatures = c("Temperature", "Humidity", "Light", "CO2", "HumidityRatio")
yFeatures = "Occupancy"
occupancy_train <-as.matrix(read.csv("datatraining.txt",stringsAsFactors = T))
occupancy_test <- as.matrix(read.csv("datatest.txt",stringsAsFactors = T))

# subset features for modeling and transform to numeric values
occupancy_train<-apply(occupancy_train[, c(xFeatures, yFeatures)], 2, FUN=as.numeric) 
occupancy_test<-apply(occupancy_test[, c(xFeatures, yFeatures)], 2, FUN=as.numeric)

# Data dimensions
nFeatures<-length(xFeatures)
nRow<-nrow(occupancy_train)

1. 在设置图形之前，让我们使用以下命令重置图形：

# Reset the graph
tf$reset_default_graph()

1. 此外，让我们启动一个交互式会话，这样可以在不引用会话间对象的情况下执行变量：

# Starting session as interactive session
sess<-tf$InteractiveSession()

1. 在 TensorFlow 中定义逻辑回归模型：

# Setting-up Logistic regression graph
x <- tf$constant(unlist(occupancy_train[, xFeatures]), shape=c(nRow, nFeatures), dtype=np$float32) # 
W <- tf$Variable(tf$random_uniform(shape(nFeatures, 1L)))
b <- tf$Variable(tf$zeros(shape(1L)))
y <- tf$matmul(x, W) + b

1. 输入特征 x 被定义为常量，因为它将作为系统的输入。权重 W 和偏置 b 被定义为变量，在优化过程中会进行优化。y 被设置为 x、W 和 b 之间的符号表示。权重 W 设置为初始化的随机均匀分布，而 b 的值被赋为零。

2. 下一步是设置逻辑回归的成本函数：

# Setting-up cost function and optimizer
y_ <- tf$constant(unlist(occupancy_train[, yFeatures]), dtype="float32", shape=c(nRow, 1L))
cross_entropy<-tf$reduce_mean(tf$nn$sigmoid_cross_entropy_with_logits(labels=y_, logits=y, name="cross_entropy"))
optimizer <- tf$train$GradientDescentOptimizer(0.15)$minimize(cross_entropy)

变量 y_ 是响应变量。逻辑回归使用交叉熵作为损失函数进行设置。损失函数被传递给梯度下降优化器，学习率为 0.15。优化之前，初始化全局变量：

# Start a session
init <- tf$global_variables_initializer()
sess$run(init)

1. 执行梯度下降算法，通过交叉熵作为损失函数优化权重：

# Running optimization 
for (step in 1:5000) {
  sess$run(optimizer)
  if (step %% 20== 0)
    cat(step, "-", sess$run(W), sess$run(b), "==>", sess$run(cross_entropy), "n")
}

它是如何工作的...

可以使用 AUC 来评估模型的性能：

# Performance on Train
library(pROC) 
ypred <- sess$run(tf$nn$sigmoid(tf$matmul(x, W) + b))
roc_obj <- roc(occupancy_train[, yFeatures], as.numeric(ypred))

# Performance on test
nRowt<-nrow(occupancy_test)
xt <- tf$constant(unlist(occupancy_test[, xFeatures]), shape=c(nRowt, nFeatures), dtype=np$float32)
ypredt <- sess$run(tf$nn$sigmoid(tf$matmul(xt, W) + b))
roc_objt <- roc(occupancy_test[, yFeatures], as.numeric(ypredt)).

AUC 可以使用来自 pROC 包的 plot.auc 函数进行可视化，如以下命令的截图所示。训练和测试（hold-out）的性能非常相似。

plot.roc(roc_obj, col = "green", lty=2, lwd=2)
plot.roc(roc_objt, add=T, col="red", lty=4, lwd=2)

使用 TensorFlow 执行逻辑回归的性能

可视化 TensorFlow 图

可以使用 TensorBoard 来可视化 TensorFlow 图。它是一个利用 TensorFlow 事件文件来可视化 TensorFlow 模型为图形的服务。TensorBoard 中的图形模型可视化还可以用于调试 TensorFlow 模型。

准备就绪

可以通过在终端中使用以下命令启动 TensorBoard：

$ tensorboard --logdir home/log --port 6006 

以下是 TensorBoard 的主要参数：

• --logdir：映射到加载 TensorFlow 事件的目录

• --debug：增加日志的详细程度

• --host：定义主机以监听其本地主机（127.0.0.1）默认地址

• --port：定义 TensorBoard 提供服务的端口

上述命令将在本地主机的 6006 端口启动 TensorFlow 服务，如下图所示：

TensorBoard

TensorBoard 中的标签捕捉在图执行过程中生成的相关数据。

如何实现...

本节介绍了如何在 TensorBoard 中可视化 TensorFlow 模型和输出。

1. 为了可视化摘要和图表，可以使用来自总结模块的FileWriter命令将 TensorFlow 的数据导出。可以使用以下命令添加默认的会话图：

# Create Writer Obj for log
log_writer = tf$summary$FileWriter('c:/log', sess$graph)

使用前述代码开发的逻辑回归图如下图所示：

在 TensorBoard 中可视化逻辑回归图

关于 TensorBoard 上符号描述的详细信息可以在www.tensorflow.org/get_started/graph_viz找到。

1. 同样，其他变量摘要可以使用正确的摘要添加到 TensorBoard，如以下代码所示：

# Adding histogram summary to weight and bias variable
w_hist = tf$histogram_summary("weights", W)
b_hist = tf$histogram_summary("biases", b)

摘要是判断模型性能的非常有用的方式。例如，对于前述案例，可以通过研究测试和训练的成本函数来理解优化性能和收敛情况。

1. 为测试创建交叉熵评估。生成测试和训练的交叉熵成本函数的示例脚本如下所示：

# Set-up cross entropy for test
nRowt<-nrow(occupancy_test)
xt <- tf$constant(unlist(occupancy_test[, xFeatures]), shape=c(nRowt, nFeatures), dtype=np$float32)
ypredt <- tf$nn$sigmoid(tf$matmul(xt, W) + b)
yt_ <- tf$constant(unlist(occupancy_test[, yFeatures]), dtype="float32", shape=c(nRowt, 1L))
cross_entropy_tst<-tf$reduce_mean(tf$nn$sigmoid_cross_entropy_with_logits(labels=yt_, logits=ypredt, name="cross_entropy_tst"))

上述代码与使用不同数据集进行训练交叉熵计算相似。通过设置一个函数返回张量对象，可以将工作量最小化。

1. 添加要收集的摘要变量：

# Add summary ops to collect data
w_hist = tf$summary$histogram("weights", W)
b_hist = tf$summary$histogram("biases", b)
crossEntropySummary<-tf$summary$scalar("costFunction", cross_entropy)
crossEntropyTstSummary<-tf$summary$scalar("costFunction_test", cross_entropy_tst)

该脚本定义了要记录在文件中的总结事件。

1. 打开写入对象log_writer。它将默认图写入位置c:/log：

# Create Writer Obj for log
log_writer = tf$summary$FileWriter('c:/log', sess$graph)

1. 运行优化并收集摘要：

for (step in 1:2500) {
  sess$run(optimizer)

  # Evaluate performance on training and test data after 50 Iteration
  if (step %% 50== 0){
   ### Performance on Train
   ypred <- sess$run(tf$nn$sigmoid(tf$matmul(x, W) + b))
   roc_obj <- roc(occupancy_train[, yFeatures], as.numeric(ypred))

   ### Performance on Test
   ypredt <- sess$run(tf$nn$sigmoid(tf$matmul(xt, W) + b))
   roc_objt <- roc(occupancy_test[, yFeatures], as.numeric(ypredt))
   cat("train AUC: ", auc(roc_obj), " Test AUC: ", auc(roc_objt), "n")

   # Save summary of Bias and weights
   log_writer$add_summary(sess$run(b_hist), global_step=step)
   log_writer$add_summary(sess$run(w_hist), global_step=step)
   log_writer$add_summary(sess$run(crossEntropySummary), global_step=step)
   log_writer$add_summary(sess$run(crossEntropyTstSummary), global_step=step)
} }

1. 使用总结模块的merge_all命令将所有摘要收集到一个张量中：

summary = tf$summary$merge_all() 

1. 使用log_writer对象将摘要写入日志文件：

log_writer = tf$summary$FileWriter('c:/log', sess$graph)
summary_str = sess$run(summary)
log_writer$add_summary(summary_str, step)
log_writer$close()

它是如何工作的...

本节介绍了使用 TensorBoard 可视化模型性能。训练和测试的交叉熵记录在 SCALARS 标签中，如以下屏幕截图所示：

训练和测试数据的交叉熵

目标函数在训练和测试成本函数上表现出类似的行为；因此，对于给定的案例，模型似乎是稳定的，且收敛大约在 1,600 次迭代时达到。

从多层感知机开始

本节将重点介绍将逻辑回归概念扩展到神经网络。

神经网络，也称为人工神经网络（ANN），是一种受生物大脑神经结构启发的计算范式。

准备工作

人工神经网络（ANN）是一组执行数据简单操作的人工神经元；这些操作的输出传递给另一个神经元。在每个神经元生成的输出称为其激活函数。多层感知机模型的示例可以在以下屏幕截图中看到：

多层神经网络的示例

上述图中的每一条连接都与神经元处理的权重相关。每个神经元可以看作是一个处理单元，接收输入并将输出传递给下一层，示例如下图所示：

一个神经元接收三个输入并输出一个结果的示例

上述图示展示了三个输入合并到神经元中，产生一个输出，之后可能传递给另一个神经元。神经元的处理操作可以是非常简单的操作，例如输入乘以权重再求和，或者是一个变换操作，例如 Sigmoid 激活函数。

如何实现…

本节介绍了多层感知机中的激活函数类型。激活函数是人工神经网络中的关键组件之一，它根据给定输入定义节点的输出。在构建神经网络时，使用了多种不同的激活函数：

• Sigmoid：Sigmoid 激活函数是一个连续函数，也称为逻辑函数，形式为 1/(1+exp(-x))。Sigmoid 函数在训练过程中有使反向传播项归零的倾向，导致响应饱和。在 TensorFlow 中，Sigmoid 激活函数使用 tf.nn.sigmoid 函数定义。

• ReLU：修正线性单元（ReLU）是最著名的连续但不光滑的激活函数之一，用于神经网络中捕捉非线性。ReLU 函数的定义是 max(0,x)。在 TensorFlow 中，ReLU 激活函数定义为 tf.nn.relu*。

• ReLU6：它将 ReLU 函数的输出上限限制为 6，定义为 min(max(0,x), 6)，因此值不会变得过小或过大。该函数在 TensorFlow 中的定义是 tf.nn.relu6。

• tanh：双曲正切函数是另一种平滑函数，作为神经网络中的激活函数使用，其值域为[ -1 到 1]，并通过 tf.nn.tanh 实现。

• softplus：它是 ReLU 的连续版本，因此其导数存在，定义为 log(exp(x)+1)。在 TensorFlow 中，softplus 函数定义为 tf.nn.softplus。

还有更多…

神经网络中有三种主要的网络架构：

• 前馈型人工神经网络：这是一种神经网络模型，信息流从输入到输出是单向的，因此架构不会形成任何循环。以下图展示了一个前馈型网络的示例：

神经网络的前馈架构

• 反馈型人工神经网络：这也被称为 Elman 递归网络，是一种神经网络类型，其中输出节点的误差作为反馈，迭代更新以最小化误差。以下图展示了一个单层反馈型神经网络架构的示例：

神经网络的反馈架构

• 横向 ANN：这是一类神经网络，介于反馈神经网络和前馈神经网络之间，神经元在层之间相互作用。以下是一个横向神经网络架构的示例：

横向神经网络架构

另见

在 TensorFlow 中支持的更多激活函数可以在www.tensorflow.org/versions/r0.10/api_docs/python/nn/activation_functions_找到。

使用 H2O 设置神经网络

本节将介绍如何使用 H2O 设置神经网络。该示例将使用与逻辑回归中类似的数据集。

准备工作

我们首先使用以下代码加载所有所需的包：

# Load the required packages
require(h2o)

然后，使用h2o.init()函数在八个核心上初始化一个单节点 H2O 实例，并在 IP 地址localhost和端口号54321上实例化相应的客户端模块：

# Initialize H2O instance (single node)
localH2O = h2o.init(ip = "localhost", port = 54321, startH2O = TRUE,min_mem_size = "20G",nthreads = 8)

如何操作...

本节展示了如何使用 H20 构建神经网络。

1. 在 R 中加载占用训练和测试数据集：

# Load the occupancy data 
occupancy_train <-read.csv("C:/occupation_detection/datatraining.txt",stringsAsFactors = T)
occupancy_test <- read.csv("C:/occupation_detection/datatest.txt",stringsAsFactors = T)

1. 以下独立变量（x）和因变量（y）将用于建模 GLM：

# Define input (x) and output (y) variables
x = c("Temperature", "Humidity", "Light", "CO2", "HumidityRatio")
y = "Occupancy"

1. 根据 H2O 的要求，将因变量转换为因子，方法如下：

# Convert the outcome variable into factor
occupancy_train$Occupancy <- as.factor(occupancy_train$Occupancy)
occupancy_test$Occupancy <- as.factor(occupancy_test$Occupancy)

1. 然后将数据集转换为 H2OParsedData 对象：

# Convert Train and Test datasets into H2O objects
occupancy_train.hex <- as.h2o(x = occupancy_train, destination_frame = "occupancy_train.hex")
occupancy_test.hex <- as.h2o(x = occupancy_test, destination_frame = "occupancy_test.hex")

1. 一旦数据加载并转换为 H2OParsedData 对象，使用h2o.deeplearning函数构建多层前馈神经网络。在当前设置中，使用以下参数构建 NN 模型：

• • 使用hidden创建一个包含五个神经元的单隐藏层

  • 使用epochs进行 50 次迭代

  • 使用自适应学习率（adaptive_rate）代替固定学习率（rate）

  • 基于 ReLU 的Rectifier激活函数

  • 使用nfold进行五折交叉验证

# H2O based neural network to Train the model 
occupancy.deepmodel <- h2o.deeplearning(x = x, 
                                        y = y, 
                                        training_frame = occupancy_train.hex, 
                                        validation_frame = occupancy_test.hex, 
                                        standardize = F, 
                                        activation = "Rectifier", 
                                        epochs = 50, 
                                        seed = 1234567, 
                                        hidden = 5, 
                                        variable_importances = T,
                                        nfolds = 5,
                                        adpative_rate = TRUE)

1. 除了配方中描述的使用 H2O 执行逻辑回归命令外，你还可以定义其他参数来微调模型性能。以下列表未覆盖所有功能参数，但涵盖了一些重要的参数。完整的参数列表可以在h2o包的文档中找到。

• • 选项可以使用预训练的自编码器模型初始化模型。

  • 通过修改时间衰减因子（rho）和平滑因子（epsilon）的选项来微调自适应学习率。对于固定学习率（rate），可以选择修改退火率（rate_annealing）和层之间的衰减因子（rate_decay）。

  • 初始化权重和偏差的选项，以及权重分布和缩放。

  • 基于分类中的错误比例和回归中的均方误差的停止标准（classification_stop 和 regression_stop）。还可以选择执行早期停止。

  • 使用弹性平均方法改进分布式模型收敛的选项，包括移动速率和正则化强度等参数。

它是如何工作的...

模型的性能可以通过多种指标进行评估，例如准确率、AUC、误分类错误率（%）、误分类错误计数、F1 分数、精确度、召回率、特异性等。然而，在本章中，模型性能的评估是基于 AUC。

以下是训练模型的训练集和交叉验证准确度。训练集和交叉验证 AUC 分别为 0.984 和 0.982：

# Get the training accuracy (AUC)
> train_performance <- h2o.performance(occupancy.deepmodel,train = T)
> train_performance@metrics$AUC
[1] 0.9848667

# Get the cross-validation accuracy (AUC)
> xval_performance <- h2o.performance(occupancy.deepmodel,xval = T)
> xval_performance@metrics$AUC
[1] 0.9821723

因为我们已经在模型中提供了测试数据（作为验证数据集），下面是其性能。测试数据集上的 AUC 为 0.991。

# Get the testing accuracy(AUC)
> test_performance <- h2o.performance(occupancy.deepmodel,valid = T)
> test_performance@metrics$AUC
[1] 0.9905056

在 H2O 中使用网格搜索调优超参数

H2O 包还允许通过网格搜索（h2o.grid）执行超参数调优。

准备开始

我们首先加载并初始化 H2O 包，代码如下：

# Load the required packages
require(h2o)

# Initialize H2O instance (single node)
localH2O = h2o.init(ip = "localhost", port = 54321, startH2O = TRUE,min_mem_size = "20G",nthreads = 8)

载入占用数据集，转换为十六进制格式，并命名为 occupancy_train.hex。

如何做...

本节将重点介绍如何使用网格搜索优化 H2O 中的超参数。

1. 在我们的例子中，我们将优化激活函数、隐藏层数量（以及每层中的神经元数量）、epochs 和正则化参数 lambda（l1 和 l2）：

# Perform hyper parameter tuning
activation_opt <- c("Rectifier","RectifierWithDropout", "Maxout","MaxoutWithDropout")
hidden_opt <- list(5, c(5,5))
epoch_opt <- c(10,50,100)
l1_opt <- c(0,1e-3,1e-4)
l2_opt <- c(0,1e-3,1e-4)

hyper_params <- list(activation = activation_opt,
                     hidden = hidden_opt,
                     epochs = epoch_opt,
                     l1 = l1_opt,
                     l2 = l2_opt)

1. 以下是设置进行网格搜索的搜索标准。除了以下列表外，还可以指定停止度量的类型、停止的最小容忍度和最大停止轮次：

#set search criteria
search_criteria <- list(strategy = "RandomDiscrete", max_models=300)

1. 现在，让我们对训练数据执行网格搜索，具体如下：

# Perform grid search on training data
dl_grid <- h2o.grid(x = x,
                    y = y,
                    algorithm = "deeplearning",
                    grid_id = "deep_learn",
                    hyper_params = hyper_params,
                    search_criteria = search_criteria,
                    training_frame = occupancy_train.hex,
                    nfolds = 5)

1. 一旦网格搜索完成（此处共有 216 个不同的模型），可以根据多个指标选择最佳模型，例如对数损失、残差偏差、均方误差、AUC、准确率、精确度、召回率、F1 分数等。在我们的场景中，选择 AUC 最高的最佳模型：

#Select best model based on auc
d_grid <- h2o.getGrid("deep_learn",sort_by = "auc", decreasing = T)
best_dl_model <- h2o.getModel(d_grid@model_ids[[1]])

它是如何工作的...

以下是网格搜索模型在训练集和交叉验证数据集上的表现。我们可以观察到，在执行网格搜索后，训练集和交叉验证数据集的 AUC 都增加了一个单位。网格搜索后的训练集和交叉验证 AUC 分别为 0.996 和 0.997。

# Performance on Training data after grid search
> train_performance.grid <- h2o.performance(best_dl_model,train = T)
> train_performance.grid@metrics$AUC
[1] 0.9965881

# Performance on Cross validation data after grid search
> xval_performance.grid <- h2o.performance(best_dl_model,xval = T)
> xval_performance.grid@metrics$AUC
[1] 0.9979131

现在，让我们评估在测试数据集上进行网格搜索后最佳模型的性能。我们可以观察到，在执行网格搜索后，AUC 增加了 0.25 个单位。测试数据集上的 AUC 为 0.993。

# Predict the outcome on test dataset
yhat <- h2o.predict(best_dl_model, occupancy_test.hex) 

# Performance of the best grid-searched model on the Test dataset
> yhat$pmax <- pmax(yhat$p0, yhat$p1, na.rm = TRUE) 
> roc_obj <- pROC::roc(c(as.matrix(occupancy_test.hex$Occupancy)), c(as.matrix(yhat$pmax)))
> pROC::auc(roc_obj)
Area under the curve: 0.9932

使用 MXNet 设置神经网络

上一章提供了在 R 中安装 MXNet 的详细信息，并通过其 Web 界面展示了一个工作示例。要开始建模，请在 R 环境中加载 MXNet 包。

准备开始

加载所需的包：

# Load the required packages
require(mxnet)

如何做...

1. 在 R 中加载占用训练集和测试集数据集：

# Load the occupancy data 
occupancy_train <-read.csv("C:/occupation_detection/datatraining.txt",stringsAsFactors = T)
occupancy_test <- read.csv("C:/occupation_detection/datatest.txt",stringsAsFactors = T)

1. 以下是用于建模 GLM 的独立变量（x）和依赖变量（y）：

# Define input (x) and output (y) variables
x = c("Temperature", "Humidity", "Light", "CO2", "HumidityRatio")
y = "Occupancy"

1. 根据 MXNet 的要求，将训练集和测试集数据集转换为矩阵，并确保结果变量的类别是数值型（而不是像 H2O 中那样的因子型）：

# convert the train data into matrix
occupancy_train.x <- data.matrix(occupancy_train[,x])
occupancy_train.y <- occupancy_train$Occupancy

# convert the test data into matrix
occupancy_test.x <- data.matrix(occupancy_test[,x])
occupancy_test.y <- occupancy_test$Occupancy

1. 现在，让我们手动配置一个神经网络。首先，配置一个具有特定名称的符号变量。然后，配置一个包含五个神经元的符号全连接网络，并跟随使用对数损失函数（或交叉熵损失函数）的 softmax 激活函数。还可以创建额外的（全连接的）隐藏层，并使用不同的激活函数。

# Configure Neural Network structure 
smb.data <- mx.symbol.Variable("data")
smb.fc <- mx.symbol.FullyConnected(smb.data, num_hidden=5) 
smb.soft <- mx.symbol.SoftmaxOutput(smb.fc)

1. 一旦神经网络配置完成，接下来我们使用 mx.model.FeedForward.create 函数创建（或训练）前馈神经网络模型。模型的参数如迭代次数或周期数（100）、评估指标（分类准确率）、每次迭代或周期的大小（100 个观察值）以及学习率（0.01）被调整：

# Train the network
model.nn <- mx.model.FeedForward.create(symbol = smb.soft,
                                        X = occupancy_train.x,
                                        y = occupancy_train.y,
                                        ctx = mx.cpu(),
                                        num.round = 100,
                                        eval.metric = mx.metric.accuracy,
                                        array.batch.size = 100,
                                        learning.rate = 0.01)

它是如何工作的...

现在，让我们评估模型在训练和测试数据集上的表现。训练数据集上的 AUC 为 0.978，测试数据集上的 AUC 为 0.982：

# Train accuracy (AUC)
> train_pred <- predict(model.nn,occupancy_train.x)
> train_yhat <- max.col(t(train_pred))-1
> roc_obj <- pROC::roc(c(occupancy_train.y), c(train_yhat))
> pROC::auc(roc_obj)
Area under the curve: 0.9786

#Test accuracy (AUC)
> test_pred <- predict(nnmodel,occupancy_test.x)
> test_yhat <- max.col(t(test_pred))-1
> roc_obj <- pROC::roc(c(occupancy_test.y), c(test_yhat))
> pROC::auc(roc_obj)
Area under the curve: 0.9824

使用 TensorFlow 设置神经网络

在本节中，我们将介绍 TensorFlow 在设置二层神经网络模型中的应用。

准备工作

要开始建模，在环境中加载 tensorflow 包。R 会加载默认的 tf 环境变量，并从 Python 中加载 NumPy 库到 np 变量：

library("tensorflow") # Load Tensorflow 
np <- import("numpy") # Load numpy library

如何操作...

1. 数据通过 R 中的标准函数导入，如以下代码所示。数据通过 read.csv 文件导入，并转换为矩阵格式，接着选择用于建模的特征，这些特征在 xFeatures 和 yFeatures 中定义*：*

# Loading input and test data
xFeatures = c("Temperature", "Humidity", "Light", "CO2", "HumidityRatio")
yFeatures = "Occupancy"
occupancy_train <-as.matrix(read.csv("datatraining.txt",stringsAsFactors = T))
occupancy_test <- as.matrix(read.csv("datatest.txt",stringsAsFactors = T))

# subset features for modeling and transform to numeric values
occupancy_train<-apply(occupancy_train[, c(xFeatures, yFeatures)], 2, FUN=as.numeric) 
occupancy_test<-apply(occupancy_test[, c(xFeatures, yFeatures)], 2, FUN=as.numeric)

# Data dimensions
nFeatures<-length(xFeatures)
nRow<-nrow(occupancy_train)

1. 现在加载网络和模型参数。网络参数定义了神经网络的结构，模型参数定义了其调整标准。如前所述，神经网络是通过两层隐藏层构建的，每一层有五个神经元。n_input 参数定义了自变量的数量，n_classes 定义了输出类别数量减一的值。在输出变量为 one-hot 编码的情况下（一个属性为占用，另一个属性为不占用），n_classes 将为 2L（等于 one-hot 编码属性的数量）。在模型参数中，学习率为 0.001，模型构建的周期数（或迭代次数）为 10000：

# Network Parameters
n_hidden_1 = 5L # 1st layer number of features
n_hidden_2 = 5L # 2nd layer number of features
n_input = 5L    # 5 attributes
n_classes = 1L  # Binary class

# Model Parameters
learning_rate = 0.001
training_epochs = 10000

1. 在 TensorFlow 中的下一步是设置一个图来执行优化。在设置图之前，使用以下命令重置图：

# Reset the graph
tf$reset_default_graph()

1. 此外，让我们启动一个交互式会话，因为它将允许我们在不引用会话之间对象的情况下执行变量：

# Starting session as interactive session
sess<-tf$InteractiveSession()

1. 以下脚本定义了图的输入（x 为自变量，y 为因变量）。输入特征 x 被定义为常量，因为它将作为输入提供给系统。类似地，输出特征 y 也被定义为常量，并具有 float32 类型：

# Graph input
x = tf$constant(unlist(occupancy_train[,xFeatures]), shape=c(nRow, n_input), dtype=np$float32)
y = tf$constant(unlist(occupancy_train[,yFeatures]), dtype="float32", shape=c(nRow, 1L))

1. 现在，让我们创建一个具有两层隐藏层的多层感知器。两层隐藏层都使用 ReLU 激活函数，输出层使用线性激活函数。权重和偏置被定义为变量，在优化过程中进行优化。初始值是从正态分布中随机选择的。以下脚本用于初始化并存储隐藏层的权重和偏置以及多层感知器模型：

# Initializes and store hidden layer's weight & bias
weights = list(
 "h1" = tf$Variable(tf$random_normal(c(n_input, n_hidden_1))),
 "h2" = tf$Variable(tf$random_normal(c(n_hidden_1, n_hidden_2))),
 "out" = tf$Variable(tf$random_normal(c(n_hidden_2, n_classes)))
)
biases = list(
 "b1" = tf$Variable(tf$random_normal(c(1L,n_hidden_1))),
 "b2" = tf$Variable(tf$random_normal(c(1L,n_hidden_2))),
 "out" = tf$Variable(tf$random_normal(c(1L,n_classes)))
)

# Create model
multilayer_perceptron <- function(x, weights, biases){
 # Hidden layer with RELU activation
 layer_1 = tf$add(tf$matmul(x, weights[["h1"]]), biases[["b1"]])
 layer_1 = tf$nn$relu(layer_1)
 # Hidden layer with RELU activation
 layer_2 = tf$add(tf$matmul(layer_1, weights[["h2"]]), biases[["b2"]])
 layer_2 = tf$nn$relu(layer_2)
 # Output layer with linear activation
 out_layer = tf$matmul(layer_2, weights[["out"]]) + biases[["out"]]
 return(out_layer)
}

1. 现在，使用初始化的weights和biases来构建模型：

pred = multilayer_perceptron(x, weights, biases)

1. 下一步是定义神经网络的cost和optimizer函数：

# Define cost and optimizer
cost = tf$reduce_mean(tf$nn$sigmoid_cross_entropy_with_logits(logits=pred, labels=y))
optimizer = tf$train$AdamOptimizer(learning_rate=learning_rate)$minimize(cost)

1. 神经网络使用 Sigmoid 交叉熵作为损失函数进行设置。然后，损失函数传递给一个梯度下降优化器（Adam），学习率为 0.001。在运行优化之前，按如下方式初始化全局变量：

# Initializing the global variables
init = tf$global_variables_initializer()
sess$run(init)

1. 一旦全局变量与损失函数和优化器函数一起初始化完毕，就开始在训练数据集上进行训练：

# Training cycle
for(epoch in 1:training_epochs){
    sess$run(optimizer)
   if (epoch %% 20== 0)
    cat(epoch, "-", sess$run(cost), "n") 
}

它是如何工作的...

可以使用 AUC 评估模型的性能：

# Performance on Train
library(pROC) 
ypred <- sess$run(tf$nn$sigmoid(multilayer_perceptron(x, weights, biases)))
roc_obj <- roc(occupancy_train[, yFeatures], as.numeric(ypred))

# Performance on Test
nRowt<-nrow(occupancy_test)
xt <- tf$constant(unlist(occupancy_test[, xFeatures]), shape=c(nRowt, nFeatures), dtype=np$float32) #
ypredt <- sess$run(tf$nn$sigmoid(multilayer_perceptron(xt, weights, biases)))
roc_objt <- roc(occupancy_test[, yFeatures], as.numeric(ypredt))

可以使用pROC包中的plot.auc函数来可视化 AUC，如下命令执行后显示的图像所示。训练和测试（持出）性能非常相似。

plot.roc(roc_obj, col = "green", lty=2, lwd=2)
plot.roc(roc_objt, add=T, col="red", lty=4, lwd=2)

使用 TensorFlow 的多层感知器性能

还有更多内容...

神经网络基于大脑的哲学；然而，大脑由约 1000 亿个神经元组成，每个神经元与 10000 个其他神经元连接。90 年代初期开发的神经网络由于计算和算法限制，面临着构建更深神经网络的许多挑战。

随着大数据、计算资源（如 GPU）和更好算法的进步，深度学习的概念应运而生，它使我们能够从文本、图像、音频等各种数据中捕捉更深的表示。

• 深度学习的趋势：深度学习是神经网络的进步，深受技术提升的推动。深度学习作为人工智能主流领域发展的主要因素如下：

• 计算能力：摩尔定律的持续性，即硬件的加速能力每两年翻一番，帮助在时间限制内训练更多的层次和更大的数据。

• 存储和更好的压缩算法：由于存储成本降低和更好的压缩算法，存储大模型的能力得到了提升，这推动了该领域的发展，实践者专注于捕捉实时数据流，如图像、文本、音频和视频格式。

• 可扩展性：从简单计算机到农场或使用 GPU 设备的扩展能力大大促进了深度学习模型的训练。

• 深度学习架构： 随着卷积神经网络等新架构的发展，强化学习为我们能够学习的内容提供了推动力，也帮助加速了学习速率。

• 跨平台编程： 在跨平台架构中进行编程和构建模型的能力显著帮助了用户基础的扩大，并在该领域带来了巨大的发展。

• 迁移学习： 这使得可以重用预训练模型，并进一步帮助显著减少训练时间。

第三章：卷积神经网络

本章将涉及以下主题：

• 下载并配置图像数据集

• 学习 CNN 分类器的架构

• 使用函数初始化权重和偏差

• 使用函数创建新的卷积层

• 使用函数将密集连接层展平

• 定义占位符变量

• 创建第一个卷积层

• 创建第二个卷积层

• 展平第二个卷积层

• 创建第一个全连接层

• 对第一个全连接层应用 dropout

• 创建带有 dropout 的第二个全连接层

• 应用 softmax 激活函数以获取预测类别

• 定义用于优化的成本函数

• 执行梯度下降成本优化

• 在 TensorFlow 会话中执行图

• 在测试数据上评估性能

介绍

卷积神经网络 (CNN) 是深度学习神经网络的一类，在构建基于图像识别和自然语言处理的分类模型中发挥着重要作用。

CNN 的架构类似于 LeNet，它主要用于识别数字、邮政编码等字符。与人工神经网络不同，CNN 有按三维空间（宽度、深度、高度）排列的神经元层。每一层将二维图像转换为三维输入体积，接着通过神经元激活将其转换为三维输出体积。

CNN 主要使用三种类型的激活层：卷积层 ReLU、池化层和全连接层。卷积层用于从输入向量（图像）中提取特征（像素之间的空间关系），并在计算与权重（和偏差）的点积后存储它们，以供进一步处理。

修正线性单元 (ReLU) 在卷积操作后应用，以引入非线性。

这是一个逐元素操作（如阈值函数、sigmoid 和 tanh），应用于每一个卷积特征图。然后，池化层（如最大池化、平均池化和求和池化等操作）用于缩减每个特征图的维度，以确保最小的信息丢失。该空间尺寸缩减操作用于控制过拟合，并增强网络对小的扭曲或变换的鲁棒性。池化层的输出随后与传统的多层感知机（也称为全连接层）连接。该感知机使用激活函数，如 softmax 或 SVM，来构建基于分类器的 CNN 模型。

本章中的教程将重点讲解如何使用 R 中的 TensorFlow 构建图像分类的卷积神经网络。虽然这些教程会给你提供典型 CNN 的概览，但我们鼓励你根据自己的需求调整和修改参数。

下载并配置图像数据集

在本章中，我们将使用 CIFAR-10 数据集来构建用于图像分类的卷积神经网络。CIFAR-10 数据集包含 60,000 张 32x32 的彩色图像，涵盖 10 个类别，每个类别有 6,000 张图像。数据集进一步分为五个训练批次和一个测试批次，每个批次包含 10,000 张图像。

测试批次包含每个类别中精确选择的 1,000 张随机图片。训练批次包含剩余的图片，按随机顺序排列，但某些训练批次可能包含某一类别更多的图片。所有训练批次中，每个类别的图片总数为 5,000 张。十个输出类别分别为飞机、汽车、鸟类、猫、鹿、狗、青蛙、马、船和卡车。各类别完全互斥。此外，数据集的格式如下：

• 第一列：包含 10 个类别的标签：飞机、汽车、鸟类、猫、鹿、狗、青蛙、马、船和卡车

• 接下来的 1,024 列：红色像素值范围从 0 到 255

• 接下来的 1,024 列：绿色像素值范围从 0 到 255

• 接下来的 1,024 列：蓝色像素值范围从 0 到 255

准备就绪

对于本食谱，您需要安装一些包的 R 版本，例如data.table和imager。

如何做...

1. 启动 R（使用 Rstudio 或 Docker）并加载所需的包。

2. 手动从www.cs.toronto.edu/~kriz/cifar.html下载数据集（二进制版本），或者使用以下函数在 R 环境中下载数据。该函数以工作目录或下载数据集的位置路径作为输入参数（data_dir）：

# Function to download the binary file
download.cifar.data <- function(data_dir) {
dir.create(data_dir, showWarnings = FALSE)
setwd(data_dir)
if (!file.exists('cifar-10-binary.tar.gz')){
download.file(url='http://www.cs.toronto.edu/~kriz/cifar-10-binary.tar.gz', destfile='cifar-10-binary.tar.gz', method='wget')
untar("cifar-10-binary.tar.gz") # Unzip files
file.remove("cifar-10-binary.tar.gz") # remove zip file
}
setwd("..")
}
# Download the data
download.cifar.data(data_dir="Cifar_10/")

1. 一旦数据集下载并解压（或解压缩），将其作为训练和测试数据集读取到 R 环境中。该函数以训练和测试批次数据集的文件名（filenames）和每个批次文件中要检索的图像数量（num.images）作为输入参数：

# Function to read cifar data
read.cifar.data <- function(filenames,num.images){
images.rgb <- list()
images.lab <- list()
for (f in 1:length(filenames)) {
to.read <- file(paste("Cifar_10/",filenames[f], sep=""), "rb")
for(i in 1:num.images) {
l <- readBin(to.read, integer(), size=1, n=1, endian="big")
r <- as.integer(readBin(to.read, raw(), size=1, n=1024, endian="big"))
g <- as.integer(readBin(to.read, raw(), size=1, n=1024, endian="big"))
b <- as.integer(readBin(to.read, raw(), size=1, n=1024, endian="big"))
index <- num.images * (f-1) + i
images.rgb[[index]] = data.frame(r, g, b)
images.lab[[index]] = l+1
}
close(to.read)
cat("completed :", filenames[f], "\n")
remove(l,r,g,b,f,i,index, to.read)
}
return(list("images.rgb"=images.rgb,"images.lab"=images.lab))
}
# Train dataset
cifar_train <- read.cifar.data(filenames = c("data_batch_1.bin","data_batch_2.bin","data_batch_3.bin","data_batch_4.bin", "data_batch_5.bin"))
images.rgb.train <- cifar_train$images.rgb
images.lab.train <- cifar_train$images.lab
rm(cifar_train)
# Test dataset
cifar_test <- read.cifar.data(filenames = c("test_batch.bin"))
images.rgb.test <- cifar_test$images.rgb
images.lab.test <- cifar_test$images.lab
rm(cifar_test)

1. 前面函数的输出是每张图片的红、绿、蓝像素数据框和它们的标签。然后，使用以下函数将数据展平为两个数据框（一个用于输入，另一个用于输出）的列表，该函数需要两个参数——输入变量列表（x_listdata）和输出变量列表（y_listdata）：

# Function to flatten the data
flat_data <- function(x_listdata,y_listdata){
# Flatten input x variables
x_listdata <- lapply(x_listdata,function(x){unlist(x)})
x_listdata <- do.call(rbind,x_listdata)
# Flatten outcome y variables
y_listdata <- lapply(y_listdata,function(x){a=c(rep(0,10)); a[x]=1; return(a)})
y_listdata <- do.call(rbind,y_listdata)
# Return flattened x and y variables
return(list("images"=x_listdata, "labels"=y_listdata))
}
# Generate flattened train and test datasets
train_data <- flat_data(x_listdata = images.rgb.train, y_listdata = images.lab.train)
test_data <- flat_data(x_listdata = images.rgb.test, y_listdata = images.lab.test)

1. 一旦输入和输出的训练与测试数据框列表准备就绪，通过绘制图像及其标签来执行完整性检查。该函数需要两个必需的参数（index：图片行号和images.rgb：展平的输入数据集）和一个可选参数（images.lab：展平的输出数据集）：

labels <- read.table("Cifar_10/batches.meta.txt")
# function to run sanity check on photos & labels import
drawImage <- function(index, images.rgb, images.lab=NULL) {
require(imager)
# Testing the parsing: Convert each color layer into a matrix,
# combine into an rgb object, and display as a plot
img <- images.rgb[[index]]
img.r.mat <- as.cimg(matrix(img$r, ncol=32, byrow = FALSE))
img.g.mat <- as.cimg(matrix(img$g, ncol=32, byrow = FALSE)
img.b.mat <- as.cimg(matrix(img$b, ncol=32, byrow = FALSE))
img.col.mat <- imappend(list(img.r.mat,img.g.mat,img.b.mat),"c") #Bind the three channels into one image
# Extract the label
if(!is.null(images.lab)){
lab = labels[[1]][images.lab[[index]]]
}
# Plot and output label
plot(img.col.mat,main=paste0(lab,":32x32 size",sep=" "),xaxt="n")
axis(side=1, xaxp=c(10, 50, 4), las=1)
return(list("Image label" =lab,"Image description" =img.col.mat))
}
# Draw a random image along with its label and description from train dataset
drawImage(sample(1:50000, size=1), images.rgb.train, images.lab.train)

1. 现在使用最小-最大标准化技术对输入数据进行转换。可以使用包中的preProcess函数进行归一化。该方法的"range"选项执行最小-最大归一化，过程如下：

# Function to normalize data
Require(caret) 
normalizeObj<-preProcess(train_data$images, method="range") 
train_data$images<-predict(normalizeObj, train_data$images) 
test_data$images <- predict(normalizeObj, test_data$images) 

它是如何工作的...

让我们回顾一下前面步骤中做的事情。在第 2 步中，我们从给定链接下载了 CIFAR-10 数据集，以防该链接或工作目录中没有该数据集。在第 3 步中，解压缩后的文件作为训练集和测试集加载到 R 环境中。训练集包含 50,000 张图像，测试集包含 10,000 张图像及其标签。然后，在第 4 步中，训练集和测试集被展平成包含两个数据框的列表：一个是输入变量（或图像），其长度为 3,072（1,024 个红色，1,024 个绿色，1,024 个蓝色），另一个是输出变量（或标签），长度为 10（每个类别的二进制标签）。在第 5 步中，我们通过生成图表对创建的训练集和测试集进行合理性检查。下图展示了一组六张训练图像及其标签。最后，在第 6 步中，使用最小-最大标准化技术对输入数据进行转换。CIFAR-10 数据集的类别示例如下图所示：

另请参见

《从微小图像中学习多层特征》，Alex Krizhevsky，2009 (www.cs.toronto.edu/~kriz/learning-features-2009-TR.pdf)。这也是本节的参考文献。

学习 CNN 分类器的架构

本章介绍的 CNN 分类器有两个卷积层，后面跟着两个全连接层，其中最后一层使用 softmax 激活函数作为分类器。

准备工作

该教程需要 CIFAR-10 数据集。因此，应该下载 CIFAR-10 数据集并将其加载到 R 环境中。此外，图像的大小为 32 x 32 像素。

怎么做……

让我们按如下方式定义 CNN 分类器的配置：

1. 每个输入图像（CIFAR-10）的大小为 32 x 32 像素，并可以被标记为 10 个类别中的一个：

# CIFAR images are 32 x 32 pixels.
img_width  = 32L
img_height = 32L

# Tuple with height and width of images used to reshape arrays.
img_shape = c(img_width, img_height)
# Number of classes, one class for each of 10 images
num_classes = 10L

1. CIFAR-10 数据集的图像有三个通道（红色、绿色和蓝色）：

# Number of color channels for the images: 3 channel for red, blue, green scales.
num_channels = 3L

1. 图像存储在以下长度的一维数组中（img_size_flat）：

# Images are stored in one-dimensional arrays of length.
img_size_flat = img_width * img_height * num_channels

1. 在第一个卷积层中，卷积滤波器的大小（宽度 x 高度）为 5 x 5 像素（filter_size1），卷积滤波器的深度（或数量）为64（num_filters1）：

# Convolutional Layer 1.
filter_size1 = 5L
num_filters1 = 64L

1. 在第二个卷积层中，卷积滤波器的大小和深度与第一个卷积层相同：

# Convolutional Layer 2.
filter_size2 = 5L
num_filters2 = 64L

1. 类似地，第一个全连接层的输出与第二个全连接层的输入相同：

# Fully-connected layer.
fc_size = 1024L

它是如何工作的……

输入图像的维度和特性分别在步骤 1 和步骤 2 中展示。每个输入图像在卷积层中经过一组滤波器的进一步处理，如步骤 4 和 5 所定义。第一个卷积层生成一组 64 张图像（每个滤波器对应一张图像）。此外，这些图像的分辨率也被减半（因为使用了 2 x 2 最大池化）；即，从 32 x 32 像素变为 16 x 16 像素。

第二卷积层将输入这 64 张图像，并输出新的 64 张图像，分辨率进一步降低。更新后的分辨率为 8 x 8 像素（由于 2 x 2 最大池化）。在第二卷积层中，共创建了 64 x 64 = 4,096 个滤波器，然后它们被进一步卷积为 64 张输出图像（或通道）。请记住，这 64 张 8 x 8 分辨率的图像对应于一个输入图像。

此外，这 64 张 8 x 8 像素的输出图像会被展平为一个长度为 4,096（8 x 8 x 64）的单一向量，如第 3 步中所定义，并作为输入传递给一层全连接神经元，这些神经元在第 6 步中定义。该 4,096 个元素的向量接着被输入到第一个包含 1,024 个神经元的全连接层。输出神经元再次输入到第二个包含 10 个神经元的全连接层（与num_classes相等）。这 10 个神经元代表每个类别标签，然后用来确定图像的（最终）类别。

首先，卷积层和全连接层的权重被随机初始化，直到分类阶段（CNN 图的结束）。在这里，分类误差是基于真实类别和预测类别计算的（也叫做交叉熵）。

然后，优化器通过使用链式法则反向传播误差，通过卷积网络进行传播，之后更新各层（或滤波器）的权重，使得误差最小化。这个包含一次正向传播和反向传播的完整周期被称为一次迭代。进行成千上万次这样的迭代，直到分类误差降到足够低的值。

通常，这些迭代使用一批图像而不是单一图像来执行，以提高计算效率。

以下图像展示了本章设计的卷积网络：

使用函数初始化权重和偏置

权重和偏置是任何深度神经网络优化的重要组成部分，在这里我们定义了一些函数来自动化这些初始化。一个好的做法是用小噪声初始化权重，以打破对称性并防止零梯度。此外，适当的小正偏置将避免神经元不激活，适合 ReLU 激活神经元。

准备开始

权重和偏置是模型系数，需要在模型编译之前初始化。此步骤需要根据输入数据集确定shape参数。

如何操作...

1. 以下函数用于返回随机初始化的权重：

# Weight Initialization
weight_variable <- function(shape) {
initial <- tf$truncated_normal(shape, stddev=0.1)
tf$Variable(initial)
}

1. 以下函数用于返回常量偏置：

bias_variable <- function(shape) {
initial <- tf$constant(0.1, shape=shape)
tf$Variable(initial)
}

它是如何工作的...

这些函数返回 TensorFlow 变量，后续将在 TensorFlow 图中使用。shape定义为一个列表，描述了卷积层中滤波器的属性，接下来会在下一个配方中介绍。权重以标准差为0.1随机初始化，偏置则以常量0.1初始化。

使用函数创建新的卷积层

创建卷积层是 CNN TensorFlow 计算图中的主要步骤。此函数主要用于定义 TensorFlow 图中的数学公式，后续在优化过程中会用到这些公式进行实际计算。

准备工作

输入数据集已定义并加载。配方中呈现的create_conv_layer函数接受以下五个输入参数，并且在设置卷积层时需要定义：

1. Input：这是一个四维张量（或列表），包含多个（输入）图像，每个图像的高度（此处为 32L）、宽度（此处为 32L）以及每个图像的通道数（此处为 3L：红色、蓝色和绿色）。

2. Num_input_channels：这是指在第一个卷积层的情况下颜色通道的数量，或者在后续卷积层的情况下滤波器通道的数量。

3. Filter_size：这是指卷积层中每个滤波器的宽度和高度。这里假设滤波器为正方形。

4. Num_filters：这是指在给定卷积层中滤波器的数量。

5. Use_pooling：这是一个二进制变量，用于执行 2 x 2 的最大池化。

如何操作...

1. 运行以下函数以创建一个新的卷积层：

# Create a new convolution layer
create_conv_layer <- function(input,
num_input_channels,
filter_size,
num_filters,
use_pooling=True)
{
# Shape of the filter-weights for the convolution.
shape1 = shape(filter_size, filter_size, num_input_channels, num_filters)
# Create new weights
weights = weight_variable(shape=shape1)
# Create new biases
biases = bias_variable(shape=shape(num_filters))
# Create the TensorFlow operation for convolution.
layer = tf$nn$conv2d(input=input,
filter=weights,
strides=shape(1L, 1L, 1L ,1L),
padding="SAME")
# Add the biases to the results of the convolution.
layer = layer + biases
# Use pooling (binary flag) to reduce the image resolution
if(use_pooling){
layer = tf$nn$max_pool(value=layer,
ksize=shape(1L, 2L, 2L, 1L),
strides=shape(1L, 2L, 2L, 1L),
padding='SAME')
}
# Add non-linearity using Rectified Linear Unit (ReLU).
layer = tf$nn$relu(layer)
# Retrun resulting layer and updated weights
return(list("layer" = layer, "weights" = weights))
}

1. 运行以下函数以生成卷积层的图：

drawImage_conv <- function(index, images.bw, images.lab=NULL,par_imgs=8) {
require(imager)
img <- images.bw[index,,,]
n_images <- dim(img)[3]
par(mfrow=c(par_imgs,par_imgs), oma=c(0,0,0,0),
mai=c(0.05,0.05,0.05,0.05),ann=FALSE,ask=FALSE)
for(i in 1:n_images){
img.bwmat <- as.cimg(img[,,i])
# Extract the label
if(!is.null(images.lab)){
lab = labels[[1]][images.lab[[index]]]
}
# Plot and output label
plot(img.bwmat,axes=FALSE,ann=FALSE)
}
par(mfrow=c(1,1))
}

1. 运行以下函数以生成卷积层权重的图：

drawImage_conv_weights <- function(weights_conv, par_imgs=8) {
require(imager)
n_images <- dim(weights_conv)[4]
par(mfrow=c(par_imgs,par_imgs), oma=c(0,0,0,0),
mai=c(0.05,0.05,0.05,0.05),ann=FALSE,ask=FALSE)
for(i in 1:n_images){
img.r.mat <- as.cimg(weights_conv[,,1,i])
img.g.mat <- as.cimg(weights_conv[,,2,i])
img.b.mat <- as.cimg(weights_conv[,,3,i])
img.col.mat <- imappend(list(img.r.mat,img.g.mat,img.b.mat),"c") 
#Bind the three channels into one image
# Plot and output label
plot(img.col.mat,axes=FALSE,ann=FALSE)
}
par(mfrow=c(1,1))
}

它是如何工作的...

该函数首先创建一个形状张量；即一个包含四个整数的列表，分别是滤波器的宽度、滤波器的高度、输入通道数和给定滤波器的数量。使用该形状张量，初始化一个具有定义形状的新权重张量，并为每个滤波器创建一个新的（常量）偏置张量。

一旦初始化了必要的权重和偏置，使用tf$nn$conv2d函数创建卷积的 TensorFlow 操作。在我们当前的设置中，所有四个维度的步长都设置为 1，填充设置为SAME。第一和最后一个默认设置为 1，但中间两个可以有更大的步长。步长是指我们允许滤波器矩阵在输入（图像）矩阵上滑动的像素数。

步幅为 3 意味着每次过滤器滑动时，沿x或y轴会跳过三个像素。较小的步幅会产生较大的特征图，从而需要更多的计算来收敛。由于填充设置为SAME，输入（图像）矩阵会在边界周围用零填充，以便我们可以将过滤器应用于输入矩阵的边界元素。利用这个特性，我们可以控制输出矩阵（或特征图）的大小与输入矩阵相同。

在卷积中，偏置值被添加到每个过滤器通道，并通过池化来防止过拟合。在当前设置中，执行 2 x 2 最大池化（使用tf$nn$max_pool）以减少图像分辨率。在这里，我们考虑 2 x 2（ksize*）大小的窗口，并选择每个窗口中的最大值。这些窗口每次按两个像素（strides）沿 x 或 y 方向滑动。

在池化时，我们通过 ReLU 激活函数（tf$nn$relu）向层中添加非线性。在 ReLU 中，每个像素都会在过滤器中被触发，所有负的像素值都会通过max(x,0)函数替换为零，其中x是像素值。通常，ReLU 激活会在池化之前执行。然而，由于我们使用的是最大池化，它对结果的影响并不显著，因为relu(max_pool(x))等同于max_pool(relu(x))。因此，通过在池化后应用 ReLU，我们可以节省大量 ReLU 操作（大约 75%）。

最后，函数返回一个包含卷积层及其对应权重的列表。卷积层是一个四维张量，具有以下属性：

• 输入图像的数量，与input相同

• 每个图像的高度（在 2 x 2 最大池化的情况下减少一半）

• 每个图像的宽度（在 2 x 2 最大池化的情况下减少一半）

• 每个卷积过滤器产生的通道数

使用函数创建新的卷积层

新创建的卷积层的四维结果被扁平化为二维层，以便将其作为输入用于全连接的多层感知机。

准备工作

该配方解释了如何在构建深度学习模型之前扁平化卷积层。给定函数（flatten_conv_layer）的输入是一个四维的卷积层，该层是基于前一层定义的。

如何操作……

1. 运行以下函数以扁平化卷积层：

flatten_conv_layer <- function(layer){
# Extract the shape of the input layer
layer_shape = layer$get_shape()
# Calculate the number of features as img_height * img_width * num_channels
num_features = prod(c(layer_shape$as_list()[[2]],layer_shape$as_list()[[3]],layer_shape$as_list()[[4]]))
# Reshape the layer to [num_images, num_features].
layer_flat = tf$reshape(layer, shape(-1, num_features))
# Return both the flattened layer and the number of features.
return(list("layer_flat"=layer_flat, "num_features"=num_features))
}

它是如何工作的……

该函数首先提取给定输入层的形状。如前述配方所述，输入层的形状由四个整数组成：图像数量、图像高度、图像宽度以及图像的颜色通道数。然后，通过图像高度、图像宽度和颜色通道数的点积计算特征数量（num_features）。

然后，该层被扁平化或调整为二维张量（使用tf$reshape）。第一维设置为-1（等于图像总数），第二维是特征数。

最后，函数返回一个包含扁平化层及输入特征总数的列表。

使用函数扁平化密集连接层

CNN 通常以一个全连接的多层感知机结束，在输出层使用 softmax 激活函数。在这里，前一卷积扁平化层中的每个神经元都与下一层（全连接层）中的每个神经元相连。

全卷积层的主要目的是利用卷积和池化阶段生成的特征，将给定的输入图像分类为不同的输出类别（这里是 10L）。它还有助于学习这些特征的非线性组合，从而定义输出类别。

在本章中，我们使用两个全连接层进行优化。这个函数主要用于定义张量流图中的数学公式，随后在优化过程中实际计算时使用。

准备就绪

(create_fc_layer)函数接收四个输入参数，具体如下：

• Input：这类似于新卷积层函数的输入。

• Num_inputs：这是在扁平化卷积层后生成的输入特征数量。

• Num_outputs：这是与输入神经元完全连接的输出神经元数量。

• Use_relu：这是一个二进制标志，只有在最终全连接层时设置为FALSE。

如何实现...

1. 运行以下函数以创建新的全连接层：

# Create a new fully connected layer
create_fc_layer <- function(input,
num_inputs,
num_outputs,
use_relu=True)
{
# Create new weights and biases.
weights = weight_variable(shape=shape(num_inputs, num_outputs))
biases = bias_variable(shape=shape(num_outputs))
# Perform matrix multiplication of input layer with weights and then add biases
layer = tf$matmul(input, weights) + biases
# Use ReLU?
if(use_relu){
layer = tf$nn$relu(layer)
}
return(layer)
}

它是如何工作的...

函数从初始化新的权重和偏置开始。然后，对输入层与初始化的权重进行矩阵乘法，并添加相关偏置。

如果全连接层不是 CNN 张量流图中的最终层，则可以执行 ReLU 非线性激活。最后，返回全连接层。

定义占位符变量

在这个配方中，让我们定义作为张量流计算图模块输入的占位符变量。这些通常是多维数组或矩阵，呈现为张量的形式。

准备就绪

占位符变量的数据类型设置为 float32（tf$float32），形状设置为二维张量。

如何实现...

1. 创建一个输入占位符变量：

x = tf$placeholder(tf$float32, shape=shape(NULL, img_size_flat), name='x')

占位符中的 NULL 值允许我们传递非确定性数组的大小。

1. 将输入占位符x重新调整为四维张量：

x_image = tf$reshape(x, shape(-1L, img_size, img_size, num_channels))

1. 创建一个输出占位符变量：

y_true = tf$placeholder(tf$float32, shape=shape(NULL, num_classes), name='y_true')

1. 使用 argmax 获取输出的（true）类别：

y_true_cls = tf$argmax(y_true, dimension=1L)

它是如何工作的...

在步骤 1 中，我们定义了一个输入占位符变量。形状张量的维度是 NULL 和 img_size_flat。前者用于存储任意数量的图像（作为行），后者定义了每张图像的输入特征长度（作为列）。在步骤 2 中，输入的二维张量被重塑成一个四维张量，作为卷积层的输入。四个维度如下：

• 第一项定义了输入图像的数量（当前设置为 -1）

• 第二项定义了每张图像的高度（相当于图像大小 32L）

• 第三项定义了每张图像的宽度（相当于图像大小，这里是 32L）

• 第四项定义了每张图像的颜色通道数（这里是 3L）

在步骤 3 中，我们定义了一个输出占位符变量，用于保存 x 中图像的真实类别或标签。形状张量的维度是 NULL 和 num_classes。前者用于存储任意数量的图像（作为行），后者定义了每张图像的真实类别作为一个长度为 num_classes 的二进制向量（作为列）。在我们的场景中，有 10 个类别。步骤 4 中，我们将二维输出占位符压缩成一个一维的类别编号张量，类别编号范围从 1 到 10。

创建第一个卷积层

在这个食谱中，我们来创建第一个卷积层。

准备就绪

以下是食谱 使用函数创建新的卷积层 中定义的函数 create_conv_layer 的输入：

• Input：这是一个四维的重塑输入占位符变量：x_image

• Num_input_channels：这是颜色通道的数量，也就是 num_channels

• Filter_size：这是过滤层的高度和宽度 filter_size1

• Num_filters：这是过滤层的深度，也就是 num_filters1

• Use_pooling：这是一个设置为 TRUE 的二进制标志

如何操作...

1. 运行 create_conv_layer 函数，使用前面的输入参数：

# Convolutional Layer 1
conv1 <- create_conv_layer(input=x_image,
num_input_channels=num_channels,
filter_size=filter_size1,
num_filters=num_filters1,
use_pooling=TRUE)

1. 提取第一个卷积层的 layers：

layer_conv1 <- conv1$layer
conv1_images <- conv1$layer$eval(feed_dict = dict(x = train_data$images, y_true = train_data$labels))

1. 提取第一个卷积层的最终 weights：

weights_conv1 <- conv1$weights
weights_conv1 <- weights_conv1$eval(session=sess)

1. 生成第一个卷积层的图：

drawImage_conv(sample(1:50000, size=1), images.bw = conv1_images, images.lab=images.lab.train)

1. 生成第一个卷积层的权重图：

drawImage_conv_weights(weights_conv1)

它是如何工作的...

在步骤 1 和 2 中，我们创建了一个四维的第一个卷积层。第一维（?）表示输入图像的数量，第二和第三维分别表示每个卷积图像的高度（16 像素）和宽度（16 像素），第四维表示产生的通道数（64）——每个卷积过滤器对应一个通道。在步骤 3 和 5 中，我们提取卷积层的最终权重，如下截图所示：

在步骤 4 中，我们绘制第一个卷积层的输出，如下截图所示：

创建第二个卷积层

在这个食谱中，我们来创建第二个卷积层。

准备就绪

以下是食谱《使用函数创建新的卷积层》中定义的函数输入create_conv_layer：

• Input：这是第一个卷积层的四维输出；即layer_conv1

• Num_input_channels：这是第一个卷积层中的滤波器数量（或深度），num_filters1

• Filter_size：这是滤波器层的高度和宽度；即filter_size2

• Num_filters：这是滤波器层的深度，num_filters2

• Use_pooling：这是设置为TRUE的二进制标志

操作方法...

1. 使用前述输入参数运行create_conv_layer函数：

# Convolutional Layer 2
conv2 <- create_conv_layer(input=layer_conv1,
num_input_channels=num_filters1,
filter_size=filter_size2,
num_filters=num_filters2,
use_pooling=TRUE)

1. 提取第二个卷积层的层：

layer_conv2 <- conv2$layer
conv2_images <- conv2$layer$eval(feed_dict = dict(x = train_data$images, y_true = train_data$labels))

1. 提取第二卷积层的最终权重：

weights_conv2 <- conv2$weights
weights_conv2 <- weights_conv2$eval(session=sess)

1. 生成第二卷积层的图：

drawImage_conv(sample(1:50000, size=1), images.bw = conv2_images, images.lab=images.lab.train)

1. 生成第二卷积层权重图：

drawImage_conv_weights(weights_conv2)

工作原理...

在第 1 步和第 2 步中，我们创建一个四维的第二卷积层。第一维（?）表示任意数量的输入图像，第二和第三维表示每个卷积图像的高度（8 像素）和宽度（8 像素），第四维表示每个卷积滤波器产生的通道数（64）。

在第 3 步和第 5 步中，我们提取卷积层的最终权重，如下图所示：

在第 4 步中，我们绘制第二个卷积层的输出，如下图所示：

展平第二个卷积层

在本食谱中，我们将展平我们创建的第二个卷积层。

准备工作

以下是食谱《创建第二个卷积层》中定义的函数输入，flatten_conv_layer：

• Layer：这是第二个卷积层的输出，layer_conv2

操作方法...

1. 使用前述输入参数运行flatten_conv_layer函数：

flatten_lay <- flatten_conv_layer(layer_conv2)

1. 提取展平层：

layer_flat <- flatten_lay$layer_flat

1. 提取每个图像生成的（输入）特征数量：

num_features <- flatten_lay$num_features

工作原理...

在将（第二）卷积层的输出与全连接网络连接之前，在第 1 步中，我们将四维卷积层重塑为二维张量。第一维（?）表示任意数量的输入图像（作为行），第二维表示为每个图像生成的展平特征向量，长度为 4,096；即 8 x 8 x 64（作为列）。第 2 步和第 3 步验证重塑后层和输入特征的维度。

创建第一个全连接层

在本食谱中，我们将创建第一个全连接层。

准备工作

以下是食谱《使用函数展平密集连接层》中定义的函数输入，create_fc_layer：

• Input：这是展平后的卷积层；即layer_flat

• Num_inputs：这是在展平之后生成的特征数量，num_features

• Num_outputs：这是全连接神经元的输出数量，fc_size

• Use_relu：这是一个二进制标志，设置为 TRUE 以在张量中引入非线性

如何操作...

1. 使用前面的输入参数运行 create_fc_layer 函数：

layer_fc1 = create_fc_layer(input=layer_flat,
num_inputs=num_features,
num_outputs=fc_size,
use_relu=TRUE)

它是如何工作的...

在这里，我们创建一个全连接层，该层返回一个二维张量。第一维（？）表示任意数量的（输入）图像，第二维表示输出神经元的数量（这里是 1,024）。

将 dropout 应用到第一个全连接层

在本食谱中，我们将应用 dropout 到全连接层的输出，以减少过拟合的可能性。dropout 步骤包括在学习过程中随机去除一些神经元。

准备就绪

dropout 连接到层的输出。因此，模型的初始结构已设置并加载。例如，在 dropout 当前层 layer_fc1 中定义了 dropout 并应用于此层。

如何操作...

1. 创建一个占位符用于 dropout，可以接收概率作为输入：

keep_prob <- tf$placeholder(tf$float32)

1. 使用 TensorFlow 的 dropout 函数来处理神经元输出的缩放和屏蔽：

layer_fc1_drop <- tf$nn$dropout(layer_fc1, keep_prob)

它是如何工作的...

在步骤 1 和步骤 2 中，我们可以根据输入的概率（或百分比）丢弃（或屏蔽）输出神经元。dropout 通常在训练期间允许，并且在测试期间可以关闭（通过将概率设置为 1 或 NULL）。

创建第二个全连接层并加入 dropout

在本食谱中，我们将创建第二个全连接层并加入 dropout。

准备就绪

以下是函数 使用函数来展开全连接层 中定义的输入参数，create_fc_layer：

• Input：这是第一个全连接层的输出，即 layer_fc1

• Num_inputs：这是第一个全连接层输出的特征数量，fc_size

• Num_outputs：这是全连接神经元输出的数量（等于标签的数量，num_classes）

• Use_relu：这是一个二进制标志，设置为 FALSE

如何操作...

1. 使用前面的输入参数运行 create_fc_layer 函数：

layer_fc2 = create_fc_layer(input=layer_fc1_drop,
num_inputs=fc_size,
num_outputs=num_classes,
use_relu=FALSE)

1. 使用 TensorFlow 的 dropout 函数来处理神经元输出的缩放和屏蔽：

layer_fc2_drop <- tf$nn$dropout(layer_fc2, keep_prob)

它是如何工作的...

在步骤 1 中，我们创建一个全连接层，返回一个二维张量。第一维（？）表示任意数量的（输入）图像，第二维表示输出神经元的数量（这里是 10 个类别标签）。在步骤 2 中，我们提供了一个选项用于 dropout，主要在网络训练过程中使用。

应用 softmax 激活函数来获得预测类别

在本食谱中，我们将使用 softmax 激活函数规范化第二个全连接层的输出，使得每个类别的（概率）值限制在 0 和 1 之间，且所有 10 个类别的值加起来为 1。

准备就绪

激活函数应用于深度学习模型生成的预测结果的管道末端。在执行此步骤之前，管道中的所有步骤需要执行完毕。该配方需要 TensorFlow 库。

如何做...

1. 在第二个全连接层的输出上运行 softmax 激活函数：

y_pred = tf$nn$softmax(layer_fc2_drop)

1. 使用 argmax 函数确定标签的类别编号。它是具有最大（概率）值的类别的索引：

y_pred_cls = tf$argmax(y_pred, dimension=1L)

定义用于优化的损失函数

损失函数主要用于通过将真实类别标签（y_true_cls）与预测类别标签（y_pred_cls）进行比较，评估模型的当前性能。基于当前的性能，优化器会进一步调整网络参数，例如权重和偏置，从而提升模型的性能。

做好准备

损失函数的定义至关重要，因为它决定了优化的标准。损失函数定义需要真实类别和预测类别进行比较。本例中使用的目标函数是交叉熵，适用于多分类问题。

如何做...

1. 使用交叉熵函数在 TensorFlow 中评估每张图像的当前性能。由于 TensorFlow 中的交叉熵函数内部应用了 softmax 正则化，我们将全连接层丢弃后的输出（layer_fc2_drop）与真实标签（y_true）一起作为输入：

cross_entropy = tf$nn$softmax_cross_entropy_with_logits(logits=layer_fc2_drop, labels=y_true)

在当前的损失函数中，softmax 激活函数已经嵌入，因此不需要单独定义激活函数。

1. 计算交叉熵的平均值，并使用优化器将其最小化：

cost = tf$reduce_mean(cross_entropy)

它是如何工作的...

在步骤 1 中，我们定义了一个交叉熵函数来评估分类的性能。根据真实标签和预测标签之间的准确匹配，交叉熵函数返回一个正值，并遵循连续分布。因为零交叉熵确保完全匹配，优化器通常通过更新网络参数（如权重和偏置）将交叉熵最小化至零。交叉熵函数为每个单独的图像返回一个值，该值需要进一步压缩成一个标量值，供优化器使用。因此，在步骤 2 中，我们计算交叉熵输出的简单平均值，并将其存储为 cost。

执行梯度下降成本优化

在本例中，我们定义一个能够最小化成本的优化器。优化后，检查 CNN 的性能。

做好准备

优化器定义需要定义 cost 配方，因为它作为输入传递给优化器。

如何做...

1. 使用目标是最小化给定 learning_rate 的成本的 Adam 优化器：

optimizer = tf$train$AdamOptimizer(learning_rate=1e-4)$minimize(cost)

1. 提取 correct_predictions 的数量，并计算平均准确率：

correct_prediction = tf$equal(y_pred_cls, y_true_cls)
accuracy = tf$reduce_mean(tf$cast(correct_prediction, tf$float32))

在 TensorFlow 会话中执行图

到目前为止，我们只创建了张量对象并将它们添加到 TensorFlow 图中以供后续执行。在这个例子中，我们将学习如何创建一个可以用来执行（或运行）TensorFlow 图的 TensorFlow 会话。

准备工作

在运行图之前，我们应该已经在 R 中安装并加载了 TensorFlow。安装详细信息可以在第一章中找到，入门。

如何操作...

1. 加载tensorflow库并导入numpy包：

library(tensorflow)
np <- import("numpy")

1. 重置或移除任何现有的default_graph：

tf$reset_default_graph()

1. 启动InteractiveSession：

sess <- tf$InteractiveSession()

1. 初始化global_variables：

sess$run(tf$global_variables_initializer())

1. 运行迭代以执行优化（training）：

# Train the model
train_batch_size = 128L
for (i in 1:100) {
spls <- sample(1:dim(train_data$images)[1],train_batch_size)
if (i %% 10 == 0) {
train_accuracy <- accuracy$eval(feed_dict = dict(
x = train_data$images[spls,], y_true = train_data$labels[spls,], keep_prob = 1.0))
cat(sprintf("step %d, training accuracy %g\n", i, train_accuracy))
}
optimizer$run(feed_dict = dict(
x = train_data$images[spls,], y_true = train_data$labels[spls,], keep_prob = 0.5))
}

1. 评估训练模型在测试数据上的表现：

# Test the model
test_accuracy <- accuracy$eval(feed_dict = dict(
x = test_data$images, y_true = test_data$labels, keep_prob = 1.0))
cat(sprintf("test accuracy %g", test_accuracy))

它是如何工作的...

步骤 1 至 4 在某种程度上是启动一个新 TensorFlow 会话的默认方式。在第 4 步中，权重和偏置的变量会被初始化，这是它们优化之前的必要步骤。第 5 步主要是执行 TensorFlow 会话进行优化。由于我们有大量的训练图像，计算所有图像的最优梯度变得非常困难（计算上）。

因此，每次迭代时，选择 128 张小的随机样本来训练激活层（权重和偏置）。在当前设置中，我们运行 100 次迭代，并在每十次迭代后报告训练准确度。

然而，这些值可以根据集群配置或计算能力（CPU 或 GPU）增加，以提高模型准确性。此外，每次迭代使用 50%的 dropout 率来训练 CNN。在第 6 步中，我们可以评估训练模型在 10,000 张测试图像上的表现。

在测试数据上的性能评估

在这个例子中，我们将使用混淆矩阵和图表来查看训练后的 CNN 在测试图像上的表现。

准备工作

绘图的先决条件包是imager和ggplot2。

如何操作...

1. 获取测试图像的实际或真实类别标签：

test_true_class <- c(unlist(images.lab.test))

1. 获取测试图像的预测类别标签。记得给每个类别标签加1，因为 TensorFlow（与 Python 相同）的起始索引是 0，而 R 是1：

test_pred_class <- y_pred_cls$eval(feed_dict = dict(
x = test_data$images, y_true = test_data$labels, keep_prob = 1.0))
test_pred_class <- test_pred_class + 1

1. 生成混淆矩阵，行是实际标签，列是预测标签：

table(actual = test_true_class, predicted = test_pred_class)

1. 生成confusion矩阵的图：

confusion <- as.data.frame(table(actual = test_true_class, predicted = test_pred_class))
plot <- ggplot(confusion)
plot + geom_tile(aes(x=actual, y=predicted, fill=Freq)) + scale_x_discrete(name="Actual Class") + scale_y_discrete(name="Predicted Class") + scale_fill_gradient(breaks=seq(from=-.5, to=4, by=.2)) + labs(fill="Normalized\nFrequency")

1. 运行一个辅助函数来绘制图像：

check.image <- function(images.rgb,index,true_lab, pred_lab) {
require(imager)
# Testing the parsing: Convert each color layer into a matrix,
# combine into an rgb object, and display as a plot
img <- images.rgb[[index]]
img.r.mat <- as.cimg(matrix(img$r, ncol=32, byrow = FALSE))
img.g.mat <- as.cimg(matrix(img$g, ncol=32, byrow = FALSE))
img.b.mat <- as.cimg(matrix(img$b, ncol=32, byrow = FALSE))
img.col.mat <- imappend(list(img.r.mat,img.g.mat,img.b.mat),"c")
# Plot with actual and predicted label
plot(img.col.mat,main=paste0("True: ", true_lab,":: Pred: ",
pred_lab),xaxt="n")
axis(side=1, xaxp=c(10, 50, 4), las=1)
}

1. 绘制随机分类错误的测试图像：

labels <- c("airplane","automobile","bird","cat","deer","dog","frog","horse","ship","truck")
# Plot misclassified test images
plot.misclass.images <- function(images.rgb, y_actual, y_predicted,labels){
# Get indices of misclassified
indices <- which(!(y_actual == y_predicted))
id <- sample(indices,1)
# plot the image with true and predicted class
true_lab <- labels[y_actual[id]]
pred_lab <- labels[y_predicted[id]]
check.image(images.rgb,index=id, true_lab=true_lab,pred_lab=pred_lab)
}
plot.misclass.images(images.rgb=images.rgb.test,y_actual=test_true_class,y_predicted=test_pred_class,labels=labels)

它是如何工作的...

在步骤 1 至 3 中，我们提取了真实的和预测的测试类别标签，并创建了混淆矩阵。下图展示了当前测试预测的混淆矩阵：

700 次训练迭代后的测试准确率仅为约 51%，可以通过增加迭代次数、增加批量大小、配置层参数（使用了 2 个卷积层）、激活函数类型（使用了 ReLU）、全连接层数量（使用了两个）、优化目标函数（使用了准确率）、池化（使用了最大 2 x 2）、丢弃概率等进一步提高。

第 4 步用于构建测试混淆矩阵的分面图，如下面的截图所示：

在第 5 步中，我们定义了一个辅助函数来绘制图像，标题中包含真实类和预测类。check.image 函数的输入参数是（test）扁平化输入数据集（images.rgb）、图像编号（index）、真实标签（true_lab*）、*和预测标签（pred_lab）。这里，红色、绿色和蓝色像素首先被解析出来，转换为矩阵，作为列表附加，并使用 plot 函数显示为图像。

在第 6 步中，我们使用第 5 步的辅助函数绘制误分类的测试图像。plot.misclass.images 函数的输入参数是（test）扁平化输入数据集（images.rgb）、真实标签的向量（y_actual）、预测标签的向量（y_predicted）和唯一有序字符标签的向量（labels）。在这里，获取误分类图像的索引，并随机选择一个索引生成绘图。以下截图显示了一组六个误分类图像及其真实和预测标签：

第四章：使用自编码器的数据表示

本章将介绍自编码器的无监督深度学习应用。我们将覆盖以下主题：

• 设置自编码器

• 数据归一化

• 设置正则化自编码器

• 微调自编码器的参数

• 设置堆叠自编码器

• 设置去噪自编码器

• 构建和比较随机编码器和解码器

• 从自编码器学习流形

• 评估稀疏分解

介绍

神经网络旨在找到输入X与输出y之间的非线性关系，即y=f(x)。自编码器是一种无监督神经网络，试图找到空间中特征之间的关系，使得h=f(x)，帮助我们学习输入空间之间的关系，可用于数据压缩、降维和特征学习。

自编码器由编码器和解码器组成。编码器帮助将输入x编码为潜在表示y，而解码器则将y转换回x。编码器和解码器具有相似的形式表示。

下面是单层自编码器的表示：

编码器将输入X编码为H，并通过隐藏层处理，而解码器则帮助从编码输出H恢复原始数据。矩阵W[e]和W[d]分别表示编码器和解码器层的权重。函数f是激活函数。

以下是自编码器的示意图：

以节点形式的约束使自编码器能够发现数据中的有趣结构。例如，在前面的图中，编码器的五个输入数据集必须经过三个节点的压缩才能得到编码值h。编码输出层的维度可以与输入/输出解码输出层相同、较低或较高。输入层节点数少于编码层的编码输出层称为欠完备表示，可以视为将数据压缩成低维表示。

编码输出层具有较多输入层的情况称为过完备表示，并在稀疏自编码器中作为正则化策略使用。自编码器的目标是找到y，捕捉数据变化的主要因素，这与**主成分分析（PCA）**类似，因此也可以用于压缩。

设置自编码器

存在多种不同架构的自编码器，这些架构通过使用不同的代价函数来捕捉数据表示。最基本的自编码器被称为香草自编码器（vanilla autoencoder）。它是一个包含两个层的神经网络，其中隐藏层的节点数与输入层和输出层相同，目标是最小化代价函数。常用的（但不限于）损失函数包括回归问题中的均方误差(MSE)和分类问题中的交叉熵。当前方法可以轻松扩展到多个层次，这种扩展被称为多层自编码器。

节点数量在自编码器中起着至关重要的作用。如果隐藏层中的节点数少于输入层的节点数，那么该自编码器被称为欠完备自编码器。隐藏层中节点数较多则表示过完备自编码器或稀疏自编码器。

稀疏自编码器旨在对隐藏层施加稀疏性。这种稀疏性可以通过在隐藏层引入比输入层更多的节点，或者通过在损失函数中引入惩罚来实现，从而使隐藏层的权重趋向于零。有些自编码器通过手动将节点的权重置为零来实现稀疏性，这些被称为K-稀疏自编码器。我们将在第一章《入门指南》中讨论的Occupancy数据集上设置自编码器。当前示例的隐藏层可以进行调整。

准备就绪

让我们使用Occupancy数据集来设置自编码器：

• 下载Occupancy数据集，如第一章《入门指南》中所述。

• 在 R 和 Python 中安装 TensorFlow

如何操作...

当前的Occupancy数据集，如第一章《入门指南》中所述，用于演示如何在 R 中使用 TensorFlow 设置自编码器：

1. 设置 R TensorFlow 环境。

2. load_occupancy_data函数可以通过使用setwd设置正确的工作目录路径来加载数据：

# Function to load Occupancy data
load_occupancy_data<-function(train){
xFeatures = c("Temperature", "Humidity", "Light", "CO2",
  "HumidityRatio")
yFeatures = "Occupancy"
  if(train){
    occupancy_ds <-  as.matrix(read.csv("datatraining.txt",stringsAsFactors = T))
  } else
  {
    occupancy_ds <- as.matrix(read.csv("datatest.txt",stringsAsFactors = T))
  }
  occupancy_ds<-apply(occupancy_ds[, c(xFeatures, yFeatures)], 2, FUN=as.numeric) 
  return(occupancy_ds)
}

1. 可以使用以下脚本将训练和测试的Occupancy数据集加载到 R 环境中：

occupancy_train <-load_occupancy_data(train=T)
occupancy_test <- load_occupancy_data(train = F)

数据归一化

数据归一化是机器学习中的一个关键步骤，用于将数据转换为相似的尺度。它也称为特征缩放，通常作为数据预处理的一部分进行。

正确的归一化对于神经网络至关重要，否则它会导致隐藏层的饱和，从而导致梯度为零，无法进行学习。

准备就绪

有多种方式可以执行归一化：

• 最小-最大标准化：最小-最大标准化保持原始分布，并将特征值缩放到*【0, 1】之间，其中0*为特征的最小值，1为最大值。标准化的过程如下：

这里，x' 是特征的归一化值。该方法对数据集中的异常值较为敏感。

• 十进制缩放：这种缩放形式用于存在不同十进制范围值的情况。例如，两个具有不同边界的特征可以通过如下方式使用十进制缩放将其带到相似的尺度：

x'=x/10^n

• Z-得分：这种转换将值缩放到具有零均值和单位方差的正态分布。Z-得分计算公式为：

Z=(x-µ)/σ

这里，µ 是均值，σ 是特征的标准差。这些分布对具有高斯分布的数据集非常有效。

所有前述方法对异常值敏感；你可以探索其他更稳健的归一化方法，例如中位数绝对偏差 (MAD)、tanh 估计器和双重 sigmoid。

数据集分布的可视化

我们来看看职业数据的特征分布：

> ggpairs(occupancy_train$data[, occupancy_train$xFeatures])

图表显示特征具有线性相关性，并且分布是非正态的。可以通过使用 Shapiro-Wilk 测试进一步验证非正态性，使用 R 中的 shapiro.test 函数。我们将对职业数据使用最小-最大标准化。

如何操作...

1. 执行以下操作以进行数据归一化：

minmax.normalize<-function(ds, scaler=NULL){
  if(is.null(scaler)){
    for(f in ds$xFeatures){
      scaler[[f]]$minval<-min(ds$data[,f])
      scaler[[f]]$maxval<-max(ds$data[,f])
      ds$data[,f]<-(ds$data[,f]-scaler[[f]]$minval)/(scaler[[f]]$maxval-scaler[[f]]$minval)
    }
    ds$scaler<-scaler
  } else
  {
    for(f in ds$xFeatures){
      ds$data[,f]<-(ds$data[,f]-scaler[[f]]$minval)/(scaler[[f]]$maxval-scaler[[f]]$minval)
    }
  }
  return(ds)
}

1. minmax.normalize 函数使用最小-最大标准化对数据进行归一化。当 scaler 变量为 NULL 时，它使用提供的数据集进行归一化，或者使用 scaler 的值进行归一化。归一化后的数据对图如下面的图所示：

此图显示了最小-最大归一化将值限制在 [0, 1] 范围内，并且没有改变特征之间的分布和相关性。

如何设置自编码器模型

下一步是设置自编码器模型。让我们使用 TensorFlow 设置一个基础的自编码器：

1. 重置 graph 并启动 InteractiveSession：

# Reset the graph and set-up a interactive session
tf$reset_default_graph()
sess<-tf$InteractiveSession()

1. 定义输入参数，其中 n 和 m 分别是样本数和特征数。为了构建网络，m 用来设置输入参数：

# Network Parameters
n_hidden_1 = 5 # 1st layer num features
n_input = length(xFeatures) # Number of input features
nRow<-nrow(occupancy_train)

当 n_hidden_1 很低时，自编码器会压缩数据，称为欠完备自编码器；而当 n_hidden_1 很大时，自编码器则是稀疏的，称为过完备自编码器。

1. 定义包括输入张量和编码器、解码器层定义的图输入参数：

# Define input feature
x <- tf$constant(unlist(occupancy_train[, xFeatures]), shape=c(nRow, n_input), dtype=np$float32) 

# Define hidden and bias layer for encoder and decoders
hiddenLayerEncoder<-tf$Variable(tf$random_normal(shape(n_input, n_hidden_1)), dtype=np$float32)
biasEncoder <- tf$Variable(tf$zeros(shape(n_hidden_1)), dtype=np$float32)
hiddenLayerDecoder<-tf$Variable(tf$random_normal(shape(n_hidden_1, n_input)))
biasDecoder <- tf$Variable(tf$zeros(shape(n_input)))

前述脚本设计了一个单层编码器和解码器。

1. 定义一个函数来评估响应：

auto_encoder<-function(x, hiddenLayerEncoder, biasEncoder){
  x_transform <- tf$nn$sigmoid(tf$add(tf$matmul(x, hiddenLayerEncoder), biasEncoder))
  x_transform
}

auto_encoder 函数接收节点偏置权重并计算输出。通过传递相应的权重，可以使用相同的函数来处理 encoder 和 decoder。

1. 通过传递符号化的 TensorFlow 变量创建 encoder 和 decoder 对象：

encoder_obj = auto_encoder(x,hiddenLayerEncoder, biasEncoder)
y_pred = auto_encoder(encoder_obj, hiddenLayerDecoder, biasDecoder)

1. y_pred 是来自 decoder 的输出，它将 encoder 对象作为输入，包含节点和偏置权重：

Define loss function and optimizer module. 
learning_rate = 0.01
cost = tf$reduce_mean(tf$pow(x - y_pred, 2))
optimizer = tf$train$RMSPropOptimizer(learning_rate)$minimize(cost)

上述脚本将均方误差定义为成本函数，并使用 TensorFlow 中的RMSPropOptimizer，学习率为 0.1，来优化权重。上述模型的 TensorFlow 图如下所示：

运行优化

下一步是执行优化器优化。执行此过程的 TensorFlow 步骤包括两部分：

1. 第一步是对图中定义的变量进行参数初始化。初始化通过调用 TensorFlow 中的global_variables_initializer函数来完成：

# Initializing the variables
init = tf$global_variables_initializer()
sess$run(init)

优化是基于优化和监控训练和测试性能进行的：

costconvergence<-NULL
for (step in 1:1000) {
  sess$run(optimizer)
  if (step %% 20==0){
    costconvergence<-rbind(costconvergence, c(step, sess$run(cost), sess$run(costt)))
    cat(step, "-", "Traing Cost ==>", sess$run(cost), "\n")
  }
}

1. 可以观察训练和测试中的成本函数，以了解模型的收敛情况，如下图所示：

costconvergence<-data.frame(costconvergence)
colnames(costconvergence)<-c("iter", "train", "test")
plot(costconvergence[, "iter"], costconvergence[, "train"], type = "l", col="blue", xlab = "Iteration", ylab = "MSE")
lines(costconvergence[, "iter"], costconvergence[, "test"], col="red")
legend(500,0.25, c("Train","Test"), lty=c(1,1), lwd=c(2.5,2.5),col=c("blue","red"))

该图显示，模型的主要收敛发生在大约400次迭代时；然而，即使经过1,000次迭代后，收敛速度依然很慢。该模型在训练数据集和保留测试数据集中都很稳定。

设置正则化自编码器

正则化自编码器通过在cost函数中添加正则化参数来扩展标准自编码器。

准备工作

正则化自编码器是标准自编码器的扩展。设置将需要：

1. 在 R 和 Python 中的 TensorFlow 安装。

2. 标准自编码器的实现。

如何操作...

自编码器的代码设置可以通过将成本定义替换为以下几行，直接转换为正则化自编码器：

Lambda=0.01
cost = tf$reduce_mean(tf$pow(x - y_pred, 2))
Regularize_weights = tf$nn$l2_loss(weights)
cost = tf$reduce_mean(cost + lambda * Regularize_weights)

它是如何工作的...

如前所述，正则化自编码器通过在成本函数中添加正则化参数来扩展标准自编码器，如下所示：

这里，λ是正则化参数，i和j是节点索引，W表示自编码器的隐藏层权重。正则化自编码器的目的是确保更强大的编码，并偏好低权重h函数。这个概念进一步被用于开发收缩自编码器，它利用输入上雅可比矩阵的 Frobenius 范数，表示如下：

其中**J(x)**是雅可比矩阵，计算方法如下：

对于线性编码器，收缩编码器和正则化编码器收敛到 L2 权重衰减。正则化有助于使自编码器对输入的敏感度降低；然而，成本函数的最小化帮助模型捕捉变化，并保持对高密度流形的敏感性。这些自编码器也被称为收缩自编码器。

微调自编码器的参数

自编码器涉及一些需要调整的参数，这取决于我们所使用的自编码器类型。自编码器中的主要参数包括：

• 任何隐藏层中的节点数量

• 适用于深度自编码器的隐藏层数量

• 激活单元，例如 sigmoid、tanh、softmax 和 ReLU 激活函数

• 隐藏单元权重上的正则化参数或权重衰减项

• 在去噪自编码器中，信号损坏的比例

• 稀疏自编码器中的稀疏性参数，用于控制隐藏层中神经元的期望激活值

• 如果使用批量梯度下降学习，批次大小；如果使用随机梯度下降，学习率和动量参数

• 训练时使用的最大迭代次数

• 权重初始化

• 如果使用了 dropout，进行 dropout 正则化

这些超参数可以通过将问题设定为网格搜索问题来训练。然而，每个超参数组合都需要训练隐藏层的神经元权重，这导致随着层数和每层节点数的增加，计算复杂性也会增加。为了解决这些关键参数和训练问题，提出了堆叠自编码器概念，它逐层训练每一层，以获取预训练权重，然后使用获得的权重对模型进行微调。这种方法大大提高了训练性能，相比传统的训练方式。

设置堆叠自编码器

堆叠自编码器是一种训练深度网络的方法，包含多个层，使用贪婪算法逐层训练。下面的图示展示了堆叠自编码器的一个示例：

堆叠自编码器的示例

准备就绪

前面的图示展示了一个具有两层的堆叠自编码器。堆叠自编码器可以有n层，其中每一层是逐层训练的。例如，前一层的训练过程如下：

堆叠自编码器的训练

第 1 层的初步训练是通过在实际输入x[i]上进行训练得到的。第一步是优化编码器的We(1)层，以适应输出 X。上面的第二步是通过使用We(1)作为输入和输出，优化第二层的权重We(2)。一旦所有We(i)层（其中i=1, 2, ..., n为层数）都经过预训练，就可以通过将所有层连接在一起进行模型微调，正如前图中的第 3 步所示。该概念还可以应用于去噪训练多层网络，这被称为堆叠去噪自编码器。去噪自编码器中开发的代码可以轻松调整为开发堆叠去噪自编码器，它是堆叠自编码器的扩展。

本配方的要求如下：

1. 需要安装 R。

2. SAENET包，可以通过命令install.packages("SAENET")从 Cran 下载安装该包。

如何操作...

在 R 中还有其他流行的库用于开发堆叠自编码器。让我们使用 R 中的SAENET包来搭建一个堆叠自编码器。SAENET是一个堆叠自编码器的实现，使用的是neuralnet包中的前馈神经网络（来自 CRAN）：

1. 如果尚未安装，可以从 CRAN 仓库获取SAENET包：

install.packages("SAENET")

1. 加载所有库依赖项：

require(SAENET)

1. 使用load_occupancy_data加载训练和测试占用数据集：

occupancy_train <-load_occupancy_data(train=T)
occupancy_test <- load_occupancy_data(train = F)

1. 使用minmax.normalize函数对数据集进行归一化：

# Normalize dataset
occupancy_train<-minmax.normalize(occupancy_train, scaler = NULL)
occupancy_test<-minmax.normalize(occupancy_test, scaler = occupancy_train$scaler)

1. 堆叠自编码器模型可以使用SAENET.train训练函数从SAENET包中构建：

# Building Stacked Autoencoder
SAE_obj<-SAENET.train(X.train= subset(occupancy_train$data, select=-c(Occupancy)), n.nodes=c(4, 3, 2), unit.type ="tanh", lambda = 1e-5, beta = 1e-5, rho = 0.01, epsilon = 0.01, max.iterations=1000)

可以使用SAE_obj[[n]]$X.output命令提取最后一个节点的输出。

设置去噪自编码器

去噪自编码器是一种特殊类型的自编码器，专注于从输入数据集中提取稳健的特征。去噪自编码器与之前的模型类似，唯一的主要区别是数据在训练网络之前会被破坏。可以使用不同的破坏方法，例如遮罩，它会在数据中引入随机错误。

准备工作

让我们使用 CIFAR-10 图像数据来设置去噪数据集：

• 使用download_cifar_data函数下载 CIFAR-10 数据集（见第三章，卷积神经网络）

• 在 R 和 Python 中安装 TensorFlow

如何操作...

我们首先需要读取数据集。

读取数据集

1. 使用第三章中解释的步骤加载CIFAR数据集，卷积神经网络。使用data_batch_1和data_batch_2文件进行训练，data_batch_5和test_batch文件分别用于验证和测试。数据可以通过flat_data函数进行展平：

train_data <- flat_data(x_listdata = images.rgb.train)
test_data <- flat_data(x_listdata = images.rgb.test)
valid_data <- flat_data(x_listdata = images.rgb.valid)

1. flat_data函数将数据集展平为NCOL = (高度 * 宽度 * 通道数)，因此数据集的维度是（图像数 × NCOL）。CIFAR中的图像大小为 32 x 32，包含三个 RGB 通道；因此，在数据展平后，我们得到 3,072 列：

> dim(train_data$images)
[1] 40000  3072

破坏数据以进行训练

1. 设置去噪自编码器所需的下一个关键功能是数据破坏：

# Add noise using masking or salt & pepper noise method
add_noise<-function(data, frac=0.10, corr_type=c("masking", "saltPepper", "none")){
  if(length(corr_type)>1) corr_type<-corr_type[1] 

  # Assign a copy of data
  data_noise = data

  # Evaluate chaining parameters for autoencoder
  nROW<-nrow(data)
  nCOL<-ncol(data)
  nMask<-floor(frac*nCOL)

  if(corr_type=="masking"){
    for( i in 1:nROW){
      maskCol<-sample(nCOL, nMask)
      data_noise[i,maskCol,,]<-0
    }
  } else if(corr_type=="saltPepper"){
    minval<-min(data[,,1,])
    maxval<-max(data[,,1,])
    for( i in 1:nROW){
      maskCol<-sample(nCOL, nMask)
      randval<-runif(length(maskCol))
      ixmin<-randval<0.5
      ixmax<-randval>=0.5
      if(sum(ixmin)>0) data_noise[i,maskCol[ixmin],,]<-minval
      if(sum(ixmax)>0) data_noise[i,maskCol[ixmax],,]<-maxval
    }
  } else
  {
    data_noise<-data
  }
  return(data_noise)
}

1. 可以使用以下脚本来破坏 CIFAR-10 数据：

# Corrupting input signal
xcorr<-add_noise(train_data$images, frac=0.10, corr_type="masking")

1. 破坏后的示例图像如下：

1. 上图使用了遮罩方法来添加噪声。此方法在随机图像位置添加零值，且定义了一个比例。另一种添加噪声的方法是使用椒盐噪声。此方法在图像中选择随机位置并进行替换，使用抛硬币原理为图像添加最小值或最大值。以下是使用椒盐方法进行数据破坏的示例：

数据破坏有助于自编码器学习更稳健的表示。

设置去噪自编码器

下一步是设置自编码器模型：

1. 首先，重置图并开始一个交互式会话，如下所示：

# Reset the graph and set-up an interactive session
tf$reset_default_graph()
sess<-tf$InteractiveSession()

1. 下一步是为输入信号和破坏信号定义两个占位符：

# Define Input as Placeholder variables
x = tf$placeholder(tf$float32, shape=shape(NULL, img_size_flat), name='x')
x_corrput<-tf$placeholder(tf$float32, shape=shape(NULL, img_size_flat), name='x_corrput')

x_corrupt 将作为自编码器的输入，而 x 是实际的图像，将用作输出。

1. 设置去噪自编码器函数，如下代码所示：

# Setting-up denoising autoencoder
denoisingAutoencoder<-function(x, x_corrput, img_size_flat=3072, hidden_layer=c(1024, 512), out_img_size=256){

  # Building Encoder
  encoder = NULL
  n_input<-img_size_flat
  curentInput<-x_corrput
  layer<-c(hidden_layer, out_img_size)
  for(i in 1:length(layer)){
    n_output<-layer[i]
    W = tf$Variable(tf$random_uniform(shape(n_input, n_output), -1.0 / tf$sqrt(n_input), 1.0 / tf$sqrt(n_input)))
    b = tf$Variable(tf$zeros(shape(n_output)))
    encoder<-c(encoder, W)
    output = tf$nn$tanh(tf$matmul(curentInput, W) + b)
    curentInput = output
    n_input<-n_output
  }

  # latent representation
  z = curentInput
  encoder<-rev(encoder)
  layer_rev<-c(rev(hidden_layer), img_size_flat)

  # Build the decoder using the same weights
  decoder<-NULL
  for(i in 1:length(layer_rev)){
    n_output<-layer_rev[i]
    W = tf$transpose(encoder[[i]])
    b = tf$Variable(tf$zeros(shape(n_output)))
    output = tf$nn$tanh(tf$matmul(curentInput, W) + b)
    curentInput = output
  }

  # now have the reconstruction through the network
  y = curentInput

  # cost function measures pixel-wise difference
  cost = tf$sqrt(tf$reduce_mean(tf$square(y - x)))
  return(list("x"=x, "z"=z, "y"=y, "x_corrput"=x_corrput, "cost"=cost))
}

1. 创建去噪对象：

# Create denoising AE object
dae_obj<-denoisingAutoencoder(x, x_corrput, img_size_flat=3072, hidden_layer=c(1024, 512), out_img_size=256)

1. 设置代价函数：

# Learning set-up
learning_rate = 0.001
optimizer = tf$train$AdamOptimizer(learning_rate)$minimize(dae_obj$cost)

1. 运行优化：

# We create a session to use the graph
sess$run(tf$global_variables_initializer())
for(i in 1:500){
  spls <- sample(1:dim(xcorr)[1],1000L)
  if (i %% 1 == 0) {
    x_corrput_ds<-add_noise(train_data$images[spls, ], frac = 0.3, corr_type = "masking")
    optimizer$run(feed_dict = dict(x=train_data$images[spls, ], x_corrput=x_corrput_ds))
    trainingCost<-dae_obj$cost$eval((feed_dict = dict(x=train_data$images[spls, ], x_corrput=x_corrput_ds)))
    cat("Training Cost - ", trainingCost, "\n")
  }
}

它是如何工作的...

自编码器继续学习关于特征的函数形式，以捕捉输入和输出之间的关系。计算机在 1,000 次迭代后如何可视化图像的示例如下所示：

在进行 1,000 次迭代后，计算机能够区分物体和环境的主要部分。随着我们继续运行算法来微调权重，计算机会继续学习更多关于物体本身的特征，如下图所示：

上图显示了模型仍在学习，但随着它开始学习关于物体的精细特征，学习率在迭代过程中逐渐变小，如下图所示。有时，模型开始上升而不是下降，这是由于批量梯度下降引起的：

使用去噪自编码器进行学习的示意图

构建和比较随机编码器和解码器

随机编码器属于生成建模领域，目标是学习给定数据 X 在转换到另一个高维空间后的联合概率 P(X)。例如，我们想学习图像并通过学习像素依赖关系和分布生成类似但不完全相同的图像。生成建模中一种流行的方法是变分自编码器（VAE），它通过对 h ~ P(h) 做出强假设，如高斯分布或伯努利分布，将深度学习与统计推理相结合。对于给定的权重 W，X 可以从分布中采样为 Pw(X|h)。下面的图示展示了 VAE 的架构：

VAE 的代价函数基于对数似然最大化。代价函数由重建误差和正则化误差项组成：

代价 = 重建误差 + 正则化误差

重建误差 是我们如何将结果与训练数据进行映射的准确度，而 正则化误差 对编码器和解码器形成的分布施加了惩罚。

准备工作

TensorFlow 需要在环境中安装并加载：

require(tensorflow)

需要加载依赖项：

require(imager)
require(caret)

MNIST 数据集需要被加载。数据集使用以下脚本进行归一化：

# Normalize Dataset
normalizeObj<-preProcess(trainData, method="range")
trainData<-predict(normalizeObj, trainData)
validData<-predict(normalizeObj, validData)

如何做...

1. MNIST 数据集被用来演示稀疏分解的概念。MNIST 数据集包含手写数字。它是从 tensorflow 数据集库下载的。数据集包含 28 x 28 像素的手写图像，包含 55,000 个训练样本，10,000 个测试样本和 5,000 个测试样本。可以通过以下脚本从 tensorflow 库下载数据集：

library(tensorflow)
datasets <- tf$contrib$learn$datasets
mnist <- datasets$mnist$read_data_sets("MNIST-data", one_hot = TRUE) 

1. 为了简化计算，MNIST 图像的大小从 28 x 28 像素减小为 16 x 16 像素，使用以下函数：

# Function to reduce image size
reduceImage<-function(actds, n.pixel.x=16, n.pixel.y=16){
  actImage<-matrix(actds, ncol=28, byrow=FALSE)
  img.col.mat <- imappend(list(as.cimg(actImage)),"c")
  thmb <- resize(img.col.mat, n.pixel.x, n.pixel.y)
  outputImage<-matrix(thmb[,,1,1], nrow = 1, byrow = F)
  return(outputImage)
} 

1. 以下脚本可以用来准备具有 16 x 16 像素图像的 MNIST 训练数据：

# Covert train data to 16 x 16  image
trainData<-t(apply(mnist$train$images, 1, FUN=reduceImage))
validData<-t(apply(mnist$test$images, 1, FUN=reduceImage))

1. plot_mnist 函数可以用来可视化选择的 MNIST 图像：

# Function to plot MNIST dataset
plot_mnist<-function(imageD, pixel.y=16){
  actImage<-matrix(imageD, ncol=pixel.y, byrow=FALSE)
  img.col.mat <- imappend(list(as.cimg(actImage)), "c")
  plot(img.col.mat)
}

设置 VAE 模型：

1. 启动一个新的 TensorFlow 环境：

tf$reset_default_graph()
sess<-tf$InteractiveSession()

1. 定义网络参数：

n_input=256
n.hidden.enc.1<-64

1. 启动一个新的 TensorFlow 环境：

tf$reset_default_graph()
sess<-tf$InteractiveSession()

1. 定义网络参数：

n_input=256
n.hidden.enc.1<-64

前述参数将形成如下的 VAE 网络：

1. 定义模型初始化函数，定义每一层 encoder 和 decoder 的权重和偏差：

model_init<-function(n.hidden.enc.1, n.hidden.enc.2, 
                               n.hidden.dec.1,  n.hidden.dec.2, 
                               n_input, n_h)
{ weights<-NULL
 ############################
 # Set-up Encoder
 ############################
 # Initialize Layer 1 of encoder
 weights[["encoder_w"]][["h1"]]=tf$Variable(xavier_init(n_input,
 n.hidden.enc.1))
 weights[["encoder_w"]]
[["h2"]]=tf$Variable(xavier_init(n.hidden.enc.1, n.hidden.enc.2))
  weights[["encoder_w"]][["out_mean"]]=tf$Variable(xavier_init(n.hidden.enc.2, n_h))
  weights[["encoder_w"]][["out_log_sigma"]]=tf$Variable(xavier_init(n.hidden.enc.2, n_h))
  weights[["encoder_b"]][["b1"]]=tf$Variable(tf$zeros(shape(n.hidden.enc.1), dtype=tf$float32))
  weights[["encoder_b"]][["b2"]]=tf$Variable(tf$zeros(shape(n.hidden.enc.2), dtype=tf$float32))
  weights[["encoder_b"]][["out_mean"]]=tf$Variable(tf$zeros(shape(n_h), dtype=tf$float32))
  weights[["encoder_b"]][["out_log_sigma"]]=tf$Variable(tf$zeros(shape(n_h), dtype=tf$float32))

 ############################
 # Set-up Decoder
 ############################
 weights[['decoder_w']][["h1"]]=tf$Variable(xavier_init(n_h, n.hidden.dec.1))
 weights[['decoder_w']][["h2"]]=tf$Variable(xavier_init(n.hidden.dec.1, n.hidden.dec.2))
 weights[['decoder_w']][["out_mean"]]=tf$Variable(xavier_init(n.hidden.dec.2, n_input))
 weights[['decoder_w']][["out_log_sigma"]]=tf$Variable(xavier_init(n.hidden.dec.2, n_input))
 weights[['decoder_b']][["b1"]]=tf$Variable(tf$zeros(shape(n.hidden.dec.1), dtype=tf$float32))
 weights[['decoder_b']][["b2"]]=tf$Variable(tf$zeros(shape(n.hidden.dec.2), dtype=tf$float32))
 weights[['decoder_b']][["out_mean"]]=tf$Variable(tf$zeros(shape(n_input), dtype=tf$float32))
 weights[['decoder_b']][["out_log_sigma"]]=tf$Variable(tf$zeros(shape(n_input), dtype=tf$float32))
 return(weights)
} 

model_init 函数返回 weights，它是一个二维列表。第一个维度表示权重的关联和类型。例如，它描述了 weights 变量是分配给编码器还是解码器，并且它是否存储节点的权重或偏差。model_init 中的 xavier_init 函数用于为模型训练分配初始权重：

# Xavier Initialization using Uniform distribution 
xavier_init<-function(n_inputs, n_outputs, constant=1){
  low = -constant*sqrt(6.0/(n_inputs + n_outputs)) 
  high = constant*sqrt(6.0/(n_inputs + n_outputs))
  return(tf$random_uniform(shape(n_inputs, n_outputs), minval=low, maxval=high, dtype=tf$float32))
}

1. 设置编码器评估函数：

# Encoder update function
vae_encoder<-function(x, weights, biases){
  layer_1 = tf$nn$softplus(tf$add(tf$matmul(x, weights[['h1']]), biases[['b1']])) 
  layer_2 = tf$nn$softplus(tf$add(tf$matmul(layer_1, weights[['h2']]), biases[['b2']])) 
  z_mean = tf$add(tf$matmul(layer_2, weights[['out_mean']]), biases[['out_mean']])
  z_log_sigma_sq = tf$add(tf$matmul(layer_2, weights[['out_log_sigma']]), biases[['out_log_sigma']])
  return (list("z_mean"=z_mean, "z_log_sigma_sq"=z_log_sigma_sq))
} 

vae_encoder 计算均值和方差，用于从隐藏层的权重和偏差中采样：

1. 设置解码器评估函数：

# Decoder update function
vae_decoder<-function(z, weights, biases){
  layer1<-tf$nn$softplus(tf$add(tf$matmul(z, weights[["h1"]]), biases[["b1"]]))
  layer2<-tf$nn$softplus(tf$add(tf$matmul(layer1, weights[["h2"]]), biases[["b2"]]))
  x_reconstr_mean<-tf$nn$sigmoid(tf$add(tf$matmul(layer2, weights[['out_mean']]), biases[['out_mean']]))
  return(x_reconstr_mean)
}

vae_decoder 函数计算与采样层相关的均值和标准差，以及输出和平均输出：

1. 设置重构估计的函数：

# Parameter evaluation
network_ParEval<-function(x, network_weights, n_h){

  distParameter<-vae_encoder(x, network_weights[["encoder_w"]], network_weights[["encoder_b"]])
  z_mean<-distParameter$z_mean
  z_log_sigma_sq <-distParameter$z_log_sigma_sq

  # Draw one sample z from Gaussian distribution
  eps = tf$random_normal(shape(BATCH, n_h), 0, 1, dtype=tf$float32)

  # z = mu + sigma*epsilon
  z = tf$add(z_mean, tf$multiply(tf$sqrt(tf$exp(z_log_sigma_sq)), eps))

  # Use generator to determine mean of
  # Bernoulli distribution of reconstructed input
  x_reconstr_mean <- vae_decoder(z, network_weights[["decoder_w"]], network_weights[["decoder_b"]])
  return(list("x_reconstr_mean"=x_reconstr_mean, "z_log_sigma_sq"=z_log_sigma_sq, "z_mean"=z_mean))
}

1. 定义优化的成本函数：

# VAE cost function
vae_optimizer<-function(x, networkOutput){
  x_reconstr_mean<-networkOutput$x_reconstr_mean
  z_log_sigma_sq<-networkOutput$z_log_sigma_sq
  z_mean<-networkOutput$z_mean
  loss_reconstruction<--1*tf$reduce_sum(x*tf$log(1e-10 + x_reconstr_mean)+
                                       (1-x)*tf$log(1e-10 + 1 - x_reconstr_mean), reduction_indices=shape(1))
  loss_latent<--0.5*tf$reduce_sum(1+z_log_sigma_sq-tf$square(z_mean)-
                                    tf$exp(z_log_sigma_sq), reduction_indices=shape(1))
  cost = tf$reduce_mean(loss_reconstruction + loss_latent)
  return(cost)
}

1. 设置模型进行训练：

# VAE Initialization
x = tf$placeholder(tf$float32, shape=shape(NULL, img_size_flat), name='x')
network_weights<-model_init(n.hidden.enc.1, n.hidden.enc.2, 
                            n.hidden.dec.1,  n.hidden.dec.2, 
                            n_input, n_h)
networkOutput<-network_ParEval(x, network_weights, n_h)
cost=vae_optimizer(x, networkOutput)
optimizer = tf$train$AdamOptimizer(lr)$minimize(cost) 

1. 运行优化：

sess$run(tf$global_variables_initializer())
for(i in 1:ITERATION){
  spls <- sample(1:dim(trainData)[1],BATCH)
  out<-optimizer$run(feed_dict = dict(x=trainData[spls,]))
  if (i %% 100 == 0){
  cat("Iteration - ", i, "Training Loss - ",  cost$eval(feed_dict = dict(x=trainData[spls,])), "\n")
  }
}

VAE 自编码器的输出：

1. 可以使用以下脚本生成结果：

spls <- sample(1:dim(trainData)[1],BATCH)
networkOutput_run<-sess$run(networkOutput, feed_dict = dict(x=trainData[spls,]))

# Plot reconstructured Image
x_sample<-trainData[spls,]
NROW<-nrow(networkOutput_run$x_reconstr_mean)
n.plot<-5
par(mfrow = c(n.plot, 2), mar = c(0.2, 0.2, 0.2, 0.2), oma = c(3, 3, 3, 3))
pltImages<-sample(1:NROW,n.plot)
for(i in pltImages){
  plot_mnist(x_sample[i,])
  plot_mnist(networkOutput_run$x_reconstr_mean[i,])
}

以下图所示是从前述 VAE 自编码器经过 20,000 次迭代后的结果：

此外，由于 VAE 是生成模型，输出结果不是输入的精确复制，而是会随着运行的不同而有所变化，因为从估计的分布中提取了一个代表性样本。

从自编码器学习流形：

流形学习是机器学习中的一种方法，它假设数据位于一个维度远低于原始数据的流形上。这些流形可以是线性或非线性的。因此，该方法尝试将数据从高维空间投影到低维空间。例如，主成分分析（PCA）是线性流形学习的一个例子，而自编码器则是一个非线性降维（NDR）方法，具有学习低维空间中非线性流形的能力。线性与非线性流形学习的比较见下图：

如图**a)所示，数据位于一个线性流形上，而在图b)**中，数据则位于二阶非线性流形上。

如何操作...

让我们取堆叠自编码器部分的输出，分析数据在转移到不同维度时，流形的表现。

设置主成分分析

1. 在进入非线性流形之前，让我们分析占用数据上的主成分分析：

# Setting-up principal component analysis 
pca_obj <- prcomp(occupancy_train$data,
                 center = TRUE,
                 scale. = TRUE)
                 scale. = TRUE)

1. 上述函数将数据转化为六个正交方向，这些方向是特征的线性组合。每个维度所解释的方差可以通过以下脚本查看：

plot(pca_obj, type = "l")

1. 上述命令将绘制主成分的方差，如下图所示：

1. 对于占用数据集，前两个主成分捕捉了大部分变异，当绘制主成分时，显示出占用的正负类之间的分离，如下图所示：

前两个主成分的输出

1. 让我们可视化自编码器学习到的低维流形。我们只使用一个维度来可视化结果，如下所示：

SAE_obj<-SAENET.train(X.train= subset(occupancy_train$data, select=-c(Occupancy)), n.nodes=c(4, 3, 1), unit.type ="tanh", lambda = 1e-5, beta = 1e-5, rho = 0.01, epsilon = 0.01, max.iterations=1000) 

1. 上述脚本的编码器架构如下所示：

堆叠自编码器中一个潜在节点的隐藏层输出如下所示：

1. 上述图表显示，占用在潜在变量的峰值处为真。然而，峰值出现在不同的值上。让我们增加潜在变量 2，这是通过 PCA 捕获的。可以使用以下脚本开发模型并绘制数据：

SAE_obj<-SAENET.train(X.train= subset(occupancy_train$data, select=-c(Occupancy)), n.nodes=c(4, 3, 2), unit.type ="tanh", lambda = 1e-5, beta = 1e-5, rho = 0.01, epsilon = 0.01, max.iterations=1000)  

# plotting encoder values
plot(SAE_obj[[3]]$X.output[,1], SAE_obj[[3]]$X.output[,2], col="blue", xlab = "Node 1 of layer 3", ylab = "Node 2 of layer 3")
ix<-occupancy_train$data[,6]==1  
points(SAE_obj[[3]]$X.output[ix,1], SAE_obj[[3]]$X.output[ix,2], col="red")

1. 带有两层编码的值在下图中显示：

评估稀疏分解

稀疏自编码器也被称为过完备表示，并且在隐藏层中具有更多的节点。稀疏自编码器通常使用稀疏性参数（正则化）执行，该参数充当约束，限制节点的激活。稀疏性也可以被看作是由于稀疏性约束而导致的节点丢弃。稀疏自编码器的损失函数由重建误差、用于控制权重衰减的正则化项以及用于稀疏性约束的 KL 散度组成。以下表示很好地说明了我们所讲的内容：

准备工作

1. 数据集已加载并设置好。

2. 使用以下脚本安装并加载autoencoder包：

install.packages("autoencoder")
require(autoencoder)

如何操作...

1. TensorFlow 的标准自编码器代码可以通过更新成本函数轻松扩展到稀疏自编码器模块。本节将介绍 R 的自编码器包，该包内置了运行稀疏自编码器的功能：

### Setting-up parameter
nl<-3 
N.hidden<-100 
unit.type<-"logistic" 
lambda<-0.001 
rho<-0.01 
beta<-6 
max.iterations<-2000 
epsilon<-0.001 

### Running sparse autoencoder
spe_ae_obj <- autoencode(X.train=trainData,  X.test = validData, nl=nl, N.hidden=N.hidden, unit.type=unit.type,lambda=lambda,beta=beta,              epsilon=epsilon,rho=rho,max.iterations=max.iterations, rescale.flag = T)

autoencode函数中的主要参数如下：

• nl：这是包括输入层和输出层在内的层数（默认值为三层）。

• N.hidden：这是每个隐藏层中神经元数量的向量。

• unit.type：这是要使用的激活函数类型。

• lambda：这是正则化参数。

• rho：这是稀疏性参数。

• beta：这是稀疏项的惩罚。

• max.iterations：这是最大迭代次数。

• epsilon：这是权重初始化的参数。权重是使用高斯分布 ~N(0, epsilon2) 初始化的。

它是如何工作的...

下图展示了稀疏自编码器捕获的来自MNIST的数字形状和方向：

通过稀疏自编码器生成的滤波器得到数字结果

稀疏自编码器学习到的滤波器可以使用来自自编码器包的visualize.hidden.units函数进行可视化。该包绘制了最终层的权重与输出之间的关系。在当前场景中，100 是隐藏层中的神经元数量，256 是输出层中的节点数量。

第五章：深度学习中的生成模型

在本章中，我们将讨论以下主题：

• 比较主成分分析与限制玻尔兹曼机

• 为伯努利分布输入设置限制玻尔兹曼机

• 训练限制玻尔兹曼机

• RBM 的反向或重建阶段

• 理解重建的对比散度

• 初始化并启动一个新的 TensorFlow 会话

• 评估 RBM 的输出

• 为协同过滤设置限制玻尔兹曼机

• 执行 RBM 训练的完整运行

• 设置深度信念网络

• 实现前馈反向传播神经网络

• 设置深度限制玻尔兹曼机

比较主成分分析与限制玻尔兹曼机

在本节中，你将学习两种广泛推荐的降维技术——主成分分析（PCA）和限制玻尔兹曼机（RBM）。考虑在n维空间中的一个向量v。降维技术本质上将向量v转换为一个相对较小（有时是相等）的m维向量v'（m<n）。这种转换可以是线性或非线性的。

PCA 对特征进行线性变换，从而生成正交调整的组件，这些组件之后会根据它们在方差捕捉中的相对重要性进行排序。这些m个组件可以视为新的输入特征，并可以如下定义：

向量v' =

这里，w 和 c 分别对应于权重（加载）和转换后的组件。

与 PCA 不同，RBM（或 DBN/自编码器）通过可见单元和隐藏单元之间的连接执行非线性变换，正如在第四章 使用自编码器的数据表示中所描述的那样。非线性有助于更好地理解与潜在变量之间的关系。除了信息捕获外，它们还倾向于去除噪声。RBM 通常基于随机分布（无论是伯努利分布还是高斯分布）。

执行大量的吉布斯采样以学习和优化可见层与隐藏层之间的连接权重。优化过程分为两个阶段：前向阶段，其中使用给定的可见层对隐藏层进行采样；反向阶段，其中使用给定的隐藏层对可见层进行重新采样。该优化旨在最小化重建误差。

以下图像表示一个限制玻尔兹曼机：

准备工作

对于这个食谱，你将需要 R（rbm和ggplot2包）和 MNIST 数据集。MNIST 数据集可以从 TensorFlow 数据集库中下载。该数据集包含 28 x 28 像素的手写图像。它有 55,000 个训练样本和 10,000 个测试样本。可以通过以下脚本从tensorflow库下载：

library(tensorflow) 
datasets <- tf$contrib$learn$datasets 
mnist <- datasets$mnist$read_data_sets("MNIST-data", one_hot = TRUE)  

如何操作...

1. 提取训练数据集（trainX包含所有 784 个独立变量，trainY包含相应的 10 个二元输出）：

trainX <- mnist$train$images 
trainY <- mnist$train$labels 

1. 对trainX数据执行 PCA：

PCA_model <- prcomp(trainX, retx=TRUE) 

1. 对trainX数据运行 RBM：

RBM_model <- rbm(trainX, retx=TRUE, max_epoch=500,num_hidden =900) 

1. 使用生成的模型对训练数据进行预测。对于 RBM 模型，生成概率：

PCA_pred_train <- predict(PCA_model) 
RBM_pred_train <- predict(RBM_model,type='probs')

1. 将结果转换为数据框：

PCA_pred_train <- as.data.frame(PCA_pred_train)
 class="MsoSubtleEmphasis">RBM_pred_train <- as.data.frame(as.matrix(RBM_pred_train))

1. 将 10 类二元trainY数据框转换为数值向量：

    trainY_num<- as.numeric(stringi::stri_sub(colnames(as.data.frame(trainY))[max.col(as.data.frame(trainY),ties.method="first")],2))

1. 绘制使用 PCA 生成的组件图。这里，x轴表示组件 1，y轴表示组件 2。以下图片展示了 PCA 模型的结果：

ggplot(PCA_pred_train, aes(PC1, PC2))+
  geom_point(aes(colour = trainY))+ 
  theme_bw()+labs()+ 
  theme(plot.title = element_text(hjust = 0.5)) 

1. 绘制使用 PCA 生成的隐藏层。这里，x轴表示隐藏 1，y轴表示隐藏 2。以下图片展示了 RBM 模型的结果：

ggplot(RBM_pred_train, aes(Hidden_2, Hidden_3))+
  geom_point(aes(colour = trainY))+ 
  theme_bw()+labs()+ 
  theme(plot.title = element_text(hjust = 0.5)) 

以下代码和图片展示了主成分所解释的累积方差：

var_explain <- as.data.frame(PCA_model$sdev²/sum(PCA_model$sdev²)) 
var_explain <- cbind(c(1:784),var_explain,cumsum(var_explain[,1])) 
colnames(var_explain) <- c("PcompNo.","Ind_Variance","Cum_Variance") 
plot(var_explain$PcompNo.,var_explain$Cum_Variance, xlim = c(0,100),type='b',pch=16,xlab = "# of Principal Components",ylab = "Cumulative Variance",main = 'PCA - Explained variance') 

以下代码和图片展示了在使用多个训练周期生成 RBM 时，重建训练误差的下降：

plot(RBM_model,xlab = "# of epoch iterations",ylab = "Reconstruction error",main = 'RBM - Reconstruction Error') 

为伯努利分布输入设置限制玻尔兹曼机

在本节中，我们将为伯努利分布的输入数据设置限制玻尔兹曼机，其中每个属性的值范围从 0 到 1（相当于一个概率分布）。本配方中使用的数据集（MNIST）具有满足伯努利分布的输入数据。

限制玻尔兹曼机由两层组成：一个可见层和一个隐藏层。可见层是输入层，节点数量等于输入属性的数量。在我们的案例中，MNIST 数据集中的每个图像由 784 个像素（28 x 28 大小）定义。因此，我们的可见层将包含 784 个节点。

另一方面，隐藏层通常是由用户定义的。隐藏层具有一组二值激活的节点，每个节点与所有其他可见节点有一定的连接概率。在我们的案例中，隐藏层将包含 900 个节点。作为初步步骤，所有可见层的节点与所有隐藏层的节点是双向连接的。

每个连接都由一个权重定义，因此定义了一个权重矩阵，其中行代表输入节点的数量，列代表隐藏节点的数量。在我们的案例中，权重矩阵（w）将是一个 784 x 900 的张量。

除了权重外，每个层中的所有节点还由偏置节点辅助。可见层的偏置节点将与所有可见节点（即 784 个节点）连接，表示为vb，而隐藏层的偏置节点将与所有隐藏节点（即 900 个节点）连接，表示为vh。

记住，RBM 的一个要点是每层内部的节点之间没有连接。换句话说，连接是跨层的，而不是层内的。

以下图像表示了包含可见层、隐藏层和连接的 RBM：

准备工作

本节提供了设置 RBM 的要求。

• 在 R 中安装并设置 TensorFlow

• mnist数据被下载并加载以设置 RBM

如何操作...

本节提供了使用 TensorFlow 设置 RBM 的可见层和隐藏层的步骤：

1. 启动一个新的交互式 TensorFlow 会话：

# Reset the graph 
tf$reset_default_graph() 
# Starting session as interactive session 
sess <- tf$InteractiveSession() 

1. 定义模型参数。num_input参数定义可见层节点的数量，num_hidden定义隐藏层节点的数量：

num_input<-784L 
num_hidden<-900L

1. 为权重矩阵创建占位符变量：

W <- tf$placeholder(tf$float32, shape = shape(num_input, num_hidden)) 

1. 为可见和隐藏偏置创建占位符变量：

vb <- tf$placeholder(tf$float32, shape = shape(num_input)) 
hb <- tf$placeholder(tf$float32, shape = shape(num_hidden)) 

训练限制玻尔兹曼机

每次训练 RBM 都会经历两个阶段：正向阶段和反向阶段（或重建阶段）。通过进行正向和反向阶段的多次迭代，来精细调节可见单元的重建。

正向阶段训练：在正向阶段，输入数据从可见层传递到隐藏层，所有计算发生在隐藏层的节点中。计算本质上是对每个从可见层到隐藏层连接的随机决策。在隐藏层中，输入数据（X）与权重矩阵（W）相乘，并加上一个隐藏偏置向量（hb）。

得到的向量（大小等于隐藏层节点的数量）会通过 sigmoid 函数，确定每个隐藏节点的输出（或激活状态）。在我们的案例中，每个输入数字会生成一个包含 900 个概率的张量向量，由于我们有 55,000 个输入数字，所以我们会得到一个大小为 55,000 x 900 的激活矩阵。利用隐藏层的概率分布矩阵，我们可以生成激活向量的样本，之后可用于估计负向阶段的梯度。

准备工作

本节提供了设置 RBM 的要求。

• 在 R 中安装并设置 TensorFlow

• mnist数据被下载并加载以设置 RBM

• RBM 模型的设置按照为伯努利分布输入设置限制玻尔兹曼机的步骤进行。

一个采样的示例

假设一个常量向量s1，它等于一个概率的张量向量。然后，使用常量向量s1的分布，创建一个新的随机均匀分布样本s2。接着计算它们的差异，并应用一个修正的线性激活函数。

如何操作...

本节提供了使用 TensorFlow 运行 RBM 模型的脚本设置步骤：

X = tf$placeholder(tf$float32, shape=shape(NULL, num_input)) 
prob_h0= tf$nn$sigmoid(tf$matmul(X, W) + hb) 
h0 = tf$nn$relu(tf$sign(prob_h0 - tf$random_uniform(tf$shape(prob_h0))))

使用以下代码执行在 TensorFlow 中创建的图：

sess$run(tf$global_variables_initializer()) 
s1 <- tf$constant(value = c(0.1,0.4,0.7,0.9)) 
cat(sess$run(s1)) 
s2=sess$run(tf$random_uniform(tf$shape(s1))) 
cat(s2) 
cat(sess$run(s1-s2)) 
cat(sess$run(tf$sign(s1 - s2))) 
cat(sess$run(tf$nn$relu(tf$sign(s1 - s2)))) 

RBM 的反向或重建阶段

在重建阶段，来自隐藏层的数据被传递回可见层。隐藏层的概率向量h0与权重矩阵W的转置相乘，并加上一个可见层偏置vb，然后通过 Sigmoid 函数生成重建的输入向量prob_v1。

通过使用重建的输入向量创建一个样本输入向量，该向量随后与权重矩阵W相乘，并加上隐藏偏置向量hb，生成更新后的隐藏概率向量h1。

这也叫做吉布斯采样。在某些情况下，样本输入向量不会生成，而是直接使用重建的输入向量prob_v1来更新隐藏层

准备开始

本节提供了使用输入概率向量进行图像重建的要求。

• mnist数据已加载到环境中

• RBM 模型是通过训练限制玻尔兹曼机的配方进行训练的

如何做...

本节介绍了执行反向重建和评估的步骤：

1. 反向图像重建可以使用输入概率向量通过以下脚本进行：

prob_v1 = tf$nn$sigmoid(tf$matmul(h0, tf$transpose(W)) + vb)
v1 = tf$nn$relu(tf$sign(prob_v1 - tf$random_uniform(tf$shape(prob_v1))))
h1 = tf$nn$sigmoid(tf$matmul(v1, W) + hb) 

1. 评估可以使用一个定义的度量标准进行，如均方误差（MSE），它是在实际输入数据（X）和重建的输入数据（v1）之间计算的。MSE 在每个周期后计算，关键目标是最小化 MSE：

err = tf$reduce_mean(tf$square(X - v1)) 

理解重建的对比散度

作为初步设置，目标函数可以定义为最小化重建可见向量v的平均负对数似然，其中*P(v)*表示生成概率的向量：

准备开始

本节提供了使用输入概率向量进行图像重建的要求。

• mnist数据已加载到环境中

• 图像是使用反向或重建阶段的配方重建的

如何做...

当前配方介绍了使用对比散度（CD）技术加速采样过程的步骤：

1. 通过将输入向量X与来自给定概率分布prob_h0的隐藏向量h0样本相乘（外积），计算正权重梯度：

w_pos_grad = tf$matmul(tf$transpose(X), h0) 

1. 通过将重建的输入数据样本v1与更新的隐藏激活向量h1进行外积，计算负权重梯度：

w_neg_grad = tf$matmul(tf$transpose(v1), h1)

1. 然后，通过从正梯度中减去负梯度并除以输入数据的大小来计算CD矩阵：

CD = (w_pos_grad - w_neg_grad) / tf$to_float(tf$shape(X)[0])

1. 然后，使用学习率（alpha）和 CD 矩阵，将权重矩阵W更新为update_W：

update_w = W + alpha * CD 

1. 此外，更新可见和隐藏偏置向量：

update_vb = vb + alpha * tf$reduce_mean(X - v1) 
update_hb = hb + alpha * tf$reduce_mean(h0 - h1) 

它是如何工作的...

目标函数可以通过随机梯度下降法最小化，间接修改（并优化）权重矩阵。整个梯度可以基于概率密度进一步分为两种形式：正梯度和负梯度。正梯度主要依赖于输入数据，而负梯度仅依赖于生成的模型。

在正梯度中，重构训练数据的概率增加，而在负梯度中，由模型随机生成的均匀样本的概率减小。

CD 技术用于优化负相。使用 CD 技术时，在每次重构迭代中都会调整权重矩阵。新的权重矩阵通过以下公式生成。学习率定义为alpha，在我们的情况下：

初始化并启动新的 TensorFlow 会话

计算误差度量（如均方误差 MSE）的一个重要部分是初始化和启动新的 TensorFlow 会话。以下是我们进行操作的步骤。

准备就绪

本节提供了启动新的 TensorFlow 会话所需的要求，用于计算误差度量。

• mnist 数据已加载到环境中

• RBM 的 TensorFlow 图已加载

如何操作...

本节提供了使用 RBM 重构优化误差的步骤：

1. 初始化当前和前一个偏置向量及权重矩阵：

cur_w = tf$Variable(tf$zeros(shape = shape(num_input, num_hidden), dtype=tf$float32)) 
cur_vb = tf$Variable(tf$zeros(shape = shape(num_input), dtype=tf$float32)) 
cur_hb = tf$Variable(tf$zeros(shape = shape(num_hidden), dtype=tf$float32)) 
prv_w = tf$Variable(tf$random_normal(shape=shape(num_input, num_hidden), stddev=0.01, dtype=tf$float32)) 
prv_vb = tf$Variable(tf$zeros(shape = shape(num_input), dtype=tf$float32)) 
prv_hb = tf$Variable(tf$zeros(shape = shape(num_hidden), dtype=tf$float32)) 

1. 启动一个新的 TensorFlow 会话：

sess$run(tf$global_variables_initializer()) 

1. 使用完整的输入数据（trainX）执行第一次运行，并获得第一组权重矩阵和偏置向量：

output <- sess$run(list(update_w, update_vb, update_hb), feed_dict = dict(X=trainX, 
                                                                          W = prv_w$eval(), 
                                                                          vb = prv_vb$eval(), 
                                                                          hb = prv_hb$eval())) 
prv_w <- output[[1]]
prv_vb <-output[[2]] 
prv_hb <-output[[3]]

1. 我们来看一下第一次运行的误差：

sess$run(err, feed_dict=dict(X= trainX, W= prv_w, vb= prv_vb, hb= prv_hb)) 

1. 使用以下脚本可以训练 RBM 的完整模型：

epochs=15 
errors <- list() 
weights <- list() 
u=1 
for(ep in 1:epochs){ 
  for(i in seq(0,(dim(trainX)[1]-100),100)){ 
    batchX <- trainX[(i+1):(i+100),] 
    output <- sess$run(list(update_w, update_vb, update_hb), feed_dict = dict(X=batchX, 
                                                                              W = prv_w, 
                                                                              vb = prv_vb, 
                                                                              hb = prv_hb)) 
    prv_w <- output[[1]]  
    prv_vb <- output[[2]] 
    prv_hb <-  output[[3]] 
    if(i%%10000 == 0){ 
      errors[[u]] <- sess$run(err, feed_dict=dict(X= trainX, W= prv_w, vb= prv_vb, hb= prv_hb)) 
      weights[[u]] <- output[[1]] 
      u <- u+1 
     cat(i , " : ") 
    } 
  } 
  cat("epoch :", ep, " : reconstruction error : ", errors[length(errors)][[1]],"\n") 
} 

1. 使用均方误差绘制重构：

error_vec <- unlist(errors)
plot(error_vec,xlab="# of batches",ylab="mean squared reconstruction error",main="RBM-Reconstruction MSE plot")

它是如何工作的...

在这里，我们将运行 15 个周期（或迭代），每个周期中会执行批量（大小=100）的优化。在每个批次中，计算 CD 并相应更新权重和偏置。为了跟踪优化过程，每处理完 10,000 行数据后都会计算一次 MSE。

下图展示了计算 90 个批次的均方重构误差的下降趋势：

评估来自 RBM 的输出

在这里，我们将绘制最终层的权重与输出（重构输入数据）之间的关系。在当前的场景下，900 是隐藏层的节点数，784 是输出（重构）层的节点数。

在下图中，可以看到隐藏层的前 400 个节点：

在这里，每个图块表示一个隐藏节点与所有可见层节点之间的连接向量。在每个图块中，黑色区域表示负权重（权重 < 0），白色区域表示正权重（权重 > 1），灰色区域表示没有连接（权重 = 0）。正值越高，隐藏节点的激活概率越大，反之亦然。这些激活有助于确定给定隐藏节点正在确定输入图像的哪一部分。

准备开始

本节提供了运行评估教程所需的要求：

• mnist数据已加载到环境中

• 使用 TensorFlow 执行 RBM 模型，并获得最佳权重

如何操作...

本教程涵盖了从 RBM 中获得的权重评估步骤：

1. 运行以下代码生成 400 个隐藏节点的图像：

uw = t(weights[[length(weights)]])   # Extract the most recent weight matrix 
numXpatches = 20    # Number of images in X-axis (user input) 
numYpatches=20      # Number of images in Y-axis (user input) 
pixels <- list() 
op <- par(no.readonly = TRUE) 
par(mfrow = c(numXpatches,numYpatches), mar = c(0.2, 0.2, 0.2, 0.2), oma = c(3, 3, 3, 3)) 
for (i in 1:(numXpatches*numYpatches)) { 
  denom <- sqrt(sum(uw[i, ]²)) 
  pixels[[i]] <- matrix(uw[i, ]/denom, nrow = numYpatches, ncol = numXpatches) 
  image(pixels[[i]], axes = F, col = gray((0:32)/32)) 
} 
par(op) 

1. 从训练数据中选择四个实际输入的数字样本：

sample_image <- trainX[1:4,]

1. 然后，使用以下代码可视化这些样本数字：

mw=melt(sample_image) 
mw$X3=floor((mw$X2-1)/28)+1 
mw$X2=(mw$X2-1)%%28 + 1; 
mw$X3=29-mw$X3 
ggplot(data=mw)+geom_tile(aes(X2,X3,fill=value))+facet_wrap(~X1,nrow=2)+ 
  scale_fill_continuous(low='black',high='white')+coord_fixed(ratio=1)+ 
  labs(x=NULL,y=NULL,)+ 
  theme(legend.position="none")+ 
  theme(plot.title = element_text(hjust = 0.5)) 

1. 现在，使用最终获得的权重和偏置重构这四个样本图像：

hh0 = tf$nn$sigmoid(tf$matmul(X, W) + hb) 
vv1 = tf$nn$sigmoid(tf$matmul(hh0, tf$transpose(W)) + vb) 
feed = sess$run(hh0, feed_dict=dict( X= sample_image, W= prv_w, hb= prv_hb)) 
rec = sess$run(vv1, feed_dict=dict( hh0= feed, W= prv_w, vb= prv_vb)) 

1. 然后，使用以下代码可视化重构后的样本数字：

mw=melt(rec) 
mw$X3=floor((mw$X2-1)/28)+1 
mw$X2=(mw$X2-1)%%28 + 1 
mw$X3=29-mw$X3 
ggplot(data=mw)+geom_tile(aes(X2,X3,fill=value))+facet_wrap(~X1,nrow=2)+ 
  scale_fill_continuous(low='black',high='white')+coord_fixed(ratio=1)+ 
  labs(x=NULL,y=NULL,)+ 
  theme(legend.position="none")+ 
  theme(plot.title = element_text(hjust = 0.5)) 

它是如何工作的...

下图展示了四个样本数字的原始图像：

重构的图像似乎去除了噪声，尤其是在数字3和6的情况下。

下图展示了同四个数字的重构图像：

为协同过滤设置限制玻尔兹曼机

在本教程中，你将学习如何使用 RBM 构建一个基于协同过滤的推荐系统。这里，对于每个用户，RBM 会根据他们过去对各种项目的评分行为，识别出相似的用户，然后尝试推荐下一个最佳项目。

准备开始

在本教程中，我们将使用 Grouplens 研究机构提供的 movielens 数据集。数据集（movies.dat 和 ratings.dat）可以通过以下链接下载。Movies.dat包含 3,883 部电影的信息，Ratings.dat包含 1,000,209 个用户对这些电影的评分。评分范围从 1 到 5，5 为最高分。

files.grouplens.org/datasets/movielens/ml-1m.zip

如何操作...

本教程涵盖了使用 RBM 设置协同过滤的步骤。

1. 在 R 中读取movies.dat数据集：

txt <- readLines("movies.dat", encoding = "latin1") 
txt_split <- lapply(strsplit(txt, "::"), function(x) as.data.frame(t(x), stringsAsFactors=FALSE)) 
movies_df <- do.call(rbind, txt_split) 
names(movies_df) <- c("MovieID", "Title", "Genres") 
movies_df$MovieID <- as.numeric(movies_df$MovieID) 

1. 向电影数据集添加一个新列（id_order），因为当前的 ID 列（UserID）不能用来索引电影，因为它的值范围是从 1 到 3,952：

movies_df$id_order <- 1:nrow(movies_df) 

1. 在 R 中读取ratings.dat数据集：

ratings_df <- read.table("ratings.dat", sep=":",header=FALSE,stringsAsFactors = F) 
ratings_df <- ratings_df[,c(1,3,5,7)] 
colnames(ratings_df) <- c("UserID","MovieID","Rating","Timestamp")

1. 使用all=FALSE合并电影和评分数据集：

merged_df <- merge(movies_df, ratings_df, by="MovieID",all=FALSE) 

1. 删除不必要的列：

merged_df[,c("Timestamp","Title","Genres")] <- NULL 

1. 将评分转换为百分比：

merged_df$rating_per <- merged_df$Rating/5 

1. 生成一个包含 1,000 个用户对所有电影评分的矩阵：

num_of_users <- 1000 
num_of_movies <- length(unique(movies_df$MovieID)) 
trX <- matrix(0,nrow=num_of_users,ncol=num_of_movies) 
for(i in 1:num_of_users){ 
  merged_df_user <- merged_df[merged_df$UserID %in% i,] 
  trX[i,merged_df_user$id_order] <- merged_df_user$rating_per 
} 

1. 查看trX训练数据集的分布。它似乎遵循伯努利分布（值的范围在 0 到 1 之间）：

summary(trX[1,]); summary(trX[2,]); summary(trX[3,]) 

1. 定义输入模型参数：

num_hidden = 20 
num_input = nrow(movies_df)

1. 启动一个新的 TensorFlow 会话：

sess$run(tf$global_variables_initializer()) 
output <- sess$run(list(update_w, update_vb, update_hb), feed_dict = dict(v0=trX, 
                                                                          W = prv_w$eval(), 
                                                                          vb = prv_vb$eval(), 
                                                                          hb = prv_hb$eval())) 
prv_w <- output[[1]]  
prv_vb <- output[[2]] 
prv_hb <-  output[[3]] 
sess$run(err_sum, feed_dict=dict(v0=trX, W= prv_w, vb= prv_vb, hb= prv_hb))

1. 使用 500 个 epoch 迭代和批次大小 100 训练 RBM：

epochs= 500 
errors <- list() 
weights <- list() 

for(ep in 1:epochs){ 
  for(i in seq(0,(dim(trX)[1]-100),100)){ 
    batchX <- trX[(i+1):(i+100),] 
    output <- sess$run(list(update_w, update_vb, update_hb), feed_dict = dict(v0=batchX, 
                                                                              W = prv_w, 
                                                                              vb = prv_vb, 
                                                                              hb = prv_hb)) 
    prv_w <- output[[1]]  
    prv_vb <- output[[2]] 
    prv_hb <-  output[[3]] 
    if(i%%1000 == 0){ 
      errors <- c(errors,sess$run(err_sum, feed_dict=dict(v0=batchX, W= prv_w, vb= prv_vb, hb= prv_hb))) 
      weights <- c(weights,output[[1]]) 
      cat(i , " : ") 
    } 
  } 
  cat("epoch :", ep, " : reconstruction error : ", errors[length(errors)][[1]],"\n") 
} 

1. 绘制重建均方误差：

error_vec <- unlist(errors) 
plot(error_vec,xlab="# of batches",ylab="mean squared reconstruction error",main="RBM-Reconstruction MSE plot") 

执行完整的 RBM 训练过程

使用前面配方中提到的相同 RBM 设置，使用 20 个隐藏节点对用户评分数据集（trX）进行训练。为了跟踪优化过程，每训练完 1,000 行就会计算一次 MSE。以下图片展示了计算得出的 500 批次（即 epochs）均方重建误差的下降趋势：

查看 RBM 推荐：现在让我们来看一下基于 RBM 的协同过滤为特定用户 ID 生成的推荐。在这里，我们将查看该用户 ID 的顶级评分流派和顶级推荐流派，并列出前 10 名电影推荐。

以下图片展示了顶级评分的流派列表：

以下图片展示了顶级推荐流派列表：

准备就绪

本节提供了协同过滤输出评估的要求：

• 已安装并设置 TensorFlow for R

• movies.dat和ratings.dat数据集已加载到环境中

• 配方为协同过滤设置限制玻尔兹曼机已执行

如何执行...

本配方包含评估 RBM 协同过滤输出的步骤：

1. 选择一个用户的评分：

inputUser = as.matrix(t(trX[75,]))
names(inputUser) <- movies_df$id_order

1. 移除用户未评分的电影（假设这些电影还未观看）：

inputUser <- inputUser[inputUser>0]

1. 绘制用户查看的流派：

top_rated_movies <- movies_df[as.numeric(names(inputUser)[order(inputUser,decreasing = TRUE)]),]$Title
top_rated_genres <- movies_df[as.numeric(names(inputUser)[order(inputUser,decreasing = TRUE)]),]$Genres
top_rated_genres <- as.data.frame(top_rated_genres,stringsAsFactors=F)
top_rated_genres$count <- 1
top_rated_genres <- aggregate(count~top_rated_genres,FUN=sum,data=top_rated_genres)
top_rated_genres <- top_rated_genres[with(top_rated_genres, order(-count)), ]
top_rated_genres$top_rated_genres <- factor(top_rated_genres$top_rated_genres, levels = top_rated_genres$top_rated_genres)
ggplot(top_rated_genres[top_rated_genres$count>1,],aes(x=top_rated_genres,y=count))+
geom_bar(stat="identity")+
theme_bw()+
theme(axis.text.x = element_text(angle = 90, hjust = 1))+
labs(x="Genres",y="count",)+
theme(plot.title = element_text(hjust = 0.5))

1. 重建输入向量以获取所有流派/电影的推荐百分比：

hh0 = tf$nn$sigmoid(tf$matmul(v0, W) + hb)
vv1 = tf$nn$sigmoid(tf$matmul(hh0, tf$transpose(W)) + vb)
feed = sess$run(hh0, feed_dict=dict( v0= inputUser, W= prv_w, hb= prv_hb))
rec = sess$run(vv1, feed_dict=dict( hh0= feed, W= prv_w, vb= prv_vb))
names(rec) <- movies_df$id_order

1. 绘制顶级推荐流派：

top_recom_genres <- movies_df[as.numeric(names(rec)[order(rec,decreasing = TRUE)]),]$Genres
top_recom_genres <- as.data.frame(top_recom_genres,stringsAsFactors=F)
top_recom_genres$count <- 1
top_recom_genres <- aggregate(count~top_recom_genres,FUN=sum,data=top_recom_genres)
top_recom_genres <- top_recom_genres[with(top_recom_genres, order(-count)), ]
top_recom_genres$top_recom_genres <- factor(top_recom_genres$top_recom_genres, levels = top_recom_genres$top_recom_genres)
ggplot(top_recom_genres[top_recom_genres$count>20,],aes(x=top_recom_genres,y=count))+
geom_bar(stat="identity")+
theme_bw()+
theme(axis.text.x = element_text(angle = 90, hjust = 1))+
labs(x="Genres",y="count",)+
theme(plot.title = element_text(hjust = 0.5))

1. 查找前 10 个推荐电影：

top_recom_movies <- movies_df[as.numeric(names(rec)[order(rec,decreasing = TRUE)]),]$Title[1:10]

以下图片展示了前 10 个推荐电影：

设置深度置信网络（DBN）

深度置信网络（DBN）是一种深度神经网络（DNN），由多个隐藏层（或潜在变量）组成。在这里，连接只存在于各层之间，而层内的节点之间没有连接。DBN 可以作为无监督模型和有监督模型进行训练。

无监督模型用于去噪并重建输入，而有监督模型（经过预训练后）用于执行分类。由于每一层中的节点之间没有连接，DBN 可以看作是一个由无监督 RBM 或自编码器组成的集合，每个隐藏层作为其后续连接隐藏层的可见层。

这种堆叠 RBM 通过在所有层之间应用 CD，增强了输入重建的性能，从实际的输入训练层开始，直到最后的隐藏（或潜在）层。

DBN 是一种图模型，以贪婪的方式训练堆叠的 RBM。它们的网络倾向于使用输入特征向量i和隐藏层*h[1,2....m]*之间的联合分布来学习深层次的层次表示：

这里，i = h[0]；P(h[k-1]|h[k])是 RBM 第k层的隐藏层上重构可见单元的条件分布；*P(h[m-1],h[m])*是 DBN 最终 RBM 层的隐藏单元和可见单元（重构）的联合分布。下图展示了一个具有四个隐藏层的 DBN，其中W表示权重矩阵：

DBN 还可以增强 DNN 的鲁棒性。DNN 在实现反向传播时面临局部优化问题。在错误表面有许多低谷的情况下，反向传播导致梯度下降发生在局部深谷中（而不是全局深谷）。而 DBN 则对输入特征进行预训练，这有助于优化指向全局最深的低谷，然后使用反向传播执行梯度下降，以逐步最小化误差率。

训练三个 RBM 的堆叠：在本配方中，我们将使用三个堆叠的 RBM 训练一个 DBN，其中第一个隐藏层有 900 个节点，第二个隐藏层有 500 个节点，第三个隐藏层有 300 个节点。

准备好

本节提供了 TensorFlow 的要求。

• 数据集已加载并设置完毕

• 使用以下脚本加载TensorFlow包：

require(tensorflow)

怎么做...

本配方涵盖了设置深度置信网络（DBM）的步骤：

1. 将每个隐藏层的节点数定义为一个向量：

RBM_hidden_sizes = c(900, 500 , 300 )

1. 利用为伯努利分布输入设置限制玻尔兹曼机配方中展示的代码，生成一个 RBM 函数，使用以下输入和输出参数：

这是设置 RBM 的函数：

RBM <- function(input_data, num_input, num_output, epochs = 5, alpha = 0.1, batchsize=100){
# Placeholder variables
vb <- tf$placeholder(tf$float32, shape = shape(num_input))
hb <- tf$placeholder(tf$float32, shape = shape(num_output))
W <- tf$placeholder(tf$float32, shape = shape(num_input, num_output))
# Phase 1 : Forward Phase
X = tf$placeholder(tf$float32, shape=shape(NULL, num_input))
prob_h0= tf$nn$sigmoid(tf$matmul(X, W) + hb) #probabilities of the hidden units
h0 = tf$nn$relu(tf$sign(prob_h0 - tf$random_uniform(tf$shape(prob_h0)))) #sample_h_given_X
# Phase 2 : Backward Phase
prob_v1 = tf$nn$sigmoid(tf$matmul(h0, tf$transpose(W)) + vb)
v1 = tf$nn$relu(tf$sign(prob_v1 - tf$random_uniform(tf$shape(prob_v1))))
h1 = tf$nn$sigmoid(tf$matmul(v1, W) + hb)
# calculate gradients
w_pos_grad = tf$matmul(tf$transpose(X), h0)
w_neg_grad = tf$matmul(tf$transpose(v1), h1)
CD = (w_pos_grad - w_neg_grad) / tf$to_float(tf$shape(X)[0])
update_w = W + alpha * CD
update_vb = vb + alpha * tf$reduce_mean(X - v1)
update_hb = hb + alpha * tf$reduce_mean(h0 - h1)
# Objective function
err = tf$reduce_mean(tf$square(X - v1))
# Initialize variables
cur_w = tf$Variable(tf$zeros(shape = shape(num_input, num_output), dtype=tf$float32))
cur_vb = tf$Variable(tf$zeros(shape = shape(num_input), dtype=tf$float32))
cur_hb = tf$Variable(tf$zeros(shape = shape(num_output), dtype=tf$float32))
prv_w = tf$Variable(tf$random_normal(shape=shape(num_input, num_output), stddev=0.01, dtype=tf$float32))
prv_vb = tf$Variable(tf$zeros(shape = shape(num_input), dtype=tf$float32))
prv_hb = tf$Variable(tf$zeros(shape = shape(num_output), dtype=tf$float32))
# Start tensorflow session
sess$run(tf$global_variables_initializer())
output <- sess$run(list(update_w, update_vb, update_hb), feed_dict = dict(X=input_data,
W = prv_w$eval(),
vb = prv_vb$eval(),
hb = prv_hb$eval()))
prv_w <- output[[1]]
prv_vb <- output[[2]]
prv_hb <- output[[3]]
sess$run(err, feed_dict=dict(X= input_data, W= prv_w, vb= prv_vb, hb= prv_hb))
errors <- weights <- list()
u=1
for(ep in 1:epochs){
for(i in seq(0,(dim(input_data)[1]-batchsize),batchsize)){
batchX <- input_data[(i+1):(i+batchsize),]
output <- sess$run(list(update_w, update_vb, update_hb), feed_dict = dict(X=batchX,
W = prv_w,
vb = prv_vb,
hb = prv_hb))
prv_w <- output[[1]]
prv_vb <- output[[2]]
prv_hb <- output[[3]]
if(i%%10000 == 0){
errors[[u]] <- sess$run(err, feed_dict=dict(X= batchX, W= prv_w, vb= prv_vb, hb= prv_hb))
weights[[u]] <- output[[1]]
u=u+1
cat(i , " : ")
}
}
cat("epoch :", ep, " : reconstruction error : ", errors[length(errors)][[1]],"\n")
}
w <- prv_w
vb <- prv_vb
hb <- prv_hb
# Get the output
input_X = tf$constant(input_data)
ph_w = tf$constant(w)
ph_hb = tf$constant(hb)
out = tf$nn$sigmoid(tf$matmul(input_X, ph_w) + ph_hb)
sess$run(tf$global_variables_initializer())
return(list(output_data = sess$run(out),
error_list=errors,
weight_list=weights,
weight_final=w,
bias_final=hb))
}

1. 按顺序训练三种不同类型的隐藏节点。换句话说，首先训练包含 900 个隐藏节点的 RBM1，然后将 RBM1 的输出作为输入，训练包含 500 个隐藏节点的 RBM2，再将 RBM2 的输出作为输入，训练包含 300 个隐藏节点的 RBM3。将所有三个 RBM 的输出存储为一个列表，RBM_output：

inpX = trainX
RBM_output <- list()
for(i in 1:length(RBM_hidden_sizes)){
size <- RBM_hidden_sizes[i]
# Train the RBM
RBM_output[[i]] <- RBM(input_data= inpX,
num_input= ncol(trainX),
num_output=size,
epochs = 5,
alpha = 0.1,
batchsize=100)
# Update the input data
inpX <- RBM_output[[i]]$output_data
# Update the input_size
num_input = size
cat("completed size :", size,"\n")
}

1. 创建一个包含三个隐藏层批次误差的数据框：

error_df <- data.frame("error"=c(unlist(RBM_output[[1]]$error_list),unlist(RBM_output[[2]]$error_list),unlist(RBM_output[[3]]$error_list)),
"batches"=c(rep(seq(1:length(unlist(RBM_output[[1]]$error_list))),times=3)),
"hidden_layer"=c(rep(c(1,2,3),each=length(unlist(RBM_output[[1]]$error_list)))),
stringsAsFactors = FALSE)

1. 绘制重构均方误差：

plot(error ~ batches,
xlab = "# of batches",
ylab = "Reconstruction Error",
pch = c(1, 7, 16)[hidden_layer],
main = "Stacked RBM-Reconstruction MSE plot",
data = error_df)
legend('topright',
c("H1_900","H2_500","H3_300"),
pch = c(1, 7, 16))

它是如何工作的...

评估训练三个堆叠 RBM 的性能：在这里，我们将为每个 RBM 运行五个时期（或迭代）。每个时期将执行批量优化（批大小 = 100）。在每个批次中，计算 CD 并相应地更新权重和偏置。

为了跟踪优化过程，在每批 10,000 行数据后计算均方误差。下图显示了为三种 RBM 分别计算的 30 个批次的均方重构误差下降趋势：

实现前馈反向传播神经网络

在这个配方中，我们将实现一个带有反向传播的柳树神经网络。神经网络的输入是第三个（或最后一个）RBM 的结果。换句话说，重构的原始数据（trainX）实际上被用来训练神经网络，作为一个监督分类器来识别（10）个数字。反向传播技术用于进一步调整分类性能。

准备工作

本节提供了 TensorFlow 的要求。

• 数据集被加载并设置完毕

• TensorFlow包已经设置并加载

如何做…

本节涵盖了设置前馈反向传播神经网络的步骤：

1. 让我们将神经网络的输入参数定义为函数参数。下表描述了每个参数：

神经网络函数将具有如下脚本中所示的结构：

NN_train <- function(Xdata,Ydata,Xtestdata,Ytestdata,input_size,
learning_rate=0.1,momentum = 0.1,epochs=10,
batchsize=100,rbm_list,dbn_sizes){
library(stringi)
*## insert all the codes mentioned in next 11 points* }

1. 初始化一个长度为 4 的权重和偏置列表，第一个是一个 784 x 900 的标准差为 0.01 的正态分布张量，第二个是 900 x 500，第三个是 500 x 300，第四个是 300 x 10：

weight_list <- list()
bias_list <- list()
# Initialize variables
for(size in c(dbn_sizes,ncol(Ydata))){
#Initialize weights through a random uniform distribution
weight_list <- c(weight_list,tf$random_normal(shape=shape(input_size, size), stddev=0.01, dtype=tf$float32))
#Initialize bias as zeroes
bias_list <- c(bias_list, tf$zeros(shape = shape(size), dtype=tf$float32))
input_size = size
}

1. 检查堆叠的 RBM 的结果是否符合dbn_sizes参数中提到的隐藏层尺寸：

#Check if expected dbn_sizes are correct
if(length(dbn_sizes)!=length(rbm_list)){
stop("number of hidden dbn_sizes not equal to number of rbm outputs generated")
# check if expected sized are correct
for(i in 1:length(dbn_sizes)){
if(dbn_sizes[i] != dbn_sizes[i])
stop("Number of hidden dbn_sizes do not match")
}
}

1. 现在，将权重和偏置放置在weight_list和bias_list中的合适位置：

for(i in 1:length(dbn_sizes)){
weight_list[[i]] <- rbm_list[[i]]$weight_final
bias_list[[i]] <- rbm_list[[i]]$bias_final
}

1. 创建输入和输出数据的占位符：

input <- tf$placeholder(tf$float32, shape = shape(NULL,ncol(Xdata)))
output <- tf$placeholder(tf$float32, shape = shape(NULL,ncol(Ydata)))

1. 现在，使用从堆叠 RBM 中获得的权重和偏置来重构输入数据，并将每个 RBM 的重构数据存储在列表input_sub中：

input_sub <- list()
weight <- list()
bias <- list()
for(i in 1:(length(dbn_sizes)+1)){
weight[[i]] <- tf$cast(tf$Variable(weight_list[[i]]),tf$float32)
bias[[i]] <- tf$cast(tf$Variable(bias_list[[i]]),tf$float32)
}
input_sub[[1]] <- tf$nn$sigmoid(tf$matmul(input, weight[[1]]) + bias[[1]])
for(i in 2:(length(dbn_sizes)+1)){
input_sub[[i]] <- tf$nn$sigmoid(tf$matmul(input_sub[[i-1]], weight[[i]]) + bias[[i]])
}

1. 定义成本函数——即预测与实际数字之间的均方误差：

cost = tf$reduce_mean(tf$square(input_sub[[length(input_sub)]] - output))

1. 实现反向传播以最小化成本：

train_op <- tf$train$MomentumOptimizer(learning_rate, momentum)$minimize(cost)

1. 生成预测结果：

predict_op = tf$argmax(input_sub[[length(input_sub)]],axis=tf$cast(1.0,tf$int32))

1. 执行训练迭代：

train_accuracy <- c()
test_accuracy <- c()
for(ep in 1:epochs){
for(i in seq(0,(dim(Xdata)[1]-batchsize),batchsize)){
batchX <- Xdata[(i+1):(i+batchsize),]
batchY <- Ydata[(i+1):(i+batchsize),]
#Run the training operation on the input data
sess$run(train_op,feed_dict=dict(input = batchX,
output = batchY))
}
for(j in 1:(length(dbn_sizes)+1)){
# Retrieve weights and biases
weight_list[[j]] <- sess$run(weight[[j]])
bias_list[[j]] <- sess$ run(bias[[j]])
}
train_result <- sess$run(predict_op, feed_dict = dict(input=Xdata, output=Ydata))+1
train_actual <- as.numeric(stringi::stri_sub(colnames(as.data.frame(Ydata))[max.col(as.data.frame(Ydata),ties.method="first")],2))
test_result <- sess$run(predict_op, feed_dict = dict(input=Xtestdata, output=Ytestdata))+1
test_actual <- as.numeric(stringi::stri_sub(colnames(as.data.frame(Ytestdata))[max.col(as.data.frame(Ytestdata),ties.method="first")],2))
train_accuracy <- c(train_accuracy,mean(train_actual==train_result))
test_accuracy <- c(test_accuracy,mean(test_actual==test_result))
cat("epoch:", ep, " Train Accuracy: ",train_accuracy[ep]," Test Accuracy : ",test_accuracy[ep],"\n")
}

1. 最后，返回四个结果的列表，分别是训练准确度（train_accuracy）、测试准确度（test_accuracy）、每次迭代生成的权重矩阵列表（weight_list）和每次迭代生成的偏置向量列表（bias_list）：

return(list(train_accuracy=train_accuracy,
test_accuracy=test_accuracy,
weight_list=weight_list,
bias_list=bias_list))

1. 对定义的神经网络进行训练迭代：

NN_results <- NN_train(Xdata=trainX,
Ydata=trainY,
Xtestdata=testX,
Ytestdata=testY,
input_size=ncol(trainX),
rbm_list=RBM_output,
dbn_sizes = RBM_hidden_sizes)

1. 以下代码用于绘制训练和测试准确度：

accuracy_df <- data.frame("accuracy"=c(NN_results$train_accuracy,NN_results$test_accuracy),
"epochs"=c(rep(1:10,times=2)),
"datatype"=c(rep(c(1,2),each=10)),
stringsAsFactors = FALSE)
plot(accuracy ~ epochs,
xlab = "# of epochs",
ylab = "Accuracy in %",
pch = c(16, 1)[datatype],
main = "Neural Network - Accuracy in %",
data = accuracy_df)
legend('bottomright',
c("train","test"),
pch = c( 16, 1))

它是如何工作的…

评估神经网络的训练和测试性能：下图显示了在训练神经网络时观察到的训练和测试准确度的增长趋势：

设置深度限制玻尔兹曼机

与 DBNs 不同，深度限制玻尔兹曼机 (DRBM) 是由互联的隐藏层组成的无向网络，能够学习这些连接上的联合概率。在当前的设置中，每次迭代后，能见度和隐藏变量会从偏置偏移向量中减去，进行中心化处理。研究表明，中心化优化了 DRBM 的性能，并且与传统的 RBM 相比，可以达到更高的对数似然值。

准备就绪

本节提供了设置 DRBM 的要求：

• 已加载并设置 MNIST 数据集：

• 已设置并加载 tensorflow 包：

如何操作...

本节详细介绍了如何在 R 中使用 TensorFlow 设置 DRBM 模型的步骤：

1. 定义 DRBM 的参数：

learning_rate = 0.005
momentum = 0.005
minbatch_size = 25
hidden_layers = c(400,100)
biases = list(-1,-1)

1. 使用双曲正切定义一个 sigmoid 函数 [(log(1+x) -log(1-x))/2]：

arcsigm <- function(x){
return(atanh((2*x)-1)*2)
}

1. 使用双曲正切定义一个 sigmoid 函数 [(e^x-e(-x))/(e^x+e(-x))]：

sigm <- function(x){
return(tanh((x/2)+1)/2)
}

1. 定义一个 binarize 函数，返回一个二值矩阵（0,1）：

binarize <- function(x){
# truncated rnorm
trnrom <- function(n, mean, sd, minval = -Inf, maxval = Inf){
qnorm(runif(n, pnorm(minval, mean, sd), pnorm(maxval, mean, sd)), mean, sd)
}
return((x > matrix( trnrom(n=nrow(x)*ncol(x),mean=0,sd=1,minval=0,maxval=1), nrow(x), ncol(x)))*1)
}

1. 定义一个 re_construct 函数，返回一个像素矩阵：

re_construct <- function(x){
x = x - min(x) + 1e-9
x = x / (max(x) + 1e-9)
return(x*255)
}

1. 定义一个函数来执行给定层的 gibbs 激活：

gibbs <- function(X,l,initials){
if(l>1){
bu <- (X[l-1][[1]] - matrix(rep(initials$param_O[[l-1]],minbatch_size),minbatch_size,byrow=TRUE)) %*%
initials$param_W[l-1][[1]]
} else {
bu <- 0
}
if((l+1) < length(X)){
td <- (X[l+1][[1]] - matrix(rep(initials$param_O[[l+1]],minbatch_size),minbatch_size,byrow=TRUE))%*%
t(initials$param_W[l][[1]])
} else {
td <- 0
}
X[[l]] <- binarize(sigm(bu+td+matrix(rep(initials$param_B[[l]],minbatch_size),minbatch_size,byrow=TRUE)))
return(X[[l]])
}

1. 定义一个函数来执行偏置向量的重参数化：

reparamBias <- function(X,l,initials){
if(l>1){
bu <- colMeans((X[[l-1]] - matrix(rep(initials$param_O[[l-1]],minbatch_size),minbatch_size,byrow=TRUE))%*%
initials$param_W[[l-1]])
} else {
bu <- 0
}
if((l+1) < length(X)){
td <- colMeans((X[[l+1]] - matrix(rep(initials$param_O[[l+1]],minbatch_size),minbatch_size,byrow=TRUE))%*%
t(initials$param_W[[l]]))
} else {
td <- 0
}
initials$param_B[[l]] <- (1-momentum)*initials$param_B[[l]] + momentum*(initials$param_B[[l]] + bu + td)
return(initials$param_B[[l]])
}

1. 定义一个函数来执行偏置偏移向量的重参数化：

reparamO <- function(X,l,initials){
initials$param_O[[l]] <- colMeans((1-momentum)*matrix(rep(initials$param_O[[l]],minbatch_size),minbatch_size,byrow=TRUE) + momentum*(X[[l]]))
return(initials$param_O[[l]])
}

1. 定义一个函数来初始化权重、偏置、偏置偏移和输入矩阵：

DRBM_initialize <- function(layers,bias_list){
# Initialize model parameters and particles
param_W <- list()
for(i in 1:(length(layers)-1)){
param_W[[i]] <- matrix(0L, nrow=layers[i], ncol=layers[i+1])
}
param_B <- list()
for(i in 1:length(layers)){
param_B[[i]] <- matrix(0L, nrow=layers[i], ncol=1) + bias_list[[i]]
}
param_O <- list()
for(i in 1:length(param_B)){
param_O[[i]] <- sigm(param_B[[i]])
}
param_X <- list()
for(i in 1:length(layers)){
param_X[[i]] <- matrix(0L, nrow=minbatch_size, ncol=layers[i]) + matrix(rep(param_O[[i]],minbatch_size),minbatch_size,byrow=TRUE)
}
return(list(param_W=param_W,param_B=param_B,param_O=param_O,param_X=param_X))
}

1. 使用前面配方中引入的 MNIST 训练数据（trainX）。通过将 trainX 数据除以 255，进行标准化处理：

X <- trainX/255

1. 生成初始的权重矩阵、偏置向量、偏置偏移向量和输入矩阵：

layers <- c(784,hidden_layers)
bias_list <- list(arcsigm(pmax(colMeans(X),0.001)),biases[[1]],biases[[2]])
initials <-DRBM_initialize(layers,bias_list)

1. 对输入数据 X 进行子集化（minbatch_size）：

batchX <- X[sample(nrow(X))[1:minbatch_size],]

1. 执行 1,000 次迭代。在每次迭代中，更新初始权重和偏置 100 次，并绘制权重矩阵的图像：

for(iter in 1:1000){

# Perform some learnings
for(j in 1:100){
# Initialize a data particle
dat <- list()
dat[[1]] <- binarize(batchX)
for(l in 2:length(initials$param_X)){
dat[[l]] <- initials$param_X[l][[1]]*0 + matrix(rep(initials$param_O[l][[1]],minbatch_size),minbatch_size,byrow=TRUE)
}

# Alternate gibbs sampler on data and free particles
for(l in rep(c(seq(2,length(initials$param_X),2), seq(3,length(initials$param_X),2)),5)){
dat[[l]] <- gibbs(dat,l,initials)
}
for(l in rep(c(seq(2,length(initials$param_X),2), seq(1,length(initials$param_X),2)),1)){
initials$param_X[[l]] <- gibbs(initials$param_X,l,initials)
}

# Parameter update
for(i in 1:length(initials$param_W)){
initials$param_W[[i]] <- initials$param_W[[i]] + (learning_rate*((t(dat[[i]] - matrix(rep(initials$param_O[i][[1]],minbatch_size),minbatch_size,byrow=TRUE)) %*%
(dat[[i+1]] - matrix(rep(initials$param_O[i+1][[1]],minbatch_size),minbatch_size,byrow=TRUE))) -
(t(initials$param_X[[i]] - matrix(rep(initials$param_O[i][[1]],minbatch_size),minbatch_size,byrow=TRUE)) %*%
(initials$param_X[[i+1]] - matrix(rep(initials$param_O[i+1][[1]],minbatch_size),minbatch_size,byrow=TRUE))))/nrow(batchX))
}

for(i in 1:length(initials$param_B)){
initials$param_B[[i]] <- colMeans(matrix(rep(initials$param_B[[i]],minbatch_size),minbatch_size,byrow=TRUE) + (learning_rate*(dat[[i]] - initials$param_X[[i]])))
}

# Reparameterization
for(l in 1:length(initials$param_B)){
initials$param_B[[l]] <- reparamBias(dat,l,initials)
}
for(l in 1:length(initials$param_O)){
initials$param_O[[l]] <- reparamO(dat,l,initials)
}
}

# Generate necessary outputs
cat("Iteration:",iter," ","Mean of W of VL-HL1:",mean(initials$param_W[[1]])," ","Mean of W of HL1-HL2:",mean(initials$param_W[[2]]) ,"\n")
cat("Iteration:",iter," ","SDev of W of VL-HL1:",sd(initials$param_W[[1]])," ","SDev of W of HL1-HL2:",sd(initials$param_W[[2]]) ,"\n")

# Plot weight matrices
W=diag(nrow(initials$param_W[[1]]))
for(l in 1:length(initials$param_W)){
W = W %*% initials$param_W[[l]]
m = dim(W)[2] * 0.05
w1_arr <- matrix(0,28*m,28*m)
i=1
for(k in 1:m){
for(j in 1:28){
vec <- c(W[(28*j-28+1):(28*j),(k*m-m+1):(k*m)])
w1_arr[i,] <- vec
i=i+1
}
}
w1_arr = re_construct(w1_arr)
w1_arr <- floor(w1_arr)
image(w1_arr,axes = TRUE, col = grey(seq(0, 1, length = 256)))
}
}

它是如何工作的...

由于前面的 DRBM 使用了两个隐藏层进行训练，我们生成了两个权重矩阵。第一个权重矩阵定义了可见层和第一个隐藏层之间的连接。第二个权重矩阵定义了第一个隐藏层和第二个隐藏层之间的连接。下图显示了第一个权重矩阵的像素图像：

下图显示了第二个权重矩阵的第二个像素图像：

第六章：循环神经网络

本章将介绍用于序列数据集建模的循环神经网络。在本章中，我们将涵盖：

• 设置基础的循环神经网络

• 设置双向 RNN 模型

• 设置深度 RNN 模型

• 设置基于长短期记忆的序列模型

设置基础的循环神经网络

循环神经网络 (RNN) 用于处理存在高自相关性的序列数据集。例如，使用患者的历史数据集预测患者的就诊路径，或预测给定句子中的下一个单词。这些问题的共同点在于输入长度不固定，并且存在序列依赖性。标准的神经网络和深度学习模型受到固定大小输入的限制，并产生固定长度的输出。例如，基于占用数据集构建的深度学习神经网络有六个输入特征，并且输出为二项式结果。

准备工作

机器学习领域中的生成模型是指那些能够生成可观察数据值的模型。例如，训练一个生成模型，通过图像库生成新的图像。所有生成模型的目标是计算给定数据集的联合分布，无论是隐式还是显式地：

1. 安装并设置 TensorFlow。

2. 加载所需的包：

library(tensorflow) 

如何操作…

本节将提供设置 RNN 模型的步骤。

1. 加载 MNIST 数据集：

# Load mnist dataset from tensorflow library 
datasets <- tf$contrib$learn$datasets 
mnist <- datasets$mnist$read_data_sets("MNIST-data", one_hot = TRUE) 

1. 重置图形并开始交互式会话：

# Reset the graph and set-up a interactive session 
tf$reset_default_graph() 
sess<-tf$InteractiveSession() 

1. 使用 第四章 使用自编码器的数据表示 中的 reduceImage 函数，将图像大小缩小至 16 x 16 像素：

# Covert train data to 16 x 16  pixel image 
trainData<-t(apply(mnist$train$images, 1, FUN=reduceImage)) 
validData<-t(apply(mnist$test$images, 1, FUN=reduceImage)) 

1. 提取定义好的 train 和 valid 数据集的标签：

labels <- mnist$train$labels 
labels_valid <- mnist$test$labels

1. 定义模型参数，如输入像素的大小（n_input）、步长（step_size）、隐藏层的数量（n.hidden）和结果类别的数量（n.classes）：

# Define Model parameter 
n_input<-16 
step_size<-16 
n.hidden<-64 
n.class<-10 

1. 定义训练参数，如学习率（lr）、每批次输入数量（batch）和迭代次数（iteration）：

lr<-0.01 
batch<-500 
iteration = 100 

1. 定义一个函数 rnn，该函数接收批量输入数据集（x）、权重矩阵（weight）和偏置向量（bias）；并返回最基本 RNN 的最终预测向量：

# Set up a most basic RNN 
rnn<-function(x, weight, bias){ 
  # Unstack input into step_size 
  x = tf$unstack(x, step_size, 1) 

  # Define a most basic RNN  
  rnn_cell = tf$contrib$rnn$BasicRNNCell(n.hidden) 

  # create a Recurrent Neural Network 
  cell_output = tf$contrib$rnn$static_rnn(rnn_cell, x, dtype=tf$float32) 

  # Linear activation, using rnn inner loop  
  last_vec=tail(cell_output[[1]], n=1)[[1]] 
  return(tf$matmul(last_vec, weights) + bias) 
} 
Define a function eval_func to evaluate mean accuracy using actual (y) and predicted labels (yhat): 
# Function to evaluate mean accuracy 
eval_acc<-function(yhat, y){ 
  # Count correct solution 
  correct_Count = tf$equal(tf$argmax(yhat,1L), tf$argmax(y,1L)) 

  # Mean accuracy 
  mean_accuracy = tf$reduce_mean(tf$cast(correct_Count, tf$float32)) 

  return(mean_accuracy) 
}

1. 定义 placeholder 变量（x 和 y），并初始化权重矩阵和偏置向量：

with(tf$name_scope('input'), { 
# Define placeholder for input data 
x = tf$placeholder(tf$float32, shape=shape(NULL, step_size, n_input), name='x') 
y <- tf$placeholder(tf$float32, shape(NULL, n.class), name='y') 

# Define Weights and bias 
weights <- tf$Variable(tf$random_normal(shape(n.hidden, n.class))) 
bias <- tf$Variable(tf$random_normal(shape(n.class))) 
}) 

1. 生成预测标签：

# Evaluate rnn cell output 
yhat = rnn(x, weights, bias) 
Define the loss function and optimizer 
cost = tf$reduce_mean(tf$nn$softmax_cross_entropy_with_logits(logits=yhat, labels=y)) 
optimizer = tf$train$AdamOptimizer(learning_rate=lr)$minimize(cost) 

1. 在初始化全局变量初始化器后运行优化：

sess$run(tf$global_variables_initializer()) 
for(i in 1:iteration){ 
  spls <- sample(1:dim(trainData)[1],batch) 
  sample_data<-trainData[spls,] 
  sample_y<-labels[spls,] 

  # Reshape sample into 16 sequence with each of 16 element 
  sample_data=tf$reshape(sample_data, shape(batch, step_size, n_input)) 
  out<-optimizer$run(feed_dict = dict(x=sample_data$eval(), y=sample_y)) 

  if (i %% 1 == 0){ 
    cat("iteration - ", i, "Training Loss - ",  cost$eval(feed_dict = dict(x=sample_data$eval(), y=sample_y)), "\n") 
  } 
} 

1. 获取 valid_data 上的平均准确率：

valid_data=tf$reshape(validData, shape(-1, step_size, n_input)) 
cost$eval(feed_dict=dict(x=valid_data$eval(), y=labels_valid)) 

它是如何工作的…

任何结构上的变化都需要重新训练模型。然而，这些假设可能不适用于很多序列数据集，比如文本分类，它们可能具有不同的输入和输出。RNN 架构有助于解决可变输入长度的问题。

标准的 RNN 架构，输入和输出如图所示：

循环神经网络架构

RNN 结构可以表述为如下：

其中 是时间/索引 t 时的状态， 是时间/索引 t 时的输入。矩阵 W 表示连接隐藏节点的权重，S 连接输入与隐藏层。时间/索引 t 时的输出节点与状态 h[t] 的关系如下所示：

在前面的方程层中，权重在状态和时间上保持不变。

设置双向 RNN 模型

循环神经网络专注于仅通过使用历史状态来捕捉时间 t 的顺序信息。然而，双向 RNN 从两个方向训练模型，一个 RNN 层从开始到结束移动，另一个 RNN 层从结束到开始移动。

因此，模型依赖于历史数据和未来数据。双向 RNN 模型在存在因果结构的情况下非常有用，例如文本和语音。双向 RNN 的展开结构如下图所示：

展开的双向 RNN 结构

准备工作

安装并设置 TensorFlow：

1. 加载所需的包：

library(tensorflow) 

1. 加载 MNIST 数据集。

2. MNIST 数据集中的图像被缩小为 16 x 16 像素并进行归一化处理（详细内容请参见 设置 RNN 模型 部分）。

如何操作...

本节介绍设置双向 RNN 模型的步骤。

1. 重置图并开始交互式会话：

# Reset the graph and set-up a interactive session 
tf$reset_default_graph() 
sess<-tf$InteractiveSession() 

1. 使用 第四章 的 reduceImage 函数将图像大小减少为 16 x 16 像素，使用自编码器的数据表示：

# Covert train data to 16 x 16  pixel image 
trainData<-t(apply(mnist$train$images, 1, FUN=reduceImage)) 
validData<-t(apply(mnist$test$images, 1, FUN=reduceImage)) 

1. 提取定义的 train 和 valid 数据集的标签：

labels <- mnist$train$labels 
labels_valid <- mnist$test$labels 

1. 定义模型参数，例如输入像素的大小（n_input）、步长（step_size）、隐藏层的数量（n.hidden）和结果类别的数量（n.classes）：

# Define Model parameter 
n_input<-16 
step_size<-16 
n.hidden<-64 
n.class<-10 

1. 定义训练参数，例如学习率（lr）、每批次运行的输入数量（batch）和迭代次数（iteration）：

lr<-0.01 
batch<-500 
iteration = 100 

1. 定义一个函数来执行 bidirectional 循环神经网络：

bidirectionRNN<-function(x, weights, bias){ 
  # Unstack input into step_size 
  x = tf$unstack(x, step_size, 1) 

  # Forward lstm cell 
  rnn_cell_forward = tf$contrib$rnn$BasicRNNCell(n.hidden) 

  # Backward lstm cell 
  rnn_cell_backward = tf$contrib$rnn$BasicRNNCell(n.hidden) 

  # Get lstm cell output 
  cell_output = tf$contrib$rnn$static_bidirectional_rnn(rnn_cell_forward, rnn_cell_backward, x, dtype=tf$float32) 

  # Linear activation, using rnn inner loop last output 
  last_vec=tail(cell_output[[1]], n=1)[[1]] 
  return(tf$matmul(last_vec, weights) + bias) 
} 

1. 定义一个 eval_func 函数，用于使用实际标签（y）和预测标签（yhat）评估平均准确度：

# Function to evaluate mean accuracy 
eval_acc<-function(yhat, y){ 
  # Count correct solution 
  correct_Count = tf$equal(tf$argmax(yhat,1L), tf$argmax(y,1L)) 

  # Mean accuracy 
  mean_accuracy = tf$reduce_mean(tf$cast(correct_Count, tf$float32)) 

  return(mean_accuracy) 
} 

1. 定义 placeholder 变量（x 和 y）并初始化权重矩阵和偏差向量：

with(tf$name_scope('input'), { 
# Define placeholder for input data 
x = tf$placeholder(tf$float32, shape=shape(NULL, step_size, n_input), name='x') 
y <- tf$placeholder(tf$float32, shape(NULL, n.class), name='y') 

# Define Weights and bias 
weights <- tf$Variable(tf$random_normal(shape(n.hidden, n.class))) 
bias <- tf$Variable(tf$random_normal(shape(n.class))) 
}) 

1. 生成预测标签：

# Evaluate rnn cell output 
yhat = bidirectionRNN(x, weights, bias) 

1. 定义损失函数和优化器：

cost = tf$reduce_mean(tf$nn$softmax_cross_entropy_with_logits(logits=yhat, labels=y)) 
optimizer = tf$train$AdamOptimizer(learning_rate=lr)$minimize(cost) 

1. 在初始化会话后，使用全局变量初始化器运行优化：

sess$run(tf$global_variables_initializer()) 
# Running optimization 
for(i in 1:iteration){ 
  spls <- sample(1:dim(trainData)[1],batch) 
  sample_data<-trainData[spls,] 
  sample_y<-labels[spls,] 

  # Reshape sample into 16 sequence with each of 16 element 
  sample_data=tf$reshape(sample_data, shape(batch, step_size, n_input)) 
  out<-optimizer$run(feed_dict = dict(x=sample_data$eval(), y=sample_y)) 

  if (i %% 1 == 0){ 
    cat("iteration - ", i, "Training Loss - ",  cost$eval(feed_dict = dict(x=sample_data$eval(), y=sample_y)), "\n") 
  } 
} 

1. 获取验证数据的平均准确度：

valid_data=tf$reshape(validData, shape(-1, step_size, n_input)) 
cost$eval(feed_dict=dict(x=valid_data$eval(), y=labels_valid))

1. RNN 的代价函数收敛情况如下图所示：

MNIST 数据集上的双向循环神经网络收敛图

设置深度 RNN 模型

RNN 架构由输入层、隐藏层和输出层组成。通过将隐藏层分解为多个组，或通过在 RNN 架构中添加计算节点，例如在微学习中使用多层感知器模型，可以使 RNN 网络变深。计算节点可以添加在输入-隐藏、隐藏-隐藏和隐藏-输出的连接之间。以下是多层深度 RNN 模型的示例：

两层深度递归神经网络架构示例

如何实现...

TensorFlow 中的 RNN 模型可以通过使用 MultiRNNCell 容易地扩展为深度 RNN 模型。之前的 rnn 函数可以用 stacked_rnn 函数替换，从而实现深度 RNN 架构：

1. 定义深度 RNN 架构中的层数：

num_layers <- 3 

1. 定义一个 stacked_rnn 函数以执行多隐藏层深度 RNN：

stacked_rnn<-function(x, weight, bias){ 
  # Unstack input into step_size 
  x = tf$unstack(x, step_size, 1) 

  # Define a most basic RNN  
  network = tf$contrib$rnn$GRUCell(n.hidden) 

  # Then, assign stacked RNN cells 
  network = tf$contrib$rnn$MultiRNNCell(lapply(1:num_layers,function(k,network){network},network)) 

  # create a Recurrent Neural Network 
  cell_output = tf$contrib$rnn$static_rnn(network, x, dtype=tf$float32) 

  # Linear activation, using rnn inner loop  
  last_vec=tail(cell_output[[1]], n=1)[[1]] 
  return(tf$matmul(last_vec, weights) + bias) 
} 

设置基于长短期记忆的序列模型

在序列学习中，目标是捕捉短期记忆和长期记忆。标准的 RNN 能很好地捕捉短期记忆，但它们在捕捉长期依赖关系时并不有效，因为在 RNN 链中，梯度会随着时间的推移消失（或极少爆炸）。

当权重值很小时，梯度会消失，这些值在相乘后会随时间消失；相比之下，权重大时，随着时间的推移，值不断增大，并导致学习过程的发散。为了解决这个问题，长短期记忆（LSTM）被提出。

如何实现...

TensorFlow 中的 RNN 模型可以通过使用 BasicLSTMCell 容易地扩展为 LSTM 模型。之前的 rnn 函数可以用 lstm 函数替换，从而实现 LSTM 架构：

# LSTM implementation 
lstm<-function(x, weight, bias){ 
  # Unstack input into step_size 
  x = tf$unstack(x, step_size, 1) 

  # Define a lstm cell 
  lstm_cell = tf$contrib$rnn$BasicLSTMCell(n.hidden, forget_bias=1.0, state_is_tuple=TRUE) 

  # Get lstm cell output 
  cell_output = tf$contrib$rnn$static_rnn(lstm_cell, x, dtype=tf$float32) 

  # Linear activation, using rnn inner loop last output 
  last_vec=tail(cell_output[[1]], n=1)[[1]] 
  return(tf$matmul(last_vec, weights) + bias) 
} 

为了简洁，代码的其他部分未被复制。

它是如何工作的...

LSTM 的结构类似于 RNN，然而，基本单元却非常不同，因为传统的 RNN 使用单一的多层感知器（MLP），而 LSTM 的单个单元包含四个相互作用的输入层。这三个层是：

• 忘记门

• 输入门

• 输出门

LSTM 中的忘记门决定丢弃哪些信息，它依赖于上一个隐藏状态输出 h[t-1] 和 X[t]，其中 X[t] 表示时间 t 的输入。

忘记门的示意图

在前面的图中，C[t] 表示时间 t 时刻的单元状态。输入数据由 X[t] 表示，隐藏状态由 h[t-1] 表示。前一层可以表示为：

输入门决定更新值并决定记忆单元的候选值，同时更新单元状态，如下图所示：

输入门的示意图

• 时间 t 时刻的输入 i[t] 更新如下：

• 当前状态的期望值和输入门的输出用于更新时刻t的当前状态，计算公式为：

输出门，如下图所示，根据输入X[t]、前一层输出*h[t-1]和当前状态C[t]*来计算 LSTM 单元的输出：

输出门示意图

基于输出门的输出可以按以下方式计算：

第七章：强化学习

本章将介绍强化学习。我们将涵盖以下主题：

• 设置马尔可夫决策过程

• 执行基于模型的学习

• 执行无模型学习

引言

强化学习（RL）是机器学习的一个领域，灵感来自心理学，例如智能体（软件程序）如何采取行动以最大化累积奖励。

强化学习是基于奖励的学习方式，其中奖励要么在学习结束时出现，要么在学习过程中分配。例如，在国际象棋中，奖励是与胜负相关的，而在像网球这样的游戏中，每赢得一分就是奖励。一些强化学习的商业实例包括谷歌的 DeepMind，它利用强化学习掌握跑酷技术。类似地，特斯拉也在使用强化学习开发人工智能驱动的技术。以下图示为强化架构的一个例子：

强化学习中智能体与环境的交互

强化学习的基本符号如下：

• T(s, a, s')：表示当在状态 s 执行动作 a 时，达到状态 s' 的转移模型

• ：表示一个策略，定义了在每个可能状态下应该采取的行动！

• R(s)：表示智能体在状态 s 时获得的奖励

本章将探讨如何使用 R 设置强化模型。下一小节将介绍来自 R 的 MDPtoolbox。

设置马尔可夫决策过程

马尔可夫决策过程（MDP）是设置强化学习的基础，其中决策的结果是半控制的；即，它部分是随机的，部分是由决策者控制的。一个 MDP 通过一组可能的状态（S）、一组可能的动作（A）、一个实值奖励函数（R）以及给定动作的状态转移概率（T）来定义。此外，一个动作对某个状态的影响仅依赖于该状态本身，而不依赖于其之前的状态。

准备工作

在本节中，我们定义一个智能体在 4 x 4 网格上移动，如下图所示：

一个 4 x 4 的 16 状态网格示例

该网格有 16 个状态（S1、S2……S16）。在每个状态下，智能体可以执行四个动作（上、右、下、左）。然而，智能体将根据以下约束限制一些动作：

• 边缘上的状态将限制为只指向网格中的状态的动作。例如，智能体在 S1 时仅限于向 右 或 下 的动作。

• 一些状态转移有障碍，标记为红色。例如，智能体不能从 S2 向下转移到 S3。

每个状态也被分配了一个奖励。智能体的目标是以最少的步骤到达目标，从而获得最大奖励。除状态 S15 的奖励值为 100 外，其他所有状态的奖励值均为 -1。

这里，我们将使用 R 中的MDPtoolbox包。

如何实现...

本节将展示如何在 R 中使用MDPtoolbox设置强化学习（RL）模型：

1. 安装并加载所需的包：

Install.packages("MDPtoolbox") 
library(MDPtoolbox) 

1. 定义动作的转移概率。这里，每一行表示“从某个状态”，每一列表示“到某个状态”。由于我们有 16 个状态，每个动作的转移概率矩阵将是一个 16 x 16 的矩阵，每一行的和为 1：

up<- matrix(c(1      ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
               0.7   ,     0.2   ,     0     ,     0     ,     0     ,     0.1   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
               0     ,     0     ,     0.8   ,     0.05  ,     0     ,     0   ,     0.15  ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
               0     ,     0     ,     0.7   ,     0.3   ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
               0.1   ,     0     ,     0     ,     0     ,     0.7   ,     0.1   ,     0     ,     0     ,     0.1   ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
               0     ,     0.05  ,     0     ,     0     ,     0.7   ,     0.15   ,     0.1   ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
               0     ,     0     ,     0.05  ,     0     ,     0     ,     0.7   ,     0.15  ,     0.05  ,     0     ,     0     ,     0.05  ,     0     ,   0     ,     0     ,     0     ,     0     , 
               0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0.7   ,     0.2   ,     0     ,     0     ,     0     ,     0.1   ,   0     ,     0     ,     0     ,     0     , 
               0     ,     0     ,     0     ,     0     ,     0.05  ,     0   ,     0     ,     0     ,     0.85  ,     0.05  ,     0     ,     0     ,   0.05  ,     0     ,     0     ,     0     , 
               0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0.7   ,     0.2   ,     0.05  ,     0     ,   0     ,     0.05  ,     0     ,     0     , 
               0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0.05  ,     0     ,     0     ,     0.7   ,     0.2   ,     0     ,   0     ,     0     ,     0.05  ,     0     , 
               0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0.05  ,     0     ,     0     ,     0     ,     0.9   ,   0     ,     0     ,     0     ,     0.05  , 
               0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0.1   ,     0     ,     0     ,     0     ,   0.9   ,     0     ,     0     ,     0     , 
               0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0.1   ,     0     ,     0     ,   0.7   ,     0.2   ,     0     ,     0     , 
               0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0.05  ,     0     ,   0     ,     0.8   ,     0.15  ,     0     , 
               0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0.8   ,     0.2   ), 
nrow=16, ncol=16, byrow=TRUE) 
left<- matrix(c(1    ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0.05      ,     0.9   ,     0     ,     0     ,     0     ,   0.05  ,     0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0.9   ,     0.05  ,     0     ,     0   ,     0.05  ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0.05  ,     0.9   ,     0     ,     0   ,     0     ,     0.05  ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0.8 ,     0     ,     0     ,     0     ,     0.1   ,     0.05   ,     0     ,     0     ,     0.05  ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0.8   ,     0     ,     0     ,     0.05  ,     0.1   ,     0.05  ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0.8   ,     0     ,     0     ,     0.05   ,     0.1   ,     0.05  ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0.1   ,     0.8   ,     0     ,     0     ,     0     ,     0.1   ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0.8   ,     0   ,     0     ,     0     ,     0.1   ,     0.05  ,     0     ,     0     ,   0.05  ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0.8   ,     0     ,     0     ,     0.05  ,     0.1   ,     0.05  ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0.8   ,     0     ,     0     ,     0.1   ,     0.1   ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0.8   ,     0     ,     0     ,     0     ,     0.2   ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0.8   ,     0     ,     0     ,     0     ,   0.2   ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0.8   ,     0     ,     0     ,   0.05  ,     0.1   ,     0.05  ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0.8   ,     0     ,   0     ,     0.05  ,     0.1   ,     0.05  , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0.8   ,   0     ,     0     ,     0.05  ,     0.15), 
nrow=16, ncol=16, byrow=TRUE) 
down<- matrix(c(0.1  ,     0.8   ,     0     ,     0     ,     0.1   ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0.05      ,     0.9   ,     0     ,     0     ,     0     ,   0.05  ,     0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0.1   ,     0.8   ,     0     ,     0   ,     0.1   ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0.1   ,     0.9   ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0.05      ,     0     ,     0     ,     0     ,     0.15  ,   0.8   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0.2   ,     0.8   ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0.2   ,     0.8   ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0.1   ,     0.9   ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0.05  ,     0   ,     0     ,     0     ,     0.1   ,     0.8   ,     0     ,     0     ,   0.05  ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0.2   ,     0.8   ,     0     ,   0     ,     0     ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0.05  ,     0.8   ,     0     ,   0     ,     0     ,     0.05  ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0.05  ,     0     ,     0     ,     0     ,     0.9   ,   0     ,     0     ,     0     ,     0.05  , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0.2   ,     0.8   ,     0     ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0.05  ,     0.15  ,     0.8   ,     0     , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0.2   ,     0.8   , 
                 0   ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     1), 
nrow=16, ncol=16, byrow=TRUE) 
right<- matrix(c(0.2 ,     0.1   ,     0     ,     0     ,     0.7   ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                  0.1      ,     0.1   ,     0     ,     0     ,     0     ,   0.8   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     , 
                  0  ,     0     ,     0.2   ,     0     ,     0     ,     0   ,     0.8   ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                  0  ,     0     ,     0.1   ,     0.9   ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0.2   ,     0.1   ,     0     ,     0     ,     0.7   ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0.9   ,     0.1   ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0.05   ,     0.1   ,     0     ,     0     ,     0     ,     0.85  ,     0     ,   0     ,     0     ,     0     ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0   ,     0.1   ,     0.2   ,     0     ,     0     ,     0     ,     0.7   ,   0     ,     0     ,     0     ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0.2   ,     0     ,     0     ,     0     ,   0.8   ,     0     ,     0     ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0.1   ,     0     ,     0     ,   0     ,     0.9   ,     0     ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0.1   ,     0     ,   0     ,     0     ,     0.9   ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0.2   ,   0     ,     0     ,     0     ,     0.8   , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   1     ,     0     ,     0     ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     1     ,     0     ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     1     ,     0     , 
                  0  ,     0     ,     0     ,     0     ,     0     ,     0   ,     0     ,     0     ,     0     ,     0     ,     0     ,     0     ,   0     ,     0     ,     0     ,     1), 
nrow=16, ncol=16, byrow=TRUE) 

1. 定义一个转移概率矩阵列表：

TPMs <- list(up=up, left=left, 
down=down, right=right) 

1. 定义一个维度为：16（状态数量）x 4（动作数量）的奖励矩阵：

Rewards<- matrix(c(-1, -1, -1, -1, 
              -1, -1, -1, -1, 
              -1, -1, -1, -1, 
              -1, -1, -1, -1, 
              -1, -1, -1, -1, 
              -1, -1, -1, -1,
              -1, -1, -1, -1, 
              -1, -1, -1, -1, 
              -1, -1, -1, -1, 
              -1, -1, -1, -1, 
              -1, -1, -1, -1, 
              -1, -1, -1, -1, 
              -1, -1, -1, -1, 
              -1, -1, -1, -1, 
              100, 100, 100, 100, 
              -1, -1, -1, -1), 
nrow=16, ncol=4, byrow=TRUE) 

1. 测试定义的 TPMs 和 Rewards 是否满足一个明确的 MDP。如果返回空字符串，则说明该 MDP 是有效的：

mdp_check(TPMs, Rewards) 

执行基于模型的学习

正如名称所示，学习是通过使用预定义的模型来增强的。这里，模型以转移概率的形式表示，关键目标是使用这些预定义的模型属性（即 TPMs）来确定最优策略和价值函数。策略被定义为一个智能体的学习机制，跨多个状态进行遍历。换句话说，确定智能体在给定状态下采取的最佳动作，以便转移到下一个状态，称为策略。

策略的目标是最大化从起始状态到目标状态的累积奖励，定义如下，其中 P(s) 是从起始状态 s 开始的累积策略 P，R 是通过执行动作 at 从状态 st 转移到状态 s[t+1] 的奖励。

值函数有两种类型：状态值函数和状态-动作值函数。在状态值函数中，对于给定的策略，它被定义为处于某一特定状态（包括起始状态）的期望奖励；而在状态-动作值函数中，对于给定的策略，它被定义为处于某一特定状态（包括起始状态）并执行某一特定动作的期望奖励。

现在，若一个策略被称为最优策略，意味着它返回最大的期望累积奖励，并且其对应的状态被称为最优状态值函数，或者其对应的状态和动作被称为最优状态-动作值函数。

在基于模型的学习中，为了获得最优策略，执行以下迭代步骤，如下图所示：

迭代步骤以找到最优策略

在本节中，我们将使用状态值函数评估策略。在每次迭代中，使用贝尔曼方程动态评估策略，如下所示，其中 V[i] 表示第 i 次迭代时的值，P 表示给定状态 s 和动作 a 的任意策略，T 表示由于动作 a 从状态 s 转移到状态 s' 的转移概率，R 表示在从状态 s 执行动作 a 后到达状态 s' 时的奖励， 表示折扣因子，取值范围为（0,1）。折扣因子确保学习初期的步骤比后续步骤更为重要。

如何实现...

本节将向你展示如何设置基于模型的强化学习（RL）：

1. 使用状态-动作值函数进行策略迭代，折扣因子 Υ = 0.9：

mdp_policy<- mdp_policy_iteration(P=TPMs, R=Rewards, discount=0.9) 

1. 获取最佳（最优）策略 P*，如下图所示。绿色箭头标记显示了从 S1 到 S15 的遍历方向：

mdp_policy$policy 
names(TPMs)[mdp_policy$policy] 

使用基于模型的迭代获得最优策略，并通过最优路径从 S1 到 S15

1. 获取每个状态的最优价值函数 V* 并如图所示绘制：

mdp_policy$V 
names(mdp_policy$V) <- paste0("S",1:16) 
barplot(mdp_policy$V,col="blue",xlab="states",ylab="Optimal value",main="Value function of the optimal Policy",width=0.5) 

最优策略的价值函数

执行无模型学习

与基于模型的学习不同，基于模型的学习明确提供了转移的动态（例如从一个状态到另一个状态的转移概率），而在无模型学习中，转移应该通过状态之间的互动（使用动作）直接推断和学习，而不是显式提供。常见的无模型学习框架有蒙特卡洛方法和Q-learning技术。前者实现简单，但收敛较慢，而后者实现复杂，但由于离策略学习，收敛效率较高。

做好准备

在本节中，我们将实现 R 语言中的 Q-learning 算法。对周围环境的同时探索和对现有知识的利用被称为离策略收敛。例如，一个代理在特定状态下首先探索所有可能的动作，以过渡到下一个状态并观察相应的奖励，然后利用当前知识通过选取产生最大可能奖励的动作来更新现有的状态-动作值。

Q 学习返回一个大小为状态数 × 动作数的二维 Q 表。Q 表中的值根据以下公式更新，其中 Q 表示状态 s 和动作 a 的值，r' 表示所选动作 a 在下一个状态的奖励，Υ 表示折扣因子，α 表示学习率：

以下图所示为 Q-learning 框架：

Q-learning 框架

如何实现...

本节提供了如何设置 Q-learning 的步骤：

1. 定义 16 个状态：

states <- c("s1", "s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10", "s11", "s12", "s13", "s14", "s15", "s16") 

1. 定义四个动作：

actions<- c("up", "left", "down", "right") 

1. 定义transitionStateAction函数，该函数可以通过动作a模拟从一个状态s到另一个状态s'的转移。该函数输入当前状态s和选定的动作a，返回下一个状态s'和相应的奖励r'。在存在约束动作的情况下，返回的下一个状态为当前状态s，并返回现有奖励r：

transitionStateAction<- function(state, action) { 
  # The default state is the existing state in case of constrained action 
next_state<- state 
if (state == "s1"&& action == "down") next_state<- "s2" 
if (state == "s1"&& action == "right") next_state<- "s5" 
if (state == "s2"&& action == "up") next_state<- "s1" 
if (state == "s2"&& action == "right") next_state<- "s6" 
if (state == "s3"&& action == "right") next_state<- "s7" 
if (state == "s3"&& action == "down") next_state<- "s4" 
if (state == "s4"&& action == "up") next_state<- "s3" 
if (state == "s5"&& action == "right") next_state<- "s9" 
if (state == "s5"&& action == "down") next_state<- "s6" 
if (state == "s5"&& action == "left") next_state<- "s1" 
if (state == "s6"&& action == "up") next_state<- "s5" 
if (state == "s6"&& action == "down") next_state<- "s7" 
if (state == "s6"&& action == "left") next_state<- "s2" 
if (state == "s7"&& action == "up") next_state<- "s6" 
if (state == "s7"&& action == "right") next_state<- "s11" 
if (state == "s7"&& action == "down") next_state<- "s8" 
if (state == "s7"&& action == "left") next_state<- "s3" 
if (state == "s8"&& action == "up") next_state<- "s7" 
if (state == "s8"&& action == "right") next_state<- "s12" 
if (state == "s9"&& action == "right") next_state<- "s13" 
if (state == "s9"&& action == "down") next_state<- "s10" 
if (state == "s9"&& action == "left") next_state<- "s5" 
if (state == "s10"&& action == "up") next_state<- "s9" 
if (state == "s10"&& action == "right") next_state<- "s14" 
if (state == "s10"&& action == "down") next_state<- "s11" 
if (state == "s11"&& action == "up") next_state<- "s10" 
if (state == "s11"&& action == "right") next_state<- "s15" 
if (state == "s11"&& action == "left") next_state<- "s7" 
if (state == "s12"&& action == "right") next_state<- "s16" 
if (state == "s12"&& action == "left") next_state<- "s8" 
if (state == "s13"&& action == "down") next_state<- "s14" 
if (state == "s13"&& action == "left") next_state<- "s9" 
if (state == "s14"&& action == "up") next_state<- "s13" 
if (state == "s14"&& action == "down") next_state<- "s15" 
if (state == "s14"&& action == "left") next_state<- "s10" 
if (state == "s15"&& action == "up") next_state<- "s14" 
if (state == "s15"&& action == "down") next_state<- "s16" 
if (state == "s15"&& action == "left") next_state<- "s11" 
if (state == "s16"&& action == "up") next_state<- "s15" 
if (state == "s16"&& action == "left") next_state<- "s12" 
  # Calculate reward 
if (next_state == "s15") { 
reward<- 100 
  } else { 
reward<- -1 
  } 

return(list(state=next_state, reward=reward)) 
} 

1. 定义一个函数，通过n次迭代执行 Q 学习：

Qlearning<- function(n, initState, termState, 
epsilon, learning_rate) { 
  # Initialize a Q-matrix of size #states x #actions with zeroes 
Q_mat<- matrix(0, nrow=length(states), ncol=length(actions), 
dimnames=list(states, actions)) 
  # Run n iterations of Q-learning 
for (i in 1:n) { 
Q_mat<- updateIteration(initState, termState, epsilon, learning_rate, Q_mat) 
  } 
return(Q_mat) 
} 
   updateIteration<- function(initState, termState, epsilon, learning_rate, Q_mat) { 
state<- initState # set cursor to initial state 
while (state != termState) { 
    # Select the next action greedily or randomnly 
if (runif(1) >= epsilon) { 
action<- sample(actions, 1) # Select randomnly 
    } else { 
action<- which.max(Q_mat[state, ]) # Select best action 
    } 
    # Extract the next state and its reward 
response<- transitionStateAction(state, action) 
    # Update the corresponding value in Q-matrix (learning) 
Q_mat[state, action] <- Q_mat[state, action] + learning_rate * 
      (response$reward + max(Q_mat[response$state, ]) - Q_mat[state, action]) 
state<- response$state # update with next state 
  } 
return(Q_mat) 
} 

1. 设置学习参数，如epsilon和learning_rate：

epsilon<- 0.1 
learning_rate<- 0.9 

1. 获取经过 50 万次迭代后的 Q 表：

Q_mat<- Qlearning(500, "s1", "s15", epsilon, learning_rate) 
Q_mat 

1. 获取最佳（最优）策略 P*，如以下图所示。绿色标记的箭头显示了从S1到S15的遍历方向：

actions[max.col(Q_mat)] 

使用无模型迭代得到的最优策略，并展示从S1到S15的最优路径

第八章：深度学习在文本挖掘中的应用

本章我们将涵盖以下主题：

• 执行文本数据的预处理和情感提取

• 使用 tf-idf 分析文档

• 使用 LSTM 网络进行情感预测

• 使用 text2vec 示例的应用

执行文本数据的预处理和情感提取

在本节中，我们将使用简·奥斯汀的畅销小说《傲慢与偏见》（1813 年出版）进行文本数据预处理分析。在 R 中，我们将使用 Hadley Wickham 的tidytext包进行分词、去除停用词、使用预定义的情感词典进行情感提取、词频-逆文档频率（tf-idf）矩阵创建，并理解n-grams 之间的配对相关性。

在本节中，我们不将文本存储为字符串、语料库或文档词频矩阵（DTM），而是将其处理成每行一个标记的表格格式。

如何做……

这是我们进行预处理的步骤：

1. 加载所需的包：

load_packages=c("janeaustenr","tidytext","dplyr","stringr","ggplot2","wordcloud","reshape2","igraph","ggraph","widyr","tidyr") 
lapply(load_packages, require, character.only = TRUE) 

1. 加载《傲慢与偏见》数据集。line_num属性与书中打印的行号相似：

Pride_Prejudice <- data.frame("text" = prideprejudice, 
                              "book" = "Pride and Prejudice", 
                              "line_num" = 1:length(prideprejudice), 
                              stringsAsFactors=F) 

1. 现在，执行分词操作，将每行一个字符串的格式重新构建为每行一个标记的格式。这里，标记可以是单个单词、一组字符、共现词（n-grams）、句子、段落等。目前，我们将句子分词为单个单词：

Pride_Prejudice <- Pride_Prejudice %>% unnest_tokens(word,text) 

1. 然后，使用stop words去除语料库去除常见词，如the、and、for等：

data(stop_words) 
Pride_Prejudice <- Pride_Prejudice %>% anti_join(stop_words,
by="word") 

1. 提取最常用的文本单词：

most.common <- Pride_Prejudice %>% dplyr::count(word, sort = TRUE)

1. 可视化最常出现的前 10 个词，如下图所示：

前 10 个常见词

most.common$word  <- factor(most.common$word , levels = most.common$word) 
ggplot(data=most.common[1:10,], aes(x=word, y=n, fill=word)) + 
  geom_bar(colour="black", stat="identity")+ 
  xlab("Common Words") + ylab("N Count")+ 
  ggtitle("Top 10 common words")+ 
  guides(fill=FALSE)+ 
  theme(plot.title = element_text(hjust = 0.5))+ 
  theme(text = element_text(size = 10))+ 
  theme(panel.background = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank()) 

1. 然后，使用bing词典提取更高层次的情感（即正面或负面）。

Pride_Prejudice_POS_NEG_sentiment <- Pride_Prejudice %>% inner_join(get_sentiments("bing"), by="word") %>% dplyr::count(book, index = line_num %/% 150, sentiment) %>% spread(sentiment, n, fill = 0) %>% mutate(net_sentiment = positive - negative)

1. 可视化文本小节（150 个词）中的情感变化，如下图所示：

每个 150 个词的句子中正面和负面词的分布

ggplot(Pride_Prejudice_POS_NEG_sentiment, aes(index, net_sentiment))+ 
  geom_col(show.legend = FALSE) + 
  geom_line(aes(y=mean(net_sentiment)),color="blue")+ 
  xlab("Section (150 words each)") + ylab("Values")+ 
  ggtitle("Net Sentiment (POS - NEG) of Pride and Prejudice")+ 
  theme(plot.title = element_text(hjust = 0.5))+ 
  theme(text = element_text(size = 10))+ 
  theme(panel.background = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank())

1. 现在使用nrc词典提取更细粒度的情感（即正面、负面、愤怒、厌恶、惊讶、信任等）：

Pride_Prejudice_GRAN_sentiment <- Pride_Prejudice %>% inner_join(get_sentiments("nrc"), by="word") %>% dplyr::count(book, index = line_num %/% 150, sentiment) %>% spread(sentiment, n, fill = 0)

1. 可视化不同情感定义的变化，如下图所示：

不同类型情感的变化

ggplot(stack(Pride_Prejudice_GRAN_sentiment[,3:12]), aes(x = ind, y = values)) + 
  geom_boxplot()+ 
  xlab("Sentiment types") + ylab("Sections (150 words) of text")+ 
  ggtitle("Variation across different sentiments")+ 
  theme(plot.title = element_text(hjust = 0.5))+ 
  theme(text = element_text(size = 15))+ 
  theme(panel.background = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank())

1. 基于bing词典提取最常出现的正面和负面词，并如图所示可视化它们：

《傲慢与偏见》中正面和负面词的前 10 名

POS_NEG_word_counts <- Pride_Prejudice %>% inner_join(get_sentiments("bing"), by="word") %>% dplyr::count(word, sentiment, sort = TRUE) %>% ungroup() POS_NEG_word_counts %>% group_by(sentiment) %>% top_n(10) %>% ungroup() %>% mutate(word = reorder(word, n)) %>% ggplot(aes(word, n, fill = sentiment)) + geom_col(show.legend = FALSE) + facet_wrap(~sentiment, scales = "free_y") + ggtitle("Top 10 positive and negative words")+ coord_flip() + theme(plot.title = element_text(hjust = 0.5))+ theme(text = element_text(size = 15))+ labs(y = NULL, x = NULL)+ theme(panel.background = element_blank(),panel.border = element_rect(linetype = "dashed", fill = NA))

1. 生成如下图所示的情感词云：

正面和负面词的词云

Prejudice %>% 
inner_join(get_sentiments("bing"), by = "word") %>% dplyr::count(word, sentiment, sort = TRUE) %>% acast(word ~ sentiment, value.var = "n", fill = 0) %>% comparison.cloud(colors = c("red", "green"), max.words = 100,title.size=2, use.r.layout=TRUE, random.order=TRUE, scale=c(6,0.5)

1. 现在分析整本书各章节的情感：

2. 1. 提取章节并执行分词：

austen_books_df <- as.data.frame(austen_books(),stringsAsFactors=F) austen_books_df$book <- as.character(austen_books_df$book) Pride_Prejudice_chapters <- austen_books_df %>% group_by(book) %>% filter(book == "Pride & Prejudice") %>% mutate(chapter = cumsum(str_detect(text, regex("^chapter [\\divxlc]", ignore_case = TRUE)))) %>% ungroup() %>% unnest_tokens(word, text)

1. 1. 从bing词典中提取positive和negative词集：

bingNEG <- get_sentiments("bing") %>%  
  filter(sentiment == "negative")  
bingPOS <- get_sentiments("bing") %>%  
  filter(sentiment == "positive") 

1. 1. 获取每章的词频：

  wordcounts <- Pride_Prejudice_chapters %>% 
  group_by(book, chapter) %>% 
  dplyr::summarize(words = n()) 

1. 1. 提取正面和负面词的比例：

POS_NEG_chapter_distribution <- merge ( Pride_Prejudice_chapters %>% 
semi_join(bingNEG, by="word") %>% 
group_by(book, chapter) %>% 
dplyr::summarize(neg_words = n()) %>% 
left_join(wordcounts, by = c("book", "chapter")) %>% 
mutate(neg_ratio = round(neg_words*100/words,2)) %>% 
filter(chapter != 0) %>% 
ungroup(), 
Pride_Prejudice_chapters %>% 
semi_join(bingPOS, by="word") %>% 
group_by(book, chapter) %>%            dplyr::summarize(pos_words = n()) %>% 
left_join(wordcounts, by = c("book", "chapter")) %>% 
mutate(pos_ratio = round(pos_words*100/words,2)) %>% 
filter(chapter != 0) %>% 
ungroup() ) 

1. 1. 基于每章正面和负面词汇的比例，为每章生成情感标志：

POS_NEG_chapter_distribution$sentiment_flag <- ifelse(POS_NEG_chapter_distribution$neg_ratio > POS_NEG_chapter_distribution$pos_ratio,"NEG","POS") 
table(POS_NEG_chapter_distribution$sentiment_flag)  

它是如何工作的...

如前所述，本节使用了简·奥斯汀的著名小说《傲慢与偏见》，详细介绍了数据整理的步骤，并使用（公开的）词典提取情感。

步骤 1 和步骤 2 显示了所需的cran包和所需文本的加载。步骤 3 和步骤 4 执行 unigram 分词和停用词移除。步骤 5 和步骤 6 提取并可视化所有 62 章中出现次数最多的前 10 个单词。步骤 7 到 12 展示了使用两个广泛使用的情感词典bing和nrc进行的高层次和细粒度情感分析。

这两个词典都包含了一些广泛使用的英文单词，并将其标记为不同的情感。在bing词典中，每个单词都被标记为高层次的二元情感（积极或消极），而在nrc词典中，每个单词都被标记为细粒度的多种情感之一（积极、消极、愤怒、期待、快乐、恐惧、厌恶、信任、悲伤和惊讶）。

每个 150 个单词的句子都被标记为一个情感，并且这一点已在图中展示，图中显示了每个 150 个单词的句子中正面和负面词汇的分布。在步骤 13 中，使用bing词典中正面或负面词汇的最大出现频率对每一章进行情感标记。在 62 章中，有 52 章正面词汇出现次数更多，而 10 章负面词汇出现次数更多。

使用 tf-idf 分析文档

在本节中，我们将学习如何定量分析文档。一种简单的方法是查看文档中 unigram 单词的分布及其出现频率，也称为词频（tf）。出现频率较高的单词通常会主导文档内容。

然而，对于像“the”、“is”、“of”等常见单词，人们往往会有所不同的看法。因此，这些词会通过停用词字典被移除。除此之外，可能还有一些特定的单词，它们频繁出现但相关性较低。这类单词会通过其逆文档频率（idf）值进行惩罚。这里，出现频率较高的单词会被惩罚。

tf-idf 统计量结合了这两个量（通过乘法），并提供了一个衡量给定文档在多个文档（或语料库）中每个单词的重要性或相关性的标准。

在本节中，我们将生成《傲慢与偏见》一书中各章节的 tf-idf 矩阵。

如何做到这一点...

这是我们如何使用 tf-idf 分析文档：

1. 提取《傲慢与偏见》一书中所有 62 章的文本。然后，返回每个单词按章节出现的次数。该书的总词汇量约为 1.22M。

Pride_Prejudice_chapters <- austen_books_df %>% 
group_by(book) %>% 
filter(book == "Pride & Prejudice") %>% 
mutate(linenumber = row_number(), 
chapter = cumsum(str_detect(text, regex("^chapter [\\divxlc]",
                                        ignore_case = TRUE)))) %>% 
ungroup() %>% 
unnest_tokens(word, text) %>% 
count(book, chapter, word, sort = TRUE) %>% 
ungroup() 

1. 计算单词的排名，使得出现频率较高的单词排名较低。同时，按排名可视化词频，如下图所示：

该图显示了具有较高词频（比率）值的单词的排名较低

freq_vs_rank <- Pride_Prejudice_chapters %>%  
mutate(rank = row_number(),  
       term_frequency = n/totalwords) 
freq_vs_rank %>%  
  ggplot(aes(rank, term_frequency)) +  
  geom_line(size = 1.1, alpha = 0.8, show.legend = FALSE) +  
  scale_x_log10() + 
  scale_y_log10()

1. 使用bind_tf-idf函数计算每个单词的tf-idf值：

Pride_Prejudice_chapters <- Pride_Prejudice_chapters %>% 
bind_tf_idf(word, chapter, n)

1. 提取并可视化 tf-idf 值较高的前 15 个单词，如下图所示：

tf-idf 值的前 15 个单词

Pride_Prejudice_chapters %>% 
  select(-totalwords) %>% 
  arrange(desc(tf_idf)) 

Pride_Prejudice_chapters %>% 
  arrange(desc(tf_idf)) %>% 
  mutate(word = factor(word, levels = rev(unique(word)))) %>%  
  group_by(book) %>%  
  top_n(15) %>%  
  ungroup %>% 
  ggplot(aes(word, tf_idf, fill = book)) + 
  geom_col(show.legend = FALSE) + 
  labs(x = NULL, y = "tf-idf") + 
  facet_wrap(~book, ncol = 2, scales = "free") + 
  coord_flip() 

它是如何工作的...

如前所述，可以观察到，非常常见的单词，如the，其 tf-idf 值接近零，而出现较少的单词，如专有名词Austen，其 tf-idf 值接近一。

使用 LSTM 网络进行情感预测

在本节中，我们将使用 LSTM 网络进行情感分析。与传统的前馈神经网络不同，LSTM 网络不仅考虑单词本身，还通过递归连接考虑序列，这使得它比传统的神经网络更准确。

在这里，我们将使用cran包中的movie reviews数据集text2vec。该数据集包含 5000 条 IMDb 电影评论，每条评论都标记有二元情感标志（正面或负面）。

如何操作...

下面是如何使用 LSTM 进行情感预测的方法：

1. 加载所需的包和电影评论数据集：

load_packages=c("text2vec","tidytext","tensorflow") 
lapply(load_packages, require, character.only = TRUE) 
data("movie_review") 

1. 提取电影评论和标签，分别作为数据框和矩阵。在电影评论中，添加一个额外的属性"Sno"表示评论编号。在标签矩阵中，添加与negative flag相关的附加属性。

reviews <- data.frame("Sno" = 1:nrow(movie_review), 
                         "text"=movie_review$review, 
                         stringsAsFactors=F) 

labels <- as.matrix(data.frame("Positive_flag" = movie_review$sentiment,"negative_flag" = (1
                    movie_review$sentiment)))

1. 提取所有评论中的独特单词，并获取它们的出现次数（n）。同时，给每个单词标记一个唯一整数（orderNo）。因此，每个单词都使用唯一整数进行编码，之后将用于 LSTM 网络。

reviews_sortedWords <- reviews %>% unnest_tokens(word,text) %>% dplyr::count(word, sort = TRUE) 
reviews_sortedWords$orderNo <- 1:nrow(reviews_sortedWords) 
reviews_sortedWords <- as.data.frame(reviews_sortedWords) 

1. 现在，根据单词的出现情况将标记的单词重新分配给评论：

reviews_words <- reviews %>% unnest_tokens(word,text) 
reviews_words <- plyr::join(reviews_words,reviews_sortedWords,by="word") 

1. 使用第 4 步的结果，创建一个评论列表，将每条评论转换为表示单词的编码数字集合：

reviews_words_sno <- list() 
for(i in 1:length(reviews$text))
{ 
  reviews_words_sno[[i]] <- c(subset(reviews_words,Sno==i,orderNo)) 
} 

1. 为了方便将等长序列输入 LSTM 网络，我们将限制评论长度为 150 个单词。换句话说，超过 150 个单词的评论将被截断为前 150 个单词，而短于 150 个单词的评论将通过在前面添加必要数量的零填充为 150 个单词。因此，我们现在添加一个新的单词0。

reviews_words_sno <- lapply(reviews_words_sno,function(x) 
{ 
  x <- x$orderNo 
  if(length(x)>150)
  { 
    return (x[1:150]) 
  } 
  else 
  { 
  return(c(rep(0,150-length(x)),x)) 
  } 
})

1. 现在，将这 5000 条评论按 70:30 的比例拆分为训练集和测试集。同时，将训练集和测试集评论按行合并成矩阵格式，行表示评论，列表示单词的位置：

train_samples <- caret::createDataPartition(c(1:length(labels[1,1])),p = 0.7)$Resample1 

train_reviews <- reviews_words_sno[train_samples] 
test_reviews <- reviews_words_sno[-train_samples] 

train_reviews <- do.call(rbind,train_reviews) 
test_reviews <- do.call(rbind,test_reviews)  

1. 同样地，也将标签根据情况拆分为训练集和测试集：

train_labels <- as.matrix(labels[train_samples,]) 
test_labels <- as.matrix(labels[-train_samples,]) 

1. 重置图，并启动交互式 TensorFlow 会话：

tf$reset_default_graph() 
sess<-tf$InteractiveSession() 

1. 定义模型参数，如输入像素的大小（n_input）、步长（step_size）、隐藏层的数量（n.hidden）和输出类别的数量（n.classes）：

n_input<-15 
step_size<-10 
n.hidden<-2 
n.class<-2 

1. 定义训练参数，如学习率(lr)、每批次输入的数量(batch)和迭代次数(iteration)：

lr<-0.01 
batch<-200 
iteration = 500

1. 基于第六章《循环神经网络》中定义的 RNN 和 LSTM 函数，来自《使用全局变量初始化器运行优化》部分。

sess$run(tf$global_variables_initializer()) 
train_error <- c() 
for(i in 1:iteration){ 
  spls <- sample(1:dim(train_reviews)[1],batch) 
  sample_data<-train_reviews[spls,] 
  sample_y<-train_labels[spls,] 

  # Reshape sample into 15 sequence with each of 10 elements 
  sample_data=tf$reshape(sample_data, shape(batch, step_size, n_input)) 
  out<-optimizer$run(feed_dict = dict(x=sample_data$eval(session = sess), y=sample_y)) 

  if (i %% 1 == 0){ 
    cat("iteration - ", i, "Training Loss - ",  cost$eval(feed_dict = dict(x=sample_data$eval(), y=sample_y)), "\n") 
  } 
  train_error <-  c(train_error,cost$eval(feed_dict = dict(x=sample_data$eval(), y=sample_y))) 
} 

1. 绘制训练误差在各次迭代中的减少情况，如下图所示：

训练数据集的情感预测误差分布

plot(train_error, main="Training sentiment prediction error", xlab="Iterations", ylab = "Train Error")

1. 获取测试数据的误差：

test_data=tf$reshape(test_reviews, shape(-1, step_size, n_input)) 
cost$eval(feed_dict=dict(x= test_data$eval(), y=test_labels))

它是如何工作的...

在第 1 到第 8 步中，加载、处理并转换电影评论数据集为一组训练和测试矩阵，可以直接用于训练 LSTM 网络。第 9 到第 14 步用于运行使用 TensorFlow 的 LSTM，如第六章《循环神经网络》中所描述。图表《训练数据集情感预测误差分布》显示了在 500 次迭代中训练误差的下降。

使用 text2vec 示例的应用

在本节中，我们将分析逻辑回归在各种text2vec示例中的性能。

如何操作...

这是我们如何应用text2vec的方式：

1. 加载所需的包和数据集：

library(text2vec) 
library(glmnet) 
data("movie_review") 

1. 执行 Lasso 逻辑回归的函数，并返回训练和测试的AUC值：

logistic_model <- function(Xtrain,Ytrain,Xtest,Ytest)
{ 
  classifier <- cv.glmnet(x=Xtrain, y=Ytrain, 
  family="binomial", alpha=1, type.measure = "auc", 
  nfolds = 5, maxit = 1000) 
  plot(classifier) 
  vocab_test_pred <- predict(classifier, Xtest, type = "response") 
  return(cat("Train AUC : ", round(max(classifier$cvm), 4), 
  "Test AUC : ",glmnet:::auc(Ytest, vocab_test_pred),"\n")) 
} 

1. 将电影评论数据按 80:20 比例划分为训练集和测试集：

train_samples <- caret::createDataPartition(c(1:length(labels[1,1])),p = 0.8)$Resample1 
train_movie <- movie_review[train_samples,] 
test_movie <- movie_review[-train_samples,] 

1. 生成所有词汇词的 DTM（不去除任何停用词），并使用 Lasso 逻辑回归评估其性能：

train_tokens <- train_movie$review %>% tolower %>% word_tokenizer 
test_tokens <- test_movie$review %>% tolower %>% word_tokenizer 

vocab_train <- create_vocabulary(itoken(train_tokens,ids=train$id,progressbar = FALSE)) 

# Create train and test DTMs 
vocab_train_dtm <- create_dtm(it = itoken(train_tokens,ids=train$id,progressbar = FALSE), 
                              vectorizer = vocab_vectorizer(vocab_train)) 
vocab_test_dtm <- create_dtm(it = itoken(test_tokens,ids=test$id,progressbar = FALSE), 
                              vectorizer = vocab_vectorizer(vocab_train)) 

dim(vocab_train_dtm) 
dim(vocab_test_dtm) 

# Run LASSO (L1 norm) Logistic Regression 
logistic_model(Xtrain = vocab_train_dtm, 
               Ytrain = train_movie$sentiment, 
               Xtest = vocab_test_dtm, 
               Ytest = test_movie$sentiment) 

1. 使用停用词列表进行修剪，然后使用 Lasso 逻辑回归评估性能：

data("stop_words") 
vocab_train_prune <- create_vocabulary(itoken(train_tokens,ids=train$id,progressbar = FALSE), 
                                       stopwords = stop_words$word) 

vocab_train_prune <- prune_vocabulary(vocab_train_prune,term_count_min = 15, 
                                      doc_proportion_min = 0.0005, 
                                      doc_proportion_max = 0.5) 

vocab_train_prune_dtm <- create_dtm(it = itoken(train_tokens,ids=train$id,progressbar = FALSE), 
                              vectorizer = vocab_vectorizer(vocab_train_prune)) 
vocab_test_prune_dtm <- create_dtm(it = itoken(test_tokens,ids=test$id,progressbar = FALSE), 
                             vectorizer = vocab_vectorizer(vocab_train_prune)) 

logistic_model(Xtrain = vocab_train_prune_dtm, 
               Ytrain = train_movie$sentiment, 
               Xtest = vocab_test_prune_dtm, 
               Ytest = test_movie$sentiment) 

1. 使用n-gram（单词单元和二元词组）生成 DTM，然后使用 Lasso 逻辑回归评估性能：

vocab_train_ngrams <- create_vocabulary(itoken(train_tokens,ids=train$id,progressbar = FALSE), 
                                        ngram = c(1L, 2L)) 

vocab_train_ngrams <- prune_vocabulary(vocab_train_ngrams,term_count_min = 10, 
                                       doc_proportion_min = 0.0005, 
                                       doc_proportion_max = 0.5) 

vocab_train_ngrams_dtm <- create_dtm(it = itoken(train_tokens,ids=train$id,progressbar = FALSE), 
                                    vectorizer = vocab_vectorizer(vocab_train_ngrams)) 
vocab_test_ngrams_dtm <- create_dtm(it = itoken(test_tokens,ids=test$id,progressbar = FALSE), 
                                   vectorizer = vocab_vectorizer(vocab_train_ngrams)) 

logistic_model(Xtrain = vocab_train_ngrams_dtm, 
               Ytrain = train_movie$sentiment, 
               Xtest = vocab_test_ngrams_dtm, 
               Ytest = test_movie$sentiment) 

1. 执行特征哈希，然后使用 Lasso 逻辑回归评估性能：

vocab_train_hashing_dtm <- create_dtm(it = itoken(train_tokens,ids=train$id,progressbar = FALSE), 
                                      vectorizer = hash_vectorizer(hash_size = 2¹⁴, ngram = c(1L, 2L))) 
vocab_test_hashing_dtm <- create_dtm(it = itoken(test_tokens,ids=test$id,progressbar = FALSE), 
                                    vectorizer = hash_vectorizer(hash_size = 2¹⁴, ngram = c(1L, 2L))) 

logistic_model(Xtrain = vocab_train_hashing_dtm, 
               Ytrain = train_movie$sentiment, 
               Xtest = vocab_test_hashing_dtm, 
               Ytest = test_movie$sentiment) 

1. 在完整词汇 DTM 上使用 tf-idf 转换，使用 Lasso 逻辑回归评估性能：

vocab_train_tfidf <- fit_transform(vocab_train_dtm, TfIdf$new()) 
vocab_test_tfidf <- fit_transform(vocab_test_dtm, TfIdf$new()) 

logistic_model(Xtrain = vocab_train_tfidf, 
               Ytrain = train_movie$sentiment, 
               Xtest = vocab_test_tfidf, 
               Ytest = test_movie$sentiment)  

它是如何工作的...

第 1 到第 3 步加载评估不同text2vec示例所需的必要包、数据集和函数。逻辑回归使用glmnet包实现，并采用 L1 惩罚（Lasso 正则化）。在第 4 步，使用训练集中的所有词汇创建 DTM，测试auc值为 0.918。在第 5 步，通过停用词和词频修剪训练和测试 DTM。

测试auc值观察到为 0.916，与使用所有词汇时相比没有太大下降。在第 6 步，除了单个词（或单元语法），还将二元语法（bi-grams）添加到词汇中。测试auc值增加到 0.928。接着，在第 7 步进行特征哈希，测试auc值为 0.895。尽管auc值有所降低，但哈希旨在提高大数据集的运行时性能。特征哈希是由 Yahoo 广泛推广的。最后，在第 8 步，进行 tf-idf 转换，返回测试auc值为 0.907。

第九章：深度学习在信号处理中的应用

本章将展示使用生成建模技术（如 RBM）创建新音乐音符的案例研究。在本章中，我们将涵盖以下主题：

• 介绍并预处理音乐 MIDI 文件

• 构建 RBM 模型

• 生成新的音乐音符

介绍并预处理音乐 MIDI 文件

在本节中，我们将读取一个 音乐数字接口（MIDI）文件库，并将其预处理为适用于 RBM 的格式。MIDI 是存储音乐音符的格式之一，可以转换为其他格式，如 .wav、.mp3、.mp4 等。MIDI 文件格式存储各种事件，如 Note-on、Note-off、Tempo、Time Signature、End of track 等。然而，我们将主要关注音符的类型——何时被打开，何时被关闭。

每首歌都被编码成一个二进制矩阵，其中行代表时间，列代表开启和关闭的音符。在每个时间点，一个音符被打开，随后同一个音符被关闭。假设，在 n 个音符中，第 i 个音符在时间 j 被打开并关闭，那么位置 Mji = 1 和 Mj(n+i) = 1，其余 Mj = 0。

所有的音符组合在一起形成一首歌。目前，在本章中，我们将利用 Python 代码将 MIDI 歌曲编码成二进制矩阵，这些矩阵可以在限制玻尔兹曼机（RBM）中使用。

准备就绪

让我们看看处理 MIDI 文件的前提条件：

1. 下载 MIDI 歌曲库：

github.com/dshieble/Music_RBM/tree/master/Pop_Music_Midi

1. 下载用于操作 MIDI 歌曲的 Python 代码：

github.com/dshieble/Music_RBM/blob/master/midi_manipulation.py

1. 安装 "reticulate" 包，它提供了 R 与 Python 的接口：

Install.packages("reticulate") 

1. 导入 Python 库：

use_condaenv("python27") 
midi <- import_from_path("midi",path="C:/ProgramData/Anaconda2/Lib/site-packages") 
np <- import("numpy") 
msgpack <- import_from_path("msgpack",path="C:/ProgramData/Anaconda2/Lib/site-packages") 
psys <- import("sys") 
tqdm <- import_from_path("tqdm",path="C:/ProgramData/Anaconda2/Lib/site-packages") 
midi_manipulation_updated <- import_from_path("midi_manipulation_updated",path="C:/Music_RBM") 
glob <- import("glob") 

如何做到这一点...

现在我们已经设置了所有基本条件，让我们看看定义 MIDI 文件的函数：

1. 定义一个函数来读取 MIDI 文件并将其编码成二进制矩阵：

get_input_songs <- function(path){ 
  files = glob$glob(paste0(path,"/*mid*")) 
  songs <- list() 
  count <- 1 
  for(f in files){ 
    songs[[count]] <- np$array(midi_manipulation_updated$midiToNoteStateMatrix(f)) 
    count <- count+1 
  } 
  return(songs) 
} 
path <- 'Pop_Music_Midi' 
input_songs <- get_input_songs(path) 

构建 RBM 模型

在本节中，我们将构建一个 RBM 模型，如 第五章中详细讨论的 深度学习中的生成模型。

准备就绪

让我们为模型设置系统：

1. 在钢琴中，最低音符是 24，最高音符是 102；因此，音符的范围是 78。这样，编码矩阵中的列数为 156（即 78 个 Note-on 和 78 个 Note-off）：

lowest_note = 24L 
highest_note = 102L 
note_range = highest_note-lowest_note 

1. 我们将每次创建 15 步的音符，输入层有 2,340 个节点，隐藏层有 50 个节点：

num_timesteps  = 15L 
num_input      = 2L*note_range*num_timesteps 
num_hidden       = 50L 

1. 学习率（alpha）为 0.1：

alpha<-0.1 

如何做到这一点...

探讨构建 RBM 模型的步骤：

1. 定义 placeholder 变量：

vb <- tf$placeholder(tf$float32, shape = shape(num_input)) 
hb <- tf$placeholder(tf$float32, shape = shape(num_hidden)) 
W <- tf$placeholder(tf$float32, shape = shape(num_input, num_hidden)) 

1. 定义一个前向传递：

X = tf$placeholder(tf$float32, shape=shape(NULL, num_input)) 
prob_h0= tf$nn$sigmoid(tf$matmul(X, W) + hb)   
h0 = tf$nn$relu(tf$sign(prob_h0 - tf$random_uniform(tf$shape(prob_h0)))) 

1. 然后，定义一个反向传递：

prob_v1 = tf$matmul(h0, tf$transpose(W)) + vb 
v1 = prob_v1 + tf$random_normal(tf$shape(prob_v1), mean=0.0, stddev=1.0, dtype=tf$float32) 
h1 = tf$nn$sigmoid(tf$matmul(v1, W) + hb)     

1. 相应地计算正向和负向梯度：

w_pos_grad = tf$matmul(tf$transpose(X), h0) 
w_neg_grad = tf$matmul(tf$transpose(v1), h1) 
CD = (w_pos_grad - w_neg_grad) / tf$to_float(tf$shape(X)[0]) 
update_w = W + alpha * CD 
update_vb = vb + alpha * tf$reduce_mean(X - v1) 
update_hb = hb + alpha * tf$reduce_mean(h0 - h1) 

1. 定义目标函数：

err = tf$reduce_mean(tf$square(X - v1)) 

1. 初始化当前和先前的变量：

cur_w = tf$Variable(tf$zeros(shape = shape(num_input, num_hidden), dtype=tf$float32)) 
cur_vb = tf$Variable(tf$zeros(shape = shape(num_input), dtype=tf$float32)) 
cur_hb = tf$Variable(tf$zeros(shape = shape(num_hidden), dtype=tf$float32)) 
prv_w = tf$Variable(tf$random_normal(shape=shape(num_input, num_hidden), stddev=0.01, dtype=tf$float32)) 
prv_vb = tf$Variable(tf$zeros(shape = shape(num_input), dtype=tf$float32)) 
prv_hb = tf$Variable(tf$zeros(shape = shape(num_hidden), dtype=tf$float32)) 

1. 启动 TensorFlow 会话：

sess$run(tf$global_variables_initializer()) 
song = np$array(trainX) 
song = song[1:(np$floor(dim(song)[1]/num_timesteps)*num_timesteps),] 
song = np$reshape(song, newshape=shape(dim(song)[1]/num_timesteps, dim(song)[2]*num_timesteps)) 
output <- sess$run(list(update_w, update_vb, update_hb), feed_dict = dict(X=song, 
                                                                          W = prv_w$eval(), 
                                                                          vb = prv_vb$eval(), 
                                                                          hb = prv_hb$eval())) 
prv_w <- output[[1]]  
prv_vb <- output[[2]] 
prv_hb <-  output[[3]] 
sess$run(err, feed_dict=dict(X= song, W= prv_w, vb= prv_vb, hb= prv_hb)) 

1. 运行200次训练周期：

epochs=200 
errors <- list() 
weights <- list() 
u=1 
for(ep in 1:epochs){ 
  for(i in seq(0,(dim(song)[1]-100),100)){ 
    batchX <- song[(i+1):(i+100),] 
    output <- sess$run(list(update_w, update_vb, update_hb), feed_dict = dict(X=batchX, 
                                                                              W = prv_w, 
                                                                              vb = prv_vb, 
                                                                              hb = prv_hb)) 
    prv_w <- output[[1]]  
    prv_vb <- output[[2]] 
    prv_hb <-  output[[3]] 
    if(i%%500 == 0){ 
      errors[[u]] <- sess$run(err, feed_dict=dict(X= song, W= prv_w, vb= prv_vb, hb= prv_hb)) 
      weights[[u]] <- output[[1]] 
      u <- u+1 
      cat(i , " : ") 
    } 
  } 
  cat("epoch :", ep, " : reconstruction error : ", errors[length(errors)][[1]],"\n") 
} 

生成新的音乐音符

在这个食谱中，我们将生成新的样本音乐音符。可以通过改变参数num_timesteps来生成新的音乐音符。然而，应该记住增加时间步数，因为在当前的 RBM 设置中，随着向量维度的增加，处理起来可能会变得计算效率低下。通过创建它们的堆叠（即深度置信网络），这些 RBM 可以在学习中变得更高效。读者可以利用第五章中深度学习中的生成模型的 DBN 代码来生成新的音乐音符。

如何操作...

1. 创建新的样本音乐：

hh0 = tf$nn$sigmoid(tf$matmul(X, W) + hb) 
vv1 = tf$nn$sigmoid(tf$matmul(hh0, tf$transpose(W)) + vb) 
feed = sess$run(hh0, feed_dict=dict( X= sample_image, W= prv_w, hb= prv_hb)) 
rec = sess$run(vv1, feed_dict=dict( hh0= feed, W= prv_w, vb= prv_vb)) 
S = np$reshape(rec[1,],newshape=shape(num_timesteps,2*note_range)) 

1. 重新生成 MIDI 文件：

midi_manipulation$noteStateMatrixToMidi(S, name=paste0("generated_chord_1")) 
generated_chord_1 

第十章：迁移学习

在本章中，我们将讨论迁移学习的概念。以下是将要涵盖的主题：

• 演示如何使用预训练模型

• 设置迁移学习模型

• 构建图像分类模型

• 在 GPU 上训练深度学习模型

• 比较使用 CPU 和 GPU 的性能

介绍

近年来，深度学习领域发生了许多发展，提升了算法的有效性和计算效率，涵盖了文本、图像、音频和视频等不同领域。然而，当涉及到在新数据集上进行训练时，机器学习通常会从零开始重建模型，就像在传统数据科学问题解决中所做的一样。当需要训练一个新的大数据集时，这会变得很具挑战性，因为它需要非常高的计算能力和大量时间才能达到预期的模型效果。

迁移学习是一种从现有模型中学习新场景的机制。这种方法对于在大数据集上训练非常有用，不一定来自相似的领域或问题描述。例如，研究人员展示了迁移学习的例子，其中他们在完全不同的问题场景下进行了迁移学习训练，例如使用分类猫和狗的模型来分类物体，如飞机与汽车。

从类比的角度来看，它更多的是将已学到的关系传递到新的架构中，以便微调权重。以下图示展示了迁移学习的应用示例：

迁移学习流程示意图

图示展示了迁移学习的步骤，其中一个预先开发的深度学习模型的权重/架构被重用以预测一个新的问题。迁移学习有助于为深度学习架构提供一个良好的起点。不同领域的多个开源项目正在进行中，促进了迁移学习的应用，例如，ImageNet (image-net.org/index)是一个用于图像分类的开源项目，许多不同的架构，如 Alexnet、VGG16 和 VGG19，已经在该项目中得到了开发。同样，在文本挖掘领域，Google News 的 Word2Vec 表示法已经通过三十亿个单词训练完成。

有关 word2vec 的详细信息，请参见code.google.com/archive/p/word2vec/.

演示如何使用预训练模型

当前的配方将涵盖使用预训练模型的设置。我们将使用 TensorFlow 来演示该配方。当前的配方将使用基于 ImageNet 数据集构建的 VGG16 架构。ImageNet 是一个开源图像库，旨在构建图像识别算法。该数据库拥有超过 1000 万张标记图像，且超过 100 万张图像包含了捕获物体的边界框。

使用 ImageNet 数据集开发了许多不同的深度学习架构。一个受欢迎的架构是 VGG 网络，它是由 Zisserman 和 Simonyan（2014）提出的卷积神经网络，并在包含 1,000 个类别的 ImageNet 数据集上进行训练。当前的方案将考虑 VGG 架构的 VGG16 变种，它因其简洁性而著名。该网络使用 224 x 224 RGB 图像作为输入。网络使用了 13 个卷积层，具有不同的宽度 x 高度 x 深度。最大池化层用于减小卷积层输出的体积大小。该网络使用了 5 个最大池化层。卷积层的输出通过 3 个全连接层。全连接层的输出通过 softmax 函数来评估 1,000 类的概率。

VGG16 的详细架构如下图所示：

VGG16 架构

准备就绪

本部分介绍了使用 VGG16 预训练模型进行分类所需的步骤。

1. 从 download.tensorflow.org/models/vgg_16_2016_08_28.tar.gz 下载 VGG16 权重文件。可以使用以下脚本下载文件：

require(RCurl) 
URL <- 'http://download.tensorflow.org/models/vgg_16_2016_08_28.tar.gz' 
download.file(URL,destfile="vgg_16_2016_08_28.tar.gz",method="libcurl") 

1. 在 Python 中安装 TensorFlow。

2. 在 R 中安装 R 和 tensorflow 包。

3. 从 image-net.org/download-imageurls 下载示例图像。

如何操作...

当前部分提供使用预训练模型的步骤：

1. 在 R 中加载 tensorflow：

require(tensorflow) 

1. 从 TensorFlow 中导入 slim 库：

slimobj = tf$contrib$slim 

TensorFlow 中的 slim 库用于维护复杂的神经网络模型，涵盖定义、训练和评估等方面。

1. 在 TensorFlow 中重置图：

tf$reset_default_graph() 

1. 定义输入图像：

# Resizing the images 
input.img= tf$placeholder(tf$float32, shape(NULL, NULL, NULL, 3)) 
scaled.img = tf$image$resize_images(input.img, shape(224,224))

1. 重新定义 VGG16 网络：

# Define VGG16 network 
library(magrittr) 
VGG16.model<-function(slim, input.image){ 
  vgg16.network = slim$conv2d(input.image, 64, shape(3,3), scope='vgg_16/conv1/conv1_1') %>%  
    slim$conv2d(64, shape(3,3), scope='vgg_16/conv1/conv1_2')  %>% 
    slim$max_pool2d( shape(2, 2), scope='vgg_16/pool1')  %>% 

    slim$conv2d(128, shape(3,3), scope='vgg_16/conv2/conv2_1')  %>% 
    slim$conv2d(128, shape(3,3), scope='vgg_16/conv2/conv2_2')  %>% 
    slim$max_pool2d( shape(2, 2), scope='vgg_16/pool2')  %>% 

    slim$conv2d(256, shape(3,3), scope='vgg_16/conv3/conv3_1')  %>% 
    slim$conv2d(256, shape(3,3), scope='vgg_16/conv3/conv3_2')  %>% 
    slim$conv2d(256, shape(3,3), scope='vgg_16/conv3/conv3_3')  %>% 
    slim$max_pool2d(shape(2, 2), scope='vgg_16/pool3')  %>% 

    slim$conv2d(512, shape(3,3), scope='vgg_16/conv4/conv4_1')  %>% 
    slim$conv2d(512, shape(3,3), scope='vgg_16/conv4/conv4_2')  %>% 
    slim$conv2d(512, shape(3,3), scope='vgg_16/conv4/conv4_3')  %>% 
    slim$max_pool2d(shape(2, 2), scope='vgg_16/pool4')  %>% 

    slim$conv2d(512, shape(3,3), scope='vgg_16/conv5/conv5_1')  %>% 
    slim$conv2d(512, shape(3,3), scope='vgg_16/conv5/conv5_2')  %>% 
    slim$conv2d(512, shape(3,3), scope='vgg_16/conv5/conv5_3')  %>% 
    slim$max_pool2d(shape(2, 2), scope='vgg_16/pool5')  %>% 

    slim$conv2d(4096, shape(7, 7), padding='VALID', scope='vgg_16/fc6')  %>% 
    slim$conv2d(4096, shape(1, 1), scope='vgg_16/fc7') %>%  

    slim$conv2d(1000, shape(1, 1), scope='vgg_16/fc8')  %>% 
    tf$squeeze(shape(1, 2), name='vgg_16/fc8/squeezed') 
  return(vgg16.network) 
} 

1. 上面的函数定义了用于 VGG16 网络的网络架构。可以使用以下脚本来定义网络：

vgg16.network<-VGG16.model(slim, input.image = scaled.img) 

1. 加载 入门指南 部分中下载的 VGG16 权重 vgg_16_2016_08_28.tar.gz：

# Restore the weights 
restorer = tf$train$Saver() 
sess = tf$Session() 
restorer$restore(sess, 'vgg_16.ckpt')

1. 下载示例测试图像。让我们根据以下脚本从 testImgURL 位置下载一个示例图像：

# Evaluating using VGG16 network 
testImgURL<-"http://farm4.static.flickr.com/3155/2591264041_273abea408.jpg" 
img.test<-tempfile() 
download.file(testImgURL,img.test, mode="wb") 
read.image <- readJPEG(img.test) 
# Clean-up the temp file 
file.remove(img.test)  

上面的脚本从变量 testImgURL 中提到的 URL 下载以下图片。以下是下载的图片：

用于评估 imagenet 的示例图像

1. 使用 VGG16 预训练模型确定类别：

## Evaluate  
size = dim(read.image) 
imgs = array(255*read.image, dim = c(1, size[1], size[2], size[3])) 
VGG16_eval = sess$run(vgg16.network, dict(images = imgs)) 
probs = exp(VGG16_eval)/sum(exp(VGG16_eval))  

所达到的最大概率为 0.62，属于类别 672，该类别在 VGG16 训练数据集中对应的标签是——山地自行车，全地形自行车，越野车。

设置迁移学习模型

当前方案将涵盖使用 CIFAR-10 数据集进行迁移学习。上一方案介绍了如何使用预训练模型。当前方案将展示如何将预训练模型应用于不同的问题陈述。

我们将使用另一个非常好的深度学习包，MXNET，通过另一种架构 Inception 来演示该概念。为了简化计算，我们将问题的复杂度从 10 个类别减少到两个类别：飞机和汽车。这个食谱的重点是使用 Inception-BN 进行迁移学习的数据准备。

做好准备

本节为即将到来的迁移学习模型设置部分做准备。

1. 从www.cs.toronto.edu/~kriz/cifar.html下载 CIFAR-10 数据集。可以使用第三章中的download.cifar.data函数来下载数据集，卷积神经网络章节。

2. 安装imager包：

install.packages("imager")

如何操作...

本部分食谱将提供一步步的指南，准备数据集以用于 Inception-BN 预训练模型。

1. 加载依赖包：

# Load packages 
require(imager) 
source("download_cifar_data.R") 
The download_cifar_data consists of function to download and read CIFAR10 dataset. 

1. 读取下载的 CIFAR-10 数据集：

# Read Dataset and labels  
DATA_PATH<-paste(SOURCE_PATH, "/Chapter 4/data/cifar-10-batches-bin/", sep="") 
labels <- read.table(paste(DATA_PATH, "batches.meta.txt", sep="")) 
cifar_train <- read.cifar.data(filenames = c("data_batch_1.bin","data_batch_2.bin","data_batch_3.bin","data_batch_4.bin")) 

1. 过滤数据集中的飞机和汽车。这是一个可选步骤，用于简化后续的复杂度：

# Filter data for Aeroplane and Automobile with label 1 and 2, respectively 
Classes = c(1, 2)  
images.rgb.train <- cifar_train$images.rgb 
images.lab.train <- cifar_train$images.lab 
ix<-images.lab.train%in%Classes 
images.rgb.train<-images.rgb.train[ix] 
images.lab.train<-images.lab.train[ix] 
rm(cifar_train)   

1. 转换为图像。此步骤是必需的，因为 CIFAR-10 数据集是 32 x 32 x 3 的图像，需要将其展平为 1024 x 3 格式：

# Function to transform to image 
transform.Image <- function(index, images.rgb) { 
  # Convert each color layer into a matrix,  
  # combine into an rgb object, and display as a plot 
  img <- images.rgb[[index]] 
  img.r.mat <- as.cimg(matrix(img$r, ncol=32, byrow = FALSE)) 
  img.g.mat <- as.cimg(matrix(img$g, ncol=32, byrow = FALSE)) 
  img.b.mat <- as.cimg(matrix(img$b, ncol=32, byrow = FALSE)) 

  # Bind the three channels into one image 
  img.col.mat <- imappend(list(img.r.mat,img.g.mat,img.b.mat),"c")  
  return(img.col.mat) 
} 

1. 下一步是对图像进行零填充：

  # Function to pad image 
  image.padding <- function(x) { 
  img_width <- max(dim(x)[1:2]) 
  img_height <- min(dim(x)[1:2]) 
  pad.img <- pad(x, nPix = img_width - img_height, 
                 axes = ifelse(dim(x)[1] < dim(x)[2], "x", "y")) 
  return(pad.img) 
}

1. 将图像保存到指定文件夹：

# Save train images 
MAX_IMAGE<-length(images.rgb.train) 

# Write Aeroplane images to aero folder 
sapply(1:MAX_IMAGE, FUN=function(x, images.rgb.train, images.lab.train){ 
  if(images.lab.train[[x]]==1){ 
    img<-transform.Image(x, images.rgb.train)   
    pad_img <- image.padding(img) 
    res_img <- resize(pad_img, size_x = 224, size_y = 224) 
    imager::save.image(res_img, paste("train/aero/aero", x, ".jpeg", sep=""))     
  } 
}, images.rgb.train=images.rgb.train, images.lab.train=images.lab.train) 

# Write Automobile images to auto folder 
sapply(1:MAX_IMAGE, FUN=function(x, images.rgb.train, images.lab.train){ 
  if(images.lab.train[[x]]==2){ 
    img<-transform.Image(x, images.rgb.train)   
    pad_img <- image.padding(img) 
    res_img <- resize(pad_img, size_x = 224, size_y = 224) 
    imager::save.image(res_img, paste("train/auto/auto", x, ".jpeg", sep=""))     
  } 
}, images.rgb.train=images.rgb.train, images.lab.train=images.lab.train) 

前面的脚本将把飞机图像保存到aero文件夹，将汽车图像保存到auto文件夹。

1. 转换为 MXNet 支持的.rec记录格式。此转换需要 Python 中的im2rec.py MXNet 模块，因为 R 不支持此转换。不过，一旦在 Python 中安装了 MXNet，可以通过系统命令从 R 调用。数据集的划分可以使用以下文件：

System("python ~/mxnet/tools/im2rec.py --list True --recursive True --train-ratio 0.90 cifar_224/pks.lst cifar_224/trainf/")

前面的脚本将生成两个列表文件：pks.lst_train.lst和pks.lst_train.lst。训练和验证的划分由前面脚本中的-train-ratio参数控制。类别的数量基于trainf目录中的文件夹数量。在这个场景中，选择了两个类别：汽车和飞机。

1. 转换用于训练和验证的数据集的*.rec文件：

# Creating .rec file from training sample list 
System("python ~/mxnet/tools/im2rec.py --num-thread=4 --pass-through=1 /home/prakash/deep\ learning/cifar_224/pks.lst_train.lst /home/prakash/deep\ learning/cifar_224/trainf/")   

# Creating .rec file from validation sample list 
System("python ~/mxnet/tools/im2rec.py --num-thread=4 --pass-through=1 /home/prakash/deep\ learning/cifar_224/pks.lst_val.lst /home/prakash/deep\ learning/cifar_224/trainf/") 

前面的脚本将创建pks.lst_train.rec和pks.lst_val.rec文件，这些文件将在下一个食谱中用于使用预训练模型训练模型。

构建图像分类模型

这个食谱的重点是使用迁移学习构建图像分类模型。它将利用前面食谱中准备的数据集，并使用 Inception-BN 架构。Inception-BN 中的 BN 代表批量归一化。有关计算机视觉中 Inception 模型的详细信息，可以参考 Szegedy 等人（2015 年）的论文。

做好准备

本节内容涵盖了使用 INCEPTION-BN 预训练模型设置分类模型的前提条件。

1. 将图像转换为用于训练和验证的.rec文件。

2. 从data.dmlc.ml/models/imagenet/inception-bn/.下载 Inception-BN 架构。

3. 安装 R 和 R 中的mxnet包。

如何操作...

1. 将.rec文件加载为迭代器。以下是将.rec数据作为迭代器加载的函数：

# Function to load data as iterators 
data.iterator <- function(data.shape, train.data, val.data, BATCHSIZE = 128) { 

  # Load training data as iterator 
  train <- mx.io.ImageRecordIter( 
    path.imgrec = train.data, 
    batch.size  = BATCHSIZE, 
    data.shape  = data.shape, 
    rand.crop   = TRUE, 
    rand.mirror = TRUE) 

  # Load validation data as iterator 
  val <- mx.io.ImageRecordIter( 
    path.imgrec = val.data, 
    batch.size  = BATCHSIZE, 
    data.shape  = data.shape, 
    rand.crop   = FALSE, 
    rand.mirror = FALSE 
  ) 

  return(list(train = train, val = val)) 
} 

在上面的函数中，mx.io.ImageRecordIter从RecordIO（.rec）文件中读取图像批次。

1. 使用data.iterator函数加载数据：

# Load dataset 
data  <- data.iterator(data.shape = c(224, 224, 3), 
                      train.data = "pks.lst_train.rec", 
                      val.data  = "pks.lst_val.rec", 
                      BATCHSIZE = 8) 
train <- data$train 
val   <- data$val 

1. 从Inception-BN文件夹加载 Inception-BN 预训练模型：

# Load Inception-BN model 
inception_bn <- mx.model.load("Inception-BN", iteration = 126) 
symbol <- inception_bn$symbol 
The different layers of the model can be viewed using function symbol$arguments 

1. 获取 Inception-BN 模型的层：

# Load model information 
internals <- symbol$get.internals() 
outputs <- internals$outputs 
flatten <- internals$get.output(which(outputs == "flatten_output")) 

1. 定义一个新的层来替换flatten_output层：

# Define new layer 
new_fc <- mx.symbol.FullyConnected(data = flatten,  
                                   num_hidden = 2,  
                                   name = "fc1")  
new_soft <- mx.symbol.SoftmaxOutput(data = new_fc,  
                                    name = "softmax") 

1. 为新定义的层初始化权重。为了重新训练最后一层，可以使用以下脚本进行权重初始化：

# Re-initialize the weights for new layer 
arg_params_new <- mxnet:::mx.model.init.params( 
  symbol = new_soft,  
  input.shape = c(224, 224, 3, 8),  
  output.shape = NULL,  
  initializer = mxnet:::mx.init.uniform(0.2),  
  ctx = mx.cpu(0) 
)$arg.params 
fc1_weights_new <- arg_params_new[["fc1_weight"]] 
fc1_bias_new <- arg_params_new[["fc1_bias"]] 

在上述层中，权重是通过在[-0.2，0.2]区间内使用均匀分布进行赋值的。ctx定义了执行操作的设备。

1. 重新训练模型：

# Mode re-train 
model <- mx.model.FeedForward.create( 
  symbol             = new_soft, 
  X                  = train, 
  eval.data          = val, 
  ctx                = mx.cpu(0), 
  eval.metric        = mx.metric.accuracy, 
  num.round          = 5, 
  learning.rate      = 0.05, 
  momentum           = 0.85, 
  wd                 = 0.00001, 
  kvstore            = "local", 
  array.batch.size   = 128, 
  epoch.end.callback = mx.callback.save.checkpoint("inception_bn"), 
  batch.end.callback = mx.callback.log.train.metric(150), 
  initializer        = mx.init.Xavier(factor_type = "in", magnitude = 2.34), 
  optimizer          = "sgd", 
  arg.params         = arg_params_new, 
  aux.params         = inception_bn$aux.params 
)  

上述模型设置为在 CPU 上运行五轮，并使用准确度作为评估指标。以下截图显示了所描述模型的执行情况：

从使用 CIFAR-10 数据集训练的 Inception-BN 模型输出：

训练后的模型产生了 0.97 的训练准确度和 0.95 的验证准确度。

在 GPU 上训练深度学习模型

图形处理单元（GPU）是用于使用大量核心进行图像渲染的硬件。Pascal 是 NVIDIA 发布的最新 GPU 微架构。GPU 中数百个核心的存在有助于提高计算效率。本节提供了使用 GPU 运行深度学习模型的配方。

准备工作

本节提供了运行 GPU 和 CPU 所需的依赖项：

1. 本实验使用了 GTX 1070 等 GPU 硬件。

2. 安装适用于 GPU 的mxnet。要为指定机器安装适用于 GPU 的mxnet，请按照mxnet.io上的安装说明进行操作。根据截图选择相应的需求，并按照说明进行操作：

获取 MXNet 安装说明的步骤

如何操作...

以下是如何在 GPU 上训练深度学习模型：

1. 上节讨论的 Inception-BN 迁移学习配方可以通过更改设备设置使其在已安装 GPU 并配置好的机器上运行，脚本如下所示：

# Mode re-train 
model <- mx.model.FeedForward.create( 
  symbol             = new_soft, 
  X                  = train, 
  eval.data          = val, 
  ctx                = mx.gpu(0), 
  eval.metric        = mx.metric.accuracy, 
  num.round          = 5, 
  learning.rate      = 0.05, 
  momentum           = 0.85, 
  wd                 = 0.00001, 
  kvstore            = "local", 
  array.batch.size   = 128, 
  epoch.end.callback = mx.callback.save.checkpoint("inception_bn"), 
  batch.end.callback = mx.callback.log.train.metric(150), 
  initializer        = mx.init.Xavier(factor_type = "in", magnitude = 2.34), 
  optimizer          = "sgd", 
  arg.params         = arg_params_new, 
  aux.params         = inception_bn$aux.params 
)  

在上述模型中，设备设置从mx.cpu更改为mx.gpu。使用 CPU 进行五次迭代的计算大约需要 2 小时，而同样的迭代使用 GPU 大约需要 15 分钟即可完成。

比较使用 CPU 和 GPU 的性能

设备切换时的一个问题是，为什么从 CPU 切换到 GPU 时会观察到如此大的改进。由于深度学习架构涉及大量的矩阵计算，GPU 利用大量并行核心加速这些计算，这些核心通常用于图像渲染。

许多算法已经利用 GPU 的强大计算能力加速执行。以下配方提供了使用gpuR包进行矩阵计算的一些基准。gpuR包是一个用于 R 中 GPU 计算的通用包。

做好准备

本节介绍了设置 GPU 与 CPU 比较所需的要求。

1. 使用已安装的 GPU 硬件，如 GTX 1070。

2. 使用 URL developer.nvidia.com/cuda-downloads 安装 CUDA 工具包。

3. 安装gpuR包：

install.packages("gpuR") 

1. 测试gpuR：

library(gpuR) 
# verify you have valid GPUs 
detectGPUs()  

如何操作...

我们从加载包开始：

1. 加载包，并将精度设置为float（默认情况下，GPU 的精度设置为单精度）：

library("gpuR") 
options(gpuR.default.type = "float") 

1. 将矩阵分配给 GPU：

# Assigning a matrix to GPU 
A<-matrix(rnorm(1000), nrow=10) 

vcl1 = vclMatrix(A)

上述命令的输出将包含对象的详细信息。以下脚本展示了一个示例：

> vcl1 
An object of class "fvclMatrix" 
Slot "address": 
<pointer: 0x000000001822e180> 

Slot ".context_index": 
[1] 1 

Slot ".platform_index": 
[1] 1 

Slot ".platform": 
[1] "Intel(R) OpenCL" 

Slot ".device_index": 
[1] 1 

Slot ".device": 
[1] "Intel(R) HD Graphics 530" 

1. 让我们考虑一下 CPU 与 GPU 的评估。由于大多数深度学习将使用 GPU 进行矩阵计算，性能通过矩阵乘法使用以下脚本进行评估：

# CPU vs GPU performance 
DF <- data.frame() 
evalSeq<-seq(1,2501,500) 
for (dimpower in evalSeq){ 
  print(dimpower) 
  Mat1 = matrix(rnorm(dimpower²), nrow=dimpower) 
  Mat2 = matrix(rnorm(dimpower²), nrow=dimpower) 

  now <- Sys.time() 
  Matfin = Mat1%*%Mat2 
  cpu <- Sys.time()-now 

  now <- Sys.time() 
  vcl1 = vclMatrix(Mat1) 
  vcl2 = vclMatrix(Mat2) 
  vclC = vcl1 %*% vcl2 
  gpu <- Sys.time()-now 

  DF <- rbind(DF,c(nrow(Mat1), cpu, gpu))  
} 
DF<-data.frame(DF) 
colnames(DF) <- c("nrow", "CPU_time", "gpu_time")   

上述脚本使用 CPU 和 GPU 进行矩阵乘法计算；时间会记录在不同维度的矩阵中。上面脚本的输出结果如下图所示：

CPU 与 GPU 的比较

图表显示，CPU 所需的计算工作量随着 CPU 的增加呈指数增长。因此，GPU 极大地加速了这一过程。

还有更多...

GPU 是机器学习计算中的新领域，许多包已经在 R 中开发，以便在保持熟悉的 R 环境中访问 GPU，例如gputools、gmatrix和gpuR。其他算法也已经开发并实现，通过访问 GPU 来增强其计算能力，例如RPUSVM，它使用 GPU 实现 SVM。因此，这个主题需要大量的创造力和一些探索，以便在利用硬件的全部能力时部署算法。

另见

要了解更多使用 R 进行并行计算的信息，请阅读 Simon R. Chapple 等人的《Mastering Parallel Programming with R》（2016 年）。