数学建模社区-数学中国

标题: 神经网络在R语言 实现 [打印本页]
作者: haviet    时间: 2011-9-13 20:25
标题: 神经网络在R语言 实现
ti<-proc.time()
2 j3 d! [/ [& [- J3 ^; cBP_one_output<-function(input,output,m,fth,sth,w,v){
( J  G2 u6 c' q! R: Q        x<-input;#7*8
, l* F5 r  P; z4 G, O3 i" i0 F! ]        y<-output;#8*1，y为向量，每一元素为一个样本输出值
$ P4 `& v7 r# k* i        theta<-fth;#11*1
0 H3 z! b8 Q9 u! N# D9 }- P        gama<-sth;#标量
( E+ ^5 }$ Z8 x8 T  A* Q        if(m!=length(theta)) print("阈值长度错误！")
. ]. i3 B& p- i2 G, q        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重& q! A7 m0 a  f# L( L2 E
        K<-nrow(x);#8一组样本的维数
, w# o7 w' O' X3 c        J<-ncol(x);#8一共有多少组样本
. h# F5 Z4 l4 }) G# r) L) T4 f9 o        w<-rbind(w,t(theta));#由7*11变为8*11
* o4 x, B( U0 F- B# B3 P$ R        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接
. y4 i- |% b& {/ B% q' p# ^/ J#定义函数f
; Q3 @6 P8 }2 m& D" g/ [8 C9 P2 V        f<-function(h) 1/(1+exp(-h));) Z7 d4 M$ ^0 H5 [. K' ]. r( a
        epsilon<-alpha<-0.5;
1 O* C- Z* B1 ~: Y1 W        N<-0;#重复学习次数的计数
4 c, j5 K- J! X0 K7 a        ei<-as.numeric();#记录每次迭代的平均残差平方和9 N5 T. Y* q/ o3 R2 m  N
        FW<-1;
, b! L+ K9 Y' J        while((FW/J)>=0.001){: p% [; P) X" W2 F
                Z1<-t(w)%*%x;#11*8矩阵，每一列为一组样本
( a: W& s- ~% ^0 E2 k                Y1<-apply(Z1,c(1,2),f);#11*8矩阵，每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
7 ]; X& L$ h  D7 t) S3 y                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns
2 T. k* @2 T) H  E                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量，每个元素为隐含层对输出层的加权值
  o$ H7 w( A* |$ J$ L. i6 p                D<-f(Z2);#向量，每一元素为一组样本的一个输出值
! ~- B: T$ _+ g                b<-y-D;* ]1 i: q( [* e" ?; J
                #J组样本的学习
- n: E$ L. ~* k* i                #向量，输出层对隐含层的权值的偏导
) M2 A, d2 S0 z; T! \                FW<-pFW2<-pFW2t_1<-0;$ t3 t* a: c8 c' s' X+ C5 J
                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导
% m: A3 O: i* ^7 q7 b% Q0 v                for(t in 1:J){
' t9 l. }2 d$ `" V7 f4 a                        B3<-b[t];
# s8 @& g3 _$ P3 `; m( Y6 H# o                        FW<-FW+B3*B3;#标量
4 U- z% w: \6 h! c, }+ [                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量! B1 }# E0 m) J/ }  ^$ c% p
                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项& m9 V/ C; S. |/ L
                        if(t==1) v<-v-0.5*epsilon*pFW2) Q, G- y+ q* ^# {: O2 v6 P! T/ w
                        else{9 F6 {* W9 }: h9 N: U( S  e( d
                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);9 f3 o1 o3 Y: d: ?' J3 p
                                pFW2t_1<-pFW2;
4 |  }6 C4 E  [* i$ X, P/ M( ]9 F                        }
9 {7 n  _9 J, x2 z5 m# z                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连* X1 m: j7 m% c5 y; j8 \
                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导, G' G* v5 {0 y) g$ O0 S2 w
                        if(t==1) w<-w-0.5*epsilon*pFW1/ z# h) l3 y! \1 U% _/ y! L
                        else{; c" n# W5 v, |! N0 z, I
                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);3 M- _$ r9 n  J$ @
                                pFW1t_1<-pFW1;
' \$ R" Q) w4 I5 S; W4 w( t                        }
" b8 I8 C1 q0 l, H                }
3 Y' h) g5 d+ t" b. P- t1 m                N<-N+1;9 C1 u, e) G+ A9 K, w3 I
                ei[N]<-FW/J;
5 W6 ?) T0 x: s) `* G6 Q( }1 H        }. c2 R5 E$ O  v# Y7 B
        theta<-w[nrow(w),];#隐含层阈值
0 |: W4 ?! F$ h1 V+ |+ o        gama<-v[length(v)];#输出层阈值, J5 y* x6 l' f/ z4 |
        w<-w[1nrow(w)-1),];#输入层对隐含层的权重$ Y6 A+ u9 n# `# S8 W4 |9 d
        v<-v[1length(v)-1)];#隐含层对输出层的权重5 @; i5 ~3 [$ m
        list(theta,gama,w,v,N,FW/J,ei)2 l& o9 v+ E8 O# `  }
}
  g, v  I7 K3 G1 d% d4 F& {; Ux<-cbind(x1,x2,x3,x4,x5,x6,x7);
- _: L  b- f7 B* h1 Gx<-t(x);5 f' F* d% }3 {  G) w
hidden_threshold<-runif(11);9 ^  ~3 p1 L8 `* ]& S/ f7 T
output_threshold<-runif(1);1 J4 D: G+ n* r5 o- b( z* v
w<-matrix(runif(77),7,11);1 _0 a3 H- h/ f! ~1 a* |
v<-runif(11);
4 o, E9 Y+ g. W  Aresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);8 t- J) V7 [  k' o, S1 N( T0 I: |, z
#输出% L' B' ^, V# ~/ B3 w
cat("\n");
5 x  _+ q5 }3 @cat("隐含层阈值theta","\n",result[[1]],"\n");
9 s$ D: S& E" v# d: ~$ k$ m) A) icat("输出层阈值gama","\n",result[[2]],"\n");  U$ g& ^" q7 u; P' n/ Y
w<-as.matrix(result[[3]],7,11);
. ]& d- s& Y% G3 Ycat("输入层对隐含层的权重w","\n");  p+ \, A! l( v( f: F0 e
w;
+ j0 v7 D0 K; I0 s) S% rcat("\n");: V0 `- F% N( e( B) F
cat("隐含层对输出层的权重v","\n",result[[4]],"\n");5 x* ]8 B( D; ?, b$ G3 I8 r" g
cat("迭代次数N" ,"\n",result[[5]],"\n");4 ~4 H- L; r$ }3 _
cat("学习误差FW","\n",result[[6]],"\n");0 F2 g1 Y- K! K
cat("每次迭代的误差","\n");
) Z# B# p2 d$ c7 ?: u7 ~plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
, J1 F4 t: X* H4 X4 kproc.time()-ti
, M1 g9 m: L, }* h, t
作者: 廷植斌_972    时间: 2011-10-30 23:44
支持~~顶顶~~~
作者: Esmtih    时间: 2011-11-8 09:26
运行不了啊？
作者: 黄窗帘    时间: 2012-2-1 14:07
就看看，不说话。
作者: 凌chers    时间: 2012-3-22 15:08
能不能解释一下呢？
作者: 兰竹李乐    时间: 2014-9-2 12:51
这牛逼的你自己编的吗



欢迎光临 数学建模社区-数学中国 (http://www.madio.net/) Powered by Discuz! X2.5