QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18587|回复: 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()  v& T6 n9 k, e+ h6 F4 v
    BP_one_output<-function(input,output,m,fth,sth,w,v){
    ' K: ~: N- n3 _$ A8 l+ Q) {        x<-input;#7*8
    ! u2 ^+ ]! \# S7 s        y<-output;#8*1,y为向量,每一元素为一个样本输出值
    & E5 v' d3 n; \( R        theta<-fth;#11*1
    , o# b- `. C; w& f  u4 D        gama<-sth;#标量$ Z) s* p2 X+ W  C# H, g
            if(m!=length(theta)) print("阈值长度错误!")
    9 \9 Q9 j2 t9 C0 ^4 P        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    ( N# b( ?8 N, K+ A' {' }- H! z, a6 w* E        K<-nrow(x);#8一组样本的维数
    : S# B0 X. f5 @- A  t7 O1 L        J<-ncol(x);#8一共有多少组样本
    / ?8 T4 u8 R+ e* [4 H        w<-rbind(w,t(theta));#由7*11变为8*11% t" A2 k+ i! {. A
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    + J% G' ~) G( j#定义函数f0 H) t. W7 Y' H4 F+ P
            f<-function(h) 1/(1+exp(-h));% J4 O9 a; r2 D0 [) b" J; G
            epsilon<-alpha<-0.5;5 G0 ~8 L; q; m% k- H9 B
            N<-0;#重复学习次数的计数3 G) w/ @6 w5 ?( v4 a
            ei<-as.numeric();#记录每次迭代的平均残差平方和
    2 v& W4 i- w+ ?; V* R7 c        FW<-1;
    + x6 W3 h' B7 s0 y8 q        while((FW/J)>=0.001){
    * h1 n) C" T- _, w4 i0 y# D                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    0 T! y8 r) e/ O' E" b                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, / t1 D8 C# K4 k  B/ m4 x
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns
    ; W) y/ y) S, m% h, E                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    : e+ \" z' U. z                D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    % F. L3 [! v5 p* ?8 K5 k2 P3 h; ]                b<-y-D;
    7 u' r) N7 H4 E, a                #J组样本的学习
    # d" j$ [  n/ R/ w                #向量,输出层对隐含层的权值的偏导
    1 j3 J/ d. B, F& o$ l" @                FW<-pFW2<-pFW2t_1<-0;" s7 N& D2 @- V% B6 z2 ~' u1 p& H( [
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导4 D8 v/ B8 F) Z+ o. ?
                    for(t in 1:J){* D& u' P. y6 X5 f4 f2 }
                            B3<-b[t];
    ' h/ m) u7 r5 a% M2 O                        FW<-FW+B3*B3;#标量
    9 O" k" o+ v1 C+ Q+ d- Y# s/ e                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量2 I( o; R! U: b6 I) z# F
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项( o$ {0 a1 f& Z+ C
                            if(t==1) v<-v-0.5*epsilon*pFW2
    $ C: f1 z1 w/ q" g9 l: \                        else{
    6 C7 l+ Q# P( R5 \  y                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);! c( H" g+ [# y+ T; p7 k, D  w( p
                                    pFW2t_1<-pFW2;( P2 u# s3 X9 A1 z; G/ V3 m4 A, M
                            }
    4 ~* a" H6 X$ t7 D# C2 R  d7 h                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    . f2 o/ e: _* e5 s                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    * s% L- }' e/ Y+ T! c  O; @8 U                        if(t==1) w<-w-0.5*epsilon*pFW1! Q4 ~' W7 x' [& T
                            else{2 f0 l# v4 E+ X4 [
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    . v2 Q3 M  p& s# W7 Z* \                                pFW1t_1<-pFW1;, _. s& C% L/ U. U1 v9 b! W( C! s2 F: U
                            }  m0 D5 O, n8 a0 q, Z8 V
                    }
    7 K' C6 X& B" E1 ^" _- p5 a+ j) ^1 ?+ o                N<-N+1;
    ; W. V& Z/ p. `- j9 q8 Q( Y                ei[N]<-FW/J;
    1 G' Q* K4 E8 x# G1 [1 e$ T, q        }
    + P0 |# T' R& Q7 q        theta<-w[nrow(w),];#隐含层阈值
    / }; @1 T' m  g& j  Y        gama<-v[length(v)];#输出层阈值% |0 D" _) E0 n) F$ b2 v
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重$ W* [1 y+ L. V; ]/ \4 t
            v<-v[1length(v)-1)];#隐含层对输出层的权重1 X# W+ ], e" M8 x5 e
            list(theta,gama,w,v,N,FW/J,ei)
    4 T/ [  r" o" W; H7 @: b}  L. v/ t5 \( ~) @
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);
    ; o: O: |1 C# [' a7 }: cx<-t(x);, P6 K3 N/ h/ Z/ B* Q' G9 B  s
    hidden_threshold<-runif(11);9 l2 e, H1 J+ s9 u
    output_threshold<-runif(1);3 N7 C# O# a( e9 M: Z, t
    w<-matrix(runif(77),7,11);- Y6 m& h" j3 d/ f. M
    v<-runif(11);
    ( O6 D1 z! p4 t  e" z9 b. m  e: uresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    3 N1 \, |' }% |$ U4 z" V$ ^#输出+ S) M. ], n, ?+ p0 W
    cat("\n");/ U, _" |: H# j2 F. h7 z. m
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    - g. H4 ?& R0 `: A  Xcat("输出层阈值gama","\n",result[[2]],"\n");
    8 G3 S; i# W( s$ U+ hw<-as.matrix(result[[3]],7,11);
    2 t$ t# j3 k. H. L9 G3 fcat("输入层对隐含层的权重w","\n");
    $ c& R8 `4 r' S& Vw;6 f% ^1 ]8 m! }+ ^; Y# N0 P0 l
    cat("\n");9 @5 s- V. q: L. t7 z; W' s3 c& \
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");  ^3 \' F9 d# x# B. [8 j
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    1 Z+ Q; q* L! U- @: Y4 r8 W$ ?cat("学习误差FW","\n",result[[6]],"\n");
    ) }& u* z' L$ K5 acat("每次迭代的误差","\n");
    9 W8 k( X7 w9 h7 x% Dplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    8 ]9 e" ]8 A5 jproc.time()-ti
    7 p3 u7 R# d+ }( ^
    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, 2025-11-9 21:55 , Processed in 0.673150 second(s), 79 queries .

    回顶部