diff options
Diffstat (limited to 'grampsunit.pas')
| -rw-r--r-- | grampsunit.pas | 4674 |
1 files changed, 4674 insertions, 0 deletions
diff --git a/grampsunit.pas b/grampsunit.pas new file mode 100644 index 0000000..566c394 --- /dev/null +++ b/grampsunit.pas @@ -0,0 +1,4674 @@ +unit grampsunit; + +interface + +{ $DEFINE detaillierteZeitanalyse} + +uses cthreads, grampstypen, sysutils, classes, gmp, grampsmath, randomunit, mystringlistunit, matheunit, systemunit; + +const + aktuellesJahr = 2015; + Standardhochzeitsalter = 25; + StandardLebensdauer = 80; + Jahrestoleranz = 2; + Zusatzueberlapp = 2*Jahrestoleranz; + Ueberlappcutoff = 20; + Entkreuzungsbelohnungsskalierung = 1e9; + OptimaleEhelaenge = 0.03; + Laengengewicht = 2*Ueberlappcutoff/(8*sqr(OptimaleEhelaenge*sqr(sqr(OptimaleEhelaenge)))); + sollABAnteil = 1/20; + Schrittweitenmultiplikator = 1.2; + epsilon = 1e-100; + minSchrittweite = 1e-13; + SchrittweitenSchwelle = 1e-10; + + WenTauschen: array[0..3,0..1] of Byte = ((0,0),(0,1),(1,1),(1,0)); + +type + tTimer = class + Zeit: extended; + stStCnt: int64; + running: boolean; + constructor create; + procedure start; + procedure stop; + function gibZeit: extended; + function gibZeitMittel: extended; + end; + tNotAus = class(TObject) + private + bitteBeenden: boolean; + public + Stati: array[0..9] of boolean; + lastKey: char; + function istZuende: boolean; + constructor create; + end; + + tMetaData = class(TObject) + private + {$IFDEF detaillierteZeitanalyse} + abvTimer,ffTimer,mmTimer,mfTimer,famTimer: tTimer; + {$ENDIF} + Sicherung: tMetaData; + Laubhaufen: tGenerikumArray; + personAuchDrueber, + familieAuchDrueber: tBooleanArray; // ist die Person/Familie auch im darüberliegenden tMetaData vorhanden? (hat nur Bedeutung, wenn es sich um tMetaData.Sicherung handelt) + procedure loescheVerknuepfungenZu(p: tPerson); + procedure loescheAlleVerbindungenZu(p: tPerson; f: tFamilie); + procedure arraysAufraeumen; + public + ParameterLaenge: longint; + + Ereignisse: tEreignisArray; + Personen: tPersonArray; + Familien: tFamilieArray; + + Verknuepfungen: tVerknuepfungArray; + MMInteraktionen: tMMInteraktionArray; + MFInteraktionen: tMFInteraktionArray; + FFInteraktionen: tFFInteraktionArray; + Parameterattribute: tParameterAttributArray; + UnabIndizes: tIntArray; + Tauschfamilien: tFamilieArray; + constructor create; + destructor destroy; override; + procedure init(md: tMetaData); + procedure printStatus(Level: longint); + {$IFDEF detaillierteZeitanalyse} + procedure printTimer(prefix: string); + {$ENDIF} + procedure berechneAbhaengigeVariable(var P: tExtendedArray{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}); + procedure GradientenRueckPropagation(P: tExtendedArray{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}; var grad: tExtendedArray); + function Energie(P: tExtendedArray; out Kreuzungen, Kreuzung: longint{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}): extended; + procedure Gradient(P: TExtendedArray{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}; var grad: tExtendedArray); +// function findeNaechstesAbhaengiges(Fam: tFamilie; out wo: longint; out Pers: tPerson): boolean; + function ladeXML(Datei: String): boolean; + procedure generiereFehlendeInfos; + function analysiereInteraktionen: boolean; + function findeKreise: tPointArrayArray; // x: Person, y: Familie + procedure blaetterAbschneiden; + procedure letztesBlattWiederAnkleben(out vkn: tVerknuepfung; out p: tPerson); + // gibt neue Verknüpfung zurück (oder nil, falls neue Familie eingefügt wurde) und neue Person (oder nil, falls beide Eltern neu sind) + procedure nurGroeszteZusammenhangskomponente; + procedure konsistenzTest(mitIndizes: boolean); + procedure pruefeAufGleichheit(vgl: tMetaData); + procedure habePersonGeloescht(p: tPerson); + procedure habeFamilieGeloescht(f: tFamilie); + procedure habePersonHinzugefuegt(p: tPerson); + procedure habeFamilieHinzugefuegt(f: tFamilie); + function istPersonAuchDrueber(p: tPerson): boolean; + function istFamilieAuchDrueber(f: tFamilie): boolean; + procedure indizesErzeugen; + function anzUnabhaengig: longint; + function anzUnbenutzt: longint; + end; + + tParameterSimplex = class + private + dim,pdim: longint; + Ecken: array of tExtendedArray; + Schwerpunkt,Energien: tExtendedArray; + Kreuzungens,Kreuzungs,Reihenfolge: tIntArray; + letzteSchwerpunktberechnung: longint; + letzteSchwerpunktabweichung: extended; + function besserAls(a,b: longint): longint; overload; // -1: a schlechter als b; 0: gleich gut; 1: a besser als b + function besserAls(aKrz: longint; aEnerg: extended; b: longint): longint; overload; // -1: a schlechter als b; 0: gleich gut; 1: a besser als b + function besserAls(a,b: longint; hart: boolean): longint; overload; // -1: a schlechter als b; 0: gleich gut (nur, wenn hart=false); 1: a besser als b + procedure ordnen; + function einsortieren(wen,Luecke: longint): longint; + function normalisiere(i: longint): boolean; overload; + function normalisiere(ps: tExtendedArray): boolean; overload; + procedure berechneEnergien(mt: longint); overload; + procedure berechneEnergien(mt: longint; ParameterBerechnen: boolean); overload; + function berechneSchwerpunkt: extended; + public + md: tMetaData; + constructor create; + destructor destroy; override; + procedure init(ps: tExtendedArray; mt: longint); + procedure outit(var ps: tExtendedArray); + function simplexSchritt(f,f1,f2,f3: extended; offset: longint): tSchrittErgebnis; overload; + function simplexSchritt(var np: tExtendedArray; f,f1,f2,f3: extended; offset: longint): tSchrittErgebnis; overload; // ohne Speicher-Alloziierung + // f ... erster Versuch + // f1 ... wenn schlechtester + // f2 ... sonst + // f3 ... wenn bester + procedure berechneEnergie(i: longint{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}); + procedure berechneAbhaengigeVariable(i: longint{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}); + function minKreuzungen: longint; + function maxKreuzungen: longint; + function minEnergie: extended; + function maxEnergie: extended; + procedure printHistogramm; + function mittlereKantenlaenge: extended; + procedure printSpur(nam: string; von,nach: longint); + end; + + tStabile = class(TObject) + private + NotAus: tNotAus; + MD: tMetaData; + Parameter: tExtendedArray; + Kreuzungen,Schritte: longint; + Energie,stepsize,laufzeit: extended; + procedure setzeFamilie(Fam: tFamilie; x,y,dist,lambda: extended; var P: tExtendedArray); + public + property Zeit: extended read laufzeit; + constructor create; overload; + constructor create(MetaData: TMetaData); overload; + destructor destroy; override; + procedure assignMetaData(MetaData: TMetaData); + procedure printStatus(Level: Longint); + function ladeXML(Datei: String): boolean; + procedure generiereFehlendeInfos; + procedure nurGroeszteZusammenhangskomponente; + procedure blaetterAbschneiden; + function analysiereInteraktionen: boolean; + function LadeVonDatei(Datei: String): boolean; + function SpeichereInDatei(Datei: String): boolean; + procedure Initialisiere(Anzahl: Longint; Art: string); + procedure optimiere; + procedure downHillSimplex; + procedure gradientenOptimierung; + end; + + tEnergieThread = class(tThread) + _s: tParameterSimplex; + _von,_bis: longint; + fertig,bp: boolean; + constructor create(s: tParameterSimplex; von,bis: longint; psBerechnen: boolean); + destructor destroy; override; + procedure execute; override; + end; + + tStabileInitThread = class(tThread) + private + _s: tStabile; + _werDran,_extraZufall: tIntArray; // werDran[wannDran[i].x] = i und + // wannDran[werDran[j]].x = j + _wannDran: t4DPointArray; // 2 ^ -wannDran[i].y ist die eigene Sollbeziehungslänge; + _anzahl: longint; + _Art: char; + _mt: tMersenneTwister; + public + fertig: boolean; + Kreuzungen: longint; + Energie: extended; + Parameter: tExtendedArray; + constructor create(s: tStabile; werDran,extraZufall: tIntArray; wannDran: t4DPointArray; art: char; anzahl: longint); + destructor destroy; override; + procedure execute; override; + end; + +implementation + +uses crt, math; + +constructor tTimer.create; +begin + inherited create; + running:=false; + Zeit:=0; + stStCnt:=0; +end; + +procedure tTimer.start; +begin + if running then exit; + running:=true; + inc(stStCnt); + Zeit:=Zeit-now; +end; + +procedure tTimer.stop; +begin + if not running then exit; + running:=false; + Zeit:=Zeit+now; +end; + +function tTimer.gibZeit: extended; +begin + if running then + result:=Zeit+now + else + result:=Zeit; +end; + +function tTimer.gibZeitMittel: extended; +begin + if stStCnt=0 then + result:=0 + else if running then + result:=(Zeit+now)/stStCnt + else + result:=Zeit/stStCnt; +end; + +// ********************************* TNotAus ******************************************************** + +function TNotAus.istZuende: boolean; +var c: char; +begin + if keyPressed then begin + c:=readkey; + case c of + #27,'q': bitteBeenden:=true; + ' ','p': readkey; + '0'..'9': Stati[ord(c)-ord('0')]:=not Stati[ord(c)-ord('0')]; + else lastKey:=c; + end{of case}; + end; + result:=bitteBeenden; +end; + +constructor TNotAus.create; +var i: longint; +begin + inherited create; + bitteBeenden:=false; + for i:=0 to 9 do + stati[i]:=i<>6; + lastKey:=#0; +end; + +// ************************************** TMetaData ********************************************** + +constructor TMetaData.create; +begin + inherited create; + fillchar(Ereignisse,sizeof(Ereignisse),#0); + setlength(Ereignisse,0); + fillchar(Personen,sizeof(Personen),#0); + setlength(Personen,0); + fillchar(Familien,sizeof(Familien),#0); + setlength(Familien,0); + fillchar(Verknuepfungen,sizeof(Verknuepfungen),#0); + setlength(Verknuepfungen,0); + fillchar(MMInteraktionen,sizeof(MMInteraktionen),#0); + setlength(MMInteraktionen,0); + fillchar(MFInteraktionen,sizeof(MFInteraktionen),#0); + setlength(MFInteraktionen,0); + fillchar(FFInteraktionen,sizeof(FFInteraktionen),#0); + setlength(FFInteraktionen,0); + fillchar(Tauschfamilien,sizeof(Tauschfamilien),#0); + setlength(Tauschfamilien,0); + fillchar(ParameterAttribute,sizeof(ParameterAttribute),#0); + setlength(ParameterAttribute,0); + Sicherung:=nil; + fillchar(Laubhaufen,sizeof(Laubhaufen),#0); + setlength(Laubhaufen,0); + fillchar(personAuchDrueber,sizeof(personAuchDrueber),#0); + setlength(personAuchDrueber,0); + fillchar(familieAuchDrueber,sizeof(familieAuchDrueber),#0); + setlength(familieAuchDrueber,0); + {$IFDEF detaillierteZeitanalyse} + abvTimer:=tTimer.create; + ffTimer:=tTimer.create; + mfTimer:=tTimer.create; + mmTimer:=tTimer.create; + famTimer:=tTimer.create; + {$ENDIF} + ParameterLaenge:=0; +end; + +destructor TMetaData.destroy; +var + i: longint; +begin + for i:=0 to length(MMInteraktionen)-1 do + MMInteraktionen[i].free; + setlength(MMInteraktionen,0); + for i:=0 to length(MFInteraktionen)-1 do + MFInteraktionen[i].free; + setlength(MFInteraktionen,0); + for i:=0 to length(FFInteraktionen)-1 do + FFInteraktionen[i].free; + setlength(FFInteraktionen,0); + for i:=0 to length(Verknuepfungen)-1 do + Verknuepfungen[i].free; + setlength(Verknuepfungen,0); + for i:=0 to length(Ereignisse)-1 do + Ereignisse[i].free; + setlength(Ereignisse,0); + for i:=0 to length(Personen)-1 do + Personen[i].free; + setlength(Personen,0); + for i:=0 to length(Familien)-1 do + Familien[i].free; + setlength(Familien,0); + setlength(Tauschfamilien,0); + setlength(ParameterAttribute,0); + Sicherung.free; + setlength(Laubhaufen,0); + setlength(personAuchDrueber,0); + setlength(familieAuchDrueber,0); + {$IFDEF detaillierteZeitanalyse} + abvTimer.free; + ffTimer.free; + mfTimer.free; + mmTimer.free; + famTimer.free; + {$ENDIF} + inherited destroy; +end; + +procedure TMetaData.init(md: tMetaData); +var + i,j: longint; + c: char; +begin + md.konsistenzTest(true); + + ParameterLaenge:=md.ParameterLaenge; + setlength(ParameterAttribute,length(md.ParameterAttribute)); + for i:=0 to length(ParameterAttribute)-1 do + ParameterAttribute[i]:=md.ParameterAttribute[i]; + + setlength(Ereignisse,length(md.Ereignisse)); + for i:=0 to length(Ereignisse)-1 do begin + Ereignisse[i]:=tEreignis.create; + Ereignisse[i].init(md.Ereignisse[i]); + end; + + setlength(Personen,length(md.Personen)); + setlength(personAuchDrueber,length(Personen)); + for i:=0 to length(Personen)-1 do begin + Personen[i]:=tPerson.create; + Personen[i].init(md.Personen[i],Ereignisse,Familien,false); + personAuchDrueber[i]:=true; + end; + + setlength(Familien,length(md.Familien)); + setlength(familieAuchDrueber,length(Familien)); + for i:=0 to length(Familien)-1 do begin + Familien[i]:=tFamilie.create; + Familien[i].init(md.Familien[i],Ereignisse,Personen,false); + familieAuchDrueber[i]:=true; + end; + + setlength(Verknuepfungen,length(md.Verknuepfungen)); + for i:=0 to length(Verknuepfungen)-1 do begin + Verknuepfungen[i]:=tVerknuepfung.create; + Verknuepfungen[i].outP:=Personen[md.Verknuepfungen[i].outP.index]; + Verknuepfungen[i].Lambda:=md.Verknuepfungen[i].Lambda; + for c:='x' to 'y' do begin + Verknuepfungen[i].Output[c]:=md.Verknuepfungen[i].Output[c]; + for j:=0 to 1 do + Verknuepfungen[i].Input[j,c]:=md.Verknuepfungen[i].Input[j,c]; + end; + Verknuepfungen[i].index:=i; + end; + + setlength(MMInteraktionen,length(md.MMInteraktionen)); + for i:=0 to length(MMInteraktionen)-1 do begin + MMInteraktionen[i]:=tMMInteraktion.create; + MMInteraktionen[i].Laenge:=md.MMInteraktionen[i].Laenge; + for j:=0 to 1 do + MMInteraktionen[i]._Ps[j]:=Personen[md.MMInteraktionen[i]._Ps[j].index]; + MMInteraktionen[i].index:=i; + end; + + setlength(MFInteraktionen,length(md.MFInteraktionen)); + for i:=0 to length(MFInteraktionen)-1 do begin + MFInteraktionen[i]:=tMFInteraktion.create; + MFInteraktionen[i].Laenge:=md.MFInteraktionen[i].Laenge; + MFInteraktionen[i]._F:=Familien[md.MFInteraktionen[i]._F.index]; + MFInteraktionen[i]._P:=Personen[md.MFInteraktionen[i]._P.index]; + MFInteraktionen[i].index:=i; + end; + + setlength(FFInteraktionen,length(md.FFInteraktionen)); + for i:=0 to length(FFInteraktionen)-1 do begin + FFInteraktionen[i]:=tFFInteraktion.create; + for j:=0 to 1 do + FFInteraktionen[i]._Fs[j]:=Familien[md.FFInteraktionen[i]._Fs[j].index]; + FFInteraktionen[i].index:=i; + end; + + setlength(Tauschfamilien,length(md.Tauschfamilien)); + for i:=0 to length(Tauschfamilien)-1 do + Tauschfamilien[i]:=Familien[md.Tauschfamilien[i].index]; + + konsistenzTest(true); +end; + +procedure TMetaData.printStatus(Level: Longint); +var + I,J,K,L,M: Longint; + ea: TEreignisart; +begin writeln('printstatus('+inttostr(level)+')'); + case Level of + 0: begin + J:=0; + K:=0; + L:=0; + M:=0; + for I:=0 to length(Personen)-1 do + for ea:=low(TEreignisart) to high(TEreignisart) do begin + J:=J+Byte(assigned(Personen[I].Ereignisse[ea])); + K:=K+Byte(assigned(Personen[I].Ereignisse[ea]) and not Personen[I].Ereignisse[ea].istDummy); + end; + for I:=0 to length(Familien)-1 do begin + L:=L+Byte(assigned(Familien[I].Anfang)); + M:=M+Byte(assigned(Familien[I].Anfang) and not Familien[I].Anfang.istDummy); + end; + writeln(inttostr(Level)+') '+inttostr(length(Ereignisse))+' Ereignisse'); + writeln(inttostr(Level)+') '+inttostr(K)+'/'+inttostr(J)+'<-'+inttostr(length(Personen))+' Personen'); + writeln(inttostr(Level)+') '+inttostr(M)+'/'+inttostr(L)+'<-'+inttostr(length(Familien))+' Familien'); + end; + 1: begin + J:=0; + K:=0; + L:=0; + for I:=0 to length(Personen)-1 do begin + J:=J+Byte(not Personen[I].Anfang.istDummy); + K:=K+Byte(not Personen[I].Ende.istDummy); + end; + for I:=0 to length(Familien)-1 do + L:=L+Byte(not Familien[I].Anfang.istDummy); + writeln(inttostr(Level)+') '+inttostr(J)+'/'+inttostr(K)+'/'+inttostr(length(Personen))+' Personen'); + writeln(inttostr(Level)+') '+inttostr(L)+'/'+inttostr(length(Familien))+' Familien'); + end; + 2,3: begin + K:=4096;//Familien[0].Anfang.Jahr-Familien[0].Eltern[0].Anfang.Jahr; + L:=-K; + for i:=0 to length(Familien)-1 do + if not Familien[i].Anfang.istDummy then + for j:=0 to 1 do + if assigned(Familien[I].Eltern[J]) and + not Familien[I].Eltern[J].Anfang.istDummy then begin + K:=min(K,Familien[I].Anfang.Jahr-Familien[I].Eltern[J].Anfang.Jahr); + L:=max(L,Familien[I].Anfang.Jahr-Familien[I].Eltern[J].Anfang.Jahr); + end; + writeln(inttostr(Level)+') '+inttostr(K)+' <= Hochzeitsalter <= '+inttostr(L)); + if Level=2 then exit; + for i:=0 to length(Familien)-1 do + if not Familien[i].Anfang.istDummy then + for j:=0 to 1 do + if assigned(Familien[I].Eltern[J]) and + not Familien[I].Eltern[J].Anfang.istDummy then begin + if K=Familien[I].Anfang.Jahr-Familien[I].Eltern[J].Anfang.Jahr then begin + writeln( + inttostr(Level)+') Minimalist:'); + writeln( + ' '+Familien[I].Eltern[J].Vorname+' '+ + Familien[I].Eltern[J].Nachname+' (G:'+ + inttostr(Familien[I].Eltern[J].Anfang.Jahr)+' H:'+ + inttostr(Familien[I].Anfang.Jahr)+' ['+ + inttostr(byte(Familien[I].Anfang.Art))+']) in Familie '+inttostr(I)); + if assigned(Familien[i].Eltern[1-j]) then + writeln( + ' mit '+Familien[I].Eltern[1-j].Vorname+' '+ + Familien[I].Eltern[1-j].Nachname+' (G:'+ + inttostr(Familien[I].Eltern[1-j].Anfang.Jahr)+' H:'+ + inttostr(Familien[I].Anfang.Jahr)+' ['+ + inttostr(byte(Familien[I].Anfang.Art))+']) in Familie '+inttostr(I)); +// writeln(' '+(Familien[I].Eltern[J])+' in Familie '+tFamilieToStr(Familien[I])); + end; + if L=Familien[I].Anfang.Jahr-Familien[I].Eltern[J].Anfang.Jahr then begin + writeln( + inttostr(Level)+') Maximalist:'); + writeln( + ' '+Familien[I].Eltern[J].Vorname+' '+ + Familien[I].Eltern[J].Nachname+' (G:'+ + inttostr(Familien[I].Eltern[J].Anfang.Jahr)+' H:'+ + inttostr(Familien[I].Anfang.Jahr)+' ['+ + inttostr(byte(Familien[I].Anfang.Art))+']) in Familie '+inttostr(I)); + if assigned(Familien[i].Eltern[1-j]) then + writeln( + ' mit '+Familien[I].Eltern[1-j].Vorname+' '+ + Familien[I].Eltern[1-j].Nachname+' (G:'+ + inttostr(Familien[I].Eltern[1-j].Anfang.Jahr)+' H:'+ + inttostr(Familien[I].Anfang.Jahr)+' ['+ + inttostr(byte(Familien[I].Anfang.Art))+']) in Familie '+inttostr(I)); +// writeln(' '+tPersonToStr(Familien[I].Eltern[J])+' in Familie '+tFamilieToStr(Familien[I])); + end; + end; + end; + 4: begin + writeln(inttostr(Level)+') '+inttostr(anzUnabhaengig)+' unabhängige Variable'); + writeln(inttostr(Level)+') '+inttostr(ParameterLaenge)+' Variable insgesamt'); + writeln(inttostr(Level)+') '+inttostr(length(Verknuepfungen))+' Verknuepfungen'); + writeln(inttostr(Level)+') '+inttostr(length(MMInteraktionen))+' Mensch-Mensch-Wechselwirkungen'); + writeln(inttostr(Level)+') '+inttostr(length(MFInteraktionen))+' Mensch-Familie-Wechselwirkungen'); + writeln(inttostr(Level)+') '+inttostr(length(FFInteraktionen))+' Familie-Familie-Wechselwirkungen'); + writeln(inttostr(Level)+') '+inttostr(length(Tauschfamilien))+' Familien mit >= 2 Kindern'); + end; + else + writeln('Illegales Argument für Funktionsaufruf von TMetaData.printStatus!'); + end{of case}; +end; + +{$IFDEF detaillierteZeitanalyse} +procedure TMetaData.printTimer(prefix: string); +begin + writeln(prefix+'Abv: '+mytimetostr(abvTimer.gibZeit)+' (avg. '+myfloattostr(abvTimer.gibZeitMittel*24*60*60)+' s)'); + writeln(prefix+'MM: '+mytimetostr(mmTimer.gibZeit)+' (avg. '+myfloattostr(mmTimer.gibZeitMittel*24*60*60)+' s)'); + writeln(prefix+'MF: '+mytimetostr(mfTimer.gibZeit)+' (avg. '+myfloattostr(mfTimer.gibZeitMittel*24*60*60)+' s)'); + writeln(prefix+'FF: '+mytimetostr(ffTimer.gibZeit)+' (avg. '+myfloattostr(ffTimer.gibZeitMittel*24*60*60)+' s)'); + writeln(prefix+'Fam: '+mytimetostr(famTimer.gibZeit)+' (avg. '+myfloattostr(famTimer.gibZeitMittel*24*60*60)+' s)'); +end; +{$ENDIF} + +procedure TMetaData.berechneAbhaengigeVariable(var P: TExtendedArray{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}); +var + i: Longint; + c: Char; +begin + {$IFDEF detaillierteZeitanalyse} + if mainThread then abvTimer.start; + {$ENDIF} + for i:=0 to length(Verknuepfungen)-1 do + for c:='x' to 'y' do + P[Verknuepfungen[i].Output[c]]:= + P[Verknuepfungen[i].Input[0,c]]*(1-P[Verknuepfungen[i].Lambda]) + + P[Verknuepfungen[i].Input[1,c]]*P[Verknuepfungen[i].Lambda]; + {$IFDEF detaillierteZeitanalyse} + if mainThread then abvTimer.stop; + {$ENDIF} +end; + +procedure TMetaData.GradientenRueckPropagation(P: tExtendedArray{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}; var grad: tExtendedArray); +var + i: Longint; + c: Char; +begin + {$IFDEF detaillierteZeitanalyse} + if mainThread then abvTimer.start; + {$ENDIF} + for i:=length(Verknuepfungen)-1 downto 0 do + for c:='x' to 'y' do begin + grad[Verknuepfungen[i].Input[0,c]]:= + grad[Verknuepfungen[i].Input[0,c]] + (1-P[Verknuepfungen[i].Lambda])*grad[Verknuepfungen[i].Output[c]]; + grad[Verknuepfungen[i].Input[1,c]]:= + grad[Verknuepfungen[i].Input[1,c]] + P[Verknuepfungen[i].Lambda]*grad[Verknuepfungen[i].Output[c]]; + grad[Verknuepfungen[i].Lambda]:= + grad[Verknuepfungen[i].Lambda] + + (P[Verknuepfungen[i].Input[1,c]] - P[Verknuepfungen[i].Input[0,c]])*grad[Verknuepfungen[i].Output[c]]; + +// P[Verknuepfungen[i].Output[c]]:= +// P[Verknuepfungen[i].Input[0,c]]*(1-P[Verknuepfungen[i].Lambda]) + +// P[Verknuepfungen[i].Input[1,c]]*P[Verknuepfungen[i].Lambda]; + end; + {$IFDEF detaillierteZeitanalyse} + if mainThread then abvTimer.stop; + {$ENDIF} +end; + +function TMetaData.Energie(P: TExtendedArray; out Kreuzungen, Kreuzung: Longint{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}): extended; +{$DEFINE Energie} +{$I energiefunktion.inc} +{$UNDEF Energie} + +procedure TMetaData.Gradient(P: TExtendedArray{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}; var Grad: tExtendedArray); +{$DEFINE Gradient} +{$I energiefunktion.inc} +{$UNDEF Gradient} + +(* +function TMetaData.findeNaechstesAbhaengiges(Fam: tFamilie; out wo: longint; out Pers: tPerson): Boolean; +var + I,J,W: Longint; + P: tPerson; +begin + if not assigned(Fam) then begin + result:=false; + wo:=-1; + Pers:=nil; + exit; + end; + for I:=0 to 1 do + if assigned(Fam.Eltern[I].KindIn) and + Fam.Eltern[I].KindIn.abhaengig then begin + Pers:=Fam.Eltern[I]; + wo:=0; + result:=true; + exit; + end; + result:=false; + wo:=-1; + W:=-1; + Pers:=nil; + for I:=0 to length(Fam.Kinder)-1 do + for J:=0 to length(Fam.Kinder[I].ElterIn)-1 do + if findeNaechstesAbhaengiges(Fam.Kinder[I].ElterIn[J],W,P) then begin + result:=true; + if (wo=-1) or (W+1<wo) or ((W+1=wo) and (random<0.5)) then begin + Pers:=P; + wo:=W+1; + end; + end; +end; +*) +function TMetaData.ladeXML(Datei: string): boolean; +var + f: tMyStringlist; + s: ansistring; + Ebene,UEbene,i,j,k,l: longint; + Speichern,gefunden: boolean; + neuEreignis: tEreignis; + neuPerson: tPerson; + neuFamilie: tFamilie; + duplikatKind: array of tPerson; + duplikatFamilie: array of tFamilie; +begin + result:=false; + writeln(Datei+' einlesen ...'); + f:=tMyStringlist.create; + if rightStr(Datei,4)='.xml' then + f.loadFromFile(Datei) + else if rightStr(Datei,7)='.gramps' then + f.loadFromGz(Datei) + else begin + f.free; + exit; + end; + + neuEreignis:=nil; + neuPerson:=nil; + neuFamilie:=nil; + + Setlength(Ereignisse,0); + Setlength(Personen,0); + Setlength(Familien,0); + + writeln('... verarbeiten ...'); + + setlength(duplikatKind,0); + setlength(duplikatFamilie,0); + + Ebene:=0; + for i:=0 to f.count-1 do begin + s:=f[i]; + case Ebene of + 0: begin + if leftStr(S,9)='<database' then + inc(Ebene); + continue; + end; + 1: begin + if S='</database>' then begin + dec(Ebene); + break; + end; + if S='<events>' then begin + inc(Ebene); + UEbene:=0; + continue; + end; + if leftStr(S,7)='<people' then begin + inc(Ebene); + UEbene:=1; + continue; + end; + if S='<families>' then begin + inc(Ebene); + UEbene:=2; + continue; + end; + end; + 2: begin + case UEbene of + 0: begin + if S='</events>' then begin + dec(Ebene); + continue; + end; + if leftStr(S,6)='<event' then begin + delete(S,1,pos('handle="',S)+7); + neuEreignis:=findeEreignis(Ereignisse,leftStr(S,pos('"',S)-1)); + Speichern:=true; + inc(Ebene); + end; + end; + 1: begin + if S='</people>' then begin + dec(Ebene); + continue; + end; + if leftStr(S,7)='<person' then begin + delete(S,1,pos('handle="',S)+7); + neuPerson:=findePerson(Personen,leftStr(S,pos('"',S)-1)); + Speichern:=true; + inc(Ebene); + end; + end; + 2: begin + if S='</families>' then begin + dec(Ebene); + continue; + end; + if leftStr(S,7)='<family' then begin + delete(S,1,pos('handle="',S)+7); + neufamilie:=findeFamilie(Familien,leftStr(S,pos('"',S)-1)); + Speichern:=true; + inc(Ebene); + end; + end; + end{of Case}; + end; + 3: begin + if (leftStr(s,11)='<attribute ') or (s='</attribute>') or + (leftStr(s,8)='<objref ') or (leftStr(s,13)='<citationref ') or + (s='</objref>') or (leftStr(s,9)='<noteref ') or + (leftStr(s,7)='<place ') or (leftStr(s,12)='<description') then + continue; + case UEbene of + 0: begin + if S='</event>' then begin + if not (Speichern and ((neuEreignis.Jahr<>0) or (neuEreignis.Art=eaHochzeit))) then + loescheEreignis(Ereignisse,neuEreignis.ID); + neuEreignis:=nil; + dec(Ebene); + continue; + end; + if leftStr(S,6)='<type>' then begin + delete(S,1,6); + S:=leftStr(S,pos('</type>',S)-1); + if (S='Jugendweihe') or (S='Confirmation') or (S='Engagement') or + (S='Flucht') or (S='Divorce') or (S='Military Service') or + (S='Medical Information') or (S='Education') or (S='Unknown') or + (S='Cremation') or (S='Residence') or (S='Graduation') or (S='Emigration') then begin + Speichern:=false; + Continue; + end; + if (S='Birth') or (S='Geburt') then begin + neuEreignis.Art:=eaGeburt; + Continue; + end; + if S='Christening' then begin + neuEreignis.Art:=eaTaufe; + Continue; + end; + if S='Marriage' then begin + neuEreignis.Art:=eaHochzeit; + Continue; + end; + if S='Death' then begin + neuEreignis.Art:=eaTod; + Continue; + end; + if (S='Burial') or (S='Vermißt') then begin + neuEreignis.Art:=eaBeerdigung; + Continue; + end; + writeln('Eventtyp: '+s); + continue; + end; + if leftStr(S,9)='<dateval ' then begin + delete(S,1,pos('val="',S)+4); + if (S[1] in ['0'..'9']) and + (S[2] in ['0'..'9']) and + (S[3] in ['0'..'9']) and + (S[4] in ['0'..'9']) then + neuEreignis.Jahr:=strtoint(copy(S,1,4)) + else + neuEreignis.Jahr:=0; + continue; + end; + if leftStr(s,9)='<datestr ' then + continue; + writeln('Event: '+s); + end; + 1: begin + if S='</person>' then begin + if not Speichern then + loeschePerson(Personen,neuPerson.ID); + neuPerson:=nil; + dec(Ebene); + continue; + end; + if leftStr(S,10)='<eventref ' then begin + delete(S,1,pos('hlink="',S)+6); + S:=leftStr(S,pos('"',S)-1); + neuEreignis:=findeEreignis(Ereignisse,S); + neuPerson.Ereignisse[neuEreignis.Art]:=neuEreignis; + neuEreignis:=nil; + continue; + end; + if leftstr(S,7)='<first>' then begin + delete(S,1,pos('>',S)); + NeuPerson.Vorname:=copy(S,1,pos('</first>',S)-1); + continue; + end; + if leftstr(S,9)='<surname>' then begin + delete(S,1,pos('>',S)); + NeuPerson.Nachname:=copy(S,1,pos('</surname>',S)-1); + continue; + end; + if leftstr(S,17)='<parentin hlink="' then begin + delete(S,1,pos('"',S)); + neuFamilie:=findeFamilie(Familien,leftStr(s,pos('"',s)-1)); + mergeFamilie(neuPerson.elterIn,neuFamilie); + neuFamilie:=nil; + continue; + end; + if (leftStr(s,16)='<childof hlink="') then begin + delete(S,1,pos('"',S)); + if assigned(neuPerson.KindIn) then begin + setlength(duplikatKind,length(duplikatKind)+1); + duplikatKind[length(duplikatKind)-1]:=neuPerson; + setlength(duplikatFamilie,length(duplikatFamilie)+1); + duplikatFamilie[length(duplikatFamilie)-1]:=neuPerson.KindIn; + end; + neuPerson.KindIn:=findeFamilie(Familien,leftStr(s,pos('"',s)-1)); + continue; + end; + if (leftStr(s,9)='<country>') or (leftStr(s,8)='<gender>') or + (leftStr(s,6)='<name ') or (s='</name>') or (leftStr(s,8)='<region ') or + (leftStr(s,6)='<nick>') or (s='<address>') or (s='</address>') or + (leftStr(s,6)='<city>') or (leftStr(s,12)='<familynick>') or + (leftStr(s,8)='<street>') or (leftStr(s,7)='<title>') or + (leftStr(s,6)='<call>') or (leftStr(s,9)='<dateval ') or + (leftStr(s,8)='<postal>') or (leftStr(s,7)='<state>') then + continue; + writeln('Person: '+s); + end; + 2: begin + if S='</family>' then begin + if not Speichern then + loescheFamilie(Familien,neuFamilie.ID); + neuFamilie:=nil; + dec(Ebene); + continue; + end; + if leftStr(S,5)='<rel ' then begin + delete(S,1,pos('type="',S)+5); + S:=leftStr(S,pos('"',S)-1); + if S='Married' then begin + NeuFamilie.verheiratet:=true; + continue; + end; + if (S='Unmarried') or (S='Unknown') then begin + neuFamilie.verheiratet:=false; + continue; + end; + writeln('Familienrelation: '+s); + continue; + end; + if leftStr(S,8)='<father ' then begin + delete(S,1,pos('hlink="',S)+6); + S:=leftstr(S,pos('"',S)-1); + neuFamilie.Eltern[0]:=findePerson(Personen,S); + continue; + end; + if leftStr(S,8)='<mother ' then begin + delete(S,1,pos('hlink="',S)+6); + S:=leftstr(S,pos('"',S)-1); + neuFamilie.Eltern[1]:=findePerson(Personen,S); + continue; + end; + if leftStr(S,10)='<eventref ' then begin + delete(S,1,pos('hlink="',S)+6); + S:=leftstr(S,pos('"',S)-1); + neuEreignis:=findeEreignis(Ereignisse,S); + if (neuEreignis.Art=eaHochzeit) and + ((not assigned(NeuFamilie.Anfang)) or + (NeuFamilie.Anfang.Jahr > neuEreignis.Jahr)) then + neuFamilie.Anfang:=neuEreignis; + neuEreignis:=nil; + continue; + end; + if leftStr(S,10)='<childref ' then begin + delete(S,1,pos('hlink="',S)+6); + S:=leftstr(S,pos('"',S)-1); + Setlength(NeuFamilie.Kinder,length(NeuFamilie.Kinder)+1); + NeuFamilie.Kinder[length(NeuFamilie.Kinder)-1]:=findePerson(Personen,S); + continue; + end; + if (s='</childref>') then + continue; + writeln('Familie: '+s); + end; + end{of Case}; + end; + end{of case}; + end; + f.free; + result:=Ebene=0; + if not result then begin + writeln('Korrupte .xml-Datei!'); + exit; + end; + + if length(duplikatKind)>0 then begin + writeln('*** Warnung ***'); + writeln(inttostr(length(duplikatKind)),' Kind-Familien-Beziehungen waren redundant, ich suche mir jetzt die zu den größten Familien aus!'); + for i:=0 to length(duplikatKind)-1 do begin + gefunden:=false; + for j:=0 to i-1 do + if duplikatKind[i]=duplikatKind[j] then begin + gefunden:=true; + break; + end; + if gefunden then continue; + + k:=-1; + l:=length(duplikatKind[i].KindIn.Kinder); + for j:=0 to length(duplikatKind)-1 do + if duplikatKind[j]=duplikatKind[i] then begin + if length(duplikatFamilie[j].Kinder)>l then begin + k:=j; + l:=length(duplikatFamilie[j].Kinder); + end; + end; + if l>=0 then begin + duplikatKind[i].KindIn.entferneKind(duplikatKind[i]); + duplikatKind[i].KindIn:=duplikatFamilie[k]; + end; + end; + setlength(duplikatKind,0); + setlength(duplikatFamilie,0); + end; + + konsistenzTest(false); + writeln('... fertig:'); +end; + +procedure TMetaData.generiereFehlendeInfos; +var + i,j: Longint; + dummyEreignis: tEreignis; + timeout: extended; + gefunden: boolean; +begin + writeln('aufhübschen ...'); + for i:=0 to length(Familien)-1 do + for j:=0 to 1 do + if not assigned(Familien[i].Eltern[j]) then begin + Familien[i].Eltern[j]:=tPerson.create; + Familien[i].Eltern[j].ID:=Familien[i].ID+'_automatischer_Elter'+inttostr(j); + setlength(Familien[i].Eltern[j].ElterIn,1); + Familien[i].Eltern[j].ElterIn[0]:=Familien[i]; + setlength(Personen,length(Personen)+1); + Personen[length(Personen)-1]:=Familien[i].Eltern[j]; + end; + dummyEreignis:=tEreignis.create; + dummyEreignis.ID:='<<42-DUMMY-42>>'; + dummyEreignis.Jahr:=0; + dummyEreignis.Art:=eaDummy; + setlength(Ereignisse,length(Ereignisse)+1); + Ereignisse[length(Ereignisse)-1]:=dummyEreignis; + for I:=0 to length(Familien)-1 do + if not assigned(Familien[I].Anfang) then + Familien[I].Anfang:=dummyEreignis; + for I:=0 to length(Personen)-1 do begin + if assigned(Personen[I].Ereignisse[eaGeburt]) and not Personen[I].Ereignisse[eaGeburt].istDummy then + Personen[I].Anfang:=Personen[I].Ereignisse[eaGeburt] + else if assigned(Personen[I].Ereignisse[eaTaufe]) and not Personen[I].Ereignisse[eaTaufe].istDummy then + Personen[I].Anfang:=Personen[I].Ereignisse[eaTaufe] + else + Personen[I].Anfang:=dummyEreignis; + if assigned(Personen[I].Ereignisse[eaTod]) and not Personen[I].Ereignisse[eaTod].istDummy then + Personen[I].Ende:=Personen[I].Ereignisse[eaTod] + else if assigned(Personen[I].Ereignisse[eaBeerdigung]) and not Personen[I].Ereignisse[eaBeerdigung].istDummy then + Personen[I].Ende:=Personen[I].Ereignisse[eaBeerdigung] + else Personen[I].Ende:=dummyEreignis; + Personen[I].P1:=-1; + Personen[I].P2:=-1; + Personen[I].P3:=-1; + end; + printStatus(1); + timeout:=now+1/24/60/60*3; + repeat + gefunden:=false; + for I:=0 to length(Personen)-1 do // Todesdatum aus Geburtsdatum + if Personen[i].Ende.istDummy and + not Personen[i].Anfang.istDummy then begin + setlength(Ereignisse,length(Ereignisse)+1); + Ereignisse[length(Ereignisse)-1]:=tEreignis.create; + Ereignisse[length(Ereignisse)-1].Art:=eaSonstiges; + Ereignisse[length(Ereignisse)-1].Jahr:=min(Personen[I].Anfang.Jahr+StandardLebensdauer,aktuellesJahr); + Ereignisse[length(Ereignisse)-1].ID:=Personen[I].ID+'_automatischer_Tod'; + Personen[I].Ende:=Ereignisse[length(Ereignisse)-1]; + gefunden:=true; + end; + if gefunden then continue; + for I:=0 to length(Familien)-1 do // Hochzeitsdatum aus Geburtsdatum der Kinder + if Familien[I].Anfang.istDummy and (not gefunden) and + (length(Familien[I].Kinder)>0) then + for J:=0 to length(Familien[I].Kinder)-1 do + if (not Familien[I].Kinder[J].Anfang.istDummy) and + (Familien[I].Anfang.istDummy or + (Familien[I].Kinder[J].Anfang.Jahr<=Familien[I].Anfang.Jahr)) then begin + Familien[I].Anfang:=Familien[I].Kinder[J].Anfang; + gefunden:=true; + end; + if gefunden then continue; + for I:=0 to length(Familien)-1 do // Hochzeitsdatum aus Geburtsdatum der Eltern + if Familien[I].Anfang.istDummy and not gefunden then begin + for J:=0 to 1 do + if assigned(Familien[I].Eltern[J]) and (not Familien[I].Eltern[J].Anfang.istDummy) and + (Familien[I].Anfang.istDummy or (Familien[I].Eltern[J].Anfang.Jahr>=Familien[I].Anfang.Jahr)) then begin + Familien[I].Anfang:=Familien[I].Eltern[J].Anfang; + gefunden:=true; + end; + if gefunden then begin + setlength(Ereignisse,length(Ereignisse)+1); + Ereignisse[length(Ereignisse)-1]:=tEreignis.create; + Ereignisse[length(Ereignisse)-1].ID:=Familien[i].ID+'_automatische_Hochzeit'; + Ereignisse[length(Ereignisse)-1].Jahr:=min(Familien[i].Anfang.Jahr+StandardHochzeitsalter,aktuellesJahr); + Ereignisse[length(Ereignisse)-1].Art:=eaSonstiges; + Familien[i].Anfang:=Ereignisse[length(Ereignisse)-1]; + break; + end; + end; + if gefunden then continue; + for I:=0 to length(Personen)-1 do // Geburtsdatum aus Hochzeitsdatum der Eltern + if Personen[I].Anfang.istDummy and + assigned(Personen[I].KindIn) and + not Personen[I].KindIn.Anfang.istDummy then begin + Personen[I].Anfang:=Personen[I].KindIn.Anfang; + gefunden:=true; + break; + end; + if gefunden then continue; + for I:=0 to length(Personen)-1 do // Geburtsdatum aus eigenen Hochzeitsdaten + if Personen[I].Anfang.istDummy then begin + for J:=0 to length(Personen[I].ElterIn)-1 do + if (not Personen[I].ElterIn[J].Anfang.istDummy) and + (Personen[I].Anfang.istDummy or + (Personen[I].Anfang.Jahr > Personen[I].ElterIn[J].Anfang.Jahr)) then + Personen[I].Anfang:=Personen[I].ElterIn[J].Anfang; + if not Personen[I].Anfang.istDummy then begin + setlength(Ereignisse,length(Ereignisse)+1); + Ereignisse[length(Ereignisse)-1]:=TEreignis.create; + Ereignisse[length(Ereignisse)-1].Art:=eaSonstiges; + Ereignisse[length(Ereignisse)-1].Jahr:=Personen[I].Anfang.Jahr-Standardhochzeitsalter; + Ereignisse[length(Ereignisse)-1].ID:=Personen[I].ID+'_automatische_Geburt'; + Personen[I].Anfang:=Ereignisse[length(Ereignisse)-1]; + gefunden:=true; + break; + end; + end; + if gefunden then continue; + for I:=0 to length(Personen)-1 do // Geburtsdatum aus Todesdatum + if Personen[I].Anfang.istDummy and + not Personen[I].Ende.istDummy then begin + setlength(Ereignisse,length(Ereignisse)+1); + Ereignisse[length(Ereignisse)-1]:=tEreignis.create; + Ereignisse[length(Ereignisse)-1].Art:=eaSonstiges; + Ereignisse[length(Ereignisse)-1].Jahr:=Personen[I].Ende.Jahr-StandardLebensdauer; + Ereignisse[length(Ereignisse)-1].ID:=Personen[I].ID+'_automatische_Geburt'; + Personen[I].Anfang:=Ereignisse[length(Ereignisse)-1]; + gefunden:=true; + break; + end; + until (not gefunden) or (now>=timeout); + if gefunden then begin + writeln('Zeitüberschreitung erreicht!'); + halt(1); + end; + + gefunden:=false; + for i:=0 to length(Personen)-1 do + if Personen[i].Anfang.istDummy or Personen[i].Ende.istDummy then begin + gefunden:=true; + write('*** Warnung *** Dummy gefunden! ('); + if Personen[i].Anfang.istDummy then write('Geburt'); + if Personen[i].Ende.istDummy then begin + if Personen[i].Anfang.istDummy then write(', '); + write('Tod'); + end; + writeln(') '+Personen[i].ID+' '+Personen[i].Vorname+' '+Personen[i].Nachname); + if assigned(Personen[i].KindIn) then + writeln(' '+inttostr(byte(Personen[i].KindIn.Anfang.istDummy))+' '+inttostr(integer(Personen[i].KindIn.Anfang.Art))+' '+inttostr(Personen[i].KindIn.Anfang.Jahr)); + writeln(' '+inttostr(length(Personen[i].ElterIn))); + for j:=0 to length(Personen[i].ElterIn)-1 do + writeln(' '+inttostr(byte(Personen[i].ElterIn[j].Anfang.istDummy))+' '+inttostr(integer(Personen[i].ElterIn[j].Anfang.Art))+' '+inttostr(Personen[i].ElterIn[j].Anfang.Jahr)); + end; + for i:=0 to length(Familien)-1 do + if Familien[i].Anfang.istDummy then begin + gefunden:=true; + writeln('*** Warnung *** Dummy gefunden! (Hochzeit) '+Familien[i].ID); + if assigned(Familien[i].Eltern[0]) then writeln(' E '+inttostr(byte(Familien[i].Eltern[0].Anfang.istDummy))+' '+Familien[i].Eltern[0].Vorname+' '+Familien[i].Eltern[0].Nachname); + if assigned(Familien[i].Eltern[1]) then writeln(' E '+inttostr(byte(Familien[i].Eltern[0].Anfang.istDummy))+' '+Familien[i].Eltern[1].Vorname+' "'+Familien[i].Eltern[1].Nachname+'"'); + for j:=0 to length(Familien[i].Kinder)-1 do + writeln(' '+inttostr(byte(Familien[i].Kinder[j].Anfang.istDummy))+' '+Familien[i].Kinder[j].Vorname+' '+Familien[i].Kinder[j].Nachname); + end; + + if gefunden then halt(1); + + for I:=0 to length(Personen)-1 do + if assigned(Personen[I].KindIn) and + (Personen[I].KindIn.Anfang.Jahr > Personen[I].Anfang.Jahr) then + Personen[I].KindIn.Anfang:=Personen[I].Anfang; + + indizesErzeugen; + writeln('... fertig'); +end; + +function TMetaData.analysiereInteraktionen: boolean; +var + i,j,k,l: longint; + speichern, + gefunden: boolean; + c: char; + Ps: tIntArray; + p: tPerson; +begin + writeln('Verknüpfungen und Interaktionen analysieren ...'); + ParameterLaenge:=0; + setlength(Verknuepfungen,0); + setlength(MMInteraktionen,0); + Setlength(MFInteraktionen,0); + setlength(FFInteraktionen,0); + setlength(ParameterAttribute,0); + for I:=0 to length(Personen)-1 do begin + if assigned(Personen[I].KindIn) then begin + Personen[I].P3:=ParameterLaenge; + if ParameterLaenge>=length(ParameterAttribute) then + setlength(ParameterAttribute,ParameterLaenge+1024); + ParameterAttribute[ParameterLaenge].istKoordinate:=false; + ParameterAttribute[ParameterLaenge].istUnabhaengig:=true; + inc(ParameterLaenge); + end + else begin + Personen[I].P1:=ParameterLaenge; + Personen[I].P2:=ParameterLaenge+1; + if ParameterLaenge>=length(ParameterAttribute)-1 then + setlength(ParameterAttribute,ParameterLaenge+1024); + ParameterAttribute[ParameterLaenge].istKoordinate:=true; + ParameterAttribute[ParameterLaenge].istUnabhaengig:=true; + ParameterAttribute[ParameterLaenge+1].istKoordinate:=true; + ParameterAttribute[ParameterLaenge+1].istUnabhaengig:=true; + ParameterLaenge:=ParameterLaenge+2; + end; + end; + + repeat + gefunden:=false; + for I:=0 to length(Personen)-1 do + if (Personen[i].P1=-1) and + (Personen[i].KindIn.Eltern[0].P1<>-1) and + (Personen[i].KindIn.Eltern[1].P1<>-1) then begin + Setlength(Verknuepfungen,length(Verknuepfungen)+1); + Verknuepfungen[length(Verknuepfungen)-1]:=tVerknuepfung.create; + Verknuepfungen[length(Verknuepfungen)-1].outP:=Personen[I]; + Verknuepfungen[length(Verknuepfungen)-1].Lambda:=Personen[I].P3; + for J:=0 to 1 do begin + Verknuepfungen[length(Verknuepfungen)-1].Input[J,'x']:= + Personen[I].KindIn.Eltern[J].P1; + Verknuepfungen[length(Verknuepfungen)-1].Input[J,'y']:= + Personen[I].KindIn.Eltern[J].P2; + end; + if ParameterLaenge>=length(ParameterAttribute)-1 then + setlength(ParameterAttribute,ParameterLaenge+1024); + ParameterAttribute[ParameterLaenge].istKoordinate:=true; + ParameterAttribute[ParameterLaenge].istUnabhaengig:=false; + ParameterAttribute[ParameterLaenge+1].istKoordinate:=true; + ParameterAttribute[ParameterLaenge+1].istUnabhaengig:=false; + Personen[i].P1:=ParameterLaenge; + Personen[i].P2:=ParameterLaenge+1; + ParameterLaenge:=ParameterLaenge+2; + Verknuepfungen[length(Verknuepfungen)-1].Output['x']:=Personen[I].P1; + Verknuepfungen[length(Verknuepfungen)-1].Output['y']:=Personen[I].P2; + gefunden:=true; + end; + until not gefunden; + + setlength(ParameterAttribute,ParameterLaenge); + + gefunden:=false; + for i:=0 to length(Personen)-1 do + if Personen[i].P1=-1 then begin + writeln(inttostr(i)+' '+Personen[i].Vorname+' '+Personen[i].Nachname); + gefunden:=true; + end; + if gefunden then begin + result:=false; + exit; + end; + + setlength(Ps,ParameterLaenge); + for J:=0 to length(Ps)-1 do begin + ParameterAttribute[j].wirdBenutzt:=true; + Ps[J]:=Byte(ParameterAttribute[j].istUnabhaengig); + end; + for I:=0 to length(Verknuepfungen)-1 do begin + for J:=I to length(Verknuepfungen)-1 do begin + speichern:=Ps[Verknuepfungen[J].Lambda]=1; + for K:=0 to 1 do + for C:='x' to 'y' do + speichern:=speichern and + (Ps[Verknuepfungen[J].Input[K,C]]=1); + for C:='x' to 'y' do + speichern:=speichern and + (Ps[Verknuepfungen[J].Output[C]]=0); + if speichern then begin + for K:=0 to 1 do begin + for C:='x' to 'y' do begin + L:=Verknuepfungen[J].Input[K,C]; + Verknuepfungen[J].Input[K,C]:=Verknuepfungen[I].Input[K,C]; + Verknuepfungen[I].Input[K,C]:=L; + end; + end; + p:=Verknuepfungen[J].outP; + Verknuepfungen[J].outP:=Verknuepfungen[I].outP; + Verknuepfungen[I].outP:=p; + for C:='x' to 'y' do begin + L:=Verknuepfungen[J].Output[C]; + Verknuepfungen[J].Output[C]:=Verknuepfungen[I].Output[C]; + Verknuepfungen[I].Output[C]:=L; + end; + L:=Verknuepfungen[J].Lambda; + Verknuepfungen[J].Lambda:=Verknuepfungen[I].Lambda; + Verknuepfungen[I].Lambda:=L; + for C:='x' to 'y' do + Ps[Verknuepfungen[I].Output[C]]:=1; + break; + end; + end; + if not speichern then begin + writeln('Warnung: Keine berechenbare Verknüpfung gefunden!: I=',I); + result:=false; + exit; + end; + end; + for I:=0 to length(Ps)-1 do + if Ps[I]<>1 then + begin + writeln('Warnung: Nicht alle Parameter wurden berechnet! ',I); + result:=false; + exit; + end; + setlength(Ps,0); + for I:=0 to length(Personen)-1 do + for J:=0 to I-1 do begin + K:=min( + Personen[I].Ende.Jahr-Personen[J].Anfang.Jahr, + Personen[J].Ende.Jahr-Personen[I].Anfang.Jahr)+1+Zusatzueberlapp; + if K>0 then begin + setlength(MMInteraktionen,length(MMInteraktionen)+1); + MMInteraktionen[length(MMInteraktionen)-1]:=tMMInteraktion.create; + MMInteraktionen[length(MMInteraktionen)-1].Laenge:=min(K,Ueberlappcutoff); + MMInteraktionen[length(MMInteraktionen)-1]._Ps[0]:=Personen[I]; + MMInteraktionen[length(MMInteraktionen)-1]._Ps[1]:=Personen[J]; + MMInteraktionen[length(MMInteraktionen)-1].index:=length(MMInteraktionen)-1; + end; + end; + for I:=0 to length(Personen)-1 do + for J:=0 to length(Familien)-1 do begin + speichern:=Personen[I].KindIn<>Familien[J]; + for K:=0 to length(Personen[I].ElterIn)-1 do + speichern:=speichern and (Personen[I].ElterIn[K]<>Familien[J]); + if speichern then begin + K:=min( + Familien[J].Anfang.Jahr-Personen[I].Anfang.Jahr, + Personen[I].Ende.Jahr-Familien[J].Anfang.Jahr)+1+Jahrestoleranz; + if K>0 then begin + setlength(MFInteraktionen,length(MFInteraktionen)+1); + MFInteraktionen[length(MFInteraktionen)-1]:=tMFInteraktion.create; + MFInteraktionen[length(MFInteraktionen)-1].Laenge:=min(K,Ueberlappcutoff); + MFInteraktionen[length(MFInteraktionen)-1]._P:=Personen[I]; + MFInteraktionen[length(MFInteraktionen)-1]._F:=Familien[J]; + MFInteraktionen[length(MFInteraktionen)-1].index:=length(MFInteraktionen)-1; + end; + end; + end; + for I:=0 to length(Familien)-1 do + for J:=0 to I-1 do begin + speichern:=true; + for K:=0 to 1 do + for L:=0 to 1 do + speichern:=speichern and + (Familien[I].Eltern[K]<>Familien[J].Eltern[L]); + K:=Jahrestoleranz+1-abs(Familien[I].Anfang.Jahr-Familien[J].Anfang.Jahr); + if (K>0) and speichern then begin + setlength(FFInteraktionen,length(FFInteraktionen)+1); + FFInteraktionen[length(FFInteraktionen)-1]:=tFFInteraktion.create; + FFInteraktionen[length(FFInteraktionen)-1]._Fs[0]:=Familien[I]; + FFInteraktionen[length(FFInteraktionen)-1]._Fs[1]:=Familien[J]; + FFInteraktionen[length(FFInteraktionen)-1].index:=length(FFInteraktionen)-1; + end; + end; + setlength(Tauschfamilien,0); + for I:=0 to length(Familien)-1 do + if length(Familien[I].Kinder)>=2 then begin + setlength(Tauschfamilien,length(Tauschfamilien)+1); + Tauschfamilien[length(Tauschfamilien)-1]:=Familien[I]; + end; + if assigned(Sicherung) then begin + writeln('... und noch die der Sicherung'); + result:=Sicherung.analysiereInteraktionen; + end + else begin + writeln('... fertig'); + result:=true; + end; +end; + +function tMetaData.findeKreise: tPointArrayArray; // x: Person, y: Familie +var Graph: tGraph; // Ecke.x=0 ... Person; Ecke.x=1 ... Familie; Ecke.y=Index; + i,j,n: longint; + Kreise: tIntArrayArray; +begin + setlength(result,0); + Graph:=tGraph.create; + setlength(Graph.Ecken,length(Personen)+length(Familien)); + n:=0; + for i:=0 to length(Personen)-1 do begin + Graph.Ecken[i].x:=0; + Graph.Ecken[i].y:=i; + end; + for i:=0 to length(Familien)-1 do begin + Graph.Ecken[i+length(Personen)].x:=1; + Graph.Ecken[i+length(Personen)].y:=i; + n:=n+2+length(Familien[i].Kinder); + end; + setlength(Graph.Kanten,n); + n:=0; + for i:=0 to length(Familien)-1 do begin + for j:=0 to 1 do begin + Graph.Kanten[n].x:=i+length(Personen); // die Familie + Graph.Kanten[n].y:=Familien[i].Eltern[j].Index; // der Elter + inc(n); + end; + for j:=0 to length(Familien[i].Kinder)-1 do begin + Graph.Kanten[n].x:=i+length(Personen); // die Familie + Graph.Kanten[n].y:=Familien[i].Kinder[j].Index; // das Kind + inc(n); + end; + end; + Kreise:=Graph.findeKreise; + setlength(result,length(Kreise)); + for i:=0 to length(result)-1 do begin + setlength(result[i],length(Kreise[i])); + for j:=0 to length(Kreise[i])-1 do + if Graph.Ecken[Graph.Kanten[Kreise[i,j]].x].x = 0 then begin + result[i,j].x:=Graph.Ecken[Graph.Kanten[Kreise[i,j]].x].y; + result[i,j].y:=Graph.Ecken[Graph.Kanten[Kreise[i,j]].y].y; + end + else if Graph.Ecken[Graph.Kanten[Kreise[i,j]].y].x = 0 then begin + result[i,j].x:=Graph.Ecken[Graph.Kanten[Kreise[i,j]].y].y; + result[i,j].y:=Graph.Ecken[Graph.Kanten[Kreise[i,j]].x].y; + end + else writeln('Kein Ende der Kante ist eine Person!'); + end; +end; + +procedure tMetaData.blaetterAbschneiden; +var + i,j,k,cnt: longint; + gefunden: boolean; +begin + if assigned(sicherung) or (length(Laubhaufen)<>0) then begin + writeln('*** Warnung ***'); + writeln('Hier waren schon Blätter gesichert, die ich jetzt vernichte.'); + sicherung.free; + setlength(Laubhaufen,0); + end; + + sicherung:=tMetaData.create; + sicherung.init(self); + sicherung.indizesErzeugen; + + for i:=0 to length(ParameterAttribute)-1 do + ParameterAttribute[i].wirdBenutzt:=true; + + cnt:=0; + + konsistenzTest(true); + + repeat + gefunden:=false; + for i:=length(Personen)-1 downto 0 do // Personen entfernen, die keine Eltern (mehr) sind + if length(Personen[i].elterIn) = 0 then begin + if cnt>=length(Laubhaufen) then + setlength(Laubhaufen,length(Laubhaufen)+1024); + Laubhaufen[cnt]:=findePerson(sicherung.Personen,pPersonToStr(Personen[i])); // Person sichern + sicherung.habePersonGeloescht(Laubhaufen[cnt] as tPerson); + inc(cnt); + + loescheAlleVerbindungenZu(Personen[i],nil); + + ParameterAttribute[Personen[i].p1].setzeBenutzt(false); // x, + ParameterAttribute[Personen[i].p2].setzeBenutzt(false); // y + if assigned(Personen[i].KindIn) then // und ggf. + ParameterAttribute[Personen[i].p3].setzeBenutzt(false); // Lambda unbenutzen + + loeschePerson(Personen,pPersonToStr(Personen[i])); // Person löschen + gefunden:=true; + end; + + for i:=length(Familien)-1 downto 0 do // Familien entfernen, die nur noch höchstens ein relevantes Mitglied haben + if byte(assigned(Familien[i].Eltern[0]) and (Familien[i].Eltern[0].anzahlVerbindungen>1)) + // Eltern brauchen mehr als die Verbindung zu + byte(assigned(Familien[i].Eltern[1]) and (Familien[i].Eltern[1].anzahlVerbindungen>1)) + // dieser Familie um relevant zu sein, + length(Familien[i].Kinder) <= 1 then begin // Kinder müssen dagegen lediglich vorhanden sein + if cnt>=length(Laubhaufen) then + setlength(Laubhaufen,length(Laubhaufen)+1024); + Laubhaufen[cnt]:=findeFamilie(sicherung.Familien,pFamilieToStr(Familien[i])); // Familie sichern + sicherung.habeFamilieGeloescht(Laubhaufen[cnt] as tFamilie); + inc(cnt); + + for j:=length(Tauschfamilien)-1 downto 0 do + if Tauschfamilien[j]=Familien[i] then begin // Familie aus Tauschfamilien löschen + for k:=j+1 to length(Tauschfamilien)-1 do + Tauschfamilien[k-1]:=Tauschfamilien[k]; + setlength(Tauschfamilien,length(Tauschfamilien)-1); + end; + + for j:=0 to 1 do + if assigned(Familien[i].Eltern[j]) and + (Familien[i].Eltern[j].anzahlVerbindungen<=1) then begin // irrelevanter Elter + sicherung.habePersonGeloescht(findePerson(sicherung.Personen,pPersonToStr(Familien[i].Eltern[j]),false)); + ParameterAttribute[Familien[i].Eltern[j].p1].setzeBenutzt(false); // x, + ParameterAttribute[Familien[i].Eltern[j].p2].setzeBenutzt(false); // y unbenutzen + + loescheAlleVerbindungenZu(Familien[i].Eltern[j],nil); + loeschePerson(Personen,pPersonToStr(Familien[i].Eltern[j])); // Elter löschen + end; + + // Kinder können per definitionem nicht irrelevant sein, daher muss man auch keine löschen + + if length(Familien[i].Kinder)=1 then begin + loescheVerknuepfungenZu(Familien[i].Kinder[0]); + ParameterAttribute[Familien[i].Kinder[0].p3].setzeBenutzt(false); // Lambda unbenutzen + ParameterAttribute[Familien[i].Kinder[0].p1].setzeUnabhaengig(true); // x, + ParameterAttribute[Familien[i].Kinder[0].p2].setzeUnabhaengig(true); // y befreien + end; + + loescheAlleVerbindungenZu(nil,Familien[i]); + + loescheFamilie(Familien,pFamilieToStr(Familien[i])); // Familie löschen + gefunden:=true; + end; + until not gefunden; + setlength(Laubhaufen,cnt); + arraysAufraeumen; +end; + +procedure tMetaData.letztesBlattWiederAnkleben(out vkn: tVerknuepfung; out p: tPerson); +var + i,j: longint; + gefunden: boolean; + sp1,sp2: tPerson; + sf: tFamilie; +begin + if (not assigned(sicherung)) or (length(Laubhaufen)=0) then begin + writeln('*** Fehler ***'); + writeln('Ich habe keine Blätter mehr übrig.'); + halt; + end; + + p:=nil; + sp1:=nil; + sp2:=nil; + sf:=nil; + vkn:=nil; + + if Laubhaufen[length(Laubhaufen)-1] is tPerson then begin // diese Person ist (zur Zeit) nur ein Kind und kann einfach eingefügt werden + write('k'); + setlength(Personen,length(Personen)+1); + Personen[length(Personen)-1]:=tPerson.create; + Personen[length(Personen)-1].init(Laubhaufen[length(Laubhaufen)-1],Ereignisse,Familien,false); // Person wird kopiert, aber zugehörige Familien werden nicht auch noch erzeugt! + sicherung.habePersonHinzugefuegt(Laubhaufen[length(Laubhaufen)-1] as tPerson); + sp1:=Laubhaufen[length(Laubhaufen)-1] as tPerson; + Personen[length(Personen)-1].index:=length(Personen)-1; + p:=Personen[length(Personen)-1]; + Parameterattribute[p.p1].setzeBenutzt(true); + Parameterattribute[p.p2].setzeBenutzt(true); + + if not (assigned(p.KindIn) and assigned(p.KindIn.Eltern[0]) and assigned(p.KindIn.Eltern[1])) then begin + writeln('*** Fehler ***'); + writeln('Als Kind einzufügende Person hat hier nicht beide Eltern!'); + halt; + end; + + gefunden:=false; + for i:=0 to length(sicherung.Verknuepfungen)-1 do + if sicherung.Verknuepfungen[i].outP=Laubhaufen[length(Laubhaufen)-1] then begin + if gefunden then begin + writeln('*** Fehler ***'); + writeln('Als Kind einzufügende Person wird durch mehr als eine Verknüpfung berechnet!'); + halt; + end; + setlength(Verknuepfungen,length(Verknuepfungen)+1); // die neue Verknuepfung wird einfach hinten angestellt + Verknuepfungen[length(Verknuepfungen)-1]:=strToTVerknuepfung(Personen,tVerknuepfungToStr(sicherung.Verknuepfungen[i])); + Verknuepfungen[length(Verknuepfungen)-1].index:=length(Verknuepfungen)-1; + vkn:=Verknuepfungen[length(Verknuepfungen)-1]; + Parameterattribute[vkn.Lambda].setzeBenutzt(true); + gefunden:=true; + end; + if not gefunden then begin + writeln('*** Fehler ***'); + writeln('Als Kind einzufügende Person wird durch keine Verknüpfung berechnet!'); + halt; + end; + setlength(Laubhaufen,length(Laubhaufen)-1); + end + else if Laubhaufen[length(Laubhaufen)-1] is tFamilie then begin // Familie inkl. Elter(n) einfügen (keine neuen Kinder!) + write('f'); + j:=-1; + for i:=0 to 1 do + if findePerson(Personen,pPersonToStr((Laubhaufen[length(Laubhaufen)-1] as tFamilie).Eltern[i]),false)<>nil then begin + if j<>-1 then begin + writeln('*** Fehler ***'); + writeln('Beide Eltern der neuen Familie waren schon vorhanden!'); + halt; + end; + j:=i; + end; + for i:=0 to 1 do + if i<>j then begin + setlength(Personen,length(Personen)+1); + Personen[length(Personen)-1]:=tPerson.create; + Personen[length(Personen)-1].init((Laubhaufen[length(Laubhaufen)-1] as tFamilie).Eltern[i],Ereignisse,Familien,false); // neuer Elter wird kopiert, aber zugehörige Familien werden nicht auch noch erzeugt! + Personen[length(Personen)-1].index:=length(Personen)-1; + sicherung.habePersonHinzugefuegt((Laubhaufen[length(Laubhaufen)-1] as tFamilie).Eltern[i]); + sp2:=sp1; + p:=Personen[length(Personen)-1]; + sp1:=(Laubhaufen[length(Laubhaufen)-1] as tFamilie).Eltern[i]; + Parameterattribute[p.p1].setzeBenutzt(true); + Parameterattribute[p.p2].setzeBenutzt(true); + end; + + setlength(Familien,length(Familien)+1); + Familien[length(Familien)-1]:=tFamilie.create; + Familien[length(Familien)-1].init(Laubhaufen[length(Laubhaufen)-1],Ereignisse,Personen,false); // Familie wird kopiert, aber Angehörige (insbesondere die Kinder) werden nicht auch noch erzeugt! + Familien[length(Familien)-1].index:=length(Familien)-1; + sf:=Laubhaufen[length(Laubhaufen)-1] as tFamilie; + sicherung.habeFamilieHinzugefuegt(sf); + + if (j<>-1) and (length(Familien[length(Familien)-1].Kinder)<>0) then begin + writeln('*** Fehler ***'); + writeln('Die neu eingefügte Familie hat schon ein Elter und ein Kind!'); + halt; + end; + if (j=-1) and (length(Familien[length(Familien)-1].Kinder)<>1) then begin + writeln('*** Fehler ***'); + writeln('Die neu eingefügte Familie hat noch kein Kind obwohl beide Eltern neu sind!'); + halt; + end; + + for i:=0 to length(sicherung.Tauschfamilien)-1 do + if sicherung.Tauschfamilien[i]=Laubhaufen[length(Laubhaufen)-1] then begin // Tauschfamilie rücksichern + setlength(Tauschfamilien,length(Tauschfamilien)+1); + Tauschfamilien[length(Tauschfamilien)-1]:=Familien[length(Familien)-1]; + end; + + if j=-1 then begin // beide Eltern sind neu, dann wird auch die Verknüpfung zurückgesichert! + write('E'); + gefunden:=false; + for i:=0 to length(sicherung.Verknuepfungen)-1 do + if (sicherung.Verknuepfungen[i].outP.KindIn=Laubhaufen[length(Laubhaufen)-1]) and // die Verknüpfung bezieht sich auf die Familie + sicherung.istPersonAuchDrueber(sicherung.Verknuepfungen[i].outP) then begin // und das berechnete Kind ist schon zurückgesichert + if gefunden then begin + writeln('*** Fehler ***'); + writeln('Die neue Familie bringt mehr als eine Verknüpfung mit!'); + halt; + end; + + setlength(Verknuepfungen,length(Verknuepfungen)+1); // die neue Verknuepfung wird einfach vorne angestellt + for j:=length(Verknuepfungen)-1 downto 1 do begin + Verknuepfungen[j]:=Verknuepfungen[j-1]; + Verknuepfungen[j].index:=j; + end; + Verknuepfungen[0]:=strToTVerknuepfung(Personen,tVerknuepfungToStr(sicherung.Verknuepfungen[i])); + Verknuepfungen[0].index:=0; + vkn:=Verknuepfungen[0]; + Parameterattribute[vkn.Lambda].setzeBenutzt(true); + ParameterAttribute[vkn.Output['x']].setzeUnabhaengig(false); // x, + ParameterAttribute[vkn.Output['y']].setzeUnabhaengig(false); // y abhängig machen + // Die restlichen Parameter werden als benutzt markiert, wenn die entsprechenden Personen eingefügt werden. + + gefunden:=true; + end; + if not gefunden then begin + writeln('*** Fehler ***'); + writeln('Beide Eltern sind neu, aber es gibt keine passende Verknüpfung!'); + halt; + end; + p:=nil; + + j:=-1; + end; + + setlength(Laubhaufen,length(Laubhaufen)-1); + end + else begin + writeln('*** Fehler ***'); + writeln('Das wieder einzufügende Blatt ist weder eine Person noch eine Familie!'); + halt; + end; + + if assigned(sp1) then begin + for i:=0 to length(sp1.inMMInteraktion)-1 do + if sicherung.istPersonAuchDrueber(sp1.inMMInteraktion[i]._Ps[0]) and // beide Personen sind + sicherung.istPersonAuchDrueber(sp1.inMMInteraktion[i]._Ps[1]) then begin // auch hier vorhanden + setlength(MMInteraktionen,length(MMInteraktionen)+1); + MMInteraktionen[length(MMInteraktionen)-1]:=ImportMMInteraktion(Personen,tMMInteraktionToStr(sp1.inMMInteraktion[i])); // Interaktion erzeugen + end; + for i:=0 to length(sp1.inMFInteraktion)-1 do + if sicherung.istFamilieAuchDrueber(sp1.inMFInteraktion[i]._F) then begin // Familie hier vorhanden + setlength(MFInteraktionen,length(MFInteraktionen)+1); + MFInteraktionen[length(MFInteraktionen)-1]:=ImportMFInteraktion(Personen,Familien,tMFInteraktionToStr(sp1.inMFInteraktion[i])); + end; + end; + + if assigned(sp2) and (sp1<>sp2) then begin + for i:=0 to length(sp2.inMMInteraktion)-1 do + if sicherung.istPersonAuchDrueber(sp2.inMMInteraktion[i]._Ps[0]) and // beide Personen sind + sicherung.istPersonAuchDrueber(sp2.inMMInteraktion[i]._Ps[1]) and // auch hier vorhanden und + (sp2.inMMInteraktion[i]._Ps[0]<>sp1) and // beide Personen sind + (sp2.inMMInteraktion[i]._Ps[1]<>sp1) then begin // nicht sp1 (sonst wurde die MMInteraktion oben schon rückgesichert) + setlength(MMInteraktionen,length(MMInteraktionen)+1); + MMInteraktionen[length(MMInteraktionen)-1]:=ImportMMInteraktion(Personen,tMMInteraktionToStr(sp2.inMMInteraktion[i])); // Interaktion erzeugen + end; + for i:=0 to length(sp2.inMFInteraktion)-1 do + if sicherung.istFamilieAuchDrueber(sp2.inMFInteraktion[i]._F) then begin // Familie hier vorhanden + setlength(MFInteraktionen,length(MFInteraktionen)+1); + MFInteraktionen[length(MFInteraktionen)-1]:=ImportMFInteraktion(Personen,Familien,tMFInteraktionToStr(sp2.inMFInteraktion[i])); + end; + end; + + if assigned(sf) then begin + for i:=0 to length(sf.inMFInteraktion)-1 do + if sicherung.istPersonAuchDrueber(sf.inMFInteraktion[i]._P) and // Familie hier vorhanden + (sf.inMFInteraktion[i]._P<>sp1) and // und Person weder sp1 + (sf.inMFInteraktion[i]._P<>sp2) then begin // noch sp2 (sonst wurde die MFInteraktion oben schon rückgesichert) + setlength(MFInteraktionen,length(MFInteraktionen)+1); + MFInteraktionen[length(MFInteraktionen)-1]:=ImportMFInteraktion(Personen,Familien,tMFInteraktionToStr(sf.inMFInteraktion[i])); + end; + for i:=0 to length(sf.inFFInteraktion)-1 do + if sicherung.istFamilieAuchDrueber(sf.inFFInteraktion[i]._Fs[0]) and // beide Familienda sind + sicherung.istFamilieAuchDrueber(sf.inFFInteraktion[i]._Fs[1]) then begin // auch hier vorhanden + setlength(FFInteraktionen,length(FFInteraktionen)+1); + FFInteraktionen[length(FFInteraktionen)-1]:=ImportFFInteraktion(Familien,tFFInteraktionToStr(sf.inFFInteraktion[i])); + end; + end; + + if length(Laubhaufen)=0 then begin + pruefeAufGleichheit(sicherung); + sicherung.free; + sicherung:=nil; + end; +end; + +procedure tMetaData.nurGroeszteZusammenhangskomponente; +var + i,j,k,l: longint; + zhks: array of tZusammenhangskomponente; + gefunden: boolean; +begin + setlength(Zhks,0); + for i:=0 to length(Personen)-1 do begin + k:=-1; + j:=0; + while j<length(Zhks) do begin + if Zhks[j].grenztAn(Personen[i]) then begin + if k=-1 then begin + k:=j; + inc(j); + continue; + end; + Zhks[k].verschmelzeMit(Zhks[j]); + Zhks[j].free; + for l:=j+1 to length(Zhks)-1 do + Zhks[l-1]:=Zhks[l]; + setlength(Zhks,length(Zhks)-1); + end; + inc(j); + end; + if k=-1 then begin + setlength(Zhks,length(Zhks)+1); + Zhks[length(Zhks)-1]:=tZusammenhangskomponente.create; + k:=length(Zhks)-1; + end; + Zhks[k].UmfeldEinfuegen(Familien,Personen[i]); + end; + if length(Zhks)=1 then begin + Zhks[0].free; + setlength(Zhks,0); + exit; + end; + writeln('*** Warnung ***'); + writeln(inttostr(length(Zhks))+' Zusammenhangskomponenten gefunden. ('+inttostr(length(Familien))+' Familien und '+inttostr(length(Personen))+' Personen)'); + j:=0; + k:=-1; + for i:=0 to length(Zhks)-1 do begin + write(' '+inttostr(length(Zhks[i].Familien))); + if length(Zhks[i].Familien)>j then begin + j:=length(Zhks[i].Familien); + k:=i; + end; + end; + writeln; + writeln('Da nehme ich doch die '+inttostr(k+1)+'. mit '+inttostr(j)+' Familien!'); + for i:=length(Personen)-1 downto 0 do begin // überflüssige Personen löschen + if not Zhks[k].grenztAn(Personen[i]) then begin + Personen[i].free; + for j:=i+1 to length(Personen)-1 do + Personen[j-1]:=Personen[j]; + setlength(Personen,length(Personen)-1); + end; + end; + for i:=length(Familien)-1 downto 0 do begin + gefunden:=false; + for j:=0 to length(Zhks[k].Familien)-1 do + gefunden:=gefunden or (Zhks[k].Familien[j]=Familien[i]); + if not gefunden then begin + Familien[i].free; + for j:=i+1 to length(Familien)-1 do + Familien[j-1]:=Familien[j]; + setlength(Familien,length(Familien)-1); + end; + end; + writeln(inttostr(length(Personen))+' Personen und '+inttostr(length(Familien))+' Familien sind übrig.'); + writeln('***'); + for i:=0 to length(Zhks)-1 do + Zhks[i].free; + setlength(Zhks,0); +end; + +procedure tMetaData.konsistenzTest(mitIndizes: boolean); +var + i,j,k,anz: longint; +begin + if assigned(sicherung) then begin + for i:=0 to length(sicherung.Personen)-1 do + if sicherung.istPersonAuchDrueber(sicherung.Personen[i]) xor + (findePerson(Personen,pPersonToStr(sicherung.Personen[i]),false)<>nil) then begin + write('Person '''+tPersonToStr(sicherung.Personen[i])+''' ist in Sicherung fälschlicherweise als '''); + if not sicherung.istPersonAuchDrueber(sicherung.Personen[i]) then + write('nicht-'); + writeln('auchdrüber'' markiert!'); + halt; + end; + for i:=0 to length(sicherung.Familien)-1 do + if sicherung.istFamilieAuchDrueber(sicherung.Familien[i]) xor + (findeFamilie(Familien,pFamilieToStr(sicherung.Familien[i]),false)<>nil) then begin + write('Familie '''+tFamilieToStr(sicherung.Familien[i])+''' ist in Sicherung fälschlicherweise als '''); + if not sicherung.istFamilieAuchDrueber(sicherung.Familien[i]) then + write('nicht-'); + writeln('auchdrüber'' markiert!'); + halt; + end; + end; + for i:=0 to length(Verknuepfungen)-1 do begin + if mitIndizes and (Verknuepfungen[i].index<>i) then begin + writeln('Verknüpfung an Stelle '+inttostr(i)+' hat Index '+inttostr(Verknuepfungen[i].index)+'.'); + halt; + end; + if assigned(Verknuepfungen[i].outP) then begin + if (Verknuepfungen[i].outP.p1<>Verknuepfungen[i].Output['x']) or + (Verknuepfungen[i].outP.p2<>Verknuepfungen[i].Output['y']) or + (Verknuepfungen[i].outP.p3<>Verknuepfungen[i].lambda) or + (Verknuepfungen[i].outP.KindIn.Eltern[0].p1<>Verknuepfungen[i].Input[0,'x']) or + (Verknuepfungen[i].outP.KindIn.Eltern[0].p2<>Verknuepfungen[i].Input[0,'y']) or + (Verknuepfungen[i].outP.KindIn.Eltern[1].p1<>Verknuepfungen[i].Input[1,'x']) or + (Verknuepfungen[i].outP.KindIn.Eltern[1].p2<>Verknuepfungen[i].Input[1,'y']) then begin + writeln('Verknüpfung '''+tVerknuepfungToStr(Verknuepfungen[i])+''' hat inkonsistente Parametereinträge!'); + halt; + end; + if (not Parameterattribute[Verknuepfungen[i].outP.p1].wirdBenutzt) or + (not Parameterattribute[Verknuepfungen[i].outP.p2].wirdBenutzt) or + (not Parameterattribute[Verknuepfungen[i].outP.p3].wirdBenutzt) or + (not Parameterattribute[Verknuepfungen[i].outP.p1].istKoordinate) or + (not Parameterattribute[Verknuepfungen[i].outP.p2].istKoordinate) or + Parameterattribute[Verknuepfungen[i].outP.p3].istKoordinate or + Parameterattribute[Verknuepfungen[i].outP.p1].istUnabhaengig or + Parameterattribute[Verknuepfungen[i].outP.p2].istUnabhaengig or + (not Parameterattribute[Verknuepfungen[i].outP.p3].istUnabhaengig) then begin + writeln('Parameter zu Verknüpfung '''+tVerknuepfungToStr(Verknuepfungen[i])+''' haben falsche Attribute: '+ + Parameterattribute[Verknuepfungen[i].outP.p1].toChar+ + Parameterattribute[Verknuepfungen[i].outP.p2].toChar+ + Parameterattribute[Verknuepfungen[i].outP.p3].toChar+'!'); + halt; + end; + anz:=0; + for j:=0 to length(Verknuepfungen[i].outP.outputIn)-1 do + if Verknuepfungen[i].outP.outputIn[j]=Verknuepfungen[i] then + inc(anz); + if anz=0 then begin + writeln('Verknüpfung '''+tVerknuepfungToStr(Verknuepfungen[i])+''' behauptet fälschlicherweise, Person '''+tPersonToStr(Verknuepfungen[i].outP)+''' zu berechnen!'); + halt; + end; + if anz>1 then begin + writeln('Verknüpfung '''+tVerknuepfungToStr(Verknuepfungen[i])+''' ist mehrfach in Person '''+tPersonToStr(Verknuepfungen[i].outP)+''' als Quelle verzeichnet!'); + halt; + end; + for k:=0 to 1 do begin + anz:=0; + for j:=0 to length(Verknuepfungen[i].outP.KindIn.Eltern[k].inputIn)-1 do + if Verknuepfungen[i].outP.KindIn.Eltern[k].inputIn[j]=Verknuepfungen[i] then + inc(anz); + if anz=0 then begin + writeln('Verknüpfung '''+tVerknuepfungToStr(Verknuepfungen[i])+''' behauptet fälschlicherweise, von Person '''+tPersonToStr(Verknuepfungen[i].outP.KindIn.Eltern[k])+''' abzuhängen!'); + halt; + end; + if anz>1 then begin + writeln('Verknüpfung '''+tVerknuepfungToStr(Verknuepfungen[i])+''' ist mehrfach in Person '''+tPersonToStr(Verknuepfungen[i].outP.KindIn.Eltern[k])+''' als Abhängigkeit verzeichnet!'); + halt; + end; + end; + end; + end; + for i:=0 to length(MMInteraktionen)-1 do begin + if mitIndizes and (MMInteraktionen[i].Index<>i) then begin + writeln('MMInteraktion an Stelle '+inttostr(i)+' hat Index '+inttostr(MMInteraktionen[i].Index)+'.'); + halt; + end; + for k:=0 to 1 do begin + anz:=0; + for j:=0 to length(MMInteraktionen[i]._Ps[k].inMMInteraktion)-1 do + if MMInteraktionen[i]._Ps[k].inMMInteraktion[j]=MMInteraktionen[i] then + inc(anz); + if anz=0 then begin + writeln('MMInteraktion '''+tMMInteraktionToStr(MMInteraktionen[i])+''' behauptet fälschlicherweise, von Person '''+MMInteraktionen[i]._Ps[k].ID+''' abzuhängen!'); + halt; + end; + if anz>1 then begin + writeln('MMInteraktion '''+tMMInteraktionToStr(MMInteraktionen[i])+''' ist mehrfach in Person '''+MMInteraktionen[i]._Ps[k].ID+''' als Abhängigkeit verzeichnet!'); + halt; + end; + end; + end; + for i:=0 to length(MFInteraktionen)-1 do begin + if mitIndizes and (MFInteraktionen[i].Index<>i) then begin + writeln('MFInteraktion an Stelle '+inttostr(i)+' hat Index '+inttostr(MFInteraktionen[i].Index)+'.'); + halt; + end; + anz:=0; + for j:=0 to length(MFInteraktionen[i]._P.inMFInteraktion)-1 do + if MFInteraktionen[i]._P.inMFInteraktion[j]=MFInteraktionen[i] then + inc(anz); + if anz=0 then begin + writeln('MFInteraktion '''+tMFInteraktionToStr(MFInteraktionen[i])+''' behauptet fälschlicherweise, von Person '''+MFInteraktionen[i]._P.ID+''' abzuhängen!'); + halt; + end; + if anz>1 then begin + writeln('MFInteraktion '''+tMFInteraktionToStr(MFInteraktionen[i])+''' ist mehrfach in Person '''+MFInteraktionen[i]._P.ID+''' als Abhängigkeit verzeichnet!'); + halt; + end; + anz:=0; + for j:=0 to length(MFInteraktionen[i]._F.inMFInteraktion)-1 do + if MFInteraktionen[i]._F.inMFInteraktion[j]=MFInteraktionen[i] then + inc(anz); + if anz=0 then begin + writeln('MFInteraktion '''+tMFInteraktionToStr(MFInteraktionen[i])+''' behauptet fälschlicherweise, von Familie '''+MFInteraktionen[i]._F.ID+''' abzuhängen!'); + halt; + end; + if anz>1 then begin + writeln('MFInteraktion '''+tMFInteraktionToStr(MFInteraktionen[i])+''' ist mehrfach in Familie '''+MFInteraktionen[i]._F.ID+''' als Abhängigkeit verzeichnet!'); + halt; + end; + end; + for i:=0 to length(FFInteraktionen)-1 do begin + if mitIndizes and (FFInteraktionen[i].Index<>i) then begin + writeln('FFInteraktion an Stelle '+inttostr(i)+' hat Index '+inttostr(FFInteraktionen[i].Index)+'.'); + halt; + end; + for k:=0 to 1 do begin + anz:=0; + for j:=0 to length(FFInteraktionen[i]._Fs[k].inFFInteraktion)-1 do + if FFInteraktionen[i]._Fs[k].inFFInteraktion[j]=FFInteraktionen[i] then + inc(anz); + if anz=0 then begin + writeln('FFInteraktion '''+tFFInteraktionToStr(FFInteraktionen[i])+''' behauptet fälschlicherweise, von Familie '''+FFInteraktionen[i]._Fs[k].ID+''' abzuhängen!'); + halt; + end; + if anz>1 then begin + writeln('FFInteraktion '''+tFFInteraktionToStr(FFInteraktionen[i])+''' ist mehrfach in Familie '''+FFInteraktionen[i]._Fs[k].ID+''' als Abhängigkeit verzeichnet!'); + halt; + end; + end; + end; + for i:=0 to length(Personen)-1 do begin + for j:=i+1 to length(Personen)-1 do + if Personen[i].id=Personen[j].id then begin + writeln('Ich habe zwei Personen mit gleicher ID gefungen: '''+tPersonToStr(Personen[i])+''' und '''+tPersonToStr(Personen[j])+'''!'); + halt; + end; + if mitIndizes and (Personen[i].Index<>i) then begin + writeln('Person an Stelle '+inttostr(i)+' hat Index '+inttostr(Personen[i].Index)+'.'); + halt; + end; + if assigned(Personen[i].KindIn) then begin + anz:=0; + for j:=0 to length(Personen[i].KindIn.Kinder)-1 do + if Personen[i].KindIn.Kinder[j]=Personen[i] then + inc(anz); + if anz=0 then begin + writeln('Kind '''+Personen[i].ID+''' behauptet fälschlicherweise, zu Familie '''+Personen[i].KindIn.ID+''' zu gehören!'); + halt; + end; + if anz>1 then begin + writeln('Kind '''+Personen[i].ID+''' ist mehrfach in Familie '''+Personen[i].KindIn.ID+'''!'); + halt; + end; + end; + for j:=0 to length(Personen[i].ElterIn)-1 do begin + anz:=0; + for k:=0 to 1 do + if Personen[i].ElterIn[j].Eltern[k]=Personen[i] then + inc(anz); + if anz=0 then begin + writeln('Elter '''+Personen[i].ID+''' behauptet fälschlicherweise, zu Familie '''+Personen[i].ElterIn[j].ID+''' zu gehören!'); + halt; + end; + if anz>1 then begin + writeln('Elter '''+Personen[i].ID+''' ist mehrfach Elter in Familie '''+Personen[i].ElterIn[j].ID+'''!'); + halt; + end; + end; + for j:=0 to length(Personen[i].inputIn)-1 do begin + anz:=0; + for k:=0 to 1 do + if Personen[i].inputIn[j].outP.kindIn.Eltern[k]=Personen[i] then + inc(anz); + if anz=0 then begin + writeln('Person '''+Personen[i].ID+''' behauptet fälschlicherweise, Input zu Verknüpfung '''+tVerknuepfungToStr(Personen[i].inputIn[j])+''' zu sein!'); + halt; + end; + if anz>1 then begin + writeln('Person '''+Personen[i].ID+''' ist mehrfach als Input zu Verknüpfung '''+tVerknuepfungToStr(Personen[i].inputIn[j])+''' verzeichnet!'); + halt; + end; + end; + for j:=0 to length(Personen[i].outputIn)-1 do begin + if Personen[i].outputIn[j].outP<>Personen[i] then begin + writeln('Person '''+Personen[i].ID+''' behauptet fälschlicherweise, Output von Verknüpfung '''+tVerknuepfungToStr(Personen[i].outputIn[j])+''' zu sein!'); + halt; + end; + end; + for j:=0 to length(Personen[i].inMMInteraktion)-1 do begin + anz:=0; + for k:=0 to 1 do + if Personen[i].inMMInteraktion[j]._Ps[k]=Personen[i] then + inc(anz); + if anz=0 then begin + writeln('Person '''+Personen[i].ID+''' behauptet fälschlicherweise, in MMInteraktion '''+tMMInteraktionToStr(Personen[i].inMMInteraktion[j])+''' zu sein!'); + halt; + end; + if anz>1 then begin + writeln('Person '''+Personen[i].ID+''' ist mehrfach in MMInteraktion '''+tMMInteraktionToStr(Personen[i].inMMInteraktion[j])+''' verzeichnet!'); + halt; + end; + end; + for j:=0 to length(Personen[i].inMFInteraktion)-1 do begin + if Personen[i].inMFInteraktion[j]._P<>Personen[i] then begin + writeln('Person '''+Personen[i].ID+''' behauptet fälschlicherweise, in MFInteraktion '''+tMFInteraktionToStr(Personen[i].inMFInteraktion[j])+''' zu sein!'); + halt; + end; + end; + end; + for i:=0 to length(Familien)-1 do begin + for j:=i+1 to length(Familien)-1 do + if Familien[i].id=Familien[j].id then begin + writeln('Ich habe zwei Familien mit gleicher ID gefungen: '''+tFamilieToStr(Familien[i])+''' und '''+tFamilieToStr(Familien[j])+'''!'); + halt; + end; + if mitIndizes and (Familien[i].Index<>i) then begin + writeln('Familie an Stelle '+inttostr(i)+' hat Index '+inttostr(Familien[i].Index)+'.'); + halt; + end; + for j:=0 to length(Familien[i].Kinder)-1 do + if Familien[i].Kinder[j].KindIn<>Familien[i] then begin + writeln('Kind '''+Familien[i].Kinder[j].ID+''' behauptet fälschlicherweise, nicht zu Familie '''+Familien[i].ID+''' zu gehören!'); + halt; + end; + for j:=0 to length(Familien[i].Eltern)-1 do + if assigned(Familien[i].Eltern[j]) then begin + anz:=0; + for k:=0 to length(Familien[i].Eltern[j].ElterIn)-1 do + if Familien[i].Eltern[j].ElterIn[k]=Familien[i] then + inc(anz); + if anz=0 then begin + writeln('Elter '''+Familien[i].Eltern[j].ID+''' behauptet fälschlicherweise, nicht zu Familie '''+Familien[i].ID+''' zu gehören!'); + halt; + end; + if anz>1 then begin + writeln('Elter '''+Familien[i].Eltern[j].ID+''' ist mehrfach in Familie '''+Familien[i].ID+'''!'); + halt; + end; + end; + for j:=0 to length(Familien[i].inMFInteraktion)-1 do begin + if Familien[i].inMFInteraktion[j]._F<>Familien[i] then begin + writeln('Familie '''+Familien[i].ID+''' behauptet fälschlicherweise, in MFInteraktion '''+tMFInteraktionToStr(Familien[i].inMFInteraktion[j])+''' zu sein!'); + halt; + end; + end; + for j:=0 to length(Familien[i].inFFInteraktion)-1 do begin + anz:=0; + for k:=0 to 1 do + if Familien[i].inFFInteraktion[j]._Fs[k]=Familien[i] then + inc(anz); + if anz=0 then begin + writeln('Familie '''+Familien[i].ID+''' behauptet fälschlicherweise, in FFInteraktion '''+tFFInteraktionToStr(Familien[i].inFFInteraktion[j])+''' zu sein!'); + halt; + end; + if anz>1 then begin + writeln('Familie '''+Familien[i].ID+''' ist mehrfach in FFInteraktion '''+tFFInteraktionToStr(Familien[i].inFFInteraktion[j])+''' verzeichnet!'); + halt; + end; + end; + if assigned(Familien[i].Eltern[0]) and assigned(Familien[i].Eltern[1]) then + for j:=i+1 to length(Familien)-1 do + if ((Familien[i].Eltern[0]=Familien[j].Eltern[0]) and (Familien[i].Eltern[1]=Familien[j].Eltern[1])) or + ((Familien[i].Eltern[0]=Familien[j].Eltern[1]) and (Familien[i].Eltern[1]=Familien[j].Eltern[0])) then begin + writeln('Es gibt hier zwei Familien zwischen jeweils den gleichen Eltern:'); + writeln(' '+Familien[i].ID+' und '+Familien[j].ID); + writeln(' zwischen '+Familien[i].Eltern[0].ID+' und '+Familien[i].Eltern[1].ID); + halt; + end; + end; +end; + +procedure tMetaData.pruefeAufGleichheit(vgl: tMetaData); +var + i,j,cnt: longint; + p2p: tIntArray; + fehler: boolean; + MMarr,vMMarr: tMMInteraktionArray; + MFarr,vMFarr: tMFInteraktionArray; + FFarr,vFFarr: tFFInteraktionArray; + Vkarr,vVkarr: tVerknuepfungArray; +begin + fehler:=false; + if ParameterLaenge<>vgl.ParameterLaenge then begin + writeln('*** Fehler ***'); + writeln('''ParameterLaenge'' ist unterschiedlich ('+inttostr(ParameterLaenge)+' vs. '+inttostr(vgl.ParameterLaenge)+')'); + fehler:=true; + end; + + setlength(p2p,ParameterLaenge); + for i:=0 to length(p2p)-1 do + p2p[i]:=-1; + + if length(Ereignisse)<>length(vgl.Ereignisse) then begin + writeln('*** Fehler ***'); + writeln('Unterschiedlich viele Ereignisse ('+inttostr(length(Ereignisse))+' vs. '+inttostr(length(vgl.Ereignisse))+')'); + fehler:=true; + end + else + for i:=0 to length(Ereignisse)-1 do begin + cnt:=0; + for j:=0 to length(vgl.Ereignisse)-1 do + if Ereignisse[i].istGleich(vgl.Ereignisse[j]) then + inc(cnt); + if cnt<>1 then begin + writeln('*** Fehler ***'); + write('Ereignis '''+tEreignisToStr(Ereignisse[i])+''' gibt es '); + if cnt=0 then writeln('nicht.') + else writeln('mehrfach.'); + fehler:=true; + end; + end; + + write('.'); + + if length(Personen)<>length(vgl.Personen) then begin + writeln('*** Fehler ***'); + writeln('Unterschiedlich viele Personen ('+inttostr(length(Personen))+' vs. '+inttostr(length(vgl.Personen))+')'); + fehler:=true; + end + else + for i:=0 to length(Personen)-1 do begin + if ((Personen[i].p1<>-1) and (p2p[Personen[i].p1]<>-1)) or + ((Personen[i].p2<>-1) and (p2p[Personen[i].p2]<>-1)) or + ((Personen[i].p3<>-1) and (p2p[Personen[i].p3]<>-1)) then begin + writeln('*** Fehler ***'); + writeln('Parameter doppelt referenziert!'); + fehler:=true; + continue; + end; + cnt:=0; + for j:=0 to length(vgl.Personen)-1 do + if Personen[i].istGleich(vgl.Personen[j]) then begin + if vgl.Personen[j].p1<>-1 then + p2p[vgl.Personen[j].p1]:=Personen[i].p1; + if vgl.Personen[j].p2<>-1 then + p2p[vgl.Personen[j].p2]:=Personen[i].p2; + if vgl.Personen[j].p3<>-1 then + p2p[vgl.Personen[j].p3]:=Personen[i].p3; + inc(cnt); + end; + if cnt<>1 then begin + writeln('*** Fehler ***'); + write('Person '''+tPersonToStr(Personen[i])+''' gibt es '); + if cnt=0 then writeln('nicht.') + else writeln('mehrfach.'); + fehler:=true; + end; + end; + + write('.'); + + if length(Familien)<>length(vgl.Familien) then begin + writeln('*** Fehler ***'); + writeln('Unterschiedlich viele Familien ('+inttostr(length(Familien))+' vs. '+inttostr(length(vgl.Familien))+')'); + fehler:=true; + end + else + for i:=0 to length(Familien)-1 do begin + cnt:=0; + for j:=0 to length(vgl.Familien)-1 do + if Familien[i].istGleich(vgl.Familien[j]) then + inc(cnt); + if cnt<>1 then begin + writeln('*** Fehler ***'); + write('Familie '''+tFamilieToStr(Familien[i])+''' gibt es '); + if cnt=0 then writeln('nicht.') + else writeln('mehrfach.'); + fehler:=true; + end; + end; + + write('.'); + + if length(Verknuepfungen)<>length(vgl.Verknuepfungen) then begin + writeln('*** Fehler ***'); + writeln('Unterschiedlich viele Verknuepfungen ('+inttostr(length(Verknuepfungen))+' vs. '+inttostr(length(vgl.Verknuepfungen))+')'); + fehler:=true; + end + else begin + Vkarr:=sortiere(Verknuepfungen); + vVkarr:=sortiere(vgl.Verknuepfungen); + for i:=0 to length(Vkarr)-1 do + if not Vkarr[i].istGleich(vVkarr[i],p2p) then begin + writeln('*** Fehler ***'); + write('Verknuepfungen unterscheiden sich ('+inttostr(cmpstr(sortstringfromobject(Vkarr[i]),sortstringfromobject(vVkarr[i])))+')!'); + break; + end; + end; + + write('.'); + + if length(MMInteraktionen)<>length(vgl.MMInteraktionen) then begin + writeln('*** Fehler ***'); + writeln('Unterschiedlich viele MMInteraktionen ('+inttostr(length(MMInteraktionen))+' vs. '+inttostr(length(vgl.MMInteraktionen))+')'); + fehler:=true; + end + else begin + MMarr:=sortiere(MMInteraktionen); + vMMarr:=sortiere(vgl.MMInteraktionen); + for i:=0 to length(MMarr)-1 do + if not MMarr[i].istGleich(vMMarr[i]) then begin + writeln('*** Fehler ***'); + write('MMInteraktionen unterscheiden sich ('+inttostr(cmpstr(sortstringfromobject(MMarr[i]),sortstringfromobject(vMMarr[i])))+')!'); + break; + end; + end; + + write('.'); + + if length(MFInteraktionen)<>length(vgl.MFInteraktionen) then begin + writeln('*** Fehler ***'); + writeln('Unterschiedlich viele MFInteraktionen ('+inttostr(length(MFInteraktionen))+' vs. '+inttostr(length(vgl.MFInteraktionen))+')'); + fehler:=true; + end + else begin + MFarr:=sortiere(MFInteraktionen); + vMFarr:=sortiere(vgl.MFInteraktionen); + for i:=0 to length(MFarr)-1 do + if not MFarr[i].istGleich(vMFarr[i]) then begin + writeln('*** Fehler ***'); + write('MFInteraktionen unterscheiden sich ('+inttostr(cmpstr(sortstringfromobject(MFarr[i]),sortstringfromobject(vMFarr[i])))+')!'); + break; + end; + end; + + write('.'); + + if length(FFInteraktionen)<>length(vgl.FFInteraktionen) then begin + writeln('*** Fehler ***'); + writeln('Unterschiedlich viele FFInteraktionen ('+inttostr(length(FFInteraktionen))+' vs. '+inttostr(length(vgl.FFInteraktionen))+')'); + fehler:=true; + end + else begin + FFarr:=sortiere(FFInteraktionen); + vFFarr:=sortiere(vgl.FFInteraktionen); + for i:=0 to length(FFarr)-1 do + if not FFarr[i].istGleich(vFFarr[i]) then begin + writeln('*** Fehler ***'); + write('FFInteraktionen unterscheiden sich ('+inttostr(cmpstr(sortstringfromobject(FFarr[i]),sortstringfromobject(vFFarr[i])))+')!'); + break; + end; + end; + + write('.'); + + if length(ParameterAttribute)<>length(vgl.ParameterAttribute) then begin + writeln('*** Fehler ***'); + writeln('''ParameterAttribute'' ist unterschiedlich lang ('+inttostr(length(ParameterAttribute))+' vs. '+inttostr(length(vgl.ParameterAttribute))+')'); + fehler:=true; + end + else + for i:=0 to length(ParameterAttribute)-1 do begin + if p2p[i]=-1 then begin + writeln('*** Fehler ***'); + write('Parameterübersetzung unvollständig!'); + fehler:=true; + continue; + end; + if ParameterAttribute[p2p[i]].istUnabhaengig<>vgl.ParameterAttribute[i].istUnabhaengig then begin + writeln('*** Fehler ***'); + writeln('Parameter '+inttostr(p2p[i])+' bzw. '+inttostr(i)+' ist ein Mal unabhängig und ein Mal nicht!'); + fehler:=true; + end; + if ParameterAttribute[p2p[i]].istKoordinate<>vgl.ParameterAttribute[i].istKoordinate then begin + writeln('*** Fehler ***'); + writeln('Parameter '+inttostr(p2p[i])+' bzw. '+inttostr(i)+' ist ein Mal eine Koordinate und ein Mal nicht!'); + fehler:=true; + end; + if ParameterAttribute[p2p[i]].wirdBenutzt<>vgl.ParameterAttribute[i].wirdBenutzt then begin + writeln('*** Fehler ***'); + writeln('Parameter '+inttostr(p2p[i])+' bzw. '+inttostr(i)+' wird ein Mal benutzt und ein Mal nicht!'); + fehler:=true; + end; + end; + + write('.'); + + if length(Tauschfamilien)<>length(vgl.Tauschfamilien) then begin + writeln('*** Fehler ***'); + writeln('Unterschiedlich viele Tauschfamilien ('+inttostr(length(Tauschfamilien))+' vs. '+inttostr(length(vgl.Tauschfamilien))+')'); + fehler:=true; + end + else + for i:=0 to length(Tauschfamilien)-1 do begin + cnt:=0; + for j:=0 to length(vgl.Tauschfamilien)-1 do + if Tauschfamilien[i].istGleich(vgl.Tauschfamilien[j]) then + inc(cnt); + if cnt<>1 then begin + writeln('*** Fehler ***'); + write('Tauschfamilien '''+tFamilieToStr(Tauschfamilien[i])+''' gibt es '); + if cnt=0 then writeln('nicht.') + else writeln('mehrfach.'); + fehler:=true; + end; + end; + writeln; + if fehler then halt; +end; + +procedure tMetaData.habePersonGeloescht(p: tPerson); +begin + if not assigned(p) then begin + writeln('*** Fehler ***'); + writeln('Gelöschte Person ist NIL!'); + halt; + end; + if Personen[p.index]<>p then begin + writeln('*** Fehler ***'); + writeln('Gelöschte Person hat falschen Index!'); + halt; + end; + if not personAuchDrueber[p.index] then begin + writeln('*** Fehler ***'); + writeln('Gelöschte Person war schon gelöscht!'); + halt; + end; + personAuchDrueber[p.index]:=false; +end; + +procedure tMetaData.habeFamilieGeloescht(f: tFamilie); +begin + if not assigned(f) then begin + writeln('*** Fehler ***'); + writeln('Gelöschte Familie ist NIL!'); + halt; + end; + if Familien[f.index]<>f then begin + writeln('*** Fehler ***'); + writeln('Gelöschte Familie hat falschen Index!'); + halt; + end; + if not familieAuchDrueber[f.index] then begin + writeln('*** Fehler ***'); + writeln('Gelöschte Familie war schon gelöscht!'); + halt; + end; + familieAuchDrueber[f.index]:=false; +end; + +procedure tMetaData.habePersonHinzugefuegt(p: tPerson); +begin + if not assigned(p) then begin + writeln('*** Fehler ***'); + writeln('Hinzugefügte Person ist NIL!'); + halt; + end; + if Personen[p.index]<>p then begin + writeln('*** Fehler ***'); + writeln('Hinzugefügte Person hat falschen Index!'); + halt; + end; + if personAuchDrueber[p.index] then begin + writeln('*** Fehler ***'); + writeln('Hinzugefügte Person war schon hinzugefügt!'); + halt; + end; + personAuchDrueber[p.index]:=true; +end; + +procedure tMetaData.habeFamilieHinzugefuegt(f: tFamilie); +begin + if not assigned(f) then begin + writeln('*** Fehler ***'); + writeln('Hinzugefügte Familie ist NIL!'); + halt; + end; + if Familien[f.index]<>f then begin + writeln('*** Fehler ***'); + writeln('Hinzugefügte Familie hat falschen Index!'); + halt; + end; + if familieAuchDrueber[f.index] then begin + writeln('*** Fehler ***'); + writeln('Hinzugefügte Familie war schon hinzugefügt!'); + halt; + end; + familieAuchDrueber[f.index]:=true; +end; + +function tMetaData.istPersonAuchDrueber(p: tPerson): boolean; +begin + if not assigned(p) then begin + writeln('*** Fehler ***'); + writeln('Person ist NIL!'); + halt; + end; + if Personen[p.index]<>p then begin + writeln('*** Fehler ***'); + writeln('Person hat falschen Index!'); + halt; + end; + result:=personAuchDrueber[p.index]; +end; + +function tMetaData.istFamilieAuchDrueber(f: tFamilie): boolean; +begin + if not assigned(f) then begin + writeln('*** Fehler ***'); + writeln('Famlie ist NIL!'); + halt; + end; + if Familien[f.index]<>f then begin + writeln('*** Fehler ***'); + writeln('Familie hat falschen Index!'); + halt; + end; + result:=familieAuchDrueber[f.index]; +end; + +procedure tMetaData.indizesErzeugen; +var i: longint; +begin + for i:=0 to length(Personen)-1 do + Personen[i].index:=i; + for i:=0 to length(Familien)-1 do + Familien[i].index:=i; + for i:=0 to length(Verknuepfungen)-1 do + Verknuepfungen[i].index:=i; + for i:=0 to length(MMInteraktionen)-1 do + MMInteraktionen[i].index:=i; + for i:=0 to length(MFInteraktionen)-1 do + MFInteraktionen[i].index:=i; + for i:=0 to length(FFInteraktionen)-1 do + FFInteraktionen[i].index:=i; +end; + +procedure tMetaData.loescheVerknuepfungenZu(p: tPerson); +var + i,ind: longint; +begin + for i:=length(p.outputIn)-1 downto 0 do begin + ind:=p.outputIn[i].index; + p.outputIn[i].free; + Verknuepfungen[ind]:=nil; + end; +end; + +procedure tMetaData.loescheAlleVerbindungenZu(p: tPerson; f: tFamilie); +var + i,j,ind: longint; +begin + if assigned(p) then begin + loescheVerknuepfungenZu(p); + for i:=length(p.inputIn)-1 downto 0 do begin + ind:=p.inputIn[i].index; + p.inputIn[i].free; + Verknuepfungen[ind]:=nil; + end; + for i:=length(p.inMMInteraktion)-1 downto 0 do begin + ind:=p.inMMInteraktion[i].index; + p.inMMInteraktion[i].free; + MMInteraktionen[ind]:=nil; + end; + for i:=length(p.inMFInteraktion)-1 downto 0 do begin + ind:=p.inMFInteraktion[i].index; + p.inMFInteraktion[i].free; + MFInteraktionen[ind]:=nil; + end; + end; + if assigned(f) then begin + for i:=length(f.inMFInteraktion)-1 downto 0 do begin + ind:=f.inMFInteraktion[i].index; + f.inMFInteraktion[i].free; + MFInteraktionen[ind]:=nil; + end; + for i:=length(f.inFFInteraktion)-1 downto 0 do begin + ind:=f.inFFInteraktion[i].index; + f.inFFInteraktion[i].free; + FFInteraktionen[ind]:=nil; + end; + for i:=length(Tauschfamilien)-1 downto 0 do + if Tauschfamilien[i]=f then begin + for j:=i+1 to length(Tauschfamilien)-1 do + Tauschfamilien[j-1]:=Tauschfamilien[j]; + setlength(Tauschfamilien,length(Tauschfamilien)-1); + end; + end; +end; + +procedure tMetaData.arraysAufraeumen; +var + i,j: longint; +begin + j:=0; + for i:=0 to length(Verknuepfungen)-1 do + if Verknuepfungen[i]<>nil then begin + Verknuepfungen[j]:=Verknuepfungen[i]; + Verknuepfungen[j].index:=j; + inc(j); + end; + setlength(Verknuepfungen,j); + j:=0; + for i:=0 to length(MMInteraktionen)-1 do + if MMInteraktionen[i]<>nil then begin + MMInteraktionen[j]:=MMInteraktionen[i]; + MMInteraktionen[j].index:=j; + inc(j); + end; + setlength(MMInteraktionen,j); + j:=0; + for i:=0 to length(MFInteraktionen)-1 do + if MFInteraktionen[i]<>nil then begin + MFInteraktionen[j]:=MFInteraktionen[i]; + MFInteraktionen[j].index:=j; + inc(j); + end; + setlength(MFInteraktionen,j); + j:=0; + for i:=0 to length(FFInteraktionen)-1 do + if FFInteraktionen[i]<>nil then begin + FFInteraktionen[j]:=FFInteraktionen[i]; + FFInteraktionen[j].index:=j; + inc(j); + end; + setlength(FFInteraktionen,j); +end; + +function tMetaData.anzUnabhaengig: longint; +var + i: longint; +begin + result:=0; + for i:=0 to length(ParameterAttribute)-1 do + result:=result+byte(ParameterAttribute[i].istUnabhaengig); +end; + +function tMetaData.anzUnbenutzt: longint; +var + i: longint; +begin + result:=0; + for i:=0 to length(ParameterAttribute)-1 do + result:=result+byte(not ParameterAttribute[i].wirdBenutzt); +end; + +// tParameterSimplex *********************************************************** +constructor tParameterSimplex.create; +begin + inherited create; + dim:=0; + fillchar(Ecken,sizeof(Ecken),#0); + setlength(Ecken,0); + fillchar(Energien,sizeof(Energien),#0); + setlength(Energien,0); + md:=nil; + letzteSchwerpunktberechnung:=0; + letzteSchwerpunktabweichung:=-1; +end; + +destructor tParameterSimplex.destroy; +begin + setlength(Ecken,0); + setlength(Energien,0); +end; + +function tParameterSimplex.besserAls(a,b: longint): longint; // -1: a schlechter als b; 0: gleich gut; 1: a besser als b +begin + result:=besserAls(a,b,false); +end; + +function tParameterSimplex.besserAls(a,b: longint; hart: boolean): longint; +begin + result:=besserAls(Kreuzungens[a],Energien[a],b); + if hart and (result=0) then begin + if a>b then begin + result:=-1; + exit; + end; + if a<b then begin + result:=1; + exit; + end; + end; +end; + +function tParameterSimplex.besserAls(aKrz: longint; aEnerg: extended; b: longint): longint; +begin + if aKrz>Kreuzungens[b] then begin + result:=-1; + exit; + end; + if aKrz<Kreuzungens[b] then begin + result:=1; + exit; + end; + if aEnerg>Energien[b] then begin + result:=-1; + exit; + end; + if aEnerg<Energien[b] then begin + result:=1; + exit; + end; + result:=0; +end; + +procedure tParameterSimplex.ordnen; +var i,j,lb,b: longint; +begin + lb:=-1; + for i:=0 to dim do begin + b:=-1; + for j:=0 to dim do + if ((lb=-1) or (besserAls(lb,j,true)>0)) and + ((b=-1) or (besserAls(b,j,true)<0)) then + b:=j; + if b=-1 then begin + writeln('Nach '+inttostr(i+1)+' von '+inttostr(dim+1)+' Schritten ist kein Element mehr zu finden! ... seltsam!'); + halt(1); + end; + Reihenfolge[i]:=b; + lb:=b; + end; +end; + +function tParameterSimplex.einsortieren(wen,Luecke: longint): longint; +var i,j,k: longint; +begin + for i:=Luecke to dim-1 do + Reihenfolge[i]:=Reihenfolge[i+1]; + i:=-1; + j:=dim; + while i<j-1 do begin // Bisektion + k:=(i+j) div 2; + if besserAls(wen,Reihenfolge[k],true)>0 then + j:=k + else + i:=k; + end; + if i<>j-1 then begin + writeln('Bisektion ist fehlgeschlagen ('+inttostr(i)+','+inttostr(j)+')'); + halt(1); + end; + for i:=dim-1 downto j do + Reihenfolge[i+1]:=Reihenfolge[i]; + Reihenfolge[j]:=wen; + result:=Luecke-j; // wie viele Plätze wurden gut gemacht? + j:=0; + for i:=0 to dim-1 do + if besserAls(Reihenfolge[i],Reihenfolge[i+1],true)<>1 then begin + j:=1; + write(i,' '); + end; + if j=1 then begin + writeln; + writeln('Fehler beim Einsortieren!'); + halt; + end; +end; + +function tParameterSimplex.normalisiere(i: longint): boolean; +begin + result:=normalisiere(Ecken[i]); + if result then + berechneSchwerpunkt; +end; + +function tParameterSimplex.normalisiere(ps: tExtendedArray): boolean; +var + i: longint; + ma,mi: extended; +begin + ma:=1; + mi:=0; + for i:=0 to length(ps)-1 do begin + ma:=max(ma,ps[i]); + mi:=min(mi,ps[i]); + end; + result:=(ma>1) or (mi<0); + if not result then exit; +(* writeln; + writeln(mi,' .. ',ma); + for i:=0 to length(ps)-1 do + if (ps[i]=mi) or (ps[i]=ma) then + writeln(' '+inttostr(i)+' '+inttostr(byte(md.Koordinate[i]))); *) + ma:=1/max(epsilon,ma-mi); + for i:=0 to length(ps)-1 do + ps[i]:=(ps[i]-mi)*ma; +end; + +procedure tParameterSimplex.berechneEnergien(mt: longint); +begin + berechneEnergien(mt,false); +end; + +procedure tParameterSimplex.berechneEnergien(mt: longint; ParameterBerechnen: boolean); +var i: longint; + fertig: boolean; + ets: array of tEnergieThread; +begin + setlength(ets,mt); + for i:=0 to mt-1 do + ets[i]:= + tEnergieThread.create( + self, + round( i /mt*(dim+1)), + round((i+1)/mt*(dim+1) - 1), + ParameterBerechnen); + repeat + fertig:=true; + for i:=0 to mt-1 do + fertig:=fertig and ets[i].fertig; + if not fertig then + sleep(100); + until fertig; + for i:=0 to mt-1 do + ets[i].free; +end; + +function tParameterSimplex.berechneSchwerpunkt: extended; +var + i,j: longint; + sp: tExtendedArray; +begin + if dim<=1 then exit; + setlength(sp,dim); + for i:=0 to dim-1 do + sp[i]:=0; + for i:=0 to dim do + for j:=0 to dim-1 do + sp[j]:=sp[j]+Ecken[i][j]; + for i:=0 to dim-1 do + sp[i]:=sp[i]/dim; + if length(Schwerpunkt)<>dim then begin + result:=-1; + setlength(Schwerpunkt,dim); + for i:=0 to dim-1 do + Schwerpunkt[i]:=sp[i]; + end + else begin + result:=0; + for i:=0 to dim-1 do begin + result:=result+sqr(sp[i]-Schwerpunkt[i]); + Schwerpunkt[i]:=sp[i]; + end; + end; + setlength(sp,0); + letzteSchwerpunktberechnung:=0; + letzteSchwerpunktabweichung:=result; +end; + +procedure tParameterSimplex.init(ps: tExtendedArray; mt: longint); +var i,j: longint; +begin + if not assigned(md) then exit; + if md.ParameterLaenge<>length(ps) then exit; + + for i:=0 to length(Ecken)-1 do + setlength(Ecken[i],0); + dim:=md.anzUnabhaengig; + pdim:=md.ParameterLaenge; + writeln('Der Simplex hat '+inttostr(dim+1)+' Ecken mit je '+inttostr(pdim)+' Parametern (davon '+inttostr(dim)+' unabhängige).'); + setlength(Ecken,dim+1); + setlength(Energien,dim+1); + setlength(Kreuzungens,dim+1); + setlength(Kreuzungs,dim+1); + setlength(Reihenfolge,dim+1); + for i:=0 to length(Ecken)-1 do begin + setlength(Ecken[i],pdim); + Energien[i]:=-1; + Kreuzungens[i]:=0; + Kreuzungs[i]:=-1; + Reihenfolge[i]:=i; + end; + + for i:=0 to pdim-1 do + Ecken[0,i]:=min(1,max(0,ps[i])); + for i:=1 to dim do begin + for j:=0 to dim-1 do + Ecken[i,j]:=Ecken[0,j] + (2*byte(Ecken[0,j]<0.5)-1)*(1e-15 + byte(MD.ParameterAttribute[MD.UnabIndizes[j]].istKoordinate)*1e-6)*byte(i-1 = j); + for j:=dim to pdim-1 do + Ecken[i,j]:=nan; + end; + for i:=0 to dim do + for j:=0 to dim-1 do + if (Ecken[i,j]<0) or (Ecken[i,j]>1) then begin + writeln('*** Fehler *** '+inttostr(i)+';'+inttostr(j)+': '+myfloattostr(Ecken[i,j])); + halt; + end; + berechneEnergien(mt,true); + berechneSchwerpunkt; + ordnen; +end; + +procedure tParameterSimplex.outit(var ps: tExtendedArray); +var + i: longint; +begin + if length(ps)<>pdim then begin + writeln('Warnung: Anzahl der Parameter hat nicht gepasst, wurde angepasst!'); + setlength(ps,pdim); + end; + for i:=0 to pdim-1 do + ps[i]:=Ecken[Reihenfolge[0],i]; +end; + +function tParameterSimplex.simplexSchritt(f,f1,f2,f3: extended; offset: longint): tSchrittErgebnis; +var + np: tExtendedArray; +begin + setlength(np,pdim); + result:=simplexSchritt(np,f,f1,f2,f3,offset); + setlength(np,0); +end; + +function tParameterSimplex.simplexSchritt(var np: tExtendedArray; f,f1,f2,f3: extended; offset: longint): tSchrittErgebnis; +var i,lu,krzgn,krz,aKrzgn: longint; + energ,aEnerg,fx,fs,fak: extended; + spBerechnen: byte; +begin + if length(np)<>pdim then begin + writeln('Warnung: Arraylange musste angepasst werden!'); + setlength(np,pdim); + for i:=0 to pdim-1 do + np[i]:=0; + end; + lu:=dim-offset; + offset:=Reihenfolge[lu]; + aEnerg:=energien[offset]; + aKrzgn:=Kreuzungens[offset]; + + fx:=(dim*f+1)/(dim-1); + fs:=(1+f)*dim/(dim-1); + for i:=0 to dim-1 do // X' = S * (1+f) dim / (dim-1) - X * (dim f + 1)/(dim - 1) + np[i]:=Schwerpunkt[i]*fs - Ecken[offset,i]*fx; + + spBerechnen:=$3*byte(normalisiere(np)) xor $1; + + md.berechneAbhaengigeVariable(np{$IFDEF detaillierteZeitanalyse}, true{$ENDIF}); + energ:=md.Energie(np,krzgn,krz{$IFDEF detaillierteZeitanalyse}, true{$ENDIF}); + + if besserAls(krzgn,energ,offset)<0 then fak:=f1 // verschlechtert + else if besserAls(krzgn,energ,Reihenfolge[0])<0 then fak:=f2 // nicht der beste + else fak:=f3; // der beste + + // X' = S (1+f) dim / (dim-1) - X * (dim f + 1)/(dim - 1) + fx:=(dim*fak+1)/(dim-1); + for i:=0 to dim-1 do + Ecken[offset,i]:=Schwerpunkt[i]*fs - Ecken[offset,i]*fx; + + spBerechnen:=(spBerechnen shl 2) or byte(not normalisiere(offset)); + berechneAbhaengigeVariable(offset{$IFDEF detaillierteZeitanalyse}, true{$ENDIF}); + berechneEnergie(offset{$IFDEF detaillierteZeitanalyse}, true{$ENDIF}); + result.faktorNeutralisiert:=besserAls(krzgn,energ,offset)>0; // mit großem Faktor verschlechtert + if result.faktorNeutralisiert then begin + fak:=f; // wird für die korrekte Schwerpunktverschiebung gebraucht + spBerechnen:=spBerechnen shr 1; + for i:=0 to pdim-1 do + Ecken[offset,i]:= + np[i]; + Energien[offset]:=energ; + Kreuzungens[offset]:=krzgn; + Kreuzungs[offset]:=krz; + end; + + if odd(spBerechnen shr 1) then + berechneSchwerpunkt // writeln('('+inttostr(letzteSchwerpunktberechnung)+') .Schwerpunktabweichung: '+myfloattostr(berechneSchwerpunkt)) + else if odd(spBerechnen) then begin + // S' = S + (X'-X)/dim + // X'-X = X' * (1 + (dim - 1)/(dim f + 1)) - S * (1+f) dim / (dim f + 1) + fx:=1 + (dim-1)/(dim*fak+1); + fs:=(1+fak)*dim/(dim*fak+1); + for i:=0 to dim-1 do + Schwerpunkt[i]:=fs*Schwerpunkt[i] + fx*Ecken[offset,i]; + inc(letzteSchwerpunktberechnung); + if (letzteSchwerpunktabweichung<=0) or + (letzteSchwerpunktberechnung*letzteSchwerpunktabweichung>1) or + (letzteSchwerpunktberechnung>100) then + berechneSchwerpunkt;//writeln('('+inttostr(letzteSchwerpunktberechnung)+') Schwerpunktabweichung: '+myfloattostr(berechneSchwerpunkt)); + end; + + result.besserAlsVorher:=besserAls(aKrzgn,aEnerg,offset)<0; +// Energien[offset]:=md.Energie(Ecken[offset],Kreuzungens[offset],Kreuzungs[offset]); + result.Platzveraenderung:=einsortieren(offset,lu); +end; + +procedure tParameterSimplex.berechneEnergie(i: longint{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}); +begin + Energien[i]:=md.Energie(Ecken[i],Kreuzungens[i],Kreuzungs[i]{$IFDEF detaillierteZeitanalyse},mainThread{$ENDIF}); +end; + +procedure tParameterSimplex.berechneAbhaengigeVariable(i: longint{$IFDEF detaillierteZeitanalyse}; mainThread: boolean{$ENDIF}); +begin + md.berechneAbhaengigeVariable(Ecken[i]{$IFDEF detaillierteZeitanalyse},mainThread{$ENDIF}); +end; + +function tParameterSimplex.minKreuzungen: longint; +begin + result:=Kreuzungens[Reihenfolge[0]]; +end; + +function tParameterSimplex.maxKreuzungen: longint; +begin + result:=Kreuzungens[Reihenfolge[dim]]; +end; + +function tParameterSimplex.minEnergie: extended; +begin + result:=Energien[Reihenfolge[0]]; +end; + +function tParameterSimplex.maxEnergie: extended; +begin + result:=Energien[Reihenfolge[dim]]; +end; + +procedure tParameterSimplex.printHistogramm; +var i: longint; + hist: tIntArray; +begin + setlength(hist,Kreuzungens[Reihenfolge[dim]]-Kreuzungens[Reihenfolge[0]]+1); + for i:=0 to length(hist)-1 do + hist[i]:=0; + for i:=0 to length(Kreuzungens)-1 do + inc(hist[Kreuzungens[i]-Kreuzungens[Reihenfolge[0]]]); + for i:=0 to length(hist)-1 do + writeln(Kreuzungens[Reihenfolge[0]]+i,': ',hist[i]); +end; + +function tParameterSimplex.mittlereKantenlaenge: extended; +var + mat: array of tExtendedArray; + i,j: longint; +begin + setlength(mat,dim); + for i:=0 to dim-1 do begin + setlength(mat[i],dim); + for j:=0 to dim-1 do + mat[i,j]:=Ecken[i+1,j]-Ecken[0,j]; + end; + result:=rootDet(mat); + for i:=0 to length(mat)-1 do + setlength(mat[i],0); + setlength(mat,0); +end; + +procedure tParameterSimplex.printSpur(nam: string; von,nach: longint); +var + ps,step: tExtendedArray; + i,j,krzgn: longint; + ener,dx: extended; + f: textfile; +const + Schritte = 10000; +begin + if fileexists(nam) then begin + writeln('*** Fehler ***'); + writeln(' Datei '''+nam+''' existiert bereits!'); + halt; + end; + setlength(ps,pdim); + setlength(step,dim); + dx:=0; + for i:=0 to dim-1 do begin + step[i]:=(Ecken[nach,i]-Ecken[von,i])/(Schritte-1); + dx:=dx+sqr(step[i]); + end; + + dx:=sqrt(dx); + + for i:=0 to pdim-1 do + ps[i]:=0; + + assignfile(f,nam); + rewrite(f); + for i:=0 to Schritte-1 do begin + for j:=0 to dim-1 do + ps[j]:=Ecken[von,j]+i*step[j]; + md.berechneAbhaengigeVariable(ps); + ener:=md.Energie(ps,krzgn,j); + writeln(f,inttostr(i)+#9+inttostr(krzgn)+#9+myfloattostr(ener)+#9+myfloattostr(i*dx)); + end; + closefile(f); +end; + +// ******************************** TStabile **************************************************** + +procedure TStabile.setzeFamilie(Fam: tFamilie; x,y,dist,lambda: extended; var P: tExtendedArray); +var Rtg,Rx,Ry: extended; +begin + Rtg:=random*2*pi; + Rx:=dist*cos(Rtg); + Ry:=dist*sin(Rtg); + P[Fam.Eltern[0].P1]:=x+Rx*Lambda; + P[Fam.Eltern[0].P2]:=y+Ry*Lambda; + P[Fam.Eltern[1].P1]:=x+Rx*(1-Lambda); + P[Fam.Eltern[1].P2]:=y+Ry*(1-Lambda); +end; + +constructor TStabile.create; +begin + create(nil); +end; + +constructor TStabile.create(MetaData: TMetaData); +begin + inherited create; + NotAus:=TNotAus.create; + if assigned(MetaData) then + MD:=MetaData + else + MD:=TMetaData.create; + setlength(Parameter,MD.ParameterLaenge); + Schritte:=0; + Laufzeit:=0; + stepsize:=minSchrittweite; +end; + +destructor TStabile.destroy; +begin + Setlength(Parameter,0); + MD.free; + NotAus.destroy; + inherited destroy; +end; + +procedure TStabile.printStatus(Level: Longint); +var + I,J,K: Longint; + laeng,kuerz,tmp: Extended; +begin + if (Level<0) or (Level>9) then + begin + writeln('Illegales Argument für Funktionsaufruf von TStabile.printStatus!'); + exit; + end; + if not assigned(MD) then + begin + writeln('Keine Metadaten vorhanden!'); + exit; + end; + if (Level=3) and not NotAus.Stati[Level] then dec(Level); + if not NotAus.Stati[Level] then exit; + case Level of + 0..4: MD.printStatus(Level); + 5: + begin + Laeng:=-1; + Kuerz:=2; + J:=0; + K:=0; + for I:=0 to length(MD.Familien)-1 do + begin + tmp:= + sqr( + Parameter[MD.Familien[I].Eltern[0].P1] - + Parameter[MD.Familien[I].Eltern[1].P1]) + + sqr( + Parameter[MD.Familien[I].Eltern[0].P2] - + Parameter[MD.Familien[I].Eltern[1].P2]); + if tmp>Laeng then + begin + Laeng:=tmp; + J:=I; + end; + if tmp<Kuerz then + begin + Kuerz:=tmp; + K:=I; + end; + end; + write( + inttostr(Level)+') '+'Längste Beziehung: '+myfloattostr(sqrt(Laeng))+' '); + write(MD.Familien[J].Eltern[0].Vorname); + write(' und '); + write(MD.Familien[J].Eltern[1].Vorname); + write(' '); + writeln('"'+MD.Familien[J].Eltern[1].Nachname+'"'); + writeln(MD.Familien[J].Eltern[0].Nachname); + write( + inttostr(Level)+') '+'Kürzeste Beziehung: '+myfloattostr(sqrt(Kuerz))+' '); + write(MD.Familien[K].Eltern[0].Vorname); + write(' und '); + write(MD.Familien[K].Eltern[1].Vorname); + write(' '); + writeln('"'+MD.Familien[K].Eltern[1].Nachname+'"'); + writeln(MD.Familien[K].Eltern[0].Nachname); + end; + 7: + writeln(inttostr(Level)+') '+inttostr(Schritte)+' '+myfloattostr(Energie)+' '+inttostr(Kreuzungen)+' Kreuzungen'); + end{of case}; +end; + +procedure TStabile.assignMetaData(MetaData: TMetaData); +begin + MD:=MetaData; + Setlength(Parameter,MD.ParameterLaenge); +end; + +function TStabile.ladeXML(Datei: String): boolean; +(*var + i,j: longint; *) +begin + result:=MD.ladeXML(Datei); + md.konsistenzTest(false); +(* + for i:=length(MD.Familien)-1 downto 1 do begin + MD.Familien[length(MD.Familien)-1].free; + setlength(MD.Familien,length(MD.Familien)-1); + MD.konsistenztest; + end; + + writeln(inttostr(length(MD.Familien))+' '+inttostr(length(MD.Personen))); + + for i:=length(MD.Personen)-1 downto 0 do + if (not assigned(MD.Personen[i].KindIn)) and + (length(MD.Personen[i].ElterIn)=0) then begin + MD.Personen[i].Free; + for j:=i+1 to length(MD.Personen)-1 do + MD.Personen[j-1]:=MD.Personen[j]; + setlength(MD.Personen,length(MD.Personen)-1); + end; + + writeln(inttostr(length(MD.Familien))+' '+inttostr(length(MD.Personen))); *) + + +(* writeln(inttostr(length(MD.Familien))+' '+inttostr(length(MD.Personen))); + for i:=0 to 39 do begin + MD.Familien[length(MD.Familien)-1].free; + setlength(MD.Familien,length(MD.Familien)-1); + MD.konsistenztest; + MD.blaetterAbschneiden; + MD.konsistenztest; + MD.nurGroeszteZusammenhangskomponente; + MD.konsistenztest; + writeln(inttostr(length(MD.Familien))+' '+inttostr(length(MD.Personen))); + end; *) +end; + +procedure TStabile.generiereFehlendeInfos; +begin + md.generiereFehlendeInfos; + md.konsistenzTest(true); +end; + +procedure TStabile.nurGroeszteZusammenhangskomponente; +begin + md.nurGroeszteZusammenhangskomponente; + md.konsistenzTest(false); +end; + +procedure TStabile.blaetterAbschneiden; +begin + writeln('Blätter abschneiden ('+inttostr(md.anzUnabhaengig)+' bzw. '+inttostr(md.ParameterLaenge)+') ...'); + md.indizesErzeugen; + md.konsistenzTest(true); + md.blaetterAbschneiden; + md.konsistenzTest(true); + writeln('... fertig ('+inttostr(md.anzUnabhaengig)+' bzw. '+inttostr(md.ParameterLaenge)+')'); +end; + +function TStabile.analysiereInteraktionen: boolean; +begin + result:=MD.analysiereInteraktionen; + if result then + setlength(Parameter,MD.ParameterLaenge); +end; + +function TStabile.LadeVonDatei(Datei: String): boolean; +var + f: tmyStringList; + s: String; + i,j: longint; +begin + result:=false; + writeln('Lade von '''+Datei+''' ...'); + f:=tMyStringList.create; + if copy(Datei,length(Datei)-3,4)='.txt' then + f.loadFromFile(Datei) + else + f.loadFromGz(Datei); + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if s<>'Stabile-Zwischenzustand (menschenlesbar, aber nicht unbedingt menschenverstehbar)' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,9)<>'Schritte ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,9); + Schritte:=strtoint(s); + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,9)<>'stepsize ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,9); + stepsize:=mystrtofloat(s); + for i:=0 to 9 do begin + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftstr(s,9)<>'Stati['+inttostr(i)+'] ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,9); + NotAus.Stati[i]:=s='1'; + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,9)<>'Laufzeit ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,9); + Laufzeit:=mystrtofloat(s); + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,19)<>'length(Ereignisse) ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,19); + j:=strtoint(s); + for i:=0 to j-1 do begin + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if pos('Ereignisse['+inttostr(i)+'] ',s)<>1 then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,length('Ereignisse['+inttostr(i)+'] ')); + ImportEreignis(s,MD.Ereignisse); + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,17)<>'length(Personen) ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,17); + j:=strtoint(s); + for i:=0 to j-1 do begin + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if pos('Personen['+inttostr(i)+'] ',s)<>1 then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,length('Personen['+inttostr(i)+'] ')); + ImportPerson(s,MD.Personen,MD.Ereignisse,MD.Familien); + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,17)<>'length(Familien) ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,17); + j:=strtoint(s); + for i:=0 to j-1 do begin + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if pos('Familien['+inttostr(i)+'] ',s)<>1 then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,length('Familien['+inttostr(i)+'] ')); + ImportFamilie(s,MD.Personen,MD.Ereignisse,MD.Familien); + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,12)<>'Unabhaengig ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,12); + MD.ParameterLaenge:=length(s); + setlength(MD.ParameterAttribute,MD.ParameterLaenge); + for i:=0 to length(MD.ParameterAttribute)-1 do + MD.ParameterAttribute[i].fromChar(s[i+1]); + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,18)<>'length(Parameter) ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,18); + if length(MD.Parameterattribute)<>strtoint(s) then begin + writeln('Inkonsistenz in Datei '''+Datei+''': Parameterlänge ('+s+') unterscheidet sich von Anzahl der Parameterattribute ('+inttostr(length(MD.Parameterattribute))+')!'); + f.free; + exit; + end; + setlength(Parameter,MD.ParameterLaenge); + for i:=0 to length(Parameter)-1 do begin + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if pos('Parameter['+inttostr(i)+'] ',s)<>1 then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,length('Parameter['+inttostr(i)+'] ')); + Parameter[i]:=mystrtofloat(s); + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,23)<>'length(Verknuepfungen) ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,23); + setlength(MD.Verknuepfungen,strtoint(s)); + for i:=0 to length(MD.Verknuepfungen)-1 do begin + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if pos('Verknuepfungen['+inttostr(i)+'] ',s)<>1 then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,length('Verknuepfungen['+inttostr(i)+'] ')); + MD.Verknuepfungen[i]:=strToTVerknuepfung(MD.Personen,s); + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,24)<>'length(MMInteraktionen) ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,24); + setlength(MD.MMInteraktionen,strtoint(s)); + for i:=0 to length(MD.MMInteraktionen)-1 do begin + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if pos('MMInteraktionen['+inttostr(i)+'] ',S)<>1 then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,length('MMInteraktionen['+inttostr(i)+'] ')); + MD.MMInteraktionen[i]:=importMMInteraktion(MD.Personen,s); + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,24)<>'length(MFInteraktionen) ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,24); + setlength(MD.MFInteraktionen,strtoint(s)); + for i:=0 to length(MD.MFInteraktionen)-1 do begin + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if pos('MFInteraktionen['+inttostr(i)+'] ',s)<>1 then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(S,1,length('MFInteraktionen['+inttostr(i)+'] ')); + MD.MFInteraktionen[i]:=importMFInteraktion(MD.Personen,MD.Familien,s); + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,24)<>'length(FFInteraktionen) ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,24); + setlength(MD.FFInteraktionen,strtoint(s)); + for i:=0 to length(MD.FFInteraktionen)-1 do begin + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if pos('FFInteraktionen['+inttostr(i)+'] ',s)<>1 then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,length('FFInteraktionen['+inttostr(i)+'] ')); + MD.FFInteraktionen[i]:=importFFInteraktion(MD.Familien,s); + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if leftStr(s,23)<>'length(Tauschfamilien) ' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,23); + setlength(MD.Tauschfamilien,strtoint(s)); + for i:=0 to length(MD.Tauschfamilien)-1 do begin + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if pos('Tauschfamilien['+inttostr(i)+'] ',s)<>1 then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + delete(s,1,length('Tauschfamilien['+inttostr(i)+'] ')); + MD.Tauschfamilien[i]:=findeFamilie(MD.Familien,s); + end; + if not f.readln(s) then begin + writeln('Unerwartetes Dateiende in '''+Datei+'''!'); + f.free; + exit; + end; + if s<>'Ende' then begin + writeln('Syntaxfehler in '''+Datei+'''!'); + f.free; + exit; + end; + if not f.eof then begin + writeln('Zu viele Daten in '''+Datei+'''!'); + f.free; + exit; + end; + + f.free; + + writeln('... fertig'); + + MD.berechneAbhaengigeVariable(Parameter{$IFDEF detaillierteZeitanalyse},true{$ENDIF}); + Energie:=MD.Energie(Parameter,Kreuzungen,i{$IFDEF detaillierteZeitanalyse},true{$ENDIF}); + printStatus(7); + result:=true; +end; + +function TStabile.SpeichereInDatei(Datei: String): boolean; +var + f: tMyStringList; + i: longint; + s: string; +begin + result:=not fileexists(Datei); + if not result then exit; + printStatus(7); + write('Speichere in '''+Datei+''' ...'); + f:=tMyStringList.create; + f.add('Stabile-Zwischenzustand (menschenlesbar, aber nicht unbedingt menschenverstehbar)'); + f.add('Schritte '+inttostr(Schritte)); + f.add('stepsize '+myfloattostr(stepsize)); + for I:=0 to 9 do + f.add('Stati['+inttostr(I)+'] '+inttostr(byte(NotAus.Stati[I]))); + write('.'); + f.add('Laufzeit '+myfloattostr(Laufzeit)); + f.add('length(Ereignisse) '+inttostr(length(MD.Ereignisse))); + for I:=0 to length(MD.Ereignisse)-1 do + f.add('Ereignisse['+inttostr(I)+'] '+TEreignisToStr(MD.Ereignisse[I])); + write('.'); + f.add('length(Personen) '+inttostr(length(MD.Personen))); + for I:=0 to length(MD.Personen)-1 do + f.add('Personen['+inttostr(I)+'] '+TPersonToStr(MD.Personen[I])); + write('.'); + f.add('length(Familien) '+inttostr(length(MD.Familien))); + for I:=0 to length(MD.Familien)-1 do + f.add('Familien['+inttostr(I)+'] '+TFamilieToStr(MD.Familien[I])); + write('.'); + setlength(s,length(MD.ParameterAttribute)); + for I:=0 to length(MD.ParameterAttribute)-1 do + s[I+1]:=MD.ParameterAttribute[I].toChar; + write('.'); + f.add('Unabhaengig '+s); + f.add('length(Parameter) '+inttostr(length(Parameter))); + for I:=0 to length(Parameter)-1 do + f.add('Parameter['+inttostr(I)+'] '+myfloattostr(Parameter[I])); + write('.'); + f.add('length(Verknuepfungen) '+inttostr(length(MD.Verknuepfungen))); + for I:=0 to length(MD.Verknuepfungen)-1 do + f.add('Verknuepfungen['+inttostr(I)+'] '+TVerknuepfungToStr(MD.Verknuepfungen[I])); + write('.'); + f.add('length(MMInteraktionen) '+inttostr(length(MD.MMInteraktionen))); + for I:=0 to length(MD.MMInteraktionen)-1 do + f.add('MMInteraktionen['+inttostr(I)+'] '+TMMInteraktionToStr(MD.MMInteraktionen[I])); + write('.'); + f.add('length(MFInteraktionen) '+inttostr(length(MD.MFInteraktionen))); + for I:=0 to length(MD.MFInteraktionen)-1 do + f.add('MFInteraktionen['+inttostr(I)+'] '+TMFInteraktionToStr(MD.MFInteraktionen[I])); + write('.'); + f.add('length(FFInteraktionen) '+inttostr(length(MD.FFInteraktionen))); + for I:=0 to length(MD.FFInteraktionen)-1 do + f.add('FFInteraktionen['+inttostr(I)+'] '+TFFInteraktionToStr(MD.FFInteraktionen[I])); + write('.'); + f.add('length(Tauschfamilien) '+inttostr(length(MD.Tauschfamilien))); + for I:=0 to length(MD.Tauschfamilien)-1 do + f.add('Tauschfamilien['+inttostr(I)+'] '+PFamilieToStr(MD.Tauschfamilien[I])); + write('.'); + f.add('Ende'); + f.saveToGz(Datei); + writeln(' fertig'); +end; + +procedure TStabile.Initialisiere(Anzahl: Longint; Art: string); +var + werDran,extraZufall: tIntArray; // werDran[wannDran[i].x] = i und + // wannDran[werDran[j]].x = j + wannDran: t4DPointArray; // 2 ^ -wannDran[i].y ist die eigene Sollbeziehungslänge; + // wannDrann[i].z ... abhängig von wem?; + // wannDran[i].u ... + // 0: als Vater abhängig, \ + // 1: als Mutter abhängig, --> 0 & 1 können _innerhalb_ einer Familie getauscht sein + // 2: als Mann abhängig, + // 3: als Frau abhängig, + // 4: als Nachfahr abhängig + //Kreise: array of tPointArray; // x: Person, y: Familie + i,j,k,l,m,n,Luecken,Wurzel: longint; + Timer: tTimer; + gefunden,fertig: boolean; + its: array of tStabileInitThread; +begin + Timer:=tTimer.create; + Timer.Start; + writeln('Initialisiere Parametersatz ...'); + + for k:=0 to length(MD.Personen)-1 do + MD.Personen[k].Index:=k; + for k:=0 to length(MD.Familien)-1 do + MD.Familien[k].Index:=k; + for k:=0 to length(MD.Ereignisse)-1 do + MD.Ereignisse[k].Index:=k; + + if length(Art)=0 then Art:='i'; + Schritte:=-1; + stepsize:=minSchrittweite; + setlength(Parameter,MD.ParameterLaenge); + Energie:=0; + Kreuzungen:=0; + for i:=1 to length(Art) do begin + if NotAus.istZuende then break; + case Art[i] of + 'b': begin + if (i=1) or (Art[i]<>Art[i-1]) then writeln(' - auf Bäume optimiert:'); + Wurzel:=-1; + Luecken:=length(MD.Personen); + for j:=0 to length(MD.Personen)-1 do begin + for k:=0 to length(Parameter)-1 do + Parameter[k]:=-1; + Parameter[MD.Personen[j].P1]:=1; + Parameter[MD.Personen[j].P2]:=1; + for k:=length(MD.Verknuepfungen)-1 downto 0 do + if Parameter[MD.Verknuepfungen[k].Output['x']]>0 then begin + Parameter[MD.Verknuepfungen[k].Input[0,'x']]:=1; + Parameter[MD.Verknuepfungen[k].Input[0,'y']]:=1; + Parameter[MD.Verknuepfungen[k].Input[1,'x']]:=1; + Parameter[MD.Verknuepfungen[k].Input[1,'y']]:=1; + end; + for k:=0 to length(MD.Verknuepfungen)-1 do + if (Parameter[MD.Verknuepfungen[k].Input[0,'x']]>0) or + (Parameter[MD.Verknuepfungen[k].Input[1,'x']]>0) then begin + Parameter[MD.Verknuepfungen[k].Output['x']]:=1; + Parameter[MD.Verknuepfungen[k].Output['y']]:=1; + Parameter[MD.Verknuepfungen[k].Input[0,'x']]:=1; + Parameter[MD.Verknuepfungen[k].Input[0,'y']]:=1; + Parameter[MD.Verknuepfungen[k].Input[1,'x']]:=1; + Parameter[MD.Verknuepfungen[k].Input[1,'y']]:=1; + end; + l:=0; + for k:=0 to length(MD.Personen)-1 do + if Parameter[MD.Personen[k].P1]<0 then + inc(l); + if (Wurzel=-1) or (l<Luecken) then begin + Wurzel:=j; + Luecken:=l; + end; + end; + writeln(' ('+ + MD.Personen[Wurzel].Vorname+' '+ + MD.Personen[Wurzel].Nachname+ + ', Lücken: '+inttostr(Luecken)+')'); +(* if Art[i]='i' then begin + writeln('Kreise suchen ...'); + Kreise:=md.findeKreise; + writeln('... und '+inttostr(length(Kreise))+' Kreise gefunden!'); + for j:=0 to length(Kreise)-1 do + write(length(Kreise[j]),' '); + if length(Kreise)>0 then begin + writeln; + j:=20; + while (not keypressed) and (j>0) do begin + sleep(100); + dec(j); + end; + if keypressed then + case readkey of + #27,'q': halt; + #13: begin + for j:=0 to length(Kreise)-1 do begin + writeln; + for k:=0 to length(Kreise[j])-1 do + writeln(md.Personen[Kreise[j,k].x].Vorname+' '+md.Personen[Kreise[j,k].x].Nachname+' ('+inttostr(Kreise[j,k].x)+')<--->('+inttostr(Kreise[j,k].y)+') Familie '+md.Familien[Kreise[j,k].y].Eltern[0].Nachname+' ('+md.Familien[Kreise[j,k].y].Eltern[1].Nachname+')'); + if readkey in [#27,'q'] then halt; + end; + halt; + end; + end{of case}; + end; + end; *) + + // Es folgt die Initialisierung von wannDran, werDran und extraZufall + + setlength(extraZufall,0); + setlength(werDran,length(MD.Personen)); + setlength(wannDran,length(MD.Personen)); + for k:=0 to length(werDran)-1 do begin + werDran[k]:=-1; + wannDran[k].x:=-1; + wannDran[k].y:=-1; + wannDran[k].z:=-1; + wannDran[k].u:=-1; + end; + werDran[0]:=Wurzel; + wannDran[Wurzel].x:=0; + wannDran[Wurzel].y:=2; + wannDran[Wurzel].z:=-1; + wannDran[Wurzel].u:=-1; + + m:=1; + while (m<length(wannDran)) and not NotAus.istZuende do begin // Zweierpotenzen verteilen + gefunden:=false; + for k:=0 to length(MD.Familien)-1 do // von den Nachfahren zu den Vorfahren + with MD.Familien[k] do + if (wannDran[Eltern[0].Index].x=-1) and + (wannDran[Eltern[1].Index].x=-1) then // beide Elternteile sind noch nicht dran gewesen + for l:=0 to length(Kinder)-1 do + if wannDran[Kinder[l].Index].x<>-1 then begin // dieses Kind war schon dran + if (wannDran[Eltern[0].Index].x<>-1) and + (wannDran[Eltern[1].Index].x<>-1) then begin // ein anderes Kind hat die Eltern schon fixiert (relativ selten) + if j=1 then + writeln('doppelt bestimmt: '+Eltern[0].Vorname+' '+Eltern[0].Nachname+' und '+Eltern[1].Vorname+' '+Eltern[1].Nachname+' -> ['+inttostr(Kinder[l].Index)+'] '+inttostr(wannDran[Kinder[l].Index].x)); + setlength(extraZufall,length(extraZufall)+1); + extraZufall[length(extraZufall)-1]:=Kinder[l].P3; + continue; + end; + for n:=0 to 1 do begin + wannDran[Eltern[n].Index].x:=m; + wannDran[Eltern[n].Index].y:=wannDran[Kinder[l].Index].y+1; // 1/2 so lang wie das Kind + wannDran[Eltern[n].Index].z:=Kinder[l].Index; + wannDran[Eltern[n].Index].u:=n; + werDran[m]:=Eltern[n].Index; + inc(m); + end; + gefunden:=true; + end; + if gefunden then continue; // Solange von den Nachfahren zu den Vorfahren was gefunden wurde, wird da auch noch mal gesucht! + for k:=0 to length(MD.Familien)-1 do // von den Vorfahren zu den Nachfahren + with MD.Familien[k] do + if (wannDran[Eltern[0].Index].x<>-1) and + (wannDran[Eltern[1].Index].x<>-1) then begin // beide Elternteile sind schon dran gewesen + for l:=0 to length(Kinder)-1 do + if wannDran[Kinder[l].Index].x=-1 then begin // dieses Kind war noch nicht dran + wannDran[Kinder[l].Index].x:=m; + wannDran[Kinder[l].Index].y:=max(wannDran[Eltern[0].Index].y,wannDran[Eltern[1].Index].y); + wannDran[Kinder[l].Index].z:=k; // nur hier indiziert .z die Familie !!! (ansonsten Personen) + wannDran[Kinder[l].Index].u:=4; + werDran[m]:=Kinder[l].Index; + inc(m); + gefunden:=true; + break; + end; + if gefunden then break; + end; + if gefunden then continue; // Solange von den Vorfahren zu den Nachfahren was gefunden wurde, wird noch mal gesucht! + n:=-1; + for k:=0 to length(MD.Familien)-1 do // von Partner zu Partner + with MD.Familien[k] do + if ((wannDran[Eltern[0].Index].x<>-1) xor + (wannDran[Eltern[1].Index].x<>-1)) and // genau ein Elternteil schon dran gewesen + ((n=-1) or + (MD.Familien[n].Anfang.Jahr > Anfang.Jahr)) then // Familie ist älter + n:=k; + if n<>-1 then + with MD.Familien[n] do begin + if (wannDran[Eltern[0].Index].x=-1) then begin // Vater noch nicht dran gewesen + wannDran[Eltern[0].Index].x:=m; + wannDran[Eltern[0].Index].y:=wannDran[Eltern[1].Index].y+1; // 1/2 so lang wie die andere Ehe der Frau + wannDran[Eltern[0].Index].z:=Eltern[1].Index; + wannDran[Eltern[0].Index].u:=2; + werDran[m]:=Eltern[0].Index; + gefunden:=true; + inc(m); + end; + if wannDran[Eltern[1].Index].x=-1 then begin // Mutter noch nicht dran gewesen + wannDran[Eltern[1].Index].x:=m; + wannDran[Eltern[1].Index].y:=wannDran[Eltern[0].Index].y+1; // 1/2 so lang wie die andere Ehe des Mannes + wannDran[Eltern[1].Index].z:=Eltern[0].Index; + wannDran[Eltern[1].Index].u:=3; + werDran[m]:=Eltern[1].Index; + gefunden:=true; + inc(m); + end; + end; + if gefunden then continue; + writeln('*** Fehler *** Manche Personen gehören nicht in die Zusammenhangskomponente der Wurzel!'); // sollte nicht passieren, wurde in ladeXML ggf. korrigiert! + for k:=0 to length(MD.Familien)-1 do + with MD.Familien[k] do begin + gefunden:=false; + if (wannDran[Eltern[0].Index].x=-1) or + (wannDran[Eltern[1].Index].x=-1) then gefunden:=true; + for l:=0 to length(Kinder)-1 do + if wannDran[Kinder[l].Index].x=-1 then gefunden:=true; + if gefunden then begin + writeln('ID: '+ID); + writeln(' '+inttostr(wannDran[Eltern[0].Index].x)+' '+Eltern[0].Vorname+' '+Eltern[0].Nachname+' '+inttostr(Eltern[0].Anfang.Jahr)); + writeln(' '+inttostr(wannDran[Eltern[0].Index].x)+' '+Eltern[1].Vorname+' '+Eltern[1].Nachname+' '+inttostr(Eltern[1].Anfang.Jahr)); + writeln(' '+inttostr(length(Kinder))+' Kinder'); + for l:=0 to length(Kinder)-1 do + with Kinder[l] do + writeln(' '+inttostr(l)+' '+inttostr(wannDran[Index].x)+' '+' '+Vorname+' '+Nachname+' '+inttostr(Anfang.Jahr)); + writeln; + end; + end; + halt; + end; + + for k:=0 to length(wannDran)-1 do + if werDran[wannDran[k].x]<>k then begin + writeln('Fehler: werDran[wannDran['+inttostr(k)+'].x]<>'+inttostr(k)); + halt; + end; + for k:=0 to length(werDran)-1 do + if wannDran[werDran[k]].x<>k then begin + writeln('Fehler: wannDran[werDran['+inttostr(k)+']].x<>'+inttostr(k)); + halt; + end; + end; + 'M': if (i=1) or (Art[i]<>Art[i-1]) then writeln(' - zufällig:'); + else begin + writeln('Den Parameter '''+Art[i]+''' kenne ich nicht!'); + exit; + end; + end{of Case}; + + setlength(its,max(2,momentanFreieCpus-1)); + for j:=0 to length(its)-1 do + its[j]:=tStabileInitThread.create(self,werDran,extraZufall,wannDran,Art[i],(Anzahl div length(its)) + (Anzahl mod length(its))*byte(j=length(its))); + + for j:=0 to length(its)-1 do + its[j].suspended:=false; + + repeat + sleep(10); + fertig:=true; + for j:=0 to length(its)-1 do + fertig:=fertig and its[j].fertig; + until fertig; + + if not NotAus.istZuende then begin + k:=0; + for j:=1 to length(its)-1 do + if (its[j].Kreuzungen<its[k].Kreuzungen) or + ((its[j].Kreuzungen=its[k].Kreuzungen) and + (its[j].Energie<its[k].Energie)) then + k:=j; + + Energie:=its[k].Energie; + Kreuzungen:=its[k].Kreuzungen; + for j:=0 to length(Parameter)-1 do + Parameter[j]:=its[k].Parameter[j]; + end; + + for j:=0 to length(its)-1 do + its[j].free; + setlength(its,0); + end; + writeln('... fertig'); + Laufzeit:=Laufzeit+Timer.gibZeit; + Timer.free; +end; + +procedure TStabile.optimiere; +var + Timer: TTimer; + i,j,k,NKreuzung,Kreuzung,NK: longint; + c: char; + NP,Richtung: TExtendedArray; + abhaengiges: TBooleanArray; + Perm: TIntArray; + Ax,Ay,Rx,Ry,tmp,sz,gesamtSchritt: extended; + echtePermutation,wasGefunden,TauschenErlauben: boolean; +begin + Timer:=tTimer.create; + Timer.Start; + writeln('Starte Optimierung ...'); + setlength(abhaengiges,MD.ParameterLaenge); + setlength(NP,MD.ParameterLaenge); + setlength(Richtung,MD.ParameterLaenge); + TauschenErlauben:=true; + Kreuzung:=-1; + NKreuzung:=-1; + while not NotAus.istZuende do + begin + inc(Schritte); + stepsize:=max(minSchrittweite,stepsize/power(schrittweitenmultiplikator,sollABAnteil)); + for c:='a' to 'f' do + begin + if NotAus.istZuende then break; + case c of + 'a': + begin + for I:=0 to length(NP)-1 do + if random*SchrittweitenSchwelle < stepSize then + NP[I]:=min(1,max(0,Parameter[I]+max(stepsize,SchrittweitenSchwelle)*(random-0.5))); + end; + 'b': + begin + for I:=0 to length(NP)-1 do + begin + tmp:=NP[I]-Parameter[I]; + NP[I]:=min(1,max(0,Parameter[I]-tmp)); + end; + end; + 'c'..'f': + begin + if (Kreuzungen=0) or not TauschenErlauben then continue; + for I:=0 to length(NP)-1 do + abhaengiges[I]:=false; + for I:=0 to 1 do begin + abhaengiges[MD.FFInteraktionen[Kreuzung]._Fs[I].Eltern[WenTauschen[ord(C)-ord('c'),I]].P1]:=true; + abhaengiges[MD.FFInteraktionen[Kreuzung]._Fs[I].Eltern[WenTauschen[ord(C)-ord('c'),I]].P2]:=true; + end; + repeat + wasGefunden:=false; + for I:=0 to length(MD.Verknuepfungen)-1 do + if (abhaengiges[MD.Verknuepfungen[I].Output['x']] or + abhaengiges[MD.Verknuepfungen[I].Output['y']]) and + not abhaengiges[MD.Verknuepfungen[I].Input[0,'x']] then begin + wasGefunden:=true; + abhaengiges[MD.Verknuepfungen[I].Input[0,'x']]:=true; + abhaengiges[MD.Verknuepfungen[I].Input[0,'y']]:=true; + abhaengiges[MD.Verknuepfungen[I].Input[1,'x']]:=true; + abhaengiges[MD.Verknuepfungen[I].Input[1,'y']]:=true; + end; + until not wasGefunden; + Ax:= + (Parameter[MD.FFInteraktionen[Kreuzung]._Fs[0].Eltern[WenTauschen[ord(C)-ord('c'),0]].P1]+ + Parameter[MD.FFInteraktionen[Kreuzung]._Fs[1].Eltern[WenTauschen[ord(C)-ord('c'),1]].P1]); + Ay:= + (Parameter[MD.FFInteraktionen[Kreuzung]._Fs[0].Eltern[WenTauschen[ord(C)-ord('c'),0]].P2]+ + Parameter[MD.FFInteraktionen[Kreuzung]._Fs[1].Eltern[WenTauschen[ord(C)-ord('c'),1]].P2]); + Rx:= + (Parameter[MD.FFInteraktionen[Kreuzung]._Fs[0].Eltern[WenTauschen[ord(C)-ord('c'),0]].P2]- + Parameter[MD.FFInteraktionen[Kreuzung]._Fs[1].Eltern[WenTauschen[ord(C)-ord('c'),1]].P2]); + Ry:= + (Parameter[MD.FFInteraktionen[Kreuzung]._Fs[1].Eltern[WenTauschen[ord(C)-ord('c'),1]].P1]- + Parameter[MD.FFInteraktionen[Kreuzung]._Fs[0].Eltern[WenTauschen[ord(C)-ord('c'),0]].P1]); + tmp:=sqrt(sqr(Rx)+sqr(Ry)); + Rx:=Rx/max(epsilon,tmp); + Ry:=Ry/max(epsilon,tmp); + for I:=0 to length(Parameter)-1 do + NP[I]:=Parameter[I]; + for I:=0 to length(MD.Personen)-1 do + if abhaengiges[MD.Personen[I].P1] then begin + tmp:=(Rx * (Ax - NP[MD.Personen[I].P1]) + Ry * (Ay - NP[MD.Personen[I].P2])); + NP[MD.Personen[I].P1]:= + NP[MD.Personen[I].P1] + Rx * tmp; + NP[MD.Personen[I].P2]:= + NP[MD.Personen[I].P2] + Ry * tmp; // eine Spiegelung an der Geraden durch A[x,y], senkrecht zu R[x,y] +(* tmp:= + Ax + + 2*((NP[MD.Personen[I].P1]-Ax)*Rx + (NP[MD.Personen[I].P2]-Ay)*Ry)*Rx + - (NP[MD.Personen[I].P1]-Ax); + NP[MD.Personen[I].P2]:= + Ay + + 2*((NP[MD.Personen[I].P1]-Ax)*Rx + (NP[MD.Personen[I].P2]-Ay)*Ry)*Ry + - (NP[MD.Personen[I].P2]-Ay); *) + NP[MD.Personen[I].P1]:=tmp; +// NP[MD.Personen[I].P1]:=min(1,max(0,NP[MD.Personen[I].P1])); +// NP[MD.Personen[I].P2]:=min(1,max(0,NP[MD.Personen[I].P2])); + if (NP[MD.Personen[I].P1]<0) or (NP[MD.Personen[I].P1]>1) or + (NP[MD.Personen[I].P2]<0) or (NP[MD.Personen[I].P2]>1) then begin + ax:=NP[MD.Personen[I].P1]; + ay:=NP[MD.Personen[I].P2]; + rx:=ax; + ry:=ay; + for j:=0 to length(MD.Personen)-1 do + if MD.Parameterattribute[MD.Personen[j].P1].istUnabhaengig then begin + ax:=min(ax,NP[MD.Personen[j].P1]); + ay:=min(ay,NP[MD.Personen[j].P2]); + rx:=max(rx,NP[MD.Personen[j].P1]); + ry:=max(ry,NP[MD.Personen[j].P2]); + end; + rx:=1/max(rx-ax,epsilon); + ry:=1/max(ry-ay,epsilon); + for j:=0 to length(MD.Personen)-1 do begin + NP[MD.Personen[j].P1]:=(NP[MD.Personen[j].P1]-ax)*rx; + NP[MD.Personen[j].P2]:=(NP[MD.Personen[j].P2]-ay)*ry; + end; + end; + abhaengiges[MD.Personen[I].P1]:=false; + abhaengiges[MD.Personen[I].P2]:=false; + end; + end; + 'g'..'z': + begin + TauschenErlauben:=Kreuzungen>100; + if length(MD.Tauschfamilien)=0 then break; + for I:=0 to length(Parameter)-1 do + NP[I]:=Parameter[I]; + I:=Random(length(MD.Tauschfamilien)); + if odd(ord(c)-ord('g')) then + begin //nur zwei permutieren + J:=random(length(MD.Tauschfamilien[I].Kinder)); + K:=random(length(MD.Tauschfamilien[I].Kinder)-1); + K:=K+Byte(K>=J); + NP[MD.Personen[J].P3]:=Parameter[MD.Personen[K].P3]; + NP[MD.Personen[K].P3]:=Parameter[MD.Personen[J].P3]; + echtePermutation:=false; + end + else + begin //beliebige Permutation + Perm:=Permutation(length(MD.Tauschfamilien[I].Kinder)); + J:=0; + for K:=0 to length(Perm)-1 do + J:=J+Byte(Perm[K]<>K); + echtePermutation:=J>2; + for K:=0 to length(Perm)-1 do + NP[MD.Tauschfamilien[I].Kinder[Perm[K]].P3]:= + Parameter[MD.Tauschfamilien[I].Kinder[K].P3]; + end; + end; + end{of case}; + MD.berechneAbhaengigeVariable(NP{$IFDEF detaillierteZeitanalyse},true{$ENDIF}); + tmp:=MD.Energie(NP,NK,NKreuzung{$IFDEF detaillierteZeitanalyse},true{$ENDIF}); + if Kreuzung<0 then + Kreuzung:=NKreuzung; + if (c in ['a'..'b']) and NotAus.Stati[6] then + writeln('6) '+c+' ',tmp,' ',NK,' Kreuzungen (',stepsize,')'); + if + (Kreuzungen>NK) or + ((tmp<Energie) and + (Kreuzungen=NK)) then + begin + TauschenErlauben:=true; + Energie:=tmp; + Kreuzungen:=NK; + Kreuzung:=NKreuzung; + if (c<='b') and ((exp(Kreuzungen)-1)*random<=Byte(Kreuzungen<4)) then + begin + for I:=0 to length(Parameter)-1 do + begin + Richtung[I]:=NP[I]-Parameter[I]; + Parameter[I]:=NP[I]; + end; + sz:=1; + j:=0; + gesamtSchritt:=1; + repeat + for I:=0 to length(Parameter)-1 do + NP[I]:=Parameter[I]+sz*Richtung[I]; + MD.berechneAbhaengigeVariable(NP{$IFDEF detaillierteZeitanalyse},true{$ENDIF}); + tmp:=MD.Energie(NP,NK,NKreuzung{$IFDEF detaillierteZeitanalyse},true{$ENDIF}); + if + (Kreuzungen>NK) or + ((tmp<Energie) and + (Kreuzungen=NK)) then + begin + inc(j); + TauschenErlauben:=true; + Energie:=tmp; + Kreuzungen:=NK; + Kreuzung:=NKreuzung; + for I:=0 to length(Parameter)-1 do + Parameter[I]:=NP[I]; + gesamtSchritt:=gesamtSchritt+sz; + sz:=sz*1.2; + end + else + sz:=-sz/1.05; + until (abs(sz)<0.1) or NotAus.istZuende; + if NotAus.Stati[8] then + begin + write('8) '+inttostr(j)+' fach optimiert, insgesamt Faktor '+myfloattostr(gesamtSchritt)+' '); + j:=0; + for I:=0 to length(Richtung)-1 do + j:=j+Byte(Richtung[I]<>0); + writeln(inttostr(j)+'/'+inttostr(MD.ParameterLaenge)+' Parameter variiert'); + end; + end + else + begin + for I:=0 to length(Parameter)-1 do + Parameter[I]:=NP[I]; + end; + if NotAus.Stati[7] then + begin + write(char(ord(c)+(ord('A')-ord('a'))*Byte((c>='g') and echtePermutation))); + printStatus(7); + end; + printStatus(5); + if C<='b' then + stepsize:=min(0.5,stepsize*schrittweitenmultiplikator); + NotAus.istZuende; + break; + end; + if NotAus.istZuende then break; + end; + end; + Laufzeit:=Laufzeit+Timer.gibZeit; + Timer.free; +end; + +procedure tStabile.downHillSimplex; +var + Timer: tTimer; + off,tol,i,cnt,aPos: longint; + c: char; + erg: tSchrittErgebnis; + np: tExtendedArray; + mi,ma: extended; + Simplex: tParameterSimplex; +const + startCnt = 100; +begin + if notAus.istZuende then exit; + Timer:=tTimer.create; + Timer.Start; + + writeln('Unabhängige Parameter normieren ...'); + mi:=1; + ma:=0; + for i:=0 to md.ParameterLaenge-1 do + if md.Parameterattribute[i].istKoordinate and md.Parameterattribute[i].istUnabhaengig then begin + mi:=min(mi,Parameter[i]); + ma:=max(ma,Parameter[i]); + end; + ma:=0.5/(ma-mi); + mi:=mi - 0.25/ma; + for i:=0 to md.ParameterLaenge-1 do + if md.Parameterattribute[i].istKoordinate and md.Parameterattribute[i].istUnabhaengig then + Parameter[i]:=(Parameter[i]-mi)*ma; + writeln('... fertig'); + + writeln('Simplex initialisieren ...'); + Simplex:=tParameterSimplex.create; + Simplex.md:=md; + Simplex.init(Parameter,max(1,momentanFreieCpus-1)); + writeln('... fertig'); + Simplex.printHistogramm; + + cnt:=0; + off:=0; + c:='-'; + tol:=10; + setlength(np,Simplex.pDim); + while not NotAus.istZuende do begin + +(* if Simplex.maxKreuzungen-Simplex.minKreuzungen>2 then begin + Simplex.printSpur('test.txt',Simplex.Reihenfolge[length(Simplex.Reihenfolge)-1],Simplex.Reihenfolge[0]); + Simplex.printHistogramm; + halt; + end; *) + + aPos:=Simplex.Reihenfolge[Simplex.dim-off]; + erg:=Simplex.SimplexSchritt(np,1,-0.2,1.1,1.25,off); + if (false and (cnt<=0.9*startCnt) and erg.besserAlsVorher) or (cnt<-startCnt) then begin + write(c+' '+inttostr(aPos)+'. Ecke ('+inttostr(off+1)+'. von hinten) ver'); + if erg.besserAlsVorher then write('bess') + else write('schlecht'); + write('ert'); + if erg.Platzveraenderung<>0 then write(' ('+inttostr(erg.Platzveraenderung)+' Plätze)'); + if erg.faktorNeutralisiert then write(' (Faktor neutralisiert)'); + writeln(' '+inttostr(Simplex.minKreuzungen)+'..'+inttostr(Simplex.maxKreuzungen)+' Kreuzungen, Energie: '+myfloattostr(Simplex.minEnergie)+'..'+myfloattostr(Simplex.maxEnergie)+' Kantenlänge: '+myfloattostr(Simplex.mittlereKantenlaenge)); + Simplex.printHistogramm; + cnt:=startCnt; + end; + dec(cnt); + case NotAus.lastKey of + 'v': begin + writeln('mittlere Simplex-Kantenlänge: '+myfloattostr(Simplex.mittlereKantenlaenge)); + NotAus.lastKey:=#0; + end; + {$IFDEF detaillierteZeitanalyse} + 't': begin + writeln('Zeiten: '); + md.printTimer(' '); + NotAus.lastKey:=#0; + end; + {$ENDIF} + 'a': begin + cpuUtilization; + NotAus.lastKey:=#0; + write('Soll ich den Simplex neu an der beseten Ecke ausrichten? (j/n) '); + c:=readkey; + while not (c in ['j','J','n','N']) do begin + writeln; + writeln(''''+c+''' verstehe ich nicht, aber ich wiederhole die Frage gerne noch einmal:'); + write('Soll ich den Simplex neu an der beseten Ecke ausrichten? (j/n) '); + c:=readkey; + end; + writeln; + if c in ['j','J'] then begin + writeln('Neu ausrichten ...'); + Simplex.outit(Parameter); + Simplex.init(Parameter,max(1,momentanFreieCpus-1)); + writeln('... fertig'); + Simplex.printHistogramm; + end; + end; + 'm': begin + NotAus.lastKey:=#0; + writeln('belegter Speicher: '+inttostr(belegterSpeicher)+' kB'); + end; + end{of case}; + if (erg.Platzveraenderung>0) or (off>Simplex.dim-2) then begin // Platz gut gemacht, wir arbeiten uns von unten wieder hoch + tol:=10; + off:=0; + end + else if erg.Platzveraenderung<0 then // Platz verloren, wir füllen die Toleranz neu + tol:=10 + else if erg.besserAlsVorher then begin // verbessert, aber kein Platz gut gemacht, Toleranz wird decrementiert + dec(tol); + if tol<=0 then begin + tol:=10; + inc(off); + end; + end + else begin // verschlechtert ohne Platzverlust, wir optimieren am nächsten rum + tol:=10; + inc(off); + end; + case c of + '-': c:='/'; + '/': c:='|'; + '|': c:='\'; + '\': c:='-'; + end; + end; + setlength(np,0); + Simplex.outit(Parameter); // Fortschritt auf Stabile übertragen + + Simplex.free; + Laufzeit:=Laufzeit+Timer.gibZeit; + Timer.free; +end; + +procedure tStabile.gradientenOptimierung; +var + Timer: tTimer; + Gradient,step,alt,ganzAlt,semiAlt: tExtendedArray; + mi,ma,aEner,ener,gaEner,phi,tmp: extended; + i,aKrzgn,krzgn,gaKrzgn, + ocnt,cnt,gut,schlecht: longint; + vkn: tVerknuepfung; + modus,baMod: byte; // 0 = nur Eltern[0] einzufügen; 1 = nur Eltern[1] einzufügen; 2 = beide Eltern einzufügen; 3 = Kind einzufügen + neuP: tPerson; + neuF: tFamilie; +(* + j: longint; + f: textfile; *) +begin + if notAus.istZuende then exit; + Timer:=tTimer.create; + Timer.Start; + + writeln('Unabhängige Parameter normieren ...'); + mi:=1; + ma:=0; + for i:=0 to md.ParameterLaenge-1 do + if md.Parameterattribute[i].istKoordinate and + md.Parameterattribute[i].wirdBenutzt then begin + mi:=min(mi,Parameter[i]); + ma:=max(ma,Parameter[i]); + end; + ma:=0.5/(ma-mi); + mi:=mi - 0.25/ma; + for i:=0 to md.ParameterLaenge-1 do + if md.Parameterattribute[i].istKoordinate and + md.Parameterattribute[i].wirdBenutzt then + Parameter[i]:=(Parameter[i]-mi)*ma; + writeln('... fertig'); + + setlength(step,md.ParameterLaenge); + setlength(Gradient,md.ParameterLaenge); + setlength(alt,md.ParameterLaenge); + + md.berechneAbhaengigeVariable(Parameter); + aEner:=md.Energie(Parameter,aKrzgn,i); + + gaEner:=aEner; + gaKrzgn:=aKrzgn; + setlength(ganzAlt,length(Parameter)); + setlength(semiAlt,length(Parameter)); + for i:=0 to length(ganzAlt)-1 do begin + ganzAlt[i]:=Parameter[i]; + semiAlt[i]:=Parameter[i]; + end; + +(* md.Gradient(Parameter,Gradient); + md.GradientenRueckPropagation(Parameter,Gradient); + + assignfile(f,'test.txt'); + rewrite(f); + for i:=0 to md.Unabhaengig-1 do begin + if i<>0 then write(f,#9); + write(f,myfloattostr(Parameter[i])); + end; + writeln(f); + for i:=0 to md.Unabhaengig-1 do begin + if i<>0 then write(f,#9); + write(f,myfloattostr(Gradient[i])); + end; + writeln(f); + setlength(Gradient,length(Parameter)); + for i:=-1 to md.Unabhaengig-1 do begin + for j:=0 to md.Unabhaengig-1 do + Gradient[j]:=Parameter[j]+1e-10*byte(i=j); + md.berechneAbhaengigeVariable(Gradient); + ener:=md.Energie(Gradient,krzgn,j); + write(f,myfloattostr(ener)); + for j:=0 to md.Unabhaengig-1 do + write(f,#9+myfloattostr(Gradient[j])); + writeln(f); + end; + + closefile(f); + + halt; *) + + baMod:=0; + + repeat + + cnt:=100; + gut:=0; + schlecht:=0; + ocnt:=3; + + if baMod=1 then write('-'); + + while (not NotAus.istZuende) and ((baMod=2) or (aKrzgn>0) or (ocnt>0)) do begin + if (baMod=1) and + (aKrzgn>0) then write('!'); + + if baMod<=1 then begin + if aKrzgn=0 then + dec(ocnt) + else + ocnt:=3; + end; + + md.Gradient(Parameter,Gradient); + md.GradientenRueckPropagation(Parameter,Gradient); + + ma:=0; + for i:=0 to md.ParameterLaenge-1 do + if md.Parameterattribute[i].istUnabhaengig then + ma:=ma + sqr(Gradient[i]); + ma:=-stepsize/sqrt(ma); + tmp:=2*stepsize/(1+99*byte(baMod<>2)); + + for i:=0 to md.ParameterLaenge-1 do begin + alt[i]:=Parameter[i]; + if md.Parameterattribute[i].istUnabhaengig then begin + step[i]:=Gradient[i]*ma + tmp*(random-0.5); + Parameter[i]:=min(1,max(0,Parameter[i]+step[i])); + end; + end; + + md.berechneAbhaengigeVariable(Parameter); + ener:=md.Energie(Parameter,Krzgn,i); + + if (krzgn>aKrzgn) or ((krzgn=aKrzgn) and (ener>aEner)) then begin + inc(schlecht); + if (0.5*stepsize<minSchrittweite) and + ((krzgn=0) or (baMod=2)) then begin + write('X'); + aEner:=ener; + aKrzgn:=krzgn; + if stepsize=minSchrittweite then + break; + stepsize:=minSchrittweite; + end + else + for i:=0 to md.ParameterLaenge-1 do + Parameter[i]:=alt[i]; + stepsize:=max(stepsize*0.5,minSchrittweite); + end + else begin + inc(gut); + stepsize:=min(stepsize*1.2,0.5); + aEner:=ener; + aKrzgn:=krzgn; + end; + dec(cnt); + if cnt<0 then begin + tmp:=0; + for i:=0 to length(ganzAlt)-1 do + tmp:=tmp+sqr(ganzAlt[i]-Parameter[i]); + write(' '+inttostr(aKrzgn)+' & '+myfloattostr(aEner)+' ('+myfloattostr(stepsize)+' '+inttostr(gut)+'/'+inttostr(schlecht)+' = '+myfloattostr(gut/(gut+schlecht))+') '+inttostr(gaKrzgn-aKrzgn)+' & '+myfloattostr(gaEner-aEner)+' <- '+myfloattostr(sqrt(tmp))+' / '); + tmp:=0; + for i:=0 to length(semiAlt)-1 do begin + tmp:=tmp+sqr(semiAlt[i]-Parameter[i]); + semiAlt[i]:=Parameter[i]; + end; + writeln(myfloattostr(sqrt(tmp))); + gut:=0; + schlecht:=0; + cnt:=100; + end; + end; + + if baMod=1 then begin + writeln(inttostr(aKrzgn)+' & '+myfloattostr(aEner)+' ('+myfloattostr(stepsize)+' '+inttostr(gut)+'/'+inttostr(schlecht)+' = '+myfloattostr(gut/(gut+schlecht))+')'); + writeln(' '+inttostr(length(md.Laubhaufen))+' '+inttostr(md.anzUnbenutzt)+'/'+inttostr(md.ParameterLaenge)); + end; + + if NotAus.istZuende then continue; + + if baMod=0 then begin + writeln('Alle Kreuzungen entfernt, füge den Rest wieder ein ...'); + inc(baMod); + end; + if (baMod=1) and + ((not assigned(md.sicherung)) or + (length(md.Laubhaufen)=0)) then begin + writeln('Ursprünglicher Graph wieder hergestellt, optimiere noch weiter ...'); + inc(baMod); + end; + + if baMod=1 then begin + md.letztesBlattWiederAnkleben(vkn,neuP); + + if not (assigned(vkn) or assigned(neuP)) then begin + writeln('*** Fehler ***'); + writeln('Beim Einfügen des Blattes weder Person noch Verknüpfung zurückgegeben!'); + halt; + end; + + neuF:=nil; + if assigned(vkn) then begin + if assigned(neuP) then modus:=3 // Kind (=neuP) einzufügen + else begin + modus:=2; // beide Eltern einzufügen + neuP:=vkn.outP; // das Kind der Verknüpfung merken + end; + end + else begin + neuF:=neuP.elterVonFamilie(0); + if neuF<>nil then modus:=0 + else begin + neuF:=neuP.elterVonFamilie(1); + if neuF<>nil then modus:=1 + else begin + writeln('*** Fehler ***'); + writeln('Verknüfpung nicht zugewiesen, aber Person ist auch kein Elter einer bekannten Familie!'); + halt; + end; + end; + end; + + case modus of + 0,1: begin + mi:=1; + if assigned(neuF.Eltern[1-modus].KindIn) then // minimale Familienlänge der Familie finden, in der neuF.Eltern[1-modus] Kind ist + mi:=min(mi,QAbstand(Parameter,neuF.Eltern[1-modus].KindIn.Eltern[0],neuF.Eltern[1-modus].KindIn.Eltern[1])); + for i:=0 to length(neuF.Eltern[1-modus].ElterIn)-1 do // minimale Familienlänge der Familie finden, in der neuF.Elter[1-modus] Elter ist + if neuF.Eltern[1-modus].ElterIn[i]<>neuF then // und die nicht selbst die neue Familie ist + mi:=min(mi,QAbstand(Parameter,neuF.Eltern[1-modus].ElterIn[i].Eltern[0],neuF.Eltern[1-modus].ElterIn[i].Eltern[1])); + mi:=sqrt(mi); + end; + 2: begin + mi:=1; + for i:=0 to length(neuP.ElterIn)-1 do // minimale Familienlänge der Kindfamilien finden + mi:=min(mi,QAbstand(Parameter,neuP.ElterIn[i].Eltern[0],neuP.ElterIn[i].Eltern[1])); + mi:=sqrt(mi); + end; + end{of case}; + + cnt:=100; + + repeat + dec(cnt); + if cnt<0 then begin + cnt:=100; + write('-'); + end; + case modus of + 0,1: begin + phi:=2*pi*random; // der Winkel der neuen Familie + ma:=(0.1+0.8*random)*mi; // die Länge der neuen Familie + Parameter[neuP.p1]:=Parameter[neuF.Eltern[1-modus].p1] + ma*cos(phi); + Parameter[neuP.p2]:=Parameter[neuF.Eltern[1-modus].p2] + ma*sin(phi); + end; + 2: begin + phi:=2*pi*random; // der Winkel der neuen Familie + Parameter[vkn.Lambda]:=0.1+0.8*random; // Lambda des alten Kindes in der neuen Familie + ma:=(0.1+0.8*random)*mi; // die Länge der neuen Familie + Parameter[vkn.input[0,'x']]:= + Parameter[vkn.output['x']] - ma*Parameter[vkn.Lambda]*cos(phi); + Parameter[vkn.input[0,'y']]:= + Parameter[vkn.output['y']] - ma*Parameter[vkn.Lambda]*sin(phi); + + Parameter[vkn.input[1,'x']]:= + Parameter[vkn.output['x']] - ma*(Parameter[vkn.Lambda]-1)*cos(phi); + Parameter[vkn.input[1,'y']]:= + Parameter[vkn.output['y']] - ma*(Parameter[vkn.Lambda]-1)*sin(phi); + end; + 3: + Parameter[vkn.Lambda]:=0.1+0.8*random; // Lambda des neuen Kindes + end{of case}; + + md.berechneAbhaengigeVariable(Parameter); + md.Energie(Parameter,aKrzgn,i); + until (aKrzgn=0) or NotAus.istZuende; + end; + + until NotAus.istZuende; + + setlength(gradient,0); + setlength(alt,0); + setlength(step,0); + Laufzeit:=Laufzeit+Timer.gibZeit; + Timer.free; +end; + +// tEnergieThread ************************************************************** + +constructor tEnergieThread.create(s: tParameterSimplex; von,bis: longint; psBerechnen: boolean); +begin + inherited create(true); + _s:=s; + _von:=von; + _bis:=bis; + bp:=psBerechnen; + fertig:=false; + freeonterminate:=false; + suspended:=false; +end; + +destructor tEnergieThread.destroy; +begin + inherited destroy; +end; + +procedure tEnergieThread.execute; +var i: longint; +begin + for i:=_von to _bis do begin + if bp then + _s.berechneAbhaengigeVariable(i{$IFDEF detaillierteZeitanalyse},false{$ENDIF}); + _s.berechneEnergie(i{$IFDEF detaillierteZeitanalyse},false{$ENDIF}); + if (_bis-i) mod ((_bis-_von) div 10) = 0 then + write('.'); + end; + fertig:=true; +end; + + +// tStabileInitThread ********************************************************** + +constructor tStabileInitThread.create(s: tStabile; werDran,extraZufall: tIntArray; wannDran: t4DPointArray; art: char; anzahl: longint); +begin + inherited create(true); + _s:=s; + setlength(_werDran,length(werDran)); + if length(_werDran)>0 then + move(werDran[0],_werDran[0],length(_werDran)*sizeof(_werDran[0])); + setlength(_wannDran,length(wannDran)); + if length(_wannDran)>0 then + move(wannDran[0],_wannDran[0],length(_wannDran)*sizeof(_wannDran[0])); + setlength(_extraZufall,length(extraZufall)); + if length(_extraZufall)>0 then + move(extraZufall[0],_extraZufall[0],length(_extraZufall)*sizeof(_extraZufall[0])); + _art:=art; + _anzahl:=anzahl; + _mt:=tMersenneTwister.Create; + _mt.init(random(high(longword))); + Kreuzungen:=-1; + Energie:=-1; + setlength(Parameter,length(_s.Parameter)); + fertig:=false +end; + +destructor tStabileInitThread.destroy; +begin + _s:=nil; + _mt.free; + setlength(_werDran,0); + setlength(_wannDran,0); + setlength(_extraZufall,0); + inherited destroy; +end; + +procedure tStabileInitThread.execute; +var + i,j,k,l,m,NK,zufallMerker: longint; + NP: TExtendedArray; + tmp,Ax,Ay,Rx,Ry: extended; +begin + setlength(NP,_s.MD.ParameterLaenge); + + for j:=0 to length(NP)-1 do + NP[j]:=-1; + + for i:=1 to max(1,_Anzahl) do begin + zufallMerker:=0; + case _Art of + 'b': begin + if _s.NotAus.istZuende then break; + for j:=0 to length(_extraZufall)-1 do + NP[_extraZufall[j]]:=_mt.random; + for j:=0 to length(_werDran)-1 do + case _wannDran[_werDran[j]].u of + -1: begin // die Wurzel + NP[_s.MD.Personen[_werDran[j]].P1]:=0.5+0.01*_mt.random; + NP[_s.MD.Personen[_werDran[j]].P2]:=0.5+0.01*_mt.random; + end; + 0,1: begin // als +/- Vorfahr abhängig, + if _wannDran[_werDran[j]].u=0 then + zufallMerker:=2*_mt.random(2)-1 // + oder - + else + zufallMerker:=-zufallMerker; // - oder + + + NP[_s.MD.Personen[_werDran[j]].P1]:=NP[_s.MD.Personen[_wannDran[_werDran[j]].z].P1] + zufallMerker*power(2,-(_wannDran[_werDran[j]].y div 2)-1)*byte(odd(_wannDran[_werDran[j]].y)); + NP[_s.MD.Personen[_werDran[j]].P2]:=NP[_s.MD.Personen[_wannDran[_werDran[j]].z].P2] + zufallMerker*power(2,-(_wannDran[_werDran[j]].y div 2)-1)*byte(not odd(_wannDran[_werDran[j]].y)); + NP[_s.MD.Personen[_wannDran[_werDran[j]].z].P3]:=0.5+0.01*_mt.random; + end; + 2,3: begin // als Mann/Frau abhängig, + tmp:=_mt.random*2*pi; + NP[_s.MD.Personen[_werDran[j]].P1]:=NP[_s.MD.Personen[_wannDran[_werDran[j]].z].P1] - power(2,-(_wannDran[_werDran[j]].y div 2)-1)*cos(tmp); + NP[_s.MD.Personen[_werDran[j]].P2]:=NP[_s.MD.Personen[_wannDran[_werDran[j]].z].P2] - power(2,-(_wannDran[_werDran[j]].y div 2)-1)*sin(tmp); + end; + 4: begin // als Nachfahr abhängig + NP[_s.MD.Personen[_werDran[j]].P3]:=_mt.random; + NP[_s.MD.Personen[_werDran[j]].P1]:=NP[_s.MD.Familien[_wannDran[_werDran[j]].z].Eltern[0].P1] * (1 - NP[_s.MD.Personen[_werDran[j]].P3]) + + NP[_s.MD.Familien[_wannDran[_werDran[j]].z].Eltern[1].P1] * NP[_s.MD.Personen[_werDran[j]].P3]; + NP[_s.MD.Personen[_werDran[j]].P2]:=NP[_s.MD.Familien[_wannDran[_werDran[j]].z].Eltern[0].P2] * (1 - NP[_s.MD.Personen[_werDran[j]].P3]) + + NP[_s.MD.Familien[_wannDran[_werDran[j]].z].Eltern[1].P2] * NP[_s.MD.Personen[_werDran[j]].P3]; + end; + end{of case}; + k:=0; + for j:=0 to length(NP)-1 do + if (NP[j]<-0.5) and _s.MD.Parameterattribute[j].wirdBenutzt then begin + for l:=0 to length(_s.MD.Personen)-1 do begin + if (_s.MD.Personen[l].p1=j) then + writeln(inttostr(_wannDran[l].x)+' Personen['+inttostr(l)+'].P1 = '+myfloattostr(NP[j])+' '+inttostr(_wannDran[l].u)); + if (_s.MD.Personen[l].p2=j) then + writeln(inttostr(_wannDran[l].x)+' Personen['+inttostr(l)+'].P2 = '+myfloattostr(NP[j])+' '+inttostr(_wannDran[l].u)); + if (_s.MD.Personen[l].p3=j) then begin + writeln(inttostr(_wannDran[l].x)+' Personen['+inttostr(l)+'].P3 = '+myfloattostr(NP[j])+' '+inttostr(_wannDran[l].u)); + writeln(' '+inttostr(byte(assigned(_s.MD.Personen[l].KindIn)))); + if assigned(_s.MD.Personen[l].KindIn) then + writeln(' ['+inttostr(_s.MD.Personen[l].KindIn.Eltern[0].Index)+'] '+ + inttostr(_wannDran[_s.MD.Personen[l].KindIn.Eltern[0].Index].x)+' '+ + inttostr(_wannDran[_s.MD.Personen[l].KindIn.Eltern[0].Index].u)+' ['+ + inttostr(_s.MD.Personen[l].KindIn.Eltern[1].Index)+'] '+ + inttostr(_wannDran[_s.MD.Personen[l].KindIn.Eltern[1].Index].x)+' '+ + inttostr(_wannDran[_s.MD.Personen[l].KindIn.Eltern[1].Index].u)); + for m:=0 to length(_wannDran)-1 do + if _wannDran[m].z=l then + writeln(' <- ['+inttostr(m)+'] '+inttostr(_wannDran[m].x)+' '+inttostr(_wannDran[m].u)); + end; + end; + inc(k); + end; + if k>0 then begin // es gibt ungesetzte Parameter + writeln('Irgendwie sind '+inttostr(k)+' benutzte von insgesamt '+inttostr(_s.MD.ParameterLaenge)+' Parametern (davon '+inttostr(_s.MD.anzUnbenutzt)+' planmäßig unbenutzt) ungesetzt ...'); + halt(1); + end; + end; + 'M': + for j:=0 to _s.MD.ParameterLaenge-1 do + if _s.MD.Parameterattribute[j].istUnabhaengig then + NP[j]:=_mt.random; + end{of Case}; + _s.MD.berechneAbhaengigeVariable(NP{$IFDEF detaillierteZeitanalyse},true{$ENDIF}); + Ax:=NP[_s.MD.Personen[0].P1]; + Ay:=NP[_s.MD.Personen[0].P2]; + Rx:=Ax; + Ry:=Ay; + for j:=1 to length(_s.MD.Personen)-1 do begin + Ax:=min(Ax,NP[_s.MD.Personen[j].P1]); + Ay:=min(Ay,NP[_s.MD.Personen[j].P2]); + Rx:=max(Rx,NP[_s.MD.Personen[j].P1]); + Ry:=max(Ry,NP[_s.MD.Personen[j].P2]); + end; + Rx:=1/max(epsilon,Rx-Ax); + Ry:=1/max(epsilon,Ry-Ay); + for j:=0 to length(_s.MD.Personen)-1 do begin + NP[_s.MD.Personen[j].P1]:= + (NP[_s.MD.Personen[j].P1]-Ax)*Rx; + NP[_s.MD.Personen[j].P2]:= + (NP[_s.MD.Personen[j].P2]-Ay)*Ry; + end; + _s.MD.berechneAbhaengigeVariable(NP{$IFDEF detaillierteZeitanalyse},true{$ENDIF}); + tmp:=_s.MD.Energie(NP,NK,j{$IFDEF detaillierteZeitanalyse},true{$ENDIF}); + if (i=1) or + (Kreuzungen>NK) or + ((tmp<Energie) and + (Kreuzungen=NK)) then begin + Energie:=tmp; + Kreuzungen:=NK; + for j:=0 to length(Parameter)-1 do + Parameter[j]:=NP[j]; + end; + if _s.NotAus.istZuende then break; + end; + + fertig:=true; +end; + +end. |