QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18883|回复: 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()5 G4 |1 \/ y5 {0 K* [' p
    BP_one_output<-function(input,output,m,fth,sth,w,v){% e6 O) j; V# E
            x<-input;#7*8  a' W9 s* g/ X
            y<-output;#8*1,y为向量,每一元素为一个样本输出值
    / Y7 c3 [6 N0 }/ b8 f        theta<-fth;#11*1
    4 `& p8 s$ {0 e7 }0 |' Q        gama<-sth;#标量
    9 L, R1 z$ {( {        if(m!=length(theta)) print("阈值长度错误!")2 R' I0 I5 r9 B) |; d' y3 T7 z
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    % V4 u0 ]) _5 a- {+ L' ?( M        K<-nrow(x);#8一组样本的维数3 h. B& C( s0 a  D6 v
            J<-ncol(x);#8一共有多少组样本* V- u# q2 J6 J1 D) l
            w<-rbind(w,t(theta));#由7*11变为8*115 |9 ~8 K! s3 j' A
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    " f' C# U6 }7 P2 i( {( ?0 Z#定义函数f' e, {* k1 q2 M& b+ x0 h+ H' b
            f<-function(h) 1/(1+exp(-h));
    . L: q6 e7 O4 q0 @2 f0 p        epsilon<-alpha<-0.5;4 W+ k7 g& c, T& n
            N<-0;#重复学习次数的计数
    ) B& y2 c4 p; A8 G9 V8 `  H* B4 H        ei<-as.numeric();#记录每次迭代的平均残差平方和
    0 F% H' N2 Q+ n# M2 n6 C        FW<-1;
    8 h% h  Y9 Z/ T6 a7 I7 r        while((FW/J)>=0.001){$ @& W: I, Z' W% J' R; g1 K
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本7 \& D3 Z6 `% H* }# _
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, 1 G5 p- `$ b, \/ v  p
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns
    5 ~* L& j* l$ i/ c$ |3 o                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    3 E: O3 P# V" _1 q2 q3 t                D<-f(Z2);#向量,每一元素为一组样本的一个输出值( `5 u4 ?, A0 G! ?# z7 M) f. P
                    b<-y-D;
    6 s1 ]3 t6 B6 }8 a* ]  `                #J组样本的学习. v9 ?0 J  L: x- ?* R
                    #向量,输出层对隐含层的权值的偏导
    : h# a8 ^6 O1 M' u4 _1 f                FW<-pFW2<-pFW2t_1<-0;
    4 j$ i" k' n: R  M+ ?$ K                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    4 A' x6 Y* A, M, }4 Z  s/ ~- G& |                for(t in 1:J){  h5 T+ C- x0 q. v4 ]
                            B3<-b[t];
    8 ?( A' ^+ q; L/ p( z5 n9 |; s                        FW<-FW+B3*B3;#标量& |$ R0 c; G# F
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量' Y9 C/ B; N9 W1 D# D4 v% v) L
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    : B: Z# }$ k* o1 M* }                        if(t==1) v<-v-0.5*epsilon*pFW2
    8 D, d- K, n& V' q! C# [" Y                        else{) t2 }, o8 K: X/ T2 Z4 _
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);" {) |, r1 c( ^+ H9 n. `  A
                                    pFW2t_1<-pFW2;# N5 h% N* S  o2 r! d, F; {9 M: J
                            }
    * ^( U8 {- e( w5 B- Q                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    1 F; l% R: A8 R, `                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导9 h) F/ `' V2 N6 b1 |. p' I
                            if(t==1) w<-w-0.5*epsilon*pFW1
    ! q0 K0 t) Z" D" ^# C+ O& y                        else{
    $ k7 V' F- K5 S0 \" d% h9 m0 W2 e3 ^                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    ) ~0 [1 B0 q( @; H/ f) |                                pFW1t_1<-pFW1;
    0 T' R  d1 x& i! @8 {                        }
    $ e- t. |# W' p( d                }$ Y' b8 P+ g+ F  w( D( Q7 Y
                    N<-N+1;2 W* ]( C$ ]8 J% a1 X- h9 l% h
                    ei[N]<-FW/J;' _* D: ^% f, _# a' e5 b  J
            }
    & U4 e% x# \# j  t5 B        theta<-w[nrow(w),];#隐含层阈值
    , N, e  r, t1 E; f$ g+ K* n7 A        gama<-v[length(v)];#输出层阈值
    - o( N8 f: o. k3 F        w<-w[1nrow(w)-1),];#输入层对隐含层的权重) s$ \- N1 ]( B
            v<-v[1length(v)-1)];#隐含层对输出层的权重7 v7 c9 D5 @3 p$ ~. g
            list(theta,gama,w,v,N,FW/J,ei)
    ! a; X+ O4 ]: S  L6 }}8 C5 y$ J7 ^5 _* S3 i6 x: w
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);$ G5 Q# [2 ~+ S) _) R
    x<-t(x);  e- V* d& D4 J6 E( \- V( A. d5 y
    hidden_threshold<-runif(11);
    # H: y. y5 ]7 c1 D; woutput_threshold<-runif(1);
    $ n+ T/ ?! y/ }% B' H+ B& I% D# Nw<-matrix(runif(77),7,11);
    ( ~; U) k8 `" c3 X- Av<-runif(11);
    % `2 c0 a9 @( _+ fresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);8 Q+ q) d  v0 Q, p! n
    #输出7 N+ c. k/ T( `5 k% v
    cat("\n");
    3 D/ e/ M5 C* p% o! lcat("隐含层阈值theta","\n",result[[1]],"\n");
    % u8 _* s3 {5 x5 w/ q0 _cat("输出层阈值gama","\n",result[[2]],"\n");# ?  T. p; D1 i/ y$ G: Q
    w<-as.matrix(result[[3]],7,11);% V( }- c) {( |- R* b3 H- K7 V1 S
    cat("输入层对隐含层的权重w","\n");; n  ^' {3 z0 e# p: _! F6 E
    w;
    - s1 N. f6 ^. I( e$ O* ~cat("\n");. s4 i. K! _+ |' C
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");( l  o$ L- V: U; w
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    ; R1 M* {2 ?1 K0 n- _  M, Gcat("学习误差FW","\n",result[[6]],"\n");
    , `: h0 d4 W0 _% Bcat("每次迭代的误差","\n");" |3 s8 m# W( N+ P
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    9 }# a  ~; I+ ?3 H) Eproc.time()-ti4 _  g4 R$ _" N
    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-8-26 18:23 , Processed in 0.409320 second(s), 81 queries .

    回顶部