QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18761|回复: 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(), c5 }: n% D7 Q" j' F2 M2 A
    BP_one_output<-function(input,output,m,fth,sth,w,v){
    : I2 Q7 i* l7 {% [$ s2 a+ u! g        x<-input;#7*8
    * |: J7 W" r9 @( I        y<-output;#8*1,y为向量,每一元素为一个样本输出值4 g5 d" B7 [! g2 u) l+ Q- G/ l" C+ {( ?
            theta<-fth;#11*1
    8 W# |: {& G- ^# [- O: a1 M        gama<-sth;#标量
    " J" O0 e  p% O' r; ^7 ^& j        if(m!=length(theta)) print("阈值长度错误!")
    6 J- E" V( [, Q& E) \        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重* Y- V4 |3 C3 e+ ]
            K<-nrow(x);#8一组样本的维数
    " Q# V$ |$ I! s1 U        J<-ncol(x);#8一共有多少组样本+ X- F* e7 R8 H+ k
            w<-rbind(w,t(theta));#由7*11变为8*11
    0 o* u0 Q. ~! ~( P; M' U" U        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接7 @6 t( M0 A/ @1 w5 v0 a2 b4 v
    #定义函数f7 V9 X# f( x$ O2 f7 W* U% N
            f<-function(h) 1/(1+exp(-h));) a! G. W# i+ i8 F' Z
            epsilon<-alpha<-0.5;
    ' G* M+ i3 L) R5 Y- V' {* |) C        N<-0;#重复学习次数的计数
    8 w& K- z) u; j+ `        ei<-as.numeric();#记录每次迭代的平均残差平方和- W0 h4 p9 d4 V' P
            FW<-1;7 M& L! ~+ c( o. ]& X
            while((FW/J)>=0.001){6 |: k9 R2 L9 _
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    4 M0 a7 f* i& M9 B6 e                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, " o7 M! W2 R3 K. ]
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns- d8 x3 h1 _& d! b: g
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值4 M1 \+ d6 l/ \9 W* \2 j
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值7 P& l; _2 E8 b* _: T: d( ^) b; b
                    b<-y-D;0 @) m' h* ~) t9 e- _" x9 f) }
                    #J组样本的学习  X& ~: b$ _1 y' D: n' I
                    #向量,输出层对隐含层的权值的偏导; f7 w- r. A( @; p
                    FW<-pFW2<-pFW2t_1<-0;
    0 k: j' [; c$ t! Z* u9 F, d                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
      E6 L9 B- h! I* \% @0 A                for(t in 1:J){
    " ?4 i3 |, l  X5 m7 h                        B3<-b[t];
    - m  ~8 L; C' J                        FW<-FW+B3*B3;#标量
      z. v2 G8 G# w; f( w( f. d2 C                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量: I9 [& c7 i9 Y# h4 k
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    % \7 |% ?- d+ ^" [) Z- g                        if(t==1) v<-v-0.5*epsilon*pFW28 W/ Z, f9 l% `8 _
                            else{" a% r0 P5 P9 I3 T
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    ' ?/ l: q  ^. K4 L                                pFW2t_1<-pFW2;
    % Y5 J" C9 u" W                        }. [" {3 H$ w8 h+ x6 V5 s( ?5 q
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连* q% p" X4 h% D- ?/ q  ]& s
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导: Q" G/ D2 A5 p7 q: m/ ^
                            if(t==1) w<-w-0.5*epsilon*pFW1+ i( f; f& G, d) q0 H4 @
                            else{0 h+ A  k" L; o8 K+ ]
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);+ ?5 t. N2 C2 b: U7 c( J* i' i
                                    pFW1t_1<-pFW1;7 o" e7 h4 l3 r. D" l2 o
                            }
    3 H' j" ?* m) e7 I, ]; T% B                }$ ~9 F$ F0 t- z. `. @
                    N<-N+1;
    ! H( _- }' j5 V' S2 `4 e                ei[N]<-FW/J;& L1 M9 e5 ^4 |
            }* g8 x. _' G4 V+ M  r
            theta<-w[nrow(w),];#隐含层阈值3 }" a# }9 n1 ?/ ^) L1 T/ N
            gama<-v[length(v)];#输出层阈值" E0 p8 j2 ~; O) [1 G0 D
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重$ P) l5 C' ~2 p$ a
            v<-v[1length(v)-1)];#隐含层对输出层的权重
    + S9 f* ?1 t8 Y        list(theta,gama,w,v,N,FW/J,ei)8 X2 L7 n4 O$ e# f
    }1 I5 [' F; J  ]0 {1 N
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);/ M% ?5 z4 i" l7 N+ Y& q/ f- j: h
    x<-t(x);- ^# G. G8 O7 K; [/ L
    hidden_threshold<-runif(11);
    9 K( |- r6 \: k% N4 S) m0 \output_threshold<-runif(1);# c/ u6 G& Q! Z. m7 K
    w<-matrix(runif(77),7,11);
    & ?2 L8 R! Q7 s5 h7 x) Z. v& lv<-runif(11);
      ]. |6 D- L$ |# Z: ^7 Uresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    3 A, n0 x, C  o0 o4 v+ h( z* Z#输出
    ' B* e5 }# {. E" Xcat("\n");( Z; j& N' ?9 F9 \0 N
    cat("隐含层阈值theta","\n",result[[1]],"\n");# G: q- j8 d5 c; V. I
    cat("输出层阈值gama","\n",result[[2]],"\n");
    7 ?+ T' [: S- [4 r. Gw<-as.matrix(result[[3]],7,11);3 E1 z1 \# ]. f3 p' q
    cat("输入层对隐含层的权重w","\n");! E* ~$ E' A) |. }% Q+ ?( j
    w;
    ' K; Y9 |9 e& Xcat("\n");
    5 |2 z* M1 ~" Ocat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    , D, z" N: c4 C/ }cat("迭代次数N" ,"\n",result[[5]],"\n");( g  D, F  c) \  G0 ?8 Z
    cat("学习误差FW","\n",result[[6]],"\n");
    7 Z% {( t. H5 O, L% A- j+ ]cat("每次迭代的误差","\n");6 _$ a# S6 i/ {0 x
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    8 S7 P+ [- z2 `+ L1 r6 Pproc.time()-ti% g! i% ?1 @/ e) p
    zan
    转播转播0 分享淘帖0 分享分享0 收藏收藏0 支持支持0 反对反对0 微信微信

    2

    主题

    9

    听众

    52

    积分

    升级  49.47%

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

    [LV.3]偶尔看看II

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

    社区QQ达人

    回复

    使用道具 举报

    凌chers        

    0

    主题

    4

    听众

    34

    积分

    升级  30.53%

  • TA的每日心情

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

    [LV.3]偶尔看看II

    群组学术交流A

    回复

    使用道具 举报

    黄窗帘        

    0

    主题

    4

    听众

    28

    积分

    升级  24.21%

    该用户从未签到

    回复

    使用道具 举报

    Esmtih        

    0

    主题

    4

    听众

    9

    积分

    升级  4.21%

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

    [LV.1]初来乍到

    回复

    使用道具 举报

    0

    主题

    4

    听众

    50

    积分

    升级  47.37%

    该用户从未签到

    回复

    使用道具 举报

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

    qq
    收缩
    • 电话咨询

    • 04714969085
    fastpost

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

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

    蒙公网安备 15010502000194号

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

    GMT+8, 2026-4-14 00:20 , Processed in 0.449563 second(s), 80 queries .

    回顶部