Thema: Delphi Itereation optimieren

Einzelnen Beitrag anzeigen

Benutzerbild von brinkee
brinkee

Registriert seit: 27. Aug 2004
60 Beiträge
 
Delphi 7 Enterprise
 
#6

Re: Itereation optimieren

  Alt 8. Sep 2007, 20:11
Hallo Leute,

danke für Eure Ratschläge. Wow, das hatte ich nicht geahnt: Ich habe die Funktionen func und getR aufgelöst und direkt in die iteration geschrieben. Jetzt dauert das Ganze nur noch 7 Sekunden, keine Minuten mehr. Das ist geil, aber immer noch nicht gut genug.

Ich werde jetzt als erstes mal meinen neuen Quellcode posten und alles ein bisschen Dokumentieren:

Delphi-Quellcode:
//####### Berechnen der Best-Fit-Values für den in "Datensatz" gegebenen Dataset ######
procedure TMainform.Regression;
Var
  x: Integer; //Variable für meine "for"-Anweisungen
  i, j, k, l, //Schleifenvariablen für die verschachtelte Iteration
  nr_fifty, nr_eighty, //Bei welcher Stoff-Konzentration werden 50/80% der Wirkung erreicht?
  xmin, xmax, ymin, ymax, //Maximal-/Minimalwerte
  a, b, c, d, start, R, Squares, Square: Double; //a, b, c und d tragen am Ende die gesuchten Werte, Squares ist für die Summe der Fehlerquadrate, Square ist der jeweilige Fehler
  F: TRealData;
  G: TRealArray;
  msg: String;
begin
  
  [...]


  //Um die vielen Funktionsaufrufe (.AsFloat) der Tabellen-Komponente (Datensatz) zu vehindern, werden die Werte zwischengespeichert!

  setlength(Dataset,2);
  setlength(Dataset[0], Datensatz.RowCount);
  setlength(Dataset[1], Datensatz.RowCount);

  for x := 0 to Datensatz.RowCount - 1 do
  begin
    Dataset[0, x] := Datensatz.Cell[0, x].AsFloat;
    Dataset[1, x] := Datensatz.Cell[1, x].AsFloat;
  end;

  //Parameter xmin, xmax, log(EC50) und hillslope mit den kleinsten Fehlerquadraten ermitteln
  start := 9999999999;

  i := ymin + 5;
  while i > ymin - 5 do
  begin
    j := ymax - 5;
    while j < (ymax + 5) do
    begin
      k := 0.8; //Empirisches Intervall für den Log(EC50)! Vielleicht falsch eingeschätzt!
      while k < 2.1 do
      begin
        l := -5;
        while l < -2 do
        begin

          Squares := 0; //Initialisieren

          //Für jeden Punkt im Datensatz den Abstand von der Kurve messen
          for x := 0 to Datensatz.RowCount - 1 do
          begin
            Square := Dataset[1,x]-(i + (j-i)/(1+Power(10,(k-Dataset[0,x])*l)));
            Squares := Squares + (Square * Square); //...und dann quadrieren!
          end;

          R := Squares;

          if R < start then //Wenn die Summe der Quadrate kleiner ist, als die vorherige (mit anderen Parametern), dann werden die Werte gemerkt...
          begin
            start := R;
            a := i;
            b := j;
            c := k;
            d := l;
          end;
          l := l + 0.1;
        end;
        k := k + 0.1;
      end;
      j := j + 0.1;
    end;
    i := i - 0.1;
  end;

  [...]


end;
Für ein besseres Verständnis der Vorhabens:

Also, ich suche eine Ausgleichskurve für gegebene Punktwolken. Es handelt sich dabei um so genannte Dosis-Wirkungs-Kurven, die aus der Auswertung von Biotests resultieren. Hier ein kleines Beispiel-Bild aus meinem Programm:

http://www.markusbrinkmann.net/images/dosis-wirkung.jpg

Die Funktion, die in die Punktwolke eingepasst werden muss, ist eine logistische wachstumskurve mit vier parametern:

Code:
Y=xmin+ (xmax-xmin)/(1+10^((LogEC50-X)*HillSlope))
Es müssen die Parameter xmin, xmax, LogEC50 und HillSlope approximiert werden.

Die Methode der kleinsten Quadrate sagt, dass die jenige approximierte Kurve am Besten ist, bei der die Summe der Quadrate der Abstände der Punkte von der Kurve minimal ist.

@jfheins: Ja, prinzipiell hast du Recht. Binärbäume sind vor allem für das Durchsuchen von Listen stark von Vorteil. Ich habe soetwas auch schoneinmal implementiert, jedoch weiß ich nicht, ob sich so ein Modell auf vier Parameter gleichzeitig übertragen lässt. Das Problem ist ja, dass die Summe der Quadrate von allen vier Variablen gleichzeitig abhängt und man also zwingend alle Permutationen ausprobieren muss - glaube ich...


Ich danke Euch allen für Eure Beiträge und hoofe, ein wenig zum Verständnis beigetragen zu haben...

Lieber Gruß,
Markus
Markus Brinkmann
  Mit Zitat antworten Zitat