神经网络在R语言 实现

haviet

ti<-proc.time()
4 L( @! ^7 D$ z/ V" eBP_one_output<-function(input,output,m,fth,sth,w,v){
        x<-input;#7*8
- u+ P) E! f9 b- b1 Y        y<-output;#8*1，y为向量，每一元素为一个样本输出值
        theta<-fth;#11*1
1 n! u8 K* ~( n5 ]- B( r9 Q        gama<-sth;#标量
        if(m!=length(theta)) print("阈值长度错误！")
        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
1 G0 a6 d! t. G: i7 @        K<-nrow(x);#8一组样本的维数
        J<-ncol(x);#8一共有多少组样本
        w<-rbind(w,t(theta));#由7*11变为8*11
        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接
#定义函数f
9 h0 e+ F# ^9 J, F# Q        f<-function(h) 1/(1+exp(-h));
: n. z: t' C: s0 j" `        epsilon<-alpha<-0.5;
1 w* M+ K) J5 J        N<-0;#重复学习次数的计数
- {1 Q5 i1 Z8 `        ei<-as.numeric();#记录每次迭代的平均残差平方和
        FW<-1;
7 k/ O2 d9 ]& J  U% {        while((FW/J)>=0.001){
                Z1<-t(w)%*%x;#11*8矩阵，每一列为一组样本
- c' e2 n7 [6 T4 z                Y1<-apply(Z1,c(1,2),f);#11*8矩阵，每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
" [9 R0 @  q7 F                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns
' g* E+ O& @( X+ d4 m+ y3 A/ o                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量，每个元素为隐含层对输出层的加权值
; D1 O2 }6 l. V7 A' V4 v                D<-f(Z2);#向量，每一元素为一组样本的一个输出值
5 M4 n& ?" C- s# \* W9 a                b<-y-D;
                #J组样本的学习
                #向量，输出层对隐含层的权值的偏导
                FW<-pFW2<-pFW2t_1<-0;
                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导
2 i6 v* m. w. j, O' F                for(t in 1:J){
/ ^( {: a( g, F8 i3 A. b                        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向量隐含层对输出层的权重偏导,此时多了一个阈值项
1 O& T" _9 D# u. W4 B' d                        if(t==1) v<-v-0.5*epsilon*pFW2
                        else{
* v4 a" ~- U- k( k0 [- Z+ p8 _6 `                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
                                pFW2t_1<-pFW2;
                        }
                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
  ]# k3 [7 X6 }% t! b6 x: }8 p                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
                        if(t==1) w<-w-0.5*epsilon*pFW1
                        else{
6 J; |/ [* M3 ?! P3 z* @& N  e                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
. r3 L6 W# ~2 T                                pFW1t_1<-pFW1;
; G6 A$ e: G# N, f2 S  S4 V. Z                        }
                }
                N<-N+1;
                ei[N]<-FW/J;
4 n8 k3 w9 u! t+ n8 z        }
        theta<-w[nrow(w),];#隐含层阈值
        gama<-v[length(v)];#输出层阈值
        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
2 T6 m/ t3 g# D& U% P5 r% v        v<-v[1length(v)-1)];#隐含层对输出层的权重
        list(theta,gama,w,v,N,FW/J,ei)
}
x<-cbind(x1,x2,x3,x4,x5,x6,x7);
x<-t(x);
9 N2 g* u) P5 ^9 }1 Chidden_threshold<-runif(11);
. ^  H% x% E7 x$ l  Z4 _output_threshold<-runif(1);
: s" b/ w) n( X' ]8 j1 [! kw<-matrix(runif(77),7,11);
v<-runif(11);
result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
3 C: |6 z" H7 W7 b; V#输出
+ Q" V( `5 a& V- d( ]9 d: L6 scat("\n");
4 B: t5 ?. ~* g& jcat("隐含层阈值theta","\n",result[[1]],"\n");
cat("输出层阈值gama","\n",result[[2]],"\n");
w<-as.matrix(result[[3]],7,11);
. S4 j0 e" O! ?) n6 p& ~5 `) C7 v$ Gcat("输入层对隐含层的权重w","\n");
w;
cat("\n");
cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
( D$ D$ v+ o% L" b& O8 J& Hcat("迭代次数N" ,"\n",result[[5]],"\n");
cat("学习误差FW","\n",result[[6]],"\n");
cat("每次迭代的误差","\n");
; |8 g2 ]3 j; @1 Bplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
proc.time()-ti
3 G" f+ j! r& m

廷植斌_972

支持~~顶顶~~~

Esmtih

运行不了啊？

黄窗帘

就看看，不说话。

凌chers

能不能解释一下呢？

兰竹李乐

这牛逼的你自己编的吗