Hallo,

ich habe hier eine unbestimmte Anzahl von Funktionen mit folgendem Aufbau:

markieren

Code:

function TuDies(_Param1);
var
  success : Integer;
  err : ErrorStruct;
begin
  Result := false;
  success := -1;
  while success < 0 do
  try
    FDB.Mutex.Acquire;
    try
      FDB.TuDies(_Param1,err);
    finally
      FDB.Mutex.Release;
    end;
    success := FDB.CheckError(err);
    Result := success = 0;
  except
    on E:Exception do FDB.CheckException(E,success);
  end;
end;

function TuDas(_Param1,_Param1);
var
  success : Integer;
  err : ErrorStruct;
begin
  Result := false;
  success := -1;
  while success < 0 do
  try
    FDB.Mutex.Acquire;
    try
      FDB.TuDas(_Param1,_Param,err);
    finally
      FDB.Mutex.Release;
    end;
    success := FDB.CheckError(err);
    Result := success = 0;
  except
    on E:Exception do FDB.CheckException(E,success);
  end;
end;

...

Die Funktionen unterscheiden sich nur im Aufruf im try finally Block.

Was für eine Möglichkeit gäbe es, den restlichen Teil auszulagern? Könnte man die eigentliche Funktion irgendwie als Parameter übergeben? Die können ja vom Parameteraufbau vollkommen verschieden sein.

Für Ideen wäre ich dankbar.

Eine Möglichkeit ist das mit anonymen Methoden zu lösen:

zusammenfalten · markieren

Delphi-Quellcode:

TMyProc = reference to procedure(Err: ErrorCode);

procedure TuEtwas(AProc: TMyProc);
var
  success : Integer;
  err : ErrorStruct;
begin
  Result := false;
  success := -1;
  while success < 0 do
  try
    FDB.Mutex.Acquire;
    try
      AProc(err);
    finally
      FDB.Mutex.Release;
    end;
    success := FDB.CheckError(err);
    Result := success = 0;
  except
    on E:Exception do FDB.CheckException(E,success);
  end;
end;

procedure TuDies(_Param1);
begin
  TuEtwas(
    Procedure(Err: ErrorCode)
    begin
      FDB.TuDies(_Param1, Err)
    end   
  )
end;

procedure TuDas(_Param1,_Param2);
begin
  TuEtwas(
    Procedure(Err: ErrorCode)
    begin
      FDB.TuDies(_Param1, _Param2, Err)
    end   
  )
end;

Wie wärs mit overload?
Dann hast du zwar immernoch 2 Funktionen, aber kannst diese unter einem Funktionsnamen zusammenfassen.

Zitat von CarlAshnikov:

Eine Möglichkeit ist das mit anonymen Methoden zu lösen:

Das klappt, vielen Dank.

Jetzt kann ich sogar noch die Prüfmethoden und den Zugriff auf den Mutex zum DB-Objekt private machen.

War nur noch eine kleine Korrektur nötig, falls das jemand mal nutzen möchte.

TMyProc = reference to procedure(var Err: ErrorCode);

Nein, bitte nicht mit diesem Exception Handling.

Wenn du an etwas Generellem interessiert bist, dann wäre hier etwas

zusammenfalten · markieren

Delphi-Quellcode:

type
  Closure = record
    class function Retry( const AProc: TProc; const MaxRetryCount: Integer = 0 ): TProc; overload; static;
    class function Retry<T>( const AProc: TProc<T>; const MaxRetryCount: Integer = 0 ): TProc<T>; overload; static;
    class function Retry<T1, T2>( const AProc: TProc<T1, T2>; const MaxRetryCount: Integer = 0 ): TProc<T1, T2>; overload; static;
    class function Retry<T1, T2, T3>( const AProc: TProc<T1, T2, T3>; const MaxRetryCount: Integer = 0 ): TProc<T1, T2, T3>; overload; static;
  end;

 { Closure }

class function Closure.Retry( const AProc: TProc; const MaxRetryCount: Integer ): TProc;
begin
  Result := procedure
    var
      LRetryCount: Integer;
    begin
      LRetryCount := 0;
      while True do
        try
          AProc( );
          Exit;
        except
          Inc( LRetryCount );
          if LRetryCount >= MaxRetryCount
          then
            raise;
        end;
    end;
end;

class function Closure.Retry<T1, T2, T3>( const AProc: TProc<T1, T2, T3>; const MaxRetryCount: Integer ): TProc<T1, T2, T3>;
begin
  Result := procedure( Arg1: T1; Arg2: T2; Arg3: T3 )
    begin
      Retry(
        procedure
        begin
          AProc( Arg1, Arg2, Arg3 );
        end, MaxRetryCount )( );
    end;
end;

class function Closure.Retry<T1, T2>( const AProc: TProc<T1, T2>; const MaxRetryCount: Integer ): TProc<T1, T2>;
begin
  Result := procedure( Arg1: T1; Arg2: T2 )
    begin
      Retry(
        procedure
        begin
          AProc( Arg1, Arg2 );
        end, MaxRetryCount )( );
    end;
end;

class function Closure.Retry<T>( const AProc: TProc<T>; const MaxRetryCount: Integer ): TProc<T>;
begin
  Result := procedure( Arg: T )
    begin
      Retry(
        procedure
        begin
          AProc( Arg );
        end, MaxRetryCount )( );
    end;
end;

Im Übrigen sollten die Aufrufe FDB.TuDies und FDB.TuDas sich selber um den Lock (wieso eigentlich Mutex, brauchst du das Session- bzw. System-Global? Sonst würde ein TMonitor reichen) kümmern, denn der scheint ja immanent wichtig zu sein, also gehört der in diese Methoden rein.

zusammenfalten · markieren

Delphi-Quellcode:

type
  TFoo = class
  public
    procedure Foo( AParam: Integer );
    procedure Bar( AParam1, AParam2: Integer );
  end;

  { TFoo }

procedure TFoo.Bar( AParam1, AParam2: Integer );
begin
  TMonitor.EnterAutoLeave( Self ); {Lock}

  Writeln( 'TFoo.Bar(', AParam1, ',', AParam2, ')' );
end;

procedure TFoo.Foo( AParam: Integer );
begin
  TMonitor.EnterAutoLeave( Self ); {Lock}

  Writeln( 'TFoo.Foo(', AParam, ')' );
end;

Dieses TMonitor.EnterAutoLeave kommt durch einen class helper von mir, der ein Interface zurückliefet und dafür für das automatische Verlassen sorgt. Dadurch wirkt der Code gleich viel entspannter.

Aufruf von der gesamten Hütte ist jetzt ein gemütlicher Spaziergang

zusammenfalten · markieren

Delphi-Quellcode:

procedure Test;
var
  LFoo: TFoo;
begin
  LFoo := TFoo.Create;
  try
    Closure.Retry<Integer>( LFoo.Foo, 10 )( 42 );
    Closure.Retry<Integer, Integer>( LFoo.Bar, 10 )( 08, 15 );
  finally
    LFoo.Free;
  end;
end;

Lustig gell?

UPDATE

Ok, das mit dem Mutex habe ich jetzt auch verstanden, damit garantierst du, dass nur einer global auf die Datenbank zugreift. Ansonsten schmeisst der Mutex eine Exception. Das ändert aber nichts an meinem Vorschlag, ausser, dass man den Closure noch erweitert um ein Predicate, dass den Exception-Typ bekommt und dort entschieden wird, ob da wirklich weitergemacht werden soll, denn eine EAccessViolation ist nichts, wo ich es nochmals versuchen müsste, da ich ja eigentlich auf nur auf den Mutex warte.

Auf Deine Antwort war ich schon gespannt. Die werde ich mir heute bei nem Kaffee mal anschauen, da klemmt es im Kopf grad. Das mit dem EnterAutoLeave ist natürlich auch sehr elegant.

Mit den Anonymen Methoden kann man schon sehr lustige Dinge anstellen:

zusammenfalten · markieren

Delphi-Quellcode:

type
  Closure = record
    class function Memoize<T, TResult>( AFunc: TFunc<T, TResult>; AEqualityComparer: IEqualityComparer<T> = nil ): TFunc<T, TResult>; static;
  end;

class function Closure.Memoize<T, TResult>( AFunc: TFunc<T, TResult>; AEqualityComparer: IEqualityComparer<T> ): TFunc<T, TResult>;
var
  LDict: AutoRef<TDictionary<T, TResult>>; { AutoRef kapselt eine Instanz in einem Interface und sorgt für die automatische Freigabe }
begin
  LDict := TDictionary<T, TResult>.Create( AEqualityComparer );
  Result := function( Arg: T ): TResult
    begin
      if not LDict.Reference.TryGetValue( Arg, Result )
      then
        begin
          Result := AFunc( Arg );
          LDict.Reference.Add( Arg, Result );
        end;
    end;
end;

So, wozu braucht man das?

zusammenfalten · markieren

Delphi-Quellcode:

function fibonacci( n: Int64 ): Int64;
begin
  if n < 2
  then
    Result := n
  else
    Result := fibonacci( n - 1 ) + fibonacci( n - 2 );
end;

function fibonacci_memoize( n: Int64 ): Int64;
var
  fibonacci: TFunc<Int64, Int64>;
begin
  fibonacci := Closure.Memoize<Int64, Int64>(
      function( n: Int64 ): Int64
    begin
      if n < 2
      then
        Result := n
      else
        Result := fibonacci( n - 1 ) + fibonacci( n - 2 );
    end );
  Result := fibonacci( n );
end;

procedure memoize_test;
var
  LFibN, LFibResult: Int64;
  LStopwatch: TStopwatch;
begin
  LFibN := 40;
  LStopwatch := TStopwatch.StartNew;
  LFibResult := fibonacci( LFibN ); // Standard Umsatzung
  LStopwatch.Stop;
  Writeln( Format( 'fibonacci(%d) = %d (%dms)', [LFibN, LFibResult, LStopwatch.ElapsedMilliseconds] ) );

  LStopwatch := TStopwatch.StartNew;
  LFibResult := fibonacci_memoize( LFibN ); // mit Closure.Memoize
  LStopwatch.Stop;
  Writeln( Format( 'fibonacci(%d) = %d (%dms)', [LFibN, LFibResult, LStopwatch.ElapsedMilliseconds] ) );
end;

Beide berechnen exakt die gleichen Werte, spannend sind jetzt die Laufzeiten

markieren

Code:

fibonacci(40) = 102334155 (1101ms)
fibonacci(40) = 102334155 (0ms)

fibonacci(100) = (dauert mir zu lange)
fibonacci(100) = 3736710778780434371 (0ms)

Kannst Du auch den Geschwindigkeitsunterschied erklären?

Sherlock

Zitat von Sherlock:

Kannst Du auch den Geschwindigkeitsunterschied erklären?

Die originale Funktion ruft sich zweimal rekursiv auf um den aktuellen Wert zu ermitteln.

F(n) = F(n-1) + F(n-2)

Damit wird

F(n-1) = F(n-2) + F(n-3)
F(n-2) = F(n-3) + F(n-4)

Die Rekursion ruft also die Berechnung eines Wertes für jede Rekursionsstufe zweimal auf (Ausnahme: n<2). Z.B. wird F(n-2) sowohl bei der Berechnung von F(n) direkt als auch indirekt bei der Berechnung von F(n-1) berechnet. Damit hast du O(2^n) Aufrufe.

Die optimierte Funktion schaut halt nach, ob sie den Wert schon berechnet hat und spart sich dann den rekursiven Aufruf, was zu einer linearen Komplexität führt.

Wie bei vielen Beispielen gibt es zur Lösung dieses Problems natürlich auch einen wesentlich einfacher zu durchschauenden Lösungsweg, aber hier geht es ja eigentlich darum, die Verwendung Anonymer Methoden zu demonstrieren und nicht einen effizienten Algorithmus für Fibonacci-Zahlen zu entwickeln.

Zitat von Sir Rufo:

Ok, das mit dem Mutex habe ich jetzt auch verstanden, damit garantierst du, dass nur einer global auf die Datenbank zugreift. Ansonsten schmeisst der Mutex eine Exception. Das ändert aber nichts an meinem Vorschlag, ausser, dass man den Closure noch erweitert um ein Predicate, dass den Exception-Typ bekommt und dort entschieden wird, ob da wirklich weitergemacht werden soll, denn eine EAccessViolation ist nichts, wo ich es nochmals versuchen müsste, da ich ja eigentlich auf nur auf den Mutex warte.

Die Exception hat nichts mit dem Mutex zu tun, sondern mit der Absicherung der TCP-IP-Verbindung oder sonstigen Problemen:
Der Mutex dient der gemeinsamen Nutzung der Verbindung zum Server.

Zitat von Sir Rufo:

Im Übrigen sollten die Aufrufe FDB.TuDies und FDB.TuDas sich selber um den Lock (wieso eigentlich Mutex, brauchst du das Session- bzw. System-Global? Sonst würde ein TMonitor reichen) kümmern, denn der scheint ja immanent wichtig zu sein, also gehört der in diese Methoden rein.

Warum sollten die Aufrufe den Lock selbst steuern? Schlägt der Aufruf der Funktion aus irgend einem Grund fehl (Lock nicht erhalten, Serverprobleme, Datenverbindung nicht da, etc), wird dies nach dem Aufruf ausgewertet. Die Funktion soll nur versuchen das Zeug loszuwerden.


Was ich auch noch festgestellt habe, var Parameter in TuDies(var _UID : Integer) können nicht aus der anonymen Methode genutzt werden, daher habe ich Varianten einbauen müssen:

markieren

Code:

 
function ToDies(var _UID : Integer) : Boolean;
begin
  Result := FDB.Call(procedure(var Err: ErrorStruct; var _ID : Integer)
  begin
    FDB.ToDies(_ID,err);
  end,_UID);
end;

Jetzt muss ich geistig nur noch den Zusammenhang zu deinem Closure-Record hinbekommen.