神经网络在R语言 实现

haviet

ti<-proc.time()
" u+ E, }1 Z, t, ~4 q, ]4 U1 [BP_one_output<-function(input,output,m,fth,sth,w,v){
        x<-input;#7*8
        y<-output;#8*1，y为向量，每一元素为一个样本输出值
        theta<-fth;#11*1
4 x+ R9 p/ d! H  b& C4 b, k        gama<-sth;#标量
        if(m!=length(theta)) print("阈值长度错误！")
1 T, F) W3 m0 q, q6 q( S        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
        K<-nrow(x);#8一组样本的维数
        J<-ncol(x);#8一共有多少组样本
: Y5 ?  A5 [0 v0 {9 H. Q: D! w        w<-rbind(w,t(theta));#由7*11变为8*11
2 w' M, i9 f/ M: h" l) S8 Y$ V        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接
#定义函数f
+ }  ]7 ~2 H* O5 f& p4 r& i        f<-function(h) 1/(1+exp(-h));
        epsilon<-alpha<-0.5;
        N<-0;#重复学习次数的计数
        ei<-as.numeric();#记录每次迭代的平均残差平方和
! H0 H$ T9 L" \; L$ W; C: K" Q        FW<-1;
6 L4 u; i' ~5 r: j) ]# j        while((FW/J)>=0.001){
+ h  M% l/ i) `  l% j* g                Z1<-t(w)%*%x;#11*8矩阵，每一列为一组样本
                Y1<-apply(Z1,c(1,2),f);#11*8矩阵，每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns
                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量，每个元素为隐含层对输出层的加权值
: a" i: g! o! `4 T5 T                D<-f(Z2);#向量，每一元素为一组样本的一个输出值
                b<-y-D;
/ o" x: L( `+ l/ v  ^2 h& E4 z                #J组样本的学习
$ S1 H7 m( X% [6 S                #向量，输出层对隐含层的权值的偏导
4 o8 t- T* o. s                FW<-pFW2<-pFW2t_1<-0;
! [) W0 t! T  \/ l0 c9 a                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导
: i& u6 v2 B1 Y( P                for(t in 1:J){
                        B3<-b[t];
# w0 P* _  ~0 E                        FW<-FW+B3*B3;#标量
                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
+ b0 U6 N! m! `7 i/ c  u                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
                        if(t==1) v<-v-0.5*epsilon*pFW2
                        else{
0 s: [; Y4 l; g, q' s) g3 C! O0 C                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
' @! E% O0 D$ A1 h. B                                pFW2t_1<-pFW2;
                        }
                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
" s" z9 l. C5 v' K# j7 v* ~" M% S                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
                        if(t==1) w<-w-0.5*epsilon*pFW1
                        else{
0 @. a% @8 ^4 U/ ~) d% `6 P                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
                                pFW1t_1<-pFW1;
4 w6 D7 a3 p# e5 D2 @( @8 j' h  _. i2 t0 t                        }
                }
' L- O+ R& ^; r" N0 T( l/ y                N<-N+1;
                ei[N]<-FW/J;
3 K0 @) _: v; j  E        }
3 j# |( Y5 q1 N# E3 O: @        theta<-w[nrow(w),];#隐含层阈值
0 s& R! q0 z  E! ]        gama<-v[length(v)];#输出层阈值
        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
        v<-v[1length(v)-1)];#隐含层对输出层的权重
        list(theta,gama,w,v,N,FW/J,ei)
5 T6 y9 Q2 B3 p}
" I+ ]. a% T: ?x<-cbind(x1,x2,x3,x4,x5,x6,x7);
x<-t(x);
hidden_threshold<-runif(11);
9 \! l: [8 j6 y2 S; h/ I. Houtput_threshold<-runif(1);
3 \$ u+ g/ M1 x, y% N/ gw<-matrix(runif(77),7,11);
8 V+ q/ |. p! Y' wv<-runif(11);
% u, [# Y' H0 }0 m" eresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
#输出
cat("\n");
! T7 L- S, k8 Z" Pcat("隐含层阈值theta","\n",result[[1]],"\n");
$ y5 v$ I: G7 u9 V% e6 qcat("输出层阈值gama","\n",result[[2]],"\n");
2 w; M- }% A6 O& S* M: v) r' [w<-as.matrix(result[[3]],7,11);
3 t$ e) e' l) x  ?4 Ucat("输入层对隐含层的权重w","\n");
w;
cat("\n");
cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
cat("迭代次数N" ,"\n",result[[5]],"\n");
4 Q1 ~1 D' S2 B$ x3 wcat("学习误差FW","\n",result[[6]],"\n");
* V9 p: Q. H3 {) B" a0 e& Mcat("每次迭代的误差","\n");
* h0 q1 r8 C3 \. y. j# Bplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
8 E! Q2 e0 _" I: P1 i2 Pproc.time()-ti

廷植斌_972

支持~~顶顶~~~

Esmtih

运行不了啊？

黄窗帘

就看看，不说话。

凌chers

能不能解释一下呢？

兰竹李乐

这牛逼的你自己编的吗