熱線電話:13121318867

登錄
首頁精彩閱讀R語言與機器學習學習筆記2(分類算法)
R語言與機器學習學習筆記2(分類算法)
2015-12-17
收藏

R語言機器學習學習筆記2(分類算法)

 當實際輸出與期望輸出不符時,進入誤差的反向傳播階段。誤差通過輸出層,按誤差梯度下降的方式修正各層權值,向隱藏層、輸入層逐層反傳。周而復始的信息正向傳播和誤差反向傳播過程,是各層權值不斷調整的過程,也是神經網絡學習訓練的過程,此過程一直進行到網絡輸出的誤差減少到可以接受的程度,或者預先設定的學習次數為止。

3、反向傳播算法

     反向傳播這一算法把我們前面提到的delta規則的分析擴展到了帶有隱藏節點的神經網絡。為了理解這個問題,設想Bob給Alice講了一個故事,然后Alice又講給了Ted,Ted檢查了這個事實真相,發現這個故事是錯誤的?,F在 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獲得輸入的輸出節點,聯系起來,我們就得到了一個培訓規則。

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

      這里每個從n接收輸入的輸出節點j都不同。關于反向傳播算法的基本情況大致如此。

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

4、最速下降法與其改進

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

      最速下降法有著收斂速度慢(因為每次搜索與前一次均正交,收斂是鋸齒形的),容易陷入局部最小值等缺點,所以他的改進辦法也有不少,最常見的是增加動量項與學習率可變。

     增加沖量項(Momentum)

  • 修改權值更新法則,使第n次迭代時的權值的更新部分地依賴于發生在第n‐1次迭代時的更新
    Delta(w)(n)=-alpha*(1-mc)*Delta(w)(n) mc*Delta(w)(n-1)
  • 右側第一項就是權值更新法則,第二項被稱為沖量項

  • 梯度下降的搜索軌跡就像一個球沿誤差曲面滾下,沖量使球從一次迭代到下一次迭代時以同樣的方向滾動

  • 沖量有時會使這個球滾過誤差曲面的局部極小值或平坦區域

  • 沖量也具有在梯度不變的區域逐漸增大搜索步長的效果,從而加快收斂。

     改變學習率

  • 當誤差減小趨近目標時,說明修正方向是正確的,可以增加學習率;當誤差增加超過一個范圍時,說明修改不正確,需要降低學習率。

5、BP神經網絡的實現

(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代碼:

[plain] view plaincopyprint?在CODE上查看代碼片派生到我的代碼片
  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,是一個不錯的學習器。這里需要注意的是動量因子mc的選取,mc不能過小,否則容易陷入局部最小而出不去,在本例中,如果mc=0.5,分類正確率僅為:0.5333333,學習效果很不理想。

四、R中的神經網絡函數

       單層的前向神經網絡模型在包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個節點的一個隱藏層的神經網絡。輸入如下程序:


[plain] view plaincopyprint?在CODE上查看代碼片派生到我的代碼片
  1. library(nnet);  #安裝nnet軟件包  

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

  3. data(Vehicle);  #調入數據  

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

  5. set.seed(1);  #設隨機數種子  

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

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

  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);  #利用訓練集中前18個變量作為輸入變量,隱藏層有3個節點,初始隨機權值在[-0.1,0.1],權值是逐漸衰減的。  

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

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

  12. #構建隱藏層包含15個節點的網絡。接著上面的語句輸入如下程序:  

  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]));  

再看手寫數字案例

       最后,我們回到最開始的那個手寫數字的案例,我們試著利用支持向量機重做這個案例。(這個案例的描述與數據參見《R語言機器學習學習筆記(分類算法)(1)》)

      由于nnet包對輸入的維數有一定限制(我也不知道為什么,可能在權值計算的時候出現了一些bug,反正將支持向量機那一節的代碼平行的移過來是會報錯的)。我們這里采用手寫數字識別技術中常用的辦法處理這個案例:計算數字的特征。選擇數字特征的辦法有許多種,你隨便百度一篇論文都有敘述。我們這里采用結構特征與統計特征結合的辦法計算圖像的特征。


     我們這里采用的統計特征與上圖有一點的不同(結構特征一致),我們是將圖片分為16塊(4*4),統計每個小方塊中點的個數,這樣我們就有25維的特征向量了。為了保證結果的可比性,我們也報告支持向量機的分類結果。

      運行下列代碼:

[plain] view plaincopyprint?在CODE上查看代碼片派生到我的代碼片
  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])  

數據分析咨詢請掃描二維碼

若不方便掃碼,搜微信號:CDAshujufenxi

數據分析師資訊
更多

OK
客服在線
立即咨詢
日韩人妻系列无码专区视频,先锋高清无码,无码免费视欧非,国精产品一区一区三区无码
客服在線
立即咨詢