r-dl-cb-merge-2R 深度学习秘籍（三）第六章：循环神经网络本章将介绍用于序列数据集建模的循环神经网络。

R 深度学习秘籍（三）

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

译者：飞龙

协议：CC BY-NC-SA 4.0

第六章：循环神经网络

本章将介绍用于序列数据集建模的循环神经网络。在本章中，我们将涵盖：

设置基础的循环神经网络
设置双向 RNN 模型
设置深度 RNN 模型
设置基于长短期记忆的序列模型

设置基础的循环神经网络

循环神经网络 (RNN) 用于处理存在高自相关性的序列数据集。例如，使用患者的历史数据集预测患者的就诊路径，或预测给定句子中的下一个单词。这些问题的共同点在于输入长度不固定，并且存在序列依赖性。标准的神经网络和深度学习模型受到固定大小输入的限制，并产生固定长度的输出。例如，基于占用数据集构建的深度学习神经网络有六个输入特征，并且输出为二项式结果。

准备工作

机器学习领域中的生成模型是指那些能够生成可观察数据值的模型。例如，训练一个生成模型，通过图像库生成新的图像。所有生成模型的目标是计算给定数据集的联合分布，无论是隐式还是显式地：

安装并设置 TensorFlow。
加载所需的包：

library(tensorflow)

如何操作…

本节将提供设置 RNN 模型的步骤。

加载 MNIST 数据集：

# Load mnist dataset from tensorflow library 
datasets <- tf$contrib$learn$datasets 
mnist <- datasets$mnist$read_data_sets("MNIST-data", one_hot = TRUE)

重置图形并开始交互式会话：

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

使用第四章 使用自编码器的数据表示 中的 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))

提取定义好的 train 和 valid 数据集的标签：

labels <- mnist$train$labels 
labels_valid <- mnist$test$labels

定义模型参数，如输入像素的大小（n_input）、步长（step_size）、隐藏层的数量（n.hidden）和结果类别的数量（n.classes）：

# Define Model parameter 
n_input<-16 
step_size<-16 
n.hidden<-64 
n.class<-10

定义训练参数，如学习率（lr）、每批次输入数量（batch）和迭代次数（iteration）：

lr<-0.01 
batch<-500 
iteration = 100

定义一个函数 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) 
}

定义 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))) 
})

生成预测标签：

# 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)

在初始化全局变量初始化器后运行优化：

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") 
  } 
}

获取 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：

加载所需的包：

library(tensorflow)

加载 MNIST 数据集。
MNIST 数据集中的图像被缩小为 16 x 16 像素并进行归一化处理（详细内容请参见 设置 RNN 模型 部分）。

如何操作...

本节介绍设置双向 RNN 模型的步骤。

重置图并开始交互式会话：

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

使用第四章的 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))

提取定义的 train 和 valid 数据集的标签：

labels <- mnist$train$labels 
labels_valid <- mnist$test$labels

定义模型参数，例如输入像素的大小（n_input）、步长（step_size）、隐藏层的数量（n.hidden）和结果类别的数量（n.classes）：

# Define Model parameter 
n_input<-16 
step_size<-16 
n.hidden<-64 
n.class<-10

定义训练参数，例如学习率（lr）、每批次运行的输入数量（batch）和迭代次数（iteration）：

lr<-0.01 
batch<-500 
iteration = 100

定义一个函数来执行 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) 
}

定义一个 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) 
}

定义 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))) 
})

生成预测标签：

# Evaluate rnn cell output 
yhat = bidirectionRNN(x, weights, bias)

定义损失函数和优化器：

cost = tf$reduce_mean(tf$nn$softmax_cross_entropy_with_logits(logits=yhat, labels=y)) 
optimizer = tf$train$AdamOptimizer(learning_rate=lr)$minimize(cost)

在初始化会话后，使用全局变量初始化器运行优化：

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") 
  } 
}

获取验证数据的平均准确度：

valid_data=tf$reshape(validData, shape(-1, step_size, n_input)) 
cost$eval(feed_dict=dict(x=valid_data$eval(), y=labels_valid))

RNN 的代价函数收敛情况如下图所示：

MNIST 数据集上的双向循环神经网络收敛图

设置深度 RNN 模型

RNN 架构由输入层、隐藏层和输出层组成。通过将隐藏层分解为多个组，或通过在 RNN 架构中添加计算节点，例如在微学习中使用多层感知器模型，可以使 RNN 网络变深。计算节点可以添加在输入-隐藏、隐藏-隐藏和隐藏-输出的连接之间。以下是多层深度 RNN 模型的示例：

两层深度递归神经网络架构示例

如何实现...

TensorFlow 中的 RNN 模型可以通过使用 MultiRNNCell 容易地扩展为深度 RNN 模型。之前的 rnn 函数可以用 stacked_rnn 函数替换，从而实现深度 RNN 架构：

定义深度 RNN 架构中的层数：

num_layers <- 3

定义一个 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）模型：

安装并加载所需的包：

Install.packages("MDPtoolbox") 
library(MDPtoolbox)

定义动作的转移概率。这里，每一行表示“从某个状态”，每一列表示“到某个状态”。由于我们有 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)

定义一个转移概率矩阵列表：

TPMs <- list(up=up, left=left, 
down=down, right=right)

定义一个维度为：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)

测试定义的 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）：

使用状态-动作值函数进行策略迭代，折扣因子 Υ = 0.9：

mdp_policy<- mdp_policy_iteration(P=TPMs, R=Rewards, discount=0.9)

获取最佳（最优）策略 P*，如下图所示。绿色箭头标记显示了从 S1 到 S15 的遍历方向：

mdp_policy$policy 
names(TPMs)[mdp_policy$policy]

使用基于模型的迭代获得最优策略，并通过最优路径从 S1 到 S15

获取每个状态的最优价值函数 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 的步骤：

定义 16 个状态：

states <- c("s1", "s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10", "s11", "s12", "s13", "s14", "s15", "s16")

定义四个动作：

actions<- c("up", "left", "down", "right")

定义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)) 
}

定义一个函数，通过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) 
}

设置学习参数，如epsilon和learning_rate：

epsilon<- 0.1 
learning_rate<- 0.9

获取经过 50 万次迭代后的 Q 表：

Q_mat<- Qlearning(500, "s1", "s15", epsilon, learning_rate) 
Q_mat

获取最佳（最优）策略 P*，如以下图所示。绿色标记的箭头显示了从S1到S15的遍历方向：

actions[max.col(Q_mat)]

使用无模型迭代得到的最优策略，并展示从S1到S15的最优路径

第八章：深度学习在文本挖掘中的应用

本章我们将涵盖以下主题：

执行文本数据的预处理和情感提取
使用 tf-idf 分析文档
使用 LSTM 网络进行情感预测
使用 text2vec 示例的应用

执行文本数据的预处理和情感提取

在本节中，我们将使用简·奥斯汀的畅销小说《傲慢与偏见》（1813 年出版）进行文本数据预处理分析。在 R 中，我们将使用 Hadley Wickham 的tidytext包进行分词、去除停用词、使用预定义的情感词典进行情感提取、词频-逆文档频率（tf-idf）矩阵创建，并理解n-grams 之间的配对相关性。

在本节中，我们不将文本存储为字符串、语料库或文档词频矩阵（DTM），而是将其处理成每行一个标记的表格格式。

如何做……

这是我们进行预处理的步骤：

加载所需的包：

load_packages=c("janeaustenr","tidytext","dplyr","stringr","ggplot2","wordcloud","reshape2","igraph","ggraph","widyr","tidyr") 
lapply(load_packages, require, character.only = TRUE)

加载《傲慢与偏见》数据集。line_num属性与书中打印的行号相似：

Pride_Prejudice <- data.frame("text" = prideprejudice, 
                              "book" = "Pride and Prejudice", 
                              "line_num" = 1:length(prideprejudice), 
                              stringsAsFactors=F)

现在，执行分词操作，将每行一个字符串的格式重新构建为每行一个标记的格式。这里，标记可以是单个单词、一组字符、共现词（n-grams）、句子、段落等。目前，我们将句子分词为单个单词：

Pride_Prejudice <- Pride_Prejudice %>% unnest_tokens(word,text)

然后，使用stop words去除语料库去除常见词，如the、and、for等：

data(stop_words) 
Pride_Prejudice <- Pride_Prejudice %>% anti_join(stop_words,
by="word")

提取最常用的文本单词：

most.common <- Pride_Prejudice %>% dplyr::count(word, sort = TRUE)

可视化最常出现的前 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())

然后，使用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)

可视化文本小节（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())

现在使用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)

可视化不同情感定义的变化，如下图所示：

不同类型情感的变化

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())

基于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))

生成如下图所示的情感词云：

正面和负面词的词云

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. 提取章节并执行分词：

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. 从bing词典中提取positive和negative词集：

bingNEG <- get_sentiments("bing") %>%  
  filter(sentiment == "negative")  
bingPOS <- get_sentiments("bing") %>%  
  filter(sentiment == "positive")

1. 获取每章的词频：

  wordcounts <- Pride_Prejudice_chapters %>% 
  group_by(book, chapter) %>% 
  dplyr::summarize(words = n())

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. 基于每章正面和负面词汇的比例，为每章生成情感标志：

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 分析文档：

提取《傲慢与偏见》一书中所有 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()

计算单词的排名，使得出现频率较高的单词排名较低。同时，按排名可视化词频，如下图所示：

该图显示了具有较高词频（比率）值的单词的排名较低

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()

使用bind_tf-idf函数计算每个单词的tf-idf值：

Pride_Prejudice_chapters <- Pride_Prejudice_chapters %>% 
bind_tf_idf(word, chapter, n)

提取并可视化 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 进行情感预测的方法：

加载所需的包和电影评论数据集：

load_packages=c("text2vec","tidytext","tensorflow") 
lapply(load_packages, require, character.only = TRUE) 
data("movie_review")

提取电影评论和标签，分别作为数据框和矩阵。在电影评论中，添加一个额外的属性"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)))

提取所有评论中的独特单词，并获取它们的出现次数（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)

现在，根据单词的出现情况将标记的单词重新分配给评论：

reviews_words <- reviews %>% unnest_tokens(word,text) 
reviews_words <- plyr::join(reviews_words,reviews_sortedWords,by="word")

使用第 4 步的结果，创建一个评论列表，将每条评论转换为表示单词的编码数字集合：

reviews_words_sno <- list() 
for(i in 1:length(reviews$text))
{ 
  reviews_words_sno[[i]] <- c(subset(reviews_words,Sno==i,orderNo)) 
}

为了方便将等长序列输入 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)) 
  } 
})

现在，将这 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)

同样地，也将标签根据情况拆分为训练集和测试集：

train_labels <- as.matrix(labels[train_samples,]) 
test_labels <- as.matrix(labels[-train_samples,])

重置图，并启动交互式 TensorFlow 会话：

tf$reset_default_graph() 
sess<-tf$InteractiveSession()

定义模型参数，如输入像素的大小（n_input）、步长（step_size）、隐藏层的数量（n.hidden）和输出类别的数量（n.classes）：

n_input<-15 
step_size<-10 
n.hidden<-2 
n.class<-2

定义训练参数，如学习率(lr)、每批次输入的数量(batch)和迭代次数(iteration)：

lr<-0.01 
batch<-200 
iteration = 500

基于第六章《循环神经网络》中定义的 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))) 
}

绘制训练误差在各次迭代中的减少情况，如下图所示：

训练数据集的情感预测误差分布

plot(train_error, main="Training sentiment prediction error", xlab="Iterations", ylab = "Train Error")

获取测试数据的误差：

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的方式：

加载所需的包和数据集：

library(text2vec) 
library(glmnet) 
data("movie_review")

执行 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")) 
}

将电影评论数据按 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,]

生成所有词汇词的 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)

使用停用词列表进行修剪，然后使用 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)

使用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)

执行特征哈希，然后使用 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)

在完整词汇 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 文件的前提条件：

下载 MIDI 歌曲库：

github.com/dshieble/Music_RBM/tree/master/Pop_Music_Midi

下载用于操作 MIDI 歌曲的 Python 代码：

github.com/dshieble/Music_RBM/blob/master/midi_manipulation.py

安装 "reticulate" 包，它提供了 R 与 Python 的接口：

Install.packages("reticulate")

导入 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 文件的函数：

定义一个函数来读取 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 模型，如第五章中详细讨论的 深度学习中的生成模型。

准备就绪

让我们为模型设置系统：

在钢琴中，最低音符是 24，最高音符是 102；因此，音符的范围是 78。这样，编码矩阵中的列数为 156（即 78 个 Note-on 和 78 个 Note-off）：

lowest_note = 24L 
highest_note = 102L 
note_range = highest_note-lowest_note

我们将每次创建 15 步的音符，输入层有 2,340 个节点，隐藏层有 50 个节点：

num_timesteps  = 15L 
num_input      = 2L*note_range*num_timesteps 
num_hidden       = 50L

学习率（alpha）为 0.1：

alpha<-0.1

如何做到这一点...

探讨构建 RBM 模型的步骤：

定义 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))

定义一个前向传递：

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))))

然后，定义一个反向传递：

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)

相应地计算正向和负向梯度：

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)

定义目标函数：

err = tf$reduce_mean(tf$square(X - v1))

初始化当前和先前的变量：

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))

启动 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))

运行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 代码来生成新的音乐音符。

如何操作...

创建新的样本音乐：

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))

重新生成 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 预训练模型进行分类所需的步骤。

从 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")

在 Python 中安装 TensorFlow。
在 R 中安装 R 和 tensorflow 包。
从 image-net.org/download-imageurls 下载示例图像。

如何操作...

当前部分提供使用预训练模型的步骤：

在 R 中加载 tensorflow：

require(tensorflow)

从 TensorFlow 中导入 slim 库：

slimobj = tf$contrib$slim

TensorFlow 中的 slim 库用于维护复杂的神经网络模型，涵盖定义、训练和评估等方面。

在 TensorFlow 中重置图：

tf$reset_default_graph()

定义输入图像：

# 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))

重新定义 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) 
}

上面的函数定义了用于 VGG16 网络的网络架构。可以使用以下脚本来定义网络：

vgg16.network<-VGG16.model(slim, input.image = scaled.img)

加载 入门指南 部分中下载的 VGG16 权重 vgg_16_2016_08_28.tar.gz：

# Restore the weights 
restorer = tf$train$Saver() 
sess = tf$Session() 
restorer$restore(sess, 'vgg_16.ckpt')

下载示例测试图像。让我们根据以下脚本从 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 的示例图像

使用 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 进行迁移学习的数据准备。

做好准备

本节为即将到来的迁移学习模型设置部分做准备。

从www.cs.toronto.edu/~kriz/cifar.html下载 CIFAR-10 数据集。可以使用第三章中的download.cifar.data函数来下载数据集，卷积神经网络章节。
安装imager包：

install.packages("imager")

如何操作...

本部分食谱将提供一步步的指南，准备数据集以用于 Inception-BN 预训练模型。

加载依赖包：

# Load packages 
require(imager) 
source("download_cifar_data.R") 
The download_cifar_data consists of function to download and read CIFAR10 dataset.

读取下载的 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"))

过滤数据集中的飞机和汽车。这是一个可选步骤，用于简化后续的复杂度：

# 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)

转换为图像。此步骤是必需的，因为 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) 
}

下一步是对图像进行零填充：

  # 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) 
}

将图像保存到指定文件夹：

# 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文件夹。

转换为 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目录中的文件夹数量。在这个场景中，选择了两个类别：汽车和飞机。

转换用于训练和验证的数据集的*.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 预训练模型设置分类模型的前提条件。

将图像转换为用于训练和验证的.rec文件。
从data.dmlc.ml/models/imagenet/inception-bn/.下载 Inception-BN 架构。
安装 R 和 R 中的mxnet包。

如何操作...

将.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）文件中读取图像批次。

使用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

从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

获取 Inception-BN 模型的层：

# Load model information 
internals <- symbol$get.internals() 
outputs <- internals$outputs 
flatten <- internals$get.output(which(outputs == "flatten_output"))

定义一个新的层来替换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")

为新定义的层初始化权重。为了重新训练最后一层，可以使用以下脚本进行权重初始化：

# 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定义了执行操作的设备。

重新训练模型：

# 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 所需的依赖项：

本实验使用了 GTX 1070 等 GPU 硬件。
安装适用于 GPU 的mxnet。要为指定机器安装适用于 GPU 的mxnet，请按照mxnet.io上的安装说明进行操作。根据截图选择相应的需求，并按照说明进行操作：

获取 MXNet 安装说明的步骤

如何操作...

以下是如何在 GPU 上训练深度学习模型：

上节讨论的 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 比较所需的要求。

使用已安装的 GPU 硬件，如 GTX 1070。
使用 URL developer.nvidia.com/cuda-downloads 安装 CUDA 工具包。
安装gpuR包：

install.packages("gpuR")

测试gpuR：

library(gpuR) 
# verify you have valid GPUs 
detectGPUs()

如何操作...

我们从加载包开始：

加载包，并将精度设置为float（默认情况下，GPU 的精度设置为单精度）：

library("gpuR") 
options(gpuR.default.type = "float")

将矩阵分配给 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"

让我们考虑一下 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 年）。