QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18837|回复: 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()
    + y  W/ i$ z; r' L4 H/ p" LBP_one_output<-function(input,output,m,fth,sth,w,v){( U. ]# {) t# O' t
            x<-input;#7*8
    7 ]. |9 h: P3 c' V9 \2 u5 K- e        y<-output;#8*1,y为向量,每一元素为一个样本输出值
    / }9 L$ ]# Z# o, ~) b$ k  P4 n        theta<-fth;#11*1+ {% p% u% L4 N: x& C3 a
            gama<-sth;#标量2 B' p5 b, A( K: Q4 V2 Y
            if(m!=length(theta)) print("阈值长度错误!")
      c& S, J& t, {' o        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    3 p4 z. v: ], i  q# J        K<-nrow(x);#8一组样本的维数& J2 E. ^) V$ }) [# n4 {" U
            J<-ncol(x);#8一共有多少组样本
    * k5 ^0 R* [! p        w<-rbind(w,t(theta));#由7*11变为8*11
    5 C$ r) \+ f- b( M        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    ' s' f& k. r& `' P7 v#定义函数f
    ! E6 [% o' ^( L; T) C1 l+ V0 I- F        f<-function(h) 1/(1+exp(-h));
    % D& z/ n& f; D! e" m3 w$ y7 S5 f1 W        epsilon<-alpha<-0.5;
    6 o' O' [9 F  S& X9 B2 t# P! ]: o        N<-0;#重复学习次数的计数( p; I4 r$ I  ?4 u7 H* A
            ei<-as.numeric();#记录每次迭代的平均残差平方和
    9 w$ ]5 W  k5 G0 w7 _        FW<-1;3 L* O- ~, W- s6 U3 d
            while((FW/J)>=0.001){- i& v. y4 F: l9 h* x) S2 y
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本& d# g8 b2 o* l  _2 C2 ~( b
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, & w, A, m7 k! r: m. g4 O4 T
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns
    : X1 Z& n) d! h& a                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值7 h# U" U3 |$ X; I2 \( V8 s
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    7 e2 ?  B, b4 l+ R4 z6 [                b<-y-D;
    9 E4 Y* k7 g  h4 K                #J组样本的学习3 ~( {% ~5 ~8 |3 \! R) `7 d+ @$ S
                    #向量,输出层对隐含层的权值的偏导
    9 D- l9 q2 b) O$ D                FW<-pFW2<-pFW2t_1<-0;8 w8 B* L7 p0 r6 {+ E
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    * U4 D' h: s' @& i! r2 @3 l& T                for(t in 1:J){3 b/ D5 L( V# {6 h8 P
                            B3<-b[t];* }$ E+ P# d( S! B
                            FW<-FW+B3*B3;#标量7 [; r( ~5 C2 Y0 ?9 c) Q
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    ) v: S% ?& t$ I. [& r                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项4 }5 [8 P) j( W; |% Z+ S: `
                            if(t==1) v<-v-0.5*epsilon*pFW2
    - D4 p/ h: N4 L; N) E- f                        else{% s4 N9 ]- h! i: [- {) Q# p
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);5 n/ e) Z1 j5 X4 ?  X" @
                                    pFW2t_1<-pFW2;
      o* d+ O5 v6 x, f                        }
    ( N/ g. r4 L+ {9 ]                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
    * f# t; X' P5 D8 C0 @* s& J$ H. ^                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导, \5 l* f2 ]/ x+ D. E0 k! \# I1 P
                            if(t==1) w<-w-0.5*epsilon*pFW1* m& D! }3 k& n% I4 \2 Z+ Y
                            else{
    ; g# d2 M) o1 L                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    ( X: o& w( U# R  ^  ^6 ?                                pFW1t_1<-pFW1;+ X. @  O, H9 Y. C* |+ [3 [9 y1 L
                            }
    : H0 t) }% V' j, J                }7 W6 @* |6 X$ m- Q3 z. q
                    N<-N+1;
    ' R7 j# Q1 q* O% M                ei[N]<-FW/J;
    6 Z% ~1 H# b* B! b7 k2 Z) b; d        }
    " F! e& N/ H. U# n& I+ |        theta<-w[nrow(w),];#隐含层阈值
    / v* l* {# v3 Y/ V        gama<-v[length(v)];#输出层阈值
    4 _) A! G, Q4 N- R        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
    / \, Y7 ]/ P' H5 M; w5 U        v<-v[1length(v)-1)];#隐含层对输出层的权重
    & _, m) p8 a) Y! k        list(theta,gama,w,v,N,FW/J,ei)) N6 B* ~1 J( h0 r
    }! h2 O1 I9 t: m% g. [
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);5 w. M) x1 y. ]2 F; d" N
    x<-t(x);4 p. e/ @6 n/ ~" W
    hidden_threshold<-runif(11);
    3 q, e6 v0 P2 M" Foutput_threshold<-runif(1);( m* I$ a% {2 L) C3 c
    w<-matrix(runif(77),7,11);
    6 r% d+ I4 ~, Q1 L7 M, E) Ov<-runif(11);2 B7 Z. K* A: P$ v, U* o
    result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    : i8 t7 f- E' d+ _% ^" _+ F#输出
    ) U" ?/ w4 b3 `  _6 acat("\n");
    + v! t( g7 a' m' [$ Q( scat("隐含层阈值theta","\n",result[[1]],"\n");$ @0 u" r6 ]2 r
    cat("输出层阈值gama","\n",result[[2]],"\n");/ O, i4 c  ^: w" i, [2 P% ]
    w<-as.matrix(result[[3]],7,11);7 E" R: C8 P; d! O
    cat("输入层对隐含层的权重w","\n");4 n% f# _4 D2 y- Z
    w;
    7 C; r, h$ Q! @, f2 Vcat("\n");
    " Y- \1 ~+ P2 j2 U3 J: Pcat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    / y/ F8 l: J+ u/ Kcat("迭代次数N" ,"\n",result[[5]],"\n");: \* j; y  H! F: U. C% n$ V
    cat("学习误差FW","\n",result[[6]],"\n");9 m/ B. \( m0 {
    cat("每次迭代的误差","\n");* p& Q, m1 r- M6 g  p5 ^# M
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");; E* [3 [8 [( ]0 j8 S# D/ D
    proc.time()-ti( _8 p3 y0 |" T0 s  p
    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 00:23 , Processed in 0.310110 second(s), 79 queries .

    回顶部