QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18884|回复: 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 T- i, Z! o. i/ I2 T7 n
    BP_one_output<-function(input,output,m,fth,sth,w,v){! X* K$ w9 [& x- w& d7 {2 J
            x<-input;#7*8
    ! N( m6 S0 l  u        y<-output;#8*1,y为向量,每一元素为一个样本输出值
    ! _* R1 Z8 a! d' M' ?        theta<-fth;#11*1
    9 V3 e, F  {* k: q* v        gama<-sth;#标量+ ~, H- }! ?6 V
            if(m!=length(theta)) print("阈值长度错误!")
    3 l4 k" @+ {( |# `! L        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    & V8 q$ I9 ^% E9 G5 v. ?( M        K<-nrow(x);#8一组样本的维数
    / y4 K# @' n7 ?# h( Z5 O        J<-ncol(x);#8一共有多少组样本
    : j$ N7 j* V* G9 J        w<-rbind(w,t(theta));#由7*11变为8*11$ B/ a0 n; {6 o2 j7 G
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接. m1 `* I9 [; i0 v% i4 C
    #定义函数f
    2 U1 I/ G/ Z2 @        f<-function(h) 1/(1+exp(-h));
    5 I; y% Y! N/ ~1 a        epsilon<-alpha<-0.5;& c. w% I& v, V
            N<-0;#重复学习次数的计数8 [$ F- H9 X' q+ W* k
            ei<-as.numeric();#记录每次迭代的平均残差平方和
    / W5 w% N; \7 T2 R3 M        FW<-1;! r+ D' C' A; O7 q
            while((FW/J)>=0.001){" g# P5 U+ f1 [# x. D
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本' T) O" y1 |5 ~1 O
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, 8 l* U8 C, n. v: I/ N
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns  J7 o2 P" B+ U5 m3 @
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值! U4 i2 g  H" `% J, U
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值9 `$ z+ s8 }  ]9 k
                    b<-y-D;) r5 [) t: _/ P7 F  e& v
                    #J组样本的学习6 A( H9 Q0 o0 G
                    #向量,输出层对隐含层的权值的偏导5 q3 G2 _  F0 `, y% H: \
                    FW<-pFW2<-pFW2t_1<-0;
    & e/ ?( T/ O% k0 d/ ]) P  K                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导; z3 e2 N2 q* B' q( o# |* P9 K
                    for(t in 1:J){% u  X6 R1 [: |
                            B3<-b[t];
    ) U- x4 @8 c) g! d. z8 M, k                        FW<-FW+B3*B3;#标量
    * ^- B% u" k3 A$ ~3 ?0 Q( K1 P                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量% c: F! o0 B7 M; Y+ w) B: \
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    : c" D: i, g9 R- A0 T                        if(t==1) v<-v-0.5*epsilon*pFW2
    * o% y; I) Y- e" j  W& q                        else{
    # c$ k5 ^- t- v                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);+ S0 `7 z9 n* |# [) H+ j/ M
                                    pFW2t_1<-pFW2;
    9 a8 s4 r- X3 r4 J1 w! N4 k9 O+ \+ b                        }
    5 f( ]0 b+ t3 t                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连9 q1 z) a' r* ?# b+ f
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导5 `  K0 X6 M! S$ \5 A7 o: X. L* ^& |
                            if(t==1) w<-w-0.5*epsilon*pFW1
    ( v, \( I: k0 p" \- |; e                        else{/ _3 A! B( i% R3 e( M
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);& M0 o* j7 ~) m: n. s
                                    pFW1t_1<-pFW1;
    ! J$ B" O9 j, I. k+ d* ]' J                        }, q' I2 m5 s! `6 @6 U( s: x: w
                    }' {4 E; i5 a. g, z
                    N<-N+1;, ]/ X! _4 g# f. d8 _  o7 Z. l; v5 g
                    ei[N]<-FW/J;4 {8 e/ B: y, D( V6 I. ^
            }! B% V; h2 z5 G# ^# ^' h( v. Z
            theta<-w[nrow(w),];#隐含层阈值
    / G- A4 I% ~! M, C1 H        gama<-v[length(v)];#输出层阈值
    ' K5 |+ y0 r& A$ _# I        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
    - b# D1 g/ V! B$ o3 j        v<-v[1length(v)-1)];#隐含层对输出层的权重
    ) Z+ G$ y# x. A. x& a' R6 {        list(theta,gama,w,v,N,FW/J,ei)$ `& F2 Y: O9 u! `& |& e
    }! d3 C$ ~; {4 W1 t
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);8 v; l8 J: ^4 y% r, S- F6 u
    x<-t(x);  G* g& I# _6 `% Q+ x2 b8 S! H. F
    hidden_threshold<-runif(11);
    0 u! t4 P8 o& U5 {% Y" l& voutput_threshold<-runif(1);; I; B/ h; _4 m: F: z
    w<-matrix(runif(77),7,11);
    + y. Y8 ^: y4 M  Zv<-runif(11);
    / g  r' k. H- Z: a! n0 eresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);' @5 p( _+ _( d
    #输出
    # M7 S5 c5 N) P0 ^5 o5 Icat("\n");
    4 R9 M8 \; B+ M2 M" M2 G$ ^/ dcat("隐含层阈值theta","\n",result[[1]],"\n");
    2 T; z9 O" s0 G8 P: U+ U4 Z- pcat("输出层阈值gama","\n",result[[2]],"\n");6 x& U# j# a; r" s" M7 w, b; Q
    w<-as.matrix(result[[3]],7,11);
    ! ], I/ H4 _, n' [6 S* fcat("输入层对隐含层的权重w","\n");
    $ G3 n' k' R& M: b) M1 }w;4 N7 Z3 u+ U* A
    cat("\n");
    3 u1 d$ T2 W. j- t* O" q- o: Mcat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    + x! [! T0 k# C% o) R" w+ Kcat("迭代次数N" ,"\n",result[[5]],"\n");  T9 r; L9 Q. P8 P) }3 A  [. p
    cat("学习误差FW","\n",result[[6]],"\n");0 {1 v$ @% M1 ]; G5 I, P( _' O
    cat("每次迭代的误差","\n");2 k1 N, ^$ y9 {* m
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");4 r; s% i' K$ I0 g) `
    proc.time()-ti
    % D, C! I0 d% U! s: b- e0 |& P6 W4 _
    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-8-27 00:08 , Processed in 0.444637 second(s), 79 queries .

    回顶部