lørdag den 24. december 2011

TDictionary og TEqualityComparer

Forleden dag havde jeg brug for at vide, hvor mange rækker, der var i hver tabel i en database, og det havde jeg så brug for at spørge om mange gange. Til det brugte jeg en TDictionary. TDictionary er en af de strukturer vi fik sammen med Generics og dermed Delphi 2009. TDictionary bruges til at samle en nøgle med en værdi i en liste. Før Generics ville jeg have brugt en TStringList og læst alle tabelnavnene ind som strings, og de respektive tabellers rækkeantal ville jeg have skrevet som integer på TObject-pladsen i listen. Den slags hacks er vi heldigvis ovre idag - netop fordi vi har Generics.

Til brug i dette indlæg har jeg konstrueret et andet eksempel. Jeg har hentet teksten fra "The Adventures of Sherlock Holmes" fra Project Gutenberg og gemt den som tekstfil, så jeg kan lave en liste over alle de forskellige ord og deres antal. Til det vil jeg bruge en TDictonary struktur. Jeg vil også i dette blogindlæg vise, at det er muligt at skrive sin egen metode til at sammenligne to elementer i listen. Jeg har her valgt at sammenligne dels med hensyn til store og små bogstaver og dels uden - eller helt kort: er AAAA det samme som aaaa eller ej.

Det første jeg skal have gjort er, at få delt teksten ind i ord. Jeg bruger en TStringlist til at læse min tekst ind i og derfra parse den videre ud i de enkelte ord. Der findes helt sikkert hurtigere måder at gøre på end den jeg viser her, men nu er det læsbarheden og forståeligheden jeg går efter - ikke en opvisning i performancetæt kode :o)

Jeg vil ikke kommentere en hel masse på algoritmen. Dels ligger den udenfor scope af dette blog indlæg, og dels mener jeg den er rimelig selvforklarende. Skulle der være nogen blandt læserne der alligevel ønsker noget uddybet, så skriv endelig så skal jeg nok svare.

Split bogen ud i enkelte ord


function TMainForm.ParseFile: TStringList;
var
  P, Start: PChar;
  s: String;
  Buffer: TStringList;
const
  Delimiter = [#$00 .. #$30, #$3A, #$40, #$5B .. #$61, ';', '?'];
begin
  Result := TStringList.Create;

  Buffer := TStringList.Create;
  try
    Buffer.LoadFromFile('pg1661.txt');
    P := PChar(Buffer.Text);

    while P^ <> #0 do
    begin
      Start := P;
      while not CharInSet(P^, Delimiter) do
        Inc(P);

      SetString(s, Start, P - Start);
      Result.Add(s);

      while CharInSet(P^, Delimiter) do
        if P^ = #0 then
          break
        else
          Inc(P);
    end;

  finally
    FreeAndNil(Buffer);
  end;
end;


Nu hvor jeg har min liste af ord skal de stoppes ind i en TDictionary, således at vi har en nøgle der er ordet, og en værdi der angiver hvor mange gange ordet optræder i bogen. Som jeg nævnte vil jeg bruge to forskellige principper til at tælle forskellige ord med: "Case sensitive" (godt dansk ord ;-)) og "ikke case sensitive". Derfor har den procedure, der har til formål at vise resultatet på skærmen, også en IEqualityComparer<String> med ind som parameter.

IEqualityComparer er defineret i Generics.Defaults (System.Generics.Defaults hvis du bruger XE2), og ser således ud:

IEqualityComparer<T> = interface
    function Equals(const Left, Right: T): Boolean;
    function GetHashCode(const Value: T): Integer;
  end;


IEqualityComparer er således den skabelon som man skal bruge, hvis man vil lave en sammenligningsklasse til brug i fx TDirectory. Heldigvis har hver datatype allerede sin egen prædefinerede samlingningsklasse som man kan få fat på ved at skrive TEqualityComparer<T>.Default, hvor T kan være en hvilken som helst datatype. Således skriver man for en string:  TEqualityComparer<String>.Default.

Jeg vil her vise den procedure, jeg bruger til at synliggøre mit TDictonary:

procedure TMainForm.NumberInstances(const AComparer: IEqualityComparer<string>; TheListView: TListView);
var
  Dictionary: TDictionary<string, Cardinal>;
  AWord: string;
  Buffer: TStringList;
  Words: TStringList;
begin
  // Opret en ny instans af TDictionary, der bruger AComparer som "sammenligner"
  Dictionary := TDictionary<string, Cardinal>.Create(AComparer);

  // Hent ord fra filen
  Words := ParseFile;

  Buffer := TStringList.Create;

  // Deaktiver skærmopdatering af hensyn til performance
  TheListView.Items.BeginUpdate;
  try
    TheListView.Clear;

    {
      Løb listen med ord igennem.
      Hvis den findes i Dictionary allerede så opdater tælleren med 1
      ellers opret et nyt element i Dictionary og sæt tælleren til 1
    }
    for AWord in Words do
      if Dictionary.ContainsKey(AWord) then
        Dictionary[AWord] := Dictionary[AWord] + 1
      else
        Dictionary.Add(AWord, 1);

    // Tag alle forskellige ord og smid den på en liste
    for AWord in Dictionary.Keys do
      Buffer.Add(AWord);

    // Sorter listen
    Buffer.Sort;

    // Vis listen på skærmen
    for AWord in Buffer do
      with TheListView.Items.Add do
      begin
        Caption := AWord;
        SubItems.Add(IntToStr(Dictionary[AWord]));
      end;

  finally
    //Slå skærm opdateringer til
    TheListView.Items.EndUpdate;
   
    //Frigiv hukommelse
    FreeAndNil(Buffer);
    FreeAndNil(Dictionary);
    FreeAndNil(Words);
  end;
end;
Jeg vil ikke her kommentere yderligere på proceduren, idet jeg allerede har skrevet kommentarer i koden. Det komplette eksempel kan sædvanen tro hentes her.

Nu hvor jeg kan skille min fil ad i enkelte ord, og jeg har skrevet en procedure til at vise det på skærmen, må det være på tide at få skrevet en case insensitive sammenligningsklasse. Jeg har tidligere vist at en sådan skal bygges over skabelonen IEqualityComparer. Så nu er det blot at gå i gang.

type
  //opbyg klassen over IEqualityComparer
  TCaseInsensitiveStringComparer = class(TEqualityComparer<string>)
  public
    function Equals(const Left, Right: string): Boolean; override;
    function GetHashCode(const Value: string): Integer; override;
  end;

function TCaseInsensitiveStringComparer.Equals(const Left, Right: string): Boolean;
begin
  //Sammenlign de to strings uden hensyn til store og små bogstaver
  Exit(SameText(Left, Right));
end;

function TCaseInsensitiveStringComparer.GetHashCode(const Value: string): Integer;
begin
// Da vi sammenligner case insensitive kalder vi
// TEqualityComparer<string>.Default.GetHashCode med AnsiUpperCase(Value)
  Result := TEqualityComparer<string>.Default.GetHashCode(AnsiUpperCase(Value));
end;

Som det ses bruger jeg blot den oprindelige hash-algoritme fra TEqualityComparer<string>, men jeg kunne i princippet havde skrevet min egen her.

Til sidst er der blot at få kaldt koden. Henholdsvis for case sensitive og case insensitive versionen af min sammenligner:

Case sensitive kald:
  NumberInstances(TEqualityComparer<string>.Default, default);

Case insensitive kald :
  NumberInstances(TCaseInsensitiveStringComparer.Create(), Custom);

Det skal her bemærkes at det andet parameter er det listview, som jeg ønsker at vise mit resultat i. Mine listviews har jeg navngivet henholdsvis "Default" og "Custom".

Til slut vil jeg blot vise skærmbilledet for programmet :



Som det ses, så har den ene sammenligningsklasse fundet 15 forekomster af "Adler" og 1 forekomst af "ADLER". Hvorimod den anden "kun" har fundet "Adler", men til gengæld har den fundet 16 forekomster (15 + 1). Samme ses bl.a. med "Adventure".

Således har jeg nu illustreret, hvordan man bruger en TDictionary og skriver sin egen sammenligningsklasse. I mit eksempel her har jeg bare brugt to simple datatyper, men der er ikke noget i vejen for at bruge mere komplicerede datatyper som fx klasser og records, og så dertil skrive sin egne sammenligningsklasse.

Jeg vil lige minde om at det komplette eksempel kan hentes her.

Tilbage er blot at ønske alle mine læsere glædelig jul og godt nytår. Jeg vil bruge tiden mellem jul og nytår til at komme på plads på en ny blogging platform. Men mere om det senere.

Jens Borrisholt

søndag den 18. december 2011

Smart Pointers og function Invoke: T;

Smart pointers har, indtil for nyligt, ikke været muligt at implementere i Delphi grundet manglen på Generics. Generics kom som bekendt i Delphi 2009.

Lad mig først starte med at citere Wikipedia for at få defineret præcis, hvad smart pointers egentligt er:

"In computer science, a smart pointer is an abstract data type that simulates a pointer while providing additional features, such as automatic garbage collection or bounds checking. These additional features are intended to reduce bugs caused by the misuse of pointers while retaining efficiency. Smart pointers typically keep track of the objects they point to for the purpose of memory management."

Så med andre ord er smart pointers en datatype med garbage collection, altså noget hvor Delphi selv rydder op, når der ikke er flere referencer til klassen. Det smarte ved smart pointers er, at de transformerer sig selv, når man spørger på deres indhold. Det er det, som dette indlæg, handler om.

Siden Delphi 3 (tror jeg nok) har vi haft interfaces i Delphi. Fidusen ved interfaces er bl.a., at man har en reference counter. Ved samtidig at nedarve fra TInterfacedObject opnår man, at objektet bliver nedlagt, når reference counter er 0 - altså med andre ord: garbage collection.

Lad mig vise et simpelt eksempel :

uses
SysUtils;


type
  iMyClass = interface
    procedure HelloWorld;
  end;

  TMyClass = class(TInterfacedObject, iMyClass)
    procedure HelloWorld;
    destructor Destroy; override;
  end;

{ TMyClass }

procedure TMyClass.HelloWorld;
begin
  ShowMessage('Hello World');
end;

destructor TMyClass.Destroy;
begin
  ShowMessage('Goodbye World');
  inherited;
end;

procedure TForm1.Button1Click(Sender: TObject); var myClass: iMyClass; begin myClass := TMyClass.Create; myClass.HelloWorld;
end;

Ganske som forventet får man to beskeder ud af det: Én, når man kalder metoden HelloWorld, og én, når klassen nedlægges. Intet nyt her. Ulempen er bare, at man kun kan kalde de metoder, der ligger på interfacet, og at man således er nødt til at kopiere alle metoderne fra klassen til interfacet først. Generelt er det temmelig ufleksibelt.

Her kommer smart pointers ind i billedet, fordi det er et interface, hvor man kan tilgå alle metoderne fra klassen uden først at skulle kopiere dem op på interfacet.

Når man - i sin kode - skriver ordet "myClass" og sætter et efterfølgende punktum, så får man listen af tilgængelige metoder. Listen er afgjort af, hvad en metode, kaldet "Invoke", returnerer. Denne metode retunerer bare interfacet selv, og således er den afgørende for, hvad man kan se af metoder. Men hvis nu man overstyrer Invoke, så kan man selv bestemme, hvad Invoke skal returnere og dermed, hvad man vil blive tilbudt i listen...

Lad mig vise noget kode. Som sædvanligt har jeg skrevet kommentarer i koden, således at jeg slipper for en lang forklaring bagefter.

unit SmartPointerU;

interface

uses
  SysUtils;

type
  //En reference til en contructor
  //eller en anden funktion, der retunerer et object.
  ISmartPointer<T> = reference to function: T;

  //I definitionen på TSmartPointer angiver jeg at T er en klasse.
  //Jeg angiver også, at jeg vil oprette en ny instans af mit object af typen "T"
  //Hvis ikke jeg skriver <T: class, Contructor> får jeg følgende fejl:
  //[DCC Error] SmartPointerU.pas(31): E2568 Can't create new instance without CONSTRUCTOR constraint in type parameter declaration
  TSmartPointer<T: class, constructor> = class(TInterfacedObject, ISmartPointer<T>)
  private
    //Object'et der arbejdes på
    FValue: T;
  public
    //Default constructor
    constructor Create; overload;

    //Overloaded contructor som tager en instans ind som parameter
    constructor Create(AValue: T); overload;

    destructor Destroy; override;

    //Invoke-funktionen som bliver kaldt når man skriver 
    //myInterface efterfulgt af punktum. Der skal ikke kaldes 
    //overload på funktionen. Det finder compileren selv ud af.
    function Invoke: T;
  end;

implementation

{ TSmartPointer<T> }

constructor TSmartPointer<T>.Create;
begin
  inherited;
  FValue := T.Create;
end;

constructor TSmartPointer<T>.Create(AValue: T);
begin
  inherited Create;
  if AValue = nil then
    FValue := T.Create
  else
    FValue := AValue;
end;

destructor TSmartPointer<T>.Destroy;
begin
  FValue.Free;
  inherited;
end;

function TSmartPointer<T>.Invoke: T;
begin
  Result := FValue;
end;

end.

Så lidt kode skal der til. Så klarer Delphi resten. Herefter er det bare tage klassen i brug. Til det formål har jeg skrevet en testklasse. Den har bare to properties: StringProperty og IntegerProperty samt en TMemo til log af fx oprettelse og nedlæggelse af klasserne, mm. Jeg vil ikke vise implementeringen af klassen her, da den kan ses i demo projektet. Her vil jeg blot vise brugen af klassen, samt klasse definitionen:

Klasse definition : 


type
  TCustomTestClass = class abstract
  strict private
    procedure SetLoggingMemo(const Value: TMemo);
  protected
    FLoggingMemo: TMemo;
    function LogMessage(const aMessage: String): String;
  public
    constructor Create(const aLoggingMemo: TMemo);
    destructor Destroy; override;
  published
    property LoggingMemo: TMemo read FLoggingMemo write SetLoggingMemo;
  end;

  TTestClass = class sealed(TCustomTestClass)
  private
    FIntegerProperty: Integer;
    FStringProperty: String;
    procedure SetIntegerProperty(const Value: Integer);
    procedure SetStringProperty(const Value: String);
  public
    property StringProperty: String read FStringProperty write SetStringProperty;
    property IntegerProperty: Integer read FIntegerProperty write SetIntegerProperty;
  end;

Brugen af TTestClass:


procedure TMainU.Button1Click(Sender: TObject);
var
  Test: ISmartPointer<TTestClass>;
begin
  Test := TSmartPointer<TTestClass>.Create(TTestClass.Create(Memo1));
end; procedure TMainU.Button2Click(Sender: TObject); var Test: ISmartPointer<TTestClass>; begin Test := TSmartPointer<TTestClass>.Create(); Test.LoggingMemo := Memo1; Test.IntegerProperty := 7; end; procedure TMainU.Button3Click(Sender: TObject); var Test: ISmartPointer<TTestClass>; TestObj: TTestClass; begin TestObj := TTestClass.Create(Memo1); TestObj.StringProperty := 'Dette er en test'; Test := TSmartPointer<TTestClass>.Create(TestObj); Test.IntegerProperty := 8; end; procedure TMainU.FormCreate(Sender: TObject); begin Memo1.Clear; end;

Loggen, og skærmbilledet fra demo projektet:


Som det ses i demo projektet, så nedlægges klasserne af sig selv. Det ses også, at man har direkte adgang til alle metoderne på klasserne via interfacet - uden at skulle kopiere dem op på interfacet selv. De to forskellige constructors er også vist i demo projektet. 

Hermed har jeg dels vist, hvad en smart pointer er, men også hvordan man implementerer sådan en struktur i Delphi.

Husk det komplette eksempel med source kode kan hentes her.

Jens Borrisholt