Implementace neuronových sítí english version
Back
propagation
Back propagation
Nejznámější model neuronových sítí. Učení s učitelem.
Vzorová implementace v Pascalu                 Ke stažení - Pascal    Ke stažení - Java
Následující kód je možné stáhnout jako součást balíku programů v Pascalu. Tento je orig_bp.pas, další programy jsou objektovou verzí programu s implementací Gain adaptive back propagation (GAB).

Novinka: Ke stažení je varianta v Javě s podporou NetBeans.


program BackPropagation;

const MaxLayer   =  5;                              { max. number of layers }
      MaxNeuron  = 15;                { max. number of neurons in one layer }
      MaxPattern = 50;                            { max. number of patterns }

type  Layers   = 0..MaxLayer;                           { available layers  }
      Neurons  = 1..MaxNeuron;                          { available neurons }
      NeurThrs = 0..MaxNeuron;        { neurons including thresholds source }
      Patterns = 1..MaxPattern;                         { usable patterns   }
      Weights  = array [Layers,NeurThrs,Neurons] of real;
                         { Weights[i,j,k] :                                 }
                         {   if j>0 ... weight from neuron j in layer i to  }
                         {              neuron k in layer i+1               }
                         {   if j=0 ... threshold of neuron k in layer i+1  }

var   w,wold : Weights;               { values of weights in time t and t-1 }
      x      : array [Layers,NeurThrs] of real;
                         { x[i,j] :                                         }
                         {   if j>0 ... output value of neuron j in layer i }
                         {   if j=0 ... value -1 used as a threshold source }
      delta  : array [Layers,Neurons] of real;
{ delta[i,j] = see remark after Eq.(18), concerning now neuron j in layer i }
      lmax   : Layers;                    { layers = 0 [bottom]..lmax [top] }
      n      : array [Layers] of Neurons; { number of neurons in each layer }
      t      : Patterns;                  { number of learning patterns     }
      xt, yt : array [Patterns,Neurons] of real;
                            { all input and expected output patterns from T }
      y      : array [Neurons] of real;
                       { expected output pattern for one chosen pair from T }
      eta, alpha : real;        { parameters of the algorithm - see Eq.(21) }
      Iters  : integer;                              { number of iterations }
      Cycles : integer;                                  { number of cycles }

function S ( ksi:real ) : real;          { neuron sigmoid transfer function }
const lambda = 1;                                            { sigmoid gain }
      RB     = 30;         { where to extrapolate the sigmoid by a constant }
var   inp : real;
begin inp:=lambda*ksi;
      if inp>30 then S:=1
                else if inp<-30 then S:=0
                                else S:=1/(1+exp(-inp));
end;

procedure State;                                 { new state of the network }
var   l   : Layers;
      j   : NeurThrs;
      k   : Neurons;
      ksi : real;                                        { neuron potential }
begin for l:=1 to lmax do
        for k:=1 to n[l] do
          begin ksi:=0;
                for j:=0 to n[l-1] do
                  ksi:=ksi+w[l-1,j,k]*x[l-1,j];          { neuron potential }
                x[l,k]:=S(ksi)                           { neuron output    }
          end
end;                         { x[lmax,k] is an actual output of the network }

procedure ChangeWeights ( l:Layers );           { new weights for one layer }
var   j     : NeurThrs;
      k     : Neurons;
      saveW : real;
begin for k:=1 to n[l+1] do
        for j:=0 to n[l] do
          begin saveW:=w[l,j,k];
                w[l,j,k]:=w[l,j,k]-
                              eta*delta[l+1,k]*x[l,j] +
                              alpha*(w[l,j,k]-wold[l,j,k]);
                wold[l,j,k]:= saveW;
          end;
end;

procedure MakeDelta ( l:Layers );               { new delta's for one layer }
var   j, k    : Neurons;
      CumulEr : real;            { cumulative error over neurons in a layer }
begin for j:=1 to n[l] do
        begin if l=lmax                                         { top layer }
                then CumulEr:=x[lmax,j]-y[j]
                else begin CumulEr:=0;      { calculate from previous layer }
                           for k:=1 to n[l+1] do
                             CumulEr:=CumulEr+delta[l+1,k]*w[l,j,k];
                     end;
              delta[l,j]:=x[l,j]*(1-x[l,j])*CumulEr
        end
end;

procedure NewWeights;                                 { network new weights }
var   l : Layers;
begin for l:=lmax-1 downto 0 do
        begin MakeDelta(l+1);               { set up delta's in upper layer }
              ChangeWeights(l);           { calculate weights in this layer }
        end
end;

function GlobalError : real;  { global error over all layers of the network }
var   p  : Patterns;
      j  : Neurons;
      Er : real;
begin Er:=0;
      for p:=1 to t do
        begin for j:=1 to n[0] do x[0,j]:=xt[p,j];
              for j:=1 to n[lmax] do y[j]:=yt[p,j];
              State;
              for j:=1 to n[lmax] do
                Er:=Er+Sqr(x[lmax,j]-y[j]);
        end;
      GlobalError:=Er;
end;

procedure Training;                     { provides learning of the patterns }
var   p     : Patterns;
      j     : Neurons;
      Error : real;                    { cumulative error for one iteration }
      iter, cycle  : integer;
begin
   writeln;                                { format for printed information }
   writeln('Iteration   LayerError   Pattern   Cycle   GlobalError');
   for cycle:=1 to Cycles do
     begin write(chr(13),cycle:38,GlobalError:14:5);     { prints of values }
           for p:=1 to t do
             begin write(chr(13),p:29);
                   for j:=1 to n[0] do x[0,j]:=xt[p,j];
                   for j:=1 to n[lmax] do y[j]:=yt[p,j];
                   for iter:=1 to Iters do
                     begin State;
                           Error:=0;
                           for j:=1 to n[lmax] do
                             Error:=Error+Sqr(x[lmax,j]-y[j]);
                           NewWeights;
                           write(chr(13),iter:5,Error:16:5);
                     end;
             end;
     end;
   writeln(chr(13),GlobalError:52:5);
end;

procedure Testing;    { you can try how well the network is learned,        }
                      { specifying on the request one or more input vectors }
var   i : Neurons;
      c : char;
begin writeln;
      repeat write('Enter network inputs (',n[0],' values) :  ');
             for i:=1 to n[0] do read(x[0,i]);
             readln;
             State;
             write('Output of the network is',':':9);
               for i:=1 to n[lmax] do write(x[lmax,i]:5:2);
             write('    More testing [Y/N] ? ');
             read(c);
      until (c='N')or(c='n');
      writeln;
end;

procedure InitNetwork;       { !! network parameters initialization routine }
var   l : Layers;            { this is the only task dependent procedure !! }
      j : NeurThrs;
      k : Neurons;
      f : text;
begin lmax:=2;               { the program will deal with the 4-2-4 network }
      n[0]:=4;  n[1]:=2;  n[2]:=4;
      RandSeed:=3456;
{! remove the following brackets numbered 1 if you want to start always    !}
{! with new random weights; if you wish to repeat your experiments again   !}
{! using the same initialization of weights, let them be there             !}
   {1 Randomize; 1}
      for l:=0 to lmax-1 do
        for j:=0 to n[l] do
          for k:=1 to n[l+1] do
            w[l,j,k]:=6*(Random-0.5)/10;
      wold:=w;
      eta:=0.3;  alpha:=0.7;                { choice of learning parameters }
      Iters:=15; Cycles:=40;    { choice of number of iterations and cycles }
{! remove brackets 2 if you do not want to create your own file of patterns!}
{! according to similar template. After removing the brackets 2, you will  !}
{! train the net on identity of vertices of 4-dimensional cube as listed;  !}
{! note that the file starts with the number of training pairs.            !}
     { copy patterns into file PATTERNS }
  {2 assign(f,'PATTERNS');
     rewrite(f);
     writeln(f,5);
     writeln(f,'1 1 0 0   1 1 0 0');
     writeln(f,'0 0 1 1   0 0 1 1');
     writeln(f,'1 0 1 0   1 0 1 0');
     writeln(f,'0 1 0 1   0 1 0 1');
     writeln(f,'0 0 0 0   0 0 0 0 ');
     close(f);                        2}

end;

procedure InitImpl;                           { implementation init routine }
var   l : Layers;
begin for l:=0 to lmax-1 do
        x[l,0]:=-1;             { used as a threshold source for next layer }
end;

procedure InitPatterns;                    { learning patterns init routine }
var   p : Patterns;
      j : Neurons;
      f : text;
begin assign(f,'PATTERNS'); reset(f);   { use your own file of training set }
      read(f,t); writeln;                              { number of patterns }
      for p:=1 to t do
        begin for j:=1 to n[0] do
                begin read(f,xt[p,j]);          { read inputs from PATTERNS }
                      write(xt[p,j]:5:2);       { and print them on screen  }
                end;
              write('   ');
              for j:=1 to n[lmax] do
                begin read(f,yt[p,j]);         { read outputs from PATTERNS }
                      write(yt[p,j]:5:2);      { and print them on screen   }
                end;
              readln(f); writeln;
        end;
      close(f);
end;

begin { BackPropagation }
      InitNetwork;
      InitImpl;
      InitPatterns;
      Training;
      Testing;
end.  { BackPropagation }
Kohonenovy
mapy
Slajdy
© 2003-2010 RNDr. Petr Božovský, CSc. (petr.bozovsky@mff.cuni.cz)
Katedra teoretické informatiky a matematické logiky MFF UK
nahoru nahoru