QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18752|回复: 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()
    , F; Q8 e" c! h% yBP_one_output<-function(input,output,m,fth,sth,w,v){
    ( p, T* C2 u+ A2 w& R2 F( o) @        x<-input;#7*8- p# w2 `) t' s
            y<-output;#8*1,y为向量,每一元素为一个样本输出值, a, i6 f% m) Q) g+ k
            theta<-fth;#11*1
    6 @1 u  }$ h& W6 t        gama<-sth;#标量
    0 d1 h3 t6 F! ?        if(m!=length(theta)) print("阈值长度错误!")
    ! [' z! L' b% k; x7 A        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    0 _$ z/ B/ h  m! R* c# V- d        K<-nrow(x);#8一组样本的维数7 M/ q: a- t" z' \8 L
            J<-ncol(x);#8一共有多少组样本
    & v, b* M( T) P4 y% ~/ a8 |& @        w<-rbind(w,t(theta));#由7*11变为8*11# g( z  S1 M, Z* `
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    * e& u  c- v) e5 n8 V- H7 r# }#定义函数f
    6 J, v& ~1 g+ y: Q. }        f<-function(h) 1/(1+exp(-h));0 Q  a( t) m% g: h/ u- d
            epsilon<-alpha<-0.5;
    0 Z, J% Q, V7 ?& n6 u" ?        N<-0;#重复学习次数的计数- H/ B/ @) Y, `7 D
            ei<-as.numeric();#记录每次迭代的平均残差平方和# W9 a, S7 e/ T# X! a
            FW<-1;
    ! n, z3 ?7 |6 Z3 Z        while((FW/J)>=0.001){
    . {: k/ M1 O8 `( o, P4 I$ }; z                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本, l& e8 E8 m3 D6 C% ?# g
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, : u; V; A6 }3 W. W  P
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns
    ; ~  [7 a5 w; }9 B* c' z* a% ?                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    - K) Q% y) P$ v                D<-f(Z2);#向量,每一元素为一组样本的一个输出值. w; }4 G! p# Q" H0 ], w5 D
                    b<-y-D;
    2 p7 G3 N; k+ E                #J组样本的学习
    + p, \- S* @' a                #向量,输出层对隐含层的权值的偏导
    ' w5 X; |6 H+ d) b! k' v                FW<-pFW2<-pFW2t_1<-0;: K$ D' I0 o2 j8 K
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导2 K; S! w7 }7 X  s
                    for(t in 1:J){
    0 S) D; V' m7 M7 C                        B3<-b[t];
    # ?& {) v( v- V6 h3 O  I) g                        FW<-FW+B3*B3;#标量
    6 t8 v$ K# s! Z' m; H                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量3 f+ O0 c; F; u! T$ e8 {2 D
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项$ j7 e- N/ v: X! J. Q
                            if(t==1) v<-v-0.5*epsilon*pFW2
    8 B; W. p# X3 \                        else{
    9 k) E9 v$ U! P1 Y                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);5 Z, o# a* L' A, x2 W) j3 e! d, S
                                    pFW2t_1<-pFW2;
    * o6 j3 C+ ]7 r1 u                        }
    & L7 w' W5 D4 o+ G5 V& Z7 p                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连0 Z1 k6 D  M2 ~) K
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导: Q7 W  l6 o) G) \- ^/ i8 T. `
                            if(t==1) w<-w-0.5*epsilon*pFW1
    " f8 y6 f) i) q. W2 P. z                        else{
    / \; U6 Y8 V3 L                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);$ P6 b" J) R3 S
                                    pFW1t_1<-pFW1;* p: ?* s1 W. [
                            }9 S5 k: R* f7 _, d, S6 G4 q6 d
                    }
    : ~* l8 Z  r6 P5 m/ m                N<-N+1;
    4 a  W+ I' T% R1 y( T8 P) N                ei[N]<-FW/J;9 W9 S% w3 z8 N: [$ i* a2 ^
            }; t: {2 m% Z" f' u8 s3 S! u9 y
            theta<-w[nrow(w),];#隐含层阈值
    7 P  y( ~# S8 g; g! J        gama<-v[length(v)];#输出层阈值: h2 {# @4 o) S/ \8 m' P
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重
    * v6 O9 a: w0 t        v<-v[1length(v)-1)];#隐含层对输出层的权重
    , u7 y0 K8 e8 u$ C. O        list(theta,gama,w,v,N,FW/J,ei)
    " [* d: h3 g/ B/ C: ~" r}5 B5 |8 N) g. S  j
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);9 n' V! Q3 _! _: R2 p. L4 q
    x<-t(x);' M  U$ v9 f8 [" b- `9 O. _& o
    hidden_threshold<-runif(11);
    4 p9 G+ G+ S: ]2 ]+ |7 Qoutput_threshold<-runif(1);
    % E  D/ O& q, z: dw<-matrix(runif(77),7,11);
    $ b. y1 w! D& G2 Wv<-runif(11);
    / f& I0 L1 R- x# \: ~+ sresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);; s9 N4 N1 H8 B( d* x  r
    #输出
    ' p4 k8 r' a. l3 x. jcat("\n");
    6 m1 A- H2 a" E: Ucat("隐含层阈值theta","\n",result[[1]],"\n");6 O$ G" r: N/ {" `. ^. v
    cat("输出层阈值gama","\n",result[[2]],"\n");
    ' A) y/ \& O! Ew<-as.matrix(result[[3]],7,11);0 E" z  O& c* h
    cat("输入层对隐含层的权重w","\n");
    1 o7 D3 ?, v% i; e3 mw;/ V! @) k( q5 ~0 m2 ~4 a
    cat("\n");" g7 h: `1 t, ~' p
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    + ?* y1 W, r* T! Y( ?5 d+ X: z4 {0 Y8 hcat("迭代次数N" ,"\n",result[[5]],"\n");
    - ~! k6 H4 d% s# D  s- {$ bcat("学习误差FW","\n",result[[6]],"\n");
    4 _, g' c  X: y! P: _+ s0 Bcat("每次迭代的误差","\n");
    3 B! e, T! y+ g' {plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");6 L, T& K, J  M& z+ {% A
    proc.time()-ti* O- n6 H# O4 y) P5 U
    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-4-10 09:48 , Processed in 0.396831 second(s), 80 queries .

    回顶部