数学建模社区-数学中国

标题: 神经网络在R语言 实现 [打印本页]
作者: haviet    时间: 2011-9-13 20:25
标题: 神经网络在R语言 实现
ti<-proc.time()
0 G; d4 ^& U# R% n9 [$ mBP_one_output<-function(input,output,m,fth,sth,w,v){
4 n0 ?2 {7 q7 N) M        x<-input;#7*8  _* e1 N, j+ ~/ s
        y<-output;#8*1，y为向量，每一元素为一个样本输出值1 e4 p, ?$ t; Z; O  Z5 ]/ F
        theta<-fth;#11*1. T! d- w  w( A7 |; }: i1 m$ {1 A
        gama<-sth;#标量
) X: F0 |: D7 F6 {# S( m        if(m!=length(theta)) print("阈值长度错误！")7 f8 ?& {) F! ]0 r* U) \& x$ p
        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重& c1 o- o- \- I6 \" q- m# @
        K<-nrow(x);#8一组样本的维数( l8 j9 O5 g; i7 B) Y. ^  A) }. q8 X
        J<-ncol(x);#8一共有多少组样本
# }* m$ r5 U# k  |1 t4 T        w<-rbind(w,t(theta));#由7*11变为8*11/ g( v( t$ N4 {/ ~2 R7 V. T
        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接: Z( Q- C% Z, x2 z& }
#定义函数f
7 r! ?9 I: i: S        f<-function(h) 1/(1+exp(-h));
" i: K7 d5 p5 Q        epsilon<-alpha<-0.5;
3 F$ }8 N- |: g2 {1 g1 x- x% v& S        N<-0;#重复学习次数的计数
8 q& Z; p3 H2 [( U! u( @0 d3 ]        ei<-as.numeric();#记录每次迭代的平均残差平方和- s8 m, I- c/ n4 i: {7 H
        FW<-1;
0 \) J& ~( I' M% J% f        while((FW/J)>=0.001){; k4 E- Y( q, [, r
                Z1<-t(w)%*%x;#11*8矩阵，每一列为一组样本) L# S/ l5 A' G9 Y
                Y1<-apply(Z1,c(1,2),f);#11*8矩阵，每一列为一组样本在隐含层的值, a matrix 1 indicates rows, % M# M4 E  |& u" ~% n( w5 c2 Q
                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns, D; Z- G# A$ y4 i: u8 e+ f- i
                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量，每个元素为隐含层对输出层的加权值
6 b: k5 H$ \* h+ ]- m, b                D<-f(Z2);#向量，每一元素为一组样本的一个输出值
; T) {, q2 M6 q3 i( S4 P8 `- p                b<-y-D;
/ ]; ]- ~8 ]' J! j3 c( A3 @. s! |                #J组样本的学习
7 K) u. o$ ~) g- f1 ]                #向量，输出层对隐含层的权值的偏导
0 c7 y8 a% T1 |4 v4 u: t                FW<-pFW2<-pFW2t_1<-0;
; }/ k( e* i" e* q, ]  k                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导( }; f/ R, v' y7 w
                for(t in 1:J){
! O# u2 R$ Z4 }9 p& H                        B3<-b[t];
' g$ n/ s1 s  u- ?                        FW<-FW+B3*B3;#标量
+ e+ |9 R! i( S  H/ m                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量5 |/ _! I2 R$ S" p4 [7 |
                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项, J: i: e8 f4 Z4 I9 ?
                        if(t==1) v<-v-0.5*epsilon*pFW2
5 {3 Q+ O# Z' Y( q( P. a                        else{
4 D2 I0 n- n& z; h& o: }1 ~                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);' J7 C4 q0 \$ B1 _
                                pFW2t_1<-pFW2;
& @/ F8 K1 p$ i4 d                        }
. z; X& R) r) |5 {9 K                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
8 s  M  g" V( n- h0 L                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
# e. \* L9 }6 _( c3 F9 O$ w: t- @' J: i                        if(t==1) w<-w-0.5*epsilon*pFW1, j! ~; B+ Q, J) H8 \
                        else{
' D- k; R) O- P                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);* m8 v' T8 n& h* m$ V  L, T
                                pFW1t_1<-pFW1;
, q5 }( q! K! r$ g7 @                        }
6 C+ M" }! g  E( z1 T                }: H/ E2 [, x3 I$ r4 p; Y
                N<-N+1;) g: x3 A( {! e8 _- ]: I
                ei[N]<-FW/J;
* f$ K0 N9 `& t9 b/ d  W        }+ }; `  v, y0 B/ Q* z6 m
        theta<-w[nrow(w),];#隐含层阈值
2 F! t/ P+ S* S; k! }8 L2 _: z# J        gama<-v[length(v)];#输出层阈值& o4 g1 e- A, `! a1 f# {& I% k3 K
        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
! S5 w! J3 y% |2 F& O        v<-v[1length(v)-1)];#隐含层对输出层的权重
+ l3 x* @$ e0 e  p; ^        list(theta,gama,w,v,N,FW/J,ei). w3 b9 M& d5 `* O
}
7 ?# ?( Z- x+ |8 E3 ^* p4 ax<-cbind(x1,x2,x3,x4,x5,x6,x7);6 a' c0 S! y% }$ j3 Y+ Z
x<-t(x);- ^# l/ Z& x( f8 Q
hidden_threshold<-runif(11);% ~* ?- M% U8 Y  M, a6 }( l
output_threshold<-runif(1);) g5 I) l" K! E4 B9 X2 y$ S
w<-matrix(runif(77),7,11);
. h# ~" ?% ^* s& z/ ?( tv<-runif(11);# a5 O  C4 v) X+ r* y
result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
; S5 S3 A; ^5 n- i( J#输出
4 ~8 G: _  y& i! l& @cat("\n");; |3 h5 H$ Z; U+ G
cat("隐含层阈值theta","\n",result[[1]],"\n");! L1 |9 m1 d' T7 s) b' q! n
cat("输出层阈值gama","\n",result[[2]],"\n");
3 T. o( Q' \- ^( ?* R) [) kw<-as.matrix(result[[3]],7,11);
* o0 J! a" H, G; X' Q% Ucat("输入层对隐含层的权重w","\n");
0 D( W% H+ ~) A0 s! C4 b  Pw;  B  y% Y: e5 y; X4 Y2 a8 _
cat("\n");
: q& O2 `) K( t' n, S, s8 a7 x. kcat("隐含层对输出层的权重v","\n",result[[4]],"\n");
7 b( G9 p% C+ E0 F$ z+ s, f! Rcat("迭代次数N" ,"\n",result[[5]],"\n");- y- |/ z: U( P+ E' c
cat("学习误差FW","\n",result[[6]],"\n");
1 w' t2 t; B- G) h' a( Gcat("每次迭代的误差","\n");
# v$ R- w3 P0 v  W+ Tplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
; @/ A" a8 v( \proc.time()-ti
. d3 H6 ~! s/ P" {
作者: 廷植斌_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