QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18881|回复: 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()
    0 K& u+ G; f5 p1 z* s# X% GBP_one_output<-function(input,output,m,fth,sth,w,v){
    # B/ }& D! ^6 X2 C; ^( L9 r        x<-input;#7*87 s# G% n8 a/ s* G, c
            y<-output;#8*1,y为向量,每一元素为一个样本输出值
    4 c; n: M% ~/ M4 t/ X# @        theta<-fth;#11*19 Z, `  q2 `5 x0 a  O
            gama<-sth;#标量
    ; d3 e* h$ t' D: h; \        if(m!=length(theta)) print("阈值长度错误!")
    3 E* [+ X/ `$ Z# e        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    5 t, [* Y9 v; U) _        K<-nrow(x);#8一组样本的维数; K! i& w( q, s4 k2 J2 F7 Z
            J<-ncol(x);#8一共有多少组样本" O+ ]0 Z9 Y- e: l; I
            w<-rbind(w,t(theta));#由7*11变为8*11
    ' V" M' g+ u9 P* s        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接& Q, o/ e( R( L3 ?# m
    #定义函数f
    1 F; q( m/ F% l1 O1 [: d4 @        f<-function(h) 1/(1+exp(-h));, |9 p3 E6 w9 h3 Z! D
            epsilon<-alpha<-0.5;
    * \1 u2 V1 R3 G$ k        N<-0;#重复学习次数的计数
    4 k0 b6 a  M6 P6 \- h        ei<-as.numeric();#记录每次迭代的平均残差平方和& _& B' O* w$ H) N. f; U
            FW<-1;1 z; E% u6 p4 T5 f$ b
            while((FW/J)>=0.001){
    6 i: G7 [' [% J: S% \                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    2 s; _7 k' j% G% H( D# q                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
    8 y" L: Y3 @- I! K9 x                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns+ ?# v8 W6 D$ K' k- e
                    Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值; D1 S* A2 w  U3 ?  k7 @! d3 X
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值! |7 L& ^* C. |8 V
                    b<-y-D;
    1 f' ^/ ^  m" Z9 |                #J组样本的学习
    2 V1 P! f3 P6 k, W/ @                #向量,输出层对隐含层的权值的偏导
    6 l3 b2 ]; }: X0 q( U4 @                FW<-pFW2<-pFW2t_1<-0;) @; H' T. h5 d
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    4 u' t# L" M% K                for(t in 1:J){
    2 W) u5 A3 n6 @- v# L& D* D                        B3<-b[t];) B9 d2 R3 a* k( b
                            FW<-FW+B3*B3;#标量. L2 t8 b' U( [
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量; w) o/ n8 w# e0 L; Y  q
                            pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    4 j: E+ h. L0 ~! ^7 [# S8 X8 j                        if(t==1) v<-v-0.5*epsilon*pFW2
    ( M: [5 @5 p3 E- h; T                        else{
    , U9 o2 \, ]( N+ h- r                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
    ( Q& w- Q$ {$ s' ~                                pFW2t_1<-pFW2;/ R  a1 G( W: {2 M
                            }7 m. k' v' a. K4 m# ]- D' C
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连/ g% O4 ?5 ^% C: k  I* k+ g, Q
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    7 a" I! C, [9 a) P* x+ i                        if(t==1) w<-w-0.5*epsilon*pFW1
    7 E1 q& K; I- p; S# `8 C1 h$ Y                        else{
    4 [( M4 W* r, z/ r7 L                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);: O# j! Y' I4 K
                                    pFW1t_1<-pFW1;3 i& ?4 P% A- h
                            }! D7 |) Q. c/ Z* ^$ t1 C# l$ Q
                    }
    # a' p& v4 F3 C- m9 I& A: |1 ~' S3 R                N<-N+1;% M9 _6 ]* K2 a2 ~: F# t( [
                    ei[N]<-FW/J;  @6 R1 h4 J. K) w
            }
    / w1 c& X0 ?: D4 F+ ?        theta<-w[nrow(w),];#隐含层阈值; W) n) `8 E- r" `0 o  U8 _2 W
            gama<-v[length(v)];#输出层阈值
    - G- a) d! S' h) A6 v# r        w<-w[1nrow(w)-1),];#输入层对隐含层的权重7 H2 h: V' ], r- H& f8 }' i+ u
            v<-v[1length(v)-1)];#隐含层对输出层的权重: A! z4 W6 A$ e1 _
            list(theta,gama,w,v,N,FW/J,ei)
    - o3 ]# K$ U9 G" i}6 T( ]( ~, G# K& h4 O% C' a3 ^
    x<-cbind(x1,x2,x3,x4,x5,x6,x7);
    * n/ ^4 D' A7 n/ Cx<-t(x);9 [, Z9 L' L2 d$ h: M+ x8 k& }
    hidden_threshold<-runif(11);
    1 z; a" H+ e% `# Q+ q5 Aoutput_threshold<-runif(1);
    + g5 I0 e4 G* P7 @. Qw<-matrix(runif(77),7,11);
    # {* h+ z4 _. W7 }v<-runif(11);& W4 Z% v: ?$ t3 i* K% ^
    result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);7 s# o0 u) h, ]- ~) g$ D
    #输出$ e; }) k2 a4 p. H
    cat("\n");7 |* `. z4 R) M% }/ m/ b: X8 A
    cat("隐含层阈值theta","\n",result[[1]],"\n");
    8 N' F! L; Y2 @4 \0 l/ |# h4 ]cat("输出层阈值gama","\n",result[[2]],"\n");
    9 x4 `2 k9 T9 b6 q3 Q6 ~& q0 j2 vw<-as.matrix(result[[3]],7,11);6 U+ U8 m/ y  ?# q. p
    cat("输入层对隐含层的权重w","\n");; y0 [: d8 T# o3 H4 w  {- X
    w;3 I% ?6 c- U) h3 V8 Y8 o/ P
    cat("\n");+ ?# {9 s, k- ?- C. G5 s5 {" {
    cat("隐含层对输出层的权重v","\n",result[[4]],"\n");$ _4 l% K8 m, D; Z% x2 e: M1 E8 n
    cat("迭代次数N" ,"\n",result[[5]],"\n");5 j; d" x' q, h/ l0 ^6 o) E8 p. ~
    cat("学习误差FW","\n",result[[6]],"\n");
    : c/ R! m& K* K$ s0 ?8 i6 gcat("每次迭代的误差","\n");1 J% n$ _% N  w6 E8 Y+ W
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");- s8 r6 |- \# r7 a
    proc.time()-ti
    & {0 ^- v3 S  ]- D% \
    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-8-26 03:13 , Processed in 0.432837 second(s), 80 queries .

    回顶部