QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18453|回复: 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(); D- R. y+ c% C$ r% V% I
    BP_one_output<-function(input,output,m,fth,sth,w,v){
    8 |5 e9 _( y8 U3 `1 M        x<-input;#7*8
    " N6 }7 t0 m7 I* n        y<-output;#8*1,y为向量,每一元素为一个样本输出值7 |. G7 V% V- L
            theta<-fth;#11*1
    5 t! |; ]9 q- h: K        gama<-sth;#标量
    ) Y( X1 v2 [2 o9 v# Q- R        if(m!=length(theta)) print("阈值长度错误!")
    # y& a. c3 ?3 K0 w% p4 ^" t        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
      Y& ?+ [9 h; M/ M3 ]( M2 _        K<-nrow(x);#8一组样本的维数
    & F9 p7 d8 ^  o7 N3 C& _9 [        J<-ncol(x);#8一共有多少组样本
    4 t$ t7 P) A! O* C2 g        w<-rbind(w,t(theta));#由7*11变为8*114 ^: B3 m+ s# N5 r0 d
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接1 q7 F" Y- l  i' ]
    #定义函数f2 j7 s$ a$ w4 O" s% y
            f<-function(h) 1/(1+exp(-h));1 Q6 [8 r+ X$ h0 _( e  c2 Z; z
            epsilon<-alpha<-0.5;
    6 D, g( c3 X$ n/ }        N<-0;#重复学习次数的计数
    5 V9 e$ Q, O- t; t, K$ D4 B        ei<-as.numeric();#记录每次迭代的平均残差平方和
    : a, ?$ ~2 H8 P# ~" d+ N9 |        FW<-1;
    , ]& {4 j5 i0 `  s/ Y/ s        while((FW/J)>=0.001){
    % y3 P. Q9 b4 H0 A7 z' n4 c                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本% M9 ?8 o0 G7 p  G
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, 2 y# v8 {& D4 e; {. `+ B) Z
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns
    3 |- U5 L6 Y% E+ S. B4 Q                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值7 `) Q3 h# A& z! S% G& L% @  r
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    1 E9 P- D7 @2 V% P& a                b<-y-D;# R% F: F5 l1 k$ L( t0 t5 g  {( M
                    #J组样本的学习/ \6 ?# ?- M( K  u& w! Z- W4 t
                    #向量,输出层对隐含层的权值的偏导
    & H* |7 b; v- ~/ o/ D  Q' F( p                FW<-pFW2<-pFW2t_1<-0;: e* t/ |# O$ V# w# y
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导& Z5 J/ }& u/ {
                    for(t in 1:J){  }: B6 D+ `: j- B
                            B3<-b[t];
    ) X8 P2 |- w- D9 ~- u9 G) _6 q                        FW<-FW+B3*B3;#标量
    ) M5 B1 @4 |; C  O; f7 ?                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量( J% B5 c# ]' l( T1 |6 n$ N
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项6 X7 [0 T6 i" i- c( m
                            if(t==1) v<-v-0.5*epsilon*pFW2
    1 t# J  m( D8 G& z                        else{
    2 j' m% T, l; h" k3 F/ p                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    9 S& `$ d+ e6 T5 \: y* z                                pFW2t_1<-pFW2;
    2 s# ^3 G% ]% V- Y8 {* b! `+ A                        }  ]+ w! |+ S# m
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连. u! H' f# U1 }
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    ; c. F$ m' i0 ~; |$ ~  c6 F) K: i; i                        if(t==1) w<-w-0.5*epsilon*pFW1
    ( i; U8 s- V1 U7 b& \                        else{
    5 h# g5 z* w0 Y* M, G: @% L                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);' P" C% A$ C0 i- s' A8 l( d- a
                                    pFW1t_1<-pFW1;, F4 `. B7 Y( D- t# U& K, h" M; A4 {
                            }' _) h& e6 m1 ]
                    }7 H0 {* K# }8 M- `( |& v2 B( R
                    N<-N+1;
    , {" [( c2 v5 z9 j! S/ {                ei[N]<-FW/J;
    - E; d" P, Q6 D( T' K        }  |/ ]0 f  i2 Y' o& B8 _
            theta<-w[nrow(w),];#隐含层阈值
    0 L: `8 ]3 P( h5 |' a        gama<-v[length(v)];#输出层阈值
    ) h9 {% ]2 G+ {; l2 w% j        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
    6 t# ?7 G* M8 B7 J& Z        v<-v[1length(v)-1)];#隐含层对输出层的权重
    8 S7 o' z* Z% ~, D  m( K        list(theta,gama,w,v,N,FW/J,ei)+ _# C* ^  o% I* e1 j  w4 R
    }
    / Y! r; K5 l. p( m2 Cx<-cbind(x1,x2,x3,x4,x5,x6,x7);
      ]5 B2 d0 `( [! [2 o- Zx<-t(x);
    1 e; @& |$ p9 W6 @hidden_threshold<-runif(11);
    % m! x0 y1 a8 U0 toutput_threshold<-runif(1);& r$ Y3 |# u. G- S& {/ j
    w<-matrix(runif(77),7,11);0 Y* T( z' r8 v( g/ Q# y2 \5 l
    v<-runif(11);
    - D3 b* V+ s7 p! |/ m1 l" l5 Oresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);  d8 G; `' O3 x6 O; r. d7 Q3 C
    #输出0 \. }0 d, T% ]$ C9 c( W9 A
    cat("\n");3 f6 B& P6 _! Z' \/ R, S$ _6 N4 a
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    ' w! @) v( b2 E! Gcat("输出层阈值gama","\n",result[[2]],"\n");
    - t$ z; k" M3 U* iw<-as.matrix(result[[3]],7,11);: O; E4 T7 G+ R: z2 [) k) ?
    cat("输入层对隐含层的权重w","\n");
    1 x+ s) r5 k3 s4 D# }' g% {9 fw;
    5 ]5 k* b7 i$ }cat("\n");
    9 [8 e- A. [; \0 L3 l% jcat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    1 v2 g8 [6 d7 v: _cat("迭代次数N" ,"\n",result[[5]],"\n");" ~5 r* L0 M6 {( D% j1 B6 b
    cat("学习误差FW","\n",result[[6]],"\n");
    ( D5 S- v9 ^2 _, Qcat("每次迭代的误差","\n");) S3 r! z7 R# B5 L. ^! D
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    0 q, k( ^7 i& G( j8 B; Q4 C* Kproc.time()-ti
    9 Q; ?' I8 Q" X; a( 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-27 08:03 , Processed in 1.142286 second(s), 80 queries .

    回顶部