QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18434|回复: 5
打印 上一主题 下一主题

神经网络在R语言 实现

[复制链接]
字体大小: 正常 放大
haviet        

2

主题

4

听众

60

积分

升级  57.89%

  • TA的每日心情
    开心
    2014-6-23 23:18
  • 签到天数: 6 天

    [LV.2]偶尔看看I

    跳转到指定楼层
    1#
    发表于 2011-9-13 20:25 |只看该作者 |倒序浏览
    |招呼Ta 关注Ta
    ti<-proc.time()
    7 Y1 z4 `: b* A5 s7 OBP_one_output<-function(input,output,m,fth,sth,w,v){
    $ V! A5 M  a: @0 A3 h5 P% Z! R        x<-input;#7*8
      u+ n" O9 d7 o* ^3 u9 ]( h        y<-output;#8*1,y为向量,每一元素为一个样本输出值
    ) M/ \, k% D0 B$ D$ T( r        theta<-fth;#11*14 P1 N2 u2 V% S2 k
            gama<-sth;#标量4 F4 `; U* \# ?. ]. Q1 g
            if(m!=length(theta)) print("阈值长度错误!")0 K! K$ N# L$ l2 j( x
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重4 g1 j  r  y$ f" ~$ y* b: T
            K<-nrow(x);#8一组样本的维数" `  t' _4 R7 l! l$ _- f) ?& K& V
            J<-ncol(x);#8一共有多少组样本
    / |" n- L  T; k3 {        w<-rbind(w,t(theta));#由7*11变为8*11
    " }: ~  E2 ^! A/ _        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    % h+ c5 E# \9 }- M$ L( M( U" b- R. O#定义函数f
    5 W, W" d  P% R* J4 V8 V        f<-function(h) 1/(1+exp(-h));( i+ G) P) x( R9 \! G# L
            epsilon<-alpha<-0.5;
    6 V% L$ R: M5 c& k& B& N1 `        N<-0;#重复学习次数的计数% Z' K6 m# A( S, X
            ei<-as.numeric();#记录每次迭代的平均残差平方和6 S) X! C' q( A7 c1 @5 a7 x) K
            FW<-1;
    1 c2 W2 A$ u$ w4 x- n6 ?        while((FW/J)>=0.001){
    4 \' B  A6 r  z; s                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    , _8 L0 {* b& j( k                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, * u# q6 X1 O8 `- q1 w6 }) F1 o
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns1 e9 S- O4 Z6 P! t- ]
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    " y* Y" U  C# K9 G. p9 m                D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    3 r, _; \% G; @                b<-y-D;+ V3 a& s- H: u9 E: }
                    #J组样本的学习
    8 M" N# Q1 y0 r, r                #向量,输出层对隐含层的权值的偏导
      q, l; j& o( g5 y                FW<-pFW2<-pFW2t_1<-0;. p" I5 G: Q5 b/ P1 i% K7 _4 W
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    7 B0 c! u8 j; S- p9 G                for(t in 1:J){
    1 [/ p( D6 |) l( Q( A+ `& K1 v* l                        B3<-b[t];( `$ f3 {  k7 g. x
                            FW<-FW+B3*B3;#标量, [3 P, s5 f) l3 \9 i) X/ E
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    0 n! I5 D  s- t2 z7 Z; I                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    & J+ @. b' |; V& m7 m                        if(t==1) v<-v-0.5*epsilon*pFW2
    ' F" B/ u+ q* s4 ]) n3 g                        else{' ~" ?3 Y5 C5 t+ Z
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);: {# m+ n5 N) |# O9 J
                                    pFW2t_1<-pFW2;
    ; G! }/ I9 s7 n: t! w7 w                        }
    ' u8 O7 s2 g. b5 L  L                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连) O. n; h) z" p/ I$ T
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导+ V6 y$ k4 O6 x5 A9 r
                            if(t==1) w<-w-0.5*epsilon*pFW12 C4 E3 _$ c* h# g% [: H4 ]
                            else{
    8 y* Z* U3 M3 _( l) f+ }                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);0 z( k% J9 `( [1 W  E- l
                                    pFW1t_1<-pFW1;
    ' |7 ~' s4 a& s! a5 T- H                        }" e8 E& |8 s  V# q+ j3 p
                    }
    7 {: W, t2 S/ q5 w8 P! i) e                N<-N+1;
    + Z& N/ F: d5 E9 t4 ?                ei[N]<-FW/J;
    ; _1 J4 T% N" |2 }        }
    ( Y, q4 q& N. n" @6 y8 t        theta<-w[nrow(w),];#隐含层阈值
    $ E. Q. o! \( s# V        gama<-v[length(v)];#输出层阈值$ l( B$ m& a4 {+ L7 d2 p7 c
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重
    - M- J0 g+ a* n6 i        v<-v[1length(v)-1)];#隐含层对输出层的权重" c) Y- Q5 Q1 I% h* Z
            list(theta,gama,w,v,N,FW/J,ei): W. U0 Q. r# F* ^
    }7 ]4 j8 W2 H: B2 O1 ]. v  Q
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);
    7 O/ N. U5 J. q0 R7 ~3 l; sx<-t(x);
    2 n" E+ g2 q) @- U/ khidden_threshold<-runif(11);6 w% g6 c" [8 d& M$ k
    output_threshold<-runif(1);* G9 h5 v7 @! W
    w<-matrix(runif(77),7,11);
    ! ]7 V8 r6 G/ v; uv<-runif(11);1 j" S- H* b+ W; q
    result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    & G* b' K3 p. {; y# g% A& R) r#输出5 p  ]& k- p) s* i
    cat("\n");3 G8 s* \) X2 J
    cat("隐含层阈值theta","\n",result[[1]],"\n");' W2 N2 ^9 r" R: H, X  l2 [
    cat("输出层阈值gama","\n",result[[2]],"\n");
    5 n7 q0 Z' B9 |2 Ew<-as.matrix(result[[3]],7,11);
    # {, w0 h& z. k: _+ ^cat("输入层对隐含层的权重w","\n");
    4 e6 V+ O: X$ m5 Gw;
    + J2 n- ?9 t+ P6 Rcat("\n");! C" F) k8 w9 g' w# J! Z$ p0 p
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    * k7 I0 T& j9 o8 c. `; C. L( K4 Jcat("迭代次数N" ,"\n",result[[5]],"\n");% j% }  @% r* k# t1 H$ h7 ?0 H
    cat("学习误差FW","\n",result[[6]],"\n");" p' H, w. ?- p8 T) {
    cat("每次迭代的误差","\n");, a8 n( i0 N$ w4 t
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");! T' p8 u+ H& ~- X  J% T0 I5 X
    proc.time()-ti2 g+ M2 C- x  j2 g5 U$ L
    zan
    转播转播0 分享淘帖0 分享分享0 收藏收藏0 支持支持0 反对反对0 微信微信

    0

    主题

    4

    听众

    50

    积分

    升级  47.37%

    该用户从未签到

    回复

    使用道具 举报

    Esmtih        

    0

    主题

    4

    听众

    9

    积分

    升级  4.21%

  • TA的每日心情
    难过
    2011-11-8 08:33
  • 签到天数: 1 天

    [LV.1]初来乍到

    回复

    使用道具 举报

    黄窗帘        

    0

    主题

    4

    听众

    28

    积分

    升级  24.21%

    该用户从未签到

    回复

    使用道具 举报

    凌chers        

    0

    主题

    4

    听众

    34

    积分

    升级  30.53%

  • TA的每日心情

    2012-8-30 18:07
  • 签到天数: 10 天

    [LV.3]偶尔看看II

    群组学术交流A

    回复

    使用道具 举报

    2

    主题

    9

    听众

    52

    积分

    升级  49.47%

  • TA的每日心情
    开心
    2016-6-22 08:37
  • 签到天数: 14 天

    [LV.3]偶尔看看II

    自我介绍
    多次国赛获奖,研究生数学建模获得国家奖

    社区QQ达人

    回复

    使用道具 举报

    您需要登录后才可以回帖 登录 | 注册地址

    qq
    收缩
    • 电话咨询

    • 04714969085
    fastpost

    关于我们| 联系我们| 诚征英才| 对外合作| 产品服务| QQ

    手机版|Archiver| |繁體中文 手机客户端  

    蒙公网安备 15010502000194号

    Powered by Discuz! X2.5   © 2001-2013 数学建模网-数学中国 ( 蒙ICP备14002410号-3 蒙BBS备-0002号 )     论坛法律顾问:王兆丰

    GMT+8, 2025-7-21 05:29 , Processed in 0.698930 second(s), 79 queries .

    回顶部