神经网络在R语言 实现

haviet

ti<-proc.time()
8 i: ^* t, Y; h* O5 OBP_one_output<-function(input,output,m,fth,sth,w,v){
        x<-input;#7*8
! o* x' O; f( a4 J- K( u        y<-output;#8*1，y为向量，每一元素为一个样本输出值
) [) z0 Q! f: k1 f8 m        theta<-fth;#11*1
. X) ^  B1 I) e( S$ T( P) ^        gama<-sth;#标量
        if(m!=length(theta)) print("阈值长度错误！")
* ~4 h& K: L) [7 Q: N- k        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
        K<-nrow(x);#8一组样本的维数
7 R* q4 M9 l$ P# R7 K: O        J<-ncol(x);#8一共有多少组样本
$ e7 B% K$ X; v4 ^        w<-rbind(w,t(theta));#由7*11变为8*11
        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接
#定义函数f
( g1 I7 n8 E" E" L4 j1 U        f<-function(h) 1/(1+exp(-h));
3 F/ F$ |3 f# r8 Q6 m8 ^        epsilon<-alpha<-0.5;
        N<-0;#重复学习次数的计数
        ei<-as.numeric();#记录每次迭代的平均残差平方和
9 ]& c0 W2 U; u& B' J  c0 W9 E        FW<-1;
        while((FW/J)>=0.001){
                Z1<-t(w)%*%x;#11*8矩阵，每一列为一组样本
6 c% N( g9 V% A, o& P' }                Y1<-apply(Z1,c(1,2),f);#11*8矩阵，每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns
/ o) K( A# p: @3 L& }$ [9 m                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量，每个元素为隐含层对输出层的加权值
                D<-f(Z2);#向量，每一元素为一组样本的一个输出值
0 a% i+ k3 t; ~+ [                b<-y-D;
: p4 L) r, V5 a; G! h                #J组样本的学习
                #向量，输出层对隐含层的权值的偏导
: u( _" i% ^- O6 l  @                FW<-pFW2<-pFW2t_1<-0;
                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导
+ v% \5 J3 E* m$ F! k4 k                for(t in 1:J){
                        B3<-b[t];
                        FW<-FW+B3*B3;#标量
                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
( i) f/ c0 e+ a1 S& N                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
* p' G- e, j0 L8 S! n! \                        if(t==1) v<-v-0.5*epsilon*pFW2
                        else{
) E+ m% P& t  O                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
                                pFW2t_1<-pFW2;
; S$ e0 S+ w' v7 q8 B) M. [4 P                        }
                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
: S  C9 o  k0 [& U6 V                        if(t==1) w<-w-0.5*epsilon*pFW1
                        else{
                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
4 h5 m: }3 J8 ?1 R* j  r$ l9 U                                pFW1t_1<-pFW1;
                        }
; z9 w5 F2 d+ b8 v- \( C                }
                N<-N+1;
1 f3 [9 M: T. Y                ei[N]<-FW/J;
        }
        theta<-w[nrow(w),];#隐含层阈值
, J0 m  g% {% h  Z! L  T" T9 u& O        gama<-v[length(v)];#输出层阈值
" L3 f' ~& \5 V        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
        v<-v[1length(v)-1)];#隐含层对输出层的权重
        list(theta,gama,w,v,N,FW/J,ei)
( {; b* v7 \& H+ I9 O; \+ X}
; Z( d  ^( U! r: Vx<-cbind(x1,x2,x3,x4,x5,x6,x7);
x<-t(x);
hidden_threshold<-runif(11);
+ S5 B: i% V/ n& M$ I) m% X0 [output_threshold<-runif(1);
w<-matrix(runif(77),7,11);
; o* k5 E" L' ov<-runif(11);
result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
#输出
  D. g5 r; \) L( Bcat("\n");
9 Q6 y' ^' d# Y, E! O0 I, }/ zcat("隐含层阈值theta","\n",result[[1]],"\n");
1 z" P# J5 Q  p0 @: V- Hcat("输出层阈值gama","\n",result[[2]],"\n");
w<-as.matrix(result[[3]],7,11);
7 q* i0 u# U6 f' }: L2 C: i: Gcat("输入层对隐含层的权重w","\n");
! F" I# E% R0 _w;
( W6 X. E. S1 B  c) }! e1 o) Xcat("\n");
cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
+ t. ?+ ^8 G2 `% U  c: y% Jcat("迭代次数N" ,"\n",result[[5]],"\n");
  ^3 ]+ y" M. A$ J8 H7 lcat("学习误差FW","\n",result[[6]],"\n");
cat("每次迭代的误差","\n");
1 p8 M# `7 ^/ P3 l! h% w2 O6 ~( tplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
proc.time()-ti

廷植斌_972

支持~~顶顶~~~

Esmtih

运行不了啊？

黄窗帘

就看看，不说话。

凌chers

能不能解释一下呢？

兰竹李乐

这牛逼的你自己编的吗