QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18999|回复: 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()
    + G7 ~$ X  n& G2 D$ w& cBP_one_output<-function(input,output,m,fth,sth,w,v){4 p% T$ n& j! j" C3 C* j# K
            x<-input;#7*8
    " ^9 g- Q9 a9 G+ F' g        y<-output;#8*1,y为向量,每一元素为一个样本输出值4 I; R2 h$ g  N9 u) E0 d' L
            theta<-fth;#11*1% C  p- g7 m& m+ R% H! b8 H
            gama<-sth;#标量  ?9 t: u. q7 @/ e
            if(m!=length(theta)) print("阈值长度错误!")0 k9 e' }' l) N$ T; x
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    ) u' A+ T; B$ _5 @" X( n        K<-nrow(x);#8一组样本的维数
    $ |, U7 T! w) @: {/ W        J<-ncol(x);#8一共有多少组样本/ y+ E, w( m' D9 _
            w<-rbind(w,t(theta));#由7*11变为8*11
    $ t/ l" m9 }" ?, {/ R0 M        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接6 C) F$ P  v0 I( F. l5 X, `
    #定义函数f
    ' |/ p  u% R0 M0 h        f<-function(h) 1/(1+exp(-h));
    1 o" X9 U9 q$ y# p8 K- V5 t        epsilon<-alpha<-0.5;# J( H8 @$ {# p) H. u: K
            N<-0;#重复学习次数的计数; {' N% R4 E  V: Q* T8 T$ N
            ei<-as.numeric();#记录每次迭代的平均残差平方和. a3 ~* F8 X" L/ p
            FW<-1;
    6 q/ j7 v. c) X9 T& @" A* u        while((FW/J)>=0.001){: _1 ?* B. d. E1 E0 e8 |! L! }4 k* Q
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    ) B7 r6 [% M* W" Y/ a                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, 2 x/ G0 h. y5 _
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns
    ( @6 F$ \. G  W: [* F                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值1 G# c  G/ N* B6 @' _
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值
      H2 R" n8 Y4 [! _% ?: d) k& s                b<-y-D;
    2 o: [) C; `$ C                #J组样本的学习
    : H% i( h9 C5 W0 R                #向量,输出层对隐含层的权值的偏导
      r5 U! N& X+ R                FW<-pFW2<-pFW2t_1<-0;
    " R! m# p* d5 r1 s                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    0 c0 @4 b) d3 X2 i- B2 p                for(t in 1:J){! v# p6 F2 t$ t7 Y- i8 E  N' ]+ l
                            B3<-b[t];7 B( u7 z0 ?' u2 s% C/ y+ w
                            FW<-FW+B3*B3;#标量
    7 m3 r0 ?1 C! ~( Z! Y                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    9 X& g2 n/ W8 l                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项: E4 d+ {3 j$ s. R
                            if(t==1) v<-v-0.5*epsilon*pFW2
    0 L* g, X& B2 r1 z4 |                        else{- Z3 j+ h/ a/ G
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    5 u" z- R4 I7 I8 }                                pFW2t_1<-pFW2;
    1 ?5 W! w$ {& |) J6 }% v9 R* o; @4 o2 _                        }, [4 b8 A) G# J5 L: k# k! O  U
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    5 k, \! i5 o$ p! C$ W* f                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导3 j* S  p% A6 ]( ]
                            if(t==1) w<-w-0.5*epsilon*pFW1; j& k6 H9 H9 M" R1 E8 p6 E* o# }
                            else{
      l( k9 s  o( F, r% M                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);  e# @8 J3 F0 y# @5 A$ [9 u) J* |
                                    pFW1t_1<-pFW1;
    ; Z4 ?& u  y. r: H# |                        }
    9 P4 x" O/ b9 m% `! i                }
    ( E% {  K! ~$ l% o# X9 P                N<-N+1;
    3 p8 m! V& P' b, }: i; D! O                ei[N]<-FW/J;+ u& J8 {0 Q# T# |- N" C. X7 l
            }
    " g* M2 d3 @" ~        theta<-w[nrow(w),];#隐含层阈值/ O: i8 ^: O1 X! I) \4 x
            gama<-v[length(v)];#输出层阈值
    3 l4 J0 F0 E/ @4 ]% p+ @- U2 W* V        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
    # |2 B+ n2 m! J2 T        v<-v[1length(v)-1)];#隐含层对输出层的权重3 ~* ^' \" r" y; g2 o9 A0 n. J) T
            list(theta,gama,w,v,N,FW/J,ei)
    ( x+ s8 Q2 f! Y# o3 d. {}2 w& ?1 M+ H$ T
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);/ q9 Y! X3 f- t7 M
    x<-t(x);
    : X/ k% D6 o3 ]! fhidden_threshold<-runif(11);
    / t! n% B9 f' B& Loutput_threshold<-runif(1);$ `1 L$ R  c  A: l0 b+ v  o
    w<-matrix(runif(77),7,11);8 }# x$ g5 F- p' `, f6 a0 _% n
    v<-runif(11);& G( d7 S' G( V" P* `9 {
    result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    $ U& b9 e) n/ P& L9 H0 M1 C#输出+ G6 a2 l6 R# x2 [  x9 G
    cat("\n");
    , I5 b' ?4 F6 C5 q" M2 V6 d7 T+ S" lcat("隐含层阈值theta","\n",result[[1]],"\n");! E) f1 I4 m- c; i4 K
    cat("输出层阈值gama","\n",result[[2]],"\n");
    9 \1 Q% R$ J9 R( kw<-as.matrix(result[[3]],7,11);
      [& ], ?' m; k/ {0 g) [% Qcat("输入层对隐含层的权重w","\n");
    / v! u: i# V5 p. Zw;
    . }9 }$ o- o7 Qcat("\n");
    - e5 `/ b+ Y: v+ r' l& l# hcat("隐含层对输出层的权重v","\n",result[[4]],"\n");0 ]5 Z3 ^( t% _3 w  j% \
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    / b* Q4 ^) A) W- ~6 }cat("学习误差FW","\n",result[[6]],"\n");
    + |8 U! R4 e- M: E1 w3 a" d- vcat("每次迭代的误差","\n");! K4 ^+ R5 E5 q% J
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    / T& X$ V$ V1 y$ O; P. `  B6 M* m9 e0 Jproc.time()-ti
    / y  e" ^3 Y9 I. [6 R
    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-24 02:36 , Processed in 1.870263 second(s), 80 queries .

    回顶部