神经网络在R语言 实现

haviet

ti<-proc.time()
5 Z5 m& L+ n8 {; CBP_one_output<-function(input,output,m,fth,sth,w,v){
7 y, _7 X' l" e. p6 d  x4 y4 [        x<-input;#7*8
        y<-output;#8*1，y为向量，每一元素为一个样本输出值
* f  G7 `% g1 y! P1 a: g        theta<-fth;#11*1
3 S5 [# i7 m5 A. _& s        gama<-sth;#标量
7 q* S% }% t1 s9 f* B        if(m!=length(theta)) print("阈值长度错误！")
        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
        K<-nrow(x);#8一组样本的维数
        J<-ncol(x);#8一共有多少组样本
        w<-rbind(w,t(theta));#由7*11变为8*11
        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接
: A- t8 w) D* D1 c#定义函数f
& r+ A2 \) `' L% r5 m& q( I        f<-function(h) 1/(1+exp(-h));
6 Z/ t% j$ U# M& k, f; C        epsilon<-alpha<-0.5;
        N<-0;#重复学习次数的计数
        ei<-as.numeric();#记录每次迭代的平均残差平方和
9 F$ n5 u! s5 V        FW<-1;
/ _  Q8 Q1 W+ l6 J- L( v        while((FW/J)>=0.001){
                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向量，每个元素为隐含层对输出层的加权值
                D<-f(Z2);#向量，每一元素为一组样本的一个输出值
                b<-y-D;
( K. ^* [0 o, H: S' D' t                #J组样本的学习
$ _/ u; ]* L% ^. H) r                #向量，输出层对隐含层的权值的偏导
' i2 e) Y5 D" c1 x8 Z! [) W                FW<-pFW2<-pFW2t_1<-0;
1 O  u( ]. Q5 z                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导
                for(t in 1:J){
                        B3<-b[t];
                        FW<-FW+B3*B3;#标量
7 D8 t2 v. k( |6 ]% A+ F                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
/ p3 M, `. g3 \( v+ ^* S2 g                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
7 o& [1 d: ^) w; v$ l: N                        if(t==1) v<-v-0.5*epsilon*pFW2
                        else{
                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
$ l7 U9 d) e  M                                pFW2t_1<-pFW2;
                        }
8 E6 T) Y5 y2 A, x                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
' v* w( G" a2 n; o6 Y7 V; Q                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
                        if(t==1) w<-w-0.5*epsilon*pFW1
8 _+ J+ H  G4 {+ @: U- ]* M2 a$ a                        else{
                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
. c: m+ |7 U, ^; x" U9 |6 v                                pFW1t_1<-pFW1;
                        }
: {( V6 c; _' [                }
% h  T  r4 `) T                N<-N+1;
                ei[N]<-FW/J;
! w8 p; L5 v& `" g& k7 t        }
1 d  `: y6 K8 [- `: _        theta<-w[nrow(w),];#隐含层阈值
        gama<-v[length(v)];#输出层阈值
: ~. V% [1 `) ]3 R) C0 B$ F        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
) _  t# L7 l- e/ ~1 t- j/ U0 T        v<-v[1length(v)-1)];#隐含层对输出层的权重
        list(theta,gama,w,v,N,FW/J,ei)
}
x<-cbind(x1,x2,x3,x4,x5,x6,x7);
: F& ~  r: `# D: lx<-t(x);
hidden_threshold<-runif(11);
output_threshold<-runif(1);
w<-matrix(runif(77),7,11);
0 \/ f) \. ]" f, sv<-runif(11);
result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
( x% v; H  N/ C9 c4 d#输出
cat("\n");
! t7 }7 x. Y, ], \: I' W: m. Qcat("隐含层阈值theta","\n",result[[1]],"\n");
& Y! b7 b' \  M* A( Wcat("输出层阈值gama","\n",result[[2]],"\n");
; b. }6 G2 Z5 d3 O: p9 g% J$ R3 cw<-as.matrix(result[[3]],7,11);
cat("输入层对隐含层的权重w","\n");
w;
cat("\n");
$ y& u# Z( k2 i$ \cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
# s0 N, d! @* R! b( Hcat("迭代次数N" ,"\n",result[[5]],"\n");
5 c$ n( U  C4 H' M/ e2 ]' ^cat("学习误差FW","\n",result[[6]],"\n");
/ R! M" i3 {' U3 r- h& }1 x8 _  Mcat("每次迭代的误差","\n");
8 Y' b0 v- L4 M6 z9 Aplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
$ J; _# C) q/ o0 g+ n: L5 Gproc.time()-ti

廷植斌_972

支持~~顶顶~~~

Esmtih

运行不了啊？

黄窗帘

就看看，不说话。

凌chers

能不能解释一下呢？

兰竹李乐

这牛逼的你自己编的吗