QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18851|回复: 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()
    ( K6 |- i% n( R2 ]BP_one_output<-function(input,output,m,fth,sth,w,v){9 S3 X" W; y9 c6 e" [
            x<-input;#7*8
    ( l) a! n' G, h+ O! ^& l' c" Z1 b        y<-output;#8*1,y为向量,每一元素为一个样本输出值) R7 t" U# v& }  T
            theta<-fth;#11*1
    " S7 X4 D8 p7 Y. s+ g        gama<-sth;#标量, Q; k9 p# v2 N$ T- O) e( Q( m
            if(m!=length(theta)) print("阈值长度错误!")1 ?% |7 p/ t6 |( k
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    4 |* Y" k% G+ d) Y# v( {" O        K<-nrow(x);#8一组样本的维数2 }. n8 Y  \* h% x7 @
            J<-ncol(x);#8一共有多少组样本
    . W/ V: W$ y) o, }4 @/ @        w<-rbind(w,t(theta));#由7*11变为8*11; b: @! k2 i$ V# V2 x, y
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接2 x# ?/ O+ ^$ d0 M* V3 W5 v
    #定义函数f' M9 u! \# E. ~2 D
            f<-function(h) 1/(1+exp(-h));# x& M: X# }7 g* _9 N* Q
            epsilon<-alpha<-0.5;
    & @2 i8 y6 O5 p( _        N<-0;#重复学习次数的计数$ @& Z, S1 b) \( n) W$ ^; s
            ei<-as.numeric();#记录每次迭代的平均残差平方和5 B8 a1 E; N; U4 B. y
            FW<-1;
    ' _+ K4 `( F$ Q% U2 a# |2 l        while((FW/J)>=0.001){; @3 w3 Z# r2 @9 g# M
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本( S  e) H( ~4 E* u6 v- G6 o
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
    2 ~4 Z" a1 G) n4 c1 ?3 i* u                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns" i+ T6 a0 v: }2 I( ?
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值; m( j  K4 I' \, Z. n1 i  V
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值) L4 z% }8 s& l1 ^9 Z. J' Z
                    b<-y-D;/ C" M! M: N  l- Z
                    #J组样本的学习/ U# a2 R8 R$ M5 D7 S
                    #向量,输出层对隐含层的权值的偏导
    % N# o$ q0 X: E* Y: X                FW<-pFW2<-pFW2t_1<-0;
    8 B2 T2 Z1 ]/ m# o) E2 S                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导6 Y( _* }( i8 ~: a
                    for(t in 1:J){; q5 V5 J  y( N* u( `- l( q
                            B3<-b[t];- g7 Y" R/ s# A5 y. k; z
                            FW<-FW+B3*B3;#标量
    % D' A) Q: s8 k7 L9 E                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量7 m4 R9 W* U- f7 r& `: r
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项  Y0 b9 b9 B$ }* S
                            if(t==1) v<-v-0.5*epsilon*pFW2
    $ ^4 G2 o! Q0 N2 n                        else{) W+ K$ U1 `: q: {# ~. W9 f4 L
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    # U) j* G6 q/ W5 h& f                                pFW2t_1<-pFW2;
    5 T) ~6 u1 O$ Q3 q' e' O0 s& y                        }
    - k! @2 |8 n, B# X                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连$ s5 P2 N4 w! P6 Z9 E+ a
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    " T% B0 p3 X2 Q+ f# v6 p                        if(t==1) w<-w-0.5*epsilon*pFW1
    ! [6 Z  ]1 u1 S0 _" a/ B8 x                        else{
    * p0 d9 j7 d9 ^7 o' ~6 v! V5 ?                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
      i& F* c2 J5 A$ p! m                                pFW1t_1<-pFW1;5 ~" G' [* o3 e0 {
                            }/ r( R( Y7 x" ^' `
                    }
    % h) ^* f% m% t* _* h                N<-N+1;
    # L" Q0 _3 g3 f. [! O, P- S2 y                ei[N]<-FW/J;  p2 l2 v& P6 i( `/ a
            }
    - r. g- E( k5 n/ m        theta<-w[nrow(w),];#隐含层阈值
    6 O) {- K* H5 \        gama<-v[length(v)];#输出层阈值! l/ X' @7 H2 Q0 a: H. h2 X
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重2 q" S. p: A$ J( i* M, z3 \& e
            v<-v[1length(v)-1)];#隐含层对输出层的权重' U0 p( K, q0 _
            list(theta,gama,w,v,N,FW/J,ei)
    6 `% P+ _7 _* Q- p}
    ) F' U1 ~, d6 Q5 x& {! @6 bx<-cbind(x1,x2,x3,x4,x5,x6,x7);# z7 V4 b# W) d( e
    x<-t(x);2 ]. }* d3 A! P' F4 o5 W
    hidden_threshold<-runif(11);
    - N) s/ o% @6 t9 ]$ v1 ~* ioutput_threshold<-runif(1);/ }$ ~& z0 q* C7 S6 P' ?& k
    w<-matrix(runif(77),7,11);" p1 i; h; w6 C! g, Q: l7 _
    v<-runif(11);/ G0 y; I$ ?5 l
    result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);; x/ `3 _/ b# a1 ]- i5 y0 d. d
    #输出. R5 W$ [# V) e4 N0 a7 [
    cat("\n");
    " e- e8 H  E9 Fcat("隐含层阈值theta","\n",result[[1]],"\n");
    2 W$ Q( P3 T& M  M; dcat("输出层阈值gama","\n",result[[2]],"\n");) G) q, ~' }! }4 [( G( b  q
    w<-as.matrix(result[[3]],7,11);
    $ E( R+ B* Y; E* T& X+ i. C( mcat("输入层对隐含层的权重w","\n");
    3 O% |- h9 ^0 P( g3 i  ?w;8 I4 k9 ~* F- E. I- d
    cat("\n");5 N' N2 Z6 I  {2 r
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");3 G7 G! |7 v. |4 [
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    5 B+ O* O# g9 W0 l5 A; m* v, ?' S2 l, N+ o! fcat("学习误差FW","\n",result[[6]],"\n");' e4 E. k  [" a" z: s6 i! v( U: p$ \
    cat("每次迭代的误差","\n");
    $ U- ?0 q1 z& `/ cplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");3 i+ l+ W! S6 V" _9 Y
    proc.time()-ti
    6 D0 `! q2 |9 n& _
    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-21 21:17 , Processed in 0.498292 second(s), 79 queries .

    回顶部