QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18504|回复: 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()
    1 _$ Q  [" p8 uBP_one_output<-function(input,output,m,fth,sth,w,v){& A5 s& _* H& [- ^
            x<-input;#7*8
    * |& o. W3 ^/ m' l+ ^/ A8 n  S        y<-output;#8*1,y为向量,每一元素为一个样本输出值
    2 B$ n, j7 i0 B0 M; V5 V        theta<-fth;#11*1
    3 `$ c; X# H1 R/ K. y. B        gama<-sth;#标量% h. B" M* g- Z  I. A
            if(m!=length(theta)) print("阈值长度错误!")+ _4 z: d  F$ I4 K' }: C' I0 P$ ^
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    5 x6 U: O" ~3 M, @+ _: f' g! m" \        K<-nrow(x);#8一组样本的维数
    # o$ M+ h9 o! \7 y: x* ?        J<-ncol(x);#8一共有多少组样本6 S6 W0 k: r; H3 e% i/ K
            w<-rbind(w,t(theta));#由7*11变为8*11. F# h  F/ @1 ?% V9 f5 u
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    2 Y) }! |1 g. D1 A#定义函数f. v$ M, g& S: N6 c5 k) ~% P
            f<-function(h) 1/(1+exp(-h));" w/ r' D! W! [7 i* G4 I6 K/ e
            epsilon<-alpha<-0.5;. s$ u, P2 s. x# ~* g% E3 }
            N<-0;#重复学习次数的计数
    0 z, \, [4 u$ y# Z6 ^        ei<-as.numeric();#记录每次迭代的平均残差平方和
    8 q1 J$ R% E) ~( u        FW<-1;
    5 P) n: V& E' `# }# A        while((FW/J)>=0.001){
    : J- s- R6 O& t7 Z/ v; K8 L( c                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本: ]. o3 w0 A. N: ^) x8 d* ~
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, 4 h3 W* X- `  W4 m1 {+ F
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns
    * q7 _7 [, w" M                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值, a& d* m; h4 b
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    + R" e: V; \. S" V* |% E                b<-y-D;
    . M0 S7 w; r5 {" f" \                #J组样本的学习- M3 d. e3 U: ]
                    #向量,输出层对隐含层的权值的偏导/ ]( G0 ]+ X& s2 Z8 l" R& b1 x
                    FW<-pFW2<-pFW2t_1<-0;
    7 H- I& Y( ^' |7 B. E                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导3 R/ x1 D& h" p& C
                    for(t in 1:J){9 f4 G; _4 w1 n
                            B3<-b[t];
    9 N& Z, I4 m4 m" |$ z: ?0 Q- I/ o                        FW<-FW+B3*B3;#标量
    8 F8 t5 x+ k: }5 U+ s8 d                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    ( }, M# `. q4 ?1 V' o                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项/ O  T$ W. j$ E$ V; z+ N; s* G
                            if(t==1) v<-v-0.5*epsilon*pFW2
      K, ?+ h$ [9 g8 c                        else{4 S- L9 w) ], M# K. D
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);- v! A4 o2 X7 h7 e# P4 W: G
                                    pFW2t_1<-pFW2;. q! H: q' D8 S7 P5 z
                            }& N5 l& N  p/ X3 }
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    6 {; b  G, j4 N7 [% ]! k) O$ u                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导& Y4 ]9 x! \; q( M2 `
                            if(t==1) w<-w-0.5*epsilon*pFW1* r! \3 L0 b  W$ o# E) f; P
                            else{3 U& o6 U6 J* x1 v
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);, P. ~2 C0 Q7 `# }" P
                                    pFW1t_1<-pFW1;
    $ y3 ]3 Y  A8 p& m$ D" @- A                        }- T1 N( i/ L5 X& `2 ^- u' j* p  J
                    }
    0 ]9 O0 l" D; R+ F                N<-N+1;
    5 \7 Y; {9 C* ?+ G                ei[N]<-FW/J;
    / C4 ~0 `$ ]% r/ [        }" I* L) ^0 @  v1 b
            theta<-w[nrow(w),];#隐含层阈值1 L1 F. r/ n; B
            gama<-v[length(v)];#输出层阈值
    2 `3 k" q% o4 o7 }: o        w<-w[1nrow(w)-1),];#输入层对隐含层的权重' s$ u( a6 B( ?' ~8 R% L/ n1 D+ Z
            v<-v[1length(v)-1)];#隐含层对输出层的权重
    * p6 l6 x# E4 R: ?. _        list(theta,gama,w,v,N,FW/J,ei), f# P9 S5 ]! R. ~8 G# y$ A
    }
    , J8 d' t7 w$ |# }- E. Ox<-cbind(x1,x2,x3,x4,x5,x6,x7);
    1 D3 X; T& k6 b3 u8 u  u* Wx<-t(x);4 N9 k3 {7 d' {# a6 f! ~! d
    hidden_threshold<-runif(11);& b3 a6 U6 l0 `+ A) R/ e/ d8 k
    output_threshold<-runif(1);
    * f0 h- P7 a; R2 x6 gw<-matrix(runif(77),7,11);  H4 }  x8 ?2 D$ k" f
    v<-runif(11);
    6 t  N" f, M! F* b1 t3 F6 _$ oresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    " |% J5 o& F4 \9 W% ^* r#输出6 K' G) M# G) M. i; F7 ?6 _) G
    cat("\n");) E% i7 _( l5 f- A  ^. }9 g
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    , n) Y7 E+ R' m- y6 |cat("输出层阈值gama","\n",result[[2]],"\n");
    $ w: N3 }+ m/ Q4 U+ [w<-as.matrix(result[[3]],7,11);
    ) x2 t9 O( W+ d" j5 f  u) _cat("输入层对隐含层的权重w","\n");
    : J# R( o! H! K7 i! S3 S3 l6 Ow;
    1 F- V, r6 D* D0 s! K% Bcat("\n");' n+ \4 W4 d9 O7 F0 x
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    + M$ h# I2 u9 H5 ^. Scat("迭代次数N" ,"\n",result[[5]],"\n");
    ' h. Y$ p( _0 B6 q# Ccat("学习误差FW","\n",result[[6]],"\n");
    / B- r( t( m1 u5 Y, G: {* N7 Ccat("每次迭代的误差","\n");9 w9 c/ q9 S6 g, ?2 [5 u9 {0 g
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");9 ?* Y# L% F5 z0 V
    proc.time()-ti
    ; \% C3 _& w  \* K4 z. z
    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-8-20 18:53 , Processed in 1.470192 second(s), 79 queries .

    回顶部