QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18834|回复: 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()( z. d* W" P7 Q$ Q9 P6 C0 V  w
    BP_one_output<-function(input,output,m,fth,sth,w,v){
    / S4 V& f9 j& Q9 x, A. g% B, M        x<-input;#7*8
    4 c1 s4 a1 H7 z( m8 A# ?        y<-output;#8*1,y为向量,每一元素为一个样本输出值
    1 q2 W  a. p9 l6 Z        theta<-fth;#11*1
    * K6 P3 O, I) S$ x5 e        gama<-sth;#标量
    * i6 M+ H' m8 e' h  J5 E        if(m!=length(theta)) print("阈值长度错误!")
    + Z6 K! o3 s* j( V        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重6 D& N3 K5 Y6 u* B+ X
            K<-nrow(x);#8一组样本的维数
    # K! M- i) A- {6 g" Q6 B' m        J<-ncol(x);#8一共有多少组样本
    . \5 f$ a, ?/ e        w<-rbind(w,t(theta));#由7*11变为8*11
    9 g$ M3 j' q' p8 R- N* @        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    3 n! T5 U/ |% L; L+ T- e' E#定义函数f+ p7 R8 C5 q( x4 D2 n, @1 w
            f<-function(h) 1/(1+exp(-h));
    1 q- @3 b2 n9 w, C% I0 _" ^        epsilon<-alpha<-0.5;
    & T% b/ `5 y! e& B* U) S+ G1 l        N<-0;#重复学习次数的计数
    * _4 d# ^9 s* X* D# Q        ei<-as.numeric();#记录每次迭代的平均残差平方和6 d7 |9 B. y; b, S9 I! u
            FW<-1;
    8 j  _3 J% o: }, }0 ~9 a: i& w        while((FW/J)>=0.001){
    3 U4 v! i- e7 r, e3 H, f                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    * p# q* |7 N7 L2 b" K. x0 n" S% G' {                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, , f2 ]2 m. @! B  n
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns8 o% u) N9 w: B" }
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    / a0 K$ f+ }) q- f, i+ p( p& R                D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    # q' t# s) L8 l; t6 Q1 m' X6 b                b<-y-D;* X5 @2 R& i* p5 d; _
                    #J组样本的学习
      x4 P4 ]1 N2 G! e                #向量,输出层对隐含层的权值的偏导" W, C$ n2 C" u) h7 ~$ m% {
                    FW<-pFW2<-pFW2t_1<-0;) B! U: S& w' h% B8 j, Q5 q3 r$ C
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导  ^5 P; r# h1 V4 u% ]
                    for(t in 1:J){$ H4 m' J9 U0 _' r) X& I
                            B3<-b[t];
    # l4 {, _. h! _& p0 f                        FW<-FW+B3*B3;#标量; ?6 c. I! j9 O* n& g4 I) M
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量* T! d, I  k( F" ]0 K- x4 v
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    , H8 S5 f+ J; @9 Y8 i# X: W                        if(t==1) v<-v-0.5*epsilon*pFW2
    1 S1 m8 i/ b2 g2 k- g* y5 m5 }                        else{" t4 `/ ]+ P# u" n
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);/ j- z% r" l2 M( S2 ^
                                    pFW2t_1<-pFW2;2 {8 [& I2 F& V) s1 K
                            }
    * e- z# G' B4 @                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连# R) Q' w! p; l) M9 r& K
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    3 ^& Q. q% Y' T7 C9 E" k% i                        if(t==1) w<-w-0.5*epsilon*pFW1
    : m. R3 F5 `& z% N8 _                        else{
    ) m: `. s  O: _/ r' u                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);& z& Y' b; k/ ^% K' b4 G; D
                                    pFW1t_1<-pFW1;
      \3 g: O8 c0 Y4 T$ X                        }
    * h1 x" [7 j7 s5 Q) W; T                }
    6 n) z8 B3 f- V, _+ B9 w2 Y                N<-N+1;  y2 V: G* F& \) o* z
                    ei[N]<-FW/J;
    + b  f- ]7 R& @; G* X; J        }
    ! k$ n4 Q  i" _. K4 m7 v0 P        theta<-w[nrow(w),];#隐含层阈值* X! l: }/ q7 S' `1 j
            gama<-v[length(v)];#输出层阈值
    1 z: ?( o2 B, F5 }0 s( y" u        w<-w[1nrow(w)-1),];#输入层对隐含层的权重) J; K* k1 v% Z3 Y$ O) Y! z
            v<-v[1length(v)-1)];#隐含层对输出层的权重+ G" t: h. I6 n; e1 a
            list(theta,gama,w,v,N,FW/J,ei)( H$ L0 A' ^! W5 r9 _- A
    }6 d# C- W3 c5 d4 [* X9 Y# y
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);
    + L2 Y8 p/ |( h- O$ L2 Sx<-t(x);
    6 n% @# }+ ?  Z' {+ Fhidden_threshold<-runif(11);; W, q  p9 L/ O4 u: N9 ]6 {0 D- u
    output_threshold<-runif(1);% n8 H1 R* S+ `' x
    w<-matrix(runif(77),7,11);0 ]6 s2 Q- z9 t0 W$ V
    v<-runif(11);* i  O& A: S2 i: o0 x, Z% o, j- V
    result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    9 r! ]1 w5 E8 v3 L6 S$ L* L, Q! h% ]7 n#输出
    . k! T1 E% ^& E. I- N) Ncat("\n");; o  }. _4 z5 u7 I
    cat("隐含层阈值theta","\n",result[[1]],"\n");( f, Q. v: H+ ?/ p+ Y+ v
    cat("输出层阈值gama","\n",result[[2]],"\n");
    ' y; x7 r- M/ Ew<-as.matrix(result[[3]],7,11);
    $ m; {$ w1 D" s& @+ ~cat("输入层对隐含层的权重w","\n");! z. H6 S: T( P! V9 i
    w;
    . }4 E5 G2 G9 I/ Ccat("\n");# @  E& S* S2 V; l4 w' A  ^
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    2 `0 q& ?1 e+ Q2 d( ?  Hcat("迭代次数N" ,"\n",result[[5]],"\n");
    ) B6 v7 g6 y1 F; l2 F$ h2 K5 M% mcat("学习误差FW","\n",result[[6]],"\n");
    7 H$ d7 V, J/ xcat("每次迭代的误差","\n");( f. X* Y6 e- [3 Q+ i
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    # r: S# u+ K9 T+ M2 X9 n/ mproc.time()-ti
    ( Q/ j- g; y5 t+ @
    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-10 14:50 , Processed in 0.692049 second(s), 80 queries .

    回顶部