当实际输出与期望输出不符时，进入误差的反向传播阶段。误差通过输出层，按误差梯度下降的方式修正各层权值，向隐藏层、输入层逐层反传。周而复始的信息正向传播和误差反向传播过程，是各层权值不断调整的过程，也是神经网络学习训练的过程，此过程一直进行到网络输出的误差减少到可以接受的程度，或者预先设定的学习次数为止。
反向传播这一算法把我们前面提到的delta规则的分析扩展到了带有隐藏节点的神经网络。为了理解这个问题，设想Bob给Alice讲了一个故事，然后Alice又讲给了Ted，Ted检查了这个事实真相，发现这个故事是错误的。现在 Ted 需要找出哪些错误是Bob造成的而哪些又归咎于Alice。当输出节点从隐藏节点获得输入，网络发现出现了误差，权系数的调整需要一个算法来找出整个误差是由多少不同的节点造成的，网络需要问，“是谁让我误入歧途？到怎样的程度？如何弥补？”这时，网络该怎么做呢？
同样源于梯度降落原理，在权系数调整分析中的唯一不同是涉及到t(p,n)与y(p,n)的差分。通常来说Wi的改变在于：
alpha * s'(a(p,n)) * d(n) *X(p,i,n)
其中d(n)是隐藏节点n的函数，让我们来看：
n 对任何给出的输出节点有多大影响；
输出节点本身对网络整体的误差有多少影响。
一方面，n 影响一个输出节点越多，n 造成网络整体的误差也越多。另一方面，如果输出节点影响网络整体的误差越少，n 对输出节点的影响也相应减少。这里d(j)是对网络的整体误差的基值，W(n,j) 是 n 对 j 造成的影响，d(j) * W(n,j) 是这两种影响的总和。但是 n 几乎总是影响多个输出节点，也许会影响每一个输出结点，这样，d(n) 可以表示为：SUM(d(j)*W(n,j))
这里j是一个从n获得输入的输出节点，联系起来，我们就得到了一个培训规则。
这里每个从n接收输入的输出节点j都不同。关于反向传播算法的基本情况大致如此。
通常把第 1部分称为正向传播，把第2部分称为反向传播。反向传播的名字由此而来。
最速下降法的基本思想是：要找到某函数的最小值，最好的办法是沿函数的梯度方向探寻，如果梯度记为d,那么迭代公式可写为w=w-alpha*d，其中alpha可理解为我们前面提到的学习速率。
最速下降法有着收敛速度慢（因为每次搜索与前一次均正交，收敛是锯齿形的），容易陷入局部最小值等缺点，所以他的改进办法也有不少，最常见的是增加动量项与学习率可变。
增加冲量项（Momentum）
右侧第一项就是权值更新法则，第二项被称为冲量项
梯度下降的搜索轨迹就像一个球沿误差曲面滚下，冲量使球从一次迭代到下一次迭代时以同样的方向滚动
冲量有时会使这个球滚过误差曲面的局部极小值或平坦区域
冲量也具有在梯度不变的区域逐渐增大搜索步长的效果，从而加快收敛。
改变学习率
当误差减小趋近目标时，说明修正方向是正确的，可以增加学习率；当误差增加超过一个范围时，说明修改不正确，需要降低学习率。
（1）数据读入，这里我们还是使用R的内置数据——鸢尾花数据，由于神经网络本质是2分类的，所以我们将鸢尾花数据也分为两类（将前两类均看做第2类），按照特征：花瓣长度与宽度做分类。
（2）划分训练数据与测试数据
（3）初始化BP网络，采用包含一个隐含层的神经网络，训练方法使用包含动量的最速下降法，传递函数使用sigmoid函数。
（4）输入样本，对样本进行归一化，计算误差，求解误差平方和
（5）判断是否收敛
（6）根据误差调整权值。权值根据以下公式进行调整：
Delta（w）= alpha *s'(a(p,n))*(t(p,n) - y(p,n)) * X(p,n,j)
其中，alpha为学习率，s'(a(p,n))*(t(p,n)- y(p,n))为局部梯度。此外，由于使用了有动量因子的最速下降法，除第一次外，后续改变量应为：
Delta（w）(n)=-alpha*(1-mc)*Delta(w)(n) mc*Delta(w)(n-1)
(7)测试，输出分类正确率。
完整的R代码：
iris1<-as.matrix(iris[,3:4])
iris1<-cbind(iris1,c(rep(1,100),rep(0,50)))
set.seed(5)
n<-length(iris1[,1])
samp<-sample(1:n,n/5)
traind<-iris1[-samp,c(1,2)]
train1<-iris1[-samp,3]
testd<-iris1[samp,c(1,2)]
test1<-iris1[samp,3]
set.seed(1)
ntrainnum<-120
nsampdim<-2
net.nin<-2
net.nhidden<-3
net.nout<-1
w<-2*matrix(runif(net.nhidden*net.nin)-0.5,net.nhidden,net.nin)
b<-2*(runif(net.nhidden)-0.5)
net.w1<-cbind(w,b)
W<-2*matrix(runif(net.nhidden*net.nout)-0.5,net.nout,net.nhidden)
B<-2*(runif(net.nout)-0.5)
net.w2<-cbind(W,B)
traind_s<-traind
traind_s[,1]<-traind[,1]-mean(traind[,1])
traind_s[,2]<-traind[,2]-mean(traind[,2])
traind_s[,1]<-traind_s[,1]/sd(traind_s[,1])
traind_s[,2]<-traind_s[,2]/sd(traind_s[,2])
sampinex<-rbind(t(traind_s),rep(1,ntrainnum))
expectedout<-train1
eps<-0.01
a<-0.3
mc<-0.8
maxiter<-2000
iter<-0
errrec<-rep(0,maxiter)
outrec<-matrix(rep(0,ntrainnum*maxiter),ntrainnum,maxiter)
sigmoid<-function(x){
y<-1/(1 exp(-x))
return(y)
}
for(i in 1:maxiter){
hid_input<-net.w1%*%sampinex;
hid_out<-sigmoid(hid_input);
out_input1<-rbind(hid_out,rep(1,ntrainnum));
out_input2<-net.w2%*%out_input1;
out_out<-sigmoid(out_input2);
outrec[,i]<-t(out_out);
err<-expectedout-out_out;
sse<-sum(err^2);
errrec[i]<-sse;
iter<-iter 1;
if(sse<=eps)
break
Delta<-err*sigmoid(out_out)*(1-sigmoid(out_out))
delta<-(matrix(net.w2[,1:(length(net.w2[1,])-1)]))%*%Delta*sigmoid(hid_out)*(1-sigmoid(hid_out));
dWex<-Delta%*%t(out_input1)
dwex<-delta%*%t(sampinex)
if(i==1){
net.w2<-net.w2 a*dWex;
net.w1<-net.w1 a*dwex;
}
else{
net.w2<-net.w2 (1-mc)*a*dWex mc*dWexold;
net.w1<-net.w1 (1-mc)*a*dwex mc*dwexold;
}
dWexold<-dWex;
dwexold<-dwex;
}
testd_s<-testd
testd_s[,1]<-testd[,1]-mean(testd[,1])
testd_s[,2]<-testd[,2]-mean(testd[,2])
testd_s[,1]<-testd_s[,1]/sd(testd_s[,1])
testd_s[,2]<-testd_s[,2]/sd(testd_s[,2])
inex<-rbind(t(testd_s),rep(1,150-ntrainnum))
hid_input<-net.w1%*%inex
hid_out<-sigmoid(hid_input)
out_input1<-rbind(hid_out,rep(1,150-ntrainnum))
out_input2<-net.w2%*%out_input1
out_out<-sigmoid(out_input2)
out_out1<-out_out
out_out1[out_out<0.5]<-0
out_out1[out_out>=0.5]<-1
rate<-sum(out_out1==test1)/length(test1)
分类正确率为：0.9333333，是一个不错的学习器。这里需要注意的是动量因子mc的选取，mc不能过小，否则容易陷入局部最小而出不去，在本例中，如果mc=0.5，分类正确率仅为：0.5333333，学习效果很不理想。
单层的前向神经网络模型在包nnet中的nnet函数，其调用格式为：
nnet(formula,data, weights, size, Wts, linout = F, entropy = F,
softmax = F, skip = F, rang = 0.7,decay = 0, maxit = 100,
trace = T)
参数说明:
size, 隐层结点数；
decay, 表明权值是递减的（可以防止过拟合）；
linout, 线性输出单元开关；
skip，是否允许跳过隐层；
maxit, 最大迭代次数；
Hess, 是否输出Hessian值
适用于神经网络的方法有predict,print和summary等，nnetHess函数用来计算在考虑了权重参数下的Hessian矩阵，并且检验是否是局部最小。
我们使用nnet函数分析Vehicle数据。随机选择半数观测作为训练集，剩下的作为测试集，构建只有包含3个节点的一个隐藏层的神经网络。输入如下程序：
library(nnet); #安装nnet软件包
library(mlbench); #安装mlbench软件包
data(Vehicle); #调入数据
n=length(Vehicle[,1]); #样本量
set.seed(1); #设随机数种子
samp=sample(1:n,n/2); #随机选择半数观测作为训练集
b=class.ind(Vehicle$Class); #生成类别的示性函数
test.cl=function(true,pred){true<-max.col(true);cres=max.col(pred);table(true,cres)};
a=nnet(Vehicle[samp,-19],b[samp,],size=3,rang=0.1,decay=5e-4,maxit=200); #利用训练集中前18个变量作为输入变量，隐藏层有3个节点，初始随机权值在[-0.1,0.1]，权值是逐渐衰减的。
test.cl(b[samp,],predict(a,Vehicle[samp,-19]))#给出训练集分类结果
test.cl(b[-samp,],predict(a,Vehicle[-samp,-19]));#给出测试集分类结果
#构建隐藏层包含15个节点的网络。接着上面的语句输入如下程序：
a=nnet(Vehicle[samp,-19],b[samp,],size=15,rang=0.1,decay=5e-4,maxit=10000);
test.cl(b[samp,],predict(a,Vehicle[samp,-19]));
test.cl(b[-samp,],predict(a,Vehicle[-samp,-19]));
最后，我们回到最开始的那个手写数字的案例，我们试着利用支持向量机重做这个案例。（这个案例的描述与数据参见《R语言与机器学习学习笔记（分类算法）（1）》）
由于nnet包对输入的维数有一定限制（我也不知道为什么，可能在权值计算的时候出现了一些bug，反正将支持向量机那一节的代码平行的移过来是会报错的）。我们这里采用手写数字识别技术中常用的办法处理这个案例：计算数字的特征。选择数字特征的办法有许多种，你随便百度一篇论文都有叙述。我们这里采用结构特征与统计特征结合的办法计算图像的特征。
我们这里采用的统计特征与上图有一点的不同（结构特征一致），我们是将图片分为16块（4*4），统计每个小方块中点的个数，这样我们就有25维的特征向量了。为了保证结果的可比性，我们也报告支持向量机的分类结果。
运行下列代码：
setwd("D:/R/data/digits/trainingDigits")
names<-list.files("D:/R/data/digits/trainingDigits")
data<-paste("train",1:1934,sep="")
for(i in 1:length(names))
assign(data[i],as.matrix(read.fwf(names[i],widths=rep(1,32))))
library(nnet)
label<-factor(rep(0:9,c(189,198,195,199,186,187,195,201,180,204)))
feature<-matrix(rep(0,length(names)*25),length(names),25)
for(i in 1:length(names)){
feature[i,1]<-sum(get(data[i])[,16])
feature[i,2]<-sum(get(data[i])[,8])
feature[i,3]<-sum(get(data[i])[,24])
feature[i,4]<-sum(get(data[i])[16,])
feature[i,5]<-sum(get(data[i])[11,])
feature[i,6]<-sum(get(data[i])[21,])
feature[i,7]<-sum(diag(get(data[i])))
feature[i,8]<-sum(diag(get(data[i])[,32:1]))
feature[i,9]<-sum((get(data[i])[17:32,17:32]))
feature[i,10]<-sum((get(data[i])[1:8,1:8]))
feature[i,11]<-sum((get(data[i])[9:16,1:8]))
feature[i,12]<-sum((get(data[i])[17:24,1:8]))
feature[i,13]<-sum((get(data[i])[25:32,1:8]))
feature[i,14]<-sum((get(data[i])[1:8,9:16]))
feature[i,15]<-sum((get(data[i])[9:16,9:16]))
feature[i,16]<-sum((get(data[i])[17:24,9:16]))
feature[i,17]<-sum((get(data[i])[25:32,9:16]))
feature[i,18]<-sum((get(data[i])[1:8,17:24]))
feature[i,19]<-sum((get(data[i])[9:16,17:24]))
feature[i,20]<-sum((get(data[i])[17:24,17:24]))
feature[i,21]<-sum((get(data[i])[25:32,17:24]))
feature[i,22]<-sum((get(data[i])[1:8,25:32]))
feature[i,23]<-sum((get(data[i])[9:16,25:32]))
feature[i,24]<-sum((get(data[i])[17:24,25:32]))
feature[i,25]<-sum((get(data[i])[25:32,25:32]))
}
data1 <- data.frame(feature,label)
m1<-nnet(label~.,data=data1,size=25,maxit = 2000,decay = 5e-6, rang = 0.1)
pred<-predict(m1,data1,type="class")
table(pred,label)
sum(diag(table(pred,label)))/length(names)
library("e1071")
m <- svm(feature,label,cross=10,type="C-classification")
m
summary(m)
pred<-fitted(m)
table(pred,label)
setwd("D:/R/data/digits/testDigits")
name<-list.files("D:/R/data/digits/testDigits")
data1<-paste("train",1:1934,sep="")
for(i in 1:length(name))
assign(data1[i],as.matrix(read.fwf(name[i],widths=rep(1,32))))
feature<-matrix(rep(0,length(name)*25),length(name),25)
for(i in 1:length(name)){
feature[i,1]<-sum(get(data1[i])[,16])
feature[i,2]<-sum(get(data1[i])[,8])
数据分析咨询请扫描二维码
