一方面，n 影響一個(gè)輸出節(jié)點(diǎn)越多，n 造成網(wǎng)絡(luò)整體的誤差也越多。另一方面，如果輸出節(jié)點(diǎn)影響網(wǎng)絡(luò)整體的誤差越少，n 對(duì)輸出節(jié)點(diǎn)的影響也相應(yīng)減少。這里d(j)是對(duì)網(wǎng)絡(luò)的整體誤差的基值，W(n,j) 是 n 對(duì) j 造成的影響，d(j) * W(n,j) 是這兩種影響的總和。但是 n 幾乎總是影響多個(gè)輸出節(jié)點(diǎn)，也許會(huì)影響每一個(gè)輸出結(jié)點(diǎn)，這樣，d(n) 可以表示為：SUM(d(j)*W(n,j))

       這里j是一個(gè)從n獲得輸入的輸出節(jié)點(diǎn)，聯(lián)系起來，我們就得到了一個(gè)培訓(xùn)規(guī)則。

• 第1部分：在隱藏節(jié)點(diǎn)n和輸出節(jié)點(diǎn)j之間權(quán)系數(shù)改變，如下所示：
  alpha *s'(a(p,n))*(t(p,n) - y(p,n)) * X(p,n,j)
• 第 2 部分：在輸入節(jié)點(diǎn)i和輸出節(jié)點(diǎn)n之間權(quán)系數(shù)改變，如下所示：
  alpha *s'(a(p,n)) * sum(d(j) * W(n,j)) * X(p,i,n)

      這里每個(gè)從n接收輸入的輸出節(jié)點(diǎn)j都不同。關(guān)于反向傳播算法的基本情況大致如此。

      通常把第 1部分稱為正向傳播，把第2部分稱為反向傳播。反向傳播的名字由此而來。

4、最速下降法與其改進(jìn)

      最速下降法的基本思想是：要找到某函數(shù)的最小值，最好的辦法是沿函數(shù)的梯度方向探尋，如果梯度記為d,那么迭代公式可寫為w=w-alpha*d，其中alpha可理解為我們前面提到的學(xué)習(xí)速率。

      最速下降法有著收斂速度慢（因?yàn)槊看嗡阉髋c前一次均正交，收斂是鋸齒形的），容易陷入局部最小值等缺點(diǎn)，所以他的改進(jìn)辦法也有不少，最常見的是增加動(dòng)量項(xiàng)與學(xué)習(xí)率可變。

     增加沖量項(xiàng)（Momentum）

• 修改權(quán)值更新法則，使第n次迭代時(shí)的權(quán)值的更新部分地依賴于發(fā)生在第n‐1次迭代時(shí)的更新
  Delta（w）(n)=-alpha*(1-mc)*Delta(w)(n) mc*Delta(w)(n-1)

• 右側(cè)第一項(xiàng)就是權(quán)值更新法則，第二項(xiàng)被稱為沖量項(xiàng)

• 梯度下降的搜索軌跡就像一個(gè)球沿誤差曲面滾下，沖量使球從一次迭代到下一次迭代時(shí)以同樣的方向滾動(dòng)

• 沖量有時(shí)會(huì)使這個(gè)球滾過誤差曲面的局部極小值或平坦區(qū)域

• 沖量也具有在梯度不變的區(qū)域逐漸增大搜索步長(zhǎng)的效果，從而加快收斂。

     改變學(xué)習(xí)率

• 當(dāng)誤差減小趨近目標(biāo)時(shí)，說明修正方向是正確的，可以增加學(xué)習(xí)率；當(dāng)誤差增加超過一個(gè)范圍時(shí)，說明修改不正確，需要降低學(xué)習(xí)率。

5、BP神經(jīng)網(wǎng)絡(luò)的實(shí)現(xiàn)

（1）數(shù)據(jù)讀入，這里我們還是使用R的內(nèi)置數(shù)據(jù)——鳶尾花數(shù)據(jù)，由于神經(jīng)網(wǎng)絡(luò)本質(zhì)是2分類的，所以我們將鳶尾花數(shù)據(jù)也分為兩類（將前兩類均看做第2類），按照特征：花瓣長(zhǎng)度與寬度做分類。

（2）劃分訓(xùn)練數(shù)據(jù)與測(cè)試數(shù)據(jù)

（3）初始化BP網(wǎng)絡(luò)，采用包含一個(gè)隱含層的神經(jīng)網(wǎng)絡(luò)，訓(xùn)練方法使用包含動(dòng)量的最速下降法，傳遞函數(shù)使用sigmoid函數(shù)。

（4）輸入樣本，對(duì)樣本進(jìn)行歸一化，計(jì)算誤差，求解誤差平方和

（5）判斷是否收斂

（6）根據(jù)誤差調(diào)整權(quán)值。權(quán)值根據(jù)以下公式進(jìn)行調(diào)整：

Delta（w）= alpha *s'(a(p,n))*(t(p,n) - y(p,n)) * X(p,n,j)

其中，alpha為學(xué)習(xí)率，s'(a(p,n))*(t(p,n)- y(p,n))為局部梯度。此外，由于使用了有動(dòng)量因子的最速下降法，除第一次外，后續(xù)改變量應(yīng)為：

Delta（w）(n)=-alpha*(1-mc)*Delta(w)(n) mc*Delta(w)(n-1)

(7)測(cè)試，輸出分類正確率。

完整的R代碼：

[plain] view plaincopyprint?

1. iris1<-as.matrix(iris[,3:4])  

2. iris1<-cbind(iris1,c(rep(1,100),rep(0,50)))  

3. set.seed(5)  

4. n<-length(iris1[,1])  

5. samp<-sample(1:n,n/5)  

6. traind<-iris1[-samp,c(1,2)]  

7. train1<-iris1[-samp,3]  

8. testd<-iris1[samp,c(1,2)]  

9. test1<-iris1[samp,3]  

10.  

11. set.seed(1)  

12. ntrainnum<-120  

13. nsampdim<-2  

14.  

15. net.nin<-2  

16. net.nhidden<-3  

17. net.nout<-1  

18. w<-2*matrix(runif(net.nhidden*net.nin)-0.5,net.nhidden,net.nin)  

19. b<-2*(runif(net.nhidden)-0.5)  

20. net.w1<-cbind(w,b)  

21. W<-2*matrix(runif(net.nhidden*net.nout)-0.5,net.nout,net.nhidden)  

22. B<-2*(runif(net.nout)-0.5)  

23. net.w2<-cbind(W,B)  

24.  

25. traind_s<-traind  

26. traind_s[,1]<-traind[,1]-mean(traind[,1])  

27. traind_s[,2]<-traind[,2]-mean(traind[,2])  

28. traind_s[,1]<-traind_s[,1]/sd(traind_s[,1])  

29. traind_s[,2]<-traind_s[,2]/sd(traind_s[,2])  

30.  

31. sampinex<-rbind(t(traind_s),rep(1,ntrainnum))  

32. expectedout<-train1  

33.  

34. eps<-0.01  

35. a<-0.3  

36. mc<-0.8  

37. maxiter<-2000  

38. iter<-0  

39.  

40. errrec<-rep(0,maxiter)  

41. outrec<-matrix(rep(0,ntrainnum*maxiter),ntrainnum,maxiter)  

42.  

43. sigmoid<-function(x){  

44.    y<-1/(1 exp(-x))  

45.    return(y)  

46. }  

47.  

48. for(i in 1:maxiter){  

49.    hid_input<-net.w1%*%sampinex;  

50.    hid_out<-sigmoid(hid_input);  

51.    out_input1<-rbind(hid_out,rep(1,ntrainnum));  

52.    out_input2<-net.w2%*%out_input1;  

53.    out_out<-sigmoid(out_input2);  

54.    outrec[,i]<-t(out_out);  

55.    err<-expectedout-out_out;  

56.    sse<-sum(err^2);  

57.    errrec[i]<-sse;  

58.    iter<-iter 1;  

59.    if(sse<=eps)  

60.        break  

61.      

62.    Delta<-err*sigmoid(out_out)*(1-sigmoid(out_out))  

63.    delta<-(matrix(net.w2[,1:(length(net.w2[1,])-1)]))%*%Delta*sigmoid(hid_out)*(1-sigmoid(hid_out));  

64.  

65.    dWex<-Delta%*%t(out_input1)  

66.    dwex<-delta%*%t(sampinex)  

67.  

68.    if(i==1){  

69.            net.w2<-net.w2 a*dWex;  

70.            net.w1<-net.w1 a*dwex;  

71.        }  

72.    else{  

73.            net.w2<-net.w2 (1-mc)*a*dWex mc*dWexold;  

74.            net.w1<-net.w1 (1-mc)*a*dwex mc*dwexold;  

75.    }  

76.  

77.    dWexold<-dWex;  

78.    dwexold<-dwex;  

79. }  

80.  

81.  

82. testd_s<-testd  

83. testd_s[,1]<-testd[,1]-mean(testd[,1])  

84. testd_s[,2]<-testd[,2]-mean(testd[,2])  

85. testd_s[,1]<-testd_s[,1]/sd(testd_s[,1])  

86. testd_s[,2]<-testd_s[,2]/sd(testd_s[,2])  

87.  

88. inex<-rbind(t(testd_s),rep(1,150-ntrainnum))  

89. hid_input<-net.w1%*%inex  

90. hid_out<-sigmoid(hid_input)  

91. out_input1<-rbind(hid_out,rep(1,150-ntrainnum))  

92. out_input2<-net.w2%*%out_input1  

93. out_out<-sigmoid(out_input2)  

94. out_out1<-out_out  

95.  

96. out_out1[out_out<0.5]<-0  

97. out_out1[out_out>=0.5]<-1  

98.  

99. rate<-sum(out_out1==test1)/length(test1)  

        分類正確率為：0.9333333，是一個(gè)不錯(cuò)的學(xué)習(xí)器。這里需要注意的是動(dòng)量因子mc的選取，mc不能過小，否則容易陷入局部最小而出不去，在本例中，如果mc=0.5，分類正確率僅為：0.5333333，學(xué)習(xí)效果很不理想。

四、R中的神經(jīng)網(wǎng)絡(luò)函數(shù)

       單層的前向神經(jīng)網(wǎng)絡(luò)模型在包nnet中的nnet函數(shù)，其調(diào)用格式為：

nnet(formula,data, weights, size, Wts, linout = F, entropy = F,

       softmax = F, skip = F, rang = 0.7,decay = 0, maxit = 100,

       trace = T)

參數(shù)說明:

size,  隱層結(jié)點(diǎn)數(shù)；

decay,   表明權(quán)值是遞減的（可以防止過擬合）；

linout,   線性輸出單元開關(guān)；

skip，是否允許跳過隱層；

maxit,  最大迭代次數(shù)；

Hess,  是否輸出Hessian值

      適用于神經(jīng)網(wǎng)絡(luò)的方法有predict,print和summary等，nnetHess函數(shù)用來計(jì)算在考慮了權(quán)重參數(shù)下的Hessian矩陣，并且檢驗(yàn)是否是局部最小。

     我們使用nnet函數(shù)分析Vehicle數(shù)據(jù)。隨機(jī)選擇半數(shù)觀測(cè)作為訓(xùn)練集，剩下的作為測(cè)試集，構(gòu)建只有包含3個(gè)節(jié)點(diǎn)的一個(gè)隱藏層的神經(jīng)網(wǎng)絡(luò)。輸入如下程序：

[plain] view plaincopyprint?

1. library(nnet);  #安裝nnet軟件包  

2. library(mlbench);  #安裝mlbench軟件包  

3. data(Vehicle);  #調(diào)入數(shù)據(jù)  

4. n=length(Vehicle[,1]); #樣本量  

5. set.seed(1);  #設(shè)隨機(jī)數(shù)種子  

6. samp=sample(1:n,n/2);  #隨機(jī)選擇半數(shù)觀測(cè)作為訓(xùn)練集  

7. b=class.ind(Vehicle$Class);  #生成類別的示性函數(shù)  

8. test.cl=function(true,pred){true<-max.col(true);cres=max.col(pred);table(true,cres)};  

9. a=nnet(Vehicle[samp,-19],b[samp,],size=3,rang=0.1,decay=5e-4,maxit=200);  #利用訓(xùn)練集中前18個(gè)變量作為輸入變量，隱藏層有3個(gè)節(jié)點(diǎn)，初始隨機(jī)權(quán)值在[-0.1,0.1]，權(quán)值是逐漸衰減的。  

10. test.cl(b[samp,],predict(a,Vehicle[samp,-19]))#給出訓(xùn)練集分類結(jié)果  

11. test.cl(b[-samp,],predict(a,Vehicle[-samp,-19]));#給出測(cè)試集分類結(jié)果  

12. #構(gòu)建隱藏層包含15個(gè)節(jié)點(diǎn)的網(wǎng)絡(luò)。接著上面的語句輸入如下程序：  

13. a=nnet(Vehicle[samp,-19],b[samp,],size=15,rang=0.1,decay=5e-4,maxit=10000); 

14. test.cl(b[samp,],predict(a,Vehicle[samp,-19]));  

15. test.cl(b[-samp,],predict(a,Vehicle[-samp,-19]));  

再看手寫數(shù)字案例

       最后，我們回到最開始的那個(gè)手寫數(shù)字的案例，我們?cè)囍?a href='/map/zhichixiangliangji/' style='color:#000;font-size:inherit;'>支持向量機(jī)重做這個(gè)案例。（這個(gè)案例的描述與數(shù)據(jù)參見《R語言與機(jī)器學(xué)習(xí)學(xué)習(xí)筆記（分類算法）（1）》）

      由于nnet包對(duì)輸入的維數(shù)有一定限制（我也不知道為什么，可能在權(quán)值計(jì)算的時(shí)候出現(xiàn)了一些bug，反正將支持向量機(jī)那一節(jié)的代碼平行的移過來是會(huì)報(bào)錯(cuò)的）。我們這里采用手寫數(shù)字識(shí)別技術(shù)中常用的辦法處理這個(gè)案例：計(jì)算數(shù)字的特征。選擇數(shù)字特征的辦法有許多種，你隨便百度一篇論文都有敘述。我們這里采用結(jié)構(gòu)特征與統(tǒng)計(jì)特征結(jié)合的辦法計(jì)算圖像的特征。

     我們這里采用的統(tǒng)計(jì)特征與上圖有一點(diǎn)的不同（結(jié)構(gòu)特征一致），我們是將圖片分為16塊（4*4），統(tǒng)計(jì)每個(gè)小方塊中點(diǎn)的個(gè)數(shù)，這樣我們就有25維的特征向量了。為了保證結(jié)果的可比性，我們也報(bào)告支持向量機(jī)的分類結(jié)果。

      運(yùn)行下列代碼：

[plain] view plaincopyprint?

1. setwd("D:/R/data/digits/trainingDigits")  

2. names<-list.files("D:/R/data/digits/trainingDigits")  

3. data<-paste("train",1:1934,sep="")  

4. for(i in 1:length(names))  

5.         assign(data[i],as.matrix(read.fwf(names[i],widths=rep(1,32))))  

6. library(nnet)  

7. label<-factor(rep(0:9,c(189,198,195,199,186,187,195,201,180,204)))  

8.  

9. feature<-matrix(rep(0,length(names)*25),length(names),25)  

10. for(i in 1:length(names)){  

11.        feature[i,1]<-sum(get(data[i])[,16])  

12.        feature[i,2]<-sum(get(data[i])[,8])  

13.        feature[i,3]<-sum(get(data[i])[,24])  

14.        feature[i,4]<-sum(get(data[i])[16,])  

15.        feature[i,5]<-sum(get(data[i])[11,])  

16.        feature[i,6]<-sum(get(data[i])[21,])  

17.        feature[i,7]<-sum(diag(get(data[i])))  

18.        feature[i,8]<-sum(diag(get(data[i])[,32:1]))  

19.        feature[i,9]<-sum((get(data[i])[17:32,17:32]))  

20.        feature[i,10]<-sum((get(data[i])[1:8,1:8]))  

21.        feature[i,11]<-sum((get(data[i])[9:16,1:8]))  

22.        feature[i,12]<-sum((get(data[i])[17:24,1:8]))  

23.        feature[i,13]<-sum((get(data[i])[25:32,1:8]))  

24.        feature[i,14]<-sum((get(data[i])[1:8,9:16]))  

25.        feature[i,15]<-sum((get(data[i])[9:16,9:16]))  

26.        feature[i,16]<-sum((get(data[i])[17:24,9:16]))  

27.        feature[i,17]<-sum((get(data[i])[25:32,9:16]))  

28.        feature[i,18]<-sum((get(data[i])[1:8,17:24]))  

29.        feature[i,19]<-sum((get(data[i])[9:16,17:24]))  

30.        feature[i,20]<-sum((get(data[i])[17:24,17:24]))  

31.        feature[i,21]<-sum((get(data[i])[25:32,17:24]))  

32.        feature[i,22]<-sum((get(data[i])[1:8,25:32]))  

33.        feature[i,23]<-sum((get(data[i])[9:16,25:32]))  

34.        feature[i,24]<-sum((get(data[i])[17:24,25:32]))  

35.        feature[i,25]<-sum((get(data[i])[25:32,25:32]))  

36. }  

37. data1 <- data.frame(feature,label)  

38. m1<-nnet(label~.,data=data1,size=25,maxit = 2000,decay = 5e-6, rang = 0.1)  

39. pred<-predict(m1,data1,type="class")  

40. table(pred,label)  

41. sum(diag(table(pred,label)))/length(names)  

42.  

43. library("e1071")  

44. m <- svm(feature,label,cross=10,type="C-classification")  

45. m  

46. summary(m)  

47. pred<-fitted(m)  

48. table(pred,label)  

49.  

50. setwd("D:/R/data/digits/testDigits")  

51. name<-list.files("D:/R/data/digits/testDigits")  

52. data1<-paste("train",1:1934,sep="")  

53. for(i in 1:length(name))  

54.    assign(data1[i],as.matrix(read.fwf(name[i],widths=rep(1,32))))  

55.  

56. feature<-matrix(rep(0,length(name)*25),length(name),25)  

57. for(i in 1:length(name)){  

58.        feature[i,1]<-sum(get(data1[i])[,16])  

59.        feature[i,2]<-sum(get(data1[i])[,8])