QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18274|回复: 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()
    " v% n; a4 z- g4 `9 I9 p# d: kBP_one_output<-function(input,output,m,fth,sth,w,v){* e, T$ ]: @. d) }8 ]1 v" a
            x<-input;#7*8
    ' ^5 j! C( k4 b, J7 b$ _. z        y<-output;#8*1,y为向量,每一元素为一个样本输出值2 D0 G2 ~& |2 W/ t8 c* {( S8 U
            theta<-fth;#11*1
    % @2 V) }: [0 L        gama<-sth;#标量: Q  O9 e5 d7 C
            if(m!=length(theta)) print("阈值长度错误!")
    1 Y7 k' C# Y& d# i        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重4 q" u. M) G% z! [  {) _+ J4 A. k
            K<-nrow(x);#8一组样本的维数9 I4 j) g/ `2 \5 q2 {" E/ t
            J<-ncol(x);#8一共有多少组样本# z5 K  b* I% ?: W. {7 a) o
            w<-rbind(w,t(theta));#由7*11变为8*11
    * G$ ~) i) T, w9 s1 R& @        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    6 k$ L5 g3 H, h9 a- I#定义函数f* t4 |! n4 L  X9 ~: Y( M4 O- [
            f<-function(h) 1/(1+exp(-h));
    % M* r8 @7 Q0 }: I7 N1 g        epsilon<-alpha<-0.5;% D$ u' k9 ], q+ ]  N  @. \
            N<-0;#重复学习次数的计数
    ; U5 M/ a: o6 E$ m        ei<-as.numeric();#记录每次迭代的平均残差平方和9 n* Z, \% M# X7 l4 z
            FW<-1;6 z- G( V: @7 u# {# o& x; P; v
            while((FW/J)>=0.001){
    4 X' U5 n3 k7 x: s$ r4 _  j                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本# [- _- q- E7 A* e/ O9 L' M
                    Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, ( Y/ ?; I, ~, w9 C! Z
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns% e* r4 w7 A3 L
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值
    5 L% s* C- a' r& {# W/ g! A                D<-f(Z2);#向量,每一元素为一组样本的一个输出值8 H0 h& @! M# L: J( U' R. K' i- S
                    b<-y-D;
    1 Z& _; R* }1 s                #J组样本的学习
    * S1 c! K4 N% n5 K$ o( k. M" L6 B                #向量,输出层对隐含层的权值的偏导* Y# b+ B5 ^4 V$ M, D: g$ P
                    FW<-pFW2<-pFW2t_1<-0;
    * O% U* v* w. Z5 ?. u8 _% q                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    5 y6 O' z( c8 Y! _                for(t in 1:J){
    , ^( G* v9 ?9 v7 S7 T5 f                        B3<-b[t];# i" A6 ?) q  B8 J
                            FW<-FW+B3*B3;#标量  g% g& U+ Q& g. Q
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    , @* T4 o/ C; H, `$ i                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项+ M& H' [8 o7 `. s5 h
                            if(t==1) v<-v-0.5*epsilon*pFW2( X+ D4 P3 V3 O( Y
                            else{+ s* b! C+ P6 O; E5 G$ c, M* R7 r
                                    v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);8 c, p/ p5 A8 C, ^! L
                                    pFW2t_1<-pFW2;( G0 l$ y; G0 d' V+ R
                            }2 J' \  M0 U* ~+ ?, P
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连+ Y# x6 h: _* z( N) Y3 X! {7 E% B
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导: m* w. _- {, y$ s# @1 g
                            if(t==1) w<-w-0.5*epsilon*pFW1
    - D! v7 U4 K" k  G2 d                        else{( v: b' t4 c. [
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);( f' {- y$ ~+ c3 B  K
                                    pFW1t_1<-pFW1;
    $ x- u" N+ n  d/ I                        }
    0 c; u' N  B3 E4 w7 B                }
    / B8 U+ _, r, [8 u                N<-N+1;6 _  F9 R0 e( s# p$ {3 t
                    ei[N]<-FW/J;
    - i: P4 g+ g) d+ z9 \: Y        }
    / B; N4 t; c4 j% T2 C# B5 U; s- T        theta<-w[nrow(w),];#隐含层阈值  ~& o$ U- @. q  ]' ~( `# D2 k+ z
            gama<-v[length(v)];#输出层阈值
    1 L& y. L" @: Y# n! M) @7 N1 K. k        w<-w[1nrow(w)-1),];#输入层对隐含层的权重' N  i  b' ]: s2 J2 Z3 h' K
            v<-v[1length(v)-1)];#隐含层对输出层的权重& p2 A4 |3 d' }( H8 Q& P
            list(theta,gama,w,v,N,FW/J,ei)3 B7 D, Z0 V9 j' L
    }
    / m/ A; F# [$ j1 s. _$ Wx<-cbind(x1,x2,x3,x4,x5,x6,x7);$ o" X4 L; d: m
    x<-t(x);
    / g9 B5 P! t6 V- S; i% @% Whidden_threshold<-runif(11);
    4 _# D+ ^7 N1 L) Aoutput_threshold<-runif(1);& E* @! }. s0 L2 S4 t+ g
    w<-matrix(runif(77),7,11);
    1 p+ v: A$ [) k8 s0 ?v<-runif(11);
    # W' a) D+ H; iresult<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);3 [& |' @3 F4 W" c! K! z; u* u
    #输出( l0 i5 N# V5 J& y' Z" \0 {
    cat("\n");) f8 z8 b- {" I+ g0 u1 c. F( O
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    . x  B, X/ |/ }. @  ?/ gcat("输出层阈值gama","\n",result[[2]],"\n");
    + O$ F9 {5 X2 W  D8 Qw<-as.matrix(result[[3]],7,11);
    + [; E$ p; ?, {3 U" m* X$ vcat("输入层对隐含层的权重w","\n");
    ( G7 H# s: L3 ~, @( S6 E/ E4 aw;' t$ v# j3 H! F$ F% H
    cat("\n");- D) A1 _7 v1 j# ~
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");. R' e! J4 H( }$ x5 w
    cat("迭代次数N" ,"\n",result[[5]],"\n");
    : o/ ~* O2 A. B$ x2 Gcat("学习误差FW","\n",result[[6]],"\n");
    $ F- @$ r% }9 R5 q1 Wcat("每次迭代的误差","\n");
    $ f- x) n" g) R1 uplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");/ W0 z4 ?/ |4 S) H4 X
    proc.time()-ti
    $ b/ c' @+ U9 ~# n6 H- Q
    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, 2025-5-13 07:40 , Processed in 0.550649 second(s), 79 queries .

    回顶部