QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18839|回复: 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(): }* c& ~9 W. T
    BP_one_output<-function(input,output,m,fth,sth,w,v){6 ]+ B, N! o7 D' ~) L- p
            x<-input;#7*88 Q$ I) T9 l* X8 d4 y8 k0 N
            y<-output;#8*1,y为向量,每一元素为一个样本输出值% r+ G9 Q' w  C, r; B5 S
            theta<-fth;#11*1
    4 ~' ~, }6 i7 F. n  R7 h& e) Y9 H        gama<-sth;#标量
    ; n  c: U$ L, G( f        if(m!=length(theta)) print("阈值长度错误!")
    / [3 L3 O; m, C" j        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重1 X" c" M9 M% A; V2 U
            K<-nrow(x);#8一组样本的维数! m$ P" K& _$ V4 A- {2 h2 x4 r
            J<-ncol(x);#8一共有多少组样本
    8 h, Q! v1 p9 t5 }6 N        w<-rbind(w,t(theta));#由7*11变为8*11: {8 E7 O+ t: u
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    : q5 y5 @; j) ^- ~0 @1 G9 @#定义函数f/ K# d9 o- l. Y. d3 g
            f<-function(h) 1/(1+exp(-h));
    , J4 b/ `, `& q* n" u) O0 W% i0 c        epsilon<-alpha<-0.5;
    5 x3 \1 g7 O3 b" `' I# k        N<-0;#重复学习次数的计数4 B1 T: x3 F$ n+ i) Q' |
            ei<-as.numeric();#记录每次迭代的平均残差平方和0 k5 f; c0 s. E  M, _& W9 @. r
            FW<-1;. p" H7 t7 h/ S: l2 n: c: y  h. e) P4 ?
            while((FW/J)>=0.001){
    9 F; s& p5 N1 h5 P2 _/ I                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    # a' E0 k# Y3 k2 k/ Z* h) M                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
    % g/ T) \2 A( p6 `) I2 R7 Z                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns
    5 \8 a" F0 c) D% J                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值% c2 \& F5 R8 V0 G$ Z& L9 i
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    8 [. J: r. Z4 T1 Z4 y/ a8 V                b<-y-D;
    4 C4 f' @% R4 _" S1 ~: P9 ^                #J组样本的学习# ~# f& h0 g8 ?% \  f2 f" ]
                    #向量,输出层对隐含层的权值的偏导5 {* S6 V( {6 v7 X2 M* s+ R5 Q
                    FW<-pFW2<-pFW2t_1<-0;8 ~5 n+ x4 B6 A: U; x( U
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    ; `8 e" L8 K5 l, ^& u8 ?                for(t in 1:J){
    - p1 o4 f. M1 a, `: Q! F                        B3<-b[t];
    8 q5 ]# v! H; b% t6 d                        FW<-FW+B3*B3;#标量
    6 u: T" R' `' g9 S1 L- q                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    6 {3 V/ ~; q/ M8 a( |; L1 d                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    4 y# ]# x8 B  `                        if(t==1) v<-v-0.5*epsilon*pFW2
    . T% V9 D7 f2 Q3 o$ j                        else{& I* R  i, I6 s) O
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    ) u4 }% p0 \: |, e  |                                pFW2t_1<-pFW2;
    5 D; k, M5 t  Y( J                        }# t' {9 q9 H5 t, r
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    7 b8 e- d0 G; R+ h                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    " K& m; |" \. P. o                        if(t==1) w<-w-0.5*epsilon*pFW1
    - t+ d& J! f% C8 p                        else{
    * E- U, e6 E* f                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    ( W' W9 X/ B- W9 j0 D- S  J& f1 G                                pFW1t_1<-pFW1;1 t& L- o1 H9 o, `* v- W
                            }6 i. }9 {3 T' N& O9 C. J6 ^
                    }# Q. D2 V+ q2 D' V
                    N<-N+1;
    3 D' S) m: b# j* b9 H% H                ei[N]<-FW/J;
    1 x; X* K6 n# G0 Q) I4 R( Y        }
    & V& B8 u2 x: e: q4 Y- G- |        theta<-w[nrow(w),];#隐含层阈值6 z# v  D6 ]! ~; p. n" _
            gama<-v[length(v)];#输出层阈值3 M" R) Y8 n/ |
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重' R- a- E% [! C* y! y
            v<-v[1length(v)-1)];#隐含层对输出层的权重
    7 m% L; O. K1 J: B+ F; {) |        list(theta,gama,w,v,N,FW/J,ei)* Q! h& Y" J4 A7 z; U$ C3 m" B8 Q
    }
    ; h8 |/ j! \3 Y% ~1 bx<-cbind(x1,x2,x3,x4,x5,x6,x7);* S  X1 P1 ?3 q( r
    x<-t(x);
    * U1 ?& N; ?9 Y% N5 J' xhidden_threshold<-runif(11);/ ^5 V, g$ t2 m6 r
    output_threshold<-runif(1);% ~7 `! h+ k7 w2 c* e) I: }
    w<-matrix(runif(77),7,11);
    8 x6 M; V3 J) v- I# f. Nv<-runif(11);
    1 M9 T2 F' `7 Q* p& b$ \( iresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    5 j5 N/ `! q3 l- k1 t  G7 Z#输出7 d; Z6 Y  @7 @2 J
    cat("\n");
    ; o- l& H# z4 r2 J: Pcat("隐含层阈值theta","\n",result[[1]],"\n");
    * Q" r4 U/ Q, B8 D, R! }cat("输出层阈值gama","\n",result[[2]],"\n");! D" T* M5 }$ _2 k! X5 W4 ]
    w<-as.matrix(result[[3]],7,11);6 b3 c9 k3 g+ g7 l6 J- @0 v& V
    cat("输入层对隐含层的权重w","\n");+ f6 [6 f9 |) w) N9 }: k& ?9 H
    w;- e, \# k8 L5 G& D. y3 b9 X
    cat("\n");. l: ~0 Q& {4 J2 _9 N8 w, `
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");3 z8 W, K+ V4 i4 p8 \4 W
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    . c4 u+ w! W8 R3 Ucat("学习误差FW","\n",result[[6]],"\n");% @6 I' \4 O8 [  D$ p
    cat("每次迭代的误差","\n");
    1 @5 _! m2 L- vplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    # s, n# @: P# v' ^4 x3 o" d' _5 Y! G$ mproc.time()-ti# w! y8 M( R$ t2 m5 A/ @2 o9 F" f' U& Z
    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-11 07:16 , Processed in 0.601322 second(s), 80 queries .

    回顶部