QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18787|回复: 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()8 w* Q1 W8 f  E! O( `8 y; x
    BP_one_output<-function(input,output,m,fth,sth,w,v){$ D8 M9 n- |5 d7 h2 k  {+ M8 g/ c7 \
            x<-input;#7*8* P2 D3 G: D8 J
            y<-output;#8*1,y为向量,每一元素为一个样本输出值
    4 d  D& r! Y6 _+ s        theta<-fth;#11*1" s) D( n; ^, J1 f3 D
            gama<-sth;#标量
    . _" q/ [  ]( {- T$ J        if(m!=length(theta)) print("阈值长度错误!")
    5 ^+ A! d- v7 h$ ^( E/ V; Q        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重" A0 L$ k! m5 o: N$ y/ M. o- _/ v
            K<-nrow(x);#8一组样本的维数$ a6 y+ J" Q$ B& J- J; x6 W* C- C
            J<-ncol(x);#8一共有多少组样本9 ?: D1 ?, I+ t% n" H
            w<-rbind(w,t(theta));#由7*11变为8*11
    * y- ^9 K- [' ]( R8 {        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    $ X( o0 K% u# [. p#定义函数f- O/ \2 Q  i! z% W; K
            f<-function(h) 1/(1+exp(-h));5 {. ^, p% M; k6 W. |" P
            epsilon<-alpha<-0.5;' R; K$ N: m! x4 G# N' _) a7 L( m
            N<-0;#重复学习次数的计数
    ' F4 z, ~* k1 T# k3 V        ei<-as.numeric();#记录每次迭代的平均残差平方和( c+ i5 ?- }1 _" X) ~
            FW<-1;' n2 q$ f5 ?' _8 Q- e
            while((FW/J)>=0.001){0 @0 m4 c' _7 c. F1 L) L! m) X
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本: E  f1 s9 ]% t; g: m3 L. Y1 _$ W
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
    ; H* C- ?0 Y- E* }# |; ]( N                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns
    , W$ ]& z6 M# A. n9 L& V# {                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    & h" H9 P4 e4 k% Y( r& ^/ N( I  t0 K* m                D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    + t5 o( S0 O! {/ ?6 f0 ~                b<-y-D;
    9 Y$ l; m; L* X6 G5 }; _$ S- v+ U% N                #J组样本的学习
    3 z5 O9 g3 d7 x) V, H  t                #向量,输出层对隐含层的权值的偏导- v, f* t1 E  Z0 ]* K6 s' F; R
                    FW<-pFW2<-pFW2t_1<-0;
    6 z- i- ^, Q6 M                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    8 S/ |5 A* [( x+ d2 l! b% j                for(t in 1:J){
    3 K- ^& u$ n8 C+ i2 l/ ^                        B3<-b[t];
    8 m& l% T- X, D& p" `                        FW<-FW+B3*B3;#标量& h' n/ w0 m6 o6 V* y$ P
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    8 G8 a$ j; v& m2 ^* ?0 e1 i$ S                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项. y( o. K3 n; I; Z* M8 Z( K
                            if(t==1) v<-v-0.5*epsilon*pFW2
    4 N: h' z7 g, y: T, d6 E  l, t                        else{& e! Z% t. z! P/ ?, D; U
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    4 E% |& E8 b2 M' m( q- p                                pFW2t_1<-pFW2;+ K) J8 O$ L" q& |
                            }
    2 j- r! F/ X5 H3 T                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连" t9 K! A4 V& ~, D' U% C
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    , U% g3 n3 w3 [( Y                        if(t==1) w<-w-0.5*epsilon*pFW1
    0 G" R( a. S6 Q, g* x                        else{
    6 a2 [4 u# I2 ?1 O8 q/ W. C                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    / }3 b7 X  p' H4 Q0 |" O5 _2 ^                                pFW1t_1<-pFW1;
    7 h. J# `5 e& G  s2 q& S                        }1 ~9 s% ?  f0 I; s$ Y6 |! m/ ?
                    }3 X" U: o4 w6 W# }
                    N<-N+1;' m7 t  l, T8 J- q( a- J
                    ei[N]<-FW/J;; Z5 ?: |$ t9 s' Z
            }
    ! z+ H8 L: I+ ]2 J% Q        theta<-w[nrow(w),];#隐含层阈值
    " y6 i" {3 f) }: P        gama<-v[length(v)];#输出层阈值
    . E, V4 D: X+ k6 `- J& R        w<-w[1nrow(w)-1),];#输入层对隐含层的权重9 A* S* B. _# [" Q( z+ [0 v
            v<-v[1length(v)-1)];#隐含层对输出层的权重
    4 k# l# H& F6 _: A5 T# O        list(theta,gama,w,v,N,FW/J,ei)
    " X- b6 ?2 X7 V+ E}
    ; |) D7 {: `) e! S2 c& ?1 cx<-cbind(x1,x2,x3,x4,x5,x6,x7);
    ) w9 X  W% _. s( y: M6 ]* hx<-t(x);
    / [  G3 _6 R4 B' x. khidden_threshold<-runif(11);7 H" n! @# S$ |) @1 L" t$ @* J
    output_threshold<-runif(1);3 Q6 v* w" P/ @, @
    w<-matrix(runif(77),7,11);8 v6 K6 R0 {+ J
    v<-runif(11);
    : u( W4 e& C* u5 gresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);. G4 s3 Y* [% X/ x/ t/ e! B
    #输出
    6 i! P0 s: A6 ?/ e! Z2 \; vcat("\n");; [. i* N; {6 G) W' D$ w% {3 e
    cat("隐含层阈值theta","\n",result[[1]],"\n");4 a$ ~3 S. {% H) ^
    cat("输出层阈值gama","\n",result[[2]],"\n");
    / P1 o/ a7 j7 s1 s0 m( Mw<-as.matrix(result[[3]],7,11);
    6 W* X0 [' L" z# `% Y5 Rcat("输入层对隐含层的权重w","\n");
    0 @# j- `* ]' u% t. ]w;
    ( n+ `/ d' H9 T% gcat("\n");
    % u/ G3 D" h2 q; v3 j# H; Vcat("隐含层对输出层的权重v","\n",result[[4]],"\n");7 Q  s* S3 ?9 E9 z8 u
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    - d9 W- G! }8 t, n; ~0 P) D7 Y3 ccat("学习误差FW","\n",result[[6]],"\n");
    6 J) s6 {6 N( B3 a& o; x' E" Pcat("每次迭代的误差","\n");) w: y0 ?' K! O9 ?
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");  Q) U1 Q1 }. y1 O$ |/ D) |) `
    proc.time()-ti
    ; |3 R2 P/ U+ F) j4 t, ^
    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-25 20:29 , Processed in 0.493849 second(s), 80 queries .

    回顶部