QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18897|回复: 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()
    ( d, z! i2 O& R, p3 O9 D5 KBP_one_output<-function(input,output,m,fth,sth,w,v){$ i# |( a9 C! G) S5 `
            x<-input;#7*8) \- {9 @6 b9 o8 J/ W& K
            y<-output;#8*1,y为向量,每一元素为一个样本输出值9 B$ U' B; H7 H2 s' w$ u: {" d
            theta<-fth;#11*1
    / x9 E" ^8 _3 `1 }        gama<-sth;#标量. s( t* k* S8 W% H( V
            if(m!=length(theta)) print("阈值长度错误!")
    ; h$ |; u& p( }7 K/ R: {0 i4 R  I        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重3 u: E1 F" |! [6 a- m* I
            K<-nrow(x);#8一组样本的维数6 G# w5 Z0 \0 |; v7 u/ e( _
            J<-ncol(x);#8一共有多少组样本; P+ o: G# y( e3 \
            w<-rbind(w,t(theta));#由7*11变为8*11
    9 G5 f# f, @  g6 F+ F. k: t/ p        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
      L6 @( J! k/ d: X/ j2 j) Z7 y7 D- e#定义函数f
    3 D/ X+ b; R- h4 o  D5 X6 Z5 Y        f<-function(h) 1/(1+exp(-h));8 |) T# y% t0 U; ^; U7 C" X1 z
            epsilon<-alpha<-0.5;* C/ m; m' Z; h
            N<-0;#重复学习次数的计数) Y& D; M6 x' D% r+ o, p8 E
            ei<-as.numeric();#记录每次迭代的平均残差平方和
    5 l. L! V9 }  W8 i7 {0 F        FW<-1;
    ; L+ |8 n5 v' a; W        while((FW/J)>=0.001){8 B; J) z9 S0 O5 s/ X# b
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    . \  O, K! z" R, R2 n$ y                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, ) r8 `, @8 h+ S2 Y- a. g# g
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns+ ]; f" r: A& k  w3 W8 h) F
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值) q" N$ d) B$ \- f
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值" b8 i% X2 N/ }) L7 i; r
                    b<-y-D;$ Y) P" {* `* r9 s# @1 n% J% s- a
                    #J组样本的学习$ r% d( I; _9 B# U5 f
                    #向量,输出层对隐含层的权值的偏导. M2 k$ Q' ]2 ~4 I
                    FW<-pFW2<-pFW2t_1<-0;
    ' @4 C* \0 {  i, \                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导5 S* f/ _$ k9 ?" x
                    for(t in 1:J){
    % w4 Y% `1 R& N( w8 F) G6 Q* V                        B3<-b[t];9 u; Q; b( k9 @5 z3 K4 ~3 v
                            FW<-FW+B3*B3;#标量0 D9 X, A# y: \7 B7 Q- Y2 `
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量+ X  F9 I( M* D: x  X+ S  t8 b3 H
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    - `5 k) P# ]6 @! }# v                        if(t==1) v<-v-0.5*epsilon*pFW2
    ' @8 S1 X7 h7 D* C& C: A                        else{& [0 d% F. h) Z# u" X% {4 ~. Q
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    4 o8 _+ Z3 {. ^. k) ~- [4 t$ h0 u                                pFW2t_1<-pFW2;
    0 j# B4 R. c5 u                        }7 B/ G1 p. S0 `3 g0 X  d9 @  n. _( ^5 M
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    ! T" u  @) C" q/ s! Q1 b                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    & @7 C3 ^7 S! k6 k; ?. c( l& W: `                        if(t==1) w<-w-0.5*epsilon*pFW16 D! r# [4 y7 ^8 |' l* j
                            else{
    5 R9 B  L, l2 O( M; ^" X                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    . v4 \2 K7 s6 T0 J5 }" {3 a2 n0 f                                pFW1t_1<-pFW1;* `1 S- B. s% @$ p% Q4 b4 O3 c& s( @
                            }
    & q( N4 S* w5 Q/ g* r                }% }. Z$ B8 |/ A
                    N<-N+1;& f& k2 {7 j$ G2 }7 ?- O
                    ei[N]<-FW/J;
    1 B" a/ E! I: e' U' X        }
    : X& }0 N; c* Z: g3 r) p! u- i        theta<-w[nrow(w),];#隐含层阈值: E1 r0 ^/ `7 Q: Y3 w0 M6 H
            gama<-v[length(v)];#输出层阈值0 K( H( ?' B8 s7 T. M* W# w
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重( S( T4 s7 t$ \' |$ I: N; _3 X. W& Q
            v<-v[1length(v)-1)];#隐含层对输出层的权重
    ; \+ s4 _: |( s) o% f+ m        list(theta,gama,w,v,N,FW/J,ei)
    2 W+ u1 K. q1 Q$ r2 Q* E# W}. c% J* h! D0 |
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);, N% j( L$ K2 t1 P& q/ e/ m
    x<-t(x);
    : b+ j9 ]# C* y, ?hidden_threshold<-runif(11);0 ]# o  H) P3 M: {, @6 D, M
    output_threshold<-runif(1);
    * v8 v' ]7 i# F6 L; dw<-matrix(runif(77),7,11);2 {5 }- Y6 v* Q0 a) W. C
    v<-runif(11);
    1 w! d+ u4 L0 d5 iresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    ( }7 g* w3 P$ f7 B. m" @. R#输出- u2 S  _: S1 ]/ T3 N, p& B
    cat("\n");2 t2 o3 r3 W/ T4 q  U; G; g
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    : y1 Y0 m  G, ~% |cat("输出层阈值gama","\n",result[[2]],"\n");" {0 [. k. D- l# Q5 A6 C
    w<-as.matrix(result[[3]],7,11);
    0 O6 U( x2 W' t, j& ~cat("输入层对隐含层的权重w","\n");  y* C; R0 h  G$ C
    w;
    ) B/ s7 ^/ t! w0 Ncat("\n");
    : f: E$ I9 x' |+ ~- {) Bcat("隐含层对输出层的权重v","\n",result[[4]],"\n");: C# k" ]7 X( N& c: l4 I, |. n
    cat("迭代次数N" ,"\n",result[[5]],"\n");% t) y5 {7 J% n' ~. ^
    cat("学习误差FW","\n",result[[6]],"\n");3 c+ V6 k+ _: j+ J4 d" }& U8 G
    cat("每次迭代的误差","\n");
    " S$ S- T2 n# ?. Oplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
      R- c9 T8 ?9 j6 Zproc.time()-ti
    % r1 R, X% D$ x2 i
    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-9-5 03:23 , Processed in 0.433621 second(s), 79 queries .

    回顶部