不加载任何包，手撕一个R语言版BP神经网络模型

欢迎关注天善智能，我们是专注于商业智能BI，人工智能AI，大数据分析与挖掘领域的垂直社区，学习，问答、求职一站式搞定！

对商业智能BI、大数据分析挖掘、机器学习，python，R等数据领域感兴趣的同学加微信：tstoutiao，邀请你进入数据爱好者交流群，数据爱好者们都在这儿。

作者：梁凯? R语言中文社区专栏作者

知乎ID：https://www.zhihu.com/people/liang-kai-77-98

前言

大家好，很久没写文章了，这段时间俗事缠身，忙于俗事，愧对于自己的研究，抛开精虫上脑般的资本，对于一个立志于发展新技术新科技，乃至立志于理论研究的人来说，只有勤勤恳恳，埋头苦干的做好理论研究，把研究转化为技术才是人工智能发展的正道，而不是一心想搞个大新闻，吸引点融资而后不了了之。本人还是认为未来是AI的世界，AI everywhere，但是也不像个别媒体打了鸡血般的吹上了天，脚踏实地的为这个新科技做点贡献才是我辈中人该做的。好了废话不多说，今天为大家带来的是不加载任何包，手撕一个神经网络，试验数据集是用烂了的波士顿房价。python版的神经网络网上有很多，但是R版的很少，在这里需要感谢，中科院自动化研究所钱鸿博士和清华大学张阳阳博士的倾情答疑，神经网络的基本知识这里就不再重复讲了，BP算法也不着重讲了，这里主要讲解怎么用R语言不加载任何包的情况下，构建一个神经网络，代码结构是基于python版本的，但是是用R重构的，通过这样的比照能让各位更加清晰的理解BP神经网络，以及R与python的不同点和各自的优缺点。好了下面开始讲解代码。

R和python不一样，R更倾向于科学计算语言函数编程，对于python的类class来说R板块化通常用函数来表示。

1.定义激活函数

#首先定义激活函数##############这里我们暂时定义两个激活函数sigmoid和tanh函数#############R原本就是科学计算语言不像python是万金油，python科学计算要用到numpy，而R你可以直接##############把它看成是numpy，所以它包含了tanh函数这里我们即可以不用定义Tanh函数了，但是我们##############还是要定义tanh的导数sigmoid<-function(x){ ? ? 1/(1+exp(x)) ? ? ? }########以下是激活函数导数的定义。sigmoid_derivative<-function(x){ ? ? ?sigmoid(x)*(1-sigmoid(x)) ? ? ? ?}tanh_derivative<-function(x){ ? ? ? ? ? 1-tanh(x)^2 ? ? ? ? ? ?} ? ?

2.板块的初始化

接下来我们的板块便是初始化，这里的初始化最主要的目的有两个第一是定义激活函数函数,第二是初始化每层的权重，在这里需要注意的是对于权重来说输出层没有权重，所以从网络结构来说，例如5层（包含输出层）的权重只有四层。其次需要在输入层加上bias，也就是说以波士顿房价为例，输入层有13个，但是加上bias便是有14个输入，而且除了输出层以外每一层都必需加上各自的阈值，就和我们理论上一样每一层隐藏层都必需减去阈值。

###函数的输入有两个，layers和activation，layers就是你需要自己设置的网络结构###R中网络结构输入为一组一维数组如C（13，3，1）就表示有输入层13个节点，和一个隐藏层3个节点还有1####个输出层1个节点，这里要注意的是我们面临的问题是回归问题所以只有一个输出。你也可以根据自己的需####要增加自己想要的网络结构如我就用c(13,3,3,2,1)这种网络结构表示1个输入层13个节点和1个输出层，另####外有3层隐藏层，他们分别的节点为3，3，2.init<-function(layers,activation){ ? ? ?if(activation =='tanh'){activation<<-tanh ? ? ? activation_prime <<- tanh_derivative} ? ? ?if(activation =='sigmoid'){activation <<- sigmoid ? ? ? activation_prime <<- sigmoid_derivative} ? ? ?###以上是选择使用哪种激活函数，你也可以自己增加激活函数 ? ? ? init_weights<-list() ? ?###这里我们依照我们刚讲过的输出层没有权重所以必需减一 ? ? ?length(init_weights)<-length(layers)-1 ? ? ?###这里加一是由于每层有自己的阈值 ? ? ? for(i in 1:(length(layers)-2)){ ? ? ? nrow<-layers[i]+1 ? ? ? ncol<-layers[i+1]+1 ? ? ? layer_matrixweight<-matrix(nrow=nrow,ncol=ncol,runif(nrow*ncol,-1,1))###这里我们必需要说的是R语言比较python最大的优点便是数据格式多样化，这里我们用list格式即可以建立###十分方便的三维数据，也可以用matrix格式轻易建立矩阵，这里我们用runif随机从-1到1之间挑选初始值 ? ? ? init_weights[[i]]<-layer_matrixweight ? ? ? ?} ? ? ? ###最后一层由于没有阈值所以结构上我们必需把他单独列出来这也就是last_ncol没有加一的起因 ? ? ? last_nrow=layers[length(init_weights)]+1 ? ? ? last_ncol=layers[length(init_weights)+1] ? ? ? init_weights[[length(init_weights)]]<-matrix(nrow=last_nrow,ncol=last_ncol,runif(last_nrow*last_ncol,-1,1)) ? ? ? #####这里我们为了区分用init_weights建立初始权重并把它赋予全局变量以便后面的函数调用 ? ? ? ?init_weights<<-init_weights ? ? }

3.拟合函数的编写

下面我们进行拟合函数板块的编写，从理论上我们可以证实函数的梯度就是最佳的优化方向，所以这里我们就需要层层的求出输出值，而后用输出值倒推出每一层的delta,而后再升级权重。

###这里的X和Y是训练样本fit<-function(x,y,learning_rate, epochs){ ? ? ?weights<-init_weights ? ? ?old_colname<-colnames(x) ? ? ?#加入一列1，作为bais ? ? ? x<-cbind(1,x) ? ? #######修改列名（可选） ? ? ?colnames(x)<-c('bais',old_colname) ? ? ?for(i in 1:epochs){ ? ? ?####随机梯度下降方法SGD ? ? ?n<-sample(1:length(x[,1]),1,replace = FALSE, prob =NULL) ? ? ?calculate_weights<-list(x[n,]) ? ? ?length(calculate_weights)<-length(weights)  ? ? ?#######计算权重 ? ? ? ? ? for( k in 1:length(weights)){ ? ? ? ? ? ? ?dot_value<-calculate_weights[[k]]%*%weights[[k]] ? ? ? ? ? ? ?activation_value<-activation(dot_value) ? ? ? ? ? ? ?calculate_weights[[k+1]]<-activation_value ? ? ? ? ? ? ? } ? ? ? ? ? ? ? ? ? ? ? ? ? ?error<-y[n]-calculate_weights[[length(calculate_weights)]] ? ? ? ? ? ############从输出层反向递推计算delta ? ? ? ? ? ?deltas<-list(error * activation_prime(calculate_weights[[length(calculate_weights)]])) ? ? ? ? ? ? ? ?for( j in (length(calculate_weights)-1):2){ ? ? ? ? ? ? ? ? ? ? ? ? length(deltas)<-length(deltas)+1 ? ? ? ? ? ? ? ? ? ? ? ? deltas[[length(deltas)]]<-deltas[[length(deltas)-1]]%*%t(weights[[j]])*activation_prime(calculate_weights[[j]]) ? ? ? ? ? ? ? ? ? ? ? } ? ? ? ? ? ? ? ? ############倒转 deltas ? ? ? ? ? ? ? ? ?deltas_reverse<-list() ? ? ? ? ? ? ? ? length(deltas_reverse)<-length(deltas) ? ? ? ? ? ? ? ? ? ? num<-length(deltas) ? ? ? ? ? ? ? ? ? ? for(m in 1:length(deltas)){ ? ? ? ? ? ? ? ? ? ? ?deltas_reverse[[m]]<-deltas[[num]] ? ? ? ? ? ? ? ? ? ? ? ? ? ? num<-num-1 ? ? ? ? ? ? ? ? ? ? ? } ? ? ? ? ? ? ? ? ?############逐层升级权重 ? ? ? ? ? ? ? for(t in 1:length(weights)){ ? ? ? ? ? ? ? ? ? ? layer<-as.numeric(calculate_weights[[t]]) ? ? ? ? ? ? ? ? ? ? delta<-deltas_reverse[[t]] ? ? ? ? ? ? ? ? ? ? weights_new<- weights[[t]]+learning_rate*(layer%*%delta) ? ? ? ? ? ? ? ? ? ? weights[[t]]<-weights_new ? ? ? ? ? ? ? ? ? ? } ? ? ? ? ? ? ? } ? ? ? ? ? ? ? ?print(weights)  ? ? ? ? ? ? #######训练好的权重用fit_weights来表示 ? ? ? ? ? ? ?fit_weights<<-weights ? ? ? ?  ? ? ? ? ? ? ? }

4.预测函数的编写

接下来就是预测函数，这里我们先写一个对每一个测试样本计算预测值的函数predict，再用apply函数写一个函数predict_total对所有的测试集并行矩阵计算预测值。

 predict<-function(x){ ? ? ? ? ? ? ? for(i in 1:length(fit_weights)){ ? ? ? ? ? ? ? dot_predict<-x%*%fit_weights[[i]] ? ? ? ? ? ? ? activation_predict<-activation(dot_predict) ? ? ? ? ? ? ? ? ? ? x<-activation_predict ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?} ? ? ? ? ? ? ? ? ? ? ? ?return(x) ? ? ? ? ? ? ? ? ? ? ? ? } ? ? ? ? ? ? ? ? ?predict_total<-function(x){ ? ? ? ? ? ? ? ? ? new_x_test<-cbind(1,x) ? ? ? ? ? ? ? ? ?predict_values<<-apply(new_x_test,1,function(x)predict(x)) ? ? ? ? ? ? ? ? ?print(predict_values) ? ? ? ? ? ? ? ? ? }

5.归一化

以上神经网络主体部分就已经写好了，接下来我们需要对data进行预解决，读取数据，随机选取训练集和测试机，而后进行归一化，这里详情了标准化归一化和极差归一化。

#读取数据 ?data<-read.csv ('boston_house_prices.csv')###随机抽取训练集和测试集（这里取百分之七十训练集）sample_num<-sample(c(1:length(data[,1])),length(data[,1])*0.7, replace = FALSE, prob =NULL)data_train<-data[sample_num,]data_test<-data[-sample_num,]x_train<-data_train[-which(colnames(data)=="MEDV")]y_train<-data_train[which(colnames(data)=="MEDV")]x_test<-data_test[-which(colnames(data)=="MEDV")]y_test<-data_test[which(colnames(data)=="MEDV")###标准化归一x_train<-apply(x_train,2,function(x)scale(x,center=T,scale=T))y_train<-scale(y_train,center=T,scale=T)x_test<-apply(x_test,2,function(x)scale(x,center=T,scale=T))y_test<-scale(y_test,center=T,scale=T)###极差化归一（可选）#x_train<-apply(x_train,2,function(x)as.matrix( (x - min(x)) / (max(x) - min(x))))#x_test<-as.matrix( (x_test ?- min(x_test )) / (max(x_test ) - min(x_test )) )#y_train<-apply(y_train,2,function(y)as.matrix( (y - min(y)) / (max(y) - min(y))))#y_test<-as.matrix( (y_test ? - min(y_test ?)) / (max(y_test ?) - min(y_test ?)) )

6.预测

我们经过一系列计算来得到训练后的权重进行预测，评价标准为MSE和MAE。

init(c(13,3,3,2,1),"tanh")fit(x_train,y_train,0.001,20000)predict_total(x_test)

最后再啰嗦几句，这里我们求得的预测值是标准化过后的，所以我们必需要根据公式对归一化的数据进行复原，python可以用sklearn包，但R不加载任何包可以自己写,以标准化归一为例。

公式为：

其中μ为所有样本数据的均值，δ为所有样本数据的标准差，所以可以求得：

7.预测数据复原

###注意这里我们由于复原预测数据所以对应的就是y_train,其实y_train_inverse就等于原始的###y_train值同理y_test也等于归一化之前的y_testy_train_inverse<-as.matrix(data_train[which(colnames(data)=="MEDV")])y_test_inverse<-as.matrix(data_test[which(colnames(data)=="MEDV")])predict_inverse<-predict_values*sd(y_train_inverse)+mean(y_train_inverse)mse<-mean((y_test_inverse-predict_inverse)^2)mae<-mean(abs(y_test_inverse-predict_inverse))

8.结果

mse[1] 29.52206> mae[1] 4.212332

结论：

可以看出结果不是很理想，但是我们可以继续调参或者者做另外的trick，另外我们的程序也可以写得更快写，少些for循环多写矩阵计算，下次我们将更改程序，使它更增强大。

公众号后端回复关键字就可学习

回复?爬虫???????? ? ? 爬虫三大案例实战??
回复?Python? ? ? ? 1小时破冰入门

回复?数据挖掘?? ? ?R语言入门及数据挖掘
回复?人工智能?? ? ?三个月入门人工智能
回复?数据分析师?? 数据分析师成长之路?
回复?机器学习????? 机器学习的商业应用
回复?数据科学????? 数据科学实战
回复?常用算法????? 常用数据挖掘算法