QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18760|回复: 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' O* B  P( Y$ l
    BP_one_output<-function(input,output,m,fth,sth,w,v){& D: S0 u& _; z) [  X5 n
            x<-input;#7*8# Q9 i* G7 l- Q# r& t
            y<-output;#8*1,y为向量,每一元素为一个样本输出值
    5 X2 `- T: }! Z1 I5 B3 _( |        theta<-fth;#11*1# G$ i& M7 x6 x2 j# s1 ~
            gama<-sth;#标量
    ! O* i  v# T' `  g        if(m!=length(theta)) print("阈值长度错误!")
    & C8 ?: f/ }6 [" B$ q) P        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    7 ]- m+ W+ I3 G        K<-nrow(x);#8一组样本的维数
    ' M: i$ k& J7 X, Q0 h; L        J<-ncol(x);#8一共有多少组样本. c# ~: @% B* ~0 H+ k. o
            w<-rbind(w,t(theta));#由7*11变为8*112 F- \9 h4 A- g( u! `
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    - X; O, n) s( O# O( [: |#定义函数f; O8 @) Q# e7 _' j. D
            f<-function(h) 1/(1+exp(-h));
    5 k' n" o4 H/ t+ p        epsilon<-alpha<-0.5;) R* b6 q* E3 Z( L% ]
            N<-0;#重复学习次数的计数
    ) Y3 v. n" R' R! \2 P        ei<-as.numeric();#记录每次迭代的平均残差平方和' h2 j4 I; d1 m- ^, @$ g% i. v
            FW<-1;
    / j9 b/ A/ \. M' B  F8 k  J; r6 R        while((FW/J)>=0.001){' p9 M7 }( I- r$ `5 o
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本$ K: r; |, R* p3 |& B
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, / c. X5 ]2 n- x. p9 y7 V# f
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns$ ^+ ?' T. W' M7 m# ^
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    ; Q9 Z9 S, J8 g0 |! z                D<-f(Z2);#向量,每一元素为一组样本的一个输出值4 }+ O4 L4 z+ c6 m, y' l. G
                    b<-y-D;4 j% n8 i4 c; _; H) t0 e
                    #J组样本的学习
    3 e8 }. Q: s9 W                #向量,输出层对隐含层的权值的偏导4 n4 t" E" d1 m/ X$ T9 C
                    FW<-pFW2<-pFW2t_1<-0;! O) Q; O& \7 u, N' A
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    3 ]& S/ F, y$ @0 h- \6 r8 G; F                for(t in 1:J){" S8 f5 u, X$ j9 v
                            B3<-b[t];
    0 J7 ?7 G" U5 V, j4 i1 v( ?                        FW<-FW+B3*B3;#标量! n0 d  `# M6 X7 j4 K5 f7 r
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量6 e" K2 E" r# c5 {  e  @
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项: `2 a% N5 L6 G! h
                            if(t==1) v<-v-0.5*epsilon*pFW2- v$ }+ u! v- l& e/ R+ L: }6 P
                            else{
    6 m! }+ t9 ]7 {$ z  T' N                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);3 U9 a" j! B# Q2 o& A* O4 ]
                                    pFW2t_1<-pFW2;0 H0 X6 r9 U% {# A" X" k
                            }
    ! F! }. H! |2 G) \% K# U2 K5 d6 k                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连) F6 [5 W7 Y! s3 N* X1 v8 Z. q
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导" C/ w. a0 E- C7 M6 @
                            if(t==1) w<-w-0.5*epsilon*pFW1# p% B% L, v0 |; w
                            else{1 Q; F7 E1 c1 ^/ Z. u6 m' j
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);$ q/ V" O2 g1 R8 ~. k7 a
                                    pFW1t_1<-pFW1;
    + K: P) M4 ^2 a5 ~: u. H* z: W                        }
    * x- C- l  w- T, x  D& r                }
    " u! h* f! \/ ~! U2 B                N<-N+1;0 v' z0 L: N/ w& V3 X
                    ei[N]<-FW/J;5 ]4 `+ i+ p. [
            }
    8 g0 B4 R- j) e! ]4 H0 u4 Y        theta<-w[nrow(w),];#隐含层阈值0 o2 H' W$ e8 V8 A0 W
            gama<-v[length(v)];#输出层阈值- S6 n. e9 ~: @1 U& x
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重+ z7 K1 Y0 l& [' |) f! E
            v<-v[1length(v)-1)];#隐含层对输出层的权重
    & f: `1 y$ r& Z/ E7 d        list(theta,gama,w,v,N,FW/J,ei)
    0 a& W' O/ c( ]6 t}
    . H6 |/ y# t6 H% c& I2 n1 E+ N1 Tx<-cbind(x1,x2,x3,x4,x5,x6,x7);* W+ f! R, p/ m+ y* u# q9 x' i
    x<-t(x);
      a" O' O$ h+ }# d! u( ghidden_threshold<-runif(11);
    7 ]6 g& O  E" @output_threshold<-runif(1);3 ^( i9 _; `3 h+ U% B5 q2 P
    w<-matrix(runif(77),7,11);- l( n! U- H7 k' O+ g* U& [  {* v, O
    v<-runif(11);
    5 i7 s4 V: a# T1 q0 S: E$ [result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    + l" J2 Y  j- {% |9 |. Q- N5 x#输出
      |0 `- q  N* M& f4 Mcat("\n");8 G  D. x1 h3 T' K$ l% U
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    , D6 S2 J; E# g" G7 L9 Hcat("输出层阈值gama","\n",result[[2]],"\n");
    6 O4 o% s2 _9 Q7 _) rw<-as.matrix(result[[3]],7,11);# ]$ `1 _+ i' v# x. v
    cat("输入层对隐含层的权重w","\n");
    ; b3 S2 }5 e5 U) `& Gw;/ l) V; L4 A) b3 @7 G8 t$ M4 P- w
    cat("\n");
    6 K1 K; H: h( f# Ucat("隐含层对输出层的权重v","\n",result[[4]],"\n");- l6 U) r8 s; n7 |( S1 `- }
    cat("迭代次数N" ,"\n",result[[5]],"\n");: m# U6 d+ \. ^" ~$ h$ f/ J
    cat("学习误差FW","\n",result[[6]],"\n");! \% g" I, E' M( t" K* L
    cat("每次迭代的误差","\n");
    ' Y" m" W0 x$ p4 f& u$ |plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    & Q( G7 H, W6 r6 i9 j: ^proc.time()-ti& W( f9 N3 w/ X6 Q0 L5 \
    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-4-12 19:38 , Processed in 0.480210 second(s), 80 queries .

    回顶部