美文网首页R语言与统计分析数据科学与R语言
61-R语言建立并运用神经网络实例

61-R语言建立并运用神经网络实例

作者: wonphen | 来源:发表于2020-03-28 16:01 被阅读0次

《深度学习精要(基于R语言)》学习笔记

1、概述

自动编码器模型可以用来学习数据集的特征,本文包括如下主题:
• 什么是无监督学习
• 自动编码器如何工作
• 在R中训练自动编码器

2、无监督学习

与使用了一个结果变量或者标记数据的有监督学习不同,无监督学习只使用输入的特征来学习。一个常见的无监督学习的例子是聚类分析,机器去学习数据中隐藏的或者潜在的聚类,目标是最小化评价的准则(例如一个聚类内部的最小的方差)。
另一种常用的无监督学习是降维。降维的目标是对一组p个变量找到一组隐藏的k个变量,且k<p,但是用这k个隐变量能够合理地重现p个原始变量。降维越厉害,简化就越厉害,但要以精度为代价。
最常见的降维的例子是主成分分析。主成分分析使用一个正交变换把原始数据变为主成分。虽然所有的主成分都是可以使用的,但是只有那些解释了足够大数量方差的成分才会被引入模型,其他的成分会作为噪声或者不必要的成分而被舍弃。

3、自动编码器

自动编码器也是神经网络,它可以是浅层的也可以是深度的。自动编码器和其他的神经网络的区别是自动编码器是被训练用来重新生成输入值或者预测输入值的。因此隐藏层和神经元并不是在一个输入值和某些其他结果之间映射,而是自(自动)编码的。

正则化的自动编码器

  1. 惩罚的自动编码器
  2. 去噪自动编码器

4、在R中训练自动编码器

> library(pacman)
> p_load(data.table, h2o)
> 
> options(width = 70, digits = 2)
> 
> # 使用手写数字识别数据集
> digits.train <- read.csv("./data_set/digit-recognizer/train.csv")
> digits.train$label <- factor(digits.train$label, levels = 0:9)
> 
> # 初始化h2o集群
> cl <- h2o.init(max_mem_size = "6G", nthreads = 4)
##  Connection successful!
## 
## R is connected to the H2O cluster: 
##     H2O cluster uptime:         4 hours 31 minutes 
##     H2O cluster timezone:       Asia/Shanghai 
##     H2O data parsing timezone:  UTC 
##     H2O cluster version:        3.28.0.4 
##     H2O cluster version age:    1 month and 2 days  
##     H2O cluster name:           H2O_started_from_R_Admin_git315 
##     H2O cluster total nodes:    1 
##     H2O cluster total memory:   5.04 GB 
##     H2O cluster total cores:    4 
##     H2O cluster allowed cores:  4 
##     H2O cluster healthy:        TRUE 
##     H2O Connection ip:          localhost 
##     H2O Connection port:        54321 
##     H2O Connection proxy:       NA 
##     H2O Internal Security:      FALSE 
##     H2O API Extensions:         Amazon S3, Algos, AutoML, Core V3, TargetEncoder, Core V4 
##     R Version:                  R version 3.6.3 (2020-02-29)
> # 将数据转移到h2o
> h2odigits <- as.h2o(digits.train, destination_frame = "h2odigits")
>
> # 前10000行用来训练,接下来10000行用来测试
> ind <- 1:10000
> h2o.train <- h2odigits[ind, -1]
> 
> ind.test <- 10001:20000
> h2o.test <- h2odigits[ind.test, -1]
> 
> xnames <- colnames(h2o.train)

H2O使用一种称为Hogwild!的并行方法,这种方法并行了随机梯度下降优化,用于如何优化/决定模型权重。
第一个模型:50个隐藏神经元,不使用任何正则化:

> ml <- h2o.deeplearning(
+   # 变量名的列表
+   x = xnames,
+   # 训练集
+   training_frame = h2o.train,
+   # 测试集
+   validation_frame = h2o.test,
+   # 激活函数
+   activation = "Tanh",
+   # 自动编码器模型
+   autoencoder = T,
+   # 隐藏神经元数量
+   hidden = 50,
+   # 迭代轮数
+   epochs = 20,
+   # 稀疏beta值
+   sparsity_beta = 0,
+   input_dropout_ratio = 0,
+   l1 = 0,
+   l2 = 0
+ )

第二个模型:100个隐藏神经元,没有任何正则化:

> m2a <- h2o.deeplearning(
+   # 变量名的列表
+   x = xnames,
+   # 训练集
+   training_frame = h2o.train,
+   # 测试集
+   validation_frame = h2o.test,
+   # 激活函数
+   activation = "Tanh",
+   # 自动编码器模型
+   autoencoder = T,
+   # 隐藏神经元数量
+   hidden = 100,
+   # 迭代轮数
+   epochs = 20,
+   # 稀疏beta值
+   sparsity_beta = 0,
+   input_dropout_ratio = 0,
+   l1 = 0,
+   l2 = 0
+ )

第三个模型:100个隐藏神经元,0.5的稀疏beta值,没有任何正则化:

> m2b <- h2o.deeplearning(
+   # 变量名的列表
+   x = xnames,
+   # 训练集
+   training_frame = h2o.train,
+   # 测试集
+   validation_frame = h2o.test,
+   # 激活函数
+   activation = "Tanh",
+   # 自动编码器模型
+   autoencoder = T,
+   # 隐藏神经元数量
+   hidden = 100,
+   # 迭代轮数
+   epochs = 20,
+   # 稀疏beta值
+   sparsity_beta = 0.5,
+   input_dropout_ratio = 0,
+   l1 = 0,
+   l2 = 0
+ )

第四个模型:100个隐藏神经元和输入(x变量)20%的丢弃,没有任何正则化:

> m2c <- h2o.deeplearning(
+   # 变量名的列表
+   x = xnames,
+   # 训练集
+   training_frame = h2o.train,
+   # 测试集
+   validation_frame = h2o.test,
+   # 激活函数
+   activation = "Tanh",
+   # 自动编码器模型
+   autoencoder = T,
+   # 隐藏神经元数量
+   hidden = 100,
+   # 迭代轮数
+   epochs = 20,
+   # 稀疏beta值
+   sparsity_beta = 0,
+   input_dropout_ratio = 0.2,
+   l1 = 0,
+   l2 = 0
+ )

提取4个模型的MSE对比:

> mse.dt <- tibble::tribble(~Model, ~Train_MSE, ~Test_MSE, "ml", ml@model$training_metrics@metrics$MSE, 
+     ml@model$validation_metrics@metrics$MSE, "m2a", m2a@model$training_metrics@metrics$MSE, 
+     m2a@model$validation_metrics@metrics$MSE, "m2b", m2b@model$training_metrics@metrics$MSE, 
+     m2b@model$validation_metrics@metrics$MSE, "m2c", m2c@model$training_metrics@metrics$MSE, 
+     m2c@model$validation_metrics@metrics$MSE)
> print(mse.dt)
## # A tibble: 4 x 3
##   Model Train_MSE Test_MSE
##   <chr>     <dbl>    <dbl>
## 1 ml      0.0144   0.0146 
## 2 m2a     0.00775  0.00800
## 3 m2b     0.00777  0.00802
## 4 m2c     0.00978  0.0101

在模型ml中,MSE是相当低的,而且在训练数据和验证数据中是完全相同的。这或许部分归因于这是一个相对简单的模型。
在模型m2a中,MSE进一步降低,并且在训练数据和验证数据中是完全相同的。
在m2b中也得到相似的结果。
在m2c中,没有额外模型复杂性的20%的输入丢弃,在训练数据和验证数据中都导致了更差的性能。

使用h2o.anomaly()函数审视模型的异常程度,将模型得到的每种情况的异常程度以及 99%分位数的信息组合起来:

> err.ml <- as.data.frame(h2o.anomaly(ml, h2o.train))
> err.m2a <- as.data.frame(h2o.anomaly(m2a, h2o.train))
> err.m2b <- as.data.frame(h2o.anomaly(m2b, h2o.train))
> err.m2c <- as.data.frame(h2o.anomaly(m2c, h2o.train))
> 
> # 合并为数据框
> err <- as.data.table(rbind(cbind.data.frame(Model = "ml", err.ml), 
+     cbind.data.frame(Model = "m2a", err.m2a), 
+     cbind.data.frame(Model = "m2b", err.m2b), 
+     cbind.data.frame(Model = "m2c", err.m2c)))
> 
> # 使用data.table包创建一个新的数据对象percentile
> percentile <- err[, .(Percentile = quantile(Reconstruction.MSE, probs = 0.99)), 
+     by = Model]
> 
> p_load(ggplot2)
> ggplot(err, aes(Reconstruction.MSE)) + 
+     geom_histogram(binwidth = 0.001, fill = "gray50") + 
+     geom_vline(aes(xintercept = Percentile), data = percentile, linetype = 2) + 
+     theme_bw() + facet_wrap(~Model)
image.png

模型m2a和m2b有最低的误差比,而且我们能看到小的尾部。
检查模型结果的另一种方法是使用h2o.deepfeatures()函数提取模型的深度特征。深度特征是模型中隐藏神经元的值。探索这些特征的一种方法是计算它们的相关性并检查相关系数的分布,一般来讲,深度特征有小的相关系数r,绝对值小于0.20,只有极少数|r|>0.20。

> fea <- h2o.deepfeatures(ml, h2o.train, layer = 0) %>% 
+     as.data.frame() %>% cor()
>
> fea[upper.tri(fea)] %>% as.data.frame() %>% 
+     ggplot(aes(.)) + 
+     geom_histogram(binwidth = 0.02) + 
+     labs(x = "", y = "") + theme_bw()
深度特征相关系数

上面的例子只表示了有一个隐藏层的浅层自动编码器。下面看看有两个隐藏层的深度自动编码器。数据集有10个不同的手写数字,我们尝试增加只有10个神经元的第二层隐藏神经元,假设当模型学习数字特征的时候,10个突出的特征会对应于这10个数字。

> m3 <- h2o.deeplearning(
+   # 变量名的列表
+   x = xnames,
+   # 训练集
+   training_frame = h2o.train,
+   # 测试集
+   validation_frame = h2o.test,
+   # 激活函数
+   activation = "Tanh",
+   # 自动编码器模型
+   autoencoder = T,
+   # 隐藏神经元数量第一层100第二层10个
+   hidden = c(100,10),
+   # 迭代轮数
+   epochs = 30,
+   # 稀疏beta值
+   sparsity_beta = 0,
+   input_dropout_ratio = 0.2,
+   l1 = 0,
+   l2 = 0
+ )

提取第二层隐藏神经元的特征值:

> fea3 <- as.data.frame(h2o.deepfeatures(m3, h2o.train, layer = 2))
> head(fea3)
##   DF.L2.C1 DF.L2.C2 DF.L2.C3 DF.L2.C4 DF.L2.C5 DF.L2.C6 DF.L2.C7
## 1     0.68    -0.23    -0.66    -0.30   -0.071     0.42  -0.6350
## 2    -0.77    -0.57    -0.49     0.33    0.725    -0.76  -0.7757
## 3     0.71     0.39    -0.32    -0.54    0.378     0.57  -0.3409
## 4     0.19    -0.82    -0.76    -0.17    0.035     0.52   0.1385
## 5    -0.77    -0.59    -0.54     0.57    0.784    -0.80  -0.8372
## 6    -0.09    -0.52    -0.38     0.16   -0.227    -0.29  -0.0032
##   DF.L2.C8 DF.L2.C9 DF.L2.C10
## 1    0.674    0.816      0.73
## 2    0.336   -0.712     -0.33
## 3   -0.235   -0.755      0.63
## 4    0.047    0.079     -0.13
## 5    0.490   -0.690     -0.13
## 6   -0.808    0.037     -0.14
> # 合并真实数字的label
> fea3$label <- digits.train$label[ind]
> 
> # 重塑为长数据集
> melt(fea3, id.vars = "label") %>% 
+     ggplot(aes(as.numeric(variable), value, 
+     col = label, linetype = label)) + 
+     stat_summary(fun.y = mean, geom = "line") + 
+     scale_x_continuous("Deep Features", breaks = 1:10) + 
+     theme_bw() + theme(legend.position = "top")
深度特征

结果非常杂乱,在深度特征和真实数字标签之间没有高区分度的标示。
最后看看模型的性能度量:

> mse.dt.2 <- tibble::tribble(~Model, ~Train_MSE, ~Test_MSE, "ml", ml@model$training_metrics@metrics$MSE, 
+     ml@model$validation_metrics@metrics$MSE, "m2a", m2a@model$training_metrics@metrics$MSE, 
+     m2a@model$validation_metrics@metrics$MSE, "m2b", m2b@model$training_metrics@metrics$MSE, 
+     m2b@model$validation_metrics@metrics$MSE, "m2c", m2c@model$training_metrics@metrics$MSE, 
+     m2c@model$validation_metrics@metrics$MSE, "m3", m3@model$training_metrics@metrics$MSE, 
+     m3@model$validation_metrics@metrics$MSE)
> 
> print(mse.dt.2)
## # A tibble: 5 x 3
##   Model Train_MSE Test_MSE
##   <chr>     <dbl>    <dbl>
## 1 ml      0.0144   0.0146 
## 2 m2a     0.00775  0.00800
## 3 m2b     0.00777  0.00802
## 4 m2c     0.00978  0.0101 
## 5 m3      0.0412   0.0410

MSE大约是0.412,比起浅层模型来,深度模型的拟合相当差,可能是因为在第2层中只有10个隐藏神经元,不足以捕捉为重建原始输入所需要数据的所有不同特征造成的。

相关文章

网友评论

    本文标题:61-R语言建立并运用神经网络实例

    本文链接:https://www.haomeiwen.com/subject/yavcuhtx.html