QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18450|回复: 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(), \4 E( n( f' C3 S9 P
    BP_one_output<-function(input,output,m,fth,sth,w,v){' V% F6 }* C7 C9 H: {
            x<-input;#7*8
    # K4 w0 {6 f( j        y<-output;#8*1,y为向量,每一元素为一个样本输出值( _! T: W* c$ x8 R' [7 u
            theta<-fth;#11*1! ?) f3 W" x8 |5 @9 a( d2 h! W
            gama<-sth;#标量4 y0 L, W9 f$ }2 q% w
            if(m!=length(theta)) print("阈值长度错误!")
    & l' H! I7 {% E- `2 }- W        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
    2 u0 A3 S+ V: l        K<-nrow(x);#8一组样本的维数
    $ N; i- J6 a& ?4 x7 F/ s) Y        J<-ncol(x);#8一共有多少组样本
    4 Y+ H& I/ k6 K- E, J4 X' d        w<-rbind(w,t(theta));#由7*11变为8*11
    " s: ]6 Q9 I( A        v<-c(v,gama);#由11变为12,但请记住:在隐含层增加一个值为-1的节点,但与输入层并未连接
    & w; c) _" f6 N6 d3 c#定义函数f6 g5 l; @& M" y6 z9 }
            f<-function(h) 1/(1+exp(-h));( o9 _7 c7 {2 Q6 s' a0 Y% l
            epsilon<-alpha<-0.5;  ^  J' @4 O3 W9 j( T, l
            N<-0;#重复学习次数的计数) k2 c5 [; r4 W: a4 X
            ei<-as.numeric();#记录每次迭代的平均残差平方和
    3 e; u" O, A. a2 T; W        FW<-1;4 ~/ f# v- w2 g7 e$ v: d
            while((FW/J)>=0.001){
    ! e. _# W. t/ v, P; B- i                Z1<-t(w)%*%x;#11*8矩阵,每一列为一组样本
    & ]! A; @. U3 _                Y1<-apply(Z1,c(1,2),f);#11*8矩阵,每一列为一组样本在隐含层的值, a matrix 1 indicates rows, * j1 x9 E5 h: D+ R6 K
                                                                                            #2 indicates columns, c(1, 2) indicates rows and columns
    / L0 @' z: Y2 z$ k  \8 @% p) F                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量,每个元素为隐含层对输出层的加权值0 w' z2 }. S6 M. [
                    D<-f(Z2);#向量,每一元素为一组样本的一个输出值
    4 A' L$ p+ ]7 s* z- X$ ]* q# ?) f                b<-y-D;
    7 K, d8 Z# i5 R& _* t" C1 w4 B* t                #J组样本的学习/ j1 I2 n+ k4 w. c% l, t- G0 f
                    #向量,输出层对隐含层的权值的偏导) o8 n4 o7 ^! u! F
                    FW<-pFW2<-pFW2t_1<-0;. K/ b* N- \) @1 ]
                    pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵,隐含层对输入层权值的偏导
    2 K- |% T4 O" t  l# q                for(t in 1:J){
    & w7 M6 Y% W! ^& w" @8 \2 w3 O                        B3<-b[t];
    4 A8 M, ]  c6 X! k! J                        FW<-FW+B3*B3;#标量, |, t4 C5 E/ L8 P! s& j
                            B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
    3 Z* k8 j  M& n. a+ a                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
    1 g3 C! e0 F& T& ?3 r6 q                        if(t==1) v<-v-0.5*epsilon*pFW2' a* |) L7 ^4 Q* V, x
                            else{
    7 F! Y4 y  C! A$ v% Q9 x6 }                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);/ o4 t" q; v  a  V1 l8 o7 u
                                    pFW2t_1<-pFW2;
    * D2 Z6 U8 Y$ m" ^. F! W5 j) M                        }* ?9 E, S  \) S, v8 K
                            B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连. a8 }+ b" Y0 b. b
                            pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
    ; m/ ]7 t, G( c# E* k5 a                        if(t==1) w<-w-0.5*epsilon*pFW1# x0 ?( H( x0 U& x6 R1 W. i% E
                            else{* U7 M9 y; l6 o6 L1 A9 Z
                                    w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);5 {6 P$ n0 c+ R: W: L: x
                                    pFW1t_1<-pFW1;
    & K2 H9 g: n+ @                        }0 R7 @( y" g' Q8 [, i8 o/ T8 c
                    }# S  N" R# g% A  [1 J( o0 F
                    N<-N+1;
    1 X* U* b. d( U9 p- Z! j/ q                ei[N]<-FW/J;: n3 H) k6 x- A' b: o; N3 e
            }
    0 T. j7 j% Q; @4 t% }+ i- z3 q        theta<-w[nrow(w),];#隐含层阈值- {0 c* |( ?; P( n
            gama<-v[length(v)];#输出层阈值
    3 c: Y6 M7 m, l1 x* Q( U3 R        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
      h0 C3 n- ~, d        v<-v[1length(v)-1)];#隐含层对输出层的权重
    0 s' g+ F. x0 G/ d, R3 G        list(theta,gama,w,v,N,FW/J,ei)
    1 }, z, V, M6 W3 h}
    6 q' c, i* P. R, M6 d2 i0 Ax<-cbind(x1,x2,x3,x4,x5,x6,x7);2 G& v# s/ k. ^. D
    x<-t(x);( p3 G0 O# U0 E. z& I
    hidden_threshold<-runif(11);
    ! |4 O! d. n! T1 _1 f1 _" Doutput_threshold<-runif(1);2 F7 k9 _; X$ ]) Y" Q. D# S+ g
    w<-matrix(runif(77),7,11);
    # y$ D, g, ]$ X* ~2 _( r5 I( X9 Lv<-runif(11);3 i: d* ^. y, H9 @, r
    result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);* ?/ q$ Y9 t# R; z3 ^1 L, o
    #输出* f$ u- Z/ V* u' A+ ^. I
    cat("\n");- j; e' ]( z( q1 X
    cat("隐含层阈值theta","\n",result[[1]],"\n");/ _  J7 ^8 c( s, B1 {
    cat("输出层阈值gama","\n",result[[2]],"\n");0 y6 U2 Y- N% q# h
    w<-as.matrix(result[[3]],7,11);( }4 m/ Y  Z# z7 P
    cat("输入层对隐含层的权重w","\n");
    , K, a- X6 ^+ v, Nw;! ]& a  ?5 n: a+ H1 k; D' O
    cat("\n");
    ' v4 E, s$ v, G- k5 Wcat("隐含层对输出层的权重v","\n",result[[4]],"\n");
    : G3 |7 [  ^$ t* j! p, M, Lcat("迭代次数N" ,"\n",result[[5]],"\n");# A( q6 L" b4 L/ O- N7 F
    cat("学习误差FW","\n",result[[6]],"\n");
    : {( r' `2 S3 N8 S/ w+ ?cat("每次迭代的误差","\n");) P% W$ t4 T: ^& e
    plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
    , w2 c+ N+ U2 h9 \+ Lproc.time()-ti% z, f1 u* P4 n; V5 @3 _
    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-7-26 09:00 , Processed in 0.519307 second(s), 79 queries .

    回顶部