QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18793|回复: 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()
    $ Q. G2 _) [- D! A) J5 jBP_one_output<-function(input,output,m,fth,sth,w,v){
    , A) _. W7 v$ V  q+ U        x<-input;#7*86 k1 o$ C  w$ Z: s% Y0 K
            y<-output;#8*1,y为向量,每一元素为一个样本输出值- U* I0 r" u* d  i" D
            theta<-fth;#11*1
    , ?. H8 `! M- e. u7 e5 I" B0 c% L        gama<-sth;#标量
    & E) A9 e1 [0 h+ @: Q% ?        if(m!=length(theta)) print("阈值长度错误!")
    . D' W- o. m! e- `        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重. E# \0 T& [+ Q2 K. k
            K<-nrow(x);#8一组样本的维数
    8 \: F/ [& [" c- R) C( L        J<-ncol(x);#8一共有多少组样本: ~2 j- h' a( z8 u2 z, M7 J% Y' |0 f1 Q
            w<-rbind(w,t(theta));#由7*11变为8*11. L6 i, R. K4 D" r4 I# k4 R6 d
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    8 Q' w. Y, D& e#定义函数f3 T+ G/ ]' Q  u8 C1 i( A
            f<-function(h) 1/(1+exp(-h));, g. D5 E5 S' S1 X% @$ G& M: ~
            epsilon<-alpha<-0.5;
    3 }. ^+ W/ K% O8 a, m        N<-0;#重复学习次数的计数
    / @; d* |7 J+ u, z8 d& U8 a        ei<-as.numeric();#记录每次迭代的平均残差平方和2 u0 |/ m4 [6 R- h$ _5 m9 q
            FW<-1;
    * U8 G% ^$ U+ Q3 O1 b; m1 z; d/ w3 ~        while((FW/J)>=0.001){# |# s7 z% B% e# q- k- x
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    5 w, l( Y0 u' h. R2 P4 U+ Y( Z                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, 7 n3 }: d1 \6 X" g
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns+ y- L  g6 c2 M" ~* X
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值. \/ u. r% c+ [$ j$ q& ?
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    . |! |1 {0 [1 n6 M' |                b<-y-D;
    $ e* |8 @: B' I. {& g! A                #J组样本的学习
    - v- G( \9 ]- E: V' [                #向量,输出层对隐含层的权值的偏导
    $ o2 i1 b+ q. ^; S* E( Z                FW<-pFW2<-pFW2t_1<-0;
    , F: ?: e4 f( V5 a+ f                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导6 z5 v: s  L; f3 I) `$ @  \
                    for(t in 1:J){
    ) X: S; f0 J4 w4 L! ?                        B3<-b[t];
    ; Q$ U9 q8 p( V4 z7 ~0 z* O                        FW<-FW+B3*B3;#标量
    0 c( v9 ?, @$ d( R% J& \- x- f                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    + Z6 V4 }% a+ l2 ]+ y- t" N7 ^" Q                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    8 _, L& @- K3 f- |7 u5 u! l; N4 @                        if(t==1) v<-v-0.5*epsilon*pFW2
    2 f' c3 k- Q5 q% p" S; x                        else{% o7 Y' M4 G3 c0 O7 y" H1 ^
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);) y1 x! U* ^- v- Z7 D6 Z5 p1 l, a6 Y" D% b
                                    pFW2t_1<-pFW2;# ?: O$ n' y) U
                            }" P/ M2 F8 E& _
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    / T2 O+ i7 v& w2 T4 p4 y                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导6 [1 C: x# C6 n3 R
                            if(t==1) w<-w-0.5*epsilon*pFW1
    ( [0 r; s2 J4 ]; b- }                        else{
    1 o. H8 ?% S+ _; o# i6 i                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    & D  l! m+ m2 {9 b                                pFW1t_1<-pFW1;
    ! ^% P& [5 O% F                        }) g- B. f8 j5 _7 C  h$ V6 O
                    }
    : t9 t$ m+ V2 V4 f. L                N<-N+1;
    # y" s4 |; }2 b9 l0 x% x                ei[N]<-FW/J;
    ; ^2 V: p1 t: `; D( \. d        }6 O5 j6 n$ {9 \+ h" b$ K6 H
            theta<-w[nrow(w),];#隐含层阈值/ T8 _/ l" {5 t3 m) c& G) K
            gama<-v[length(v)];#输出层阈值) d7 q' Z* d$ W2 \
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重5 p0 [$ t) V$ e4 S0 I( J7 `
            v<-v[1length(v)-1)];#隐含层对输出层的权重/ x: d% R2 _, D7 c6 R6 m( s3 x2 z
            list(theta,gama,w,v,N,FW/J,ei)
    $ }: D/ I3 Y( G0 @- U/ d}. ]- H8 R, ~/ ?5 s) ^1 X( H, a/ }
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);. N5 r- N% H+ M, C8 u7 q( q& ^" _% ?
    x<-t(x);
    5 C/ [7 L* M; o$ F( thidden_threshold<-runif(11);
    $ o6 A& ^" l$ N: A4 d- W/ G; {output_threshold<-runif(1);
    3 C% w+ U- {4 y  D& q) Qw<-matrix(runif(77),7,11);
    4 B4 n" h9 x8 Qv<-runif(11);
    * [& U& z& i! i# h$ o- t% yresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    5 k+ e3 p5 y4 B* B+ b: S& P6 z#输出3 V+ a2 U1 x% o) F4 m" o6 {
    cat("\n");* l: s* i; }' U5 E7 D1 A; ]! P
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    0 f& o& w# e/ J* {! B. A1 _cat("输出层阈值gama","\n",result[[2]],"\n");6 }& Z* f% p" n0 F: n
    w<-as.matrix(result[[3]],7,11);! h, ]/ a7 f& Z! m4 }& m1 f3 r
    cat("输入层对隐含层的权重w","\n");6 n* T! E4 Z( K9 n
    w;% L8 I" P$ k- Q8 f- M
    cat("\n");
    / [: u3 a/ a0 p' qcat("隐含层对输出层的权重v","\n",result[[4]],"\n");" Y  [, e- A3 Z4 @+ H
    cat("迭代次数N" ,"\n",result[[5]],"\n");
      |9 d9 ]5 j  q- f( g4 Ccat("学习误差FW","\n",result[[6]],"\n");
    8 M* d0 N  j* b7 a1 ~: Zcat("每次迭代的误差","\n");% ^, l+ K, L! g% n/ d2 O8 n
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    8 ]' s8 j! {; k2 e/ v! J. yproc.time()-ti
    3 o" ~, J. b! E& [; D7 K' `
    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-5-27 20:28 , Processed in 0.385208 second(s), 79 queries .

    回顶部