神经网络在R语言 实现

haviet

ti<-proc.time()
BP_one_output<-function(input,output,m,fth,sth,w,v){
) e7 z# q: w1 h( u& U+ @& _$ l7 E( }        x<-input;#7*8
        y<-output;#8*1，y为向量，每一元素为一个样本输出值
# m6 s3 S( l; |        theta<-fth;#11*1
  p% F" L# a0 x, K) O5 h5 E        gama<-sth;#标量
        if(m!=length(theta)) print("阈值长度错误！")
1 n9 A: d  S! ~& L9 O1 r; a        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
        K<-nrow(x);#8一组样本的维数
        J<-ncol(x);#8一共有多少组样本
9 [0 b, s: z8 u, q        w<-rbind(w,t(theta));#由7*11变为8*11
        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接
) b0 `* _4 o4 u) s; E#定义函数f
        f<-function(h) 1/(1+exp(-h));
" w( H( i* [) r% D        epsilon<-alpha<-0.5;
2 M" _7 z$ r+ C        N<-0;#重复学习次数的计数
$ i$ M6 \' d+ ]: J        ei<-as.numeric();#记录每次迭代的平均残差平方和
" K$ l' X: f' {8 [        FW<-1;
" a% a1 l  p; L. V5 Z        while((FW/J)>=0.001){
( ]. e2 ]( h. q; S8 ]. r, t                Z1<-t(w)%*%x;#11*8矩阵，每一列为一组样本
1 T$ [1 q7 d: u0 @                Y1<-apply(Z1,c(1,2),f);#11*8矩阵，每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
4 D2 P* L5 o: L4 }* f* j                                                                                        #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;
                #J组样本的学习
7 D2 ^6 ~- E+ h$ s                #向量，输出层对隐含层的权值的偏导
                FW<-pFW2<-pFW2t_1<-0;
3 ~1 L) v$ b( q                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导
                for(t in 1:J){
% H# C; R* f+ g, ]7 u: G9 _                        B3<-b[t];
$ u2 @4 W7 `  z  w+ T; S                        FW<-FW+B3*B3;#标量
- \/ z  h) E$ w6 A                        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
                        else{
                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
                                pFW2t_1<-pFW2;
# b, g) A4 O0 o  Z- s; Z                        }
                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
  J7 \' O: x% p$ v7 K( ^                        if(t==1) w<-w-0.5*epsilon*pFW1
% n! I' M- P/ L5 t8 T+ F+ N                        else{
5 E9 I$ \! ^! T6 p0 I1 |0 ^                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
                                pFW1t_1<-pFW1;
! k, Q' r9 B1 r  I$ ?                        }
                }
& m) r/ H; |8 D' A) q                N<-N+1;
' h. K, p4 s8 [. ^6 z                ei[N]<-FW/J;
/ z* W1 M7 r* ]! ~2 D        }
        theta<-w[nrow(w),];#隐含层阈值
: f7 s4 d2 Y( Z; Z        gama<-v[length(v)];#输出层阈值
        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
  q: A  |  l1 |1 |! w7 C9 V# I        v<-v[1length(v)-1)];#隐含层对输出层的权重
2 Z( k- `, M1 F. i) ?7 {( d        list(theta,gama,w,v,N,FW/J,ei)
6 o9 f4 N9 q( f$ j}
x<-cbind(x1,x2,x3,x4,x5,x6,x7);
x<-t(x);
# L2 k: K( N# o8 Chidden_threshold<-runif(11);
1 O: W9 B5 ]# ]; moutput_threshold<-runif(1);
w<-matrix(runif(77),7,11);
v<-runif(11);
$ A9 A. t% j+ ~8 p. ?: Mresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
# q* G" a! t1 b, S9 `! U0 _/ k1 t#输出
9 b) _' ^1 I: }" m% o1 O  ccat("\n");
: P6 u- i" E: {( g/ K- ~cat("隐含层阈值theta","\n",result[[1]],"\n");
cat("输出层阈值gama","\n",result[[2]],"\n");
0 p4 X1 U5 {" r9 q- t+ g  ~" gw<-as.matrix(result[[3]],7,11);
5 @0 [6 b2 l2 y  k3 r+ Acat("输入层对隐含层的权重w","\n");
6 u- H, X$ X3 Q' M! J6 V$ Bw;
cat("\n");
cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
  p3 P7 R4 G/ @! \- o8 n* xcat("迭代次数N" ,"\n",result[[5]],"\n");
! O) s% `7 x' ccat("学习误差FW","\n",result[[6]],"\n");
cat("每次迭代的误差","\n");
plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
proc.time()-ti

廷植斌_972

支持~~顶顶~~~

Esmtih

运行不了啊？

黄窗帘

就看看，不说话。

凌chers

能不能解释一下呢？

兰竹李乐

这牛逼的你自己编的吗