神经网络在R语言 实现

haviet

ti<-proc.time()
0 D' |# f; K+ N& ?9 A2 L2 oBP_one_output<-function(input,output,m,fth,sth,w,v){
2 {" F. C3 s1 D' u8 e' F8 g        x<-input;#7*8
        y<-output;#8*1，y为向量，每一元素为一个样本输出值
0 X& n7 q0 ~* P0 B1 Y        theta<-fth;#11*1
        gama<-sth;#标量
4 A. w6 l  W" I3 E8 h9 {& D$ ^( u) K        if(m!=length(theta)) print("阈值长度错误！")
5 A4 }2 h6 K3 x3 m5 x- H2 i: W        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
0 k* a" l% t5 C& u3 }2 a5 b        K<-nrow(x);#8一组样本的维数
        J<-ncol(x);#8一共有多少组样本
0 a: j) F! T0 y5 @5 i2 b, p        w<-rbind(w,t(theta));#由7*11变为8*11
        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接
#定义函数f
# K2 S; e- O* T  G# j0 ?        f<-function(h) 1/(1+exp(-h));
7 t# E5 `' D! G) `8 L$ S3 P        epsilon<-alpha<-0.5;
        N<-0;#重复学习次数的计数
        ei<-as.numeric();#记录每次迭代的平均残差平方和
' F( R7 t7 N! V) @% s' k        FW<-1;
        while((FW/J)>=0.001){
3 L/ V( {  S/ m# P: f                Z1<-t(w)%*%x;#11*8矩阵，每一列为一组样本
                Y1<-apply(Z1,c(1,2),f);#11*8矩阵，每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
! [0 Z$ n2 B6 [' T% i                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns
) M# i1 d: T/ ]$ p$ ]' f                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量，每个元素为隐含层对输出层的加权值
6 g4 T8 Q6 Y/ D% V  e6 _5 {6 F                D<-f(Z2);#向量，每一元素为一组样本的一个输出值
, @/ c; I/ g( O, [6 a7 X) b                b<-y-D;
                #J组样本的学习
# `; O8 ]! |% y) N# V, V$ s5 B                #向量，输出层对隐含层的权值的偏导
                FW<-pFW2<-pFW2t_1<-0;
                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导
( F' r6 x1 d/ {8 b* M                for(t in 1:J){
                        B3<-b[t];
                        FW<-FW+B3*B3;#标量
/ L& E5 U' t5 g1 R% c8 t                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
8 _( k  C( N& N+ j                        if(t==1) v<-v-0.5*epsilon*pFW2
% f$ G+ z: {4 ~$ o! b                        else{
                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
& F9 z; H2 \2 E& K; I' D  l                                pFW2t_1<-pFW2;
/ M! M* H6 J" Q* w                        }
" e3 [2 }2 f4 m: ?0 q7 O- j                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
( }5 ], a: T( e& D1 F                        if(t==1) w<-w-0.5*epsilon*pFW1
                        else{
. N# t- c) c# q. S                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
8 r) `0 x: q2 _" L" k8 S                                pFW1t_1<-pFW1;
) {$ Z) g* Y# _. h5 I3 a) p& ^                        }
; l0 ~0 ~& j& }7 _/ e                }
; B6 o4 H* F/ V                N<-N+1;
                ei[N]<-FW/J;
        }
        theta<-w[nrow(w),];#隐含层阈值
' j0 L/ t+ S/ M' D6 U& c* R        gama<-v[length(v)];#输出层阈值
        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
        v<-v[1length(v)-1)];#隐含层对输出层的权重
        list(theta,gama,w,v,N,FW/J,ei)
}
x<-cbind(x1,x2,x3,x4,x5,x6,x7);
x<-t(x);
hidden_threshold<-runif(11);
output_threshold<-runif(1);
5 i* k, G  p2 d  G) b4 cw<-matrix(runif(77),7,11);
v<-runif(11);
result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
0 z& E3 z2 _. M#输出
cat("\n");
cat("隐含层阈值theta","\n",result[[1]],"\n");
+ }3 I$ `3 q, P5 N2 e$ Vcat("输出层阈值gama","\n",result[[2]],"\n");
4 T3 Z* b( M5 _6 ]0 V; B9 G) ]w<-as.matrix(result[[3]],7,11);
cat("输入层对隐含层的权重w","\n");
; E6 K1 s3 K0 dw;
! p' |" q. k& D% R+ z& Gcat("\n");
8 ^3 z6 K. A) A& D8 ucat("隐含层对输出层的权重v","\n",result[[4]],"\n");
cat("迭代次数N" ,"\n",result[[5]],"\n");
$ ^, s+ s! g7 u- Ecat("学习误差FW","\n",result[[6]],"\n");
; r; o+ m% C* W4 Icat("每次迭代的误差","\n");
% Y" n- H- I' i# v1 v% iplot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
' l: q/ U, [; N7 uproc.time()-ti
& |9 t3 W8 W7 A- g; x" z

廷植斌_972

支持~~顶顶~~~

Esmtih

运行不了啊？

黄窗帘

就看看，不说话。

凌chers

能不能解释一下呢？

兰竹李乐

这牛逼的你自己编的吗