QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18794|回复: 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()+ E" ?- l! q! K4 J) ~' J1 b
    BP_one_output<-function(input,output,m,fth,sth,w,v){: L. l% k; ^% G5 x# m( I
            x<-input;#7*8# {8 l: M2 t8 g- X/ f
            y<-output;#8*1,y为向量,每一元素为一个样本输出值
    # y- o2 B' Q0 C2 C        theta<-fth;#11*1& F5 U, {! w; o3 U1 Y8 o
            gama<-sth;#标量) l2 Q/ v2 D4 J( m3 ~" n
            if(m!=length(theta)) print("阈值长度错误!")% X; l# ^6 t/ I
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    . ]; S4 ?1 F4 _9 z6 e% I  v  i        K<-nrow(x);#8一组样本的维数
    ; [: ~2 N- V6 U        J<-ncol(x);#8一共有多少组样本" r9 a3 |% b# n, ~4 [, A- {4 ]: q
            w<-rbind(w,t(theta));#由7*11变为8*11
    / j9 g6 B" }  ^9 q3 U        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接, i) G& Y" o# a# t' B- M; z
    #定义函数f) A# L* |. A4 w+ I
            f<-function(h) 1/(1+exp(-h));, Y: Q6 r, p5 r' k& g9 s
            epsilon<-alpha<-0.5;
    1 q  M+ h6 v3 E0 H& p; Y9 y9 T        N<-0;#重复学习次数的计数0 a# I! p/ L4 y" l$ @2 `# X9 n
            ei<-as.numeric();#记录每次迭代的平均残差平方和
    6 T6 L3 u( r4 ~. j( m$ C        FW<-1;
    2 [& @5 p6 D7 n9 w* \        while((FW/J)>=0.001){
    9 g* C$ Z" w! k3 O6 |, j                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本; U3 x- L" K  p; A$ D
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
    9 ^1 `% U4 n7 F7 }                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns4 }3 E# [9 M  d7 e& [* c
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    7 z# u4 G$ x* i                D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    + a8 v7 R& e) E- ~$ r; t                b<-y-D;+ @$ y; j) j( r8 j
                    #J组样本的学习
    6 `7 Q6 C4 A% ?% Q, z) |, t: q% c                #向量,输出层对隐含层的权值的偏导
    0 W& V6 _# _# w* `& L( m) x                FW<-pFW2<-pFW2t_1<-0;7 [, J/ w& s% {& U6 L* Y6 W- i& Y
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导1 W/ W# G% z* m( M
                    for(t in 1:J){4 W& i, J! z" E( D  Z
                            B3<-b[t];
    ! q! w5 D9 N1 M/ p                        FW<-FW+B3*B3;#标量% [% l7 u1 ^) r( _) M4 k8 j
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    % m6 A- v3 w* T8 y! d% \8 y+ H                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    / x% E: G% x7 ^; x+ K                        if(t==1) v<-v-0.5*epsilon*pFW2
    + Z2 N! L" t9 X" Z  d# z                        else{; E7 ?) v9 {& ^, V, U
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);" F* G, E) p4 L% t
                                    pFW2t_1<-pFW2;
    5 X! C# H! H0 h                        }
    8 b3 S, M* e( U- |+ y                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    ' I9 \0 _/ c- m% x) q                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导1 v9 V' d  s% l7 b
                            if(t==1) w<-w-0.5*epsilon*pFW1
    4 i6 W6 P; Z! `- D8 b1 [) l6 J                        else{
    & v) t0 W1 x  P, i+ F( D! T                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    ' \" z% z5 M+ U. n3 \                                pFW1t_1<-pFW1;( k+ K% f2 q/ E0 _
                            }/ U* C/ y0 C6 O" d2 h$ C
                    }- t2 V% w7 b+ o
                    N<-N+1;/ s" [( Q1 Q5 q2 k! R& V2 ^
                    ei[N]<-FW/J;
    ; b8 D. n& K  k" h2 ^        }% i6 ~, Y) D: S. M# a* V8 N* K- E
            theta<-w[nrow(w),];#隐含层阈值
    $ C. Q- w: {; e: ]: ~* A) Y/ x! ^        gama<-v[length(v)];#输出层阈值
    , y/ l3 o. E4 X        w<-w[1nrow(w)-1),];#输入层对隐含层的权重" ?  @5 _8 H3 Q& W. ]9 C
            v<-v[1length(v)-1)];#隐含层对输出层的权重+ L2 Z/ X3 u  u
            list(theta,gama,w,v,N,FW/J,ei)% N- _4 m: S9 ?
    }
    & G2 Q- L) `0 fx<-cbind(x1,x2,x3,x4,x5,x6,x7);
    : C9 {9 H' t+ Q+ w  nx<-t(x);8 R' p( D+ M5 V0 {  a
    hidden_threshold<-runif(11);
    4 G2 ~7 Y, C% ^$ ioutput_threshold<-runif(1);
    1 ~  b7 p" Z. P2 k6 n) L( Uw<-matrix(runif(77),7,11);
    . E9 I) \0 z2 l8 Fv<-runif(11);
    . _. h/ f% X: Q; |) jresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);+ H4 N- j) Z  l+ e! y! s
    #输出) a7 D2 l' N1 v' [
    cat("\n");% X3 F6 z( U9 c& I
    cat("隐含层阈值theta","\n",result[[1]],"\n");# R, K# W1 A7 u9 ~% O) |7 a
    cat("输出层阈值gama","\n",result[[2]],"\n");  e! M: ]8 w) n" V$ H8 T% |
    w<-as.matrix(result[[3]],7,11);
    ( P  K2 K: U( Z! q  H0 K% X' ]cat("输入层对隐含层的权重w","\n");
    ; f  A2 V  l& H; {) j0 W: u0 \! Aw;( y1 z9 I$ x8 S$ W  y
    cat("\n");
    % ?8 G6 [. Q' X( w/ D5 ]/ N' Ucat("隐含层对输出层的权重v","\n",result[[4]],"\n");8 `3 p* Y4 k- y* \
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    * F0 z) N# H. X, Z! X) c7 j! c3 e0 b, Kcat("学习误差FW","\n",result[[6]],"\n");0 K; b! ?$ L! o- `# X: G
    cat("每次迭代的误差","\n");
    % E- r* x/ ~+ c/ Uplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");* ~; D% l1 T0 u" P! M8 s4 c1 @/ ]
    proc.time()-ti
    5 Y) i5 Y$ O/ B" W6 q& P: 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-5-28 01:53 , Processed in 0.367987 second(s), 80 queries .

    回顶部