神经网络在R语言 实现

haviet

ti<-proc.time()
1 ?# N) p% t" O6 P1 r1 F, sBP_one_output<-function(input,output,m,fth,sth,w,v){
% a" o& z% s9 q! [2 C        x<-input;#7*8
        y<-output;#8*1，y为向量，每一元素为一个样本输出值
) [5 v% [4 a$ p; h3 {        theta<-fth;#11*1
6 O# ~/ G4 C% q- X        gama<-sth;#标量
4 b# l2 h0 V/ L8 I; t- k6 @: b        if(m!=length(theta)) print("阈值长度错误！")
$ W& ^! \0 a8 P( b, Z        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
        K<-nrow(x);#8一组样本的维数
4 I+ h4 r+ @6 S% W0 X        J<-ncol(x);#8一共有多少组样本
        w<-rbind(w,t(theta));#由7*11变为8*11
. e- O' O3 Q& p5 g- Y0 ~        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接
4 O  o+ a$ U  c  }5 [#定义函数f
        f<-function(h) 1/(1+exp(-h));
        epsilon<-alpha<-0.5;
        N<-0;#重复学习次数的计数
        ei<-as.numeric();#记录每次迭代的平均残差平方和
' i% f8 U. r& K5 i% ]) K        FW<-1;
        while((FW/J)>=0.001){
( a' |/ Z7 M2 [# o                Z1<-t(w)%*%x;#11*8矩阵，每一列为一组样本
2 u7 G5 n4 ~; Z# [3 Z# p                Y1<-apply(Z1,c(1,2),f);#11*8矩阵，每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
% S9 |0 N0 V, f( P                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns
7 Y3 F# `& L+ O6 J' H                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量，每个元素为隐含层对输出层的加权值
* b0 G- L5 U, R                D<-f(Z2);#向量，每一元素为一组样本的一个输出值
& D" W; [1 ~% v  h6 J( Y9 \                b<-y-D;
                #J组样本的学习
                #向量，输出层对隐含层的权值的偏导
# U# C+ {3 o! k. d1 {# Y; Y                FW<-pFW2<-pFW2t_1<-0;
" ]1 z- T; j4 Y% z  v                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导
                for(t in 1:J){
/ n  i  G8 Z8 [' c7 c                        B3<-b[t];
; E' _: a% R/ X& ]0 S" }* J) ]                        FW<-FW+B3*B3;#标量
                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
0 a* K* r: i9 v  }# n  q                        if(t==1) v<-v-0.5*epsilon*pFW2
                        else{
2 E- O9 V  I) z1 Y: Y/ Z1 D, R' V; d                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
0 |  C0 T) G! ~                                pFW2t_1<-pFW2;
! _0 ~0 E; N% F  Y; }: R1 E( F$ h                        }
" F. W6 ~9 Z: L+ i# h; N; {9 N                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
                        if(t==1) w<-w-0.5*epsilon*pFW1
                        else{
# Y2 j4 Z+ f( s3 p( B! n' s" t& W                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
2 c7 Q) E# _2 [$ v) @9 B                                pFW1t_1<-pFW1;
                        }
                }
                N<-N+1;
3 C9 \* V) M0 w. `0 x2 d* L9 {' i4 q6 L                ei[N]<-FW/J;
" O3 Z( [- r) l7 }        }
        theta<-w[nrow(w),];#隐含层阈值
& q; z, y1 w. q  }' `        gama<-v[length(v)];#输出层阈值
        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
/ W# Q+ H1 e5 Q6 [- n        v<-v[1length(v)-1)];#隐含层对输出层的权重
        list(theta,gama,w,v,N,FW/J,ei)
}
5 z- T7 O; Q( G7 Ix<-cbind(x1,x2,x3,x4,x5,x6,x7);
x<-t(x);
hidden_threshold<-runif(11);
  I: v. `- @  K. E6 b; N! m! koutput_threshold<-runif(1);
w<-matrix(runif(77),7,11);
( _' L; a$ f; O% y. D' J' _v<-runif(11);
/ i$ X% m4 P  ~( d' z" l$ j: {. w+ qresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
#输出
cat("\n");
3 \- J  Z, F# ^8 W% lcat("隐含层阈值theta","\n",result[[1]],"\n");
cat("输出层阈值gama","\n",result[[2]],"\n");
2 h* K' h4 M, E8 i$ V% f' J6 ww<-as.matrix(result[[3]],7,11);
cat("输入层对隐含层的权重w","\n");
w;
cat("\n");
1 x) ?; k# J: q1 b. _cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
cat("迭代次数N" ,"\n",result[[5]],"\n");
cat("学习误差FW","\n",result[[6]],"\n");
' N" e6 i' _9 o# C8 {) @cat("每次迭代的误差","\n");
plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
6 m; S" T$ g8 k2 Z" cproc.time()-ti

兰竹李乐

这牛逼的你自己编的吗

凌chers

能不能解释一下呢？

黄窗帘

就看看，不说话。

Esmtih

运行不了啊？

廷植斌_972

支持~~顶顶~~~