QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18830|回复: 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()
    ) s$ U: S! A1 q& T" n0 dBP_one_output<-function(input,output,m,fth,sth,w,v){
    3 S7 }; S3 Y! n; V* m9 h        x<-input;#7*84 |2 {4 \$ B+ e3 E: U2 j: |- y% r9 o
            y<-output;#8*1,y为向量,每一元素为一个样本输出值
    1 \* n/ W- @. ~( T( [( b9 m        theta<-fth;#11*1
    0 i2 ^( X5 p: k' G7 K$ y# q0 H" i        gama<-sth;#标量
    + l, B8 e1 l  Z* b        if(m!=length(theta)) print("阈值长度错误!")0 O- V" p5 `: q& S9 O
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    6 P; k0 x; L) c# {. F' c        K<-nrow(x);#8一组样本的维数
    ( |; g2 n" Y/ q* b0 j- S/ J$ p) G        J<-ncol(x);#8一共有多少组样本+ [9 t, l7 X) P# I3 h
            w<-rbind(w,t(theta));#由7*11变为8*11
    ) r# Q2 `; F' g# ~+ o        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接8 B* o1 G1 f5 f$ @# G1 V; K
    #定义函数f! z* s. s8 Z( Y" j% }0 n6 [
            f<-function(h) 1/(1+exp(-h));
    $ M: K! G% D. e0 W        epsilon<-alpha<-0.5;
    1 ^6 x6 ~* F1 ^% I1 H        N<-0;#重复学习次数的计数* c9 q1 m/ O2 R7 p
            ei<-as.numeric();#记录每次迭代的平均残差平方和& l3 Q- n; v& Y# J/ B" W0 o' e7 \) K
            FW<-1;3 k& y2 ]' f# C+ F- n' X- C8 l( L
            while((FW/J)>=0.001){
    ( s$ Z. e/ G" Z6 r2 {/ {6 }                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    - Q7 e  f3 P6 b                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
    + l! h1 D, ]9 X                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns; }$ a+ |' y" p# w
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
      g; D  [  Q6 c( T5 T1 [* }0 z4 Q                D<-f(Z2);#向量,每一元素为一组样本的一个输出值/ w! W4 T6 g- O6 |
                    b<-y-D;; C  V- H" X" r4 d% U
                    #J组样本的学习/ L9 X. `) K7 \6 y- r
                    #向量,输出层对隐含层的权值的偏导
    7 A0 |: k4 X1 i& C2 ~! C                FW<-pFW2<-pFW2t_1<-0;* u8 D) c  X: Y2 W! D9 M* F% f
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导5 i) ?8 Y) [. J' ?9 v1 u
                    for(t in 1:J){4 b% s) I1 {) i
                            B3<-b[t];
      c1 u5 a! Q$ z1 q$ |& z+ E0 w                        FW<-FW+B3*B3;#标量
    " i/ w: p- P& k, ]- N# Z                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量: y# D( l7 o+ w& d: t9 F+ B3 o
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    - c9 p7 G) D# o' U6 r                        if(t==1) v<-v-0.5*epsilon*pFW2
    5 Z4 q8 d! ?6 q( u                        else{& R8 D* L% X! z
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    1 P+ C  I. r/ f2 Y. B6 r7 x                                pFW2t_1<-pFW2;
      v9 Q- F0 T; d                        }
    % F7 K* t8 k7 c$ _; u                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    7 a: E2 ^. l7 i- N' o: m' r9 w                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导2 K" l+ R+ g/ x% C
                            if(t==1) w<-w-0.5*epsilon*pFW1
      C; Q9 k( k! U+ j                        else{, L8 k# D$ y, u6 ^; ?
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    9 S( p/ U% Y4 r. ?- Q$ Y( \                                pFW1t_1<-pFW1;
    6 ]5 J, n9 Q2 J0 e                        }. h4 N6 V! W9 [1 m
                    }
    ! O% g8 {$ |7 }( ]$ o                N<-N+1;
    # [/ h+ m- h- C2 S                ei[N]<-FW/J;
    7 D0 V* Z! R6 H9 O( A0 t( Y        }7 ?( w" \) ?# E7 \$ o
            theta<-w[nrow(w),];#隐含层阈值
    ' |7 D6 [( i0 r) {; v6 |        gama<-v[length(v)];#输出层阈值) H6 X2 I3 G8 A  n/ N8 l
            w<-w[1nrow(w)-1),];#输入层对隐含层的权重
    6 ^$ n  }/ [' U8 x4 O, F        v<-v[1length(v)-1)];#隐含层对输出层的权重
    , S# B8 ?; f1 H" l! y: N        list(theta,gama,w,v,N,FW/J,ei)
    9 h8 ~: \- r0 R  |5 U# z; a8 [/ ?}
    : ^% Y3 V) p5 U! v* Vx<-cbind(x1,x2,x3,x4,x5,x6,x7);
    1 k: D8 _' Z1 g' M$ D. a. O* g3 tx<-t(x);
    ' _( a1 m6 Z. e9 C8 o, m" p+ {hidden_threshold<-runif(11);- L! a: y% o9 I
    output_threshold<-runif(1);. ~5 h- A# W6 {- t" |- ]2 w1 Q$ ~
    w<-matrix(runif(77),7,11);6 r0 d6 x8 z* w. h) z5 ]. N1 K/ e4 O
    v<-runif(11);
    2 L4 G/ J+ _& l7 c0 S; q& yresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);) }9 Q6 ^  a8 s( y
    #输出
    ' r, X6 A+ D+ U7 L. xcat("\n");
    & G/ Y8 B2 c- e: G4 scat("隐含层阈值theta","\n",result[[1]],"\n");
    / ^8 p0 _0 a1 m; [; ?cat("输出层阈值gama","\n",result[[2]],"\n");( Y( @: H3 N. l& f4 t7 T" N$ ]' d
    w<-as.matrix(result[[3]],7,11);
    8 S+ D$ Y5 a% f# Ocat("输入层对隐含层的权重w","\n");
    " F% c- X. T9 _w;! [. h2 \" h6 j$ ?6 n- D9 d6 {. l
    cat("\n");* B9 G5 F* H9 B2 Y& y% P
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    1 a0 \  A' d* Ecat("迭代次数N" ,"\n",result[[5]],"\n");/ g4 y" d/ m& H
    cat("学习误差FW","\n",result[[6]],"\n");
    7 e- H' p. w( e6 o. q) O: Ccat("每次迭代的误差","\n");3 f! N' L* N$ \4 [+ t
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    ( `4 H6 a3 M# j" rproc.time()-ti/ z& d  ]) y" n: z" e6 v. p' z
    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-10 04:14 , Processed in 0.465900 second(s), 80 queries .

    回顶部