QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 19044|回复: 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()  b0 B6 Z0 k8 n; z; A
    BP_one_output<-function(input,output,m,fth,sth,w,v){8 s6 I! H$ Q" }4 h
            x<-input;#7*83 C" Y" U+ g5 A! w( n
            y<-output;#8*1,y为向量,每一元素为一个样本输出值
    ! _- I. \! S8 u* X        theta<-fth;#11*11 |: m- A5 M. l3 e5 L& X1 F
            gama<-sth;#标量
    . h; x7 f) w. G% x0 L9 L        if(m!=length(theta)) print("阈值长度错误!")
    ( e) K1 u5 o1 f* j3 p        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    6 r' N; N* Q0 W3 K! K1 M        K<-nrow(x);#8一组样本的维数
    . V6 n. K, e2 r! `. \4 O        J<-ncol(x);#8一共有多少组样本
    7 N; J* j. w. p        w<-rbind(w,t(theta));#由7*11变为8*11
    ; n! _  B; q( }' I9 C% V2 p        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接9 j5 J) T7 @+ s2 T( E. A. ?* b
    #定义函数f
    3 f3 j. h% x4 T) F5 |/ s  K1 r! Z: i2 J        f<-function(h) 1/(1+exp(-h));$ B( o+ C( L  F* u
            epsilon<-alpha<-0.5;# a( i$ w& C: ^$ u$ `
            N<-0;#重复学习次数的计数% q" c- o; |& N4 A9 A9 b* A, [. M
            ei<-as.numeric();#记录每次迭代的平均残差平方和* ~8 I$ b0 Z4 ~. s/ X
            FW<-1;! }, h+ T4 X' A0 O
            while((FW/J)>=0.001){
    ; }. _% M: U7 c+ S4 X4 D, \& w5 F                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本! I" i: E8 k/ z0 ]9 I: f% ?
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, 5 O  l6 ]6 A7 k9 D( d
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns
    , P( N, C7 \) T. b& i5 `                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    & v+ h0 |/ o+ F# R/ ^                D<-f(Z2);#向量,每一元素为一组样本的一个输出值: l# X: p5 b, r% D/ y" D8 P1 ^5 B
                    b<-y-D;
    % D7 O# ]6 [' f                #J组样本的学习/ g+ c/ _$ n. c+ l  o2 g7 e5 z9 Q
                    #向量,输出层对隐含层的权值的偏导' R( [& D7 l1 @/ Y  n0 V" c
                    FW<-pFW2<-pFW2t_1<-0;
    " n, J+ A2 }: F7 ~' q7 ]/ h                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导  u# {! u& M7 W0 Z0 L1 k4 p9 q
                    for(t in 1:J){
    $ i/ }/ B' D9 I5 ?& T: D7 x* z                        B3<-b[t];
    2 o, }" m% J; m; o) I                        FW<-FW+B3*B3;#标量# i4 K$ P: Y+ J$ J$ q
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    4 `" i9 Q1 \+ k! p4 b; o' `( a# L9 |                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项- q* C: H; B: K
                            if(t==1) v<-v-0.5*epsilon*pFW24 S9 C7 {7 Z2 _$ l) ?0 ?0 R
                            else{
    & i3 L2 j$ C+ G4 I                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);  e2 |! ^0 t) z8 u
                                    pFW2t_1<-pFW2;
    , O& O5 C, k8 }: S                        }: M0 e! i% t, `# h# Y$ |; V
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    : w5 M5 ~7 Q( e# a# ~+ w                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    . X3 o2 C; f2 o                        if(t==1) w<-w-0.5*epsilon*pFW16 {% T' I( E/ p, k* `  X8 D' o
                            else{% i: g) p0 [1 J% C. ^, k2 p
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);$ Y. M) N! {! t$ e% v  Q- p8 d) H! ^
                                    pFW1t_1<-pFW1;
    ( A0 [) J1 f. |                        }- b. F, F. u2 L" f1 C: G& i* ^3 s+ n4 t1 |
                    }
    7 D- q, F4 |1 _+ l$ v# E  L8 e' ^' q2 k                N<-N+1;) |' g) o- H6 c; @$ b
                    ei[N]<-FW/J;
    . i$ a. J  j5 p' ?! M* {) ~( m        }
    0 A( s7 L. {: R6 |0 S3 [7 @! b6 F' g        theta<-w[nrow(w),];#隐含层阈值
    # j" W, n7 M& z+ ^" l; a        gama<-v[length(v)];#输出层阈值
    ) `3 Y$ j1 W$ R0 x' M$ h' |        w<-w[1nrow(w)-1),];#输入层对隐含层的权重4 q+ w1 H, U. l0 t! f
            v<-v[1length(v)-1)];#隐含层对输出层的权重  ~1 z. D% D! E6 o" \) h3 Y7 O
            list(theta,gama,w,v,N,FW/J,ei)( P" u0 L" |- N" x- e( G9 q6 N+ x
    }: S2 R$ d/ I( a) w1 ~$ s
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);0 r( {6 b: u4 A3 }9 s
    x<-t(x);- w( V: u: w- F! W" b3 N3 u! l1 @
    hidden_threshold<-runif(11);
    1 g2 l. B( |+ i) V% I4 W# doutput_threshold<-runif(1);
    8 Z- _% M7 |9 L2 u, S5 P) K8 h/ B9 D- A( Pw<-matrix(runif(77),7,11);
    2 H$ u' Y% c& X5 E) y9 b. A, Rv<-runif(11);
    1 W- o% X; @- ~5 m# Qresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);& j. `3 s4 v" X% W! |/ i
    #输出) V* i2 r1 N5 i  O5 K9 n
    cat("\n");
    1 j3 U/ U; m8 K& x$ P/ Y1 @2 u# Pcat("隐含层阈值theta","\n",result[[1]],"\n");5 Y/ ^8 y. v- x/ e
    cat("输出层阈值gama","\n",result[[2]],"\n");% Q3 \; C4 E" x2 @
    w<-as.matrix(result[[3]],7,11);3 p5 g) T5 ?; A' [
    cat("输入层对隐含层的权重w","\n");
    : b) p/ j: _: q+ c3 G" p/ Iw;! A$ Z. e0 K' T5 N
    cat("\n");
    - K! f, \4 N3 S3 H, Dcat("隐含层对输出层的权重v","\n",result[[4]],"\n");3 I! B# I2 L! h7 T7 }2 y9 H# i. {
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    % _+ C/ l' O8 T: D3 q$ b9 }4 i& }cat("学习误差FW","\n",result[[6]],"\n");
    " s# n8 R8 Q; O& q  \- ]+ Dcat("每次迭代的误差","\n");
    * f2 W* y6 N1 @, Tplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    0 _) W! w( ^/ @/ G$ lproc.time()-ti' A8 Y9 p0 Z0 i
    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达人

    回复

    使用道具 举报

    您需要登录后才可以回帖 登录 | 注册地址

    fastpost qq
    收缩
    • 电话咨询

    • 04714969085

    关于我们| 联系我们| 诚征英才| 对外合作| 产品服务| QQ

    手机版|Archiver| |繁體中文 手机客户端  

    蒙公网安备 15010502000194号

    Powered by Discuz! X2.5   © 2001-2013 数学建模网-数学中国 ( 蒙ICP备14002410号-3 蒙BBS备-0002号 )     论坛法律顾问:王兆丰

    GMT+8, 2026-10-31 21:33 , Processed in 0.295834 second(s), 80 queries .

    回顶部