QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18838|回复: 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()3 s, [/ b! }) j$ K; m
    BP_one_output<-function(input,output,m,fth,sth,w,v){
    ' k( l/ U6 Z5 g. P5 J        x<-input;#7*86 O* L, I: u( L
            y<-output;#8*1,y为向量,每一元素为一个样本输出值) }& V: M; C  Q/ P
            theta<-fth;#11*1
    ; ^5 H$ I! x: f- c4 U. X1 V        gama<-sth;#标量% Z, V6 F8 u3 a; Y2 x, b! v5 |
            if(m!=length(theta)) print("阈值长度错误!")1 L3 h' x8 b; U% g+ _. v+ _
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重& o  X& K: E2 e- y
            K<-nrow(x);#8一组样本的维数5 ^! x% l2 `3 c0 K2 ^
            J<-ncol(x);#8一共有多少组样本. w5 K5 j2 V/ K" ?9 D: S# n+ c
            w<-rbind(w,t(theta));#由7*11变为8*11, F% @. @+ V: N; E* }7 y
            v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接9 U) R9 P; }6 a" r/ V
    #定义函数f7 I. i; @: B9 Q) U4 u- _
            f<-function(h) 1/(1+exp(-h));
    1 T+ m, c8 S; v  D5 {( g        epsilon<-alpha<-0.5;# w: {* j5 E( R9 N1 i! x# l
            N<-0;#重复学习次数的计数
    % h" n8 h8 q* |1 Y        ei<-as.numeric();#记录每次迭代的平均残差平方和
    $ s$ w( N, [1 v5 m! ?        FW<-1;% _8 X) B/ V, A: `7 K" L" i
            while((FW/J)>=0.001){
    7 N" X$ J. g5 K% X: _" F6 O; P                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    2 K( U5 @, M1 m2 E: r! P" x                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, ) w3 k4 |2 b5 y# K! z& [
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns7 c5 _. P7 o' q& O2 n5 S" o2 ?
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    " u' w2 C! h% d1 @7 x) ^4 E, b0 [/ d                D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    ! {# {" R$ {+ H1 C6 G5 V                b<-y-D;
    : i9 c+ l9 f* O, |: n8 P) m                #J组样本的学习
    . B$ J+ D1 X) d0 y7 a3 e                #向量,输出层对隐含层的权值的偏导
    - j: j- \& d6 I5 M: r                FW<-pFW2<-pFW2t_1<-0;# A& K6 K" e8 x  M
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导1 Y' Y. W, k! B. T" T
                    for(t in 1:J){
    " Z& ]7 e; L0 X$ e! i9 u                        B3<-b[t];
    + K" g4 u" K' Z2 l2 v% \! T                        FW<-FW+B3*B3;#标量2 E9 j$ g9 l* u" z5 w3 l
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量/ L7 C8 `$ n* L; x5 L
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    1 `/ e7 l3 t, S- s% M                        if(t==1) v<-v-0.5*epsilon*pFW2
    - x6 Q! V5 Z  W0 J                        else{' ^7 k5 h( x& ~. o  y$ V- I) d8 C
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);4 b! x0 O! L1 s/ t: Z6 ^3 y
                                    pFW2t_1<-pFW2;
    " T8 k+ [9 i# U- V1 c6 m                        }. ^  X7 r; t' n; C' t
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    5 L4 ^9 o- n8 J) ^                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    - \: C, J7 D+ i$ @# k$ {( }3 s                        if(t==1) w<-w-0.5*epsilon*pFW1
    5 q$ k7 g" x( f. K$ ~& z                        else{5 f2 [- z% r* x2 j; I- Y
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    5 Q) N" m4 n4 t  M! d3 n                                pFW1t_1<-pFW1;
    : ~, g. n" g, ~+ C) }- ?                        }+ c% Q) X2 ^& s7 f8 S- V) Y! l( B
                    }
    5 U( u6 ?2 j1 t; i                N<-N+1;
    / u  h: R$ j. }0 U                ei[N]<-FW/J;1 a0 \: K. v2 ?  @4 o4 G- X8 m% d
            }# c7 P( D7 _* k& `
            theta<-w[nrow(w),];#隐含层阈值
    5 R1 C" [6 i' Z" P" p* z# R$ z' a8 @        gama<-v[length(v)];#输出层阈值
    4 u  J! x* \6 W- q        w<-w[1nrow(w)-1),];#输入层对隐含层的权重4 x3 @; _- B1 H9 B' V7 ]# Q
            v<-v[1length(v)-1)];#隐含层对输出层的权重
      M2 B* D7 U. e1 T) [        list(theta,gama,w,v,N,FW/J,ei)
    4 u7 n; l5 Q( Q1 t+ o}
    ' o/ s, L' I- }6 ^1 O/ j' d: R/ mx<-cbind(x1,x2,x3,x4,x5,x6,x7);6 `5 b' F2 O; f% B/ J1 y* v
    x<-t(x);
    ( A+ Y- R8 G# [9 _) L0 b9 [( Thidden_threshold<-runif(11);
    7 z( n7 E" L) w; Z$ k4 r  ]output_threshold<-runif(1);. M5 p( D- h6 Z
    w<-matrix(runif(77),7,11);& u  G5 J+ A7 ]- ^8 D
    v<-runif(11);8 ?) B! h' Q6 B
    result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);' ~7 I1 n8 x- U5 m$ D+ c/ y( Z8 r
    #输出# t% T# e1 ~- f4 ~# S, b
    cat("\n");0 `) Q7 G4 n. }0 o/ c! |$ x9 a0 M
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    9 `; ~% A8 @$ m0 lcat("输出层阈值gama","\n",result[[2]],"\n");( c- }0 j9 H( b: n2 j( M4 }6 Z' C
    w<-as.matrix(result[[3]],7,11);
    : A) s! N" |9 `* Wcat("输入层对隐含层的权重w","\n");
    ; x5 Z, v" ^- A" X3 n* K$ f* @w;- [1 u: I6 l5 v: N# p% Q
    cat("\n");
    1 ^: g5 s4 I2 b+ w( K. @cat("隐含层对输出层的权重v","\n",result[[4]],"\n");: x, ~/ Q, O" ^; F
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    0 G# {. c% A8 j& @' W: U2 Lcat("学习误差FW","\n",result[[6]],"\n");
    0 U  a7 P9 o8 F7 ?cat("每次迭代的误差","\n");/ h% s" s0 P/ d; i  u& f# m# z
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");6 W7 X- g8 W( ^* O4 H9 p% w
    proc.time()-ti
    & g, V9 S: N1 a& Z9 X( b2 I/ I& g
    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-11 02:53 , Processed in 0.370594 second(s), 79 queries .

    回顶部