QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18853|回复: 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()
    * _  ^$ F. W- E% ~) sBP_one_output<-function(input,output,m,fth,sth,w,v){; O; @5 ^# F4 h$ C( i7 M- w
            x<-input;#7*8) @$ o4 R5 N8 H) b0 P- @+ J
            y<-output;#8*1,y为向量,每一元素为一个样本输出值
    ' P# Y& T1 N1 a4 j        theta<-fth;#11*15 b2 I$ B+ ?" ^5 J- E; I6 Y. Y
            gama<-sth;#标量
    6 F7 L7 O# F1 {/ S        if(m!=length(theta)) print("阈值长度错误!"). D+ r& _9 D6 A6 d, `
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    8 g6 `1 B1 V4 E        K<-nrow(x);#8一组样本的维数0 w: v& E  Q* O
            J<-ncol(x);#8一共有多少组样本7 S5 w: J* w: q1 Y0 G) n6 ?: R
            w<-rbind(w,t(theta));#由7*11变为8*113 }: v' M% p* o7 W3 Y7 S
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接9 \6 j7 E/ A0 n! u- Z) }
    #定义函数f8 n7 ^: l1 n" n! x
            f<-function(h) 1/(1+exp(-h));
    1 w4 Y/ G1 b# S& y        epsilon<-alpha<-0.5;
    0 K* d4 r2 W# |& {4 u0 G4 Y        N<-0;#重复学习次数的计数
    1 o3 B. M9 D4 I( _8 ?% R/ C        ei<-as.numeric();#记录每次迭代的平均残差平方和
      a( N. H; l( `1 D# B' p        FW<-1;
    - f; E+ b* {" s7 Z, M6 X% V        while((FW/J)>=0.001){
    & |; o1 E$ }5 w                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本/ Z% {4 _/ F& J" S- P/ N/ H) x  I% V
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows,   n4 b# ^5 X1 L9 h
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns' d+ Y) n6 E$ U
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    - D5 u2 d$ u" `+ e9 c                D<-f(Z2);#向量,每一元素为一组样本的一个输出值, p  A% v5 C# ?6 q! ~
                    b<-y-D;
    & t- f( A4 T2 {  _1 W) [                #J组样本的学习
    1 @4 f2 Q/ n3 z                #向量,输出层对隐含层的权值的偏导
    1 j9 x+ G" b8 x% o                FW<-pFW2<-pFW2t_1<-0;
    : P/ b6 H( C! X2 X& Q' A                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导- k% ~7 V- Q! {7 g% ~/ K4 G; X
                    for(t in 1:J){, j/ S2 D/ e% M. i! K4 h
                            B3<-b[t];: v/ v: ]: I4 e( T4 N9 Z
                            FW<-FW+B3*B3;#标量
    7 S$ Y" y0 A. ?- ]/ M% ~! U                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    9 Z; ?- S) u3 @' p' i                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    4 ~" i9 t* Q8 T" t0 p; t: D0 n2 b: l                        if(t==1) v<-v-0.5*epsilon*pFW2
    0 t4 K4 |& Q/ ~6 w" Z                        else{
    7 x- `) @2 @# h5 D% f6 d/ K2 l: o                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);  H7 O; {6 ]7 Y- i0 i8 \& T/ e
                                    pFW2t_1<-pFW2;+ v6 f, v1 r2 h5 Z
                            }- L  V, o9 }7 P
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连& a9 I' S- ~9 T7 D+ I
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    " e0 r" w6 V2 r. }) H                        if(t==1) w<-w-0.5*epsilon*pFW1
      A3 x* q% \0 I                        else{% ^0 O$ b$ T( o9 [9 m
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    : ?  k, T) C# S% x- u% I# T                                pFW1t_1<-pFW1;
    " a: z& J/ `# R* j                        }
    + [8 }& H& m0 F& f                }3 j% |" W# R3 e0 i1 u3 h( C
                    N<-N+1;
      h0 L& M$ X' }; z" A: }                ei[N]<-FW/J;
    + f2 t/ g7 ]0 B* A& X! F' `        }
    $ F$ h  z5 P( _3 V" O% k+ s6 k. w6 R        theta<-w[nrow(w),];#隐含层阈值4 L# |) Z! b! I. h% X8 ~3 l* O
            gama<-v[length(v)];#输出层阈值
    5 J2 u$ \) n+ x2 l& j4 h        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
    # R9 C4 L# ^9 g- ?( q% W/ }        v<-v[1length(v)-1)];#隐含层对输出层的权重" K& B1 d. h; o  g" K) \2 Z
            list(theta,gama,w,v,N,FW/J,ei)
    : G4 G3 X, M/ j% @6 v' ?' X}" r8 T" W5 O/ U9 n5 H+ _5 V
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);. E- W" f/ M( m( i) I
    x<-t(x);$ d) I5 E/ R1 p  P" H( Q
    hidden_threshold<-runif(11);( g, t# x  G% P6 o# {
    output_threshold<-runif(1);$ n  F( s6 w' u
    w<-matrix(runif(77),7,11);
    6 c0 y3 o: L7 c+ A0 t1 w; e2 Lv<-runif(11);
    1 [; `3 J/ [7 F8 R+ Z) R+ Uresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);0 F# W  Q1 \  H6 s
    #输出# s8 T; H( c  J  ~8 }1 w( b- v4 H
    cat("\n");  j' ]- a- o1 \- i- d
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    % ]5 D6 Q3 Y( fcat("输出层阈值gama","\n",result[[2]],"\n");* ]9 G* p5 O1 Q9 s. z- I; a, Y! ]8 a
    w<-as.matrix(result[[3]],7,11);
    2 j$ e  A1 A( p! [8 a7 O- vcat("输入层对隐含层的权重w","\n");
    7 {1 _. y/ f8 Xw;
    - _0 m& g* _, {cat("\n");/ H. x9 x7 I7 k2 i8 Y
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");4 v% O3 P+ M9 F" ~0 e, B
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    3 _! `: b9 L8 X, c3 Y0 N) X1 }8 ^cat("学习误差FW","\n",result[[6]],"\n");0 H% q- o& i/ F0 a3 G0 ^
    cat("每次迭代的误差","\n");9 e* ?( _/ z2 A1 ?2 }
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    2 k+ f2 T! m. o# a3 d3 L: Wproc.time()-ti
    ) M) R5 `+ F% y0 A% S) F" B& ]7 s
    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, 2026-7-22 11:40 , Processed in 0.565515 second(s), 80 queries .

    回顶部