QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18852|回复: 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()& C6 t2 T8 Y, j. r) `7 p" l
    BP_one_output<-function(input,output,m,fth,sth,w,v){- o2 w+ H. \& q4 O
            x<-input;#7*8' F6 a. W/ R) T; E1 L" Y7 R
            y<-output;#8*1,y为向量,每一元素为一个样本输出值
    , X1 U& j; h8 a- Q# Z        theta<-fth;#11*1
    / J+ s$ {+ ~  B# y$ h( j$ p        gama<-sth;#标量
    9 C1 J9 t$ C; ]! d4 Y; i$ i7 u" W- K        if(m!=length(theta)) print("阈值长度错误!")
    ' ~7 v: a8 E+ U- C- H  W7 h        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重4 W. d- \8 o. T6 C
            K<-nrow(x);#8一组样本的维数
    * G8 R( h1 q% e5 r/ f6 M/ [/ N5 J        J<-ncol(x);#8一共有多少组样本
    4 {1 M& q2 i+ j4 I0 r% n2 v        w<-rbind(w,t(theta));#由7*11变为8*115 V/ B, Z( ]5 w4 P7 O; d* ^( N
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    $ \& f+ K5 N7 E1 Y) p! {& _* M3 h#定义函数f1 K+ X$ h$ W1 Q  N- A
            f<-function(h) 1/(1+exp(-h));
    - S1 J) Y* B2 [" A* v4 l6 d        epsilon<-alpha<-0.5;
      @) ^* E$ x) p        N<-0;#重复学习次数的计数
      B# E+ Z. b' V4 R( \4 k  _& t        ei<-as.numeric();#记录每次迭代的平均残差平方和
    " O" F9 m4 _# U        FW<-1;
    ' U# w2 b6 R; S        while((FW/J)>=0.001){
    ' L4 U1 s# E6 q" b! m                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本5 `& [; @$ M2 h% l& j) F& z
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, 6 e3 E4 @# U" @. h5 I( A, q' V) ]
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns; j6 ~( O. x( F7 R1 \
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值$ r) G# f$ [4 v
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值3 T0 I1 v: G6 G% G; H9 y5 P
                    b<-y-D;
    , c9 |5 {* l  e                #J组样本的学习
    % }* j1 _. y+ ]                #向量,输出层对隐含层的权值的偏导/ Z4 A% d1 m8 U/ z8 ?
                    FW<-pFW2<-pFW2t_1<-0;1 H& C/ U4 p/ d! V, q
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    ) h- T' f6 G4 f# H                for(t in 1:J){" V1 J* J" n+ M$ @. B% N
                            B3<-b[t];/ J- h& _! S7 h/ G) X4 L! |) [
                            FW<-FW+B3*B3;#标量
    5 Y9 U; F% ]. U. C6 E- \                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量+ R4 N, E  g7 k, j$ P  z
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项0 C$ v( p' Y5 {, N4 e
                            if(t==1) v<-v-0.5*epsilon*pFW2/ }  H3 N( x0 q" O
                            else{  b  F1 w! I0 {  G7 g* @) U
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    # f" T* i6 A5 }3 i% B+ Q                                pFW2t_1<-pFW2;
    ( Y0 k# }; x1 \1 r- f                        }2 x6 O' X5 o' p( L+ \0 I/ s( o& X
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连! ~2 `( P7 c5 k
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    0 \4 L/ k! N+ O  X& G1 y                        if(t==1) w<-w-0.5*epsilon*pFW11 p6 A$ }% N* v# g, h$ ^! ]* n, S
                            else{
    + T1 v5 P1 ]" S4 |4 N: U9 y                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    " q: i' d6 ?! E; o                                pFW1t_1<-pFW1;
    . m1 [" p+ S& d6 M8 N- H& f                        }  {, e, p. `9 d  \& @6 B" a8 y) U
                    }
    ' t* ]7 q! z( C                N<-N+1;) G/ t- A7 a! W
                    ei[N]<-FW/J;
    & [6 E% F& F! j; E+ e8 N; D        }
    3 d" j* [. y' A+ J6 @2 y, {$ @        theta<-w[nrow(w),];#隐含层阈值
      U$ @9 Q3 e7 }        gama<-v[length(v)];#输出层阈值
    6 b+ G' l  M, J3 O        w<-w[1nrow(w)-1),];#输入层对隐含层的权重& E3 ~7 w# z7 b. A) P' v1 A* o
            v<-v[1length(v)-1)];#隐含层对输出层的权重7 i# _* a" B  R. ^! u; S
            list(theta,gama,w,v,N,FW/J,ei)
    ! j7 U6 `7 S! u4 ]! O! b}
    ! Z/ u! D' ]+ Xx<-cbind(x1,x2,x3,x4,x5,x6,x7);
    . D. M* H0 L- t5 }% |* _+ s9 ~x<-t(x);
    $ p# E, N+ |4 O  Fhidden_threshold<-runif(11);
    $ U/ b9 ]; Q. I, Uoutput_threshold<-runif(1);
    4 q: W' _+ f; Lw<-matrix(runif(77),7,11);  j" f. j# i+ u2 t- L% l% c! [
    v<-runif(11);. x' z8 ]3 Y5 ?" O
    result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
      O) t6 X! d/ X9 j9 r#输出3 v) i2 s( t1 `2 l* k
    cat("\n");
    6 s. {  i  F# L1 Jcat("隐含层阈值theta","\n",result[[1]],"\n");
    / s2 {& K* V" b9 acat("输出层阈值gama","\n",result[[2]],"\n");
    % O( Z$ h( Q. ^! _w<-as.matrix(result[[3]],7,11);) @* ~; s; d( S* L
    cat("输入层对隐含层的权重w","\n");
    : F$ G$ n( G; J  sw;
    , U, V( b0 L' c' b: i3 u/ hcat("\n");
    ( a) e2 [( I, `" g4 H  fcat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    , G6 W, J; V9 d5 i- R9 V$ Jcat("迭代次数N" ,"\n",result[[5]],"\n");
    4 ^% ~/ Z8 I  ~cat("学习误差FW","\n",result[[6]],"\n");
    % K$ D6 I+ y# L5 f9 qcat("每次迭代的误差","\n");
    ) o! Z+ w; R# c" n" J+ lplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    # p6 P9 d/ Q0 F4 c6 L5 j$ e! j$ z5 n1 Nproc.time()-ti( b& ^9 y" [( j7 j1 X* S6 ?
    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:22 , Processed in 0.377393 second(s), 79 queries .

    回顶部