diff options
Diffstat (limited to 'nnunit.pas')
| -rw-r--r-- | nnunit.pas | 544 |
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.
+
|