Tuesday, October 26, 2010

Memoize in Delphi

Memoize is a generic caching function, it accepts a closure as a function and return a function that does the same stuff but caches the results, very interesting.

The implementation:


TFunctionHelpers = class
  public
    class function Memoize<A, R>(aFunc: TFunc<A, R>): TFunc<A, R>;
    //other helper functions
  end;
Example of use:
type
  TSlowClass = class
  public
    //A time consuming function that changes the
    //result depending on the input value.
    //It does not matter the goal of the function, it can do whatever you want
    function Execute(aValue: integer): integer;
  end;

var
  slow: TSlowClass;
  F: TFunc<integer, integer>;
  i: integer;

begin
  slow := TSlowClass.Create;
  F := TFunctionHelpers.Memorize<integer, integer>(slow.Execute);
  for i := 0 to 999 do
    Memo1.Lines.Add(IntToStr(F(i div 10);  
  //So only 10 out of 1000 calls to the method have been really made
end;
The implementation is quite tricky, it uses a devired class from TDictionary as A(rgument) and R(esult) that does not need to be freed.
{ TManagedDictionary<TKey, TValue> }

function TManagedDictionary<TKey, TValue>.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TManagedDictionary<TKey,TValue>._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TManagedDictionary<TKey,TValue>._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

{ TFunctionHelpers<A, R> }
class function TFunctionHelpers.Memoize<A,R>(aFunc: TFunc<A, R>): TFunc<A, R>;
var
  Map: IDictionary<A, R>;

begin
  Map := TManagedDictionary<A, R>.Create;

  Result := function(aArg: A): R
  var
    FuncResult: R;

  begin
    if Map.TryGetValue(aArg, FuncResult) then
    begin
      Exit(FuncResult);
    end;

    FuncResult := aFunc(aArg);
    Map.Add(aArg, FuncResult);

    Exit(FuncResult);
  end;
end;
That's all for today

No comments:

Post a Comment