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.