Puntatori alberi e ricorsività parte ][

Rieccomi 🙂 con la seconda parte dei miei mini articoli su Delphi. I simpatizzanti della mela morsicata mi perdoneranno per aver usato ][ al posto del numero 2, ma il mio primo computer è stato un Apple ][ e la tentazione è stata troppo grande 🙂
La prima puntata della saga è qui. Partendo dal primo articolo ho pensato di aggiungere l’implementazione di un design pattern, il singleton.
Lo scopo del singleton, che è un design pattern creazionale, è quello di garantire la creazione di una sola istanza di una particolare classe. Il link a wikipedia è qui. Nell’esempio precedente il singleton potrebbe esserci utile perché pensando alla nostra classe StandardTreeGest in un contesto più ampio, quindi come parte di un progetto più complesso scritto da molti programmatori, ci troveremmo a doverla istanziare in più punti. Certo potremmo dichiarare una bella variabile globale 🙂 (male… molto male chi lo ha pensato?) ma questa non ci garantirebbe dall’instanziarla più volte e quindi poi trovarci con una struttura dati inconsistente e con anomalie molto molto “stravaganti”.

Cercando in giro non ho trovato molti esempi di singleton in Delphi. I primi risultati della mia ricerca sono stati:

questo che però è stato risolto usando un’interfaccia e dove si elogiava una soluzione C# definendola elegante… Delphi si basa sul Pascal, ma non è un linguaggio vecchio 🙂 abbiamo anche i tipi generici da Delphi 2009
– Altra soluzione è questa (per Delphi 5) ma utilizza un singleton “strano”… con una tecnica di reference count.

Avendo comprato un bel libro sui design pattern (da non leggere la sera 🙂 specialmente dopo una pizza ai 4 formaggi) ho voluto fare (o almeno ci ho provato) il “preciso” copiando il codice C++

#include <iostream>
 
#define null 0
 
class singleton {
  private:
    static singleton* instance_ptr;

  protected:
    singleton() { };

  public:
    ~singleton() {};
    static singleton* get_instance() {
      if (instance_ptr == null) {
        instance_ptr = new singleton;
      }
      return instance_ptr;
    }
};
 
// initialize pointer
singleton* singleton::instance_ptr = null;

Che in Delphi verrà scritto invece così:

  Singleton = class
    strict private
      // Singleton
      class var
        pInstance: Singleton;

    strict protected
      constructor Create; virtual;

    public
      destructor Destroy; override;
      class function getInstance: StandardTreeGest;
  end;

Ok descriviamo il codice Delphi. Per prima la bellissima parola chiave strict che serve a rendere veramente privati e protetti i dati membro… perché le parole private e protected non valgono per classi all’interno della stessa unit. Tanto per intenderci potete vedere questo codice sorgente che ho copiato da Stack Overflow:

type
  TFather = class
  private
    FPriv : integer;
  strict private
    FStrPriv : integer;
  protected
    FProt : integer;
  strict protected
    FStrProt : integer;
  public
    FPublic : integer;
  end;

  TSon = class(TFather)
  public
    procedure DoStuff;
  end;

  TUnrelated = class
  public
    procedure DoStuff;
  end;

procedure TSon.DoStuff;
begin
  FProt := 10;       // Legal, as it should be. Accessible to descendants.
  FPriv := 100;      // Legal, even though private. This won't work from another unit!
  FStrictPriv := 10; // <- Compiler Error, FStrictPrivFather is private to TFather
  FPublic := 100;    // Legal, naturally. Public members are accessible from everywhere.
end;

procedure TUnrelated.DoStuff;
var
  F : TFather;
begin
  F := TFather.Create;
  try
    F.FProt := 10;     // Legal, but it shouldn't be!
    F.FStrProt := 100; // <- Compiler error, the strict keyword has "made the protection work"
    F.FPublic := 100;  // Legal, naturally.
  finally
    F.Free;
  end;
end;

Qui si parla di un bug del compilatore… ma nell’help ufficiale è una features 🙂 ovviamente!!!
Poi incontriamo un’altra parolina magica class var questa ci permette di definire dei dati membro statici, infatti per il singleton sia il dato membro che la funzione di istanziazione della classe devono essere statici (per poter essere richiamati senza istanziare una classe, ma dico una cosa ovvia vero…?).

La Unit TreeGest del nostro esempio risulterà quindi essere questa:

unit TreeGest;

interface

type
  pElement = ^Element;

  Element = record
    iValue: integer;
    pLeftElement, pRightElement: pElement;
  end;

  StandardTreeGest = class
    strict private
      // Singleton
      class var
        pInstance: StandardTreeGest;

    strict protected
      constructor Create; virtual;

    private
      // Tree managment
      pRoot: pElement;

      function CreateNewElem(ext_iValue: integer): pElement;
      function InsertSorted(ext_iValue: integer; var pCurrElem: pElement): pElement;
      function ReadFromMinimum(pCurrElem: pElement): string;

      procedure DeleteAll_From(pCurrElem: pElement);

    public
      function AddElement(ext_iValue: integer): pElement;
      function SortAscending: string;

      procedure DeleteAll;

      destructor Destroy; override;

      // Singleton
      class function getInstance: StandardTreeGest;
  end;

implementation

{ StandardTreeGest }

uses
  System.SysUtils;

constructor StandardTreeGest.Create;
begin
  pRoot := nil;
end;

destructor StandardTreeGest.Destroy;
begin
  if assigned(pRoot) then
    DeleteAll;
end;

class function StandardTreeGest.getInstance: StandardTreeGest;
begin
  if (pInstance = nil) then
    pInstance := StandardTreeGest.Create;

  result := pInstance;
end;

procedure StandardTreeGest.DeleteAll;
begin
  DeleteAll_From(pRoot);
  pRoot := nil;
end;

procedure StandardTreeGest.DeleteAll_From(pCurrElem: pElement);
begin
  if pCurrElem <> nil then
  begin
    DeleteAll_From(pCurrElem.pLeftElement);
    DeleteAll_From(pCurrElem.pRightElement);
    Dispose(pCurrElem);
  end
end;

function StandardTreeGest.AddElement(ext_iValue: integer): pElement;
var
  pAddedElement: pElement;

begin
  if pRoot = nil then
  begin
    pRoot := CreateNewElem(ext_iValue);
    pAddedElement := pRoot;
  end
  else
    pAddedElement := InsertSorted(ext_iValue, pRoot);

  result := pAddedElement;
end;

function StandardTreeGest.CreateNewElem(ext_iValue: integer): pElement;
var
  pNewElement: pElement;
begin
  try
    new(pNewElement);
    pNewElement.iValue := ext_iValue;
    pNewElement.pLeftElement := nil;
    pNewElement.pRightElement := nil;
  except
    pNewElement := nil;
  end;

  result := pNewElement;
end;

function StandardTreeGest.InsertSorted(ext_iValue: integer; var pCurrElem: pElement): pElement;
var
  pResultElem: pElement;

begin
  if (pCurrElem = nil) then
  begin
    pResultElem := CreateNewElem(ext_iValue);
    pCurrElem := pResultElem;
  end
  else
    if (ext_iValue < pCurrElem.iValue) then
      pResultElem := InsertSorted(ext_iValue, pCurrElem.pLeftElement)
    else
      pResultElem := InsertSorted(ext_iValue, pCurrElem.pRightElement);

  result := pResultElem;
end;

function StandardTreeGest.SortAscending: string;
var
  sNode: string;

begin
  sNode := ReadFromMinimum(pRoot);
  if (sNode <> '') then
    result := Copy(sNode, 3, length(sNode) - 2)
  else
    result := '';
end;

function StandardTreeGest.ReadFromMinimum(pCurrElem: pElement): string;
var
  sOrderedTree: string;

begin
  if pCurrElem <> nil then
  begin
    sOrderedTree := ReadFromMinimum(pCurrElem.pLeftElement) + ' - ' + IntToStr(pCurrElem.iValue);
    sOrderedTree := sOrderedTree + ReadFromMinimum(pCurrElem.pRightElement);
  end
  else
    sOrderedTree := '';

  result := sOrderedTree;
end;

end.

Oltre ad aver implementato il singleton rispetto a quella dello scorso post ho aggiunto un blocco try…except al momento dell’allocazione della memoria del nuovo nodo dell’albero. Nel mondo ideale la memoria è illimitata, ma in quello reale finisce sempre sul più bello e la scorsa volta mi sono dimenticato di gestire l’eccezione.
Il programma avrà l’aspetto seguente:

pgm_singleton

Che a parte un bottone in più… è uguale al precedente… che farà il nuovo bottone?

procedure TfrmMain.btnAddElem2Click(Sender: TObject);
var
  pTreeGestLocal: StandardTreeGest;
  iValue, iCode: integer;

begin
  pTreeGestLocal := StandardTreeGest.getInstance;

  Val(txtValue.Text, iValue, iCode);

  if ((trim(txtValue.Text) <> '') and (iCode = 0)) then
  begin
    pTreeGestLocal.AddElement(StrToInt(txtValue.Text));
    txtValue.Clear;
    txtValue.SetFocus;
  end
end;

Semplicemente permette di verificare il singleton, aggiungendo direttamente un elemento all’albero. Notate che uso solo varibili locali e che la getInstance mi restituisce sempre il riferimento all’unica classe StandardTreeGest creata.

Il codice sorgente lo potete scaricare qui.

Alla prossima 🙂

Posta un commento o usa questo indirizzo per il trackback.

Rispondi

Inserisci i tuoi dati qui sotto o clicca su un'icona per effettuare l'accesso:

Logo di WordPress.com

Stai commentando usando il tuo account WordPress.com. Chiudi sessione /  Modifica )

Google photo

Stai commentando usando il tuo account Google. Chiudi sessione /  Modifica )

Foto Twitter

Stai commentando usando il tuo account Twitter. Chiudi sessione /  Modifica )

Foto di Facebook

Stai commentando usando il tuo account Facebook. Chiudi sessione /  Modifica )

Connessione a %s...

Questo sito utilizza Akismet per ridurre lo spam. Scopri come vengono elaborati i dati derivati dai commenti.

%d blogger hanno fatto clic su Mi Piace per questo: