initial Commit

1 files changed, 544 insertions, 0 deletions

diff --git a/nnunit.pas b/nnunit.pas
new file mode 100644
index 0000000..1f2cedd
--- /dev/null
+++ b/nnunit.pas
@@ -0,0 +1,544 @@
+unit NNunit;

+

+{$mode objfpc}{$H+}

+

+interface

+

+uses

+  Classes, SysUtils, Dialogs, Math, ComCtrls, Forms;

+

+type

+  TExtendedArray = Array of Extended;

+  TLongintArray = Array of Longint;

+  TTrainingsset = Array of Array[Boolean] of TExtendedArray;

+

+  PTEbene = ^TEbene;

+

+  TNeuron = class(TObject)

+    Gewichte,altGew:                 TExtendedArray;

+    Nummer:                          Longint;

+    Schwelle,altSch,Wert,rohWert,

+      dPhi,ddPhi,Schranke,

+      Fehler,Ableitung,Kruemmung:    Extended;

+    constructor create(vorherGroesze, Nr: Longint); overload;

+    constructor create(Neu: TNeuron); overload;

+    destructor destroy; override;

+    procedure berechnen(Elter: PTEbene);

+    procedure FehlerRueckPropagation(Kind: PTEbene);

+    procedure KruemmungVorPropagation(Elter: PTEbene);

+    procedure Ausgabeschichtfehler(Op: TExtendedArray);

+    procedure FehlerEinarbeiten(Elter: PTEbene; Lernrate: Extended);

+    procedure rueckgaengig;

+    function Gradientquadrat(Elter: PTEbene): Extended;

+    function toString: String; override;

+  end;

+

+  TEbene = class(TObject)

+    Neuronen: array of TNeuron;

+    constructor create(Groesze,vorherGroesze: Longint); overload;

+    constructor create(Eb: TEbene; WerteZufaellig: Boolean); overload;

+    destructor destroy; override;

+    procedure berechnen(Elter: PTEbene);

+    procedure FehlerRueckPropagation(Kind: PTEbene);

+    procedure KruemmungVorPropagation(Elter: PTEbene);

+    procedure Ausgabeschichtfehler(Op: TExtendedArray);

+    procedure FehlerEinarbeiten(Elter: PTEbene; Lernrate: Extended);

+    procedure rueckgaengig;

+    function Gradientquadrat(Elter: PTEbene): Extended;

+    function Kruemmung(Op: TExtendedArray): Extended;

+    function toString: String; override;

+  end;

+

+  TNeuronalesNetz = class(TObject)

+    Ebenen: array of TEbene;

+    constructor create(Tiefe,Groesze: Longint); overload;

+    constructor create(Groesze: TLongintArray); overload;

+    constructor create(NN: TNeuronalesNetz; WerteZufaellig: Boolean); overload;

+    constructor create(NN: TNeuronalesNetz); overload;

+    destructor destroy; override;

+    function Output(Input: TExtendedArray): TExtendedArray;

+    function Lerne(Ip,Op: TExtendedArray; Lernrate: Extended; Meldungen: Boolean): Extended;

+    procedure Trainieren(LR: Extended; TS: TTrainingsset; PB: TProgressBar; AP: TApplication; Sortierung: Longint; Nachrichten: Boolean; out Ausgabe: String);

+    function Pruefen(Anz: Longint; TS: TTrainingsset; PB: TProgressBar; AP: TApplication; out Ausgabe: String): Extended;

+    function toString: String; override;

+  end;

+

+implementation

+

+const Sf = 5;

+

+constructor TNeuron.create(vorherGroesze, Nr: Longint);

+var I: Longint;

+begin

+  inherited create;

+  Nummer:=Nr;

+  Setlength(Gewichte,vorherGroesze);

+  Setlength(altGew,vorherGroesze);

+  for I:=0 to length(Gewichte)-1 do begin

+    Gewichte[I]:=max(-Schranke,min(Schranke,(random-0.5)/vorherGroesze));

+    altGew[I]:=0;

+  end;

+  Schwelle:=max(-Schranke,min(Schranke,0.2*random-0.1));

+  altSch:=0;

+  rohWert:=0;

+  Wert:=1/2;

+  dPhi:=Sf/4;

+  ddPhi:=0;

+  Schranke:=100;

+  Fehler:=0;

+  Ableitung:=0;

+  Kruemmung:=0;

+end;

+

+constructor TNeuron.create(Neu: TNeuron);

+var I: Longint;

+begin

+  inherited create;

+  Nummer:=Neu.Nummer;

+  Setlength(Gewichte,length(Neu.Gewichte));

+  for I:=0 to length(Gewichte)-1 do

+    Gewichte[I]:=Neu.Gewichte[I];

+  Setlength(altGew,length(Neu.altGew));

+  for I:=0 to length(altGew)-1 do

+    altGew[I]:=Neu.altGew[I];

+  Schwelle:=neu.Schwelle;

+  altSch:=neu.altSch;

+  rohWert:=neu.rohWert;

+  Wert:=neu.Wert;

+  dPhi:=neu.dPhi;

+  ddPhi:=neu.ddPhi;

+  Fehler:=neu.Fehler;

+  Ableitung:=neu.Ableitung;

+  Kruemmung:=neu.Kruemmung;

+end;

+

+destructor TNeuron.destroy;

+begin

+  Setlength(Gewichte,0);

+  Setlength(altGew,0);

+  inherited destroy;

+end;

+

+procedure TNeuron.berechnen(Elter: PTEbene);

+var I: Longint;

+begin

+  rohWert:=-Schwelle;

+  for I:=0 to length(Gewichte)-1 do

+    rohWert:=rohWert + Elter^.Neuronen[I].Wert*Gewichte[I];

+  if rohWert>10/Sf then Wert:=1

+  else begin

+    if rohWert<-10/Sf then Wert:=0

+    else Wert:=1/(1+Exp(-Sf*rohWert));

+  end;

+  dPhi:=-Sf*Wert*(Wert-1);

+  ddPhi:=-Sf*dPhi*(2*Wert-1);

+end;

+

+procedure TNeuron.FehlerRueckPropagation(Kind: PTEbene);

+var I: Longint;

+begin

+  Fehler:=0;

+  for I:=0 to length(Kind^.Neuronen)-1 do

+    Fehler:=Fehler+Kind^.Neuronen[I].Fehler*Kind^.Neuronen[I].Gewichte[Nummer];

+  Fehler:=Fehler*dPhi;

+end;

+

+procedure TNeuron.KruemmungVorPropagation(Elter: PTEbene);

+var I:           Longint;

+    Teil1,Teil2: Extended;

+begin

+  Teil1:=Fehler; // d Schwelle

+  Teil2:=0;

+  for I:=0 to length(Elter^.Neuronen)-1 do begin

+    Teil1:=Teil1

+      + Gewichte[I]*Elter^.Neuronen[I].Ableitung                         // w_ij * d n_i

+      + Fehler*sqr(Elter^.Neuronen[I].Wert);                             // n_i * d w_ij

+    Teil2:=Teil2

+      + Gewichte[I]*Elter^.Neuronen[I].Kruemmung                         // w_ij * d2 n_i

+      + 2*Fehler*Elter^.Neuronen[I].Wert * Elter^.Neuronen[I].Ableitung; // 2 * d w_ij * d n_i

+  end;

+  Kruemmung:=Teil2 * dPhi  // Teil2 * phi'

+    + sqr(Teil1) * ddPhi;  // Teil1^2 * phi''

+  Ableitung:=Teil1 * dPhi; // Teil1 * phi'

+end;

+

+procedure TNeuron.Ausgabeschichtfehler(Op: TExtendedArray);

+begin

+  Fehler:=Wert-Op[Nummer];

+  Fehler:=Fehler*dPhi;

+end;

+

+procedure TNeuron.FehlerEinarbeiten(Elter: PTEbene; Lernrate: Extended);

+var I:   Longint;

+begin

+  for I:=0 to length(Gewichte)-1 do begin

+    altGew[I]:=Gewichte[I];

+    Gewichte[I]:=max(-Schranke,min(Schranke,Gewichte[I]-Lernrate*Fehler*Elter^.Neuronen[I].Wert));

+  end;

+  altSch:=Schwelle;

+  Schwelle:=max(-Schranke,min(Schranke,Schwelle-Lernrate*Fehler));

+end;

+

+procedure TNeuron.rueckgaengig;

+var I:   Longint;

+begin

+  for I:=0 to length(Gewichte)-1 do

+    Gewichte[I]:=altGew[I];

+  Schwelle:=altSch;

+end;

+

+function TNeuron.Gradientquadrat(Elter: PTEbene): Extended;

+var I: Longint;

+begin

+  result:=0;

+  for I:=0 to length(Elter^.Neuronen)-1 do

+    result:=result+sqr(Elter^.Neuronen[I].Wert*Gewichte[I]*Fehler);

+end;

+

+function TNeuron.toString: String;

+var I: Longint;

+begin

+  result:=floattostr(Schwelle);

+  for I:=0 to length(Gewichte)-1 do

+    result:=result+' '+floattostr(Gewichte[I]);

+end;

+

+constructor TEbene.create(Groesze,vorherGroesze: Longint);

+var I: Longint;

+begin

+  inherited create;

+  Setlength(Neuronen,Groesze);

+  for I:=0 to length(Neuronen)-1 do

+    Neuronen[I]:=TNeuron.create(vorherGroesze,I);

+end;

+

+constructor TEbene.create(Eb: TEbene; WerteZufaellig: Boolean);

+var I: Longint;

+begin

+  inherited create;

+  Setlength(Neuronen,length(Eb.Neuronen));

+  for I:=0 to length(Neuronen)-1 do

+    if WerteZufaellig then

+      Neuronen[I]:=TNeuron.create(length(Eb.Neuronen[0].Gewichte),I)

+    else Neuronen[I]:=TNeuron.create(Eb.Neuronen[I]);

+end;

+

+destructor TEbene.destroy;

+var I: Longint;

+begin

+  for I:=0 to length(Neuronen)-1 do

+    Neuronen[I].Free;

+  Setlength(Neuronen,0);

+  inherited destroy;

+end;

+

+procedure TEbene.berechnen(Elter: PTEbene);

+var I: Longint;

+begin

+  for I:=0 to length(Neuronen)-1 do

+    Neuronen[I].berechnen(Elter);

+end;

+

+procedure TEbene.FehlerRueckPropagation(Kind: PTEbene);

+var I: Longint;

+begin

+  for I:=0 to length(Neuronen)-1 do

+    Neuronen[I].FehlerRueckPropagation(Kind);

+end;

+

+procedure TEbene.KruemmungVorPropagation(Elter: PTEbene);

+var I: Longint;

+begin

+  for I:=0 to length(Neuronen)-1 do

+    Neuronen[I].KruemmungVorPropagation(Elter);

+end;

+

+procedure TEbene.Ausgabeschichtfehler(Op: TExtendedArray);

+var I: Longint;

+begin

+  for I:=0 to length(Neuronen)-1 do

+    Neuronen[I].Ausgabeschichtfehler(Op);

+end;

+

+procedure TEbene.FehlerEinarbeiten(Elter: PTEbene; Lernrate: Extended);

+var I: Longint;

+begin

+  for I:=0 to length(Neuronen)-1 do

+    Neuronen[I].FehlerEinarbeiten(Elter,Lernrate);

+end;

+

+procedure TEbene.rueckgaengig;

+var I: Longint;

+begin

+  for I:=0 to length(Neuronen)-1 do

+    Neuronen[I].rueckgaengig;

+end;

+

+function TEbene.Gradientquadrat(Elter: PTEbene): Extended;

+var I: Longint;

+begin

+  result:=0;

+  for I:=0 to length(Neuronen)-1 do

+    result:=result + Neuronen[I].Gradientquadrat(Elter);

+end;

+

+function TEbene.Kruemmung(Op: TExtendedArray): Extended;

+var I: Longint;

+begin

+  result:=0;

+  for I:=0 to length(Neuronen)-1 do

+    result:=result

+      + sqr(Neuronen[I].Ableitung)

+      + (Neuronen[I].Wert-Op[I])*Neuronen[I].Kruemmung;

+end;

+

+function TEbene.toString: String;

+var I: Longint;

+begin

+  result:='';

+  for I:=0 to length(Neuronen)-1 do begin

+    result:=result+Neuronen[I].toString;

+    if I<length(Neuronen)-1 then result:=result+#13;

+  end;

+end;

+

+constructor TNeuronalesNetz.create(Tiefe,Groesze: Longint);

+var G: TLongintArray;

+    I: Longint;

+begin

+  setlength(G,Tiefe);

+  for I:=0 to length(G)-1 do

+    G[I]:=Groesze;

+  create(G);

+end;

+

+constructor TNeuronalesNetz.create(Groesze: TLongintArray);

+var I: Longint;

+begin

+  inherited create;

+  Setlength(Ebenen,length(Groesze));

+  for I:=0 to length(Ebenen)-1 do

+    Ebenen[I]:=TEbene.create(Groesze[I],Groesze[I-Byte(I>0)]*Byte(I>0));

+end;

+

+constructor TNeuronalesNetz.create(NN: TNeuronalesNetz);

+begin

+  create(NN,false);

+end;

+

+constructor TNeuronalesNetz.create(NN: TNeuronalesNetz; WerteZufaellig: Boolean);

+var I: Longint;

+begin

+  inherited create;

+  setlength(Ebenen,length(NN.Ebenen));

+  for I:=0 to length(Ebenen)-1 do

+    Ebenen[I]:=TEbene.Create(NN.Ebenen[I],WerteZufaellig);

+end;

+

+destructor TNeuronalesNetz.destroy;

+var I: Longint;

+begin

+  for I:=0 to length(Ebenen)-1 do

+    Ebenen[I].Free;

+  Setlength(Ebenen,0);

+  inherited destroy;

+end;

+

+function TNeuronalesNetz.Output(Input: TExtendedArray): TExtendedArray;

+var I: Longint;

+begin

+  if length(Input)<>length(Ebenen[0].Neuronen) then begin

+    MessageDlg('Eingabelänge ('+inttostr(length(Input))+') ist ungleich der Anzahl Neuronen in der ersten Ebene ('+inttostr(length(Ebenen[0].Neuronen))+')!',mtError,[mbOk],0);

+    exit;

+  end;

+  for I:=0 to length(Input)-1 do

+    Ebenen[0].Neuronen[I].Wert:=Input[I];

+  for I:=1 to length(Ebenen)-1 do

+    Ebenen[I].berechnen(@(Ebenen[I-1]));

+  Setlength(result,length(Ebenen[length(Ebenen)-1].Neuronen));

+  for I:=0 to length(result)-1 do

+    result[I]:=Ebenen[length(Ebenen)-1].Neuronen[I].Wert;

+end;

+

+function TNeuronalesNetz.Lerne(Ip,Op: TExtendedArray; Lernrate: Extended; Meldungen: Boolean): Extended;

+var I,Ausdauer: Longint;

+    iO:         TExtendedArray;

+    Fehler0,

+      lFehler,

+      aFehler,

+      LR:       Extended;

+begin

+  iO:=Output(Ip);

+  Fehler0:=0;

+  for I:=0 to length(iO)-1 do

+    Fehler0:=Fehler0+sqr(iO[I]-Op[I]);

+

+  lFehler:=Fehler0;

+  Ausdauer:=100;

+

+  repeat

+    Ebenen[length(Ebenen)-1].Ausgabeschichtfehler(Op);

+    for I:=length(Ebenen)-2 downto 1 do

+      Ebenen[I].FehlerRueckPropagation(@(Ebenen[I+1]));

+    LR:=0;

+    for I:=1 to length(Ebenen)-1 do begin

+      Ebenen[I].KruemmungVorPropagation(@(Ebenen[I-1]));

+      LR:=LR+Ebenen[I].Gradientquadrat(@(Ebenen[I-1]));

+    end;

+    LR:=LR/Ebenen[length(Ebenen)-1].Kruemmung(Op);

+    if LR<0 then

+      LR:=Lernrate;

+    For I:=length(Ebenen)-1 downto 1 do

+      Ebenen[I].FehlerEinarbeiten(@(Ebenen[I-1]),LR);

+    iO:=Output(Ip);

+    aFehler:=0;

+    for I:=0 to length(iO)-1 do

+      aFehler:=aFehler+sqr(iO[I]-Op[I]);

+    if aFehler>lFehler then begin

+      For I:=1 to length(Ebenen)-1 do

+        Ebenen[I].rueckgaengig;

+      if Meldungen and (aFehler-lFehler >= 0.1 * Fehler0) then

+        MessageDlg('Keine Verbesserung erreicht! '+floattostr(aFehler-lFehler)+'/'+floattostr(lFehler),mtError,[mbOk],0);

+      LR:=LR/2;

+    end;

+    if aFehler-lFehler >= -0.01 * Fehler0 then dec(Ausdauer);

+    lFehler:=aFehler;

+  until true; //(aFehler<0.01*Fehler0) or (Ausdauer<0);

+

+(*  lFehler:=Fehler0;

+

+  LR:=Lernrate;

+

+  repeat

+    Ebenen[length(Ebenen)-1].Ausgabeschichtfehler(Op);

+    For I:=length(Ebenen)-2 downto 1 do

+      Ebenen[I].FehlerRueckPropagation(@(Ebenen[I+1]));

+    For I:=length(Ebenen)-1 downto 1 do

+      Ebenen[I].FehlerEinarbeiten(@(Ebenen[I-1]),LR);

+    iO:=Output(Ip);

+    aFehler:=0;

+    for I:=0 to length(iO)-1 do

+      aFehler:=aFehler+sqr(iO[I]-Op[I]);

+    if aFehler-lFehler >= 0 then LR:=LR*0.2;

+    if lFehler-aFehler > 0 then LR:=LR*1.2;

+    lFehler:=aFehler;

+  until (LR>100*Lernrate) or (LR<0.01*Lernrate) or (aFehler<0.1*Fehler0); *)

+  result:=Fehler0-aFehler;

+end;

+

+procedure TNeuronalesNetz.Trainieren(LR: Extended; TS: TTrainingsset; PB: TProgressBar; AP: TApplication; Sortierung: Longint; Nachrichten: Boolean; out Ausgabe: String);

+var I,J,K:          Longint;

+    Erfolg,

+      Fortschritt,

+      Rueckschritt: Extended;

+    Perm:           TLongintArray;

+begin

+  Setlength(Perm,length(TS));

+  case Sortierung of

+    0: begin

+      for I:=0 to length(Perm)-1 do

+        Perm[I]:=-1;

+      for I:=0 to length(Perm)-1 do begin

+        J:=Random(length(Perm)-I);

+        K:=-1;

+        repeat

+          inc(K);

+          if Perm[K]<>-1 then inc(J);

+        until K>=J;

+        Perm[J]:=I;

+      end;

+    end;

+    1:

+      for I:=0 to length(Perm)-1 do

+        Perm[I]:=I;

+    -1:

+      for I:=0 to length(Perm)-1 do

+        Perm[I]:=length(Perm)-1-I;

+  end{of case};

+  PB.Min:=1;

+  PB.Max:=Min(100,length(TS));

+  PB.Position:=1;

+  PB.Visible:=True;

+  Fortschritt:=0;

+  Rueckschritt:=0;

+  for I:=0 to length(TS)-1 do begin

+    Erfolg:=Lerne(TS[Perm[I],false],TS[Perm[I],true],LR,Nachrichten);

+    Rueckschritt:=Max(Rueckschritt,-Erfolg);

+    Fortschritt:=Max(Fortschritt,Erfolg);

+    if ((100*I) div length(TS) > (100*(I-1)) div length(TS)) then begin

+      PB.StepIt;

+      AP.ProcessMessages;

+    end;

+  end;

+  PB.Visible:=False;

+  Ausgabe:='Fortschritt: '+floattostr(Fortschritt)+' Rückschritt: '+floattostr(Rueckschritt);

+end;

+

+function TNeuronalesNetz.Pruefen(Anz: Longint; TS: TTrainingsset; PB: TProgressBar; AP: TApplication; out Ausgabe: String): Extended;

+var I,J,K,L,gut,StGut: Longint;

+    dasistgut:         Boolean;

+    Fehler:            Extended;

+    Op:                TExtendedArray;

+    Vari:              TLongintArray;

+begin

+  Anz:=min(Anz,length(TS));

+  Setlength(Vari,Anz);

+  if Anz>=length(TS) then begin

+    for I:=0 to length(Vari)-1 do

+      Vari[I]:=I;

+  end

+  else begin

+    for I:=0 to length(Vari)-1 do begin

+      J:=Random(length(TS)-I);

+      K:=0;

+      while K<=J do begin

+        for L:=0 to I-1 do

+          if Vari[L]=K then begin

+            inc(J);

+            break;

+          end;

+        inc(K);

+      end;

+      Vari[I]:=J;

+    end;

+  end;

+  gut:=0;

+  StGut:=0;

+  PB.Min:=1;

+  PB.Max:=Min(100,Anz);

+  PB.Position:=1;

+  PB.Visible:=True;

+  Fehler:=0;

+  for I:=0 to length(Vari)-1 do begin

+    Op:=Output(TS[Vari[I],false]);

+    dasistgut:=true;

+    for J:=0 to 9 do begin

+      Fehler:=Fehler + Sqr(Op[J] - TS[Vari[I],true,J]);

+      dasistgut:=dasistgut and ((Op[J]<0.5) xor (TS[Vari[I],true,J]>=0.5));

+      StGut:=StGut + Byte((Op[J]<0.5) xor (TS[Vari[I],true,J]>=0.5));

+    end;

+    gut:=gut+byte(dasistgut);

+    if ((100*I) div Anz > (100*(I-1)) div Anz) then begin

+      PB.StepIt;

+      AP.ProcessMessages;

+    end;

+  end;

+  PB.Visible:=False;

+  Ausgabe:=inttostr(gut)+'/'+inttostr(Anz)+' -> '+floattostr(100*gut/Anz)+'%, '+floattostr(100*Stgut/Anz/10)+'% Fehler: '+floattostr(Fehler/Anz);

+  result:=(gut+0.01)/Anz;

+end;

+

+function TNeuronalesNetz.toString: String;

+var I: Longint;

+begin

+  result:='';

+  for I:=1 to length(Ebenen)-1 do begin

+    result:=result+Ebenen[I].toString;

+    if I<length(Ebenen)-1 then

+      result:=result+#13#13;

+  end;

+end;

+

+

+end.

+