QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18997|回复: 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()5 y& V! l! k9 Z
    BP_one_output<-function(input,output,m,fth,sth,w,v){
    0 {- ^; G2 z/ v# J: p        x<-input;#7*8! F* g$ s/ h$ S& S9 Z  P  g
            y<-output;#8*1,y为向量,每一元素为一个样本输出值* R& b& Z) A8 ]2 ^: G& n) e$ a
            theta<-fth;#11*15 S6 i( ~, L1 [6 q# p
            gama<-sth;#标量
    6 Q+ z: M4 A2 c0 f        if(m!=length(theta)) print("阈值长度错误!")
    ! o- I' Y2 X8 b: ^7 c: j        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    ' i. G, ^/ m( f6 O        K<-nrow(x);#8一组样本的维数% P  ~# }0 \# j$ s$ a. G/ N4 j+ o
            J<-ncol(x);#8一共有多少组样本
    ; g- v  {, S* b% }% A        w<-rbind(w,t(theta));#由7*11变为8*11# g" F" T) J# l% T( D5 ]- D
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    4 v  Z" N' A) z& B, ^. n7 I# C#定义函数f
    8 H0 i5 u, J0 w, Y0 ~9 `        f<-function(h) 1/(1+exp(-h));
    , J& o2 P/ g5 v/ ~        epsilon<-alpha<-0.5;
    ! |) I& F& e' [4 w8 o        N<-0;#重复学习次数的计数9 y/ e& j/ D3 I( T
            ei<-as.numeric();#记录每次迭代的平均残差平方和$ s- Q5 J& \3 b% _; D% j
            FW<-1;4 B* M+ N. v% y& o$ X1 ]' H% v' u
            while((FW/J)>=0.001){! P* m& C9 I6 U% F3 T( _" K
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    % ^) n& I. B8 I                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
    , ?3 {) b/ ?, Z9 t6 w: P2 g                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns0 h% ^, R# s; k) b, g9 d
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    9 d* q. T6 @" P' |: O                D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    / i# Y5 D) W& o- v) C( ]7 h                b<-y-D;
    - `  i  }2 p7 t8 L( p) `( R                #J组样本的学习
    5 W" ^! l! ], a: k                #向量,输出层对隐含层的权值的偏导) _6 A" ]2 w8 U
                    FW<-pFW2<-pFW2t_1<-0;
    # g; o: _$ i, j( \$ v$ Z: y                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导- l# L, _/ E5 ^+ b
                    for(t in 1:J){
    ; d; g- [% _3 W/ R" O! ]; M; @                        B3<-b[t];0 @. a, v! z3 j7 ]
                            FW<-FW+B3*B3;#标量
    0 M+ ]( o  x( `8 z2 Y3 `                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    - ^' I- B# G. T9 L' d4 [                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项; x1 ~7 g9 U# R) p( j
                            if(t==1) v<-v-0.5*epsilon*pFW2
    1 ]3 Q4 k5 _: W, e) D1 C8 r" \5 d8 @                        else{
    ( q" E4 u  \: ?6 \, n                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    * }. i$ l# L. b9 i& ]* e                                pFW2t_1<-pFW2;# M9 d& U% d3 q. b( i  W
                            }/ K, {/ y7 Q/ V- R* Z
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    + k1 t' F; z7 A                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    * D& P9 \7 v$ J! |* f0 k                        if(t==1) w<-w-0.5*epsilon*pFW1
    ! U# g: K  p9 t4 ?) ~4 o* ]                        else{1 I1 X$ W- {% Z( \% {
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    " M  M& q3 \( G: V6 D                                pFW1t_1<-pFW1;
    % H$ {# G& k4 E8 l" L                        }
    ( a# f) [- Z+ }" U                }
    ) ], |; c% C& J7 W: E  f                N<-N+1;
    ' X$ ], Z0 n. ^6 m                ei[N]<-FW/J;6 _* J% n$ j$ R) p
            }7 b1 b* j( _6 P- s% a- W' ?
            theta<-w[nrow(w),];#隐含层阈值
    % J( \% b3 ^7 `' E        gama<-v[length(v)];#输出层阈值. W1 K9 ]' O$ s. l- E- O; {6 f
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重
    0 }4 R5 t0 J% y) x* i        v<-v[1length(v)-1)];#隐含层对输出层的权重9 j$ n: t; `4 M( j
            list(theta,gama,w,v,N,FW/J,ei)
    , K3 S# I# ?  E}0 @6 G4 S& _. \1 t+ d. ?. b
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);4 z& v$ _  y7 I
    x<-t(x);
    ! c- T9 `* \5 e- ~hidden_threshold<-runif(11);5 E( b' ~7 E; F  B; R+ g
    output_threshold<-runif(1);
    : E. k' [& Z0 V6 ^+ d; C) @+ Yw<-matrix(runif(77),7,11);
    $ F8 R7 Z* o1 E% R6 _8 Wv<-runif(11);
    7 B6 U# `+ ]  N9 G! L& ~result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);+ O5 H1 h( R5 e* |/ |+ s" \. p
    #输出
    ; |. x* q" e0 Q# y. R  Z* Acat("\n");
    ( ^, E) K3 H/ X/ [! M- u9 Xcat("隐含层阈值theta","\n",result[[1]],"\n");% s8 q" p- T  Y* U$ ?, K# Q
    cat("输出层阈值gama","\n",result[[2]],"\n");0 c' P/ K+ I' y4 b
    w<-as.matrix(result[[3]],7,11);! C+ r6 J  [& u; n; R( P$ j
    cat("输入层对隐含层的权重w","\n");$ ?1 ~  v9 Y9 n6 d4 I4 B. _% _; f
    w;" z3 W0 B+ x* I7 e
    cat("\n");
    7 }. x' F1 g9 ycat("隐含层对输出层的权重v","\n",result[[4]],"\n");# ~- Q/ s! b! W* q' _
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    7 m$ W/ M" z! v2 @cat("学习误差FW","\n",result[[6]],"\n");* E% Z, G, S2 j& y3 B
    cat("每次迭代的误差","\n");
    & d6 b" H; A7 Q/ N) _8 B& r  F! Dplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    . n6 j7 n% \, N* b1 m& z8 x. t4 r; T, nproc.time()-ti
    ; p( t( o, Q3 G$ c+ q
    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-10-23 08:48 , Processed in 3.573723 second(s), 80 queries .

    回顶部