優化演算法是機器學習的一個重要組成部分，BP神經網路是深度學習的基礎，BP神經網路原理非常簡單，幾乎可以理解作是logistic迴歸的一種集合方式，在前面的博文中，筆者利用R語言實現了幾種優化演算法，本文以前面提到的粒子群演算法為工具，以神經網路的原理為基礎，實現了BP神經網路，最後以一個UCI（點選開啟連結可以下載該資料）信用評分的例子來說明神經網路運用的效果。

######根據神經網路的原理利用R語言來實現神經網路
##神經網路輸入層，隱藏層，輸出層引數設定
nclass<-c(14,5,5,1);
#啟用函式，本例選取的是雙曲正弦函式
sigmoid<-function(x){
    return((exp(x)-exp(-x))/(exp(x)+exp(-x)))
}
#向前計算
Neuralnet<-function(data,parameter){
        data<-scale(data);
		r_<-nrow(data[,-15]);
		c_<-ncol(data[,-15]);
        whide1<-matrix(parameter[1:(c_*nclass[2])],nrow=c_,ncol=nclass[2]);
		whide2<-matrix(parameter[(c_*nclass[2]+1):(c_*nclass[2]+nclass[2]*nclass[3])],nrow=nclass[2],ncol=nclass[3]);
		wout<-parameter[(c_*nclass[2]+nclass[2]*nclass[3]+1):(c_*nclass[2]+nclass[2]*nclass[3]+nclass[3]*nclass[4])];
		#計算各個節點值?
		in_value<-as.matrix(data[,-15]);
        hide1_value<-sigmoid(in_value%*%whide1);
        hide2_value<-sigmoid(hide1_value%*%whide2);
        out_value<-sigmoid(hide2_value%*%wout);
    return(out_value);
}

####
################PSO演算法實現################
##初始化PSO演算法引數
#收斂因子k（類似於慣性系數的作用）
#學習因子初始化k*phi_1,k*phi_2,phi<-phi_1+phi_2
#粒子群位置初始化w,以及wmin,wmax
#粒子群速度初始化v,以及vmin,vmax
k<-0.729
phi_1<-2.05
phi_2<-2.05
#以上引數為參照前人的經驗
#初始化引數的函式
inifunc<-function(dim,wmin,wmax,vmin,vmax,n){
            G<-rep(NA,2*dim+1);
            A<-matrix(runif(n*dim,wmin,wmax),nrow=n,ncol=dim);
            B<-matrix(runif(n*dim,vmin,vmax),nrow=n,ncol=dim);
            C<-apply(A,1,func);
            G<-cbind(A,B,C)[which(C==min(C)),];
    return(rbind(cbind(A,B,C),G));
}

##所有粒子歷史最優搜尋函式Gbest)
Gbestfunc<-function(x,dim,n){
              C<-x[-(n+1),2*dim+1];
    return(rbind(x[-(n+1),],x[which(C==min(C)),]));
}

##PSO 核心 function
PSOAfunc<-function(x,dim,wmin,wmax,vmin,vmax,n){
              A<-x[-(n+1),1:dim];
              B<-x[-(n+1),(dim+1):(2*dim)];
              C<-x[-(n+1),2*dim+1];
              for(i in 1:n){
                   neww<-A[i,]+B[i,];
                           for(j in 1:dim){
                               if(neww[j]>wmax || neww[j]vmax || B[i,k]vmax || B[i,k]0){
              x[i,j]=1} else
              x[i,j]=0
           }
       }
    return(x)
}
	
A<-interfunc(200,100,0,1,-0.2,0.2,100)

table(option01(Neuralnet(data_test,A)),data_test[,15])	
			
 

   如有錯誤，歡迎指正！