神经网络在R语言 实现

haviet

ti<-proc.time()
BP_one_output<-function(input,output,m,fth,sth,w,v){
        x<-input;#7*8
5 e; ]5 p& |6 u" R8 }        y<-output;#8*1，y为向量，每一元素为一个样本输出值
        theta<-fth;#11*1
3 k% K8 I( W6 ]7 o( e        gama<-sth;#标量
) {4 q) o6 Y5 L& h4 d5 v        if(m!=length(theta)) print("阈值长度错误！")
        x<-rbind(x,t(rep(-1,ncol(x))));#8*8导致x的最后一列为阈值theta的权重
        K<-nrow(x);#8一组样本的维数
9 M+ C4 R% v( r' p5 B        J<-ncol(x);#8一共有多少组样本
3 E- _! K" p% P8 x! ^* G  ^& Q        w<-rbind(w,t(theta));#由7*11变为8*11
$ {% Y! [9 k  }- W        v<-c(v,gama);#由11变为12，但请记住：在隐含层增加一个值为-1的节点，但与输入层并未连接
" e! F2 s8 \& y#定义函数f
" X$ ~6 x/ X8 X) S1 e        f<-function(h) 1/(1+exp(-h));
        epsilon<-alpha<-0.5;
        N<-0;#重复学习次数的计数
3 w2 {% u2 f/ Y+ s        ei<-as.numeric();#记录每次迭代的平均残差平方和
. t3 I5 m- H* T7 j% l  y& {        FW<-1;
        while((FW/J)>=0.001){
5 a# i, G& z# V0 p' [$ @0 [                Z1<-t(w)%*%x;#11*8矩阵，每一列为一组样本
                Y1<-apply(Z1,c(1,2),f);#11*8矩阵，每一列为一组样本在隐含层的值, a matrix 1 indicates rows,
" P. M- m% J" P( d* @0 p+ T                                                                                        #2 indicates columns, c(1, 2) indicates rows and columns
                Z2<-t(v)%*%rbind(Y1,t(rep(-1,ncol(Y1))));#8*1向量，每个元素为隐含层对输出层的加权值
                D<-f(Z2);#向量，每一元素为一组样本的一个输出值
! S/ ~# S. M" k                b<-y-D;
                #J组样本的学习
: L- ?( z5 ?, j9 _7 J                #向量，输出层对隐含层的权值的偏导
                FW<-pFW2<-pFW2t_1<-0;
8 h+ D) g2 A9 i7 X+ _6 U                pFW1t_1<-matrix(0,nrow(w),ncol(w));#矩阵，隐含层对输入层权值的偏导
                for(t in 1:J){
                        B3<-b[t];
                        FW<-FW+B3*B3;#标量
- A: \/ V3 x+ H/ f# v. _" ~5 C) B                        B2<-f(Z2[t])*(1-f(Z2[t]))*B3;#标量
' F2 \, q1 h2 O5 K                        pFW2<--2*c(Y1[,t],-1)*B2;#12*1向量隐含层对输出层的权重偏导,此时多了一个阈值项
% x  i5 h7 d0 d; l( U5 x# @4 y9 l                        if(t==1) v<-v-0.5*epsilon*pFW2
                        else{
                                v<-v-0.5*epsilon*pFW2+alpha*(-0.5*epsilon*pFW2t_1);
+ J' u: c: Y/ q3 \1 M                                pFW2t_1<-pFW2;
2 w* b6 r* P* z8 r% {                        }
                        B1<-diag(f(Z1[,t])*(1-f(Z1[,t])))%*%v[1length(v)-1)]*B2;#11*1隐含层多出来的一个节点即阈值节点并未与输入层相连
8 f# I9 h1 T* j5 c! M: z: {- ]) ~                        pFW1<--2*x[,t]%*%t(B1)#8*11输入层对隐含层的权重偏导
1 y; T' o) S% P& d8 k! f                        if(t==1) w<-w-0.5*epsilon*pFW1
                        else{
                                w<-w-0.5*epsilon*pFW1+alpha*(-0.5*epsilon*pFW1t_1);
% w6 d  X  n0 u( D4 S: r# I                                pFW1t_1<-pFW1;
                        }
                }
                N<-N+1;
                ei[N]<-FW/J;
4 m' P# ^6 G* S% B) o        }
        theta<-w[nrow(w),];#隐含层阈值
        gama<-v[length(v)];#输出层阈值
* @; W8 p; b# Z( ]% `: Y        w<-w[1nrow(w)-1),];#输入层对隐含层的权重
        v<-v[1length(v)-1)];#隐含层对输出层的权重
8 l; h3 w- ^4 x! C) N) T2 u" i; K        list(theta,gama,w,v,N,FW/J,ei)
}
9 }! \7 ^/ S, Z% F- ]- Fx<-cbind(x1,x2,x3,x4,x5,x6,x7);
% f3 O- q3 d9 p' u4 Zx<-t(x);
' U4 L& M# E- _& f- rhidden_threshold<-runif(11);
output_threshold<-runif(1);
w<-matrix(runif(77),7,11);
. I' r. B, }1 N1 Mv<-runif(11);
result<-BP_one_output(x,y,11,hidden_threshold,output_threshold,w,v);
#输出
: H! x& u% E8 r2 i+ Kcat("\n");
6 V" p  d% S  h; a9 y- C" T2 jcat("隐含层阈值theta","\n",result[[1]],"\n");
cat("输出层阈值gama","\n",result[[2]],"\n");
w<-as.matrix(result[[3]],7,11);
cat("输入层对隐含层的权重w","\n");
w;
8 l* P% l; d( t" H6 {/ R$ Ncat("\n");
cat("隐含层对输出层的权重v","\n",result[[4]],"\n");
/ q, \& B, O$ F. y2 j3 wcat("迭代次数N" ,"\n",result[[5]],"\n");
cat("学习误差FW","\n",result[[6]],"\n");
: V" L5 t. J; Hcat("每次迭代的误差","\n");
plot(result[[7]],type="l",ylab="每次学习误差",xlab="反复学习的次数");
- R5 H* ~3 ^* N- B0 q* rproc.time()-ti

廷植斌_972

支持~~顶顶~~~

Esmtih

运行不了啊？

黄窗帘

就看看，不说话。

凌chers

能不能解释一下呢？

兰竹李乐

这牛逼的你自己编的吗