神经网络在R语言 实现

haviet

ti<-proc.time()
. z  F$ h2 G" z8 v8 U0 fBP_one_output<-function(input,output,m,fth,sth,w,v){
6 c, _0 R' t$ |        x<-input;#7*8
7 a( J" Q5 M2 ?" q% k8 D1 l        y<-output;#8*1，y为向量，每一元素为一个样本输出值
: N. l& b% B! q' x# J        theta<-fth;#11*1
" z! R: X8 t5 J  c' i        gama<-sth;#标量
        if(m!=length(theta)) print("阈值长度错误！")
        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
9 h- d1 Q+ u' Z3 H" u        K<-nrow(x);#8一组样本的维数
$ I/ o% D6 ^2 S3 E9 c9 y7 X        J<-ncol(x);#8一共有多少组样本
        w<-rbind(w,t(theta));#由7*11变为8*11
        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接
$ Y9 l1 K. X: w' a#定义函数f
) v7 L+ e8 v" A1 L        f<-function(h) 1/(1+exp(-h));
# w( k1 q& L* }4 M, F        epsilon<-alpha<-0.5;
        N<-0;#重复学习次数的计数
( P1 E9 }* O" L        ei<-as.numeric();#记录每次迭代的平均残差平方和
        FW<-1;
4 k( Z* `) x3 Z7 z& x6 Y' y% Y/ v        while((FW/J)>=0.001){
                Z1<-t(w)%*%x;#11*8矩阵，每一列为一组样本
7 V% N1 z% Z3 F7 X. ~% B                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);#向量，每一元素为一组样本的一个输出值
; U$ |- s5 O  q/ D. v8 J6 e3 K3 L                b<-y-D;
6 F6 J, J6 a" W7 f1 U: ~                #J组样本的学习
                #向量，输出层对隐含层的权值的偏导
                FW<-pFW2<-pFW2t_1<-0;
                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导
                for(t in 1:J){
4 E! h2 L& f5 Q6 n" \1 \                        B3<-b[t];
                        FW<-FW+B3*B3;#标量
                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
                        if(t==1) v<-v-0.5*epsilon*pFW2
" l% V+ H3 e8 f9 Y9 t- a                        else{
) T0 U4 I, d) n                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
                                pFW2t_1<-pFW2;
( Y6 B8 ]' J4 Z0 K                        }
; ~. [6 O$ O( y+ e: L                        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{
                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
6 n8 t2 c+ S6 k& t                                pFW1t_1<-pFW1;
/ {0 T4 R3 d) q$ x/ v                        }
. y( o- o- H2 {. @) t, [" a, h                }
# p& z* u, r! B0 z& I, q  f                N<-N+1;
& V6 V* T5 A) c2 C# v" i: e& m# I                ei[N]<-FW/J;
5 X$ V, k- T* H+ I7 f2 P        }
6 [1 |) s% Y5 `# I8 Y+ K) O. ?$ T        theta<-w[nrow(w),];#隐含层阈值
        gama<-v[length(v)];#输出层阈值
        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
        v<-v[1length(v)-1)];#隐含层对输出层的权重
        list(theta,gama,w,v,N,FW/J,ei)
1 p' W8 U& A6 r: J}
x<-cbind(x1,x2,x3,x4,x5,x6,x7);
' C) n- M$ u0 P, k( `9 Nx<-t(x);
hidden_threshold<-runif(11);
$ H% y4 f1 E9 @5 ^- R# A  b& xoutput_threshold<-runif(1);
w<-matrix(runif(77),7,11);
v<-runif(11);
6 }* d3 }2 a& o0 M1 j. presult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
#输出
0 R0 M; Z8 M9 Q% R2 L; ^cat("\n");
$ [! a+ }) P$ R, \9 Ocat("隐含层阈值theta","\n",result[[1]],"\n");
9 H0 M: j; ]* J* b4 s0 r/ Zcat("输出层阈值gama","\n",result[[2]],"\n");
w<-as.matrix(result[[3]],7,11);
cat("输入层对隐含层的权重w","\n");
w;
cat("\n");
" P0 S- ^  w3 A+ I( R/ S% Gcat("隐含层对输出层的权重v","\n",result[[4]],"\n");
cat("迭代次数N" ,"\n",result[[5]],"\n");
9 k; X1 A' j2 c7 mcat("学习误差FW","\n",result[[6]],"\n");
0 r0 @3 h& A  P  u1 A' Ycat("每次迭代的误差","\n");
/ M8 n$ U7 E. r* `( l5 Kplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
proc.time()-ti

廷植斌_972

支持~~顶顶~~~

Esmtih

运行不了啊？

黄窗帘

就看看，不说话。

凌chers

能不能解释一下呢？

兰竹李乐

这牛逼的你自己编的吗