QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18759|回复: 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()
    / ]/ ^+ H' L* D! q2 C1 pBP_one_output<-function(input,output,m,fth,sth,w,v){
    & ?5 {" v+ I' A! G, J        x<-input;#7*83 l) R$ {7 L5 h; _/ n8 f  N: r- N
            y<-output;#8*1,y为向量,每一元素为一个样本输出值
    # W7 ]( w3 N/ C4 B        theta<-fth;#11*1* E- l$ K4 W# Y% ]  i% Z
            gama<-sth;#标量4 r: n7 R. [* O7 e# s$ b7 o# M- D
            if(m!=length(theta)) print("阈值长度错误!")0 N+ ]8 x: ~7 D! C& I' z
            x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    4 P3 l7 d" ~0 n0 O; x        K<-nrow(x);#8一组样本的维数
    1 y" j, l# T7 G8 x        J<-ncol(x);#8一共有多少组样本
    - @5 ]% P( d  W2 m$ `5 Q. W        w<-rbind(w,t(theta));#由7*11变为8*11
    6 C$ ?9 R% k% s        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接1 u+ Y2 V" ?; _5 F/ Q1 p
    #定义函数f( a/ n' F1 w  X0 C
            f<-function(h) 1/(1+exp(-h));! R0 I4 J$ Q- E/ t/ U
            epsilon<-alpha<-0.5;% B" p" w3 p! t; I
            N<-0;#重复学习次数的计数
    3 f2 u+ K* _: n- J' p2 ~        ei<-as.numeric();#记录每次迭代的平均残差平方和
    # ]9 o4 b$ A, m. p( r% L: ]+ o2 x3 w        FW<-1;
    0 B, `6 R$ M; K" J1 v9 O/ F/ g        while((FW/J)>=0.001){. ?, x* d- T4 Y- ]( ^; Q& _) ~2 N% h
                    Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本2 W. k1 R4 H' B0 B# o7 q6 e9 I
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, $ i# ]& |. I; K
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns+ h: A: E  @. s1 D
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    ( o* F1 a+ l( a& m  M5 g                D<-f(Z2);#向量,每一元素为一组样本的一个输出值
      L; c; `2 H8 B                b<-y-D;/ A* y' i0 A8 f
                    #J组样本的学习
    * b- q" N% x4 Q+ G7 ]: g/ B                #向量,输出层对隐含层的权值的偏导  j4 I+ i8 L* D- _2 [
                    FW<-pFW2<-pFW2t_1<-0;
    6 |/ ?; t/ {. p: W                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导6 Y# n/ w) {5 P* u
                    for(t in 1:J){
    $ ^3 P, x4 W) O/ v3 q: @                        B3<-b[t];
    - T- c$ U7 r2 U& J- r1 S) o                        FW<-FW+B3*B3;#标量7 k2 C, M0 f- D+ b% K' y3 u
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    , g3 n0 `& A; E, a                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    . Q' t7 M0 O* p6 ^! J. q! P  X$ I                        if(t==1) v<-v-0.5*epsilon*pFW2
    8 y0 x' o, l! N3 G  }                        else{
    : p  A+ Y& F% b                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    ! I' Q$ a) d! ?5 C                                pFW2t_1<-pFW2;% a7 G" B+ x7 c3 r' T: Y& y
                            }7 M% Y7 s; }$ F; K8 S
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连5 x7 p7 b4 S: W
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导0 h) Z5 p3 j* `0 P, X' u# ?
                            if(t==1) w<-w-0.5*epsilon*pFW1
    0 z# V1 m2 _* e- g0 q% _                        else{$ G: u4 J3 V% M# N0 ?
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
    0 P# p9 j" s7 M; @" J3 y5 j  {                                pFW1t_1<-pFW1;
      I0 D" t, m" z4 E: ~9 h5 B                        }
    + @: v* D- B# ^# o! ?                }$ v5 B+ I# x1 _' E7 H2 K
                    N<-N+1;
    / U# o4 C* ?; \7 T  k8 E                ei[N]<-FW/J;  L& k) X" E' F% ~7 P
            }* p+ P+ Q8 X8 b  X
            theta<-w[nrow(w),];#隐含层阈值: U( J: ?& k: {+ U+ _
            gama<-v[length(v)];#输出层阈值
    8 r. e, m" L* Y, E: q! l5 ~        w<-w[1nrow(w)-1),];#输入层对隐含层的权重( c  \; P% j/ S! S% r; C
            v<-v[1length(v)-1)];#隐含层对输出层的权重
    4 B% S) w% o: b  o4 D+ ]2 J3 \- b        list(theta,gama,w,v,N,FW/J,ei)$ w2 t5 E- v2 s! Q( v( c
    }' }+ `/ Z& T! r
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);
    . ]2 j, \6 `/ `! y9 Yx<-t(x);
    2 P. ]. O+ W9 B4 A+ ]8 ]% ?hidden_threshold<-runif(11);( N( Z9 X3 D- G
    output_threshold<-runif(1);
    & q. ~* ?5 R1 J5 ]2 b! F; Sw<-matrix(runif(77),7,11);
    + Y: H) J+ i" a2 ov<-runif(11);
    ' U6 K: L0 m; E0 ?result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
    ) u( d: R7 c2 p! }( G#输出1 l7 Y8 Y! C4 x0 |+ l) S+ U
    cat("\n");+ r$ _( _4 ]4 p( C( ^! H
    cat("隐含层阈值theta","\n",result[[1]],"\n");2 ^0 h) B. R) |
    cat("输出层阈值gama","\n",result[[2]],"\n");- X3 a. ]9 {( r- ]! n
    w<-as.matrix(result[[3]],7,11);
    , z, L* a: M9 d/ {, W8 u. hcat("输入层对隐含层的权重w","\n");
    ; V7 d/ q: I5 u+ j9 ~w;4 m: W$ j% p: w- J1 f' o7 m  \
    cat("\n");! |+ i$ j5 s9 b& }; p5 A3 y7 s
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");& q& @$ A) R' z! z6 F8 d% V
    cat("迭代次数N" ,"\n",result[[5]],"\n");7 g% m0 w# X( Y: m8 }9 K1 x
    cat("学习误差FW","\n",result[[6]],"\n");3 ^. i$ ]+ ]* d7 d2 R) t4 v& @& P
    cat("每次迭代的误差","\n");+ O) D6 v9 A7 i' @, n
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    3 o* h& q7 \1 @) g. Y9 s6 J  @proc.time()-ti# h! o" N: F% m8 |% u
    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-4-12 12:08 , Processed in 0.361139 second(s), 80 queries .

    回顶部