R语言 image.binarization: 包_R语言keras包MLP数据分类

使用R语言中的keras包进行MLP神经网络模型的建立,进行数据分类。

完整的程序地址:

R keras MLP classification​rpubs.com

使用数据地址:

Image Segmentation Data Set​archive.ics.uci.edu

加载包并读取数据:

library(keras)
library(ggplot2)
library(pheatmap)
## 数据准备
imsedata <- read.csv("image segmentation.csv",header = T,row.names = NULL)
imsedata$REGION.PIXEL.COUNT <- NULL
imsedata$row.names <- as.integer(as.factor(imsedata$row.names))-1

table(imsedata$row.names)
## 
##  0  1  2  3  4  5  6 
## 30 30 30 30 30 30 30

数据中一共包含7类数据,每类有30个样本。建立模型前的数据准备工作。标准化和数据集切分。

## dataframe to matrix
imsedata <- as.matrix(imsedata) 

## 数据切分
set.seed(123)
index <- sample(nrow(imsedata),size = round(nrow(imsedata)*0.7))
train_x <- imsedata[index,2:19]
train_y <- to_categorical(imsedata[index,1],7)
test_x <- imsedata[-index,2:19]
test_y <- to_categorical(imsedata[-index,1],7)


## 数据标准化
imsedatascale <- apply(imsedata[,2:19], 2, scale)
## 标准化后数据切分
train_xsc <- imsedatascale[index,]
test_xsc <- imsedatascale[-index,]

训练数据集分为标准化前后的数据,使用这种方式,来分析数据标准化处理对最终模型的影响。

使用keras搭建MLP模型

model <- keras_model_sequential()
model %>%
  layer_dense(units = 64,activation = "relu",input_shape = 18,name = "den1")%>%
  layer_dropout(rate = 0.25)%>%
  layer_dense(units = 32,activation = "relu",name = "den2")%>%
  layer_gaussian_dropout(rate = 0.25)%>%
  layer_dense(units = 7,activation = "softmax")

summary(model)
## ___________________________________________________________________________
## Layer (type)                     Output Shape                  Param #     
## ===========================================================================
## den1 (Dense)                     (None, 64)                    1216        
## ___________________________________________________________________________
## dropout_1 (Dropout)              (None, 64)                    0           
## ___________________________________________________________________________
## den2 (Dense)                     (None, 32)                    2080        
## ___________________________________________________________________________
## gaussian_dropout_1 (GaussianDrop (None, 32)                    0           
## ___________________________________________________________________________
## dense_1 (Dense)                  (None, 7)                     231         
## ===========================================================================
## Total params: 3,527
## Trainable params: 3,527
## Non-trainable params: 0
## ___________________________________________________________________________

模型一共有两个隐藏层,分别含有64和32个神经元。接下来训练模型和预测,分析模型的性能。

## compile
model%>%compile(
  loss = "categorical_crossentropy",
  optimizer = optimizer_adam(),
  metrics = c("accuracy")
)

##标准化前数据的训练结果
mod_history <- model%>% fit(train_x,train_y,epochs = 100,batch_size = 8,validation_split = 0.2,verbose = 0)

## 可视化训练过程
plot(mod_history)+
  theme_bw()+ggtitle("Don't scale")

## 预测在测试集上的准确度
model %>% evaluate(test_x,test_y)
## $loss
## [1] 1.14371
## 
## $acc
## [1] 0.8095238

838d898668d49c0b369805991447cc4a.png

上面的结果是使用没有标准化的数据训练的收敛情况和精度。可见在测试集上的精度为0.8。

##标准化后数据的训练结果
mod_historysc <- model%>% fit(train_xsc,train_y,epochs = 100,batch_size = 8,validation_split = 0.2,verbose=0)

## 可视化训练过程
plot(mod_historysc)+
  theme_bw()+ggtitle("scale")

## 预测在测试集上的准确度
model %>% evaluate(test_xsc,test_y)
## $loss
## [1] 0.3914827
## 
## $acc
## [1] 0.8412698

faa7f786c495de9d4d3a8377c6452bda.png

上面的结果为使用标准化的数据,得到的模型训练时的收敛情况和在测试集上的精度。在测试集上的精度为0.84,比不标准话精度高,且模型收敛快,并且更稳定。

可视化模型训练过程中的权重。

model_we <- get_weights(model)
length(model_we)
## [1] 6
dim(model_we[[1]])
## [1] 18 64
pheatmap(model_we[[1]],cluster_rows = F,cluster_cols = F,labels_row = 1:18,labels_col = 1:64,
         main = "layder 1 weight")

90459612c7d03ecaafd03c2a9a974604.png

输入层到第一隐藏层的权重热力图。

dim(model_we[[3]])
## [1] 64 32
pheatmap(model_we[[3]],cluster_rows = F,cluster_cols = F,labels_row = 1:64,labels_col = 1:32,
         main = "layder 2 weight")

301592562156bc076ec6440b9cfab849.png

第一隐藏层到第二隐藏层的权重热力图。

dim(model_we[[5]])
## [1] 32  7
pheatmap(model_we[[5]],cluster_rows = F,cluster_cols = F,labels_row = 1:32,labels_col = 1:7,
         main = "layder 3 weight")

3875f6fa627f7e8c65f95e65e25af9d5.png

第二隐藏层到输出层的权重热力图。

========================================

针对文章中,使用model <- keras_model_sequential()出现错误的问题:

针对这种情况,可以使用如下面截图所示的程序来更改建立网络模型的方式。

f22c564ab017359922f9f8fb04fe51f9.png

代码如下,仅供参考,这里的代码和前面的代码不是匹配的。

## 定义LSTM模型
lstminputs <- layer_input(shape=max_len)
lstmprediction <- lstminputs%>%
  layer_embedding(input_dim = max_words+1,output_dim = 64,
                            input_length = max_len)%>%
  layer_lstm(128,activation = "tanh")%>%
  layer_dropout(0.5)%>%
  layer_dense(128,activation="relu",name="FC1")%>%
  layer_dropout(0.5)%>%
  layer_dense(64,activation="relu",name="FC2")%>%
  layer_dense(10,activation="softmax",name="soft")
lstmmodel <-  keras_model(inputs = lstminputs,outputs = lstmprediction)
summary(lstmmodel)
## compile model
lstmmodel%>%compile(loss="categorical_crossentropy",
                    optimizer=optimizer_adam(),
                    metrics="accuracy")

该段程序来自《R语言统计分析与机器学习》。

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值