QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18756|回复: 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()/ b0 K7 w% c3 X& I; i" y
    BP_one_output<-function(input,output,m,fth,sth,w,v){  k$ f, p8 h- }; j3 d* c3 L
            x<-input;#7*8
    3 g0 i  g; u, w        y<-output;#8*1,y为向量,每一元素为一个样本输出值* D3 P( a/ M+ [( L4 E4 Q2 e
            theta<-fth;#11*1
    0 I/ V/ K  N" X& t; t        gama<-sth;#标量0 Y5 u  e+ \6 _& V/ p2 f1 L! z- d
            if(m!=length(theta)) print("阈值长度错误!")8 G$ U4 X- d0 O- ~6 G, f
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重4 |4 ^/ i0 q& m9 [
            K<-nrow(x);#8一组样本的维数- m" p0 k' j: E
            J<-ncol(x);#8一共有多少组样本
    4 A/ E' O1 c4 D$ F        w<-rbind(w,t(theta));#由7*11变为8*11
    6 _7 t8 f4 m  b9 u" Q4 d) m2 o        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    : r; O* y& S# z  Q9 B( C#定义函数f
    - F) j# ]. @% d# }' E        f<-function(h) 1/(1+exp(-h));
    ! u: y- h# }% r' A        epsilon<-alpha<-0.5;
    1 O4 Y) s: B- T" S! ~- L8 q7 T- M, b        N<-0;#重复学习次数的计数
    , |) `7 g" G# l3 `        ei<-as.numeric();#记录每次迭代的平均残差平方和
      b2 _0 M% G4 q3 v. G        FW<-1;# i; j4 d) A9 z5 }' @
            while((FW/J)>=0.001){  A: R3 v  F4 q, L
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本: _/ T. M6 \3 ^' ?; y, o
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
    ' C$ j3 i) Y7 k% _0 y) z  E                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns
    ' d6 N2 v4 ]) ~0 A: p                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    6 Z% F+ q1 L: y                D<-f(Z2);#向量,每一元素为一组样本的一个输出值3 W8 T: @  {* i6 \0 ~; s3 z
                    b<-y-D;9 f& `  R% |- J
                    #J组样本的学习' o3 ]* t- t0 Q/ F; p* g5 N
                    #向量,输出层对隐含层的权值的偏导
    ! Q, H& [3 u2 v! G$ a                FW<-pFW2<-pFW2t_1<-0;
    ' B( g; ~( t, d9 x: h                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    - A4 T1 W, k# |                for(t in 1:J){$ {' z: ?& C4 ]  h! ^0 e# b" L+ V, l+ e
                            B3<-b[t];. ^0 p7 k; j1 Y  a$ S
                            FW<-FW+B3*B3;#标量
    / L! {2 L1 J* B; _9 W                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    9 s  a& I9 Q7 V2 g% O/ Y* w* i+ b                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    ' \+ H) R. V, ?3 w2 _                        if(t==1) v<-v-0.5*epsilon*pFW2
    $ L+ V4 ?# |$ A+ I( f! S% t1 t                        else{
    , m7 a2 b$ i9 V                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    " J' B3 i. h/ U: z* N/ p) n                                pFW2t_1<-pFW2;9 P; T' i  o1 p$ z# m
                            }
    # l7 T- e2 B. ^8 M* T                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连' V8 @. _7 o9 w
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导! _" {; x* W  [  h. d* r$ e+ o
                            if(t==1) w<-w-0.5*epsilon*pFW1# x9 Y# `6 Q5 L$ b4 t' {
                            else{
    2 P  \* `* [  Z! Y; e                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);/ [& L1 [8 o5 x# I9 s2 H/ x
                                    pFW1t_1<-pFW1;" J, S) Y/ y" c
                            }1 T$ v0 k  r, q  R. k
                    }
    ! F$ o% L, G) _1 L( c                N<-N+1;! p+ J) N9 u+ ~3 O6 q) @9 }6 Q6 I
                    ei[N]<-FW/J;
    3 d2 t  X! w8 \9 L. S! j5 c: k$ ^% c        }
    " L2 e* E) i# E4 I        theta<-w[nrow(w),];#隐含层阈值
    ; R8 M: X1 i; i% D  [        gama<-v[length(v)];#输出层阈值
    ! I- V, b) K8 V0 {6 R7 U8 Y* }! e        w<-w[1nrow(w)-1),];#输入层对隐含层的权重% m( o6 X! {# B0 Q2 S! t
            v<-v[1length(v)-1)];#隐含层对输出层的权重
    5 y1 g2 [$ ~: H        list(theta,gama,w,v,N,FW/J,ei)
    2 a3 t! x1 X; J$ Z& \% _}
    / ]) f; `* P) n; g, ?' Q5 Gx<-cbind(x1,x2,x3,x4,x5,x6,x7);
    8 I# Z( Y0 e8 y  tx<-t(x);
    * s9 a: T/ E3 |0 i/ uhidden_threshold<-runif(11);
    1 Y: ~+ c; Q& x2 z" k6 Aoutput_threshold<-runif(1);8 ^1 u8 Q2 m/ ~+ P% n# A' B+ P
    w<-matrix(runif(77),7,11);
    1 {/ G9 [" b7 x' O: sv<-runif(11);
    : F, q" m0 }5 lresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);5 g; c2 A! g% F  t' T! ~+ C3 Z3 L
    #输出
      g7 q+ k2 a: u' g2 Ncat("\n");2 x& j( b7 s0 X, a* I, y
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    ( H* T8 s7 q9 _$ T1 i; q" M5 m' F( g: Mcat("输出层阈值gama","\n",result[[2]],"\n");
    / P: T0 Q. I2 I! b1 fw<-as.matrix(result[[3]],7,11);
    * `4 U* ?( Q7 q2 O6 a( Ycat("输入层对隐含层的权重w","\n");" w. e$ N% l' `) R0 N+ _
    w;
    & P( v, b0 Z" R5 f% L; E% ecat("\n");& i3 |& ]8 g4 I& D
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    - \0 A! ]& b& N$ Scat("迭代次数N" ,"\n",result[[5]],"\n");% r, T4 k3 J8 ~
    cat("学习误差FW","\n",result[[6]],"\n");8 T6 b" s. Q9 y" Z' ]
    cat("每次迭代的误差","\n");" U, [2 P7 v# H  W/ z
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    , v/ E* V6 x# o5 W) `proc.time()-ti
    / r- t& l0 e4 `$ f" X
    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-11 14:35 , Processed in 0.446493 second(s), 80 queries .

    回顶部